Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv13704/win32forth/apps/Win32ForthIDE
Modified Files:
ClassBrowser.f
Log Message:
gah: Modified to show :OBJECT OBJ_NAME instead of [UNKNOWN] for objets.
Index: ClassBrowser.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ClassBrowser.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ClassBrowser.f 9 Jun 2006 11:44:56 -0000 1.2
--- ClassBrowser.f 9 Jun 2006 12:10:32 -0000 1.3
***************
*** 66,76 ****
create NameBuf$ MAXSTRING 1+ allot
: AddName ( xt hPrev hRoot fChildren -- ) \ show name, if can't find name, [UNKNOWN]
>r rot DUP >NAME DUP NAME> ['] [UNKNOWN] = \ if not found
! IF DROP z" [UNKNOWN]"
ELSE COUNT NameBuf$ ascii-z \ make a z-String
THEN 2swap 1 r> AddItem ;
-
\ ------------------------------------------------------------------------------
\ ------------------------------------------------------------------------------
--- 66,101 ----
create NameBuf$ MAXSTRING 1+ allot
+ \ The following definitions enable us to find the name of an object defined with :OBJECT
+ \ from the xt of it's nameless class; gah
+
+ 0 value SearchClass
+
+ : (objname) ( nfa -- )
+ dup name> dup @ doobj =
+ if >body @ SearchClass =
+ if s" :OBJECT " NameBuf$ place
+ nfa-count NameBuf$ +place NameBuf$ +null
+ 0 to SearchClass
+ else drop
+ then
+ else 2drop
+ then ;
+
+
+ : objname ( xt -- )
+ >body to SearchClass NameBuf$ off
+ \in-system-ok ['] (objname) on-allwords ;
+
: AddName ( xt hPrev hRoot fChildren -- ) \ show name, if can't find name, [UNKNOWN]
>r rot DUP >NAME DUP NAME> ['] [UNKNOWN] = \ if not found
! IF DROP dup ?IsClass
! IF dup objname Namebuf$ count 0=
! IF drop z" [UNKNOWN]"
! THEN
! ELSE z" [UNKNOWN]"
! THEN
ELSE COUNT NameBuf$ ascii-z \ make a z-String
THEN 2swap 1 r> AddItem ;
\ ------------------------------------------------------------------------------
\ ------------------------------------------------------------------------------
|
