Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Win32ForthIDE Main.f,1.63,1.64
|
From: Ezra B. <ezr...@us...> - 2009-05-10 03:56:35
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv1687/apps/Win32ForthIDE Modified Files: Main.f Log Message: Bug fixes . Couple minor enhancements. Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Main.f,v retrieving revision 1.63 retrieving revision 1.64 diff -C2 -d -r1.63 -r1.64 *** Main.f 19 Apr 2009 07:26:06 -0000 1.63 --- Main.f 10 May 2009 03:56:28 -0000 1.64 *************** *** 79,82 **** --- 79,89 ---- 2 constant VERT_SPLIT + Color: WHITE value back-color \ default font background color + Color: BLACK value fore-color \ default font color + Color: WHITE value caret-backcolor \ current line color + Color: LTGRAY value select-backcolor \ selection background color + Color: BLACK value select-forecolor \ selection font color + Color: BLACK value browse-forecolor \ browse mode foreground color + Color: LTGRAY value browse-backcolor \ browse mode background color defer Compile-File ' beep is Compile-File *************** *** 136,139 **** --- 143,151 ---- Font TabFont + : GetFileTabChild ( ndx -- child ) \ ndx must be valid + TCIF_PARAM IsMask: OpenFilesTab + GetTabInfo: OpenFilesTab + LParam: OpenFilesTab ; + : AddFileTab ( -- ) z" <Untitled>" IsPsztext: OpenFilesTab *************** *** 144,159 **** Resize: MainWindow ; : UpdateFileTab ( -- ) ! ActiveChild 0= ?exit ! GetHandle: OpenFilesTab Call IsWindow 0= ?exit ! \ GetFileName: ActiveChild count "TO-PATHEND" asciiz IsPsztext: OpenFilesTab ! \ TCIF_TEXT IsMask: OpenFilesTab ! \ GetSelectedTab: OpenFilesTab SetTabInfo: OpenFilesTab ! \ we have to refresh all tabs since for some reason the above doesn't work well ! GetTabCount: OpenFilesTab dup 0> ! if 1+ 0 ! do TCIF_PARAM IsMask: OpenFilesTab ! i GetTabInfo: OpenFilesTab ! Lparam: OpenFilesTab ?dup if dup GetFileName: [ ] count rot ActiveCoder <> \ we prefer the full name for this one --- 156,169 ---- Resize: MainWindow ; + : TabFile? ( -- n ) \ n=#open files | 0 + GetTabCount: OpenFilesTab dup 0> ?exit + drop 0 ; + : UpdateFileTab ( -- ) ! ActiveChild 0= ?exit ! Gethandle: OpenFilesTab Call IsWindow 0= ?exit ! TabFile? ?dup ! if 0 ! do i GetFileTabChild ?dup if dup GetFileName: [ ] count rot ActiveCoder <> \ we prefer the full name for this one *************** *** 161,182 **** then dup 0= if 2drop s" <Untitled>" ! then asciiz ! IsPsztext: OpenFilesTab TCIF_TEXT IsMask: OpenFilesTab i SetTabInfo: OpenFilesTab then loop - else drop then ; : OnTabChanged ( l obj-- ) 2drop ! TCIF_PARAM IsMask: OpenFilesTab ! GetSelectedTab: OpenFilesTab GetTabInfo: OpenFilesTab ! Lparam: OpenFilesTab OnSelect false ; ' OnTabChanged IsChangeFunc: OpenFilestab : ShowFileTab ( -- ) ! GetTabCount: OpenFilesTab dup 0> ! if 1+ 0 do TCIF_PARAM IsMask: OpenFilesTab i GetTabInfo: OpenFilesTab --- 171,189 ---- then dup 0= if 2drop s" <Untitled>" ! then asciiz IsPsztext: OpenFilesTab TCIF_TEXT IsMask: OpenFilesTab i SetTabInfo: OpenFilesTab then loop then ; : OnTabChanged ( l obj-- ) 2drop ! GetSelectedTab: OpenFilesTab GetFileTabChild ! OnSelect false ; ' OnTabChanged IsChangeFunc: OpenFilestab : ShowFileTab ( -- ) ! TabFile? ?dup ! if 0 do TCIF_PARAM IsMask: OpenFilesTab i GetTabInfo: OpenFilesTab *************** *** 185,203 **** then loop - else drop then ; : DeleteFileTab { ThisChild -- } ! TCIF_PARAM IsMask: OpenFilesTab ! GetTabCount: OpenFilesTab dup 0> ! if 1+ 0 ! do i GetTabInfo: OpenFilesTab ! Lparam: OpenFilesTab ThisChild = if i DeleteTab: OpenFilesTab leave then loop - else drop then ; : control-key? ( -- f ) \ console not available in IDE so ?control doesn't work VK_CONTROL Call GetKeyState 0x8000 and ; --- 192,260 ---- then loop then ; : DeleteFileTab { ThisChild -- } ! TabFile? ?dup ! if 0 ! do i GetFileTabChild ThisChild = if i DeleteTab: OpenFilesTab leave then loop then ; + 0 value tab-index \ tab which was right clicked + + : CloseTabFile ( ndx -- ) + GetFileTabChild dup ActiveChild = + if drop IDM_CLOSE DoCommand + else GetHandle: [ ] CloseChild: MainWindow + then update ; + + : CloseSelectedTabFile ( -- ) + tab-index CloseTabFile update ; + + + : CloseTabsRight ( -- ) + Begin tab-index 1+ GetTabCount: OpenfilesTab < + while tab-index 1+ CloseTabFile + Repeat ; + + : CloseTabsLeft ( -- ) + Begin -1 +to tab-index + tab-index 0 >= + While tab-index CloseTabFile + Repeat ; + + : CompileTabFile ( -- ) + tab-index GetFileTabChild >r + GetFileType: [ r@ ] FT_SOURCE = + if Compile: [ r@ ] + then r>drop ; + + + PopupBar TabPopup + + Popup "" + MenuItem "Close" CloseSelectedTabFile ; + MenuSeparator + :MenuItem mnucar "Close all files to right" CloseTabsRight ; + :MenuItem mnucal "Close all files to left" CloseTabsLeft ; + MenuSeparator + :MenuItem mnucmp "Compile" CompileTabFile ; + EndBar + + : check-menu-funcs ( -- ) + GetTabCount: OpenFilesTab 1- tab-index > Enable: mnucar + tab-index 0> Enable: mnucal + tab-index GetFileTabChild GetFileType: [ ] FT_SOURCE = Enable: mnucmp ; + + : Handle_TabRightClick { \ htinfo -- } + GetHandle: OpenFilesTab get-mouse-xy swap pad 2! + pad 0 TCM_HITTEST GetHandle: OpenFilesTab Call SendMessage + dup to tab-index -1 <> + if check-menu-funcs + GetHandle: Mainwindow dup get-mouse-xy rot Track: TabPopup + then ; + : control-key? ( -- f ) \ console not available in IDE so ?control doesn't work VK_CONTROL Call GetKeyState 0x8000 and ; *************** *** 641,644 **** --- 698,702 ---- show-form-tab \ show the form designer whether detached or not Adjust-Monitor + TabPopup SetPopupBar: self Update show-project-tab \ always default *************** *** 691,695 **** if w l Handle_Notify: ControlToolbar else r@ GetHandle: OpenFilesTab = ! if w l Handle_Notify: OpenFilesTab else false then --- 749,756 ---- if w l Handle_Notify: ControlToolbar else r@ GetHandle: OpenFilesTab = ! if l GetNotifyCode NM_RCLICK = ! if Handle_TabRightClick false ! else w l Handle_Notify: OpenFilesTab ! then else false then *************** *** 990,994 **** \ Window class for optional means of adding code to forms \ Allows the full power of the IDE editor to be used when adding code to forms ! :Class CodeChild <Super HyPerEditorChild max-path 2 + bytes FileName --- 1051,1055 ---- \ Window class for optional means of adding code to forms \ Allows the full power of the IDE editor to be used when adding code to forms ! :Class CodeChild <Super HyperEditorChild max-path 2 + bytes FileName *************** *** 1017,1024 **** CodeFlag case ! 1 of s" Global" endof ! 2 of s" Local" endof ! 3 of s" OnInit" endof ! 4 of GetName: CurrentControl endof s" " rot endcase --- 1078,1085 ---- CodeFlag case ! FLAG_GLOBAL of s" Global" endof ! FLAG_LOCAL of s" Local" endof ! FLAG_ONINIT of s" OnInit" endof ! FLAG_CODE of GetName: CurrentControl endof s" " rot endcase *************** *** 1033,1048 **** CodeFlag case ! 1 of GlobalCode: CurrentForm ! GetGlobalCursorPos: CurrentForm to pos ! endof ! 2 of LocalCode: CurrentForm ! GetLocalCursorPos: CurrentForm to pos ! endof ! 3 of OnInitCode: CurrentForm ! GetOnInitCursorPos: CurrentForm to pos ! endof ! 4 of ControlCode: CurrentControl ! GetCursorPos: CurrentControl to pos ! endof 0 to pos false swap endcase ( addr ) dup 0= --- 1094,1109 ---- CodeFlag case ! FLAG_GLOBAL of GlobalCode: CurrentForm ! GetGlobalCursorPos: CurrentForm to pos ! endof ! FLAG_LOCAL of LocalCode: CurrentForm ! GetLocalCursorPos: CurrentForm to pos ! endof ! FLAG_ONINIT of OnInitCode: CurrentForm ! GetOnInitCursorPos: CurrentForm to pos ! endof ! FLAG_CODE of ControlCode: CurrentControl ! GetCursorPos: CurrentControl to pos ! endof 0 to pos false swap endcase ( addr ) dup 0= *************** *** 1065,1080 **** CodeFlag case ! 1 of pos SetGlobalCursorPos: CurrentForm ! GlobalCode: CurrentForm ! endof ! 2 of pos SetLocalCursorPos: CurrentForm ! LocalCode: CurrentForm ! endof ! 3 of pos SetOnInitCursorPos: CurrentForm ! OnInitCode: CurrentForm ! endof ! 4 of pos SetCursorPos: CurrentControl ! ControlCode: CurrentControl ! endof false swap endcase ( addr ) ?dup --- 1126,1141 ---- CodeFlag case ! FLAG_GLOBAL of pos SetGlobalCursorPos: CurrentForm ! GlobalCode: CurrentForm ! endof ! FLAG_LOCAL of pos SetLocalCursorPos: CurrentForm ! LocalCode: CurrentForm ! endof ! FLAG_ONINIT of pos SetOnInitCursorPos: CurrentForm ! OnInitCode: CurrentForm ! endof ! FLAG_CODE of pos SetCursorPos: CurrentControl ! ControlCode: CurrentControl ! endof false swap endcase ( addr ) ?dup *************** *** 1104,1108 **** ;M ! :M On_Close: ( -- ) On_Close: super dup if 0 to ActiveCoder --- 1165,1169 ---- ;M ! :M On_Close: ( -- f ) On_Close: super dup if 0 to ActiveCoder |
