Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Win32ForthIDE EdBookmarks.f, NONE, 1.1 ProjectWindow.f, NONE, 1.1 EdTabControl.f, 1.20, 1.21 EdNavigator.f, 1.5, NONE
|
From: Ezra B. <ezr...@us...> - 2008-09-08 03:02:40
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv31849/apps/Win32ForthIDE Modified Files: EdTabControl.f Added Files: EdBookmarks.f ProjectWindow.f Removed Files: EdNavigator.f Log Message: IDE updates. EAB --- NEW FILE: ProjectWindow.f --- \ ProjectWindow.f \ * *********************** Project Navigator ********************************** \ \ Allows quick navigating between code in a project. When editing files in a large \ project sometimes remembering where a word was defined can be challenging. You \ can find yourself opening many files and browsing through them to find the word. \ Project navigator keeps tracks of various code routines and by double clicking \ in the navigator tree on the desired word the file is open to the position of \ the word. \ \ \ Usage: After starting Navigator click "Track" to build code tree. Note that \ doing so clears the entire tree. By default library files used by a project are \ not scanned. This however, can be enabled in the Preferences dialog. Note too \ that this option is not saved when the IDE is closed. \ \ \ Sunday, April 27 2008 - 22:25 - Have been noticing some inconsistencies when clicking \ in the navigator tree to go to a file. Cursor is not always position correctly; you \ have to click and pause then double-click to open file. This is whether I double-click \ or right click on an item. Tests indicate it may be timing issues or something. \ For now I've added a button to goto a position. It seem more consistent than the \ tree clicking, even though some peculiarities still seem to be lurking around. \ I will continue to work on it. \ \ * **************************************************************************** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ the Project Treeview control \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ fload ProjectTree.f :object ManagerWindow <Super ProjectTreeViewControl :M ExWindowStyle: ( -- ) WS_EX_CLIENTEDGE ;M :M Handle_Notify: ( h m w l -- f ) \ Handle the notification messages of the treeview control. \ dup GetNotifyCode NM_DBLCLK = \ if IDM_EXECUTEFILE_PRJ DoCommand false \ else Handle_Notify: super \ then ;M Handle_Notify: super ;M ;object PushButton btnTrack PushButton btnGoto StatusBar NavigatorBar create curfilename max-path allot create currentname max-path allot -1 value markerhandle create lastword$ 0 , 100 allot create parentclass 0 , 100 allot \ parent class or object of method defer OpenSource \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Tree Item object \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :Class Codeitem <Super Object record: iteminfo max-path bytes itemname int parenttree \ parent treeview control int parentitem \ parent item in treeview control int hwnditem \ handle for item int linenumber int markerhandle \ scintilla control handle int itemid \ item id max-path bytes linetext max-path bytes filename ;recordsize: sizeof(iteminfo) :M classinit: ( -- ) classinit: Super iteminfo sizeof(iteminfo) erase -1 to markerhandle ;M :M setname: ( addr cnt -- ) itemname maxstring erase maxstring min 0max itemname swap move ;M :M getname: ( -- addrz ) itemname ;M :M getname$: ( -- addrz ) itemname zcount ;M :M isparentitem: ( n -- ) to parentitem ;M :M parentitem: ( -- n ) parentitem ;M :M isparenttree: ( n -- ) to parenttree ;M :M parenttree: ( -- n ) parenttree ;M :M handle: ( -- hwnd ) hwnditem ;M :M ishandle: ( n -- ) to hwnditem ;M :M itemid: ( -- f ) itemid ;M :M isitemid: ( f -- ) to itemid ;M :M linenumber: ( -- n ) linenumber ;M :M islinenumber: ( n -- ) to linenumber ;M :M linetext: ( -- addr count ) linetext count ;M :M islinetext: ( addr count-- ) linetext place ;M :M filename: ( -- addr count ) filename count ;M :M isfilename: ( addr count-- ) filename place ;M :M markerhandle: ( -- n ) markerhandle ;M :M ismarkerhandle: ( n -- ) to markerhandle ;M ;class :object NavigatorTree <Super TreeViewControl \ 1. Colon Definitions/Code \ 2. Values/Variables/Constants/Creates/Ints \ 3. Objects/Classes \ 4. Privates/Publics (Methods, Colon Definitions) int hwndmain \ handle of root item in tree \ pointers to dynamic parent list int MainList int CodeList int GlobalDataList int PrivateDataList int ClassesList int MethodsList int PrivateCodeList false value in-class? false value in-definition? false value in-enum? 0 value code-id 0 value ThisItem 1 to enum-value enum: _colon _code _value _variable _constant _method _class _object _create _int _bytes _short _dint _byte _2value ; \ enumerate parent ids -32 to enum-value enum: _main_ _code_ _pdata_ \ private data list _gdata_ \ global data list _classes_ _Methods_ _pcodelist_ ; create treename ," Code Tracker" 33 allot create default-treename ," Code Tracker" :M CodeList: ( -- list ) CodeList ;M :M PrivateDataList: ( -- list ) PrivateDataList ;M :M GlobalDataList: ( -- list ) GlobalDataList ;M :M ClassesList: ( -- list ) ClassesList ;M :M MethodsList: ( -- list ) MethodsList ;M :M MainList: ( -- list ) MainList ;M : AddChildItem ( -- ) tvins /tvins erase tvitem /tvitem erase 0 to cChildren Handle: ThisList to hParent TVI_LAST to hInsertAfter GetName: ThisItem to pszText ThisItem to lparam [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or ] literal to mask tvitem->tvins InsertItem: Self IsHandle: ThisItem ; : UpdateList ( f -- ) ThisList IsParentItem: ThisItem Self IsParentTree: ThisItem currentname count SetName: ThisItem code-id isitemid: ThisItem source islinetext: ThisItem #linecount islinenumber: ThisItem markerhandle ismarkerhandle: ThisItem curfilename count isfilename: ThisItem AddChildItem ; :M AddItem: ( parentlist -- ) to ThisList Data@: ThisList if AddLink: ThisList then New> CodeItem dup Data!: ThisList to ThisItem UpdateList ;M :M AddCode: ( -- ) \ global definitions CodeList AddItem: Self ;M :M AddPrivateCode: ( -- ) PrivateCodeList AddItem: Self ;M :M AddPrivateData: ( -- ) PrivateDataList AddItem: Self ;M :M AddGlobalData: ( -- ) GlobalDataList AddItem: Self ;M :M AddMethod: ( -- ) MethodsList AddItem: Self ;M :M AddClass: ( -- ) ClassesList AddItem: Self ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_BORDER invert and \ remove WS_BORDER style WS_CLIPCHILDREN or [ TVS_HASLINES TVS_HASBUTTONS or TVS_DISABLEDRAGDROP or TVS_SHOWSELALWAYS or TVS_LINESATROOT or ] LITERAL or ;M : AddParentItem ( lparam hAfter hParent nChildren -- hwnd ) tvins /tvins erase tvitem /tvitem erase ( nChildren) to cChildren ( hParent) to hParent ( hAfter) to hInsertAfter ( lparam) to lparam getname: lparam to pszText [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or TVIF_STATE or ] LITERAL to mask TVIS_BOLD dup to state to statemask tvitem->tvins InsertItem: Self ; : AddParentLists ( -- ) MainList TVI_LAST TVI_ROOT 1 AddParentItem dup to hwndmain isHandle: MainList ClassesList TVI_LAST hwndmain 1 AddParentItem isHandle: ClassesList MethodsList TVI_LAST hwndmain 1 AddParentItem isHandle: MethodsList CodeList TVI_LAST hwndmain 1 AddParentItem isHandle: CodeList PrivateCodeList TVI_LAST hwndmain 1 AddParentItem isHandle: PrivateCodeList GlobalDataList TVI_LAST hwndmain 1 AddParentItem isHandle: GlobalDataList PrivateDataList TVI_LAST hwndmain 1 AddParentItem isHandle: PrivateDataList ; :M SortParentLists: ( -- ) \ Sort the content of the lists handle: GlobalDataList SortChildren: Self handle: PrivateDataList SortChildren: Self handle: MethodsList SortChildren: Self handle: ClassesList SortChildren: Self handle: Codelist SortChildren: Self handle: PrivateCodeList SortChildren: Self ;M :M Classinit: ( -- ) Classinit: Super 0 to SelectedItem ;M : DisposeLists ( -- ) MainList 0= ?exit CodeList DisposeList 0 to CodeList PrivateCodeList DisposeList 0 to PrivateCodeList GlobalDataList DisposeList 0 to GlobalDataList PrivateDataList DisposeList 0 to PrivateDataList MethodsList DisposeList 0 to MethodsList ClassesList DisposeList 0 to ClassesList Mainlist DisposeList 0 to Mainlist ; :M setname: ( addr cnt -- ) treename place ;M : CreateTree ( -- ) _main_ treename count new> treelinked-list to MainList _code_ s" Global Definitions" new> treelinked-list to CodeList _pcodelist_ s" Private Definitions" new> treelinked-list to PrivateCodeList _gdata_ s" Global Data" new> treelinked-list to GlobalDataList _pdata_ s" Private Data" new> treelinked-list to PrivateDataList _Methods_ s" Methods" new> treelinked-list to MethodsList _classes_ s" Objects & Classes" new> treelinked-list to ClassesList ; :M Start: ( parent -- ) Start: Super CreateTree AddParentLists ;M :M Close: ( -- ) DisposeLists Close: Super ;M :M On_SelChanged: ( -- f ) lparamNew to SelectedItem itemid: SelectedItem 0> if s" File: " pad place Filename: SelectedItem "to-pathend" pad +place s" , Line#: " pad +place LineNumber: SelectedItem (.) pad +place pad count else s" " then asciiz SetText: NavigatorBar false ;M :M SelectedItem: ( -- n ) SelectedItem ;M :M Clear: ( -- ) TVI_ROOT DeleteItem: Self drop DisposeLists CreateTree AddParentLists parentclass off default-treename count treename place ;M : not-in-class ( -- ) false to in-class? parentclass off ; : +parent-class ( -- ) s" (" currentname +place parentclass count currentname +place s" )" currentname +place ; : data-add ( -- ) in-class? if +parent-class AddPrivateData: Self else AddGlobalData: Self then ; : add-code { cid -- } in-definition? ?exit \ should not happen! bl word dup c@ 0= abort" Add Code error!" count currentname place cid to code-id true to in-definition? in-class? if +parent-class AddPrivateCode: Self else AddCode: Self then ; : add-data { cid -- } in-definition? ?exit bl word dup c@ 0= abort" Add data error!" count currentname place cid to code-id data-add ; : add-class { cid -- } in-class? ?exit bl word dup c@ 0= abort" Add Class\Object error!" count currentname place currentname count parentclass place cid to code-id true to in-class? AddClass: Self ; : add-method ( -- ) in-definition? ?exit in-class? not ?exit bl word dup c@ 0= abort" Add Method error!" count currentname place +parent-class _method to code-id true to in-definition? AddMethod: Self ; : ?add-word ( a -- ) comment? if drop exit then Case s" :" "of _colon add-code EndOf s" :code" "of _code add-code EndOf s" ;" "of false to in-definition? false to in-enum? EndOf s" ;code" "of false to in-definition? EndOf s" :class" "of _class add-class EndOf s" :object" "of _object add-class EndOf s" ;class" "of not-in-class EndOf s" ;object" "of not-in-class EndOf s" :m" "of add-method EndOf s" ;m" "of false to in-definition? EndOf s" value" "of _value add-data EndOf s" variable" "of _variable add-data EndOf s" constant" "of _constant add-data EndOf s" create" "of _create add-data EndOf s" 2value" "of _2value add-data EndOf s" int" "of in-class? if _int add-data then EndOf s" bytes" "of in-class? if _bytes add-data then EndOf s" short" "of in-class? if _short add-data then EndOf s" byte" "of in-class? if _byte add-data then EndOf s" dint" "of in-class? if _dint add-data then EndOf s" enum:" "of in-definition? not to in-enum? EndOf s" setcommand" "of lastword$ uppercase count currentname place \ any vector tables _constant to code-id data-add EndOF in-enum? if count currentname place _constant to code-id data-add false then dup if count lastword$ place \ save word false then EndCase ; \ // -- -1 \S \ ( 1 ) \ (( 2 )) \ /* 4 */ \ (* 8 *) \ comment: 16 comment; \ DOC 32 ENDDOC : +Comment ( n -- ) comment? IF drop ELSE comment? or to comment? THEN ; : -Comment ( n -- ) invert comment? and to comment? ; : \Comment ( -- ) comment? 0= IF source nip >in ! THEN ; \ ignore till end of line : build-NavigatorTree ( -- ) bl word dup count lower dup c@ IF Case s" \" "of \comment EndOf s" //" "of \comment EndOf s" --" "of \comment EndOf s" \s" "of -1 +Comment EndOf s" (" "of 1 +Comment EndOf s" )" "of 1 -Comment EndOf s" ((" "of 2 +Comment EndOf s" ))" "of 2 -Comment EndOf s" /*" "of 4 +Comment EndOf s" */" "of 4 -Comment EndOf s" (*" "of 8 +Comment EndOf s" *)" "of 8 -Comment EndOf s" comment:" "of 16 +Comment EndOf s" comment;" "of 16 -Comment EndOf s" doc" "of 32 +Comment EndOf s" enddoc" "of 32 -Comment EndOf ( default ) ?add-word false EndCase ELSE drop THEN ; : .trackmessage ( fname cnt -- ) s" Tracking " pad place "to-pathend" pad +place s" ..." pad +place pad count asciiz SetText: NavigatorBar ; :M TrackCode: ( fname cnt -- ) curfilename place curfilename c@ 0= ?exitm curfilename count .trackmessage false to comment? 0 to #linecount curfilename count "open if drop exitm then source-ID >r to source-ID >in @ >r source 2>r \ save current source new$ (source) cell+ ! refill if 1 +to #linecount then begin more? dup 0= if drop refill dup if 1 +to #linecount \ bump line count then then while build-NavigatorTree repeat source-id close-file drop 2r> (source) 2! r> >in ! r> to source-id SortParentLists: Self 0 to selecteditem z" " SetText: NavigatorBar ;M ;object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Top window pane \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :Object NavigatorWindow <Super Child-Window ColorObject FrmColor \ the background color :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height FrmColor FillArea: dc ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop \ set form color to system color COLOR_BTNFACE Call GetSysColor NewColor: FrmColor self Start: NavigatorTree self Start: btnTrack s" Track" SetText: btnTrack Handle: TabFont SetFont: btnTrack self Start: btnGoto s" Goto" SetText: btnGoto Handle: TabFont SetFont: btnGoto self Start: NavigatorBar ;M :m On_Size: ( -- ) Redraw: NavigatorBar 0 25 Width Height 25 - Height: NavigatorBar - Move: NavigatorTree 0 0 75 24 Move: btnTrack 77 0 75 24 Move: btnGoto ;M : ShowFile { \ item -- } SelectedItem: NavigatorTree dup to item 0= ?exit \ should not be ItemID: item 0 <= ?exit \ listname FileName: item OpenSource LineNumber: item 1- GotoLine: CurrentWindow SetFocus: CurrentWindow ; :M ShowFile: ( -- ) ShowFile ;M :M WM_NOTIFY ( h m w l -- f ) dup GetNotifyWnd GetHandle: NavigatorTree <> if false exitm then Handle_Notify: NavigatorTree ;M :M Close: ( -- ) Close: NavigatorTree Close: super ;M ;Object : LibFile? ( a n - f ) "path-only" dup 7 - /string s" src\lib" caps-compare 0= ; : Track-Project-Files { \ ilist item -- } ProjectName: TheProject SetName: NavigatorTree Clear: NavigatorTree ModuleList: TheProject to ilist #items: ilist 1+ 1 ?do i >Link#: ilist Data@: ilist to item GetName$: item 2dup LibFile? not include-libs? or if TrackCode: NavigatorTree else 2drop then loop Handle: [ MainList: NavigatorTree ] ExpandItem: NavigatorTree ; \ IDM_BUILD_CODE_TREE SetCommand : Track-Opened-Files { \ ThisFile -- } s" Opened Files" SetName: NavigatorTree Clear: NavigatorTree GetTabCount: OpenFilesTab 1+ 0 do TCIF_PARAM IsMask: OpenFilesTab i GetTabInfo: OpenFilesTab Lparam: OpenFilesTab dup to ThisFile if GetFileType: ThisFile FT_SOURCE = if GetFileName: ThisFile count TrackCode: NavigatorTree then then loop ; : BuildNavigatorTree ( -- ) Clear: NavigatorTree GetBuildFile: TheProject nip if Track-Project-Files else GetTabCount: OpenFilesTab 0> if Track-Opened-Files then then ; ' BuildNavigatorTree SetFunc: btnTrack : ShowFile ( -- ) ShowFile: NavigatorWindow ; ' ShowFile SetFunc: btnGoto :Object ProjectWindow <Super Child-Window TabControl ProjectTab :M WndClassStyle: ( -- style ) \ Set the style member of the the WNDCLASS structure. CS_DBLCLKS ;M :M ReSize: ( -- ) \ Resize the controls within the main window. AutoSize: ProjectTab ClientSize: ProjectTab 2over d- ( x y w h ) 4dup Move: ManagerWindow Move: NavigatorWindow ;M :M On_Size: ( -- ) \ Handle the WM_SIZE message. ReSize: self Paint: ProjectTab ;M : ShowManager ( -- ) SW_SHOW Show: ManagerWindow \ show before hide SW_HIDE Show: NavigatorWindow ; : ShowNavigator ( -- ) SW_SHOW Show: NavigatorWindow SW_HIDE Show: ManagerWindow ; :M SelChange: ( -- ) \ Show the control for the currently selected tab. GetSelectedTab: ProjectTab case 0 of ShowManager endof 1 of ShowNavigator endof endcase ;M \ : selchange-func { lParam obj \ Parent -- false } \ This function es executed when the currently selected tab has changed. \ lParam is the adress of the Address of an NMHDR structure. \ obj is the address of the TabControl object that has send the \ notification message. GetParent: obj to Parent SelChange: Parent false ; :M ShowTab: ( n -- ) \ show tab n SetSelectedTab: ProjectTab SelChange: self ;M :M On_Init: ( -- ) self Start: ManagerWindow self Start: NavigatorWindow TCS_FLATBUTTONS AddStyle: ProjectTab self Start: ProjectTab Handle: TabFont SetFont: ProjectTab ['] selchange-func IsChangeFunc: ProjectTab TCIF_TEXT IsMask: ProjectTab z" Manager" IsPszText: ProjectTab 1 InsertTab: ProjectTab TCIF_TEXT IsMask: ProjectTab z" Navigator" IsPszText: ProjectTab 2 InsertTab: ProjectTab SelChange: self \ show the control for the currently selected tab ;M :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc ;M :M WM_NOTIFY ( h m w l -- f ) \ Handle the notification messages of the controls. dup GetNotifyWnd GetHandle: ManagerWindow = if Handle_Notify: ManagerWindow else dup GetNotifyWnd GetHandle: ProjectTab = if Handle_Notify: ProjectTab else false then then ;M :M Close: ( -- ) Close: ManagerWindow Close: NavigatorWindow Close: Super ;M :M On_Done: ( -- ) On_Done: Super ;M ;Object \s Index: EdTabControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdTabControl.f,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** EdTabControl.f 11 Aug 2008 17:46:18 -0000 1.20 --- EdTabControl.f 8 Sep 2008 03:02:34 -0000 1.21 *************** *** 146,171 **** ;class ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ the Project Treeview control ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! fload ProjectTree.f ! ! :class ProjectWindow <Super ProjectTreeViewControl ! ! :M ExWindowStyle: ( -- ) ! WS_EX_CLIENTEDGE ;M ! ! :M Handle_Notify: ( h m w l -- f ) ! \ Handle the notification messages of the treeview control. ! \ dup GetNotifyCode NM_DBLCLK = ! \ if IDM_EXECUTEFILE_PRJ DoCommand false ! \ else Handle_Notify: super ! \ then ;M ! Handle_Notify: super ! ;M ! ! ;class ! fload edfilepane.f fload edforthform.f --- 146,150 ---- ;class ! fload ProjectWindow.f fload edfilepane.f fload edforthform.f *************** *** 191,195 **** TabControlEx cTab FileListView cFileList ! ProjectWindow cProjectTree ClassBrowserWindow cClassTree ClassBrowserWindow cVocTree --- 170,174 ---- TabControlEx cTab FileListView cFileList ! \ ProjectWindow ProjectWindow ClassBrowserWindow cClassTree ClassBrowserWindow cVocTree *************** *** 206,210 **** ClientSize: cTab 2over d- ( x y w h ) 4dup Move: cFileList ! 4dup Move: cProjectTree 4dup Move: cClassTree 4dup Move: cVocTree --- 185,189 ---- ClientSize: cTab 2over d- ( x y w h ) 4dup Move: cFileList ! 4dup Move: ProjectWindow 4dup Move: cClassTree 4dup Move: cVocTree *************** *** 222,226 **** : ShowFiles ( -- ) SW_SHOW Show: cFileList \ show before hide ! SW_HIDE Show: cProjectTree SW_HIDE Show: cVocTree SW_HIDE Show: cClassTree --- 201,205 ---- : ShowFiles ( -- ) SW_SHOW Show: cFileList \ show before hide ! SW_HIDE Show: ProjectWindow SW_HIDE Show: cVocTree SW_HIDE Show: cClassTree *************** *** 231,235 **** : ShowProject ( -- ) ! SW_SHOW Show: cProjectTree SW_HIDE Show: cFileList SW_HIDE Show: cVocTree --- 210,214 ---- : ShowProject ( -- ) ! SW_SHOW Show: ProjectWindow SW_HIDE Show: cFileList SW_HIDE Show: cVocTree *************** *** 243,247 **** SW_SHOW Show: cVocTree SW_HIDE Show: cFileList ! SW_HIDE Show: cProjectTree SW_HIDE Show: cClassTree SW_HIDE Show: TheFolderView --- 222,226 ---- SW_SHOW Show: cVocTree SW_HIDE Show: cFileList ! SW_HIDE Show: ProjectWindow SW_HIDE Show: cClassTree SW_HIDE Show: TheFolderView *************** *** 253,257 **** SW_SHOW Show: cClassTree SW_HIDE Show: cFileList ! SW_HIDE Show: cProjectTree SW_HIDE Show: cVocTree SW_HIDE Show: TheFolderView --- 232,236 ---- SW_SHOW Show: cClassTree SW_HIDE Show: cFileList ! SW_HIDE Show: ProjectWindow SW_HIDE Show: cVocTree SW_HIDE Show: TheFolderView *************** *** 264,268 **** SW_HIDE Show: cClassTree SW_HIDE Show: cFileList ! SW_HIDE Show: cProjectTree SW_HIDE Show: cVocTree detached? not --- 243,247 ---- SW_HIDE Show: cClassTree SW_HIDE Show: cFileList ! SW_HIDE Show: ProjectWindow SW_HIDE Show: cVocTree detached? not *************** *** 276,280 **** SW_HIDE Show: cClassTree SW_HIDE Show: cFileList ! SW_HIDE Show: cProjectTree SW_HIDE Show: cVocTree SW_HIDE Show: TheFolderView --- 255,259 ---- SW_HIDE Show: cClassTree SW_HIDE Show: cFileList ! SW_HIDE Show: ProjectWindow SW_HIDE Show: cVocTree SW_HIDE Show: TheFolderView *************** *** 326,333 **** else dup GetNotifyWnd GetHandle: cVocTree = if Handle_Notify: cVocTree ! else dup GetNotifyWnd GetHandle: cProjectTree = ! if Handle_Notify: cProjectTree ! else false ! then then then then then ;M :M AddFormTab: ( -- ) --- 305,313 ---- else dup GetNotifyWnd GetHandle: cVocTree = if Handle_Notify: cVocTree ! else \ dup GetNotifyWnd GetHandle: ProjectWindow = ! \ if Handle_Notify: ProjectWindow ! \ else ! false ! then then then then ;M :M AddFormTab: ( -- ) *************** *** 346,350 **** :M On_Init: ( -- ) self Start: cFileList ! self Start: cProjectTree self Start: cVocTree self Start: cClassTree --- 326,330 ---- :M On_Init: ( -- ) self Start: cFileList ! self Start: ProjectWindow self Start: cVocTree self Start: cClassTree --- NEW FILE: EdBookmarks.f --- \ EdBookMarks.f \ Bookmarking allows setting markers at points anywhere in a source file for quick \ navigating. \ Click "Add Bookmark" to save the position of the current line in the current \ file as a bookmark. To return to a saved bookmark click on the desired mark. \ \ "Clear BookMarks" does as it says, clears all bookmarks from all open files. PushButton btnAddBookMark PushButton btnClearBookMarks :Object BookMarksWindow <Super Window 0 value BookMarkList Listbox BMListBox ColorObject FrmColor \ the background color 0 value ThisItem : UpdateList ( -- ) currentname count SetName: ThisItem source islinetext: ThisItem #linecount islinenumber: ThisItem curfilename count isfilename: ThisItem markerhandle ismarkerhandle: ThisItem ; : Addbookmark ( -- ) Data@: BookMarkList if AddLink: BookMarkList then New> CodeItem dup Data!: BookMarkList to ThisItem updatelist linetext: thisitem asciiz addstringto: BMListBox ; :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height FrmColor FillArea: dc ;M :M StartSize: ( -- width height ) BookMarksSize ;M :M StartPos: ( -- x y ) BookMarksPos ;M :M WindowTitle: ( -- ztitle ) z" Bookmarks" ;M :M On_Done: ( -- ) originx originy 2to BookMarksPos Width Height 2to BookMarksSize On_Done: Super ;M :m On_Init: ( -- ) New> Linked-List to BookMarkList CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop \ set form color to system color COLOR_BTNFACE Call GetSysColor NewColor: FrmColor self Start: BMListBox Handle: TabFont SetFont: BMListBox self Start: btnAddBookMark s" Add Bookmark" SetText: btnAddBookMark Handle: TabFont SetFont: btnAddBookMark self Start: btnClearBookMarks s" Clear Bookmarks" SetText: btnClearBookMarks Handle: TabFont SetFont: btnClearBookMarks ;m :m on_size: ( -- ) 0 0 100 24 Move: btnAddBookMark 102 0 100 24 Move: btnClearBookMarks 0 25 width height 25 - Move: BMListBox ;m : -leading ( addr cnt -- addr2 cnt2 ) \ remove leading blanks and tabs dup 0 ?do over i + c@ bl <= if 1 /string else leave \ leave if not bl or tab then loop ; : add-bookmark ( -- ) ActiveChild 0= ?exit GetFileType: ActiveChild FT_SOURCE <> ?exit GetFileName: ActiveChild count curfilename place GetCurrentLine: ActiveChild dup to #linecount LineLength: CurrentWindow cell+ malloc >r #linecount r@ GetLine: CurrentWindow 2 - 0max r@ swap ( -- addr len ) -leading maxstring min 0max 2dup currentname place 0 #linecount SCI_MARKERADD GetHandle: CurrentWindow call SendMessage to markerhandle source 2>r (source) 2! AddBookMark -1 to markerhandle \ reset it 2r> (source) 2! r> release ; :M BookMark: ( -- ) add-bookmark ;M :M ClearBookMarks: { \ this -- } Clear: BMListBox GetTabCount: OpenFilesTab dup 0> if 1+ 0 do TCIF_PARAM IsMask: OpenFilesTab i GetTabInfo: OpenFilesTab Lparam: OpenFilesTab to this This if GetFileType: This FT_SOURCE = if ChildWindow: This GetHandle: [ ] >r 0 -1 SCI_MARKERDELETEALL r> Call SendMessage drop then then loop else drop then ;M :M Close: ( -- ) ClearBookMarks: self Close: BMListBox BookMarkList DisposeList Close: super ;M : ShowFile { \ item -- } FileName: Thisitem (OpenSourceFile) markerhandle: Thisitem dup 0< if drop LineNumber: Thisitem else 0 swap SCI_MARKERLINEFROMHANDLE GetHandle: CurrentWindow call SendMessage dup 0< if drop LineNumber: Thisitem then then GotoLine: CurrentWindow SetFocus: CurrentWindow ; :M WM_COMMAND ( h m w l -- f ) over LOWORD GetID: BMListBox = if over HIWORD LBN_SELCHANGE = if GetSelection: BMListBox dup LB_ERR <> if 1+ >Link#: BookMarkList Data@: BookMarkList to ThisItem ShowFile else drop then then then false ;M ;Object : add-bookmark ( -- ) BookMark: BookMarksWindow ; IDM_SET_BOOKMARK SetCommand ' add-bookmark SetFunc: btnAddBookMark : clear-bookmarks ( -- ) ClearBookMarks: BookMarksWindow ; ' clear-bookmarks SetFunc: btnClearBookMarks : BookMarker ( -- ) GetHandle: MainWindow SetParentWindow: BookMarksWindow Start: BookMarksWindow ; IDM_BOOKMARKS SetCommand \s --- EdNavigator.f DELETED --- |
