Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28933/win32forth/src/lib
Modified Files:
FCOM.F toolbar.f
Log Message:
gah:More dexing and minor optimisations
Index: toolbar.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/toolbar.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** toolbar.f 29 Jun 2006 04:09:43 -0000 1.4
--- toolbar.f 13 Sep 2006 09:34:57 -0000 1.5
***************
*** 21,24 ****
--- 21,28 ----
Change log:
+
+ September 12th, 2006 - 20:47 - gah
+ Added \in-system-ok to account for ?pairs being moved to system space
+
September 25th, 2005 - 18:59 - Rod
Changed to use Control rather than Child-Window
***************
*** 97,101 ****
;
: ;ToolBarTable ( addr1 addr2 12 -- )
! 12 ?pairs
here rot ! \ Resolve address of cust. table
here 0 , \ no of buttons in cust. table
--- 101,105 ----
;
: ;ToolBarTable ( addr1 addr2 12 -- )
! \in-system-ok 12 ?pairs
here rot ! \ Resolve address of cust. table
here 0 , \ no of buttons in cust. table
***************
*** 115,119 ****
;
: ToolBarTableExtraButtons: ( addr 12 -- addr 12 )
! dup 12 ?pairs
over dup @ swap cell- !
;
--- 119,123 ----
;
: ToolBarTableExtraButtons: ( addr 12 -- addr 12 )
! \in-system-ok dup 12 ?pairs
over dup @ swap cell- !
;
***************
*** 121,125 ****
2>r rot ( bidx) , swap ( id) , ( state) c,
2r> swap ( style) c, 0 w, 0 , ( txtno) ,
! dup 12 ?pairs over 1 swap +!
;
: SeparatorButton, ( addr 12 -- addr 12 )
--- 125,129 ----
2>r rot ( bidx) , swap ( id) , ( state) c,
2r> swap ( style) c, 0 w, 0 , ( txtno) ,
! \in-system-ok dup 12 ?pairs over 1 swap +!
;
: SeparatorButton, ( addr 12 -- addr 12 )
***************
*** 160,164 ****
;
: ;ToolStrings ( addr 13 -- )
! 13 ?pairs
0 , align
here over ! \ Resolve address of address table
--- 164,168 ----
;
: ;ToolStrings ( addr 13 -- )
! \in-system-ok 13 ?pairs
0 , align
here over ! \ Resolve address of address table
***************
*** 174,178 ****
;
: ts," ( 13 -<string">- 13 )
! dup 13 ?pairs
state @
if true abort" Illegal use of tool string compiler"
--- 178,182 ----
;
: ts," ( 13 -<string">- 13 )
! \in-system-ok dup 13 ?pairs
state @
if true abort" Illegal use of tool string compiler"
***************
*** 375,379 ****
else
to Parent
! z" ToolbarWindow32" Create-Control
register-struct-size
--- 379,383 ----
else
to Parent
! z" ToolbarWindow32" Create-Control
register-struct-size
***************
*** 632,636 ****
else 0
then ;M
!
;Class
--- 636,640 ----
else 0
then ;M
!
;Class
Index: FCOM.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/FCOM.F,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** FCOM.F 19 Aug 2006 01:50:52 -0000 1.4
--- FCOM.F 13 Sep 2006 09:34:57 -0000 1.5
***************
*** 797,801 ****
: cguid ( tinfo -- ) \ compiles a guid
>r rp@ tattr-allot dup UseStruct TYPEATTR guid
! state @ if 16 POSTPONE SLITERAL POSTPONE DROP
else 16 new$ dup >r place r> 1+ then
rp@ swap tattr-free rp@ UCOM ITypeInfo IReleaseref drop r> drop ;
--- 797,801 ----
: cguid ( tinfo -- ) \ compiles a guid
>r rp@ tattr-allot dup UseStruct TYPEATTR guid
! \in-system-ok state @ if 16 POSTPONE SLITERAL POSTPONE DROP
else 16 new$ dup >r place r> 1+ then
rp@ swap tattr-free rp@ UCOM ITypeInfo IReleaseref drop r> drop ;
|
