Update of /cvsroot/win32forth/win32forth-stc/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25317/win32forth-stc/src
Modified Files:
Menu.f Utils.f primutil.f
Log Message:
gah:Added more utility words to PrimUtils and Utils. Removed hide form Menus (it was causing the wrong things to be hidden for unnamed menus)
Index: Utils.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/Utils.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Utils.f 30 Apr 2007 07:49:26 -0000 1.1
--- Utils.f 3 May 2007 09:00:02 -0000 1.2
***************
*** 17,20 ****
--- 17,28 ----
in-application
+ \ ---------------------------------------------------------------------------
+ \ ------------------ Miscelaneous Constants ---------------------------------
+ \ ---------------------------------------------------------------------------
+
+ 260 constant max-handle
+ ' name>xt alias name>
+ Library Shell32.dll
+
: screen-size ( -- width height ) \ get windows screen size
SM_CXSCREEN call GetSystemMetrics \ screen width
***************
*** 630,635 ****
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! module \s
! internal
fload builtby.f
--- 638,643 ----
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! \ module \s
! (( internal
fload builtby.f
***************
*** 642,646 ****
else drop
then ;
!
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ 20 Random number generator for Win32Forth
--- 650,654 ----
else drop
then ;
! ))
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ 20 Random number generator for Win32Forth
***************
*** 673,677 ****
\ 21 Delay Time Words
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
!
\ old Win32s support removed
\ September 17th, 2003 - 10:38 dbu
--- 681,685 ----
\ 21 Delay Time Words
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! ((
\ old Win32s support removed
\ September 17th, 2003 - 10:38 dbu
***************
*** 760,764 ****
EXTERNAL
!
: make-cursor ( cursor_constant appinst -- )
create , ,
--- 768,772 ----
EXTERNAL
! ))
: make-cursor ( cursor_constant appinst -- )
create , ,
***************
*** 797,801 ****
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
!
in-system
--- 805,809 ----
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! ((
in-system
***************
*** 808,812 ****
POSTPONE evaluate
POSTPONE ; immediate ;
!
MODULE
--- 816,820 ----
POSTPONE evaluate
POSTPONE ; immediate ;
! ))
MODULE
Index: primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v
retrieving revision 1.28
retrieving revision 1.29
diff -C2 -d -r1.28 -r1.29
*** primutil.f 30 Apr 2007 07:49:26 -0000 1.28
--- primutil.f 3 May 2007 09:00:02 -0000 1.29
***************
*** 163,166 ****
--- 163,180 ----
' _\n->crlf is \n->crlf \ link into kernel deferred word
+ : -null, ( -- )
+ 5 0 \ remove previous nulls
+ do here 1- c@ ?leave
+ -1 ALLOT
+ loop ;
+
+ : Z", ( addr len -- ) \ W32F String Extra
+ \ *G Compile the string, addr len at here.
+ HERE OVER ALLOT swap cmove ;
+
+ : Z," ( -<string">- ) \ compile string" at here
+ HERE [CHAR] " PARSE Z", 0 C, ALIGN ZCOUNT \N->CRLF
+ ;
+
\ Moved to user area to make asciiz thread safe gah 28jun04
MAXSTRING newuser z-buf
***************
*** 172,175 ****
--- 186,195 ----
z-buf ascii-z ;
+ : +z," ( -<text">- )
+ -null, z," ;
+
+ : +z", ( a1 n1 -- )
+ -null, z", ;
+
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
***************
*** 355,358 ****
--- 375,394 ----
;
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+ \ Limited support for the '#define' statment from 'C'
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
+ in-system
+
+ : #define ( -<name expression>- )
+ >in @ >r
+ bl word drop bl word 1+ c@ [char] " =
+ r> >in !
+ if create /parse-s$ count ",
+ else >in @ >r bl word drop interpret r> >in ! constant bl word drop
+ then ;
+
+ in-application
+
\ ------------------------------------------------------------------------
\ Often used
Index: Menu.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/Menu.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Menu.f 30 Apr 2007 07:49:26 -0000 1.1
--- Menu.f 3 May 2007 09:00:02 -0000 1.2
***************
*** 262,266 ****
NextId to mid
:noname to mfunc
! hide !csp
BREAK_FLAG to BROKEN_FLAG
0 to BREAK_FLAG
--- 262,266 ----
NextId to mid
:noname to mfunc
! !csp
BREAK_FLAG to BROKEN_FLAG
0 to BREAK_FLAG
***************
*** 536,544 ****
: (ClassInit) ( -- )
[ warning on ]
! ClassInit: super
! m"text"
! :noname to mfunc
! hide !csp
! ;
in-application
--- 536,540 ----
: (ClassInit) ( -- )
[ warning on ]
! ClassInit: super m"text" :noname to mfunc !csp ;
in-application
|
