1\ Etags support for GNU Forth.
2
3\ Copyright (C) 1995,1998,2001,2003,2007 Free Software Foundation, Inc.
4
5\ This file is part of Gforth.
6
7\ Gforth is free software; you can redistribute it and/or
8\ modify it under the terms of the GNU General Public License
9\ as published by the Free Software Foundation, either version 3
10\ of the License, or (at your option) any later version.
11
12\ This program is distributed in the hope that it will be useful,
13\ but WITHOUT ANY WARRANTY; without even the implied warranty of
14\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15\ GNU General Public License for more details.
16
17\ You should have received a copy of the GNU General Public License
18\ along with this program. If not, see http://www.gnu.org/licenses/.
19
20
21\ This does not work like etags; instead, the TAGS file is updated
22\ during the normal Forth interpretation/compilation process.
23
24\ The present version has several shortcomings: It always overwrites
25\ the TAGS file instead of just the parts corresponding to the loaded
26\ files, but you can have several tag tables in emacs. Every load
27\ creates a new etags file and the user has to confirm that she wants
28\ to use it.
29
30\ Communication of interactive programs like emacs and Forth over
31\ files is clumsy. There should be better cooperation between them
32\ (e.g. via shared memory)
33
34\ This is ANS Forth with the following serious environmental
35\ dependences: the variable LAST must contain a pointer to the last
36\ header, NAME>STRING must convert that pointer to a string, and
37\ HEADER must be a deferred word that is called to create the name.
38
39\ Changes by David: Removed the blanks before and after the explicit
40\ tag name, since that conflicts with Emacs' auto-completition. In
41\ fact those blanks are not necessary, since search is performed on
42\ the tag-text, rather than the tag name.
43
44require search.fs
45require environ.fs
46require extend.fs
47
48: tags-file-name ( -- c-addr u )
49    \ for now I use just TAGS; this may become more flexible in the
50    \ future
51    s" TAGS" ;
52
53variable tags-file 0 tags-file !
54
55create tags-line 128 chars allot
56
57: skip-tags ( file-id -- )
58    \ reads in file until it finds the end or the loadfilename
59    drop ;
60
61: tags-file-id ( -- file-id )
62    tags-file @ 0= if
63	tags-file-name w/o create-file throw
64\ 	2dup file-status
65\ 	if \ the file does not exist
66\ 	    drop w/o create-file throw
67\ 	else
68\ 	    drop r/w open-file throw
69\ 	    dup skip-tags
70\ 	endif
71	tags-file !
72    endif
73    tags-file @ ;
74
752variable last-loadfilename 0 0 last-loadfilename 2!
76
77: put-load-file-name ( file-id -- )
78    >r
79    sourcefilename last-loadfilename 2@ d<>
80    if
81	#ff r@ emit-file throw
82	#lf r@ emit-file throw
83	sourcefilename 2dup
84	r@ write-file throw
85	last-loadfilename 2!
86	s" ,0" r@ write-line throw
87    endif
88    rdrop ;
89
90: put-tags-entry ( -- )
91    \ write the entry for the last name to the TAGS file
92    \ if the input is from a file and it is not a local name
93    source-id dup 0<> swap -1 <> and	\ input from a file
94    current @ locals-list <> and	\ not a local name
95    latest 0<> and	\ not an anonymous (i.e. noname) header
96    if
97	tags-file-id >r
98	r@ put-load-file-name
99	source drop >in @ r@ write-file throw
100	127 r@ emit-file throw
101\	bl r@ emit-file throw
102	latest name>string r@ write-file throw
103\	bl r@ emit-file throw
104	1 r@ emit-file throw
105	base @ decimal sourceline# 0 <# #s #> r@ write-file throw base !
106	s" ,0" r@ write-line throw
107	\ the character position in the file; not strictly necessary AFAIK
108	\ instead of using 0, we could use file-position and subtract
109	\ the line length
110	rdrop
111    endif ;
112
113: (tags-header) ( -- )
114    defers header
115    put-tags-entry ;
116
117' (tags-header) IS header
118