Annotation of gforth/etags.fs, revision 1.21

1.1       anton       1: \ Etags support for GNU Forth.
                      2: 
1.21    ! anton       3: \ Copyright (C) 1995,1998,2001,2003,2007,2008,2012 Free Software Foundation, Inc.
1.3       anton       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
1.17      anton       9: \ as published by the Free Software Foundation, either version 3
1.3       anton      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
1.17      anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.3       anton      19: 
                     20: 
1.1       anton      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
1.18      anton      35: \ dependences: the word LATEST must return a pointer to the last
1.1       anton      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: 
1.11      dvdkhlng   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: 
1.8       pazsan     44: require search.fs
1.15      pazsan     45: require environ.fs
1.8       pazsan     46: require extend.fs
1.7       pazsan     47: 
1.1       anton      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: 
                     53: variable tags-file 0 tags-file !
                     54: 
                     55: create 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: 
                     75: 2variable last-loadfilename 0 0 last-loadfilename 2!
                     76: 
                     77: : put-load-file-name ( file-id -- )
                     78:     >r
1.4       anton      79:     sourcefilename last-loadfilename 2@ d<>
1.1       anton      80:     if
                     81:        #ff r@ emit-file throw
                     82:        #lf r@ emit-file throw
1.4       anton      83:        sourcefilename 2dup
1.1       anton      84:        r@ write-file throw
                     85:        last-loadfilename 2!
                     86:        s" ,0" r@ write-line throw
                     87:     endif
                     88:     rdrop ;
                     89: 
1.20      anton      90: : put-tags-string ( c-addr u -- )
                     91:     2>r source-id dup 0<> swap -1 <> and       \ input from a file
1.5       anton      92:     current @ locals-list <> and       \ not a local name
1.1       anton      93:     if
                     94:        tags-file-id >r 
                     95:        r@ put-load-file-name
                     96:        source drop >in @ r@ write-file throw
                     97:        127 r@ emit-file throw
1.20      anton      98:        r> 2r> rot dup >r write-file throw
1.1       anton      99:        1 r@ emit-file throw
1.4       anton     100:        base @ decimal sourceline# 0 <# #s #> r@ write-file throw base !
1.1       anton     101:        s" ,0" r@ write-line throw
                    102:        \ the character position in the file; not strictly necessary AFAIK
                    103:        \ instead of using 0, we could use file-position and subtract
                    104:        \ the line length
                    105:        rdrop
1.20      anton     106:     else
                    107:        2r> 2drop
1.5       anton     108:     endif ;
1.1       anton     109: 
1.20      anton     110: : put-tags-name ( -- )
                    111:     >in @ parse-name put-tags-string >in ! ;
                    112: 
                    113: ' put-tags-name is record-name
                    114: 
                    115: : put-tags-entry ( -- )
                    116:     \ write the entry for the last name to the TAGS file
                    117:     \ if the input is from a file and it is not a local name
                    118:     latest 0<> if
                    119:        latest name>string put-tags-string
                    120:     then ;
                    121: 
1.1       anton     122: : (tags-header) ( -- )
                    123:     defers header
                    124:     put-tags-entry ;
                    125: 
                    126: ' (tags-header) IS header

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>