tags.fs 3.75 KB
Newer Older
pazsan's avatar
pazsan committed
1 2
\ VI tags support for GNU Forth.

3
\ Authors: Anton Ertl, Bernd Paysan
Anton Ertl's avatar
Anton Ertl committed
4
\ Copyright (C) 1995,1998,2002,2003,2007,2008,2009,2010,2012,2019 Free Software Foundation, Inc.
pazsan's avatar
pazsan committed
5 6 7 8 9

\ This file is part of Gforth.

\ Gforth is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License
anton's avatar
anton committed
10
\ as published by the Free Software Foundation, either version 3
pazsan's avatar
pazsan committed
11 12 13 14 15 16 17 18
\ of the License, or (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU General Public License for more details.

\ You should have received a copy of the GNU General Public License
anton's avatar
anton committed
19
\ along with this program. If not, see http://www.gnu.org/licenses/.
pazsan's avatar
pazsan committed
20

anton's avatar
anton committed
21 22
\ usage: gforth tags.fs your_files.fs ...
\  then: vi -t word_name
pazsan's avatar
pazsan committed
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

\ This does not work like etags; instead, the TAGS file is updated
\ during the normal Forth interpretation/compilation process.

\ The present version has several shortcomings: It always overwrites
\ the TAGS file instead of just the parts corresponding to the loaded
\ files, but you can have several tag tables in emacs. Every load
\ creates a new etags file and the user has to confirm that she wants
\ to use it.

\ Communication of interactive programs like emacs and Forth over
\ files is clumsy. There should be better cooperation between them
\ (e.g. via shared memory)

\ This is ANS Forth with the following serious environmental
38
\ dependences: the word LATEST must return a pointer to the last
pazsan's avatar
pazsan committed
39 40 41 42 43 44 45 46
\ header, NAME>STRING must convert that pointer to a string, and
\ HEADER must be a deferred word that is called to create the name.

\ Changes by David: Removed the blanks before and after the explicit
\ tag name, since that conflicts with Emacs' auto-completition. In
\ fact those blanks are not necessary, since search is performed on
\ the tag-text, rather than the tag name.

anton's avatar
anton committed
47 48 49 50 51
\ Changes by Erik Rossen: Reversed the order of the tagname and tagfile
\ and got rid of the trailing "$" in the address regexp.  I also needed
\ to comment out search.fs since it sets the search order destructively
\ on my system.  Added a bit more explanation on how to use tags.fs.

52
require search.fs
pazsan's avatar
pazsan committed
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
require extend.fs

: tags-file-name ( -- c-addr u )
    \ for now I use just tags; this may become more flexible in the
    \ future
    s" tags" ;

variable tags-file 0 tags-file !

create tags-line 128 chars allot
    
: skip-tags ( file-id -- )
    \ reads in file until it finds the end or the loadfilename
    drop ;

: tags-file-id ( -- file-id )
    tags-file @ 0= if
70 71
        s" sort >tags" w/o open-pipe throw
\	tags-file-name w/o create-file throw
pazsan's avatar
pazsan committed
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
\ 	2dup file-status
\ 	if \ the file does not exist
\ 	    drop w/o create-file throw
\ 	else
\ 	    drop r/w open-file throw
\ 	    dup skip-tags
\ 	endif
	tags-file !
    endif
    tags-file @ ;

2variable last-loadfilename 0 0 last-loadfilename 2!

: put-load-file-name ( file-id -- )
    >r
    sourcefilename r@ write-file throw
    #tab r> emit-file throw ;

90 91
: put-tags-string ( c-addr u -- )
    2>r source-id dup 0<> swap -1 <> and	\ input from a file
pazsan's avatar
pazsan committed
92 93 94
    current @ locals-list <> and	\ not a local name
    if
	tags-file-id >r 
95
	r> 2r> rot dup >r write-file throw
pazsan's avatar
pazsan committed
96
	#tab r@ emit-file throw
anton's avatar
anton committed
97
	r@ put-load-file-name
pazsan's avatar
pazsan committed
98 99
	s" /^" r@ write-file throw
	source drop >in @ r@ write-file throw
anton's avatar
anton committed
100
	s" /" r@ write-line throw
pazsan's avatar
pazsan committed
101
	rdrop
102 103
    else
	2r> 2drop
pazsan's avatar
pazsan committed
104 105
    endif ;

106 107 108 109 110 111 112 113 114 115 116 117
: put-tags-name ( -- )
    >in @ parse-name put-tags-string >in ! ;

' put-tags-name is record-name

: put-tags-entry ( -- )
    \ write the entry for the last name to the TAGS file
    \ if the input is from a file and it is not a local name
    latest 0<> if
	latest name>string put-tags-string
    then ;

Bernd Paysan's avatar
Bernd Paysan committed
118
' put-tags-entry IS header-extra