Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Win32ForthIDE FORMOBJECT.F, 1.6, 1.7 Main.f, 1.64, 1.65 ProjectWindow.f, 1.6, 1.7
|
From: Ezra B. <ezr...@us...> - 2010-02-01 01:43:59
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sfp-cvsdas-1.v30.ch3.sourceforge.com:/tmp/cvs-serv18355 Modified Files: FORMOBJECT.F Main.f ProjectWindow.f Log Message: Updates.EAB Index: ProjectWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ProjectWindow.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** ProjectWindow.f 21 May 2009 03:16:55 -0000 1.6 --- ProjectWindow.f 1 Feb 2010 01:43:50 -0000 1.7 *************** *** 753,759 **** \ 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 ( -- ) --- 753,759 ---- \ 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 ( -- ) *************** *** 921,927 **** 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 --- 921,925 ---- Clear: NavigatorTree GetTabCount: OpenFilesTab 1+ 0 ! do i GetFileTabChild dup to ThisFile if GetFileType: ThisFile FT_SOURCE = if GetFileName: ThisFile count TrackCode: NavigatorTree Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Main.f,v retrieving revision 1.64 retrieving revision 1.65 diff -C2 -d -r1.64 -r1.65 *** Main.f 10 May 2009 03:56:28 -0000 1.64 --- Main.f 1 Feb 2010 01:43:50 -0000 1.65 *************** *** 142,145 **** --- 142,149 ---- TCS_BUTTONS TCS_MULTILINE or TCS_FLATBUTTONS or AddStyle: OpenFilesTab Font TabFont + Font DefaultEditorFont + S" Fixedsys" SetFaceName: DefaultEditorFont + 9 SetHeight: DefaultEditorFont + DefaultEditorFont value EditorFont : GetFileTabChild ( ndx -- child ) \ ndx must be valid *************** *** 186,192 **** TabFile? ?dup if 0 ! do TCIF_PARAM IsMask: OpenFilesTab ! i GetTabInfo: OpenFilesTab ! Lparam: OpenFilesTab ActiveChild = if i SetSelectedTab: OpenFilesTab leave then --- 190,194 ---- TabFile? ?dup if 0 ! do i GetFileTabChild ActiveChild = if i SetSelectedTab: OpenFilesTab leave then *************** *** 229,233 **** tab-index GetFileTabChild >r GetFileType: [ r@ ] FT_SOURCE = ! if Compile: [ r@ ] then r>drop ; --- 231,237 ---- tab-index GetFileTabChild >r GetFileType: [ r@ ] FT_SOURCE = ! if SaveAllBeforeCompile? ! if IDM_SAVE_ALL DoCommand ! then Compile: [ r@ ] then r>drop ; *************** *** 249,258 **** 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 ; --- 253,266 ---- tab-index GetFileTabChild GetFileType: [ ] FT_SOURCE = Enable: mnucmp ; ! : OnTabButton? { \ htinfo -- f } \ was the mouse right clicked on a tab button?, f = -1 if no, tab index if yes ! 3 cells localalloc: htinfo ! GetHandle: OpenFilesTab get-mouse-xy swap htinfo 2! ! htinfo 0 TCM_HITTEST GetHandle: OpenFilesTab Call SendMessage \ -1 means it wasn't on a tab ! ; ! ! : Handle_TabRightClick ( -- ) ! OnTabButton? dup to tab-index -1 <> if check-menu-funcs ! GetHandle: Mainwindow dup get-mouse-xy rot Track: TabPopup then ; *************** *** 578,581 **** --- 586,592 ---- MonitorTop s>d (d.) s" MonitorTop" "SetDefault Detached? s>d (d.) s" Detached" "SetDefault + GetFaceName: EditorFont s" TextFont" "SetDefault + GetHeight: EditorFont + s>d (d.) s" TextFontSize" "SetDefault WindowState SIZE_RESTORED = *************** *** 640,643 **** --- 651,656 ---- s" MonitorTop" "GetDefaultValue if to MonitorTop else drop then s" Detached" "GetDefaultValue if to detached? else drop then + s" TextFont" "GetDefault -IF 2dup SetFaceName: EditorFont THEN 2drop + s" TextFontSize" "GetDefaultValue if SetHeight: EditorFont else drop then s" SearchText" "GetDefault -IF 2dup "CLIP" find-buf place THEN 2drop *************** *** 695,702 **** load-defaults self Start: OpenFilesTab \ start after mdiclient - Handle: TabFont SetFont: OpenFilesTab show-form-tab \ show the form designer whether detached or not Adjust-Monitor ! TabPopup SetPopupBar: self Update show-project-tab \ always default --- 708,714 ---- load-defaults self Start: OpenFilesTab \ start after mdiclient show-form-tab \ show the form designer whether detached or not Adjust-Monitor ! TabPopup SetPopupBar: self \ start the popup Update show-project-tab \ always default *************** *** 714,717 **** --- 726,735 ---- THEN ;M + :M WM_RBUTTONDOWN ( h m w l -- res ) + OnTabButton? -1 <> + if WM_RBUTTONDOWN WM: Super \ handle it normally + else 0 \ forget it + then ;M + :M WM_CLOSE ( h m w l -- res ) CloseAll: self *************** *** 824,827 **** --- 842,846 ---- caret-backcolor SetCaretBackColor: ChildParent Select-ForeColor Select-BackColor SetSelectionColor: ChildParent + EditorFont SetFont: ChildWindow \ tuck it here so splitter windows are also updated ; Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/FORMOBJECT.F,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** FORMOBJECT.F 10 Apr 2009 16:44:39 -0000 1.6 --- FORMOBJECT.F 1 Feb 2010 01:43:50 -0000 1.7 *************** *** 25,29 **** --- 25,31 ---- MenuItem "Save (.ff)" IDM_FORM_SAVE DoCommand ; MenuItem "Save &As" IDM_FORM_SaveAs DoCommand ; + MenuSeparator MenuItem "Compile (.frm)" IDM_FORM_WRITE DoCommand ; + :MenuItem mnu_tkey "Compile to exe" IDM_TURNKEY_FORM DoCommand ; MenuSeparator MenuItem "Add/Edit Code" ShowCodeEditorTab ; *************** *** 104,107 **** --- 106,113 ---- int firsttime? \ are we sizing for the first time? int locked? + int turnkeying? + int success? \ true if successful compile + create exe-ext ," _exe" \ form file with turnkey code e.g form1.frm_exe + MultistatusBar frmStatusbar *************** *** 997,1000 **** --- 1003,1007 ---- ?mnu_font else locked? Check: mnu_lock + GetSuperClass: ActiveForm DIALOG-CLASS = Enable: mnu_tkey FormPopup to CurrentPopup then h m w l WM_RBUTTONDOWN WM: Super *************** *** 1017,1025 **** 0 to OnInitCode max-codesize malloc to Globalcode ! GlobalCode max-codesize erase max-codesize malloc to LocalCode ! LocalCode max-codesize erase max-codesize malloc to OnInitCode ! OnInitCode max-codesize erase 0 to LocalCursorPos 0 to GlobalCursorPos --- 1024,1032 ---- 0 to OnInitCode max-codesize malloc to Globalcode ! GlobalCode off max-codesize malloc to LocalCode ! LocalCode off max-codesize malloc to OnInitCode ! OnInitCode off 0 to LocalCursorPos 0 to GlobalCursorPos *************** *** 1102,1105 **** --- 1109,1113 ---- true to firsttime? false to locked? + false to turnkeying? Init: self ;M *************** *** 1391,1395 **** #controls SetCount: self GetData: self Write: FormFile \ save header first ! if Close: FormFile exit \ exit if errorl then #Controls 1+ 1 ?do i SetThisControl --- 1399,1403 ---- #controls SetCount: self GetData: self Write: FormFile \ save header first ! if Close: FormFile exit \ exit if error then #Controls 1+ 1 ?do i SetThisControl *************** *** 1575,1579 **** : writeGroupStyle ( -- ) \ write WS_GROUP style if needed ! Group?: ThisControl GetType: ThisControl TypeRadioButton <> and if +crlf 2tabs s" WS_GROUP +Style: " append --- 1583,1587 ---- : writeGroupStyle ( -- ) \ write WS_GROUP style if needed ! Group?: ThisControl GetType: ThisControl TypeRadioButton <> and if +crlf 2tabs s" WS_GROUP +Style: " append *************** *** 1668,1671 **** --- 1676,1685 ---- then ; + : SearchLocalCode ( str cnt -- f ) \ search local code for str, return true if found + LocalCode zcount -trailing ?dup + if 2swap caps-search nip nip + else drop false + then ; + : writeGlobalCode ( -- ) \ outside of form GlobalCode zcount -trailing ?dup *************** *** 1879,1882 **** --- 1893,1897 ---- : writeWindowStyle ( -- ) + s" :M WindowStyle:" SearchLocalCode ?exit \ exits if you have written your own window style code ?write-child-style GetSuperClass: self DIALOG-CLASS <> ?exit \ don't write style for child windows or mdi dialogs *************** *** 1914,1930 **** : writeWM_COMMAND ( -- ) +crlf ! GetSuperClass: self MDIDIALOG-CLASS = if s" :M ON_COMMAND: ( h m w l -- res )" append&crlf else s" :M WM_COMMAND ( h m w l -- res )" append&crlf ! then ! 2tabs s" over LOWORD ( ID ) self \ object address on stack" append&crlf ! 2tabs s" WMCommand-Func ?dup \ must not be zero" append&crlf ! 2tabs s" if" append 1 +tabs s" execute" append&crlf ! 2tabs s" else" append 1 +tabs s" 2drop \ drop ID and object address" ! append&crlf 2tabs s" then" append 1 +tabs s" 0 ;M" append&crlf \ write function to set OnWMCommand +crlf s" :M SetCommand: ( cfa -- ) \ set WMCommand function" append&crlf 2tabs s" to WMCommand-Func" append&crlf ! 2tabs s" ;M" append&crlf ; : writeOnPaint ( -- ) --- 1929,1955 ---- : writeWM_COMMAND ( -- ) +crlf ! GetSuperClass: self MDIDIALOG-CLASS = dup>r if s" :M ON_COMMAND: ( h m w l -- res )" append&crlf else s" :M WM_COMMAND ( h m w l -- res )" append&crlf ! then r> 0= ! if 2tabs s" dup 0= \ id is from a menu if lparam is zero" append&crlf ! 2tabs s" if over LOWORD CurrentMenu if dup DoMenu: CurrentMenu then" append&crlf ! 2tabs s" CurrentPopup if dup DoMenu: CurrentPopup then drop" append&crlf ! 2tabs s" else over LOWORD ( ID ) self \ object address on stack" append&crlf ! 2tabs s" WMCommand-Func ?dup \ must not be zero" append&crlf ! 2tabs s" if execute" append&crlf ! 2tabs s" else 2drop \ drop ID and object address" append&crlf ! 2tabs s" then" append&crlf ! 2tabs s" then " append ! else 2tabs s" over LOWORD ( ID ) self \ object address on stack" append&crlf ! 2tabs s" WMCommand-Func ?dup \ must not be zero" append&crlf ! 2tabs s" if execute" append&crlf ! 2tabs s" else 2drop \ drop ID and object address" append&crlf ! 2tabs s" then " append ! then s" 0 ;M" append&crlf \ write function to set OnWMCommand +crlf s" :M SetCommand: ( cfa -- ) \ set WMCommand function" append&crlf 2tabs s" to WMCommand-Func" append&crlf ! 2tabs s" ;M" append&crlf ; : writeOnPaint ( -- ) *************** *** 1935,1938 **** --- 1960,1964 ---- : writeOnSize ( -- ) + s" :M On_Size:" SearchLocalCode ?exit \ exit if you have written your own sizing code with-statusbar not ?exit +crlf *************** *** 1977,1981 **** then then 2tabs s" \ Insert your code here, e.g delete fonts, any bitmaps etc." append&crlf ! 2tabs s" On_Done: super" append&crlf 2tabs s" ;M" append&crlf ; --- 2003,2009 ---- then then 2tabs s" \ Insert your code here, e.g delete fonts, any bitmaps etc." append&crlf ! turnkeying? ! if 2tabs s" 0 Call PostQuitMessage drop \ quit the application" append&crlf ! then 2tabs s" On_Done: super" append&crlf 2tabs s" ;M" append&crlf ; *************** *** 2016,2019 **** --- 2044,2064 ---- 2tabs s" ;M" append&crlf ; + : writeMain ( -- ) \ main routine for a turnkeyed form + turnkeying? not ?exit + +crlf + s" : Main ( -- )" append&crlf + 2tabs s" Start: " append frmName count append&crlf + 2tabs s" MessageLoop bye ;" append&crlf + +crlf s" &forthdir count &appdir place" append&crlf + s" ' Main turnkey " append frmName count append s" .exe" append&crlf + false to turnkeying? \ reset it + iconfile c@ \ do we have an icon file? + if s" Needs Resources.f" append&crlf \ load resources + s"append iconfile count append "append s" " append + \in-system-ok s"append join$( &appdir count frmName count s" .exe" )join$ count append "append + s" AddAppIcon" append&crlf + then s" 1 pause-seconds bye" append + ; + : startpushbutton ( -- ) writecommoncode *************** *** 2234,2238 **** writeOnSize WriteOnDone ! writeClosing ; :M GetBuffer: ( -- addr len ) --- 2279,2284 ---- writeOnSize WriteOnDone ! writeClosing ! WriteMain ; :M GetBuffer: ( -- addr len ) *************** *** 2303,2309 **** 2dup temp$ place s" .bak" temp$ +place ! temp$ count rename-file drop ; : WriteForm { flag \ file$ -- } \ flag is true if showing messages max-path LocalAlloc: file$ IsNewForm? --- 2349,2358 ---- 2dup temp$ place s" .bak" temp$ +place ! temp$ count delete-file drop \ delete any existing file first ! temp$ count rename-file drop \ before renaming ! ; : WriteForm { flag \ file$ -- } \ flag is true if showing messages + false to success? max-path LocalAlloc: file$ IsNewForm? *************** *** 2317,2322 **** if SetFocus: self OverWrite? 0= ?exit then ! then file$ count create-backup \ always create backup file ! GetBuffer: self nip \ do we have info? if file$ count SetName: FormFile Create: FormFile ?exit --- 2366,2373 ---- if SetFocus: self OverWrite? 0= ?exit then ! then turnkeying? ! if exe-ext count file$ +place \ differentiate a turnkey form from normal compiled form ! else file$ count create-backup \ create backup file ! then GetBuffer: self nip \ do we have info? if file$ count SetName: FormFile Create: FormFile ?exit *************** *** 2324,2327 **** --- 2375,2379 ---- Close: FormFile \ close first then ?exit \ exit on error + true to success? flag 0= ?exit join$( s" File " *************** *** 2342,2345 **** --- 2394,2403 ---- false WriteForm ;M + :M Turnkey: ( -- ) + true to turnkeying? + Compile: self success? + if join$( textfile exe-ext count )join$ count Compile-File + then ;M + ;Class |
