Menu
▾
▴
[Win32forth-cvs] win32forth/src CONTROL.F, 1.14, 1.15 GENERIC.F, 1.31, 1.32 Pre-save.f, 1.7, 1.8 Primutil.f, 1.65, 1.66
|
From: George H. <geo...@us...> - 2013-11-28 20:51:58
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv1710 Modified Files: CONTROL.F GENERIC.F Pre-save.f Primutil.f Log Message: Added suppress-system for DOES> words. Moved setting of locks to pre-save and minor tweeks to GUI. Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v retrieving revision 1.31 retrieving revision 1.32 diff -C2 -d -r1.31 -r1.32 *** GENERIC.F 20 Nov 2013 12:28:36 -0000 1.31 --- GENERIC.F 28 Nov 2013 20:51:55 -0000 1.32 *************** *** 115,119 **** in-previous ! 1 bits AmDialog 1 bits wStatus1 1 bits wStatus2 --- 115,119 ---- in-previous ! 1 bits wStatus0 ' wStatus0 alias AmDialog \ Can be aliased by descendants of CONTROL only 1 bits wStatus1 1 bits wStatus2 *************** *** 294,298 **** :M Scroll: { x y -- } ! \ *G The ScrollWindow function scrolls the contents of the specified window's client area. hWnd if 0 0 y x hWnd Call ScrollWindow drop --- 294,298 ---- :M Scroll: { x y -- } ! \ *G Scroll the contents of the specified window's client area. hWnd if 0 0 y x hWnd Call ScrollWindow drop *************** *** 300,304 **** :M Move: { x y w h -- } ! \ *G The MoveWindow function changes the position and dimensions of window. \ ** For a top-level window, the position and dimensions are relative to the upper-left corner \ ** of the screen. For a child window, they are relative to the upper-left corner of the parent --- 300,304 ---- :M Move: { x y w h -- } ! \ *G Change the position and dimensions of window. \ ** For a top-level window, the position and dimensions are relative to the upper-left corner \ ** of the screen. For a child window, they are relative to the upper-left corner of the parent *************** *** 451,467 **** :M GetStyle: ( -- style ) ! \ *G Retrieves the window styles. GWL_STYLE GetWindowLong: self ;M :M SetStyle: ( style -- ) ! \ *G Sets a new window style. GWL_STYLE SetWindowLong: self drop ;M :M +Style: ( style -- ) ! \ *G Add a window style. GetStyle: self OR SetStyle: self ;M :M -Style: ( style -- ) ! \ *G Remove a window style. INVERT GetStyle: self AND SetStyle: self ;M --- 451,467 ---- :M GetStyle: ( -- style ) ! \ *G Retrieves the window styles of a running window. GWL_STYLE GetWindowLong: self ;M :M SetStyle: ( style -- ) ! \ *G Sets a new window style of a running window. GWL_STYLE SetWindowLong: self drop ;M :M +Style: ( style -- ) ! \ *G Add a window style to a running window. GetStyle: self OR SetStyle: self ;M :M -Style: ( style -- ) ! \ *G Remove a window style from a running window. INVERT GetStyle: self AND SetStyle: self ;M *************** *** 653,669 **** \ The following definitions are for handling Dialog messages and have been moved \ here rather than have multiple copies of the code in different descendants - : +DialogList ( -- ) \ link into dialog list in Start: - 1 to AmDialog ; : ?DoAddDialogList ( -- ) \ Needs to be in On_Init: for all dialogs and dialog-windows. AmDialog 0<> dialoglink @ 0= and if dialoglink Dialog-link add-link then ; - : -DialogList ( -- ) \ don't link from dialog list in Start: - 0 to AmDialog ; - : ?DoRemoveDialogList ( -- ) \ Needs to be in On_Done: for all dialogs and dialog-windows. AmDialog 0<> dialoglink @ 0<> and if dialoglink \ Normally this is achieved through inheritance Dialog-link un-link drop dialoglink off then ; \ by using On_Done: Super. : DoDialogMsg { pMsg flag -- pMsg f | pMsg FALSE } Dialog-link \ all dialog handles --- 653,676 ---- \ The following definitions are for handling Dialog messages and have been moved \ here rather than have multiple copies of the code in different descendants : ?DoAddDialogList ( -- ) \ Needs to be in On_Init: for all dialogs and dialog-windows. AmDialog 0<> dialoglink @ 0= and if dialoglink Dialog-link add-link then ; : ?DoRemoveDialogList ( -- ) \ Needs to be in On_Done: for all dialogs and dialog-windows. AmDialog 0<> dialoglink @ 0<> and if dialoglink \ Normally this is achieved through inheritance Dialog-link un-link drop dialoglink off then ; \ by using On_Done: Super. + : +DialogList ( -- ) \ link into dialog list in Start: + \ *G Used so window responds to Dialog messages. Used by ModeLessDialog DialogWindow and + \ ** MdiDialog classes but can be added to any descendants of class Window (including + \ ** descendants of Child-Window) so they can respond to dialog messages. Can also be + \ ** used programatically. + 1 to AmDialog hwnd if ?DoAddDialogList then ; + + : -DialogList ( -- ) \ don't link from dialog list in Start: + \ *G Disable responding to dialog messages. This was mainly used for the ~: destructor method + \ ** though is no longer needed. Can also be used programatically. + hwnd if ?DoRemoveDialogList then 0 to AmDialog ; + : DoDialogMsg { pMsg flag -- pMsg f | pMsg FALSE } Dialog-link \ all dialog handles Index: Pre-save.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Pre-save.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Pre-save.f 15 Nov 2013 19:35:03 -0000 1.7 --- Pre-save.f 28 Nov 2013 20:51:55 -0000 1.8 *************** *** 66,68 **** --- 66,93 ---- pre-save-image-chain chain-add PreInitAppID + dpr-warning-off + + : pre-init-system-locks-off ( -- ) + \ *G Set all the system deferred words for locking and unlocking (except (memlock) and + \ ** (memunlock) which are set by the kernel) to noops in the image. This is done for + \ ** the system so that at start-up code that uses them will work correctly before the locks + \ ** are initialised. + ['] noop is-image (controllock) + ['] noop is-image (controlunlock) + ['] noop is-image (dialoglock) \ no longer needed + ['] noop is-image (dialogunlock) \ no longer needed + ['] noop is-image (classnamelock) + ['] noop is-image (classnameunlock) + ['] noop is-image (pointerlock) + ['] noop is-image (pointerunlock) + ['] noop is-image (dynlock) + ['] noop is-image (dynunlock) + ['] noop is-image (gdilock) + ['] noop is-image (gdiunlock) + ; + + dpr-warning-on + + pre-save-image-chain chain-add pre-init-system-locks-off + in-previous Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.65 retrieving revision 1.66 diff -C2 -d -r1.65 -r1.66 *** Primutil.f 20 Nov 2013 12:28:36 -0000 1.65 --- Primutil.f 28 Nov 2013 20:51:55 -0000 1.66 *************** *** 251,254 **** --- 251,256 ---- r> to sys-warning? throw ; immediate + : Suppress-system suppress on ; + : allot-to ( n1 -- ) \ *G Extend the dictionary space of most recent word compile to length n1. *************** *** 1085,1092 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ defer (controllock) defer (controlunlock) ! defer (dialoglock) ! defer (dialogunlock) defer (classnamelock) defer (classnameunlock) --- 1087,1096 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + dpr-warning-off + defer (controllock) defer (controlunlock) ! defer (dialoglock) deprecated ! defer (dialogunlock) deprecated defer (classnamelock) defer (classnameunlock) *************** *** 1098,1123 **** defer (gdiunlock) ! : init-system-locks-off ( -- ) ! \ *G Set all the system deferred words for locking and unlocking (except (memlock) and ! \ ** (memunlock) which are set by the kernel) to noops. This is done automatically ! \ ** by the system at start-up so code that uses it will work correctly before the locks ! \ ** are initialised. ! ['] noop is (controllock) ! ['] noop is (controlunlock) ! ['] noop is (dialoglock) ! ['] noop is (dialogunlock) ! ['] noop is (classnamelock) ! ['] noop is (classnameunlock) ! ['] noop is (pointerlock) ! ['] noop is (pointerunlock) ! ['] noop is (dynlock) ! ['] noop is (dynunlock) ! ['] noop is (gdilock) ! ['] noop is (gdiunlock) ! ; ! ! init-system-locks-off ! initialization-chain chain-add init-system-locks-off \s --- 1102,1119 ---- defer (gdiunlock) ! ' noop is (controllock) ! ' noop is (controlunlock) ! ' noop is (dialoglock) \ no longer needed ! ' noop is (dialogunlock) \ no longer needed ! ' noop is (classnamelock) ! ' noop is (classnameunlock) ! ' noop is (pointerlock) ! ' noop is (pointerunlock) ! ' noop is (dynlock) ! ' noop is (dynunlock) ! ' noop is (gdilock) ! ' noop is (gdiunlock) ! dpr-warning-on \s Index: CONTROL.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROL.F,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** CONTROL.F 15 Mar 2013 00:23:06 -0000 1.14 --- CONTROL.F 28 Nov 2013 20:51:55 -0000 1.15 *************** *** 102,108 **** int Horizontal int Vertical ! int timering? \ are we opening a popup info window ! int timerclosed? \ has popup been closed ! int auto-close? \ does info window automatically close after a time? int style max-binfo 1+ bytes binfo --- 102,108 ---- int Horizontal int Vertical ! ' wStatus0 alias timering? \ are we opening a popup info window ! ' wStatus1 alias timerclosed? \ has popup been closed ! ' wStatus2 alias auto-close? \ does info window automatically close after a time? int style max-binfo 1+ bytes binfo *************** *** 179,187 **** :M WindowStyle: ( -- style ) \ *G Get the window style of this control ! [ WS_CHILD WS_VISIBLE or ] literal ;M :M AddStyle: ( n -- ) \ *G Set any additional style of the control. Must be done before the control ! \ ** is created. to style ;M --- 179,187 ---- :M WindowStyle: ( -- style ) \ *G Get the window style of this control ! [ WS_CHILD WS_VISIBLE or ] literal style or ;M :M AddStyle: ( n -- ) \ *G Set any additional style of the control. Must be done before the control ! \ ** is started. Use +Style: to add to a running control. to style ;M *************** *** 249,253 **** :M GetAutoClose: ( -- flag ) ! auto-close? ;M :M WM_TIMER ( h m w l -- res ) --- 249,253 ---- :M GetAutoClose: ( -- flag ) ! auto-close? 0<> ;M :M WM_TIMER ( h m w l -- res ) |
