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