--- gforth/objects.fs	1999/02/16 06:32:29	1.12
+++ gforth/objects.fs	2000/09/23 15:06:01	1.19
@@ -1,6 +1,6 @@
 \ yet another Forth objects extension
 
-\ written by Anton Ertl 1996-1998
+\ written by Anton Ertl 1996-2000
 \ public domain; NO WARRANTY
 
 \ This (in combination with compat/struct.fs) is in ANS Forth (with an
@@ -228,6 +228,28 @@ variable last-interface-offset 0 last-in
     \g @var{interface}.
     end-interface-noname constant ;
 
+\ visibility control
+
+variable public-wordlist
+
+: protected ( -- ) \ objects- objects
+    \g Set the compilation wordlist to the current class's wordlist
+    current-interface @ class-wordlist @
+    dup get-current <>
+    if \ we are not protected already
+	get-current public-wordlist !
+    then
+    set-current ;
+
+: public ( -- ) \ objects- objects
+    \g Restore the compilation wordlist that was in effect before the
+    \g last @code{protected} that actually changed the compilation
+    \g wordlist.
+    current-interface @ class-wordlist @ get-current =
+    if \ we are protected
+	public-wordlist @ set-current
+    then ;
+
 \ classes
 
 : add-class-order ( n1 class -- wid1 ... widn n+n1 )
@@ -237,10 +259,18 @@ variable last-interface-offset 0 last-in
     then
     r> class-wordlist @ swap 1+ ;
 
-: push-order ( class -- ) \ objects- objects
+: class>order ( class -- ) \ objects- objects
     \g Add @var{class}'s wordlists to the head of the search-order.
     >r get-order r> add-class-order set-order ;
 
+: push-order class>order ; \ old name
+
+: methods ( class -- ) \ objects- objects
+    \g Makes @var{class} the current class. This is intended to be
+    \g used for defining methods to override selectors; you cannot
+    \g define new fields or selectors.
+    dup current-interface ! class>order ;
+
 : class ( parent-class -- align offset ) \ objects- objects
     \g Start a new class definition as a child of
     \g @var{parent-class}. @var{align offset} are for use by
@@ -252,8 +282,7 @@ variable last-interface-offset 0 last-in
     0 r@ interface-offset !
     dup r@ class-parent !
     wordlist r@ class-wordlist !
-    r@ current-interface !
-    r> push-order
+    r> methods
     class-inst-size 2@ ;
 
 : remove-class-order ( wid1 ... widn n+n1 class -- n1 )
@@ -264,15 +293,23 @@ variable last-interface-offset 0 last-in
     until
     drop ;
 
-: drop-order ( class -- ) \ objects- objects
+: class-previous ( class -- ) \ objects- objects
     \g Drop @var{class}'s wordlists from the search order. No
     \g checking is made whether @var{class}'s wordlists are actually
     \g on the search order.
     >r get-order r> remove-class-order set-order ;
 
+: drop-order class-previous ; \ old name
+
+: end-methods ( -- ) \ objects- objects
+    \g Switch back from defining methods of a class to normal mode
+    \g (currently this just restores the old search order).
+    current-interface @ class-previous ;
+
 : end-class-noname ( align offset -- class ) \ objects- objects
     \g End a class definition. The resulting class is @var{class}.
-    current-interface @ dup drop-order class-inst-size 2!
+    public end-methods
+    current-interface @ class-inst-size 2!
     end-interface-noname ;
 
 : end-class ( align offset "name" -- ) \ objects- objects
@@ -281,25 +318,6 @@ variable last-interface-offset 0 last-in
     \ name execution: ( -- class )
     end-class-noname constant ;
 
-\ visibility control
-
-variable public-wordlist
-
-: protected ( -- ) \ objects- objects
-    \g Set the compilation wordlist to the current class's wordlist
-    current-interface @ class-wordlist @
-    dup get-current <>
-    if \ we are not protected already
-	get-current public-wordlist !
-    then
-    set-current ;
-
-: public ( -- ) \ objects- objects
-    \g Restore the compilation wordlist that was in effect before the
-    \g last @code{protected} that actually changed the compilation
-    \g wordlist.
-    public-wordlist @ set-current ;
-
 \ classes that implement interfaces
 
 : front-extend-mem ( addr1 u1 u -- addr addr2 u2 )
@@ -345,12 +363,20 @@ variable public-wordlist
 \ : to-this ( object -- )
 \     thisp ! ;
 
-: m: ( -- xt colon-sys; run-time: object -- ) \ objects- objects
-    \g Start a method definition; @var{object} becomes new @code{this}.
-    :noname 
+: enterm ( -- ; run-time: object -- )
+    \g method prologue; @var{object} becomes new @code{this}.
     POSTPONE this
     POSTPONE >r
     POSTPONE to-this ;
+    
+: m: ( -- xt colon-sys; run-time: object -- ) \ objects- objects
+    \g Start a method definition; @var{object} becomes new @code{this}.
+    :noname enterm ;
+
+: :m ( "name" -- xt; run-time: object -- ) \ objects- objects
+    \g Start a named method definition; @var{object} becomes new
+    \g @code{this}.  Has to be ended with @code{;m}.
+    : enterm ;
 
 : exitm ( -- ) \ objects- objects
     \g @code{exit} from a method; restore old @code{this}.
@@ -459,7 +485,7 @@ current-interface 1 cells save-mem curre
 0 current-interface @ class-parent !
 wordlist current-interface @ class-wordlist !
 object%
-current-interface @ push-order
+current-interface @ class>order
 
 ' drop ( object -- )
 method construct ( ... object -- ) \ objects- objects
@@ -472,6 +498,8 @@ method print ( object -- ) \ objects- ob
 \g Print the object. The method for the class @var{object} prints
 \g the address of the object and the address of its class.
 
+selector equal ( object1 object2 -- flag )
+
 end-class object ( -- class ) \ objects- objects
 \g the ancestor of all classes.