File:  [gforth] / gforth / etags.fs
Revision 1.2: download - view: text, annotated - select for diffs
Wed Sep 6 21:00:14 1995 UTC (24 years, 7 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Removed BUGS, tried to clean up.

    1: \ Etags support for GNU Forth.
    2: 
    3: \ This does not work like etags; instead, the TAGS file is updated
    4: \ during the normal Forth interpretation/compilation process.
    5: 
    6: \ The present version has several shortcomings: It always overwrites
    7: \ the TAGS file instead of just the parts corresponding to the loaded
    8: \ files, but you can have several tag tables in emacs. Every load
    9: \ creates a new etags file and the user has to confirm that she wants
   10: \ to use it.
   11: 
   12: \ Communication of interactive programs like emacs and Forth over
   13: \ files is clumsy. There should be better cooperation between them
   14: \ (e.g. via shared memory)
   15: 
   16: \ This is ANS Forth with the following serious environmental
   17: \ dependences: the variable LAST must contain a pointer to the last
   18: \ header, NAME>STRING must convert that pointer to a string, and
   19: \ HEADER must be a deferred word that is called to create the name.
   20: 
   21: : tags-file-name ( -- c-addr u )
   22:     \ for now I use just TAGS; this may become more flexible in the
   23:     \ future
   24:     s" TAGS" ;
   25: 
   26: variable tags-file 0 tags-file !
   27: 
   28: create tags-line 128 chars allot
   29:     
   30: : skip-tags ( file-id -- )
   31:     \ reads in file until it finds the end or the loadfilename
   32:     drop ;
   33: 
   34: : tags-file-id ( -- file-id )
   35:     tags-file @ 0= if
   36: 	tags-file-name w/o create-file throw
   37: \ 	2dup file-status
   38: \ 	if \ the file does not exist
   39: \ 	    drop w/o create-file throw
   40: \ 	else
   41: \ 	    drop r/w open-file throw
   42: \ 	    dup skip-tags
   43: \ 	endif
   44: 	tags-file !
   45:     endif
   46:     tags-file @ ;
   47: 
   48: create emit-file-char 0 c,
   49: 
   50: : emit-file ( c file-id -- )
   51:     swap emit-file-char c!
   52:     emit-file-char 1 chars rot write-file ;
   53: 
   54: 2variable last-loadfilename 0 0 last-loadfilename 2!
   55: 
   56: : put-load-file-name ( file-id -- )
   57:     >r
   58:     loadfilename 2@ last-loadfilename 2@ d<>
   59:     if
   60: 	#ff r@ emit-file throw
   61: 	#lf r@ emit-file throw
   62: 	loadfilename 2@ 2dup
   63: 	r@ write-file throw
   64: 	last-loadfilename 2!
   65: 	s" ,0" r@ write-line throw
   66:     endif
   67:     rdrop ;
   68: 
   69: : put-tags-entry ( -- )
   70:     \ write the entry for the last name to the TAGS file
   71:     \ if the input is from a file and it is not a local name
   72:     source-id dup 0<> swap -1 <> and	\ input from a file
   73:     get-current locals-list <> and	\ not a local name
   74:     last @ 0<> and	\ not an anonymous (i.e. noname) header
   75:     if
   76: 	tags-file-id >r 
   77: 	r@ put-load-file-name
   78: 	source drop >in @ r@ write-file throw
   79: 	127 r@ emit-file throw
   80: 	bl r@ emit-file throw
   81: 	last @ name>string r@ write-file throw
   82: 	bl r@ emit-file throw
   83: 	1 r@ emit-file throw
   84: 	base @ decimal loadline @ 0 <# #s #> r@ write-file throw base !
   85: 	s" ,0" r@ write-line throw
   86: 	\ the character position in the file; not strictly necessary AFAIK
   87: 	\ instead of using 0, we could use file-position and subtract
   88: 	\ the line length
   89: 	rdrop
   90:     endif cr ;
   91: 
   92: : (tags-header) ( -- )
   93:     defers header
   94:     put-tags-entry ;
   95: 
   96: ' (tags-header) IS header

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>