[gforth] / gforth / tags.fs  

gforth: gforth/tags.fs


1 : pazsan 1.1 \ VI tags support for GNU Forth.
2 :    
3 : anton 1.9 \ Copyright (C) 1995,1998,2002,2003,2007,2008 Free Software Foundation, Inc.
4 : pazsan 1.1
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 : anton 1.6 \ as published by the Free Software Foundation, either version 3
10 : pazsan 1.1 \ 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 : anton 1.6 \ along with this program. If not, see http://www.gnu.org/licenses/.
19 : pazsan 1.1
20 : anton 1.2 \ usage: gforth tags.fs your_files.fs ...
21 :     \ then: vi -t word_name
22 : pazsan 1.1
23 :     \ This does not work like etags; instead, the TAGS file is updated
24 :     \ during the normal Forth interpretation/compilation process.
25 :    
26 :     \ The present version has several shortcomings: It always overwrites
27 :     \ the TAGS file instead of just the parts corresponding to the loaded
28 :     \ files, but you can have several tag tables in emacs. Every load
29 :     \ creates a new etags file and the user has to confirm that she wants
30 :     \ to use it.
31 :    
32 :     \ Communication of interactive programs like emacs and Forth over
33 :     \ files is clumsy. There should be better cooperation between them
34 :     \ (e.g. via shared memory)
35 :    
36 :     \ This is ANS Forth with the following serious environmental
37 : anton 1.8 \ dependences: the word LATEST must return a pointer to the last
38 : pazsan 1.1 \ header, NAME>STRING must convert that pointer to a string, and
39 :     \ HEADER must be a deferred word that is called to create the name.
40 :    
41 :     \ Changes by David: Removed the blanks before and after the explicit
42 :     \ tag name, since that conflicts with Emacs' auto-completition. In
43 :     \ fact those blanks are not necessary, since search is performed on
44 :     \ the tag-text, rather than the tag name.
45 :    
46 : anton 1.2 \ Changes by Erik Rossen: Reversed the order of the tagname and tagfile
47 :     \ and got rid of the trailing "$" in the address regexp. I also needed
48 :     \ to comment out search.fs since it sets the search order destructively
49 :     \ on my system. Added a bit more explanation on how to use tags.fs.
50 :    
51 : anton 1.10 require search.fs
52 : pazsan 1.1 require extend.fs
53 :    
54 :     : tags-file-name ( -- c-addr u )
55 :     \ for now I use just tags; this may become more flexible in the
56 :     \ future
57 :     s" tags" ;
58 :    
59 :     variable tags-file 0 tags-file !
60 :    
61 :     create tags-line 128 chars allot
62 :    
63 :     : skip-tags ( file-id -- )
64 :     \ reads in file until it finds the end or the loadfilename
65 :     drop ;
66 :    
67 :     : tags-file-id ( -- file-id )
68 :     tags-file @ 0= if
69 :     tags-file-name w/o create-file throw
70 :     \ 2dup file-status
71 :     \ if \ the file does not exist
72 :     \ drop w/o create-file throw
73 :     \ else
74 :     \ drop r/w open-file throw
75 :     \ dup skip-tags
76 :     \ endif
77 :     tags-file !
78 :     endif
79 :     tags-file @ ;
80 :    
81 :     2variable last-loadfilename 0 0 last-loadfilename 2!
82 :    
83 :     : put-load-file-name ( file-id -- )
84 :     >r
85 :     sourcefilename r@ write-file throw
86 :     #tab r> emit-file throw ;
87 :    
88 :     : put-tags-entry ( -- )
89 :     \ write the entry for the last name to the TAGS file
90 :     \ if the input is from a file and it is not a local name
91 :     source-id dup 0<> swap -1 <> and \ input from a file
92 :     current @ locals-list <> and \ not a local name
93 : anton 1.4 latest 0<> and \ not an anonymous (i.e. noname) header
94 : pazsan 1.1 if
95 :     tags-file-id >r
96 : anton 1.4 latest name>string r@ write-file throw
97 : pazsan 1.1 #tab r@ emit-file throw
98 : anton 1.2 r@ put-load-file-name
99 : pazsan 1.1 s" /^" r@ write-file throw
100 :     source drop >in @ r@ write-file throw
101 : anton 1.2 s" /" r@ write-line throw
102 : pazsan 1.1 rdrop
103 :     endif ;
104 :    
105 :     : (tags-header) ( -- )
106 :     defers header
107 :     put-tags-entry ;
108 :    
109 :     ' (tags-header) IS header

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help