[Win32forth-cvs] win32forth/src/tools ClassBrowser.f,1.3,1.4

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/tools
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv31243/win32forth/src/tools

Modified Files:
	ClassBrowser.f 
Log Message:
gah: Modified to show :OBJECT OBJ_NAME instead of [UNKNOWN] for objets (SciEd and IDE not done yet).

Index: ClassBrowser.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/tools/ClassBrowser.f,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ClassBrowser.f	14 May 2006 10:46:19 -0000	1.3
--- ClassBrowser.f	9 Jun 2006 10:42:37 -0000	1.4
***************
*** 3,7 ****
  \ Created: Samstag, Mai 22 2004 - dbu
  \ Updated: Samstag, Mai 29 2004 - 10:58 - dbu
! \
  \ Win32Forth class and vocabulary browser
  
--- 3,8 ----
  \ Created: Samstag, Mai 22 2004 - dbu
  \ Updated: Samstag, Mai 29 2004 - 10:58 - dbu
! \ Updated: Friday, June 09 2006 - gah
! 
  \ Win32Forth class and vocabulary browser
  
***************
*** 48,54 ****
  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 ;
--- 49,81 ----
  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 ;
***************
*** 314,317 ****
--- 341,345 ----
  
  cr .( 'Class and vocabulary browser' loaded )
+ 
  class-browser