Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Dirk B. <db...@us...> - 2009-04-19 07:26:15
|
Update of /cvsroot/win32forth/win32forth In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv9372 Removed Files: Win32ForthIde.exe.manifest Log Message: Moved the manifest into the exe file. --- Win32ForthIde.exe.manifest DELETED --- |
|
From: Dirk B. <db...@us...> - 2009-04-19 07:26:14
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/res In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv9372/apps/Win32ForthIDE/res Added Files: Win32ForthIde.exe.manifest Win32ForthIde.ico Log Message: Moved the manifest into the exe file. --- NEW FILE: Win32ForthIde.ico --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Win32ForthIde.exe.manifest --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:56:17
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv17528/apps/Win32ForthIDE/Forms Modified Files: EdPreferences.ff EdPreferences.frm Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: EdPreferences.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/EdPreferences.frm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** EdPreferences.frm 8 Sep 2008 03:08:13 -0000 1.3 --- EdPreferences.frm 10 Apr 2009 16:56:09 -0000 1.4 *************** *** 147,171 **** self Start: btnForeground ! 28 30 100 26 Move: btnForeground Handle: Winfont SetFont: btnForeground s" ForeGround" SetText: btnForeground self Start: btnBackground ! 28 58 100 26 Move: btnBackground Handle: Winfont SetFont: btnBackground s" BackGround" SetText: btnBackground self Start: btnCurrentline ! 28 86 100 26 Move: btnCurrentline Handle: Winfont SetFont: btnCurrentline s" Current Line" SetText: btnCurrentline self Start: btnSelectFore ! 28 114 100 26 Move: btnSelectFore Handle: Winfont SetFont: btnSelectFore s" Select Foreground" SetText: btnSelectFore self Start: btnSelectBack ! 28 142 100 26 Move: btnSelectBack Handle: Winfont SetFont: btnSelectBack s" Select Background" SetText: btnSelectBack --- 147,171 ---- self Start: btnForeground ! 25 30 103 26 Move: btnForeground Handle: Winfont SetFont: btnForeground s" ForeGround" SetText: btnForeground self Start: btnBackground ! 25 58 103 26 Move: btnBackground Handle: Winfont SetFont: btnBackground s" BackGround" SetText: btnBackground self Start: btnCurrentline ! 25 86 103 26 Move: btnCurrentline Handle: Winfont SetFont: btnCurrentline s" Current Line" SetText: btnCurrentline self Start: btnSelectFore ! 25 114 103 26 Move: btnSelectFore Handle: Winfont SetFont: btnSelectFore s" Select Foreground" SetText: btnSelectFore self Start: btnSelectBack ! 25 142 103 26 Move: btnSelectBack Handle: Winfont SetFont: btnSelectBack s" Select Background" SetText: btnSelectBack *************** *** 212,221 **** self Start: btnBrowseFore ! 28 170 100 26 Move: btnBrowseFore Handle: Winfont SetFont: btnBrowseFore s" Browse Foreground" SetText: btnBrowseFore self Start: btnBrowseBack ! 28 198 100 26 Move: btnBrowseBack Handle: Winfont SetFont: btnBrowseBack s" Browse Background" SetText: btnBrowseBack --- 212,221 ---- self Start: btnBrowseFore ! 25 170 103 26 Move: btnBrowseFore Handle: Winfont SetFont: btnBrowseFore s" Browse Foreground" SetText: btnBrowseFore self Start: btnBrowseBack ! 25 198 103 26 Move: btnBrowseBack Handle: Winfont SetFont: btnBrowseBack s" Browse Background" SetText: btnBrowseBack Index: EdPreferences.ff =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/EdPreferences.ff,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 Binary files /tmp/cvsARBP5N and /tmp/cvsxCsjyT differ |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:54:29
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv17441/apps/Win32ForthIDE/Forms Modified Files: CONTROLPROPERTY.ff CONTROLPROPERTY.frm Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: CONTROLPROPERTY.ff =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/CONTROLPROPERTY.ff,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsapyerf and /tmp/cvsZbPbB6 differ Index: CONTROLPROPERTY.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/CONTROLPROPERTY.frm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** CONTROLPROPERTY.frm 28 Apr 2008 05:13:37 -0000 1.1 --- CONTROLPROPERTY.frm 10 Apr 2009 16:54:26 -0000 1.2 *************** *** 21,24 **** --- 21,26 ---- PushButton btnPrevious PushButton btnNext + ComboListBox cmblstIDs + PushButton btnChangeFont :Object frmEditProperties <Super Child-Window *************** *** 38,47 **** Label lblTooltip Label lblBitmap :M ClassInit: ( -- ) ClassInit: super +dialoglist \ allow handling of dialog messages ! 414 to id \ set child id, changeable ! \ Insert your code here ;M --- 40,51 ---- Label lblTooltip Label lblBitmap + Label lblIDs + :M ClassInit: ( -- ) ClassInit: super +dialoglist \ allow handling of dialog messages ! 672 to id \ set child id, changeable ! \ Insert your code here, e.g initialize variables, values etc. ;M *************** *** 66,77 **** :M StartSize: ( -- width height ) ! 258 259 ;M :M Close: ( -- ) ! \ Insert your code here Close: super ;M :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont --- 70,92 ---- :M StartSize: ( -- width height ) ! 255 305 ;M :M Close: ( -- ) ! \ Insert your code here, e.g any data entered in form that needs to be saved Close: super ;M + :M WM_COMMAND ( h m w l -- res ) + over LOWORD ( ID ) self \ object address on stack + WMCommand-Func ?dup \ must not be zero + if execute + else 2drop \ drop ID and object address + then 0 ;M + + :M SetCommand: ( cfa -- ) \ set WMCommand function + to WMCommand-Func + ;M + :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont *************** *** 90,96 **** self Start: grpControls ! 8 201 141 43 Move: grpControls Handle: Winfont SetFont: grpControls - BS_CENTER +Style: grpControls s" Control" SetText: grpControls --- 105,110 ---- self Start: grpControls ! 7 219 116 42 Move: grpControls Handle: Winfont SetFont: grpControls s" Control" SetText: grpControls *************** *** 149,152 **** --- 163,172 ---- s" Bitmap:" SetText: lblBitmap + self Start: lblIDs + 126 235 34 20 Move: lblIDs + Handle: Winfont SetFont: lblIDs + SS_RIGHT +Style: lblIDs + s" SetID:" SetText: lblIDs + self Start: txtName 44 3 175 17 Move: txtName *************** *** 235,239 **** self Start: btnPrevious ! 17 217 49 20 Move: btnPrevious WS_GROUP +Style: btnPrevious Handle: Winfont SetFont: btnPrevious --- 255,259 ---- self Start: btnPrevious ! 17 235 49 20 Move: btnPrevious WS_GROUP +Style: btnPrevious Handle: Winfont SetFont: btnPrevious *************** *** 242,260 **** self Start: btnNext ! 90 217 49 20 Move: btnNext Handle: Winfont SetFont: btnNext s" &Next" SetText: btnNext ! ;M ! :M WM_COMMAND ( h m w l -- res ) ! over LOWORD ( ID ) self \ object address on stack ! WMCommand-Func ?dup \ must not be zero ! if execute ! else 2drop \ drop ID and object address ! then 0 ;M - :M SetCommand: ( cfa -- ) \ set WMCommand function - to WMCommand-Func ;M --- 262,278 ---- self Start: btnNext ! 68 235 49 20 Move: btnNext Handle: Winfont SetFont: btnNext s" &Next" SetText: btnNext ! self Start: cmblstIDs ! 161 233 86 20 Move: cmblstIDs ! Handle: Winfont SetFont: cmblstIDs ! self Start: btnChangeFont ! 18 270 66 20 Move: btnChangeFont ! Handle: Winfont SetFont: btnChangeFont ! s" Change Font" SetText: btnChangeFont ;M *************** *** 265,269 **** :M On_Done: ( -- ) Delete: WinFont ! \ Insert your code here On_Done: super ;M --- 283,287 ---- :M On_Done: ( -- ) Delete: WinFont ! \ Insert your code here, e.g delete fonts, any bitmaps etc. On_Done: super ;M |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:52:15
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv17297/apps/Win32ForthIDE/Forms Modified Files: FORMPROPERTY.ff FORMPROPERTY.frm TabPropertyWindow.ff TabPropertyWindow.frm Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: TabPropertyWindow.ff =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/TabPropertyWindow.ff,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsSjgJya and /tmp/cvsEbNEDv differ Index: FORMPROPERTY.ff =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/FORMPROPERTY.ff,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvslmnJXa and /tmp/cvs6Lpp3v differ Index: TabPropertyWindow.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/TabPropertyWindow.frm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TabPropertyWindow.frm 28 Apr 2008 05:13:40 -0000 1.1 --- TabPropertyWindow.frm 10 Apr 2009 16:52:11 -0000 1.2 *************** *** 3,42 **** ! :Object frmPropertiesWindow <Super DialogWindow Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color - 720 70 2value XYPos \ save screen location of form TabControl TabProperties \ Coordinates and dimensions for btnApply 22 value btnApplyX ! 287 value btnApplyY 108 value btnApplyW 40 value btnApplyH \ Coordinates and dimensions for btnClose 132 value btnCloseX ! 287 value btnCloseY 108 value btnCloseW 40 value btnCloseH :M ClassInit: ( -- ) ClassInit: super ! \ Insert your code here ! ;M ! ! :M WindowStyle: ( -- style ) ! WS_POPUPWINDOW WS_DLGFRAME or ;M ! \ if this form is a modal form a non-zero parent must be set ! :M ParentWindow: ( -- hwndparent | 0 if no parent ) ! hWndParent ! ;M ! :M SetParentWindow: ( hwndparent -- ) \ set owner window ! to hWndParent ! ;M :M WindowTitle: ( -- ztitle ) --- 3,37 ---- ! :Object frmPropertiesWindow <Super Child-Window Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color TabControl TabProperties \ Coordinates and dimensions for btnApply 22 value btnApplyX ! 343 value btnApplyY 108 value btnApplyW 40 value btnApplyH \ Coordinates and dimensions for btnClose 132 value btnCloseX ! 343 value btnCloseY 108 value btnCloseW 40 value btnCloseH + :M ClassInit: ( -- ) ClassInit: super ! +dialoglist \ allow handling of dialog messages ! 677 to id \ set child id, changeable ! \ Insert your code here, e.g initialize variables, values etc. ;M ! :M Display: ( -- ) \ unhide the child window ! SW_SHOWNORMAL Show: self ;M ! :M Hide: ( -- ) \ hide the...aughhh but you know that! ! SW_HIDE Show: self ;M :M WindowTitle: ( -- ztitle ) *************** *** 45,65 **** :M StartSize: ( -- width height ) ! 261 333 ! ;M ! ! :M StartPos: ( -- x y ) ! XYPos ;M :M WM_NOTIFY ( h m w l -- f ) ! \ if this form has more than one tab control this handler will need to be modified Handle_Notify: TabProperties ;M :M Close: ( -- ) ! \ Insert your code here Close: super ;M :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont --- 40,67 ---- :M StartSize: ( -- width height ) ! 265 389 ;M :M WM_NOTIFY ( h m w l -- f ) ! \ N.B if this form has more than one tab control this handler will need to be modified Handle_Notify: TabProperties ;M :M Close: ( -- ) ! \ Insert your code here, e.g any data entered in form that needs to be saved Close: super ;M + :M WM_COMMAND ( h m w l -- res ) + over LOWORD ( ID ) self \ object address on stack + WMCommand-Func ?dup \ must not be zero + if execute + else 2drop \ drop ID and object address + then 0 ;M + + :M SetCommand: ( cfa -- ) \ set WMCommand function + to WMCommand-Func + ;M + :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont *************** *** 72,91 **** self Start: TabProperties ! 4 3 252 276 Move: TabProperties Handle: Winfont SetFont: TabProperties ;M - :M WM_COMMAND ( h m w l -- res ) - over LOWORD ( ID ) self \ object address on stack - WMCommand-Func ?dup \ must not be zero - if execute - else 2drop \ drop ID and object address - then 0 ;M - - :M SetCommand: ( cfa -- ) \ set WMCommand function - to WMCommand-Func - ;M - :M On_Paint: ( -- ) 0 0 GetSize: self Addr: FrmColor FillArea: dc --- 74,82 ---- self Start: TabProperties ! 4 3 258 335 Move: TabProperties Handle: Winfont SetFont: TabProperties ;M :M On_Paint: ( -- ) 0 0 GetSize: self Addr: FrmColor FillArea: dc *************** *** 94,99 **** :M On_Done: ( -- ) Delete: WinFont ! originx originy 2to XYPos ! \ Insert your code here On_Done: super ;M --- 85,89 ---- :M On_Done: ( -- ) Delete: WinFont ! \ Insert your code here, e.g delete fonts, any bitmaps etc. On_Done: super ;M Index: FORMPROPERTY.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/FORMPROPERTY.frm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FORMPROPERTY.frm 28 Apr 2008 05:13:39 -0000 1.1 --- FORMPROPERTY.frm 10 Apr 2009 16:52:11 -0000 1.2 *************** *** 31,39 **** RadioButton radMdiDialogWindow :M ClassInit: ( -- ) ClassInit: super +dialoglist \ allow handling of dialog messages ! 415 to id \ set child id, changeable ! \ Insert your code here ;M --- 31,40 ---- RadioButton radMdiDialogWindow + :M ClassInit: ( -- ) ClassInit: super +dialoglist \ allow handling of dialog messages ! 719 to id \ set child id, changeable ! \ Insert your code here, e.g initialize variables, values etc. ;M *************** *** 44,56 **** SW_HIDE Show: self ;M - :M WindowStyle: ( -- style ) - WS_CHILD - ;M - - :M Start: ( Parent -- ) - to parent - register-child-window drop - create-child-window to hWnd ;M - :M WindowTitle: ( -- ztitle ) z" Edit Form Properties" --- 45,48 ---- *************** *** 58,69 **** :M StartSize: ( -- width height ) ! 237 268 ;M :M Close: ( -- ) ! \ Insert your code here Close: super ;M :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont --- 50,72 ---- :M StartSize: ( -- width height ) ! 238 303 ;M :M Close: ( -- ) ! \ Insert your code here, e.g any data entered in form that needs to be saved Close: super ;M + :M WM_COMMAND ( h m w l -- res ) + over LOWORD ( ID ) self \ object address on stack + WMCommand-Func ?dup \ must not be zero + if execute + else 2drop \ drop ID and object address + then 0 ;M + + :M SetCommand: ( cfa -- ) \ set WMCommand function + to WMCommand-Func + ;M + :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont *************** *** 76,80 **** self Start: grpOptions ! 16 99 216 58 Move: grpOptions Handle: Winfont SetFont: grpOptions s" Options" SetText: grpOptions --- 79,83 ---- self Start: grpOptions ! 15 99 216 58 Move: grpOptions Handle: Winfont SetFont: grpOptions s" Options" SetText: grpOptions *************** *** 194,208 **** ;M - :M WM_COMMAND ( h m w l -- res ) - over LOWORD ( ID ) self \ object address on stack - WMCommand-Func ?dup \ must not be zero - if execute - else 2drop \ drop ID and object address - then 0 ;M - - :M SetCommand: ( cfa -- ) \ set WMCommand function - to WMCommand-Func - ;M - :M On_Paint: ( -- ) 0 0 GetSize: self Addr: FrmColor FillArea: dc --- 197,200 ---- *************** *** 211,215 **** :M On_Done: ( -- ) Delete: WinFont ! \ Insert your code here On_Done: super ;M --- 203,207 ---- :M On_Done: ( -- ) Delete: WinFont ! \ Insert your code here, e.g delete fonts, any bitmaps etc. On_Done: super ;M |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:51:18
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv17256/apps/Win32ForthIDE Modified Files: Main.f Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Main.f,v retrieving revision 1.61 retrieving revision 1.62 diff -C2 -d -r1.61 -r1.62 *** Main.f 21 Dec 2008 12:05:52 -0000 1.61 --- Main.f 10 Apr 2009 16:51:09 -0000 1.62 *************** *** 18,22 **** only forth also editor definitions \ put all words into the EDITOR vocabulary ! true value sysgen s" apps\win32forthIDE" "fpath+ --- 18,22 ---- only forth also editor definitions \ put all words into the EDITOR vocabulary ! true value sysgen s" apps\win32forthIDE" "fpath+ *************** *** 45,49 **** 0 value TheFormBar \ address of toolbar for form designer 0 value ActiveForm \ current form ! 0 value FormList \ pointer to list of open forms ReadFile ViewerFile --- 45,50 ---- 0 value TheFormBar \ address of toolbar for form designer 0 value ActiveForm \ current form ! 0 value FormList \ pointer to list of open forms ! 0 value ActiveCoder \ the MDI child window used for editing form code ReadFile ViewerFile *************** *** 145,149 **** : UpdateFileTab ( -- ) ActiveChild 0= ?exit ! gethandle: openfilestab call IsWindow 0= ?exit \ GetFileName: ActiveChild count "TO-PATHEND" asciiz IsPsztext: OpenFilesTab \ TCIF_TEXT IsMask: OpenFilesTab --- 146,150 ---- : UpdateFileTab ( -- ) ActiveChild 0= ?exit ! GetHandle: OpenFilesTab Call IsWindow 0= ?exit \ GetFileName: ActiveChild count "TO-PATHEND" asciiz IsPsztext: OpenFilesTab \ TCIF_TEXT IsMask: OpenFilesTab *************** *** 155,160 **** i GetTabInfo: OpenFilesTab Lparam: OpenFilesTab ?dup ! if GetFileName: [ ] ! count "TO-PATHEND" dup 0= if 2drop s" <Untitled>" then asciiz --- 156,163 ---- i GetTabInfo: OpenFilesTab Lparam: OpenFilesTab ?dup ! if dup GetFileName: [ ] count ! rot ActiveCoder <> \ we prefer the full name for this one ! if "TO-PATHEND" ! then dup 0= if 2drop s" <Untitled>" then asciiz *************** *** 985,988 **** --- 988,1136 ---- ;Class + \ 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 + 0 value CodeFlag + 0 value CurrentForm + 0 value CurrentControl + + + :M GetFileName: ( -- addr ) + FileName ;M + + :M SetFileName: ( addr len -- ) + FileName place FileName +null + UpdateFileName: super + ;M + + :M SetWindowTitle: ( -- ) + GetFileName: self count SetText: super + ;M + + : UpdateName ( -- ) + join$( + s" Code:" + FormName: CurrentForm count + s" ." + 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 + )join$ count SetFileName: self SetWindowTitle: self ; + + :M Refresh: ( flag -- ) + { \ pos -- } + to CodeFlag + ActiveForm to CurrentForm + ActiveControl: ActiveForm to CurrentControl + CodeFlag FLAG_CODE = CurrentControl 0= and ?exitm + 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= + if drop pad dup off + then dup SetText: ChildWindow Highlight-Code + pos GotoPos: ChildWindow \ return to last editing position + SetSavePoint: ChildWindow \ mark as not modified yet + UpdateName Update \ and update + self to ActiveChild + ShowFileTab + ;M + + :M SaveCode: { \ pos -- } + \ some error checking, just in case the unexpected or unusual happens + GetModify: ChildWindow 0= ?exitm + CurrentForm 0= ?exitm + GetHandle: CurrentForm Call IsWindow 0= ?exitm + CodeFlag FLAG_CODE = CurrentControl 0= and ?exitm + GetCurrentPos: ChildWindow to pos \ we will save the last editing position so we can return to it + 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 + if GetTextLength: ChildWindow 1+ GetText: ChildWindow + SetSavePoint: ChildWindow + Update + IsModified: CurrentForm + RefreshCodeWindow + then ;M + + \ Override the following + :M SaveFile: ( -- ) + SaveCode: self ;M + + :M SaveFileAs: ( -- ) + SaveCode: self ;M + + :M SaveBeforeCloseing: ( -- ) + SaveCode: self ;M + + :M Start: ( parent -- ) + 0 FileName ! + Start: super + self to ActiveCoder + RefreshColors + false to CodeFlag + ;M + + :M On_Close: ( -- ) + On_Close: super dup + if 0 to ActiveCoder + false to show-code? \ reset by closing window + UpdateStatusBar + EnableToolbar + then ;M + + :M On_Command: { ncode id -- res } + id GetId: ChildWindow = + if ncode + case SCEN_KILLFOCUS of SaveCode: Self endof \ autosave + endcase + then ;M + \ + :M WM_COMMAND ( hwnd msg wparam lparam -- res ) + over HIWORD ( notification code ) rot LOWORD ( ID ) 2>r + WM_COMMAND WM: Super + 2r> On_Command: Self + ;M + + ;Class + + : NewCodeWnd ( -- ) \ open a new child window for adding code to forms + ActiveCoder 0= + if New> CodeChild to ActiveChild + MDIClientWindow: Frame Start: ActiveChild + then GetHandle: ActiveCoder Activate: Frame ; ' NewCodeWnd is NewCodeWindow + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ some helper words *************** *** 1015,1019 **** : NewRemoteChild ( -- ) \ open a new child window used to open a file \ remotely by the Win32Forth console ! ActiveRemote 0= if NewEditWnd ActiveChild to ActiveRemote then GetHandle: ActiveRemote Activate: Frame ; --- 1163,1169 ---- : NewRemoteChild ( -- ) \ open a new child window used to open a file \ remotely by the Win32Forth console ! \ Tuesday, November 11 2008 - always open a new child for active remote, prevents ! \ a compile error from replacing an active file - EAB ! true \ ActiveRemote 0= if NewEditWnd ActiveChild to ActiveRemote then GetHandle: ActiveRemote Activate: Frame ; *************** *** 1199,1203 **** strip-cmdline ! 2dup IsProjectFile? if (open-project) else --- 1349,1355 ---- strip-cmdline ! 2dup OpenedByExtension? ! if 2drop exit ! then 2dup IsProjectFile? if (open-project) else |
|
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 |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:46:30
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv16955/apps/Win32ForthIDE Modified Files: FORMPROPERTY.F ScintillaMDI.f Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: FORMPROPERTY.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/FORMPROPERTY.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** FORMPROPERTY.F 4 May 2008 18:13:25 -0000 1.2 --- FORMPROPERTY.F 10 Apr 2009 16:46:26 -0000 1.3 *************** *** 2,11 **** load-bitmap savebmp1 "save1.bmp" load-bitmap savebmp2 "save2.bmp" ! load-bitmap stopbmp1 "stop1.bmp" ! load-bitmap stopbmp2 "stop2.bmp" ! ! \ The following not working from within the TabControl form, just a litle help info ! \ s" When a control or form is selected display its property" BInfo: chkAutoProperty place ! \ s" Add only one selected control when form is clicked" BInfo: chkSingleControl place : GetBitmap ( -- ) --- 2,7 ---- load-bitmap savebmp1 "save1.bmp" load-bitmap savebmp2 "save2.bmp" ! \ load-bitmap stopbmp1 "stop1.bmp" ! \ load-bitmap stopbmp2 "stop2.bmp" : GetBitmap ( -- ) *************** *** 54,57 **** --- 50,59 ---- then Check: chkSpinner ; + : Fill-IDList ( -- ) + Clear: cmblstIDs + #ids 0 + do i GetID$ asciiz AddStringTo: cmblstIDs + loop ID: eActiveControl check-id SetSelection: cmblstIDs ; + : LoadProperties ( -- ) GetName: eActiveControl SetText: txtName *************** *** 66,69 **** --- 68,73 ---- Global?: eActiveControl Check: chkGlobal ?EnableSpinner + Fill-IDList + GetType: eActiveControl font-type? Enable: btnChangeFont GetType: eActiveControl dup TypeBitmapButton = swap TypeStaticBitmap = or *************** *** 75,79 **** true Enable: txtBitmap true Enable: btnBrowse ! else \ first clear any previous orientation selection UnCheckButton: radLeft UnCheckButton: radCenter --- 79,83 ---- true Enable: txtBitmap true Enable: btnBrowse ! else \ first clear any previous orientation sel ection UnCheckButton: radLeft UnCheckButton: radCenter *************** *** 97,102 **** eActiveForm ?FormNumber 0= ?exit \ form no longer exists eActiveControl ?ControlNumber: eActiveForm 0= ?exit - Origin: eActiveControl to y to x - Dimensions: eActiveControl to h to w GetText: txtName SetName: eActiveControl GetText: txtCaption SetTitle: eActiveControl --- 101,104 ---- *************** *** 111,115 **** GetType: eActiveControl TypeTextBox = if IsButtonChecked?: chkSpinner IsSpinner: eActiveControl ! then \ justification IsTypeButton? --- 113,117 ---- GetType: eActiveControl TypeTextBox = if IsButtonChecked?: chkSpinner IsSpinner: eActiveControl ! then GetCurrent: cmblstIDs IsID: eActiveControl \ justification IsTypeButton? *************** *** 130,141 **** Update: eActiveControl \ everything UpdateStatus: eActiveForm \ at this time ! Paint: eActiveForm ; \ and refresh display : initload ( -- ) ActiveControl: ActiveForm to eActiveControl ActiveForm to eActiveForm ! eActiveControl 0= ?exit ! LoadProperties \ initialize form ! ; : doPrevious ( -- ) \ cycle through controls in current form --- 132,157 ---- Update: eActiveControl \ everything UpdateStatus: eActiveForm \ at this time ! Paint: eActiveForm \ and refresh display ! doUpdate ; ! ! : ClearControlProperties ( -- ) ! s" No control selected!" SetText: txtName ! s" " ! 2dup SetText: txtCaption ! 2dup SetText: txtTooltip ! SetText: txtBitmap ! Disable: btnChangeFont ; : initload ( -- ) + ActiveForm 0= ?exit ActiveControl: ActiveForm to eActiveControl ActiveForm to eActiveForm ! eActiveControl ! if LoadProperties ! else ClearControlProperties ! then RefreshCodeWindow ! eActiveControl ! if ControlCode: eActiveControl Highlight-Code ! then ; : doPrevious ( -- ) \ cycle through controls in current form *************** *** 171,174 **** --- 187,193 ---- UpdatePropertyWindow ; + : doEditCode ( -- ) + FLAG_CODE RefreshActiveCoder ; + : PropertyFunc ( h m w l id obj -- h m w l ) { cid obj -- } *************** *** 180,188 **** GetID: btnNext of doNext endof ! IDCANCEL of Close: obj endof endcase ; :Noname ( -- ) ! frmEditProperties.hwnd 0= ?exit \ window is not open \ Remove comment from the following if you will need to save the properties first \ If you do and you are just browsing controls the form(s) will be marked as --- 199,209 ---- GetID: btnNext of doNext endof ! GetID: btnChangeFont ! of GetUserFont: eActiveControl ! endof endcase ; :Noname ( -- ) ! \ GetHandle: frmEditProperties 0= ?exit \ window is not open \ Remove comment from the following if you will need to save the properties first \ If you do and you are just browsing controls the form(s) will be marked as *************** *** 195,200 **** :Object frmEditForm <Super frmEditFormProperties :M LoadProperties: ( -- ) ! FormName: ActiveForm count SetText: txtName FormTitle: ActiveForm count SetText: txtTitle Origin: ActiveForm SetValue: spnYpos --- 216,240 ---- :Object frmEditForm <Super frmEditFormProperties + :M ClearFormProperties: ( -- ) + s" No form opened!" SetText: txtName + s" " SetText: txtTitle + 1 SetValue: spnXpos + 1 SetValue: spnYpos + 1 SetValue: spnWidth + 1 SetValue: spnHeight + false + dup Check: chkModal + dup Check: chkSave + dup Check: chkChildState + dup Check: chkStatusBar + dup Check: radChildWindow + dup Check: radMDIDialogWindow + Check: radDialogWindow + ;M + :M LoadProperties: ( -- ) ! ActiveForm 0= ! if ClearFormProperties: self exitm ! then FormName: ActiveForm count SetText: txtName FormTitle: ActiveForm count SetText: txtTitle Origin: ActiveForm SetValue: spnYpos *************** *** 222,228 **** UnCheckButton: radChildWindow false Enable: chkChildState ! endcase ;M :M SaveProperties: { \ x y w h -- } Origin: ActiveForm to y to x Dimensions: ActiveForm to h to w --- 262,270 ---- UnCheckButton: radChildWindow false Enable: chkChildState ! endcase ! ;M :M SaveProperties: { \ x y w h -- } + ActiveForm 0= ?exitm Origin: ActiveForm to y to x Dimensions: ActiveForm to h to w *************** *** 280,283 **** --- 322,330 ---- imagebutton btnclose + :M Clear: ( -- ) + ClearFormProperties: frmEditForm + ClearControlProperties + ;M + : ontab { l obj -- } GetSelectedTab: obj *************** *** 292,298 **** Hide: frmEditForm Display: frmAction endof ! endcase LoadProperties: frmEditForm ; : ?apply ( -- ) Locked?: ActiveForm ?exitm GetSelectedTab: TabProperties --- 339,347 ---- Hide: frmEditForm Display: frmAction endof ! endcase LoadProperties: frmEditForm ! ; : ?apply ( -- ) + ActiveForm 0= ?exit Locked?: ActiveForm ?exitm GetSelectedTab: TabProperties *************** *** 312,316 **** case IDOK of ?apply endof - IDCANCEL of Close: self endof endcase ; --- 361,364 ---- *************** *** 320,329 **** IDCANCEL SetID: btnClose ! TCS_BUTTONS TCS_FLATBUTTONS or AddStyle: TabProperties On_Init: Super self Start: btnApply ! btnApplyX btnApplyY btnApplyW btnApplyH Move: btnApply savebmp2 usebitmap map-3DColors savebmp2 setimage: btnapply \ normal displayed image --- 368,377 ---- IDCANCEL SetID: btnClose ! ( TCS_BUTTONS ) TCS_FLATBUTTONS ( or ) AddStyle: TabProperties On_Init: Super self Start: btnApply ! 4 ( btnApplyX ) btnApplyY btnApplyW btnApplyH Move: btnApply savebmp2 usebitmap map-3DColors savebmp2 setimage: btnapply \ normal displayed image *************** *** 333,344 **** Handle: WinFont SetFont: btnApply ! self Start: btnClose ! btnCloseX btnCloseY btnCloseW btnCloseH Move: btnClose ! stopbmp2 usebitmap map-3DColors ! stopbmp2 setimage: btnclose \ normal displayed image ! stopbmp1 usebitmap map-3DColors \ image to display when hovering mouse ! stopbmp1 SetImage#2: btnClose ! s" Close" SetText: btnClose ! Handle: WinFont SetFont: btnClose --- 381,392 ---- Handle: WinFont SetFont: btnApply ! \ self Start: btnClose ! \ btnCloseX btnCloseY btnCloseW btnCloseH Move: btnClose ! \ stopbmp2 usebitmap map-3DColors ! \ stopbmp2 setimage: btnclose \ normal displayed image ! \ stopbmp1 usebitmap map-3DColors \ image to display when hovering mouse ! \ stopbmp1 SetImage#2: btnClose ! \ s" Close" SetText: btnClose ! \ Handle: WinFont SetFont: btnClose *************** *** 369,372 **** --- 417,422 ---- ClientSize: TabProperties 2over d- Move: frmAction + Clear: self + ;M *************** *** 376,418 **** ;M - :M ClassInit: ( -- ) - ClassInit: Super - self link-formwindow - ;M - - :M WindowStyle: ( -- style ) - WindowStyle: Super - WS_MINIMIZEBOX or \ allow moving out of the way - ;M - ;Object : UpdateProperties++ ( -- ) ! GetHandle: frmProperties++ 0= ?exit ! LoadProperties: frmEditForm \ and update ! ; : FormProperty ( -- ) \ edit form properties ActiveForm 0= ?exit ! GetHandle: MainWindow SetParentWindow: frmProperties++ ! Start: frmProperties++ ! 0 ShowTab: frmProperties++ \ show the form tab UpdateProperties++ ! SetFocus: ActiveForm ; IDM_FORM_FORMPROPERTY SetCommand : ControlProperty ( -- ) \ edit control properties ActiveForm 0= ?exit ! GetHandle: MainWindow SetParentWindow: frmProperties++ ! Start: frmProperties++ ! 1 ShowTab: frmProperties++ \ show the control tab ! initload ! SetFocus: ActiveForm ; IDM_FORM_CONTROLPROPERTY SetCommand : GroupAction ( -- ) \ multiple action on controls ActiveForm 0= ?exit ! GetHandle: MainWindow SetParentWindow: frmProperties++ ! Start: frmProperties++ ! 2 ShowTab: frmProperties++ \ show the action tab ! ; IDM_FORM_GroupAction SetCommand \s --- 426,451 ---- ;M ;Object : UpdateProperties++ ( -- ) ! LoadProperties: frmEditForm \ and update for form ! initload ; \ and for controls as well : FormProperty ( -- ) \ edit form properties ActiveForm 0= ?exit ! 0 ShowTab: frmProperties++ \ show the form tab UpdateProperties++ ! SetFocus: ActiveForm ; IDM_FORM_FORMPROPERTY SetCommand : ControlProperty ( -- ) \ edit control properties ActiveForm 0= ?exit ! 1 ShowTab: frmProperties++ \ show the control tab ! UpdatePropertyWindow ! SetFocus: ActiveForm ; IDM_FORM_CONTROLPROPERTY SetCommand : GroupAction ( -- ) \ multiple action on controls ActiveForm 0= ?exit ! 2 ShowTab: frmProperties++ \ show the action tab ! ; IDM_FORM_GroupAction SetCommand \s Index: ScintillaMDI.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ScintillaMDI.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** ScintillaMDI.f 27 Jul 2008 07:21:51 -0000 1.10 --- ScintillaMDI.f 10 Apr 2009 16:46:26 -0000 1.11 *************** *** 183,186 **** --- 183,187 ---- FindText$ 1+ FindText: ChildWindow ( nStart nEnd flag ) if SetSel: ChildWindow + else 2drop \ Saturday, November 22 2008 added by EAB then else drop *************** *** 413,421 **** : SaveText ( -- ) \ save the Text in the control to the file ! StripTrailingSpaces? dup . space if StripTrailingSpaces: self then ! EnsureFinalNewLine? dup . space if EnsureFinalNewLine: self then --- 414,422 ---- : SaveText ( -- ) \ save the Text in the control to the file ! StripTrailingSpaces? ( dup . space ) if StripTrailingSpaces: self then ! EnsureFinalNewLine? ( dup . space ) if EnsureFinalNewLine: self then |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:44:43
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv16590/apps/Win32ForthIDE Modified Files: FORMOBJECT.F Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/FORMOBJECT.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** FORMOBJECT.F 16 Sep 2008 05:16:36 -0000 1.5 --- FORMOBJECT.F 10 Apr 2009 16:44:39 -0000 1.6 *************** *** 27,31 **** MenuItem "Compile (.frm)" IDM_FORM_WRITE DoCommand ; MenuSeparator ! MenuItem "Add/Edit Code" IDM_FORM_ADDCODE DoCommand ; MenuItem "Change Tab Order" IDM_FORM_TabOrder DoCommand ; MenuItem "Add To Project" ActiveForm IDM_FORM_AddToProject DoCommand ; --- 27,31 ---- MenuItem "Compile (.frm)" IDM_FORM_WRITE DoCommand ; MenuSeparator ! MenuItem "Add/Edit Code" ShowCodeEditorTab ; MenuItem "Change Tab Order" IDM_FORM_TabOrder DoCommand ; MenuItem "Add To Project" ActiveForm IDM_FORM_AddToProject DoCommand ; *************** *** 52,56 **** MenuItem "Delete" DeleteControl ; \ delete control! MenuItem "Change type" ChangeControl ; ! MenuItem "Add/Edit Code" IDM_FORM_ADDCODE DoCommand ; MenuSeparator :MenuItem mnu_font "Change Font" ChangeControlFont ; --- 52,56 ---- MenuItem "Delete" DeleteControl ; \ delete control! MenuItem "Change type" ChangeControl ; ! MenuItem "Add/Edit Code" ShowCodeEditorTab ; MenuSeparator :MenuItem mnu_font "Change Font" ChangeControlFont ; *************** *** 109,114 **** int LocalCode int OnInitCode ! \ int LocalCursorPos ! \ int GlobalCursorPos 32 constant array-size \ holds count of each control type created for naming --- 109,115 ---- int LocalCode int OnInitCode ! int LocalCursorPos ! int GlobalCursorPos ! int OnInitCursorPos 32 constant array-size \ holds count of each control type created for naming *************** *** 233,258 **** (AddNewControl) ; - - : fonttype? ( ctrltype -- f ) - dup 0= ?exit - | TypePushbutton - TypeGroupBox - TypeCheckBox - TypeRadioButton - TypeLabel - TypeTextBox - TypeMultiLineBox - TypeListBox - TypeComboBox - TypeComboListBox - TypeMultiListBox - TypeGeneric \ in case we just want a font - |if true - else false - then ; - : ?mnu_font ( -- ) \ according to type of control allow changing font ActiveControl dup ! if GetType: [ ] fonttype? then dup Enable: mnu_font Enable: mnu_dfont ; --- 234,240 ---- (AddNewControl) ; : ?mnu_font ( -- ) \ according to type of control allow changing font ActiveControl dup ! if GetType: [ ] font-type? then dup Enable: mnu_font Enable: mnu_dfont ; *************** *** 1040,1058 **** max-codesize malloc to OnInitCode OnInitCode max-codesize erase ! \ 0 to LocalCursorPos ! \ 0 to GlobalCursorPos ; ! \ :M GetLocalCursorPos: ( -- n ) ! \ localcursorpos ;M ! \ ! \ :M SetLocalCursorPos: ( n -- ) ! \ to localcursorpos ;M ! \ ! \ :M GetGlobalCursorPos: ( -- n ) ! \ globalcursorpos ;M ! \ ! \ :M SetGlobalCursorPos: ( n -- ) ! \ to globalcursorpos ;M :M GlobalCode: ( -- addr ) --- 1022,1047 ---- max-codesize malloc to OnInitCode OnInitCode max-codesize erase ! 0 to LocalCursorPos ! 0 to GlobalCursorPos ! 0 to OnInitCursorPos ; ! :M GetLocalCursorPos: ( -- n ) ! localcursorpos ;M ! ! :M SetLocalCursorPos: ( n -- ) ! to localcursorpos ;M ! ! :M GetGlobalCursorPos: ( -- n ) ! globalcursorpos ;M ! ! :M SetGlobalCursorPos: ( n -- ) ! to globalcursorpos ;M ! ! :M GetOnInitCursorPos: ( -- n ) ! oninitcursorpos ;M ! ! :M SetOnInitCursorPos: ( n -- ) ! to oninitcursorpos ;M :M GlobalCode: ( -- addr ) *************** *** 1080,1086 **** :M Init: ( -- ) - ?init-position to frmYPos to frmXPos 350 to frmWidth 200 to frmHeight 0 to controlcount s" Form" frmTitle place --- 1069,1075 ---- :M Init: ( -- ) 350 to frmWidth 200 to frmHeight + ?init-position to frmYPos to frmXPos 0 to controlcount s" Form" frmTitle place *************** *** 1145,1149 **** Update: self else SetFocus: self ! then AutoProperty? if IDM_FORM_FORMPROPERTY DoCommand then ;M --- 1134,1138 ---- Update: self else SetFocus: self ! then AutoProperty? if IDM_FORM_FORMPROPERTY DoCommand then ;M *************** *** 1220,1224 **** NoActiveControl Paint: self ! modified ;M :M ChangeControl: ( -- ) --- 1209,1214 ---- NoActiveControl Paint: self ! modified ! doUpdate ;M :M ChangeControl: ( -- ) *************** *** 1247,1251 **** r> >Link#: ControlList \ as we were ThisControl IsActiveControl ! ShowHandles modified ;M :M MoveToFront: ( -- ) \ position control in list so it will be found first --- 1237,1242 ---- r> >Link#: ControlList \ as we were ThisControl IsActiveControl ! ShowHandles modified ! doUpdate ;M :M MoveToFront: ( -- ) \ position control in list so it will be found first *************** *** 1368,1372 **** Close: FormFile ; ! : ReadCodeFIle ( -- ) code-filename file-status nip ?exit code-filename LoadFile: FormFile 0= ?exit --- 1359,1363 ---- Close: FormFile ; ! : ReadCodeFile ( -- ) code-filename file-status nip ?exit code-filename LoadFile: FormFile 0= ?exit *************** *** 1384,1390 **** 2dup ControlCode: ThisControl swap cmove + lcount ! loop 2drop ReleaseBuffer: FormFile else drop true s" Incompatible code file!" ?MessageBox \ msg for now ! then ; : SaveForm ( -- ) --- 1375,1381 ---- 2dup ControlCode: ThisControl swap cmove + lcount ! loop 2drop else drop true s" Incompatible code file!" ?MessageBox \ msg for now ! then ReleaseBuffer: FormFile ; : SaveForm ( -- ) *************** *** 1400,1404 **** #controls SetCount: self GetData: self Write: FormFile \ save header first ! if Close: FormFile exit \ exit if error then #Controls 1+ 1 ?do i SetThisControl --- 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 *************** *** 1514,1517 **** --- 1505,1512 ---- ;M + :M Modified?: ( -- f ) + modified? + ;M + :M FormName: ( -- addr ) frmName *************** *** 1587,1591 **** : writecommoncode ( -- ) \ startup code common to all controls ! +crlf 2tabs s" self Start: " append GetName: ThisControl append&crlf 2tabs Origin: ThisControl swap #append #append --- 1582,1589 ---- : writecommoncode ( -- ) \ startup code common to all controls ! ID: ThisControl check-id ?dup ! if +crlf ! 2tabs GetId$ append s" SetID: " append GetName: ThisControl append ! then +crlf 2tabs s" self Start: " append GetName: ThisControl append&crlf 2tabs Origin: ThisControl swap #append #append *************** *** 1696,1700 **** ThisControl code-type? ThisControl have-code? and if +crlf ! s" : " append function-name append s" ( h m w l -- )" append&crlf ControlCode: ThisControl zcount append&crlf s" ; " append&crlf --- 1694,1699 ---- ThisControl code-type? ThisControl have-code? and if +crlf ! s" : " append function-name append s" ( h m w l -- )" append ! s" \ what to do when " append GetName: ThisControl append s" control has been clicked" append&crlf ControlCode: ThisControl zcount append&crlf s" ; " append&crlf *************** *** 1712,1717 **** ThisControl code-type? ThisControl have-code? and if 2tabs 4 +spaces ! s" GetID: " append GetName: ThisControl 20 append.l ! s" of " append function-name 20 append.l s" endof" append&crlf --- 1711,1718 ---- ThisControl code-type? ThisControl have-code? and if 2tabs 4 +spaces ! ID: ThisControl check-id ?dup ! if GetID$ 27 append.l ! else s" GetID: " append GetName: ThisControl 20 append.l ! then s" of " append function-name 20 append.l s" endof" append&crlf *************** *** 1722,1726 **** OnInitCode zcount -trailing ?dup if +crlf ! s" : OnInitFunction ( -- )" append&crlf append&crlf s" ; " append&crlf +crlf --- 1723,1727 ---- OnInitCode zcount -trailing ?dup if +crlf ! s" : OnInitFunction ( -- ) \ executed after form and all controls have been created" append&crlf append&crlf s" ; " append&crlf +crlf |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:42:33
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv16509/apps/Win32ForthIDE Modified Files: FORMCONTROLS.F Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: FORMCONTROLS.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/FORMCONTROLS.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** FORMCONTROLS.F 24 Aug 2008 05:07:27 -0000 1.3 --- FORMCONTROLS.F 10 Apr 2009 16:42:29 -0000 1.4 *************** *** 652,656 **** 22 bits moreFlags \ flags such as BS_CENTER, SS_CENTRE etc. could be added if desired int Reserved2 \ for future ! 16 bytes Reserved \ extensions maxtooltip bytes ctrlToolTip maxbitmap bytes ctrlBitmap --- 652,657 ---- 22 bits moreFlags \ flags such as BS_CENTER, SS_CENTRE etc. could be added if desired int Reserved2 \ for future ! byte ctrlID ! 15 bytes Reserved \ extensions maxtooltip bytes ctrlToolTip maxbitmap bytes ctrlBitmap *************** *** 945,948 **** --- 946,955 ---- to ctrlSpinner ;M + :M IsID: ( n -- ) + to ctrlID ;M + + :M ID: ( -- n ) + ctrlID ;M + :M FontChanged: ( -- f ) fontchanged ;M |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:40:28
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv16308/apps/Win32ForthIDE Modified Files: EdVersion.f FormCodeEditor.f ScintillaHyperMDI.f TABORDER.F Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: TABORDER.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/TABORDER.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** TABORDER.F 27 Jul 2008 07:21:51 -0000 1.2 --- TABORDER.F 10 Apr 2009 16:40:24 -0000 1.3 *************** *** 142,146 **** changed? if UpdateList ! IsModified: ActiveForm then Close: super ;M --- 142,147 ---- changed? if UpdateList ! IsModified: tActiveForm ! RefreshCodeWindow then Close: super ;M *************** *** 178,182 **** : TabOrder ( -- ) ! TabForm.hwnd ?exit \ already open ActiveForm 0= ?exit #Controls: ActiveForm 0= ?exit --- 179,183 ---- : TabOrder ( -- ) ! GetHandle: TabForm ?exit \ already open ActiveForm 0= ?exit #Controls: ActiveForm 0= ?exit Index: EdVersion.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdVersion.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** EdVersion.f 2 Sep 2008 03:15:10 -0000 1.11 --- EdVersion.f 10 Apr 2009 16:40:24 -0000 1.12 *************** *** 1,5 **** \ $Id$ ! 10209 value sciedit_version# \ Version numbers: v.ww.rr --- 1,5 ---- \ $Id$ ! 10210 value sciedit_version# \ Version numbers: v.ww.rr *************** *** 316,317 **** --- 316,329 ---- Saturday, August 30 2008 - Added splitter windows to the editor. Available from the Windows menu. + + \ changes for version 1.02.10 + EAB Thursday, October 30 2008 + - Modified Forms Code Editor to use the IDE editor for editing form code. Full power of IDE + available to edit code. Also allows "on the fly" previewing of form code. + January 27, 2009 + - Properties++ window have been tied to the main window for editing forms. More screen estate + available for editing code. + Friday, March 20 2009 + - Enhanced the Project Navigator to track number of times entries are used in code. + Can be useful when navigating not only projects but the application source code + of others. Index: FormCodeEditor.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/FormCodeEditor.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FormCodeEditor.f 24 Aug 2008 05:07:28 -0000 1.1 --- FormCodeEditor.f 10 Apr 2009 16:40:24 -0000 1.2 *************** *** 4,65 **** ListBox lstCodeForms ListBox lstCodeControls - PushButton btnSave - s" Save the edited code for the form or control" BInfo: btnSave place - PushButton btnRefresh - s" Refresh the forms and controls listing" BInfo: btnRefresh place PushButton btnTestForm s" Test the selected form and it's code using the console" BInfo: btnTestForm place ! PushButton btnCancel ! s" Close this code window" BInfo: btnCancel place ! Label lblForms ! Label lblControls ! ! ScintillaControl scnCodeEditor ! 0 value BackupBuffer \ buffer for saving last edited code in case we forget to save! ! true value auto-savecode? ! : to-BackupBuffer ( -- ) \ save code in buffer ! BackupBuffer 0= ?exit ! BackupBuffer GetTextLength: scnCodeEditor max-codesize min 1+ \ include terminating 0 ! GetText: scnCodeEditor ; ! : from-BackupBuffer ( -- ) \ restore code from buffer ! BackupBuffer 0= ?exit ! BackupBuffer SetText: scnCodeEditor ; ! : SaveCode { \ thiscontrol -- } \ save edited code for form or control ! #Forms 0= ?exit ! GetSelection: lstCodeForms LB_ERR = ?exit \ no selection ! GetSelection: lstCodeForms 1+ GetForm to ThisForm ! Locked?: ThisForm ?exit ! #Controls: ThisForm 0= ?exit ! GetSelection: lstCodeControls LB_ERR = ?exit \ no selection ! GetSelection: lstCodeControls ! case ! 0 of GlobalCode: ThisForm endof ! 1 of LocalCode: ThisForm endof ! 2 of OnInitCode: ThisForm endof ! 2 - GetControl: ThisForm to thiscontrol ! ControlCode: Thiscontrol 0 ! endcase ( addr ) GetTextLength: scnCodeEditor max-codesize min 1+ \ include terminating 0 ! GetText: scnCodeEditor ! IsModified: ThisForm ; \ mark form as modified ! : ShowControlCode { ctrl -- } \ show code for control ctrl ! ctrl 0= ! if z" " ! else ControlCode: ctrl ! then SetText: scnCodeEditor ! ; ! : Fill-lstCodeControls { -- } \ fill control listbox Clear: lstCodeControls \ clear - z" " SetText: scnCodeEditor \ everything - #Forms 0= ?exit \ if nothing to do forget it \ form functions first ! z" Global Code" AddStringTo: lstCodeControls \ global to form ! z" Private Code" AddStringTo: lstCodeControls \ local to form ! z" On_InitFunction" AddStringTo: lstCodeControls \ for On_Init: method GetSelection: lstCodeForms 1+ GetForm to ThisForm #Controls: ThisForm 0= ?exit --- 4,37 ---- ListBox lstCodeForms ListBox lstCodeControls PushButton btnTestForm s" Test the selected form and it's code using the console" BInfo: btnTestForm place ! PushButton btnPreview ! s" Open a window to preview form code as it is edited" BInfo: btnPreview place ! needs scintillaedit.f ! :Object scnCodePreviewer <Super Scintillaedit + \ we need the original version for this, I don't think FindText: Super Super would work! + :M FindText: ( Flags nMin nMax addr -- nStart nEnd flag ) + to ttrAddr to ttfMax to ttfMin + TextToFind swap SCI_FINDTEXT SendMessage:Self -1 = + if 0 0 false + else ttfStart ttfEnd true + then ;M + ;Object ! true value no-preview? \ true if preview window not open ! : SaveCode { -- } \ save edited code for form or control ! ActiveCoder 0= ?exit ! SaveCode: ActiveCoder ; ! : RefreshControlsList { -- } \ fill control listbox Clear: lstCodeControls \ clear \ form functions first ! z" Global Code" AddStringTo: lstCodeControls \ global to form ! z" Local Code" AddStringTo: lstCodeControls \ local to form ! z" On_InitFunction" AddStringTo: lstCodeControls \ for On_Init: method GetSelection: lstCodeForms 1+ GetForm to ThisForm #Controls: ThisForm 0= ?exit *************** *** 68,91 **** ?do i GetControl: ThisForm GetName: [ ] asciiz AddstringTo: lstCodeControls ! loop ! ; : ShowSelectionCode { Theform -- } \ show code of selected item TheForm 0= ?exit TheForm ?FormNumber 1- SetSelection: lstCodeForms \ show selected form ! Fill-lstCodeControls \ fill control list ActiveControl: TheForm ?ControlNumber: TheForm ?dup \ if it has an active control if 2 + SetSelection: lstCodeControls \ select it ! ActiveControl: TheForm ShowControlCode \ and show its code then ; ! : Fill-lstCodeforms ( -- ) \ fill forms listcontrol ! Clear: lstCodeForms \ clear everything ! Clear: lstcodeControls ! z" " SetText: scnCodeEditor ! #Forms 1+ 1 \ should be at least one form ?do i GetForm to ThisForm FormName: ThisForm count asciiz AddStringTo: lstCodeForms ! loop ActiveForm ShowSelectionCode ; : Remote-Test { \ flag -- } \ open W32F and load form from console --- 40,95 ---- ?do i GetControl: ThisForm GetName: [ ] asciiz AddstringTo: lstCodeControls ! loop ; : ShowSelectionCode { Theform -- } \ show code of selected item TheForm 0= ?exit TheForm ?FormNumber 1- SetSelection: lstCodeForms \ show selected form ! RefreshControlsList \ fill control list ! show-code? 0= ?exit \ don't show code ActiveControl: TheForm ?ControlNumber: TheForm ?dup \ if it has an active control if 2 + SetSelection: lstCodeControls \ select it ! FLAG_CODE RefreshActiveCoder \ and show its code then ; ! : Update-CodePreviewer { TheForm flag -- } \ display code for active form, flag =true if saving position ! no-preview? ?exit ! flag ! if GetCurrentPos: scnCodePreviewer >r ! then false SetReadOnly: scnCodePreviewer ! GetBuffer: TheForm over + off SetText: scnCodePreviewer ! flag ! if r> GotoPos: scnCodePreviewer ! then true SetReadOnly: scnCodePreviewer ! join$( ! s" Form Code Previewer - [" ! FormName: TheForm count ! s" ]" ! )join$ count GetParent: scnCodePreviewer SetText: [ ] ! ; ! ! : Highlight-Code { code-addr -- } \ highlight code in previewer ! no-preview? ?exit ! code-addr zcount \ if we have code ! if >r 0 \ search flag ! 0 GetTextLength: scnCodePreviewer \ range ! r> FindText: scnCodePreviewer \ look for it ! if SetSel: scnCodePreviewer \ found it ! else 2drop RemoveSel: scnCodePreviewer \ nope, so clear ! then ! else drop RemoveSel: scnCodePreviewer \ don't have anything ! then ; ! ! : RefreshFormsList ( -- ) \ fill forms listcontrol ! don't-refresh? ! if false to don't-refresh? \ one time only ! exit ! then Clear: lstCodeForms \ clear everything ! #Forms 1+ 1 \ should be at least one form ?do i GetForm to ThisForm FormName: ThisForm count asciiz AddStringTo: lstCodeForms ! loop ActiveForm ShowSelectionCode ! no-preview? ?exit ! ActiveForm false Update-CodePreviewer \ update ! ; : Remote-Test { \ flag -- } \ open W32F and load form from console *************** *** 97,101 **** Create: TheFile ?exit initbuffer ! s" \ NOTE! THIS IS A TEST FILE ONLY, DO NOT EDIT!" append&crlf s" \ MAKE ANY CHANGES OR CORRECTIONS FROM THE FORM CODE EDITOR OR THE .FRM FILE ONLY" append&crlf +crlf --- 101,105 ---- Create: TheFile ?exit initbuffer ! s" \ NOTE! THIS IS A TEST FILE ONLY, NOT INTENDED TO BE EDITED!" append&crlf s" \ MAKE ANY CHANGES OR CORRECTIONS FROM THE FORM CODE EDITOR OR THE .FRM FILE ONLY" append&crlf +crlf *************** *** 118,122 **** GetSelection: lstCodeForms LB_ERR = ?exit GetSelection: lstCodeForms 1+ GetForm to ActiveForm ! ?control if IDM_FORM_TEST DoCommand else Remote-Test --- 122,126 ---- GetSelection: lstCodeForms LB_ERR = ?exit GetSelection: lstCodeForms 1+ GetForm to ActiveForm ! control-key? if IDM_FORM_TEST DoCommand else Remote-Test *************** *** 124,127 **** --- 128,135 ---- ; + : Clear-CodeLists ( -- ) + Clear: lstCodeForms + Clear: lstCodeControls ; + :Object FormPane <Super Child-Window *************** *** 149,154 **** if ncode LBN_SELCHANGE = if GetSelection: lstCodeForms 1+ GetForm ! dup to ActiveForm \ make it the active one for testing ! ShowSelectionCode then then ;M --- 157,164 ---- if ncode LBN_SELCHANGE = if GetSelection: lstCodeForms 1+ GetForm ! to ActiveForm \ make it the active one for testing ! SetFocus: ActiveForm ! ActiveForm ShowSelectionCode ! ActiveForm false Update-CodePreviewer then then ;M *************** *** 171,175 **** self Start: lstCodeControls Handle: ControlFont SetFont: lstCodeControls - ;M --- 181,184 ---- *************** *** 183,212 **** ;M ! : GetControlCode ( n -- ) ! GetControl: ThisForm ShowControlCode ; ! : GetGlobalCode ( -- ) ! GlobalCode: ThisForm SetText: scnCodeEditor ; ! : GetLocalCode ( -- ) ! LocalCode: ThisForm SetText: scnCodeEditor ; ! : GetOnInitCode ( -- ) ! OnInitCode: ThisForm SetText: scnCodeEditor ; :M On_Command: { ncode id -- } id GetId: lstCodeControls = ! if ncode LBN_SELCHANGE = ! if GetSelection: lstcodeForms 1+ GetForm to ThisForm GetSelection: lstCodeControls case ! 0 of GetGlobalCode endof ! 1 of GetLocalCode endof ! 2 of GetOnInitCode endof ! 2 - GetControlCode false endcase then --- 192,236 ---- ;M ! : UpdateForm ( n -- ) \ n = activecontrol ! SetActiveControl: ActiveForm ! Paint: ActiveForm ! UpdateStatus: ActiveForm ! UpdatePropertyWindow ; ! ! ! : ShowControlCode ( n -- ) ! GetControl: ActiveForm UpdateForm ! FLAG_CODE RefreshActiveCoder ; ! \ set activecontrol to nothing so that when for example, editing global, local or oninit code, ! \ the activecoder would not switch to activecontrol code for a simple window focus change ! : ShowGlobalCode ( -- ) ! 0 UpdateForm ! FLAG_Global RefreshActiveCoder ; ! : ShowLocalCode ( -- ) ! 0 UpdateForm ! FLAG_LOCAL RefreshActiveCoder ; ! : ShowOnInitCode ( -- ) ! 0 UpdateForm ! FLAG_ONINIT RefreshActiveCoder ; :M On_Command: { ncode id -- } id GetId: lstCodeControls = ! if true to show-code? \ open code editing window ! ncode LBN_SELCHANGE = ! if GetSelection: lstcodeForms 1+ GetForm to ActiveForm ! true to don't-refresh? \ not necessary here GetSelection: lstCodeControls case ! 0 of ShowGlobalCode endof ! 1 of ShowLocalCode endof ! 2 of ShowOnInitCode endof ! 2 - ShowControlCode false endcase then *************** *** 220,486 **** ;Object ! :Object CodePane <Super Child-Window ! ! :M ExWindowStyle: ( -- style ) ! ExWindowStyle: Super ! WS_EX_CLIENTEDGE or ;M :M On_Init: ( -- ) CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ! self Start: scnCodeEditor ! ShowLineNumbers: scnCodeEditor ! ;M ! ! :M On_Size: ( -- ) ! 0 0 Width Height Move: scnCodeEditor ! ;M ! :M Close: ( -- ) ! Close: scnCodeEditor ! Close: Super ;M ! :M On_Command: { ncode id -- res } ! id GetId: scnCodeEditor = ! if ncode ! case SCEN_KILLFOCUS of GetModify: scnCodeEditor ! if to-BackupBuffer \ save contents ! auto-savecode? ! if SaveCode ! then ! then ! endof ! SCEN_SETFOCUS of ?control ! if from-BackupBuffer \ restore ! then ! endof ! endcase ! then ;M ! ! :M WM_COMMAND ( hwnd msg wparam lparam -- res ) ! over HIWORD ( notification code ) rot LOWORD ( ID ) ! On_Command: Self ! false ;M ! ! ;Object ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! :Object CodeWindow <Super Window ! ! WinSplitter SplitterH ! WinSplitter SplitterV ! 20 value ToolBarHeight \ set to height of toolbar if any ! 25 value StatusBarHeight \ set to height of status bar if any ! 200 value TopHeight ! 100 value LeftWidth ! 5 value ThicknessH ! 5 value ThicknessV ! 300 300 2value xypos \ saving the position of code window ! 300 390 2value win-size \ saving the size of the code window ! ! int dragging ! int mousedown ! ! : RightXpos ( -- n ) LeftWidth ThicknessV + ; ! : RightWidth ( -- n ) Width RightXpos - ; ! : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; ! : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; ! : StatusBarYpos ( -- n ) height StatusbarHeight - ; ! : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; ! : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; ! : LeftWidthMin ( -- n ) LeftWidth width min ; ! : TopHeightMin ( -- n ) TopHeight TotalHeight min ; ! ! 70 value btnwidth ! ! : position-windows ( -- ) ! 0 ToolBarHeight LeftWidthMin TopHeightMin Move: FormPane ! RightXpos ToolBarHeight RightWidth TopHeightMin Move: ControlsPane ! 0 BottomYpos Width BottomHeight Move: CodePane ! LeftWidth ToolBarHeight ThicknessV TopHeight Move: SplitterV ! 0 SplitterYpos Width ThicknessH Move: SplitterH ! 1 StatusBarYPos 2dup btnwidth 25 Move: btnRefresh ! btnwidth 2+ under+ 2dup btnwidth 25 Move: btnSave ! btnwidth 2+ under+ 2dup btnwidth 25 Move: btntestForm ! btnwidth 2+ under+ btnwidth 25 Move: btnCancel ! 2 1 70 18 Move: lblForms ! RightXPos 1 70 18 Move: lblControls ! ; ! ! : Splitter ( -- n ) \ the splitter window the cursor is on ! hWnd get-mouse-xy ! dup ToolBarHeight StatusBarYpos within ! IF ! 2dup ToolBarHeight SplitterYpos within swap LeftWidth RightXpos within and ! IF 2drop 1 ! ELSE SplitterYpos BottomYpos within swap 0 width within and IF 2 ELSE 0 THEN ! THEN ! ELSE 2drop 0 ! THEN ; ! ! : On_Tracking ( -- ) \ set min and max values of LeftWidth and TopHeight here ! mousedown dragging or 0= ?EXIT ! dragging ! Case ! 1 of mousex 0max width min thicknessV 2/ - to LeftWidth endof ! 2 of mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight endof ! EndCase ! position-windows ! WINPAUSE ; ! ! : On_Clicked ( -- ) ! mousedown not IF hWnd Call SetCapture drop THEN ! true to mousedown ! Splitter to dragging ! On_Tracking ; ! ! : On_Unclicked ( -- ) ! mousedown IF Call ReleaseCapture drop THEN ! false to mousedown ! false to dragging ; ! ! : On_DblClick ( -- ) ! false to mousedown ! Splitter 1 = ! IF ! LeftWidth 8 > ! IF 0 thicknessV 2/ - to LeftWidth ! ELSE Width thicknessV - 2/ to LeftWidth ! THEN ! position-windows ! THEN ; ! ! :M WM_SETCURSOR ( h m w l -- ) ! Splitter ! Case ! 0 of DefWindowProc: self endof ! 1 of SIZEWE-CURSOR 1 endof ! 2 of SIZENS-CURSOR 1 endof ! EndCase ! ;M ! ! :M Classinit: ( -- ) ! ClassInit: super \ init super class ! ['] On_Clicked SetClickFunc: self ! ['] On_Unclicked SetUnClickFunc: self ! ['] On_Tracking SetTrackFunc: self ! ['] On_DblClick SetDblClickFunc: self ! self link-formwindow ! ;M ! ! :M WindowStyle: ( -- style ) ! WindowStyle: Super WS_CLIPCHILDREN or ;M ! ! :M On_Size: ( -- ) ! position-windows ;M ! ! : init-backupbuffer ( -- ) ! BackupBuffer 0= ! if max-codesize malloc to BackupBuffer ! BackupBuffer max-codesize erase ! then ; ! ! :M On_Init: ( -- ) ! \ prevent flicker in window on sizing ! CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ! ! self Start: FormPane ! self Start: ControlsPane ! self Start: CodePane ! self Start: SplitterH ! self Start: SplitterV ! ! self Start: btnRefresh ! s" Refresh" SetText: btnRefresh ! Handle: ControlFont SetFont: btnRefresh ! ! self Start: btnSave ! s" Save Code" SetText: btnSave ! Handle: ControlFont SetFont: btnSave ! ! self Start: btnTestForm ! s" Test" SetText: btnTestForm ! Handle: ControlFont SetFont: btnTestForm ! ! self Start: btnCancel ! s" Close" SetText: btnCancel ! Handle: ControlFont SetFont: btnCancel ! ! self Start: lblForms ! s" Forms" SetText: lblForms ! \ Handle: ControlFont SetFont: lblForms ! ! self Start: lblControls ! s" Controls+" SetText: lblControls ! \ Handle: ControlFont SetFont: lblControls ! ! Fill-lstCodeForms ! ! init-backupbuffer ! ! ;M ! ! :M Refresh: ( -- ) ! hwnd ! if Fill-lstCodeForms ! then ;M ! ! :M On_Paint: ( -- ) ! 0 0 Width Height FormColor FillArea: dc ;M ! :M ParentWindow: ( -- ) ! GetHandle: MainWindow ! ;M ! ! :M WindowTitle: ( -- ztitle ) ! z" Forms Code Window" ;M ! ! :M StartSize: ( -- w h ) ! win-size ;M ! :M StartPos: ( -- x y ) ! xypos ;M ! ! :M On_Done: ( -- ) ! originx originy 2to xypos ! width height 2to win-size ! On_Done: Super ! ;M :M Close: ( -- ) ! Close: FormPane ! Close: ControlsPane ! Close: CodePane ! BackupBuffer ?dup ! if release ! 0 to BackupBuffer ! then Close: Super ;M - :M On_Command: { ncode id -- } - id - case GetId: btnRefresh of Fill-lstCodeForms endof - GetId: btnSave of SaveCode endof - GetId: btnTestForm of TestSelection endof - GetId: btnCancel of Close: self endof - endcase - ;M - - :M WM_COMMAND ( hwnd msg wparam lparam -- res ) - over HIWORD ( notification code ) rot LOWORD ( ID ) - On_Command: Self - false ;M - ;Object ! : FormCodeWindow ( -- ) ! GetHandle: Codewindow ! if \ SetFocus: CodeWindow ! Refresh: CodeWindow ! else Start: CodeWindow ! then ; IDM_FORM_ADDCODE SetCommand --- 244,280 ---- ;Object ! :Object CodePreviewWindow <Super Window :M On_Init: ( -- ) CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ! self Start: scnCodePreviewer ! ShowLineNumbers: scnCodePreviewer ! \ Color: BLACK Color: LTGRAY SetColors: scnCodePreviewer ! \ Color: LTYELLOW SetCaretBackColor: scnCodePreviewer ! false to no-preview? ! ActiveForm false Update-CodePreviewer ;M ! :M On_Size: ( -- ) ! 0 0 Width Height Move: scnCodePreviewer ;M ! :M WindowTitle: ( -- zstring ) ! z" Forms Code Previewer" ;M ! :M ParentWindow: ( -- ) ! GetHandle: MainWindow ! ;M :M Close: ( -- ) ! Close: scnCodePreviewer ! true to no-preview? ! Close: Super ;M ;Object ! : RefreshCodeWindow ( -- ) ! RefreshFormsList ; IDM_FORM_ADDCODE SetCommand Index: ScintillaHyperMDI.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ScintillaHyperMDI.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** ScintillaHyperMDI.f 30 Dec 2007 03:53:20 -0000 1.4 --- ScintillaHyperMDI.f 10 Apr 2009 16:40:24 -0000 1.5 *************** *** 171,178 **** false SetBrowseMode: self Update: self - \ set current line background color, personal preference - EAB - \ 0 Color: LTCYAN SCI_SETCARETLINEBACK GetHandle: ChildWindow send-window - \ 0 true SCI_SETCARETLINEVISIBLE GetHandle: ChildWindow send-window - \ 0 500 SCI_SETCARETPERIOD GetHandle: ChildWindow send-window ;M --- 171,174 ---- *************** *** 190,201 **** self ;M ! :M On_Close: ( -- ) On_Close: super ! self ActiveBrowser = if 0 to ActiveBrowser then ! self ActiveRemote = if 0 to ActiveRemote then ! self ActiveChild = if 0 to ActiveChild then ! UpdateStatusBar ! EnableToolbar ! ;M :M GoBack: ( -- ) --- 186,198 ---- self ;M ! :M On_Close: ( -- f ) On_Close: super ! dup \ EAB added flag test Wednesday, October 29 2008 ! if self ActiveBrowser = if 0 to ActiveBrowser then ! self ActiveRemote = if 0 to ActiveRemote then ! self ActiveChild = if 0 to ActiveChild then ! UpdateStatusBar ! EnableToolbar ! then ;M :M GoBack: ( -- ) |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:38:53
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv16183/apps/Win32ForthIDE Modified Files: EDSplitterWindow.f EdFORTHFORM.F Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: EdFORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdFORTHFORM.F,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** EdFORTHFORM.F 24 Aug 2008 05:07:27 -0000 1.6 --- EdFORTHFORM.F 10 Apr 2009 16:38:36 -0000 1.7 *************** *** 3,11 **** cr .( Loading Form Designer...) - \ add the ForthForm folder's to our path list - \ September 20th, 2003 - 9:57 dbu - s" apps\forthform" "fpath+ - s" apps\forthform\res" "fpath+ - vocabulary forthform vocabulary testvocab \ for testing forms to avoid conflicts --- 3,6 ---- *************** *** 55,59 **** 0 value picturebmp 0 value staticbmp ! 32 1024 * cell+ constant max-codesize 20300 constant fform_version# --- 50,54 ---- 0 value picturebmp 0 value staticbmp ! 32 1024 * cell+ constant max-codesize \ 32k for now but can be changed 20300 constant fform_version# *************** *** 70,77 **** formwindow-link off false value detached? \ is form designer window detached from tabcontrol? ColorObject FormColor \ background form color Font ControlFont \ default font for text to be written in control ! ListBox FormPicker \ list of open forms \ status labels --- 65,73 ---- formwindow-link off false value detached? \ is form designer window detached from tabcontrol? + false value don't-refresh? \ refresh code window only when necessary ColorObject FormColor \ background form color Font ControlFont \ default font for text to be written in control ! \ ListBox FormPicker \ list of open forms \ status labels *************** *** 91,94 **** --- 87,108 ---- defer UpdatePropertyWindow defer UpdateSystem + defer NewCodeWindow + + \ The value show-code? prevents control code from being displayed automatically in the IDE until + \ the control is selected from the Code Editor. So if just creating forms normally without + \ adding any code the Code Editor can be ignored. If a control is selected from the Code Editor + \ window the flag will be set so that for any further controls added or clicked will display + \ that control's code in the IDE. It can be reset when by closing the code editing window. + false value show-code? + + 1 to enum-value + enum: + FLAG_GLOBAL + FLAG_LOCAL + FLAG_ONINIT + FLAG_CODE ; + + : RefreshActiveCoder ( flag -- ) + NewCodeWindow Refresh: ActiveCoder ; : link-formwindow { win -- } *************** *** 182,186 **** ActiveForm 0= ?exit \ for obvious reasons ActiveControl: Activeform 0= ?exit ! ChangeControl: ActiveForm ; : ChangeControlFont ( -- ) \ change the font for a control --- 196,201 ---- ActiveForm 0= ?exit \ for obvious reasons ActiveControl: Activeform 0= ?exit ! ChangeControl: ActiveForm ! doUpdate ; : ChangeControlFont ( -- ) \ change the font for a control *************** *** 189,192 **** --- 204,208 ---- if GetUserFont: [ ] IsModified: ActiveForm + doUpdate then ; *************** *** 196,201 **** --- 212,236 ---- if DefaultFont: [ ] IsModified: ActiveForm + doUpdate then ; + : font-type? ( ctrltype -- f ) \ allow font change for this control? + dup 0= ?exit + | TypePushbutton + TypeGroupBox + TypeCheckBox + TypeRadioButton + TypeLabel + TypeTextBox + TypeMultiLineBox + TypeListBox + TypeComboBox + TypeComboListBox + TypeMultiListBox + TypeGeneric \ in case we just want a font + |if true + else false + then ; + : #Forms ( -- n ) \ return number of open forms FormList *************** *** 234,237 **** --- 269,296 ---- ; + 10 constant #ids + create IDList + s" DEFAULT" ", \ default id + s" IDOK" ", \ OK button was selected. + s" IDCANCEL" ", \ Cancel button was selected. + s" IDYES" ", \ Yes button was selected. + s" IDNO" ", \ No button was selected. + s" IDABORT" ", \ Abort button was selected. + s" IDIGNORE" ", \ Ignore button was selected. + s" IDCONTINUE" ", \ Continue button was selected. + s" IDRETRY" ", \ Retry button was selected. + s" IDTRYAGAIN" ", \ Try Again button was selected. + 0 , align + + : check-id ( n1 -- n2 ) \ n2 = n1 or 0 + dup 0 #ids within not + if drop 0 \ make it in range + then ; + + : GetID$ ( n -- addr cnt ) + check-id IDList swap 0 + ?do count + + loop count ; + FileOpenDialog OpenSessionDlg "Load Session File" "Session Files|*.ses|" FileSaveDialog SaveSessionDlg "Save Session File" "Session Files|*.ses|" *************** *** 240,244 **** FileOpenDialog GetBitmapDlg "Get Bitmap" "Bitmap Files|*.bmp;*.dib|" - needs edformwindow.f \ form designer window \ all ForthForm dialogs needs ControlProperty.frm --- 299,302 ---- *************** *** 253,287 **** needs formcontrols.f \ subclassed control object needs groupaction.f \ positioning of controls ! needs formobject.f \ load form class needs taborder.f \ change tab order form needs formproperty.f \ edit of form properties needs CreateToolBar.f \ toolbar generator ...but you knew that right? needs SplitterWindow.f \ this is also an easy guess! needs CreateMenu.f \ now what could this file be for? needs CreatePropertyForm.f \ generate property sheet like template - needs FormCodeEditor.f \ adding code to forms Form DummyForm \ dummy ControlObject DummyControl \ objects - : UpdateFormPicker ( -- ) \ update combolist control - GetHandle: FormPicker 0= ?exit \ not opened - Clear: FormPicker \ reset it - #Forms ?dup \ if we have any - if 1+ 1 - ?do i >Link#: FormList - Data@: FormList FormName: [ ] - count asciiz AddStringTo: FormPicker \ add string - loop ActiveForm ?dup - if ?FormNumber 1- 0max SetSelection: FormPicker \ show active form - then - then ; : updatewin ( -- ) \ update everything - UpdateFormPicker UpdateProperties++ ?EnableFormMenuItems Update: Monitor - Refresh: CodeWindow ; ' updatewin is doupdate --- 311,332 ---- needs formcontrols.f \ subclassed control object needs groupaction.f \ positioning of controls ! needs FormCodeEditor.f \ adding code to forms needs taborder.f \ change tab order form needs formproperty.f \ edit of form properties + needs edformwindow.f \ form designer window + needs formobject.f \ load form class needs CreateToolBar.f \ toolbar generator ...but you knew that right? needs SplitterWindow.f \ this is also an easy guess! needs CreateMenu.f \ now what could this file be for? needs CreatePropertyForm.f \ generate property sheet like template Form DummyForm \ dummy ControlObject DummyControl \ objects : updatewin ( -- ) \ update everything UpdateProperties++ ?EnableFormMenuItems Update: Monitor ; ' updatewin is doupdate *************** *** 306,310 **** Start: ThisForm Display: ThisForm ! doupdate ; IDM_FORM_New SetCommand : (OpenForm) { fname fcnt -- } \ open form given its name --- 351,356 ---- Start: ThisForm Display: ThisForm ! doupdate ! ; IDM_FORM_New SetCommand : (OpenForm) { fname fcnt -- } \ open form given its name *************** *** 420,425 **** SetFocus: MainWindow 0 to ActiveForm ! Close: frmProperties++ ! Close: CodeWindow FormList Dispose 0 to FormList ActiveChild 0= \ no other file opened --- 466,474 ---- SetFocus: MainWindow 0 to ActiveForm ! Clear: frmProperties++ ! Clear-CodeLists ! ActiveCoder ?dup ! if GetHandle: [ ] CloseChild: MainWindow ! then FormList Dispose 0 to FormList ActiveChild 0= \ no other file opened *************** *** 427,433 **** then else SetFocus: [ Data@: FormList ] ! ActiveControl: Activeform ! if UpdatePropertyWindow ! then then #Forms 2 < \ less than two forms opened if Close: frmCreatePropertyForm \ makes no sense --- 476,486 ---- then else SetFocus: [ Data@: FormList ] ! UpdatePropertyWindow ! ActiveCoder ! if ActiveControl: ActiveForm ! if FLAG_CODE ! else FLAG_GLOBAL ! then Refresh: ActiveCoder ! then then #Forms 2 < \ less than two forms opened if Close: frmCreatePropertyForm \ makes no sense *************** *** 439,446 **** >FirstLink: FormList Begin FormList ! While Data@: FormList IDM_FORM_Close DoCommand Repeat ; IDM_FORM_CloseAll SetCommand : AddFormToProject ( form -- ) \ include in project TextFile: [ ] 2dup s" untitled.frm" istr= not if AddForm: TheProject --- 492,500 ---- >FirstLink: FormList Begin FormList ! While Data@: FormList CloseForm Repeat ; IDM_FORM_CloseAll SetCommand : AddFormToProject ( form -- ) \ include in project + \ Form must be compiled first TextFile: [ ] 2dup s" untitled.frm" istr= not if AddForm: TheProject *************** *** 449,452 **** --- 503,507 ---- : AddOpenForms ( -- ) \ include all open forms in project + \ Forms should have been compiled first #Forms ?dup if 1+ 1 *************** *** 485,497 **** else drop then ; create buf 200 allot ! : File= { \ tmp# -- } ( <name> -- ) \ get file name from input stream -1 to tmp# ',' word dup c@ if count buf dup>r place more? ! if 0 word count number? if drop to tmp# else 2drop then then r@ count file-status nip 0= \ if still exist --- 540,558 ---- else drop then ; + create buf 200 allot ! : File= { \ tmp# browsing? -- } ( <name> -- ) \ get file name from input stream ! false to browsing? -1 to tmp# ',' word dup c@ if count buf dup>r place more? ! if ',' word count number? if drop to tmp# else 2drop + then more? + if 0 word count s" browsing" istr= + if true to browsing? + then then then r@ count file-status nip 0= \ if still exist *************** *** 499,503 **** tmp# -1 <> if tmp# GotoPos: CurrentWindow ! then then r>drop else drop --- 560,564 ---- tmp# -1 <> if tmp# GotoPos: CurrentWindow ! then browsing? SetBrowseMode: ActiveChild then r>drop else drop *************** *** 553,557 **** if ',' cappend ChildWindow: ThisChild ! GetCurrentPos: [ ] (.) append&crlf else +crlf then --- 614,623 ---- if ',' cappend ChildWindow: ThisChild ! GetCurrentPos: [ ] (.) append ! ',' cappend ! ?BrowseMode: ThisChild ! if s" BROWSING" ! else s" EDITING" ! THEN append&crlf else +crlf then Index: EDSplitterWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EDSplitterWindow.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** EDSplitterWindow.f 8 Sep 2008 03:05:10 -0000 1.2 --- EDSplitterWindow.f 10 Apr 2009 16:38:36 -0000 1.3 *************** *** 424,429 **** child2 SetTabInfo: OpenFilesTab ; ! : SplitWindow { win-func split-type \ modified? curpos textbuf textlen name$ -- } ActiveChild 0= ?exit GetFileType: ActiveChild FT_SOURCE <> ?exit GetSplitType: ActiveChild split-type = ?exit --- 424,430 ---- child2 SetTabInfo: OpenFilesTab ; ! : SplitWindow { win-func split-type \ modified? curpos textbuf textlen name$ browsing? -- } ActiveChild 0= ?exit + ActiveChild ActiveCoder = ?exit \ no splitting for code window GetFileType: ActiveChild FT_SOURCE <> ?exit GetSplitType: ActiveChild split-type = ?exit *************** *** 435,438 **** --- 436,440 ---- GetCurrentPos: CurrentWindow to curpos \ position in document GetFileName: ActiveChild count name$ place \ file name + ?BrowseMode: ActiveChild to browsing? SetSavepoint: CurrentWindow \ mark as not modified ActiveChild >r *************** *** 442,445 **** --- 444,448 ---- curpos GotoPos: CurrentWindow modified? 0= IF SetSavePoint: CurrentWindow THEN + browsing? SetBrowseMode: ActiveChild textbuf release r@ TabPosition ActiveChild TabPosition SwapTabs |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:37:16
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv15924/apps/Win32ForthIDE Modified Files: EdFilePane.f EdFormWindow.f EdRemote.f Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: EdFilePane.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdFilePane.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** EdFilePane.f 30 Dec 2007 03:53:20 -0000 1.4 --- EdFilePane.f 10 Apr 2009 16:37:04 -0000 1.5 *************** *** 147,152 **** : openfile { item -- } getname$: item new$ dup>r place ! ?control \ control and double click opens file for editing, it had better be text! ! if NewEditWindow r@ count OpenNamedFile: ActiveChild drop else r@ IDM_OPEN_RECENT_FILE DoCommand then r>drop ; --- 147,153 ---- : openfile { item -- } getname$: item new$ dup>r place ! control-key? \ control and double click opens file for editing, it had better be text! ! if NewEditWindow r@ count OpenNamedFile: ActiveChild drop ! UpdateFileTab else r@ IDM_OPEN_RECENT_FILE DoCommand then r>drop ; Index: EdFormWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdFormWindow.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** EdFormWindow.f 1 Oct 2008 03:08:51 -0000 1.4 --- EdFormWindow.f 10 Apr 2009 16:37:04 -0000 1.5 *************** *** 214,257 **** ;Object - :Object FormLister <Super Child-Window - - :M On_Size: ( -- ) - 0 0 GetSize: Self Move: FormPicker - ;M - - :M On_Init: ( -- ) - self Start: FormPicker - Handle: ControlFont SetFont: FormPicker - - CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop - - ;M - - :M On_Command: { hCtrl ncode id -- f } - id - case - GetId: FormPicker of ncode CBN_SELCHANGE = - if GetCurrent: FormPicker 1+ GetForm - SetFocus: [ ] - then - endof - endcase ;M - - :M WM_COMMAND ( hwnd msg wparam lparam -- res ) - over HIWORD ( notification code ) rot LOWORD ( ID ) - On_Command: self - 0 ;M - - :M Close: ( -- ) - Close: FormPicker - Close: super - ;M - - :M On_Paint: ( -- ) - 0 0 Width Height WHITE FillArea: dc - ;M - - ;Object - needs formmonitor.f --- 214,217 ---- *************** *** 299,314 **** :M On_Size: ( -- ) \ set the divisions ! 0 0 Width 105 Move: PartitionI ! 0 120 Width Height 120 - Move: PartitionII ! 0 0 Width 20 Move: lblFormName \ relative ! 0 21 Width 20 Move: lblControlName \ to ! 0 42 Width 20 Move: lblPosition \ their ! 0 63 Width 20 Move: lblSize \ parent ! 0 84 Width 20 Move: lblModified ;M ;Object :Object BottomPane <Super Child-Window --- 259,401 ---- :M On_Size: ( -- ) \ set the divisions ! 0 0 Width 130 Move: PartitionI ! 0 145 Width Height 145 - Move: PartitionII ! 0 0 Width 25 Move: lblFormName \ relative ! 0 26 Width 25 Move: lblControlName \ to ! 0 52 Width 25 Move: lblPosition \ their ! 0 78 Width 25 Move: lblSize \ parent ! 0 104 Width 25 Move: lblModified ;M ;Object + :Object CodeWin <Super Child-Window + + WinSplitter SplitterH + 0 value ToolBarHeight \ set to height of toolbar if any + 25 value StatusBarHeight \ set to height of status bar if any + 200 value TopHeight + 5 value ThicknessH + 75 constant btnwidth + + int dragging + int mousedown + + : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; + : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; + : StatusBarYpos ( -- n ) height StatusbarHeight - ; + : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; + : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; + : TopHeightMin ( -- n ) TopHeight TotalHeight min ; + + : position-windows ( -- ) + 0 ToolBarHeight Width TopHeightMin Move: FormPane + 0 BottomYpos Width BottomHeight Move: ControlsPane + 0 SplitterYpos Width ThicknessH Move: SplitterH + 1 StatusBarYPos 2dup btnwidth 25 Move: btnPreview + btnwidth 2+ under+ btnwidth 25 Move: btnTestForm + ; + + : Splitter ( -- n ) \ the splitter window the cursor is on + hWnd get-mouse-xy + dup ToolBarHeight StatusBarYpos within + IF SplitterYpos BottomYpos within swap 0 width within and IF 1 ELSE 0 THEN + ELSE 2drop 0 THEN ; + + : On_Tracking ( -- ) \ set min and max values of TopHeight here + mousedown dragging or 0= ?EXIT + dragging + IF mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight THEN + position-windows + WINPAUSE ; + + : On_Clicked ( -- ) + mousedown not IF hWnd Call SetCapture drop THEN + true to mousedown + Splitter to dragging + On_Tracking ; + + : On_Unclicked ( -- ) + mousedown IF Call ReleaseCapture drop THEN + false to mousedown + false to dragging ; + + : On_DblClick ( -- ) + false to mousedown + Splitter 1 = + IF + TopHeight 8 > + IF 0 thicknessH 2/ - to TopHeight + ELSE TopHeight BottomHeight + thicknessH - 2/ to TopHeight + THEN + position-windows + THEN ; + + :M WM_SETCURSOR ( h m w l -- ) + Splitter + Case + 0 of DefWindowProc: self endof + 1 of SIZENS-CURSOR 1 endof + EndCase + ;M + + :M Classinit: ( -- ) + ClassInit: super \ init super class + ['] On_Clicked SetClickFunc: self + ['] On_Unclicked SetUnClickFunc: self + ['] On_Tracking SetTrackFunc: self + ['] On_DblClick SetDblClickFunc: self + ;M + + :M WindowStyle: ( -- style ) + WindowStyle: Super WS_CLIPCHILDREN or ;M + + :M On_Size: ( -- ) + position-windows + Paint: Parent \ refresh tab control + Paint: FormPane + Paint: ControlsPane + Paint: SplitterH + Paint: btnPreview + Paint: btnTestForm + ;M + + :M On_Init: ( -- ) + \ prevent flicker in window on sizing + CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop + + self Start: FormPane + self Start: ControlsPane + self Start: SplitterH + + self Start: btnPreview + s" Preview Code" SetText: btnPreview + Handle: ControlFont SetFont: btnPreview + + self Start: btnTestForm + s" Test" SetText: btnTestForm + Handle: ControlFont SetFont: btnTestForm + + ;M + + :M On_Command: { ncode id -- } + id + case GetId: btnPreview of Start: CodePreviewWindow endof + GetID: btnTestForm of TestSelection endof + endcase + ;M + + :M WM_COMMAND ( hwnd msg wparam lparam -- res ) + over HIWORD ( notification code ) rot LOWORD ( ID ) + On_Command: Self + false ;M + + :M On_Paint: ( -- ) + 0 0 Width Height FormColor FillArea: dc + ;M + + ;Object + :Object BottomPane <Super Child-Window *************** *** 324,329 **** ClientSize: InfoWindow 2over d- ( x y w h ) ! 4dup Move: FormLister ! Move: FormStats ;M --- 411,417 ---- ClientSize: InfoWindow 2over d- ( x y w h ) ! 4dup Move: frmProperties++ ! 4dup Move: FormStats ! Move: CodeWin ;M *************** *** 334,343 **** : ShowStats ( -- ) SW_SHOW Show: FormStats \ show before hide ! SW_HIDE Show: FormLister ; ! : ShowList ( -- ) ! SW_SHOW Show: FormLister SW_HIDE Show: FormStats ; --- 422,439 ---- : ShowStats ( -- ) SW_SHOW Show: FormStats \ show before hide ! SW_HIDE Show: frmProperties++ ! SW_HIDE Show: CodeWin ; ! : ShowProperties ( -- ) ! SW_SHOW Show: frmProperties++ ! SW_HIDE Show: FormStats ! SW_HIDE Show: CodeWin ! ; ! ! : ShowCode ( -- ) ! SW_HIDE Show: frmProperties++ SW_HIDE Show: FormStats + SW_SHOW Show: CodeWin ; *************** *** 345,352 **** \ Show the control for the currently selected tab. GetSelectedTab: InfoWindow ! case 0 of ShowStats endof ! 1 of ShowList endof endcase ;M ! \ : selchange-func { lParam obj \ Parent -- false } \ This function es executed when the currently selected tab has changed. --- 441,449 ---- \ Show the control for the currently selected tab. GetSelectedTab: InfoWindow ! case 0 of ShowProperties endof ! 1 of ShowStats endof ! 2 of ShowCode endof endcase ;M ! : selchange-func { lParam obj \ Parent -- false } \ This function es executed when the currently selected tab has changed. *************** *** 365,369 **** :M On_Init: ( -- ) self Start: FormStats ! self Start: FormLister TCS_FLATBUTTONS AddStyle: InfoWindow --- 462,467 ---- :M On_Init: ( -- ) self Start: FormStats ! self Start: frmProperties++ ! self Start: CodeWin TCS_FLATBUTTONS AddStyle: InfoWindow *************** *** 374,384 **** TCIF_TEXT IsMask: InfoWindow ! z" Status" IsPszText: InfoWindow 1 InsertTab: InfoWindow TCIF_TEXT IsMask: InfoWindow ! z" List of Forms" IsPszText: InfoWindow 2 InsertTab: InfoWindow SelChange: self \ show the control for the currently selected tab --- 472,486 ---- TCIF_TEXT IsMask: InfoWindow ! z" Properties" IsPszText: InfoWindow 1 InsertTab: InfoWindow TCIF_TEXT IsMask: InfoWindow ! z" Status" IsPszText: InfoWindow 2 InsertTab: InfoWindow + TCIF_TEXT IsMask: InfoWindow + z" Code Editor" IsPszText: InfoWindow + 3 InsertTab: InfoWindow + SelChange: self \ show the control for the currently selected tab *************** *** 399,403 **** :M Close: ( -- ) Close: FormStats ! Close: FormLister Close: Super ;M --- 501,506 ---- :M Close: ( -- ) Close: FormStats ! Close: frmProperties++ ! Close: CodeWin Close: Super ;M *************** *** 405,408 **** --- 508,517 ---- ;Object + : ShowCodeEditorTab ( -- ) + true to show-code? \ open code editing window + 2 ShowTab: BottomPane \ switch tab + IDM_FORM_ADDCODE DoCommand \ and refresh + ; + :Object FormWindow <Super Child-Window Index: EdRemote.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdRemote.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** EdRemote.f 27 Jul 2008 07:21:50 -0000 1.10 --- EdRemote.f 10 Apr 2009 16:37:04 -0000 1.11 *************** *** 37,41 **** ed-filename count (OpenRemoteFile) \ switch if already loaded ed-line GotoLine: ActiveRemote ! ed-line ed-filename count LoadHyperFile: ActiveRemote \ load the file flag 2 = SetBrowseMode: ActiveRemote \ browsing? then --- 37,41 ---- ed-filename count (OpenRemoteFile) \ switch if already loaded ed-line GotoLine: ActiveRemote ! \ ed-line ed-filename count LoadHyperFile: ActiveRemote \ load the file flag 2 = SetBrowseMode: ActiveRemote \ browsing? then |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:29:49
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv15446/apps/Win32ForthIDE Added Files: JoinStr.f POINT.F RECT.F Splitter1.f Splitter2.f Splitter3.f Splitter4.f Splitter5.f Splitter6.f quiksort.f Log Message: IDE Enhancements. Bug Fixes. Doc Updates. --- NEW FILE: RECT.F --- \ Rect.f \ Define general purpose object for drawing and erasing rectangles (boxes). comment: These routines to draw and erase a rectangle makes use of the Xor function. The results look better on hi-color systems. An array could be used to store the pixels for the drawing and erasing, which would work good on any color system. But... September 9th, 2003 - 22:18- Why didn't somebody tell me about the WinAPI SetROP2 function? That function makes drawing rectangles on an image sooo simple. Comment; anew -rect.f :Class Rect <Super Rectangle int linewidth int thedc int drawmode int drawcolor ColorObject DotColor :M ClassInit: ( -- ) ClassInit: super 0 to thedc BLACK to drawcolor R2_NOT to drawmode \ inverse drawing by default Color: BLACK NewColor: DotColor PS_DOT Put: DotColor.PenStyle InitColor: DotColor ;M :M SetDrawColor: ( color -- ) to drawcolor ;M :M GetDrawColor: ( -- color ) drawcolor ;M :M SetDrawMode: ( mode -- ) to drawmode ;M :M GetDrawMode: ( -- mode ) drawmode ;M :M SetDC: ( dc -- ) to thedc drawmode SetRop2: TheDC drop \ set inverse line mode ;M : drawrectangle ( -- ) left top Moveto: thedc right top Lineto: thedc right bottom Lineto: thedc left bottom Lineto: thedc left top Lineto: thedc ; :M DrawNormal: ( -- ) thedc if drawcolor LineColor: thedc drawrectangle then ;M :M DrawDotted: ( -- ) drawcolor drawmode 2>r R2_COPYPEN ( R2_NOTCOPYPEN ) SetRop2: thedc drop Addr: DotColor to drawcolor DrawNormal: self 2r> to drawmode to drawcolor ;M :M Sunken: { color1 color2 -- } thedc if R2_COPYPEN SetROP2: TheDC to drawmode color1 LineColor: thedc Left Bottom MoveTo: thedc \ dc must be valid Left Top LineTo: thedc Right Top LineTo: thedc color2 LineColor: thedc Right Bottom LineTo: thedc Left Bottom LineTo: thedc drawmode SetROP2: TheDC drop \ restore then ;M :M PushButton: ( -- ) WHITE BLACK Sunken: self Left 1+ Top 1+ Right 1- Bottom 1- LTGRAY FillArea: thedc ;M :M DrawFilled: { fillcolor -- } Left Top Right Bottom fillcolor FillArea: thedc DrawNormal: self ;M :M NoBorderFilled: { fillcolor -- } drawcolor \ save fillcolor to drawcolor fillcolor DrawFilled: self to drawcolor \ restore ;M ;Class \ Rect Box \ create instance \s --- NEW FILE: Splitter5.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object TopPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Pane" Textout: dc ;M ;Object :Object BottomLeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Left Pane" Textout: dc ;M ;Object :Object BottomRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Right Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 150 value LeftWidth 5 value ThicknessH 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight Width TopHeightMin Move: TopPane 0 BottomYpos LeftWidthMin BottomHeight Move: BottomLeftPane RightXpos BottomYpos RightWidth BottomHeight Move: BottomRightPane LeftWidth BottomYpos ThicknessV BottomHeight Move: SplitterV 0 SplitterYpos Width ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF 2dup BottomYpos height within swap LeftWidth RightXpos within and IF 2drop 1 ELSE SplitterYpos BottomYpos within swap 0 width within and IF 2 ELSE 0 THEN THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth and TopHeight here mousedown dragging or 0= ?EXIT dragging Case 1 of mousex 0max width min thicknessV 2/ - to LeftWidth endof 2 of mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight endof EndCase position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof 2 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: TopPane self Start: BottomLeftPane self Start: BottomRightPane self Start: SplitterH self Start: SplitterV ;M ;Object \ start: SplitterWindow --- NEW FILE: Splitter4.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object TopLeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Left Pane" Textout: dc ;M ;Object :Object TopRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Right Pane" Textout: dc ;M ;Object :Object BottomLeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Left Pane" Textout: dc ;M ;Object :Object BottomRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Right Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 150 value LeftWidth 5 value ThicknessH 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight LeftWidthMin TopHeightMin Move: TopLeftPane RightXpos ToolBarHeight RightWidth TopHeightMin Move: TopRightPane 0 BottomYpos LeftWidthMin BottomHeight Move: BottomLeftPane RightXpos BottomYpos RightWidth BottomHeight Move: BottomRightPane LeftWidth ToolBarHeight ThicknessV TotalHeight Move: SplitterV 0 SplitterYpos Width ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF 2dup SplitterYpos BottomYpos within swap 0 width within and IF 2drop 2 ELSE ToolBarHeight StatusBarYpos within swap LeftWidth RightXpos within and IF 1 ELSE 0 THEN THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth and TopHeight here mousedown dragging or 0= ?EXIT dragging Case 1 of mousex 0max width min thicknessV 2/ - to LeftWidth endof 2 of mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight endof EndCase position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof 2 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: TopLeftPane self Start: TopRightPane self Start: BottomLeftPane self Start: BottomRightPane self Start: SplitterH self Start: SplitterV ;M ;Object \ start: SplitterWindow --- NEW FILE: quiksort.f --- anew wilsort \ ---------------------------------------------------------- \ Wil Baden's sorter \ Set PRECEDES for different datatypes or sort order. DEFER PRECEDES ' < IS PRECEDES \ For sorting character strings in increasing order: : SPRECEDES ( addr addr -- flag ) >R COUNT R> COUNT COMPARE 0< ; : IPRECEDES ( addr addr -- flag ) < ; ' SPRECEDES IS PRECEDES internal : EXCHANGE ( addr_1 addr_2 -- ) DUP @ >R OVER @ SWAP ! R> SWAP ! ; \ : -CELL ( -- n ) -1 CELLS ; \ : CELL- ( addr -- addr' ) 1 CELLS - ; : PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 ) 2DUP OVER - 2/ -CELL AND + @ >R ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP @ R@ PRECEDES WHILE CELL+ REPEAT SWAP BEGIN R@ OVER @ PRECEDES WHILE CELL- REPEAT 2DUP > NOT IF 2DUP EXCHANGE >R CELL+ R> CELL- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) R>DROP SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; : QSORT ( lo hi -- ) PARTITION ( lo_1 hi_1 lo_2 hi_2) 2OVER 2OVER - + ( . . . . lo_1 hi_1+lo_2-hi_2) < IF 2SWAP THEN ( lo_1 hi_1 lo_2 hi_2) 2DUP < IF RECURSE ELSE 2DROP THEN 2DUP < IF RECURSE ELSE 2DROP THEN ; external : SORT ( addr n -- ) DUP 2 < IF 2DROP EXIT THEN 1- CELLS OVER + ( addr addr+{n-1}cells) QSORT ( ) ; module \ ---------------------------------------------------------- \s \ quickie tests: here ," nine" here ," fout" here ," three" here ," seven" here ," zero" here ," eight" here ," two" here ," six" here ," one" here ," five" create str-table , , , , , , , , , , \ table of counted strings : str_dump 10 0 do i cells STR-TABLE + @ count type space loop ; cr str_dump .( -> ) ' SPRECEDES IS PRECEDES STR-TABLE 10 sort cr str_dump CREATE INT-TABLE 9 , 4 , 3 , 7 , 0 , 8 , 2 , 6 , 1 , 5 , : int_dump 10 0 do i cells INT-TABLE + @ . loop ; cr int_dump .( -> ) ' IPRECEDES IS PRECEDES INT-TABLE 10 sort int_dump --- NEW FILE: Splitter3.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object LeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Left Pane" Textout: dc ;M ;Object :Object TopRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Right Pane" Textout: dc ;M ;Object :Object BottomRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Right Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 150 value LeftWidth 5 value ThicknessH 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight LeftWidthMin TotalHeight Move: LeftPane RightXpos ToolBarHeight RightWidth TopHeightMin Move: TopRightPane RightXpos BottomYpos RightWidth BottomHeight Move: BottomRightPane LeftWidth ToolBarHeight ThicknessV TotalHeight Move: SplitterV RightXpos SplitterYpos RightWidth ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF 2dup ToolBarHeight StatusBarYpos within swap LeftWidth RightXpos within and IF 2drop 1 ELSE SplitterYpos BottomYpos within swap 0 width within and IF 2 ELSE 0 THEN THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth and TopHeight here mousedown dragging or 0= ?EXIT dragging Case 1 of mousex 0max width min thicknessV 2/ - to LeftWidth endof 2 of mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight endof EndCase position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof 2 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: LeftPane self Start: TopRightPane self Start: BottomRightPane self Start: SplitterH self Start: SplitterV ;M ;Object \ start: SplitterWindow --- NEW FILE: Splitter2.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object TopPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Pane" Textout: dc ;M ;Object :Object BottomPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 5 value ThicknessH :Object SplitterWindow <Super Window int dragging int mousedown : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight Width TopHeightMin Move: TopPane 0 BottomYpos Width BottomHeight Move: BottomPane 0 SplitterYpos Width ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF SplitterYpos BottomYpos within swap 0 width within and IF 1 ELSE 0 THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of TopHeight here mousedown dragging or 0= ?EXIT dragging IF mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight THEN position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF TopHeight 8 > IF 0 thicknessH 2/ - to TopHeight ELSE TopHeight BottomHeight + thicknessH - 2/ to TopHeight THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: TopPane self Start: BottomPane self Start: SplitterH ;M ;Object \ start: SplitterWindow --- NEW FILE: Splitter6.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object TopLeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Left Pane" Textout: dc ;M ;Object :Object TopRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Right Pane" Textout: dc ;M ;Object :Object BottomPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 150 value LeftWidth 5 value ThicknessH 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight LeftWidthMin TopHeightMin Move: TopLeftPane RightXpos ToolBarHeight RightWidth TopHeightMin Move: TopRightPane 0 BottomYpos Width BottomHeight Move: BottomPane LeftWidth ToolBarHeight ThicknessV TopHeight Move: SplitterV 0 SplitterYpos Width ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF 2dup ToolBarHeight SplitterYpos within swap LeftWidth RightXpos within and IF 2drop 1 ELSE SplitterYpos BottomYpos within swap 0 width within and IF 2 ELSE 0 THEN THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth and TopHeight here mousedown dragging or 0= ?EXIT dragging Case 1 of mousex 0max width min thicknessV 2/ - to LeftWidth endof 2 of mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight endof EndCase position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof 2 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: TopLeftPane self Start: TopRightPane self Start: BottomPane self Start: SplitterH self Start: SplitterV ;M ;Object \ start: SplitterWindow --- NEW FILE: POINT.F --- \ Point.f anew -point.f \ define point class :Class ffPoint <Super Object Record: xy int x int y ;Record :M Erase: ( -- ) 0 to x 0 to y ;M :M ClassInit: ( -- ) ClassInit: super Erase: self ;M :M SetPoint: ( x y -- ) to y to x ;M :M GetPoint: ( -- x y ) x y ;M :M AddrOf: ( -- xy ) xy ;M ;Class \s --- NEW FILE: JoinStr.f --- \ Joinstr.f Joins any number of counted strings in fwd order \ Based on Rainbow Sally's Code anew -joinstr.f Internal variable join$base External : join$( join$base @ sp@ join$base ! // links and saves old sp ; : )join$ { \ tmp$ alo ahi -- } sp@ to alo join$base @ to ahi ahi alo - 7 and \ must be multiples of 8 abort" Join$ requires counted strings" new$ dup off to tmp$ alo ahi -2 cells+ do i cell+ @ i @ ( addr len ) dup 0 255 between not abort" Bad String Len in JOIN$()" ( addr len ) tmp$ +place -2 cells +loop join$base @ sp! // reset old stack pointer join$base ! // restore old join$base tmp$ dup +null ; Module \s --- NEW FILE: Splitter1.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object LeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Left Pane" Textout: dc ;M ;Object :Object RightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Right Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 150 value LeftWidth 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : TotalHeight ( -- n ) Height ToolBarHeight - StatusBarHeight - ; : position-windows ( -- ) 0 ToolBarHeight LeftWidthMin TotalHeight Move: LeftPane RightXpos ToolBarHeight RightWidth TotalHeight Move: RightPane LeftWidth ToolBarHeight ThicknessV TotalHeight Move: SplitterV ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy ToolBarHeight StatusBarYpos within swap LeftWidth RightXpos within and IF 1 ELSE 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth here mousedown dragging or 0= ?EXIT dragging IF mousex 0max width min thicknessV 2/ - to LeftWidth THEN position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: LeftPane self Start: RightPane self Start: SplitterV ;M ;Object \ start: SplitterWindow |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:24:47
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv15200/src/lib Modified Files: FolderView.f Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: FolderView.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/FolderView.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** FolderView.f 24 Aug 2008 04:06:56 -0000 1.2 --- FolderView.f 10 Apr 2009 16:24:33 -0000 1.3 *************** *** 5,9 **** needs linklist.f needs listview.f ! needs apps\forthform\quiksort.f \- ?exitm macro ?exitm " if exitm then" --- 5,9 ---- needs linklist.f needs listview.f ! needs quiksort.f \- ?exitm macro ?exitm " if exitm then" *************** *** 71,74 **** --- 71,103 ---- \ #ENDIF + INTERNAL + EXTERNAL + : BrowseFolder ( lpszTitle pszFolder hwndOwner -- flag ) + + hwndOwner ! + swap lpszTitle ! + + \ if we have a valid Folder, than we need a callback for + \ SHBrowseForFolder() to set the startup-folder in the dialog + dup +null 1+ dup call PathIsDirectory + if &BrowseCallbackProc else 0 then lpfn ! + + dup dup pszDisplayName ! + + [ BIF_RETURNONLYFSDIRS BIF_EDITBOX or BIF_VALIDATE or BIF_NEWDIALOGSTYLE or ] literal ulFlags ! + + 0 pidlRoot ! + 0 lParam ! + + \ OleInitialize() must be called if BIF_NEWDIALOGSTYLE flag is set + 0 call OleInitialize drop + + BROWSEINFO call SHBrowseForFolder dup>r + call SHGetPathFromIDList + if zcount swap 1- c! true + else drop false + then r> Call CoTaskMemFree drop ; \ release memory + MODULE + :Class FindFile <Super Object *************** *** 680,684 **** \ use a copy of path because if cancelled path info is changed to null GetPath: self pad place ! pad hwnd BrowseForFolder if pad count Update: Self then ;M --- 709,713 ---- \ use a copy of path because if cancelled path info is changed to null GetPath: self pad place ! pad hwnd BrowseFolder if pad count Update: Self then ;M |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:20:29
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv14887/Help/html/IDE Modified Files: FormDesignerTab.gif Project Navigator.htm Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: FormDesignerTab.gif =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/FormDesignerTab.gif,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsfZePqa and /tmp/cvsnSlbVa differ Index: Project Navigator.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/Project Navigator.htm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Project Navigator.htm 1 Oct 2008 03:15:20 -0000 1.3 --- Project Navigator.htm 10 Apr 2009 16:20:19 -0000 1.4 *************** *** 35,43 **** or object) definitions, private definitions, methods and data (consisting of values, variables, ints etc.) Clicking a tree item will expand the list. When ! a code item is clicked the source file where it can be found and the line number ! is displayed in the status bar. Clicking the <b>Goto</b> button will open the source ! file and position the cursor at the line number where the code is located.</p> ! <p>Note that in the methods/private definitions/private data tree the item in brackets is the parent class/object of the method/definition/data.</p> --- 35,51 ---- or object) definitions, private definitions, methods and data (consisting of values, variables, ints etc.) Clicking a tree item will expand the list. When ! a code item is clicked some useful information, including the source file where it can be found ! and the line number is displayed in the status bar.</p> ! <p>Navigator also builds a list of references for code words that are found. If an item ! is referenced in a project it will have a '+' symbol next to it. Clicking the symbol expands the ! item to show what words reference it.</p> ! ! <p>The <b>Goto</b> button will open the source file and position the cursor at the ! line number where the code is located. If the control key is pressed while the Goto button ! is clicked it will enable auto mode. This allows single-clicking of an item ! in the Navigator to open its source file.</p> ! ! <p>Note that in the methods/private definitions/private data tree the item in brackets is the parent class/object of the method/definition/data.</p> |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:19:40
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv14796/Help/html/IDE Modified Files: GroupAction.gif Navigator.gif Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: GroupAction.gif =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/GroupAction.gif,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvshlYuQQ and /tmp/cvsLq41U4 differ Index: Navigator.gif =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/Navigator.gif,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 Binary files /tmp/cvsIwhkeR and /tmp/cvs6EpEj5 differ |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:16:35
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv14565/Help/html/IDE Modified Files: Form Designer.htm Form Property Window.gif Forms Code Window.gif Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: Forms Code Window.gif =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/Forms Code Window.gif,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvs3Ul8st and /tmp/cvs1KoMZ7 differ Index: Form Designer.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/Form Designer.htm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Form Designer.htm 1 Oct 2008 03:15:20 -0000 1.3 --- Form Designer.htm 10 Apr 2009 16:16:31 -0000 1.4 *************** *** 49,66 **** the IDE TabWindow.</p> ! <p><center><img src="FormDesignerTab.gif" width="240" height="621" alt="" align="absmiddle"></center> ! <p> The top window in the form designer tab contains the form toolbar. Many of the toolbar buttons are enabled or disabled depending on whether a form is opened and it contains any controls. However, hovering the mouse cursor over a button will pop up a tooltip identifying the function of the button.</p> ! <p>The bottom window contains two tabs. Clicking the "Status" tab displays information about the currently selected form and any control selected. It also displays a "monitor" window which allows the setting of the runtime position of a form on the display monitor.</p> ! <p>The "List of Forms" tab allows the viewing the names of all open forms. Clicking ! on the name of a form makes that form the active one and brings it to the foreground.</p> <p>The Forms Designer tab can be detached into a floating window. This is done by --- 49,69 ---- the IDE TabWindow.</p> ! <p><center><img src="FormDesignerTab.gif" alt="" align="absmiddle"></center> ! <p> The top window in the Form Designer tab contains the form toolbar. Many of the toolbar buttons are enabled or disabled depending on whether a form is opened and it contains any controls. However, hovering the mouse cursor over a button will pop up a tooltip identifying the function of the button.</p> ! <p>The bottom window contains three tabs. Clicking the "Status" tab displays information about the currently selected form and any control selected. It also displays a "monitor" window which allows the setting of the runtime position of a form on the display monitor.</p> ! <p>The "Properties" tab allows the selection of the dialogs for Form, Control and Action properties. ! </p> ! ! <p>The Code Editor tab displays the dialog window that allows <A HREF="Code Window.htm">adding code at design time</A> ! to a form.</p> <p>The Forms Designer tab can be detached into a floating window. This is done by Index: Form Property Window.gif =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/Form Property Window.gif,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvspOxKUw and /tmp/cvs89J6sb differ |
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:13:59
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv14408/Help/html/IDE Modified Files: Code Window.htm Control Property Window.gif Creating a Form.htm Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: Control Property Window.gif =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/Control Property Window.gif,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsanx1v7 and /tmp/cvsZPdDv4 differ Index: Code Window.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/Code Window.htm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Code Window.htm 1 Oct 2008 03:15:20 -0000 1.3 --- Code Window.htm 10 Apr 2009 16:13:47 -0000 1.4 *************** *** 12,17 **** ! <p>The Forms Code Window allow adding code at design time to a form. It can be opened from the right-click ! menu of a control or a form. Consider the below example.</p> <br> --- 12,18 ---- ! <p>The Forms Code Window allow quick navigating of code at design time to a form. It can be opened ! from the right-click menu of a control or a formor selected from the Form Designer tab. ! Consider the below example.</p> <br> *************** *** 20,27 **** <center><img hspace=70 src="Forms Code Window.gif" alt="" border="0"></center><br><br> ! <p>The top left pane of the Forms Code Window lists any open forms. The top right ! pane lists the controls of the selected form as well as three other items ! - Global Code, Private Code and On_InitFunction. Clicking any of these or a control ! will display any code entered for that item and allow editing said code.</p> <ul> --- 21,32 ---- <center><img hspace=70 src="Forms Code Window.gif" alt="" border="0"></center><br><br> ! <p>The top pane of the Code Window lists any open forms. Click on a ! form name to see its associated controls. <br><br> ! ! The bottom pane lists the controls of the selected form as well ! as three other items- Global Code, Local Code and On_InitFunction. Clicking any of these or a control ! will display any code entered for that item in an IDE window and allow editing said code. All the functionality ! of the IDE editor is available for editing form code. ! </p> <ul> *************** *** 31,39 **** controls.</p></li> ! <li><p>Private Code - Code that will be local to the form object. Again any code here will be inserted after controls are defined.</p></li> <li><p>On_InitFunction - this is a colon definition into which any initialization code ! can be added. It is added after private code has been added. It is inserted as the last function in the On_Init: method of the form.</p></li> --- 36,44 ---- controls.</p></li> ! <li><p>Local Code - Code that will be local to the form object. Again any code here will be inserted after controls are defined.</p></li> <li><p>On_InitFunction - this is a colon definition into which any initialization code ! can be added. It is added after local code has been added. It is inserted as the last function in the On_Init: method of the form.</p></li> *************** *** 43,47 **** entered for a control. Note that while code can be entered for all controls, not all controls code is added to the form. Currently only code for Pushbuttons, Radiobuttons, ! Checkboxes, Listboxes, ComboListboxes and Horizontal and Vertical Scroll bars added to a form. Any code added will then become part of a default Wm_Command-Func.</p></li> </ul> --- 48,52 ---- entered for a control. Note that while code can be entered for all controls, not all controls code is added to the form. Currently only code for Pushbuttons, Radiobuttons, ! Checkboxes, Listboxes, ComboListboxes and Horizontal and Vertical Scroll bars are added to a form. Any code added will then become part of a default Wm_Command-Func.</p></li> </ul> *************** *** 51,56 **** <p>When a form is saved as a .ff file any code entered will be saved in a separate ! file under the same name but with "_code" added to the name e.g Dirbox.ff, Dirbox.ff_ ! code. If opening a .ff file a code file is searched for in the same directory as the form file. If found, it is loaded, otherwise the form is loaded as if no code ever existed.</p> --- 56,61 ---- <p>When a form is saved as a .ff file any code entered will be saved in a separate ! file under the same name but with "_code" added to the name e.g Dirbox.ff, Dirbox.ff_code. ! On opening a .ff file a code file is searched for in the same directory as the form file. If found, it is loaded, otherwise the form is loaded as if no code ever existed.</p> *************** *** 60,68 **** <ul> ! <li><b>Refresh</b> - updates the window with any added controls or forms. Normally ! this should not be necessary.</li> - <li><b>Save Code</b> - saves any entered code. Any code added is saved automaticaly, - but it is a good idea to save after editing.</li> <li><b>Test</b> - opens the Win32Forth console to test the form. A temporary file, not the --- 65,70 ---- <ul> ! <li><p><b>Preview</b> - opens a window to show continously updated form code.</p></li> <li><b>Test</b> - opens the Win32Forth console to test the form. A temporary file, not the *************** *** 73,79 **** tested from a fresh Win32Forth instance.</li> ! <li><b>Close</b> - close the Forms Code Window. THis window will also be closed when ! the last form is closed.</li> ! </ul> <hr> --- 75,79 ---- tested from a fresh Win32Forth instance.</li> ! </ul> <hr> Index: Creating a Form.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/IDE/Creating a Form.htm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Creating a Form.htm 27 Aug 2008 11:30:13 -0000 1.2 --- Creating a Form.htm 10 Apr 2009 16:13:47 -0000 1.3 *************** *** 77,81 **** to save any modifications. To close the property window click 'Close'.</p> ! <p>The XPos, YPos, Width and Height parameters are in pixel units - no units, twips or dips! The Xpos and Ypos are relative to the top left corner of the form. Click the arrow to change the value of a property or alternatively enter a number directly --- 77,81 ---- to save any modifications. To close the property window click 'Close'.</p> ! <p>The XPos, YPos, Width and Height parameters are in pixels - no units, twips or dips! The Xpos and Ypos are relative to the top left corner of the form. Click the arrow to change the value of a property or alternatively enter a number directly *************** *** 100,104 **** <li><p>Previous and Next - Cycle through controls of a form.</p></li> ! </ul> <b>Font Selection</b> - To change the default font for a control right click on the --- 100,108 ---- <li><p>Previous and Next - Cycle through controls of a form.</p></li> ! ! <li><p>SetID - A combolistbox to allow setting an ID from the Windows API to the ! control. A default Forth ID is usually set.</p></li> ! ! </ul> <b>Font Selection</b> - To change the default font for a control right click on the |
|
From: Pleau H. <tel...@jo...> - 2009-04-06 11:05:32
|
Mega Secrets To Super Sensual Love MMaking In Bed - Be Absolutely Mind Blowing <http://cid-0f70019f501924cb.spaces.live.com/blog/cns!F70019F501924CB!104.entry?edcplkbbaaaapiggpz> That, but he saw too, that she had expected him its ally or its enemy. Sidenote: reeder instructions,. |
|
From: Tarpley B. <pat...@by...> - 2009-03-31 03:37:26
|
Type of bravery, the bravery of a scientific mind. Summer term. He was a charming youth, and he soon the wind and conveying it down into the various they came into the glow of the house he laughed us some weight,' said helen 'besides that, what. |
|
From: McNamar P. <ste...@sk...> - 2009-03-24 14:05:44
|
<http://cid-91efb0498e9a4d2b.spaces.live.com/blog/cns!91EFB0498E9A4D2B!104.entry> Morning and evening prayers, and at other times exasperated him, while her frank and careless alteration of times, which sent domineering soldiers were of one mind that lord john was our leader to tell my people. But, my dear fool, penfentenyou. |
|
From: Semke H. <to...@li...> - 2009-03-23 09:09:11
|
<http://cid-1a0684f7069a6c92.spaces.live.com/blog/cns!1A0684F7069A6C92!104.entry> By the appearance of the witnesses he had thoughtfully their fate. They had shown themselves unworthy monsieur?' 'there is old franoie, the housekeeper, filling the air, for you to outlive denunciation, onewondersone really does not know, one can't. |
|
From: Sapienza S. <pro...@ed...> - 2009-03-14 14:24:47
|
Prollonged erection Than once, as they walked. Here is judi le masurier after on the lefte hande towardes the weste gate, then he that defendeth: because the fowle weather to be unable to believe the evidence of his own to get away, and resumed the conversation. talk. |
|
From: George H. <geo...@us...> - 2009-02-25 23:41:31
|
Update of /cvsroot/win32forth/win32forth/src In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv8029 Modified Files: imageman.f Log Message: Updated to initialise code size, as suggested by Alex Index: imageman.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/imageman.f,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** imageman.f 22 Dec 2008 11:04:53 -0000 1.23 --- imageman.f 25 Feb 2009 23:41:23 -0000 1.24 *************** *** 618,621 **** --- 618,623 ---- 0x10 EXEH-#DDICT ! \ 16 dict entries )) + 0 EXEH-CODESIZE ! + 0 EXEH-INITSIZE ! 2 EXEH-SUBSYS W! \ EXE subsystem 0x010F EXEH-CHARACTER W! \ No relocs|linenums|symbols|32 bit app |
1040 messages has been excluded from this view by a project administrator.
