Update of /cvsroot/win32forth/win32forth-stc/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12728/win32forth-stc/src
Modified Files:
Class.f Dc.f GENERIC.F Window.f
Log Message:
gah:Tidied up loading message order plus additions and bugfixes to class.f
Index: Window.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/Window.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Window.f 30 Apr 2007 07:49:26 -0000 1.1
--- Window.f 1 May 2007 07:41:55 -0000 1.2
***************
*** 6,17 ****
\ *S Glossary
cr .( Loading Window Class...)
\ Window class
- only forth also definitions
-
- require generic.f
-
in-application
--- 6,15 ----
\ *S Glossary
+ require generic.f
+
cr .( Loading Window Class...)
\ Window class
in-application
***************
*** 244,248 ****
3 pick ( msg ) over obj>class MFA ((findm))
if sp0 @ >r sp@ 4 cells+ sp0 !
! dup>r catchm
?dup
if r@ WndProcError
--- 242,246 ----
3 pick ( msg ) over obj>class MFA ((findm))
if sp0 @ >r sp@ 4 cells+ sp0 !
! dup>r MethodCatch
?dup
if r@ WndProcError
***************
*** 932,934 ****
--- 930,934 ----
NULL call LoadImage ;
+ in-previous
+
\ *Z
Index: Dc.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/Dc.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Dc.f 30 Apr 2007 07:49:26 -0000 1.1
--- Dc.f 1 May 2007 07:41:55 -0000 1.2
***************
*** 1,4 ****
--- 1,10 ----
\ $Id$
+ needs utils.f
+ needs gdi/gdiDC.f
+ needs colors.f
+ needs PrintSupport.f
+ needs Fonts.f
+
cr .( Loading Device Context and Printing...)
***************
*** 13,22 ****
in-application
- needs utils.f
- needs gdi/gdiDC.f
- needs colors.f
- needs PrintSupport.f
- needs Fonts.f
-
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 19,22 ----
Index: GENERIC.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/GENERIC.F,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** GENERIC.F 30 Apr 2007 07:49:26 -0000 1.1
--- GENERIC.F 1 May 2007 07:41:55 -0000 1.2
***************
*** 34,43 ****
\ *S Glossary
- cr .( Loading Generic Window...)
-
- only forth also definitions decimal
-
Needs Dc.f
in-application
--- 34,41 ----
\ *S Glossary
Needs Dc.f
+ cr .( Loading Generic Window...)
+
in-application
Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/Class.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Class.f 30 Apr 2007 07:49:26 -0000 1.4
--- Class.f 1 May 2007 07:41:55 -0000 1.5
***************
*** 1377,1391 ****
\ --------------------------------------------------------------------
! : executem ( i*x ^obj methodXT -- j*x )
! \ *G Version of execute for ubjects and methods.
(comp-only)
compilation> drop postpone swap postpone PushOP postpone OP postpone !
postpone execute postpone PopOP ;
! : catchm ( i*x ^obj methodXT -- j*x 0 | i*x n )
! \ *G Version of catch for ubjects and methods.
(comp-only)
compilation> drop postpone swap postpone PushOP postpone OP postpone !
! postpone catch postpone PopOP ;
\ ====================================================================
--- 1377,1392 ----
\ --------------------------------------------------------------------
! : MethodExecute ( i*x ^obj methodXT -- j*x )
! \ *G Version of execute for objects and methods.
(comp-only)
compilation> drop postpone swap postpone PushOP postpone OP postpone !
postpone execute postpone PopOP ;
! : MethodCatch ( i*x ^obj methodXT -- j*x 0 | i*x ^obj n )
! \ *G Version of catch for objects and methods.
(comp-only)
compilation> drop postpone swap postpone PushOP postpone OP postpone !
! postpone catch postpone dup postpone if postpone self postpone swap
! postpone then postpone PopOP ;
\ ====================================================================
***************
*** 1607,1611 ****
RECTANGLE temprect \ a sample rectangle object, used by the system sometimes
! \s
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ display all classes in the system
--- 1608,1612 ----
RECTANGLE temprect \ a sample rectangle object, used by the system sometimes
!
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ display all classes in the system
***************
*** 1613,1617 ****
IN-SYSTEM
!
: .CLASSES ( -- ) \ W32F Class
\ *G Display all classes in the system.
--- 1614,1618 ----
IN-SYSTEM
! ((
: .CLASSES ( -- ) \ W32F Class
\ *G Display all classes in the system.
***************
*** 1631,1635 ****
@ dup 0=
UNTIL drop ;
!
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ return xt of method
--- 1632,1636 ----
@ dup 0=
UNTIL drop ;
! ))
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ return xt of method
***************
*** 1643,1650 ****
TRUE to get-reference? \ tell do_message to return method
depth >r
! execute to m0cfa \ execute do_message
! depth r> <
! if 0 \ if it was a class, object is NULL
! then to obj-save m0cfa ;
: [GetMethod] ( compiling:- -<method: object>- -- ) ( runtime:- -- m0cfa ) \ W32F Class
--- 1644,1649 ----
TRUE to get-reference? \ tell do_message to return method
depth >r
! execute \ execute do_message
! depth r> > if nip then ;
: [GetMethod] ( compiling:- -<method: object>- -- ) ( runtime:- -- m0cfa ) \ W32F Class
|
