Annotation of gforth/etags.fs, revision 1.1

1.1     ! anton       1: \ Etags support for GNU Forth.
        !             2: 
        !             3: \ This does not work like etags; instead, the TAGS file is updated
        !             4: \ during the normal Forth interpretation/compilation process.
        !             5: 
        !             6: \ The present version has several shortcomings: It always overwrites
        !             7: \ the TAGS file instead of just the parts corresponding to the loaded
        !             8: \ files, but you can have several tag tables in emacs. Every load
        !             9: \ creates a new etags file and the user has to confirm that she wants
        !            10: \ to use it.
        !            11: 
        !            12: \ Communication of interactive programs like emacs and Forth over
        !            13: \ files is clumsy. There should be better cooperation between them
        !            14: \ (e.g. via shared memory)
        !            15: 
        !            16: \ This is ANS Forth with the following serious environmental
        !            17: \ dependences: the variable LAST must contain a pointer to the last
        !            18: \ header, NAME>STRING must convert that pointer to a string, and
        !            19: \ HEADER must be a deferred word that is called to create the name.
        !            20: 
        !            21: : tags-file-name ( -- c-addr u )
        !            22:     \ for now I use just TAGS; this may become more flexible in the
        !            23:     \ future
        !            24:     s" TAGS" ;
        !            25: 
        !            26: variable tags-file 0 tags-file !
        !            27: 
        !            28: create tags-line 128 chars allot
        !            29:     
        !            30: : skip-tags ( file-id -- )
        !            31:     \ reads in file until it finds the end or the loadfilename
        !            32:     drop ;
        !            33: 
        !            34: : tags-file-id ( -- file-id )
        !            35:     tags-file @ 0= if
        !            36:        tags-file-name w/o create-file throw
        !            37: \      2dup file-status
        !            38: \      if \ the file does not exist
        !            39: \          drop w/o create-file throw
        !            40: \      else
        !            41: \          drop r/w open-file throw
        !            42: \          dup skip-tags
        !            43: \      endif
        !            44:        tags-file !
        !            45:     endif
        !            46:     tags-file @ ;
        !            47: 
        !            48: create emit-file-char 0 c,
        !            49: 
        !            50: : emit-file ( c file-id -- )
        !            51:     swap emit-file-char c!
        !            52:     emit-file-char 1 chars rot write-file ;
        !            53: 
        !            54: 2variable last-loadfilename 0 0 last-loadfilename 2!
        !            55: 
        !            56: : put-load-file-name ( file-id -- )
        !            57:     >r
        !            58:     loadfilename 2@ last-loadfilename 2@ d<>
        !            59:     if
        !            60:        #ff r@ emit-file throw
        !            61:        #lf r@ emit-file throw
        !            62:        loadfilename 2@ 2dup
        !            63:        r@ write-file throw
        !            64:        last-loadfilename 2!
        !            65:        s" ,0" r@ write-line throw
        !            66:     endif
        !            67:     rdrop ;
        !            68: 
        !            69: : put-tags-entry ( -- )
        !            70:     \ write the entry for the last name to the TAGS file
        !            71:     \ if the input is from a file and it is not a local name
        !            72:     source-id dup 0<> swap -1 <> and   \ input from a file
        !            73:     get-current locals-list <> and     \ not a local name
        !            74:     last @ 0<> and     \ not an anonymous (i.e. noname) header
        !            75:     if
        !            76:        tags-file-id >r 
        !            77:        r@ put-load-file-name
        !            78:        source drop >in @ r@ write-file throw
        !            79:        127 r@ emit-file throw
        !            80:        last @ name>string r@ write-file throw
        !            81:        1 r@ emit-file throw
        !            82:        base @ decimal loadline @ 0 <# #s #> r@ write-file throw base !
        !            83:        s" ,0" r@ write-line throw
        !            84:        \ the character position in the file; not strictly necessary AFAIK
        !            85:        \ instead of using 0, we could use file-position and subtract
        !            86:        \ the line length
        !            87:        rdrop
        !            88:     endif ;
        !            89: 
        !            90: : (tags-header) ( -- )
        !            91:     defers header
        !            92:     put-tags-entry ;
        !            93: 
        !            94: ' (tags-header) IS header

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