From: Ezra B. <ezr...@us...> - 2009-04-10 16:49:38
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv17131/apps/Win32ForthIDE Modified Files: ProjectWindow.f Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: ProjectWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ProjectWindow.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** ProjectWindow.f 1 Oct 2008 03:10:14 -0000 1.3 --- ProjectWindow.f 10 Apr 2009 16:49:34 -0000 1.4 *************** *** 31,35 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! fload ProjectTree.f :object ManagerWindow <Super ProjectTreeViewControl --- 31,63 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! needs ProjectTree.f ! needs joinstr.f ! ! \ adapted from -scan ! CODE -LSCAN ( addr len long -- addr' len' ) \ Scan for cell "long" BACKWARDS starting ! \ at addr, the end of the string, back through len cells before addr, ! \ returning addr' and len' of long. ! mov eax, ebx ! pop ecx ! jecxz short @@1 ! pop edi ! std ! repnz scasd ! cld ! jne short @@2 ! add ecx, # 1 ! add edi, # 4 ! @@2: push edi ! xor edi, edi \ edi is zero ! @@1: mov ebx, ecx ! next c; ! ! create abort$ 6 c, 'a' c, 'b' c, 'o' c, 'r' c, 't' c, '"' c, ! create squote$ 2 c, 's' c, '"' c, ! create dotquote$ 2 c, '.' c, '"' c, ! create cquote$ 2 c, 'c' c, '"' c, ! create zquote$ 2 c, 'z' c, '"' c, ! create commaquote$ 2 c, ',' c, '"' c, ! create zcommaquote$ 3 c, 'z' c, ',' c, '"' c, :object ManagerWindow <Super ProjectTreeViewControl *************** *** 49,62 **** ;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 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 77,96 ---- ;object + Label lblInfo1 + Label lblInfo2 PushButton btnTrack PushButton btnGoto + s" Press control to toggle single click file open" BInfo: btnGoto place StatusBar NavigatorBar create curfilename max-path allot create currentname max-path allot -1 value markerhandle ! create lastword$ 0 , max-path allot ! create parentclass 0 , max-path allot \ parent class or object of method defer OpenSource + defer auto-showfile + false value goto-on-click? + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Tree Item object \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 73,76 **** --- 107,111 ---- int markerhandle \ scintilla control handle int itemid \ item id + int #grands max-path bytes linetext max-path bytes filename *************** *** 110,117 **** to hwnditem ;M ! :M itemid: ( -- f ) itemid ;M ! :M isitemid: ( f -- ) to itemid ;M --- 145,152 ---- to hwnditem ;M ! :M ItemID: ( -- f ) itemid ;M ! :M isItemID: ( f -- ) to itemid ;M *************** *** 140,143 **** --- 175,184 ---- to markerhandle ;M + :M incr: ( -- ) + 1 +to #grands ;M + + :M #grands: ( -- n ) + #grands ;M + ;class *************** *** 149,162 **** \ 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? --- 190,203 ---- \ 4. Privates/Publics (Methods, Colon Definitions) ! 0 value hwndmain \ handle of root item in tree \ pointers to dynamic parent list ! 0 value MainList ! 0 value CodeList ! 0 value GlobalDataList ! 0 value PrivateDataList ! 0 value ClassesList ! 0 value MethodsList ! 0 value PrivateCodeList false value in-class? *************** *** 165,178 **** 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 _fvariable _fconstant _fvalue ; \ enumerate parent ids -32 to enum-value enum: ! _main_ _code_ _pdata_ \ private data list --- 206,228 ---- 0 value code-id 0 value ThisItem ! 0 value ThisGrandChild ! 0 value CurrentChild ! 0 value SelectedItem ! 256 constant _grand-id ! 0 value hash-table \ points to table of hash values, we will use the pointer bufferaddr ! buffermax 2/ constant hash-table-size \ ( 64k ) ! hash-table-size cell / constant max-hash-items ( 16k ) ! 0 value hash-table-mirror \ points to table of child items ! hash-table-size Pointer GrandChildList ! enum: _colon _code _value _variable _constant _method _class _object _create _int _bytes _short ! _dint _byte _2value _fvariable _fconstant _fvalue _defer _setcommand ; \ enumerate parent ids -32 to enum-value enum: ! 0 _main_ _code_ _pdata_ \ private data list *************** *** 216,224 **** 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 --- 266,286 ---- InsertItem: Self IsHandle: ThisItem ; + : add-to-hash-table { item str cnt -- } + hash-table @ max-hash-items >= abort" Hash buffer full!" + new$ >r + str cnt 2dup bl scan nip - \ remove appended parent name if neceesary + r@ place + r@ count lower \ case insensitive + r> count method-hash + hash-table lcount cells+ ! + hash-table incr \ bump count + item hash-table-mirror lcount cells+ ! + hash-table-mirror incr ; + : UpdateList ( f -- ) ThisList IsParentItem: ThisItem Self IsParentTree: ThisItem currentname count SetName: ThisItem ! code-id isItemID: ThisItem source islinetext: ThisItem #linecount islinenumber: ThisItem *************** *** 226,229 **** --- 288,292 ---- curfilename count isfilename: ThisItem AddChildItem + ThisItem currentname count add-to-hash-table ; *************** *** 277,286 **** 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 --- 340,427 ---- ClassesList TVI_LAST hwndmain 1 AddParentItem isHandle: ClassesList MethodsList TVI_LAST hwndmain 1 AddParentItem isHandle: MethodsList PrivateCodeList TVI_LAST hwndmain 1 AddParentItem isHandle: PrivateCodeList PrivateDataList TVI_LAST hwndmain 1 AddParentItem isHandle: PrivateDataList + CodeList TVI_LAST hwndmain 1 AddParentItem isHandle: CodeList + GlobalDataList TVI_LAST hwndmain 1 AddParentItem isHandle: GlobalDataList ; + : HaveChildren ( -- ) \ show the "+" next to item + tvins /tvins erase + tvitem /tvitem erase + 1 to cChildren + Handle: CurrentChild to hitem + TVIF_CHILDREN to mask + tvitem->tvins + SetItem: Self ; + + : AddGrandChildItem ( -- ) + HaveChildren + tvins /tvins erase + tvitem /tvitem erase + 0 to cChildren + Handle: CurrentChild to hParent + TVI_LAST to hInsertAfter + GetName: ThisGrandChild to pszText + ThisGrandChild to lparam + [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or ] literal to mask + tvitem->tvins + InsertItem: Self IsHandle: ThisGrandChild + Incr: CurrentChild \ bump child count + ; + + : UpdateGrandInfo ( -- ) + CurrentChild IsParentItem: ThisGrandChild + Self IsParentTree: ThisGrandChild + currentname count SetName: ThisGrandChild + code-id isItemID: ThisGrandChild + source islinetext: ThisGrandChild + #linecount islinenumber: ThisGrandChild + markerhandle ismarkerhandle: ThisGrandChild + curfilename count isfilename: ThisGrandChild + AddGrandChildItem ; + + : AddNewGrandChild ( -- ) + GrandChildList @ max-hash-items >= abort" Sorry, too many references!" + New> CodeItem dup to ThisGrandChild + GrandChildList lcount cells+ ! + GrandChildList incr ; + + : DisposeGrandChildren ( -- ) \ this takes a little while if there are a lot of grans + GrandChildList lcount cells bounds + ?do i @ Dispose + cell +loop GrandChildList off ; + + : add-grandchild ( -- ) + _grand-id to code-id + in-definition? not + if bl word count ?dup \ likely it's an instance if a name follows + if currentname place + else drop + then + then + AddNewGrandChild + UpdateGrandInfo ; + + : init-hash-tables ( -- ) + BufferAddress to hash-table \ use this as it is available + hash-table hash-table-size + to hash-table-mirror + hash-table off + hash-table-mirror off ; + + : search-hash-table { hash-val -- addr flag } + hash-table lcount dup>r 1- 0max cells+ r> hash-val -lscan + ; + + : searchLists { str cnt -- } + new$ >r + str cnt r@ place + r@ count lower + r> count method-hash search-hash-table + if hash-table cell+ - \ calculate offset + hash-table-mirror cell+ + @ to CurrentChild + add-grandchild + else drop + then ; + :M SortParentLists: ( -- ) \ Sort the content of the lists *************** *** 298,312 **** ;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 -- ) --- 439,459 ---- ;M + \ Thursday, November 06 2008 - Lists being disposed but not their pointers. Fixed + + : DisposeThisList ( list -- ) + dup DisposeList \ dispose the list + Dispose ; \ then the object : DisposeLists ( -- ) MainList 0= ?exit ! CodeList DisposeThisList 0 to CodeList ! PrivateCodeList DisposeThisList 0 to PrivateCodeList ! GlobalDataList DisposeThisList 0 to GlobalDataList ! PrivateDataList DisposeThisList 0 to PrivateDataList ! MethodsList DisposeThisList 0 to MethodsList ! ClassesList DisposeThisList 0 to ClassesList ! Mainlist DisposeThisList 0 to Mainlist ! DisposeGrandChildren ! ; :M setname: ( addr cnt -- ) *************** *** 321,325 **** _Methods_ s" Methods" new> treelinked-list to MethodsList _classes_ s" Objects & Classes" new> treelinked-list to ClassesList ! ; :M Start: ( parent -- ) --- 468,472 ---- _Methods_ s" Methods" new> treelinked-list to MethodsList _classes_ s" Objects & Classes" new> treelinked-list to ClassesList ! ; :M Start: ( parent -- ) *************** *** 334,348 **** ;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 --- 481,541 ---- ;M + : ID$ ( -- addr cnt ) + ItemID: SelectedItem + case + _colon of s" Colon definition" endof + _code of s" Code definition" endof + _value of s" Value" endof + _variable of s" Variable" endof + _constant of s" Constant" endof + _method of s" Method" endof + _class of s" Class" endof + _object of s" Object" endof + _create of s" Create" endof + _int of s" Int" endof + _bytes of s" Bytes" endof + _short of s" Short" endof + _dint of s" Dint" endof + _byte of s" Byte" endof + _2value of s" Double value" endof + _fvariable of s" Float variable" endof + _fvalue of s" Float value" endof + _fconstant of s" Float constant" endof + _defer of s" Deferred word" endof + _setcommand of s" DoCommand vector" endof + _grand-id of s" References " new$ dup>r place + GetName$: [ ParentItem: SelectedItem ] + r@ +place + r> count + endof + s" " rot + endcase s" Type: " pad place + pad +place + #grands: SelectedItem ?dup + if s" with " pad +place + dup>r (.) pad +place + s" reference" pad +place + r> 1 > + if s" s" pad +place + then + then pad count ; + :M On_SelChanged: ( -- f ) lparamNew to SelectedItem ! ItemID: SelectedItem 0> \ filename selected ! if join$( s" File: " ! Filename: SelectedItem "to-pathend" ! s" , Line#: " ! LineNumber: SelectedItem (.) ! )join$ count SetText: lblInfo1 ! ID$ SetText: lblInFo2 ! auto-showfile ! else ItemID: SelectedItem 0< \ category selected ! if #items: SelectedItem (.) pad place ! s" entries" pad +place ! pad count ! else s" " \ root item ! then SetText: lblInfo1 s" " SetText: lblInfo2 ! then false ;M *************** *** 350,354 **** :M Clear: ( -- ) ! TVI_ROOT DeleteItem: Self drop DisposeLists CreateTree --- 543,548 ---- :M Clear: ( -- ) ! TVI_ROOT DeleteItem: Self drop ! GrandChildList off DisposeLists CreateTree *************** *** 356,359 **** --- 550,554 ---- parentclass off default-treename count treename place + init-hash-tables ;M *************** *** 394,397 **** --- 589,593 ---- : add-class { cid -- } + in-definition? ?exit in-class? ?exit bl word dup c@ 0= if drop exit then \ forget it! *************** *** 412,415 **** --- 608,628 ---- AddMethod: Self ; + : add-defer ( -- ) + \ is may be found in s" strings, typically found only in definitions. + \ But ['] <name> is <deferred word> wouldn't be found either! + in-definition? ?exit + bl word dup c@ 0= if drop exit then \ forget it! + count currentname place + _defer to code-id + in-class? + if +parent-class + AddPrivateCode: Self + else AddCode: Self + then ; + + max-path bytes ThisWord \ primarily to keep case of enum constants + \ some quoted string words + : skip-" ( -- ) + '"' parse 2drop ; : ?add-word ( a -- ) *************** *** 422,429 **** --- 635,646 ---- s" ;code" "of false to in-definition? EndOf s" :class" "of _class add-class EndOf + \ these next are for when navigating W32F source files + s" |class" "of _class add-class EndOF + s" |:" "of _colon add-code 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" is" "of add-defer EndOf s" ;m" "of false to in-definition? EndOf s" value" "of _value add-data EndOf *************** *** 449,460 **** 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 --- 666,687 ---- s" setcommand" "of lastword$ uppercase count currentname place \ any vector tables ! _setcommand to code-id data-add EndOF ! s" :noname" "of true to in-definition? EndOf ! abort$ count "of skip-" EndOf ! squote$ count "of skip-" EndOf ! dotquote$ count "of skip-" EndOf ! cquote$ count "of skip-" EndOF ! zquote$ count "of skip-" EndOF ! commaquote$ count "of skip-" EndOF ! zcommaquote$ count "of skip-" EndOf ! s" {" "of '}' parse 2drop EndOF ! in-enum? if drop ThisWord count currentname place _constant to code-id data-add false then dup ! if count 2dup lastword$ place \ save word ! searchLists false then *************** *** 476,480 **** : build-NavigatorTree ( -- ) ! bl word dup count lower dup c@ IF Case --- 703,707 ---- : build-NavigatorTree ( -- ) ! bl word dup count 2dup ThisWord place lower dup c@ IF Case *************** *** 482,485 **** --- 709,715 ---- s" //" "of \comment EndOf s" --" "of \comment EndOf + \ this next one causes some words to be missed when tracking, e.g the : in some sources, + \ so we simply skip the rest of the line + s" .(" "of \comment EndOF s" \s" "of -1 +Comment EndOf s" (" "of 1 +Comment EndOf *************** *** 505,509 **** "to-pathend" pad +place s" ..." pad +place ! pad count asciiz SetText: NavigatorBar ; :M TrackCode: ( fname cnt -- ) --- 735,739 ---- "to-pathend" pad +place s" ..." pad +place ! pad count SetText: lblInfo1 ; :M TrackCode: ( fname cnt -- ) *************** *** 534,538 **** SortParentLists: Self 0 to selecteditem ! z" " SetText: NavigatorBar ;M ;object --- 764,769 ---- SortParentLists: Self 0 to selecteditem ! s" " SetText: lblInfo1 ! ;M ;object *************** *** 572,585 **** 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 --- 803,823 ---- Handle: TabFont SetFont: btnGoto ! self Start: lblInfo1 ! Handle: TabFont SetFont: lblInfo1 ! ! self Start: lblInfo2 ! Handle: TabFont SetFont: lblInfo2 ! ;M :m On_Size: ( -- ) ! 0 25 Width Height 75 - Move: NavigatorTree 0 0 75 24 Move: btnTrack 77 0 75 24 Move: btnGoto + + 0 Height 50 - Width 24 Move: lblInfo1 + 0 Height 25 - Width 24 Move: lblInfo2 ;M *************** *** 588,593 **** ItemID: item 0 <= ?exit \ listname FileName: item OpenSource ! LineNumber: item 1- ! GotoLine: CurrentWindow SetFocus: CurrentWindow ; --- 826,830 ---- ItemID: item 0 <= ?exit \ listname FileName: item OpenSource ! LineNumber: item 1- GotoLine: CurrentWindow SetFocus: CurrentWindow ; *************** *** 597,601 **** :M WM_NOTIFY ( h m w l -- f ) dup GetNotifyWnd GetHandle: NavigatorTree <> if false exitm then ! Handle_Notify: NavigatorTree ;M :M Close: ( -- ) --- 834,841 ---- :M WM_NOTIFY ( h m w l -- f ) dup GetNotifyWnd GetHandle: NavigatorTree <> if false exitm then ! Handle_Notify: NavigatorTree ! goto-on-click? CurrentWindow 0<> and ! if Setfocus: CurrentWindow ! then ;M :M Close: ( -- ) *************** *** 606,610 **** ;Object ! : LibFile? ( a n - f ) "path-only" dup 7 - /string s" src\lib" caps-compare 0= ; --- 846,851 ---- ;Object ! : LibFile? ( a n - f ) ! pad place pad count "path-only" dup 7 - /string s" src\lib" istr= ; *************** *** 638,641 **** --- 879,883 ---- GetTabCount: OpenFilesTab 0> to open? Clear: NavigatorTree + s" " SetText: lblInfo2 \ clear this one control-key? open? and \ force tracking of opened files if control key pressed if Track-Opened-Files exit *************** *** 648,652 **** : ShowFile ( -- ) ! ShowFile: NavigatorWindow ; ' ShowFile SetFunc: btnGoto :Object ProjectWindow <Super Child-Window --- 890,904 ---- : ShowFile ( -- ) ! control-key? ! if goto-on-click? 0= dup to goto-on-click? \ toggle function ! if s" Auto Goto" ! else s" Goto" ! then SetText: btnGoto ! then ShowFile: NavigatorWindow ; ' ShowFile SetFunc: btnGoto ! ! : (auto-showfile) ( -- ) ! goto-on-click? ! if ShowFile ! then ; ' (auto-showfile) is auto-showfile :Object ProjectWindow <Super Child-Window |