home *** CD-ROM | disk | FTP | other *** search
- ;; 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)))))
-