diff options
Diffstat (limited to 'lisp/tags.el')
| -rw-r--r-- | lisp/tags.el | 304 |
1 files changed, 304 insertions, 0 deletions
diff --git a/lisp/tags.el b/lisp/tags.el new file mode 100644 index 00000000000..2cef30ae2da --- /dev/null +++ b/lisp/tags.el @@ -0,0 +1,304 @@ +;; Tags facility for Emacs. +;; Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +(provide 'tags) + +(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)))) + (setq tags-file-name buffer-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)))))) + +;; Return a default tag to search for, based on the text at point. +(defun find-tag-default () + (save-excursion + (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))) + +(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-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 (next-file t) + (goto-char (point-min)))) + (while (not (eval tags-loop-form)) + (next-file) + (message "Scanning file %s..." buffer-file-name) + (goto-char (point-min)))) + +(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 tags-query-replace (from to &optional delimited) + "Query-replace-regexp FROM with TO through all files listed in tag table. +Third arg DELIMITED (prefix arg) means replace only word-delimited matches. +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: \nP") + (setq tags-loop-form + (list 'and (list 'save-excursion + (list 're-search-forward from nil t)) + (list 'not (list 'perform-replace from to t t + (not (null delimited)))))) + (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 (or (eobp) (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))))) |