Annotation of gforth/etags.fs, revision 1.1
1.1 ! anton 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: last @ name>string r@ write-file throw
! 81: 1 r@ emit-file throw
! 82: base @ decimal loadline @ 0 <# #s #> r@ write-file throw base !
! 83: s" ,0" r@ write-line throw
! 84: \ the character position in the file; not strictly necessary AFAIK
! 85: \ instead of using 0, we could use file-position and subtract
! 86: \ the line length
! 87: rdrop
! 88: endif ;
! 89:
! 90: : (tags-header) ( -- )
! 91: defers header
! 92: put-tags-entry ;
! 93:
! 94: ' (tags-header) IS header
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>