[gforth] / gforth / tags.fs  

gforth: gforth/tags.fs


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

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help