wombat%vger@XENURUS.GOULD.COM (Joan Eslinger) (09/25/88)
There were a couple of problems with tags.el (as I and some local users
saw it) so I changed a few things. For one, it would pull every file
listed in a tags file into memory if you tried to run tags-search (very
bad if you're working on a program with a few hundred files), and for
another you couldn't do regexp searches on tags. Also, it's easier to
chain goto-tag calls now, since the default can be configured to be the
"next word" rather than the "previous word". This is a version of the
tags.el from 18.51 with my changes. The changes were slightly differnt
in 18.50; haven't tried them in 18.52 yet. I've been using this for
several months and have only one complaint with it - you get an error if
you type ESC-. at the end of a buffer, most annoying when you're in a
shell buffer, where you are almost always at the end when you want to
look up a tag. Someday...
Unless you set some variables, you won't get the regexp or chain stuff.
Several things are defvars, so users can configure some of their own
defaults.
Since I sometimes need to refer to 3 or 4 kernel trees at once, some in
directories where I couldn't put a TAGS file, I also wrote
select-tags-file, a function that shows you a dired listing of a
directory of tags files and lets you pick one. I use shell scripts to
build the tags files in the dead of night, and build them with absolute
path names so the tags files can be stored in a single directory.
;; Copyright (C) 1985 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;; The distributed version of this file pulls in all of the files
;; mentioned by a TAGS file whenever it is used to apply a function to
;; all the files. If you happen to do this with a kernel TAGS file
;; you get hundreds of files (actually, buffers) that you weren't
;; really interested in filling up memory, leading to nasty Danger
;; warnings. This version notices what files are already being
;; visited whenever tags-loop-continue is called initially, and as it
;; loops through all the files it kills buffers that were neither 1)
;; in use before initialization nor 2) "interesting" as determined by
;; the tags-loop-form.
;; If a function's tags-loop-form leaves the cursor in the file and
;; suspends the tags-loop-continue when "interesting" things happen
;; (like tags-search) that function will work without change with this
;; tags.el. If a function is like tags-query-replace, though, in that
;; it does its work on all (or at least more than one) "interesting"
;; files before suspending tags-loop-continue, it will need a small
;; hack in its tags-loop-form in order to have the "interesting" files
;; not thrown away. This is assuming you want to hold on to the
;; interesting files, of course.
(defvar tag-table-files nil
"List of file names covered by current tag table.
nil means it has not been computed yet; do (tag-table-files) to compute it.")
(defvar last-tag nil
"Tag found by the last find-tag.")
(defun visit-tags-table (file)
"Tell tags commands to use tag table file FILE.
FILE should be the name of a file created with the `etags' program.
A directory name is ok too; it means file TAGS in that directory."
(interactive (list (read-file-name "Visit tags table: (default TAGS) "
default-directory
(concat default-directory "TAGS")
t)))
(setq file (expand-file-name file))
(if (file-directory-p file)
(setq file (concat file "TAGS")))
(setq tag-table-files nil
tags-file-name file))
(defun visit-tags-table-buffer ()
"Select the buffer containing the current tag table.
This is a file whose name is in the variable tags-file-name."
(or tags-file-name
(call-interactively 'visit-tags-table))
(set-buffer (or (get-file-buffer tags-file-name)
(progn
(setq tag-table-files nil)
(find-file-noselect tags-file-name))))
(or (verify-visited-file-modtime (get-file-buffer tags-file-name))
(cond ((yes-or-no-p "Tags file has changed, read new contents? ")
(revert-buffer t t)
(setq tag-table-files nil))))
(or (eq (char-after 1) ?\^L)
(error "File %s not a valid tag table" tags-file-name)))
(defun file-of-tag ()
"Return the file name of the file whose tags point is within.
Assumes the tag table is the current buffer.
File name returned is relative to tag table file's directory."
(let ((opoint (point))
prev size)
(save-excursion
(goto-char (point-min))
(while (< (point) opoint)
(forward-line 1)
(end-of-line)
(skip-chars-backward "^,\n")
(setq prev (point))
(setq size (read (current-buffer)))
(goto-char prev)
(forward-line 1)
(forward-char size))
(goto-char (1- prev))
(buffer-substring (point)
(progn (beginning-of-line) (point))))))
(defun tag-table-files ()
"Return a list of files in the current tag table.
File names returned are absolute."
(save-excursion
(visit-tags-table-buffer)
(or tag-table-files
(let (files)
(goto-char (point-min))
(while (not (eobp))
(forward-line 1)
(end-of-line)
(skip-chars-backward "^,\n")
(setq prev (point))
(setq size (read (current-buffer)))
(goto-char prev)
(setq files (cons (expand-file-name
(buffer-substring (1- (point))
(save-excursion
(beginning-of-line)
(point)))
(file-name-directory tags-file-name))
files))
(forward-line 1)
(forward-char size))
(setq tag-table-files (nreverse files))))))
(defun find-tag-tag (string)
(let* ((default (find-tag-default))
(spec (read-string
(if default
(format "%s(default %s) " string default)
string))))
(list (if (equal spec "")
default
spec))))
(defun find-tag (tagname &optional next other-window)
"Find tag (in current tag table) whose name contains TAGNAME.
Selects the buffer that the tag is contained in
and puts point at its definition.
If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
If second arg NEXT is non-nil (interactively, with prefix arg),
searches for the next tag in the tag table
that matches the tagname used in the previous find-tag.
See documentation of variable tags-file-name."
(interactive (if current-prefix-arg
'(nil t)
(find-tag-tag "Find tag: ")))
(let (buffer file linebeg startpos)
(save-excursion
(visit-tags-table-buffer)
(if (not next)
(goto-char (point-min))
(setq tagname last-tag))
(setq last-tag tagname)
(while (progn
(if (not (search-forward tagname nil t))
(error "No %sentries containing %s"
(if next "more " "") tagname))
(not (looking-at "[^\n\177]*\177"))))
(search-forward "\177")
(setq file (expand-file-name (file-of-tag)
(file-name-directory tags-file-name)))
(setq linebeg
(buffer-substring (1- (point))
(save-excursion (beginning-of-line) (point))))
(search-forward ",")
(setq startpos (read (current-buffer))))
(if other-window
(find-file-other-window file)
(find-file file))
(widen)
(push-mark)
(let ((offset 1000)
found
(pat (concat "^" (regexp-quote linebeg))))
(or startpos (setq startpos (point-min)))
(while (and (not found)
(progn
(goto-char (- startpos offset))
(not (bobp))))
(setq found
(re-search-forward pat (+ startpos offset) t))
(setq offset (* 3 offset)))
(or found
(re-search-forward pat nil t)
(error "%s not found in %s" pat file)))
(beginning-of-line))
(setq tags-loop-form '(find-tag nil t))
;; Return t in case used as the tags-loop-form.
t)
(defun find-tag-other-window (tagname &optional next)
"Find tag (in current tag table) whose name contains TAGNAME.
Selects the buffer that the tag is contained in in another window
and puts point at its definition.
If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
If second arg NEXT is non-nil (interactively, with prefix arg),
searches for the next tag in the tag table
that matches the tagname used in the previous find-tag.
See documentation of variable tags-file-name."
(interactive (if current-prefix-arg
'(nil t)
(find-tag-tag "Find tag other window: ")))
(find-tag tagname next t))
(defvar next-file-list nil
"List of files for next-file to process.")
(defun next-file (&optional initialize)
"Select next file among files in current tag table.
Non-nil argument (prefix arg, if interactive)
initializes to the beginning of the list of files in the tag table."
(interactive "P")
(if initialize
(setq next-file-list (tag-table-files)))
(or next-file-list
(error "All files processed."))
(find-file (car next-file-list))
(setq next-file-list (cdr next-file-list)))
(defvar tags-loop-form nil
"Form for tags-loop-continue to eval to process one file.
If it returns nil, it is through with one file; move on to next.")
(defun tags-search (regexp)
"Search through all files listed in tag table for match for REGEXP.
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue].
See documentation of variable tags-file-name."
(interactive "sTags search (regexp): ")
(if (and (equal regexp "")
(eq (car tags-loop-form) 're-search-forward))
(tags-loop-continue nil)
(setq tags-loop-form
(list 're-search-forward regexp nil t))
(tags-loop-continue t)))
(defun list-tags (string)
"Display list of tags in file FILE.
FILE should not contain a directory spec
unless it has one in the tag table."
(interactive "sList tags (in file): ")
(with-output-to-temp-buffer "*Tags List*"
(princ "Tags in file ")
(princ string)
(terpri)
(save-excursion
(visit-tags-table-buffer)
(goto-char 1)
(search-forward (concat "\f\n" string ","))
(forward-line 1)
(while (not (looking-at "\f"))
(princ (buffer-substring (point)
(progn (skip-chars-forward "^\177")
(point))))
(terpri)
(forward-line 1)))))
(defun tags-apropos (string)
"Display list of all tags in tag table REGEXP matches."
(interactive "sTag apropos (regexp): ")
(with-output-to-temp-buffer "*Tags List*"
(princ "Tags matching regexp ")
(prin1 string)
(terpri)
(save-excursion
(visit-tags-table-buffer)
(goto-char 1)
(while (re-search-forward string nil t)
(beginning-of-line)
(princ (buffer-substring (point)
(progn (skip-chars-forward "^\177")
(point))))
(terpri)
(forward-line 1)))))
(defvar tags-known-files-list nil
"Keeps track of which files were being edited before tags-loop-continue
was called.\n")
(defun tags-loop-continue (&optional first-time)
"Continue last \\[tags-search] or \\[tags-query-replace] command.
Used noninteractively with non-nil argument
to begin such a command. See variable tags-loop-form."
(interactive)
(if first-time
(progn (setq tags-known-files-list (known-files (buffer-list)))
(next-file t)
(goto-char (point-min))))
(while (not (eval tags-loop-form))
(if (not (assoc buffer-file-name tags-known-files-list))
(kill-buffer (current-buffer)))
(next-file)
(message "Scanning file %s..." buffer-file-name)
(goto-char (point-min)))
(setq tags-known-files-list
(cons (cons buffer-file-name nil) tags-known-files-list)))
(defun tags-query-replace (from to)
"Query-replace-regexp FROM with TO through all files listed in tag table.
If you exit (C-G or ESC), you can resume the query-replace
with the command \\[tags-loop-continue].
See documentation of variable tags-file-name."
(interactive "sTags query replace (regexp): \nsTags query replace %s by: ")
(setq tags-loop-form
(list 'and (list 'save-excursion
(list 're-search-forward from nil t))
(list 'setq 'tags-known-files-list
(list 'cons (list 'cons 'buffer-file-name nil)
'tags-known-files-list))
(list 'not (list 'perform-replace from to t t nil))))
(tags-loop-continue t))
(defun known-files (bufflist)
"Make an alist of all files being edited before starting the
tags-loop-continue. cdr of each elt is nil. assoc means not having to write
a memq-for-strings."
(cond ((null bufflist)
nil)
(t
(let ((name (buffer-file-name (car bufflist))))
(if name
(cons (cons name nil)
(known-files (cdr bufflist)))
(known-files (cdr bufflist)))))))
;;;
;;; The distributed version of find-tag uses an ordinary search instead
;;; of a regexp-search. Allow people to use regexp-search if desired.
;;; Also provide for changing how the default tag is selected, to make
;;; chained tags lookups easier.
;;;
(fset 'distributed-find-tag (symbol-function 'find-tag))
(defvar find-tag-search-regexp nil
"Should the default be for a regexp search when looking up a tag
in the TAGS file? If set, this will also cause the default tag to be
looked up as a simple-minded regexp -- ^function_name(, which
unfortunately won't work for macros.")
(defun find-tag (tagname &optional next other-window)
"Find tag (in current tag table) whose name contains TAGNAME.
Selects the buffer that the tag is contained in
and puts point at its definition.
If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
If second arg NEXT is non-nil (interactively, with prefix arg),
searches for the next tag in the tag table
that matches the tagname used in the previous find-tag.
See documentation of variables tags-file-name, find-tag-search-regexp,
and find-tag-default-search-backward."
(interactive (if current-prefix-arg
'(nil t)
(find-tag-tag "Find tag: ")))
(if find-tag-search-regexp
(let ((saved-search-forward (symbol-function 'search-forward)))
(fset 'search-forward (symbol-function 're-search-forward))
(distributed-find-tag tagname next other-window)
(fset 'search-forward saved-search-forward))
(distributed-find-tag tagname next other-window)))
(defvar find-tag-default-search-backward t
"Which way to look for the tag to use by default. Default is
t (backwards, for compatibility with distributed version), but some
may prefer nil, which will search forward in the buffer instead.")
(defun find-tag-default ()
(save-excursion
(concat
(if find-tag-search-regexp
"[ \t\n\f]+")
(if find-tag-default-search-backward
(progn
(while (looking-at "\\sw\\|\\s_")
(forward-char 1))
(if (re-search-backward "\\sw\\|\\s_" nil t)
(progn (forward-char 1)
(buffer-substring
(point)
(progn (forward-sexp -1)
(while (looking-at "\\s'")
(forward-char 1))
(point))))
nil))
(progn
(while (not (looking-at "\\sw\\|\\s_"))
(forward-char 1))
(while (looking-at "\\sw\\|\\s_")
(forward-char -1))
(forward-char 1)
; (if (re-search-forward "\\sw*\\|\\s_*" nil t)
(if (re-search-forward "\\(\\sw\\|\\s_\\)*" nil t)
(progn
(buffer-substring (point)
(progn (forward-sexp -1)
(while (looking-at "\\s'")
(forward-char 1))
(point))))
nil)))
(if find-tag-search-regexp
"[ \t]*("))))
;;; Tags file selection
;;; TAGS files for various reference sources are kept in a known place and
;;; updated regularly. Users may also maintain their own such directories.
;;; The function select-tags-table will pop up a dired window on the tags
;;; directory where the user selects (with 's') the appropriate tags file
;;; and context is restored. Future invocations of find-tag, tags-search,
;;; etc., will refer to the selected tags file. Really just a menu-style
;;; visit-tags-table.
;;;
(autoload 'dired "dired" "" t)
(defvar default-tags-file-directory
"/usr/local/lib/emacs/ref-src-tags/")
(defun select-tags-table (tags-dir)
"Select a TAGS file for future reference by emacs tags commands. Use 's'
to select the desired file."
(interactive (list (expand-file-name
(read-file-name "Directory of tags files: "
default-tags-file-directory
default-tags-file-directory nil))))
(setq tags-dir
(or tags-dir default-tags-file-directory))
(let ((old-dired-hook
(and (boundp 'dired-mode-hook)
dired-mode-hook)))
(setq dired-mode-hook
(cons 'lambda
(cons nil
(cons '(local-set-key "s" 'tags-table-select)
(if old-dired-hook
(cdr (cdr old-dired-hook))
nil)))))
(dired tags-dir)
(setq dired-mode-hook old-dired-hook)))
(defun tags-table-select ()
(interactive)
(if (save-excursion
(beginning-of-line)
(looking-at " d"))
(error (concat (dired-get-filename) " is a directory.")))
(visit-tags-table (dired-get-filename))
(message (concat "Selected " (dired-get-filename)))
(bury-buffer nil))