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 |