Menu
▾
▴
[Win32forth-cvs] win32forth/apps/ProMgr HexViewer.f,NONE,1.1 ProjectManager.f,1.10,1.11
|
From: Ezra B. <ezr...@us...> - 2005-11-01 23:17:46
|
Update of /cvsroot/win32forth/win32forth/apps/ProMgr In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27444/apps/ProMgr Modified Files: ProjectManager.f Added Files: HexViewer.f Log Message: Enhance Project Manager a little. Index: ProjectManager.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ProMgr/ProjectManager.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** ProjectManager.f 15 Sep 2005 16:36:08 -0000 1.10 --- ProjectManager.f 1 Nov 2005 23:17:36 -0000 1.11 *************** *** 5,8 **** --- 5,10 ---- comment: + October 07, 2005 - EAB - added class for viewing binary files of any size. + September 5th, 2005 Rod - version 2.01.00 *************** *** 42,46 **** May 15, 2004 08:57:31 PM - factored out project manager into a separate application ! First integrated into ForthForm, butI thought that it would be a little cumbersome to have the additional files required - especially the Zip32.dll and w32fScintilla.dll - distributed with ForthForm. --- 44,48 ---- May 15, 2004 08:57:31 PM - factored out project manager into a separate application ! First integrated into ForthForm, but I thought that it would be a little cumbersome to have the additional files required - especially the Zip32.dll and w32fScintilla.dll - distributed with ForthForm. *************** *** 96,100 **** \ Odd minor version numbers are possibly unstable beta releases. ! Create ProjectVersion ," 2.01.00" needs linklist.f --- 98,102 ---- \ Odd minor version numbers are possibly unstable beta releases. ! Create ProjectVersion ," 2.01.01" needs linklist.f *************** *** 111,114 **** --- 113,117 ---- needs ScintillaHyperEdit.f needs HtmlDisplayWindow.f + needs hexviewer.f \ hex dump class needs RegistrySupport.f needs RecentFiles.f *************** *** 207,216 **** : OpenProjectFile ( -- addr ) - \ ProjectPath count ?dup - \ if SetDir: OpenProjectDialog else drop then s" Project Files|*.fpj|" SetFilter: OpenProjectDialog s" Open Project File" SetTitle: OpenProjectDialog Gethandle: TheProjectWindow Start: OpenProjectDialog ; - \ GetDir: OpenProjectDialog ?dup if ProjectPath place else drop then ; : SelectAFile ( -- addr ) --- 210,216 ---- *************** *** 282,287 **** Start: super - \ 24 22 word-join 0 TB_SETBUTTONSIZE hwnd call SendMessage drop \ does nothing - \ 16 20 word-join 0 TB_SETBITMAPSIZE hwnd call SendMessage drop 16 16 word-join 0 TB_SETBITMAPSIZE hwnd call SendMessage drop \ smaller height of toolbar --- 282,285 ---- *************** *** 561,565 **** TVIF_IMAGE or TVIF_SELECTEDIMAGE or to mask tvitem->tvins - \ tvins 0 TVM_INSERTITEMA hWnd Call SendMessage InsertItem: self IsHandle: ThisItem ; --- 559,562 ---- *************** *** 630,634 **** TVIF_IMAGE or TVIF_SELECTEDIMAGE or to mask tvitem->tvins - \ tvins 0 TVM_INSERTITEMA hWnd Call SendMessage ; InsertItem: self ; --- 627,630 ---- *************** *** 651,661 **** : .buildfile ( -- ) ! mainfile c@ if s" Build file: " else s" No build file set" then new$ dup>r place mainfile count r@ +place ! r@ +null ! r> 1+ 1 SetText: TheStatusBar false to dirty? ; :m setbuildfile: ( addr cnt -- ) --- 647,658 ---- : .buildfile ( -- ) ! mainfile c@ dup if s" Build file: " else s" No build file set" then new$ dup>r place mainfile count r@ +place ! if s" ---- Total files in project= " r@ +place ! totalfiles: self (.) r@ +place ! then r> dup +null 1+ 1 SetText: TheStatusBar false to dirty? ; :m setbuildfile: ( addr cnt -- ) *************** *** 837,841 **** Close: ProjectFile false to Modified - \ 0= s" Project saved!" ?MessageBox ;M s" Error saving project" ?MessageBox ;M --- 834,837 ---- *************** *** 897,901 **** THEN THEN - \ hwndmain ToggleExpandItem: self hwndmain TVE_EXPAND Expand: self hwndmain GetChild: self SelectItem: self --- 893,896 ---- *************** *** 931,935 **** ;Object - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Right Pane \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 926,929 ---- *************** *** 942,945 **** --- 936,940 ---- int viewfont HtmlDisplayControl HtmlBox + HexViewer BinaryBox :M ExWindowStyle: ( -- ) *************** *** 948,952 **** : is-binary-file? ( -- f ) true \ default ! GetBuffer: viewerfile 100 min 0max \ check first 100 bytes bounds ?do i c@ bl < --- 943,947 ---- : is-binary-file? ( -- f ) true \ default ! GetBuffer: viewerfile 1000 min 0max \ check first 1000 bytes bounds ?do i c@ bl < *************** *** 958,962 **** loop not ; ! : Close-viewers ( -- ) Close: ViewBox Close: HtmlBox ; : Start-ViewBox ( -- ) --- 953,958 ---- loop not ; ! : Close-viewers ( -- ) ! Close: ViewBox Close: HtmlBox Close: BinaryBox ; : Start-ViewBox ( -- ) *************** *** 978,1013 **** 0 0 GetSize: self Move: HtmlBox then ; ! ! \ The following routines for hex viewing adapted from "Dump" in kernel ! : H.R ( n1 -- ) \ display n1 as a hex number right ! \ justified in a field of 8 characters ! BASE @ >R HEX ! 0 <# #S #> 8 OVER - +spaces append ! R> BASE ! ; ! ! : H.2 ( n1 -- ) \ display n1 as a HEX number of n2 digits ! BASE @ >R HEX ! 0 <# 2 0 ?DO # LOOP #> append ! R> BASE ! ; ! ! : EMIT. ( n -- ) ! DUP BL 255 BETWEEN 0= IF DROP [CHAR] . THEN cappend ; ! ! : HexView ( -- ) ( hex byte format with ascii ) ! initbuffer GetBuffer: viewerfile ! \ our buffer is limited so dump only first 10k ! [ 10 1024 * ] LITERAL min 0max ! over +no-wrap dup rot ! ?do i h.r s" | " append ! i 16 +no-wrap over umin i ! 2dup ! do i c@ h.2 ! bl cappend ! i j 7 + = if bl cappend then ! loop 2dup - 16 over - 3 * swap 8 < - +spaces ! s" |" append ! do i c@ emit. ! loop s" |" append&crlf ! 16 +loop drop Thebuffer Settextz: Viewbox ; : LoadCursor ( z$ -- h ) >r LR_LOADFROMFILE 0 0 IMAGE_CURSOR r> 0 call LoadImage ; --- 974,983 ---- 0 0 GetSize: self Move: HtmlBox then ; ! ! : Start-BinaryBox ( -- ) ! GetHandle: BinaryBox 0= ! if self Start: BinaryBox ! AutoSize: BinaryBox ! then ; : LoadCursor ( z$ -- h ) >r LR_LOADFROMFILE 0 0 IMAGE_CURSOR r> 0 call LoadImage ; *************** *** 1029,1033 **** ( default ) swap is-binary-file? ! IF start-ViewBox HexView ELSE start-ViewBox GetBuffer: viewerfile SetTextz: ViewBox --- 999,1003 ---- ( default ) swap is-binary-file? ! IF Start-BinaryBox GetBuffer: viewerfile Dump: BinaryBox ELSE start-ViewBox GetBuffer: viewerfile SetTextz: ViewBox *************** *** 1043,1046 **** --- 1013,1017 ---- GetHandle: ViewBox if 0 0 Getsize: self Move: ViewBox then GetHandle: HtmlBox if Autosize: HtmlBox then + GetHandle: BinaryBox if AutoSize: BinaryBox then ;M *************** *** 1074,1080 **** then ;M ;Object - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Project StatusBar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 1045,1053 ---- then ;M + :M Close: ( -- ) + Close-Viewers ;M + ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Project StatusBar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 1089,1093 **** ;Object - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Project help window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 1062,1065 ---- *************** *** 1229,1233 **** :M DefaultIcon: ( -- hIcon ) \ return the default icon handle for window 101 appInst Call LoadIcon - \ s" src\res\Project.ico" Prepend<home>\ LoadIconFile ;M --- 1201,1204 ---- *************** *** 1245,1249 **** WS_CLIPCHILDREN +Style: self self to TheProjectWindow - \ ProjectMenu SetMenuBar: self \ set in ClassInit ptoolbar to TheToolBar 1024 SetID: TheToolBar --- 1216,1219 ---- *************** *** 1288,1291 **** --- 1258,1263 ---- Options SaveSettings ProjectManager SaveSettings + false promgr-started + SaveRecentFiles SaveRecentFiles MenuHandle: CurrentMenu ?dup *************** *** 1795,1802 **** ?do GetName: [ Data@: ThisList ] zcount 2dup LibFile? NoLibfiles and IF 2drop [ also hidden ] -1 +to #FilesTobeZipped [ forth ] ! ELSE AddFileToBeZipped ( a.k.a +zfile ) ! THEN ! \ AddFileToBeZipped ( a.k.a +zfile ) ! >NextLink: ThisList loop cell +loop 0 to zprintcnt true to dirty? ThisPath count goZip! --- 1767,1773 ---- ?do GetName: [ Data@: ThisList ] zcount 2dup LibFile? NoLibfiles and IF 2drop [ also hidden ] -1 +to #FilesTobeZipped [ forth ] ! ELSE AddFileToBeZipped ( a.k.a +zfile ) ! THEN ! >NextLink: ThisList loop cell +loop 0 to zprintcnt true to dirty? ThisPath count goZip! *************** *** 1959,1975 **** then r> close-file drop ; ! : PM ( -- ) ! WindowSettings RestoreSettings ! Options RestoreSettings ! InitScintillaControl \ Dienstag, August 03 2004 dbu \+ sysgen read-path-file ! init-msg-buffer ! Start: ProjectWindow ! RestoreRecentFiles ! 6 SetNumber: RecentFiles \+ sysgen HandleCmdLine \+ sysgen PMAccelerators EnableAccelerators ! SetProjectTitle ! ; --- 1930,1947 ---- then r> close-file drop ; ! : PM ( -- ) ! WindowSettings RestoreSettings ! Options RestoreSettings ! InitScintillaControl \ Dienstag, August 03 2004 dbu \+ sysgen read-path-file ! init-msg-buffer ! Start: ProjectWindow ! \+ sysgen true promgr-started ! RestoreRecentFiles ! 6 SetNumber: RecentFiles \+ sysgen HandleCmdLine \+ sysgen PMAccelerators EnableAccelerators ! SetProjectTitle ! ; --- NEW FILE: HexViewer.f --- \ HexViewer.F Adapted from FileDump.f needs ExUtils.f :class HexViewer <super child-window int screen-cols int screen-rows 0 constant first-line# \ first line number int last-line# \ last line number int last-top-line# int cur-first-line \ current first line position 16 constant bytes/line int buff-len \ length of the buffer int buff-ptr \ address of the buffer int eob-ptr \ end of buffer pointer Font fdFont :m classinit: ( -- ) classinit: super NextID to ID 0 to buff-ptr 0 to buff-len 0 to eob-ptr 200 to last-line# last-line# 20 - to last-top-line# ;m :m home: ( -- ) first-line# to cur-first-line paint: self ;m : set-params ( -- ) temprect GetClientrect: self temprect.right to width temprect.bottom to height width char-width / to screen-cols height char-height / to screen-rows last-line# screen-rows - 0max to last-top-line# \ set the vertical scroll limits false last-top-line# first-line# SB_VERT GetHandle: self Call SetScrollRange drop ; : release-buffptr ( -- ) buff-ptr ?dup if release 0 to buff-ptr then ; : alloc-buffptr { size -- } release-buffptr size cell+ malloc to buff-ptr ; : hex-view ( a1 n1 -- ) dup to buff-len alloc-buffptr \ keep my own copy, just in case buff-ptr buff-len move hwnd 0= ?exit buff-len bytes/line /mod swap if 1+ then to last-line# buff-ptr buff-len + to eob-ptr set-params home: self ; :M Dump: ( addr cnt -- ) hex-view ;M :M On_Init: ( -- ) On_Init: super 8 Width: fdFont 14 Height: fdFont s" Courier" SetFaceName: fdFont Create: fdFont ;M :m on_size: ( -- ) set-params ;m :m startpos: 0 0 ;m :m startsize: 75 char-width * 20 char-height * ;m \ The following routines for hex viewing adapted from "Dump" in kernel : H.R ( n1 -- ) \ display n1 as a hex number right \ justified in a field of 8 characters BASE @ >R HEX 0 <# #S #> 8 OVER - +spaces append R> BASE ! ; : H.2 ( n1 -- ) \ display n1 as a HEX number of n2 digits BASE @ >R HEX 0 <# 2 0 ?DO # LOOP #> append R> BASE ! ; : EMIT. ( n -- ) DUP BL 255 BETWEEN 0= IF DROP [CHAR] . THEN cappend ; : dump-line { n -- addr cnt } ( hex byte format with ascii ) initbuffer n bytes/line * buff-ptr + dup 16 + eob-ptr >= \ limit dump if eob-ptr over - \ to available else bytes/line \ characters then over +no-wrap dup rot ?do i h.r s" | " append i 16 +no-wrap over umin i 2dup do i c@ h.2 bl cappend i j 7 + = if bl cappend then loop 2dup - 16 over - 3 * swap 8 < - +spaces s" |" append do i c@ emit. loop s" |" append 16 +loop drop TheBuffer ; :m on_paint: ( -- ) 0 0 GetSize: self WHITE FillArea: dc buff-ptr 0= ?exitm SaveDC: dc \ save device context Handle: fdFont SetFont: dc \ set the font to be used screen-rows 0 do 0 char-height i * i cur-first-line + dup last-line# >= if drop spcs 80 else dump-line then textout: dc loop RestoreDC: dc ;m :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super WS_VSCROLL or \ add vertical scroll bar ;M :m vposition: ( n -- ) \ move to position n 0max last-top-line# min to cur-first-line paint: self ;m :m vscroll: ( n -- ) \ move n lines up or down cur-first-line + vposition: self ;m :m end: ( -- ) \ move to end, in this case it's 100 bytes down to pad last-top-line# to cur-first-line paint: self ;m :m vpage: ( n -- ) \ down or up n pages screen-rows 1- * vscroll: self ;m :M WM_VSCROLL ( h m w l -- res ) swap word-split >r CASE SB_BOTTOM of End: self endof SB_TOP of Home: self endof SB_LINEDOWN of 1 VScroll: self endof SB_LINEUP of -1 VScroll: self endof SB_PAGEDOWN of 1 VPage: self endof SB_PAGEUP of -1 VPage: self endof SB_THUMBPOSITION of r@ VPosition: self endof SB_THUMBTRACK of r@ VPosition: self endof ENDCASE r>drop \ position the vertical button in the scroll bar TRUE cur-first-line SB_VERT GetHandle: self Call SetScrollPos drop 0 ;M :m on_done: ( -- ) release-buffptr Delete: fdFont on_done: super ;m :M AutoSize: ( -- ) tempRect.AddrOf GetClientRect: Parent 0 0 Right: tempRect Bottom: tempRect \ x,y,h,w Move: self ;M :M ~: ( -- ) release-buffptr ;m ;class \s |
