;;; etags.el --- etags facility for Emacs
-;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994
+;; Copyright (C) 1985, 86, 88, 89, 92, 93, 94, 95, 96, 98, 2000, 2001
;; Free Software Foundation, Inc.
-;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
+;; Author: Roland McGrath <roland@gnu.org>
+;; Maintainer: FSF
;; Keywords: tools
;; This file is part of GNU Emacs.
;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
;;; Code:
+(require 'ring)
+
;;;###autoload
(defvar tags-file-name nil
"*File name of tags table.
;; Make M-x set-variable tags-file-name like M-x visit-tags-table.
;;;###autoload (put 'tags-file-name 'variable-interactive "fVisit tags table: ")
+(defgroup etags nil "Tags tables"
+ :group 'tools)
+
+;;;###autoload
+(defcustom tags-case-fold-search 'default
+ "*Whether tags operations should be case-sensitive.
+A value of t means case-insensitive, a value of nil means case-sensitive.
+Any other value means use the setting of `case-fold-search'."
+ :group 'etags
+ :type '(choice (const :tag "Case-sensitive" nil)
+ (const :tag "Case-insensitive" t)
+ (other :tag "Use default" default))
+ :version "21.1")
+
;;;###autoload
;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
-(defvar tags-table-list nil
+(defcustom tags-table-list nil
"*List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
To switch to a new list of tags tables, setting this variable is sufficient.
If you set this variable, do not also set `tags-file-name'.
-Use the `etags' program to make a tags table file.")
+Use the `etags' program to make a tags table file."
+ :group 'etags
+ :type '(repeat file))
;;;###autoload
-(defvar tags-add-tables 'ask-user
+(defcustom tags-compression-info-list '("" ".Z" ".bz2" ".gz" ".tgz")
+ "*List of extensions tried by etags when jka-compr is used.
+An empty string means search the non-compressed file.
+These extensions will be tried only if jka-compr was activated
+\(i.e. via customize of `auto-compression-mode' or by calling the function
+`auto-compression-mode')."
+ :type '(repeat string)
+ :group 'etags)
+
+;; !!! tags-compression-info-list should probably be replaced by access
+;; to directory list and matching jka-compr-compression-info-list. Currently,
+;; this implementation forces each modification of
+;; jka-compr-compression-info-list to be reflected in this var.
+;; An alternative could be to say that introducing a special
+;; element in this list (e.g. t) means : try at this point
+;; using directory listing and regexp matching using
+;; jka-compr-compression-info-list.
+
+
+;;;###autoload
+(defcustom tags-add-tables 'ask-user
"*Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).
Any other value means ask the user whether to add a new tags table
-to the current list (as opposed to starting a new list).")
+to the current list (as opposed to starting a new list)."
+ :group 'etags
+ :type '(choice (const :tag "Do" t)
+ (const :tag "Don't" nil)
+ (other :tag "Ask" ask-user)))
+
+(defcustom tags-revert-without-query nil
+ "*Non-nil means reread a TAGS table without querying, if it has changed."
+ :group 'etags
+ :type 'boolean)
+
+(defvar tags-table-computed-list nil
+ "List of tags tables to search, computed from `tags-table-list'.
+This includes tables implicitly included by other tables. The list is not
+always complete: the included tables of a table are not known until that
+table is read into core. An element that is t is a placeholder
+indicating that the preceding element is a table that has not been read
+into core and might contain included tables to search.
+See `tags-table-check-computed-list'.")
+
+(defvar tags-table-computed-list-for nil
+ "Value of `tags-table-list' that `tags-table-computed-list' corresponds to.
+If `tags-table-list' changes, `tags-table-computed-list' is thrown away and
+recomputed; see `tags-table-check-computed-list'.")
(defvar tags-table-list-pointer nil
- "Pointer into `tags-table-list' where the current state of searching is.
-Might instead point into a list of included tags tables.
+ "Pointer into `tags-table-computed-list' for the current state of searching.
Use `visit-tags-table-buffer' to cycle through tags tables in this list.")
(defvar tags-table-list-started-at nil
- "Pointer into `tags-table-list', where the current search started.")
-
-(defvar tags-table-parent-pointer-list nil
- "Saved state of the tags table that included this one.
-Each element is (LIST POINTER STARTED-AT), giving the values of
- `tags-table-list', `tags-table-list-pointer' and
- `tags-table-list-started-at' from before we moved into the current table.")
+ "Pointer into `tags-table-computed-list', where the current search started.")
(defvar tags-table-set-list nil
"List of sets of tags table which have been used together in the past.
Each element is a list of strings which are file names.")
;;;###autoload
-(defvar find-tag-hook nil
+(defcustom find-tag-hook nil
"*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
The value in the buffer in which \\[find-tag] is done is used,
-not the value in the buffer \\[find-tag] goes to.")
+not the value in the buffer \\[find-tag] goes to."
+ :group 'etags
+ :type 'hook)
;;;###autoload
-(defvar find-tag-default-function nil
+(defcustom find-tag-default-function nil
"*A function of no arguments used by \\[find-tag] to pick a default tag.
If nil, and the symbol that is the value of `major-mode'
has a `find-tag-default-function' property (see `put'), that is used.
-Otherwise, `find-tag-default' is used.")
+Otherwise, `find-tag-default' is used."
+ :group 'etags
+ :type '(choice (const nil) function))
+
+(defcustom find-tag-marker-ring-length 16
+ "*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
+ :group 'etags
+ :type 'integer
+ :version "20.3")
+
+(defcustom tags-tag-face 'default
+ "*Face for tags in the output of `tags-apropos'."
+ :group 'etags
+ :type 'face
+ :version "21.1")
+
+(defcustom tags-apropos-verbose nil
+ "If non-nil, print the name of the tags file in the *Tags List* buffer."
+ :group 'etags
+ :type 'boolean
+ :version "21.1")
+
+(defcustom tags-apropos-additional-actions nil
+ "Specify additional actions for `tags-apropos'.
+
+If non-nil, value should be a list of triples (TITLE FUNCTION
+TO-SEARCH). For each triple, `tags-apropos' processes TO-SEARCH and
+lists tags from it. TO-SEARCH should be an alist, obarray, or symbol.
+If it is a symbol, the symbol's value is used.
+TITLE, a string, is a title used to label the additional list of tags.
+FUNCTION is a function to call when a symbol is selected in the
+*Tags List* buffer. It will be called with one argument SYMBOL which
+is the symbol being selected.
+
+Example value:
+
+ '((\"Emacs Lisp\" Info-goto-emacs-command-node obarray)
+ (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray)
+ (\"SCWM\" scwm-documentation scwm-obarray))"
+ :group 'etags
+ :type '(repeat (list (string :tag "Title")
+ function
+ (sexp :tag "Tags to search")))
+ :version "21.1")
+
+(defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length)
+ "Ring of markers which are locations from which \\[find-tag] was invoked.")
(defvar default-tags-table-function nil
"If non-nil, a function to choose a default tags file for a buffer.
This function receives no arguments and should return the default
tags table file to use for the current buffer.")
-(defvar tags-location-stack nil
- "List of markers which are locations visited by \\[find-tag].
+(defvar tags-location-ring (make-ring find-tag-marker-ring-length)
+ "Ring of markers which are locations visited by \\[find-tag].
Pop back to the last location with \\[negative-argument] \\[find-tag].")
\f
;; Tags table state.
;; These variables are local in tags table buffers.
-(defvar tag-lines-already-matched nil
- "List of positions of beginnings of lines within the tags table
-that are already matched.")
-
(defvar tags-table-files nil
"List of file names covered by current tags table.
nil means it has not yet been computed; use `tags-table-files' to do so.")
(defvar tags-completion-table nil
- "Alist of tag names defined in current tags table.")
+ "Obarray of tag names defined in current tags table.")
(defvar tags-included-tables nil
"List of tags tables included by the current tags table.")
\f
;; Hooks for file formats.
-(defvar tags-table-format-hooks '(etags-recognize-tags-table
- recognize-empty-tags-table)
- "List of functions to be called in a tags table buffer to identify
-the type of tags table. The functions are called in order, with no arguments,
+(defvar tags-table-format-functions '(etags-recognize-tags-table
+ tags-recognize-empty-tags-table)
+ "Hook to be called in a tags table buffer to identify the type of tags table.
+The functions are called in order, with no arguments,
until one returns non-nil. The function should make buffer-local bindings
of the format-parsing tags function variables if successful.")
(defvar tags-table-files-function nil
"Function to do the work of `tags-table-files' (which see).")
(defvar tags-completion-table-function nil
- "Function to build the tags-completion-table.")
+ "Function to build the `tags-completion-table'.")
(defvar snarf-tag-function nil
"Function to get info about a matched tag for `goto-tag-location-function'.")
(defvar goto-tag-location-function nil
(defvar tags-included-tables-function nil
"Function to do the work of `tags-included-tables' (which see).")
(defvar verify-tags-table-function nil
- "Function to return t iff the current buffer contains a valid
-\(already initialized\) tags file.")
+ "Function to return t iff current buffer contains valid tags file.")
\f
;; Initialize the tags table in the current buffer.
;; Returns non-nil iff it is a valid tags table. On
;; non-nil return, the tags table state variable are
;; made buffer-local and initialized to nil.
(defun initialize-new-tags-table ()
- (set (make-local-variable 'tag-lines-already-matched) nil)
(set (make-local-variable 'tags-table-files) nil)
(set (make-local-variable 'tags-completion-table) nil)
(set (make-local-variable 'tags-included-tables) nil)
+ ;; We used to initialize find-tag-marker-ring and tags-location-ring
+ ;; here, to new empty rings. But that is wrong, because those
+ ;; are global.
+
;; Value is t if we have found a valid tags table buffer.
- (let ((hooks tags-table-format-hooks))
- (while (and hooks
- (not (funcall (car hooks))))
- (setq hooks (cdr hooks)))
- hooks))
+ (run-hook-with-args-until-success 'tags-table-format-functions))
;;;###autoload
(defun visit-tags-table (file &optional local)
default-directory)
t)
current-prefix-arg))
+ (or (stringp file) (signal 'wrong-type-argument (list 'stringp file)))
+ ;; Bind tags-file-name so we can control below whether the local or
+ ;; global value gets set. Calling visit-tags-table-buffer will
+ ;; initialize a buffer for the file and set tags-file-name to the
;; Calling visit-tags-table-buffer with tags-file-name set to FILE will
;; initialize a buffer for FILE and set tags-file-name to the
;; fully-expanded name.
(let ((tags-file-name file))
(save-excursion
- (or (visit-tags-table-buffer 'same)
+ (or (visit-tags-table-buffer file)
(signal 'file-error (list "Visiting tags table"
"file does not exist"
file)))
;; Set the global value of tags-file-name.
(setq-default tags-file-name file)))
-;; Move tags-table-list-pointer along and set tags-file-name.
-;; If NO-INCLUDES is non-nil, ignore included tags tables.
-;; Returns nil when out of tables.
-(defun tags-next-table (&optional no-includes)
- ;; Do we have any included tables?
- (if (and (not no-includes)
- (visit-tags-table-buffer 'same)
- (tags-included-tables))
-
- ;; Move into the included tags tables.
- (setq tags-table-parent-pointer-list
- ;; Save the current state of what table we are in.
- (cons (list tags-table-list
- tags-table-list-pointer
- tags-table-list-started-at)
- tags-table-parent-pointer-list)
- ;; Start the pointer in the list of included tables.
- tags-table-list tags-included-tables
- tags-table-list-pointer tags-included-tables
- tags-table-list-started-at tags-included-tables)
-
- ;; No included tables. Go to the next table in the list.
- (setq tags-table-list-pointer
- (cdr tags-table-list-pointer))
- (or tags-table-list-pointer
- ;; Wrap around.
- (setq tags-table-list-pointer tags-table-list))
-
- (if (eq tags-table-list-pointer tags-table-list-started-at)
- ;; We have come full circle. No more tables.
- (if tags-table-parent-pointer-list
- ;; Pop back to the tags table which includes this one.
- (progn
- ;; Restore the state variables.
- (setq tags-table-list
- (nth 0 (car tags-table-parent-pointer-list))
- tags-table-list-pointer
- (nth 1 (car tags-table-parent-pointer-list))
- tags-table-list-started-at
- (nth 2 (car tags-table-parent-pointer-list))
- tags-table-parent-pointer-list
- (cdr tags-table-parent-pointer-list))
- ;; Recurse to skip to the next table after the parent.
- (tags-next-table t))
- ;; All out of tags tables.
- (setq tags-table-list-pointer nil))))
-
- (and tags-table-list-pointer
- ;; Set tags-file-name to the fully-expanded name.
- (setq tags-file-name
- (tags-expand-table-name (car tags-table-list-pointer)))))
+(defun tags-table-check-computed-list ()
+ "Compute `tags-table-computed-list' from `tags-table-list' if necessary."
+ (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list)))
+ (or (equal tags-table-computed-list-for expanded-list)
+ ;; The list (or default-directory) has changed since last computed.
+ (let* ((compute-for (mapcar 'copy-sequence expanded-list))
+ (tables (copy-sequence compute-for)) ;Mutated in the loop.
+ (computed nil)
+ table-buffer)
+
+ (while tables
+ (setq computed (cons (car tables) computed)
+ table-buffer (get-file-buffer (car tables)))
+ (if (and table-buffer
+ ;; There is a buffer visiting the file. Now make sure
+ ;; it is initialized as a tag table buffer.
+ (save-excursion
+ (tags-verify-table (buffer-file-name table-buffer))))
+ (save-excursion
+ (set-buffer table-buffer)
+ (if (tags-included-tables)
+ ;; Insert the included tables into the list we
+ ;; are processing.
+ (setcdr tables (nconc (mapcar 'tags-expand-table-name
+ (tags-included-tables))
+ (cdr tables)))))
+ ;; This table is not in core yet. Insert a placeholder
+ ;; saying we must read it into core to check for included
+ ;; tables before searching the next table in the list.
+ (setq computed (cons t computed)))
+ (setq tables (cdr tables)))
+
+ ;; Record the tags-table-list value (and the context of the
+ ;; current directory) we computed from.
+ (setq tags-table-computed-list-for compute-for
+ tags-table-computed-list (nreverse computed))))))
+
+;; Extend `tags-table-computed-list' to remove the first `t' placeholder.
+;; An element of the list that is `t' is a placeholder indicating that the
+;; preceding element is a table that has not been read into core and might
+;; contain included tables to search. On return, the first placeholder
+;; element will be gone and the element before it read into core and its
+;; included tables inserted into the list.
+(defun tags-table-extend-computed-list ()
+ (let ((list tags-table-computed-list))
+ (while (not (eq (nth 1 list) t))
+ (setq list (cdr list)))
+ (save-excursion
+ (if (tags-verify-table (car list))
+ ;; We are now in the buffer visiting (car LIST). Extract its
+ ;; list of included tables and insert it into the computed list.
+ (let ((tables (tags-included-tables))
+ (computed nil)
+ table-buffer)
+ (while tables
+ (setq computed (cons (car tables) computed)
+ table-buffer (get-file-buffer (car tables)))
+ (if table-buffer
+ (save-excursion
+ (set-buffer table-buffer)
+ (if (tags-included-tables)
+ ;; Insert the included tables into the list we
+ ;; are processing.
+ (setcdr tables (append (tags-included-tables)
+ tables))))
+ ;; This table is not in core yet. Insert a placeholder
+ ;; saying we must read it into core to check for included
+ ;; tables before searching the next table in the list.
+ (setq computed (cons t computed)))
+ (setq tables (cdr tables)))
+ (setq computed (nreverse computed))
+ ;; COMPUTED now contains the list of included tables (and
+ ;; tables included by them, etc.). Now splice this into the
+ ;; current list.
+ (setcdr list (nconc computed (cdr (cdr list)))))
+ ;; It was not a valid table, so just remove the following placeholder.
+ (setcdr list (cdr (cdr list)))))))
;; Expand tags table name FILE into a complete file name.
(defun tags-expand-table-name (file)
(expand-file-name "TAGS" file)
file))
-;; Search for FILE in LIST (default: tags-table-list); also search
-;; tables that are already in core for FILE being included by them. Return t
-;; if we find it, nil if not. Comparison is done after tags-expand-table-name
-;; on both sides. If MOVE-TO is non-nil, update tags-table-list and the list
-;; pointers to point to the table found. In recursive calls, MOVE-TO is a list
-;; value for tags-table-parent-pointer-list describing the position of the
-;; caller's search.
-(defun tags-find-table-in-list (file move-to &optional list)
- (or list
- (setq list tags-table-list))
+;; Like member, but comparison is done after tags-expand-table-name on both
+;; sides and elements of LIST that are t are skipped.
+(defun tags-table-list-member (file list)
(setq file (tags-expand-table-name file))
- (let (;; Set up the MOVE-TO argument used for the recursive calls we will do
- ;; for included tables. This is a list value for
- ;; tags-table-parent-pointer-list describing the included tables we are
- ;; descending; we cons our position onto the list from our recursive
- ;; caller (which is searching a list that contains the table whose
- ;; included tables we are searching). The atom `in-progress' is a
- ;; placeholder; when a recursive call locates FILE, we replace
- ;; 'in-progress with the tail of LIST whose car contained FILE.
- (recursing-move-to (if move-to
- (cons (list list 'in-progress 'in-progress)
- (if (eq move-to t) nil move-to))))
- this-file)
- (while (and (consp list) ; We set LIST to t when we locate FILE.
- (not (string= file
- (setq this-file
- (tags-expand-table-name (car list))))))
- (if (get-file-buffer this-file)
- ;; This table is already in core. Visit it and recurse to check
- ;; its included tables.
- (save-excursion
- (let ((tags-file-name this-file)
- found)
- (visit-tags-table-buffer 'same)
- (and (tags-included-tables)
- ;; We have some included tables; check them.
- (tags-find-table-in-list file recursing-move-to
- tags-included-tables)
- (progn
- ;; We found FILE in the included table.
- (if move-to
- (progn
- ;; The recursive call has already frobbed the list
- ;; pointers. It set tags-table-parent-pointer-list
- ;; to a list including RECURSING-MOVE-TO. Now we
- ;; must mutate that cons so its list pointers show
- ;; the position where we found this included table.
- (setcar (cdr (car recursing-move-to)) list)
- (setcar (cdr (cdr (car recursing-move-to))) list)
- ;; Don't do further list frobnication below.
- (setq move-to nil)))
- (setq list t))))))
- (if (consp list)
- (setq list (cdr list))))
- (and list move-to
- (progn
- ;; We have located FILE in the list.
- ;; Now frobnicate the list pointers to point to it.
- (setq tags-table-list-started-at list
- tags-table-list-pointer list)
- (if (consp move-to)
- ;; We are in a recursive call. MOVE-TO is the value for
- ;; tags-table-parent-pointer-list that describes the tables
- ;; descended by the caller (and its callers, recursively).
- (setq tags-table-parent-pointer-list move-to)))))
+ (while (and list
+ (or (eq (car list) t)
+ (not (string= file (tags-expand-table-name (car list))))))
+ (setq list (cdr list)))
list)
-;; Local var in visit-tags-table-buffer
-;; which is set by tags-table-including.
-(defvar visit-tags-table-buffer-cont)
-
-;; Subroutine of visit-tags-table-buffer. Frobs its local vars.
-;; Search TABLES for one that has tags for THIS-FILE. Recurses on
-;; included tables. Returns the tail of TABLES (or of an inner
-;; included list) whose car is a table listing THIS-FILE. If
-;; CORE-ONLY is non-nil, check only tags tables that are already in
-;; buffers--don't visit any new files.
-(defun tags-table-including (this-file tables core-only &optional recursing)
- (let ((starting-tables tables)
+(defun tags-verify-table (file)
+ "Read FILE into a buffer and verify that it is a valid tags table.
+Sets the current buffer to one visiting FILE (if it exists).
+Returns non-nil iff it is a valid table."
+ (if (get-file-buffer file)
+ ;; The file is already in a buffer. Check for the visited file
+ ;; having changed since we last used it.
+ (let (win)
+ (set-buffer (get-file-buffer file))
+ (setq win (or verify-tags-table-function (initialize-new-tags-table)))
+ (if (or (verify-visited-file-modtime (current-buffer))
+ ;; Decide whether to revert the file.
+ ;; revert-without-query can say to revert
+ ;; or the user can say to revert.
+ (not (or (let ((tail revert-without-query)
+ (found nil))
+ (while tail
+ (if (string-match (car tail) buffer-file-name)
+ (setq found t))
+ (setq tail (cdr tail)))
+ found)
+ tags-revert-without-query
+ (yes-or-no-p
+ (format "Tags file %s has changed, read new contents? "
+ file)))))
+ (and verify-tags-table-function
+ (funcall verify-tags-table-function))
+ (revert-buffer t t)
+ (initialize-new-tags-table)))
+ (and (file-exists-p file)
+ (progn
+ (set-buffer (find-file-noselect file))
+ (or (string= file buffer-file-name)
+ ;; find-file-noselect has changed the file name.
+ ;; Propagate the change to tags-file-name and tags-table-list.
+ (let ((tail (member file tags-table-list)))
+ (if tail
+ (setcar tail buffer-file-name))
+ (if (eq file tags-file-name)
+ (setq tags-file-name buffer-file-name))))
+ (initialize-new-tags-table)))))
+
+;; Subroutine of visit-tags-table-buffer. Search the current tags tables
+;; for one that has tags for THIS-FILE (or that includes a table that
+;; does). Return the name of the first table table listing THIS-FILE; if
+;; the table is one included by another table, it is the master table that
+;; we return. If CORE-ONLY is non-nil, check only tags tables that are
+;; already in buffers--don't visit any new files.
+(defun tags-table-including (this-file core-only)
+ (let ((tables tags-table-computed-list)
(found nil))
- ;; Loop over TABLES, looking for one containing tags for THIS-FILE.
+ ;; Loop over the list, looking for a table containing tags for THIS-FILE.
(while (and (not found)
tables)
- (let ((tags-file-name (tags-expand-table-name (car tables))))
- (if (or (get-file-buffer tags-file-name)
- (and (not core-only)
- (file-exists-p tags-file-name)))
- (progn
- ;; Select the tags table buffer and get the file list up to date.
- (visit-tags-table-buffer 'same)
- (or tags-table-files
- (setq tags-table-files
- (funcall tags-table-files-function)))
-
- (cond ((member this-file tags-table-files)
- ;; Found it.
- (setq found tables))
-
- ((tags-included-tables)
- ;; This table has included tables. Check them.
- (let ((old tags-table-parent-pointer-list))
- (unwind-protect
- (progn
- (or recursing
- ;; At top level (not in an included tags
- ;; table), set the list to nil so we can
- ;; collect just the elts from this run.
- (setq tags-table-parent-pointer-list nil))
- (setq found
- ;; Recurse on the list of included tables.
- (tags-table-including this-file
- tags-included-tables
- core-only
- t))
- (if found
- ;; One of them lists THIS-FILE.
- ;; Set the table list state variables to move
- ;; us inside the list of included tables.
- (setq tags-table-parent-pointer-list
- (cons
- (list tags-table-list
- tags-table-list-pointer
- tags-table-list-started-at)
- tags-table-parent-pointer-list)
- tags-table-list starting-tables
- tags-table-list-pointer found
- tags-table-list-started-at found
- ;; Set a local variable of
- ;; our caller, visit-tags-table-buffer.
- ;; Set it so we won't frob lists later.
- visit-tags-table-buffer-cont
- 'included)))
- (or recursing
- ;; tags-table-parent-pointer-list now describes
- ;; the path of included tables taken by recursive
- ;; invocations of this function. The recursive
- ;; calls have consed onto the front of the list,
- ;; so it is now outermost first. We want it
- ;; innermost first, so reverse it. Then append
- ;; the old list (from before we were called the
- ;; outermost time), to get the complete current
- ;; state of included tables.
- (setq tags-table-parent-pointer-list
- (nconc (nreverse
- tags-table-parent-pointer-list)
- old))))))))))
+
+ (if core-only
+ ;; Skip tables not in core.
+ (while (eq (nth 1 tables) t)
+ (setq tables (cdr (cdr tables))))
+ (if (eq (nth 1 tables) t)
+ ;; This table has not been read into core yet. Read it in now.
+ (tags-table-extend-computed-list)))
+
+ (if tables
+ ;; Select the tags table buffer and get the file list up to date.
+ (let ((tags-file-name (car tables)))
+ (visit-tags-table-buffer 'same)
+ (if (member this-file (mapcar 'expand-file-name
+ (tags-table-files)))
+ ;; Found it.
+ (setq found tables))))
(setq tables (cdr tables)))
- found))
+ (if found
+ ;; Now determine if the table we found was one included by another
+ ;; table, not explicitly listed. We do this by checking each
+ ;; element of the computed list to see if it appears in the user's
+ ;; explicit list; the last element we will check is FOUND itself.
+ ;; Then we return the last one which did in fact appear in
+ ;; tags-table-list.
+ (let ((could-be nil)
+ (elt tags-table-computed-list))
+ (while (not (eq elt (cdr found)))
+ (if (tags-table-list-member (car elt) tags-table-list)
+ ;; This table appears in the user's list, so it could be
+ ;; the one which includes the table we found.
+ (setq could-be (car elt)))
+ (setq elt (cdr elt))
+ (if (eq t (car elt))
+ (setq elt (cdr elt))))
+ ;; The last element we found in the computed list before FOUND
+ ;; that appears in the user's list will be the table that
+ ;; included the one we found.
+ could-be))))
+
+;; Subroutine of visit-tags-table-buffer. Move tags-table-list-pointer
+;; along and set tags-file-name. Returns nil when out of tables.
+(defun tags-next-table ()
+ ;; If there is a placeholder element next, compute the list to replace it.
+ (while (eq (nth 1 tags-table-list-pointer) t)
+ (tags-table-extend-computed-list))
+
+ ;; Go to the next table in the list.
+ (setq tags-table-list-pointer (cdr tags-table-list-pointer))
+ (or tags-table-list-pointer
+ ;; Wrap around.
+ (setq tags-table-list-pointer tags-table-computed-list))
+
+ (if (eq tags-table-list-pointer tags-table-list-started-at)
+ ;; We have come full circle. No more tables.
+ (setq tags-table-list-pointer nil)
+ ;; Set tags-file-name to the name from the list. It is already expanded.
+ (setq tags-file-name (car tags-table-list-pointer))))
(defun visit-tags-table-buffer (&optional cont)
"Select the buffer containing the current tags table.
+If optional arg is a string, visit that file as a tags table.
If optional arg is t, visit the next table in `tags-table-list'.
If optional arg is the atom `same', don't look for a new table;
just select the buffer visiting `tags-file-name'.
Returns t if it visits a tags table, or nil if there are no more in the list."
;; Set tags-file-name to the tags table file we want to visit.
- (let ((visit-tags-table-buffer-cont cont))
- (cond ((eq visit-tags-table-buffer-cont 'same)
- ;; Use the ambient value of tags-file-name.
- (or tags-file-name
- (error (substitute-command-keys
- (concat "No tags table in use! "
- "Use \\[visit-tags-table] to select one.")))))
-
- (visit-tags-table-buffer-cont
- ;; Find the next table.
- (if (tags-next-table)
- ;; Skip over nonexistent files.
- (let (file)
- (while (and (setq file
- (tags-expand-table-name tags-file-name))
- (not (or (get-file-buffer file)
- (file-exists-p file))))
- (tags-next-table)))))
+ (cond ((eq cont 'same)
+ ;; Use the ambient value of tags-file-name.
+ (or tags-file-name
+ (error "%s"
+ (substitute-command-keys
+ (concat "No tags table in use; "
+ "use \\[visit-tags-table] to select one")))))
+
+ ((eq t cont)
+ ;; Find the next table.
+ (if (tags-next-table)
+ ;; Skip over nonexistent files.
+ (while (and (not (or (get-file-buffer tags-file-name)
+ (file-exists-p tags-file-name)))
+ (tags-next-table)))))
- (t
- ;; We are visiting a table anew, so throw away the previous
- ;; context of what included tables we were inside of.
- (while tags-table-parent-pointer-list
- ;; Set the pointer as if we had iterated through all the
- ;; tables in the list.
- (setq tags-table-list-pointer tags-table-list-started-at)
- ;; Fetching the next table will pop the included-table state.
- (tags-next-table))
-
- ;; Pick a table out of our hat.
- (setq tags-file-name
- (or
- ;; First, try a local variable.
- (cdr (assq 'tags-file-name (buffer-local-variables)))
- ;; Second, try a user-specified function to guess.
- (and default-tags-table-function
- (funcall default-tags-table-function))
- ;; Third, look for a tags table that contains
- ;; tags for the current buffer's file.
- ;; If one is found, the lists will be frobnicated,
- ;; and VISIT-TAGS-TABLE-BUFFER-CONT
- ;; will be set non-nil so we don't do it below.
- (car (or
- ;; First check only tables already in buffers.
- (save-excursion (tags-table-including buffer-file-name
- tags-table-list
- t))
- ;; Since that didn't find any, now do the
- ;; expensive version: reading new files.
- (save-excursion (tags-table-including buffer-file-name
- tags-table-list
- nil))))
- ;; Fourth, use the user variable tags-file-name, if it is
- ;; not already in tags-table-list.
- (and tags-file-name
- (not (tags-find-table-in-list tags-file-name nil))
- tags-file-name)
- ;; Fifth, use the user variable giving the table list.
- ;; Find the first element of the list that actually exists.
- (let ((list tags-table-list)
- file)
- (while (and list
- (setq file (tags-expand-table-name (car list)))
- (not (get-file-buffer file))
- (not (file-exists-p file)))
- (setq list (cdr list)))
- (car list))
- ;; Finally, prompt the user for a file name.
- (expand-file-name
- (read-file-name "Visit tags table: (default TAGS) "
- default-directory
- "TAGS"
- t))))))
-
- ;; Expand the table name into a full file name.
- (setq tags-file-name (tags-expand-table-name tags-file-name))
-
- (if (and (eq visit-tags-table-buffer-cont t)
- (null tags-table-list-pointer))
- ;; All out of tables.
- nil
-
- ;; Verify that tags-file-name is a valid tags table.
- (if (if (get-file-buffer tags-file-name)
- ;; The file is already in a buffer. Check for the visited file
- ;; having changed since we last used it.
- (let (win)
- (set-buffer (get-file-buffer tags-file-name))
- (setq win (or verify-tags-table-function
- (initialize-new-tags-table)))
- (if (or (verify-visited-file-modtime (current-buffer))
- (not (yes-or-no-p
- "Tags file has changed, read new contents? ")))
- (and win (funcall verify-tags-table-function))
- (revert-buffer t t)
- (initialize-new-tags-table)))
- (set-buffer (find-file-noselect tags-file-name))
- (or (string= tags-file-name buffer-file-name)
- ;; find-file-noselect has changed the file name.
- ;; Propagate the change to tags-file-name and tags-table-list.
- (let ((tail (member tags-file-name tags-table-list)))
- (if tail
- (setcar tail buffer-file-name))
- (setq tags-file-name buffer-file-name)))
- (initialize-new-tags-table))
+ (t
+ ;; Pick a table out of our hat.
+ (tags-table-check-computed-list) ;Get it up to date, we might use it.
+ (setq tags-file-name
+ (or
+ ;; If passed a string, use that.
+ (if (stringp cont)
+ (prog1 cont
+ (setq cont nil)))
+ ;; First, try a local variable.
+ (cdr (assq 'tags-file-name (buffer-local-variables)))
+ ;; Second, try a user-specified function to guess.
+ (and default-tags-table-function
+ (funcall default-tags-table-function))
+ ;; Third, look for a tags table that contains tags for the
+ ;; current buffer's file. If one is found, the lists will
+ ;; be frobnicated, and CONT will be set non-nil so we don't
+ ;; do it below.
+ (and buffer-file-name
+ (or
+ ;; First check only tables already in buffers.
+ (tags-table-including buffer-file-name t)
+ ;; Since that didn't find any, now do the
+ ;; expensive version: reading new files.
+ (tags-table-including buffer-file-name nil)))
+ ;; Fourth, use the user variable tags-file-name, if it is
+ ;; not already in the current list.
+ (and tags-file-name
+ (not (tags-table-list-member tags-file-name
+ tags-table-computed-list))
+ tags-file-name)
+ ;; Fifth, use the user variable giving the table list.
+ ;; Find the first element of the list that actually exists.
+ (let ((list tags-table-list)
+ file)
+ (while (and list
+ (setq file (tags-expand-table-name (car list)))
+ (not (get-file-buffer file))
+ (not (file-exists-p file)))
+ (setq list (cdr list)))
+ (car list))
+ ;; Finally, prompt the user for a file name.
+ (expand-file-name
+ (read-file-name "Visit tags table: (default TAGS) "
+ default-directory
+ "TAGS"
+ t))))))
+
+ ;; Expand the table name into a full file name.
+ (setq tags-file-name (tags-expand-table-name tags-file-name))
+
+ (unless (and (eq cont t) (null tags-table-list-pointer))
+ ;; Verify that tags-file-name names a valid tags table.
+ ;; Bind another variable with the value of tags-file-name
+ ;; before we switch buffers, in case tags-file-name is buffer-local.
+ (let ((curbuf (current-buffer))
+ (local-tags-file-name tags-file-name))
+ (if (tags-verify-table local-tags-file-name)
;; We have a valid tags table.
(progn
;; doesn't get in the user's way.
(bury-buffer (current-buffer))
- ;; If this was a new table selection (CONT is nil), make sure
- ;; tags-table-list includes the chosen table, and update the
- ;; list pointer variables.
- (or visit-tags-table-buffer-cont
+ ;; If this was a new table selection (CONT is nil), make
+ ;; sure tags-table-list includes the chosen table, and
+ ;; update the list pointer variables.
+ (or cont
;; Look in the list for the table we chose.
- ;; This updates the list pointers if it finds the table.
- (or (tags-find-table-in-list tags-file-name t)
+ (let ((found (tags-table-list-member
+ local-tags-file-name
+ tags-table-computed-list)))
+ (if found
+ ;; There it is. Just switch to it.
+ (setq tags-table-list-pointer found
+ tags-table-list-started-at found)
+
;; The table is not in the current set.
;; Try to find it in another previously used set.
(let ((sets tags-table-set-list))
(while (and sets
- (not (tags-find-table-in-list tags-file-name
- t (car sets))))
+ (not (tags-table-list-member
+ local-tags-file-name
+ (car sets))))
(setq sets (cdr sets)))
(if sets
;; Found in some other set. Switch to that set.
(setq tags-table-set-list
(cons tags-table-list
tags-table-set-list)))
- ;; The list pointers are already up to date;
- ;; we need only set tags-table-list.
(setq tags-table-list (car sets)))
;; Not found in any existing set.
(concat "Keep current list of "
"tags tables also? ")))))
;; Add it to the current list.
- (setq tags-table-list (cons tags-file-name
+ (setq tags-table-list (cons local-tags-file-name
tags-table-list))
+
;; Make a fresh list, and store the old one.
(message "Starting a new list of tags tables")
(or (null tags-table-list)
(setq tags-table-set-list
(cons tags-table-list
tags-table-set-list)))
- (setq tags-table-list (list tags-file-name)))
-
- ;; Set the tags table list state variables to point
- ;; at the table we want to use first.
- (setq tags-table-list-started-at tags-table-list
- tags-table-list-pointer tags-table-list)))))
+ ;; Clear out buffers holding old tables.
+ (dolist (table tags-table-list)
+ ;; The list can contain items `t'.
+ (if (stringp table)
+ (let ((buffer (find-buffer-visiting table)))
+ (if buffer
+ (kill-buffer buffer)))))
+ (setq tags-table-list (list local-tags-file-name))))
+
+ ;; Recompute tags-table-computed-list.
+ (tags-table-check-computed-list)
+ ;; Set the tags table list state variables to start
+ ;; over from tags-table-computed-list.
+ (setq tags-table-list-started-at tags-table-computed-list
+ tags-table-list-pointer
+ tags-table-computed-list)))))
;; Return of t says the tags table is valid.
t)
;; The buffer was not valid. Don't use it again.
- (let ((file tags-file-name))
- (kill-local-variable 'tags-file-name)
- (if (eq file tags-file-name)
- (setq tags-file-name nil)))
- (error "File %s is not a valid tags table" buffer-file-name)))))
+ (set-buffer curbuf)
+ (kill-local-variable 'tags-file-name)
+ (if (eq local-tags-file-name tags-file-name)
+ (setq tags-file-name nil))
+ (error "File %s is not a valid tags table" local-tags-file-name)))))
+
+(defun tags-reset-tags-tables ()
+ "Reset tags state to cancel effect of any previous \\[visit-tags-table] or \\[find-tag]."
+ (interactive)
+ ;; Clear out the markers we are throwing away.
+ (let ((i 0))
+ (while (< i find-tag-marker-ring-length)
+ (if (aref (cddr tags-location-ring) i)
+ (set-marker (aref (cddr tags-location-ring) i) nil))
+ (if (aref (cddr find-tag-marker-ring) i)
+ (set-marker (aref (cddr find-tag-marker-ring) i) nil))
+ (setq i (1+ i))))
+ (setq tags-file-name nil
+ tags-location-ring (make-ring find-tag-marker-ring-length)
+ find-tag-marker-ring (make-ring find-tag-marker-ring-length)
+ tags-table-list nil
+ tags-table-computed-list nil
+ tags-table-computed-list-for nil
+ tags-table-list-pointer nil
+ tags-table-list-started-at nil
+ tags-table-set-list nil))
\f
(defun file-of-tag ()
"Return the file name of the file whose tags point is within.
;;;###autoload
(defun tags-table-files ()
"Return a list of files in the current tags table.
-Assumes the tags table is the current buffer.
-File names returned are absolute."
+Assumes the tags table is the current buffer. The file names are returned
+as they appeared in the `etags' command that created the table, usually
+without directory names."
(or tags-table-files
(setq tags-table-files
(funcall tags-table-files-function))))
;; Recurse in that buffer to compute its completion table.
(if (tags-completion-table)
;; Combine the tables.
- (mapatoms (function
- (lambda (sym)
- (intern (symbol-name sym) table)))
+ (mapatoms (lambda (sym) (intern (symbol-name sym) table))
tags-completion-table))
(setq included (cdr included))))
(setq tags-completion-table table))
(spec (completing-read (if default
(format "%s(default %s) " string default)
string)
- 'tags-complete-tag)))
+ 'tags-complete-tag
+ nil nil nil nil default)))
(if (equal spec "")
(or default (error "There is no default tag"))
spec)))
;; Get interactive args for find-tag{-noselect,-other-window,-regexp}.
(defun find-tag-interactive (prompt &optional no-default)
- (if current-prefix-arg
+ (if (and current-prefix-arg last-tag)
(list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
'-
t))
(read-string prompt)
(find-tag-tag prompt)))))
+(defvar find-tag-history nil)
+
+;; Dynamic bondage:
+(eval-when-compile
+ (defvar etags-case-fold-search)
+ (defvar etags-syntax-table))
+
;;;###autoload
(defun find-tag-noselect (tagname &optional next-p regexp-p)
"Find tag (in current tags table) whose name contains TAGNAME.
If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
+A marker representing the point when this command is invoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag: "))
- ;; Save the current buffer's value of `find-tag-hook' before selecting the
- ;; tags table buffer.
+ (setq find-tag-history (cons tagname find-tag-history))
+ ;; Save the current buffer's value of `find-tag-hook' before
+ ;; selecting the tags table buffer. For the same reason, save value
+ ;; of `tags-file-name' in case it has a buffer-local value.
(let ((local-find-tag-hook find-tag-hook))
(if (eq '- next-p)
;; Pop back to a previous location.
- (if (null tags-location-stack)
+ (if (ring-empty-p tags-location-ring)
(error "No previous tag locations")
- (let ((marker (car tags-location-stack)))
- ;; Pop the stack.
- (setq tags-location-stack (cdr tags-location-stack))
+ (let ((marker (ring-remove tags-location-ring 0)))
(prog1
;; Move to the saved location.
- (set-buffer (marker-buffer marker))
+ (set-buffer (or (marker-buffer marker)
+ (error "The marked buffer has been deleted")))
(goto-char (marker-position marker))
;; Kill that marker so it doesn't slow down editing.
(set-marker marker nil nil)
;; Run the user's hook. Do we really want to do this for pop?
(run-hooks 'local-find-tag-hook))))
- (if next-p
+ ;; Record whence we came.
+ (ring-insert find-tag-marker-ring (point-marker))
+ (if (and next-p last-tag)
;; Find the same table we last used.
(visit-tags-table-buffer 'same)
;; Pick a table to use.
(visit-tags-table-buffer)
;; Record TAGNAME for a future call with NEXT-P non-nil.
(setq last-tag tagname))
- (prog1
- ;; Record the location so we can pop back to it later.
- (marker-buffer
- (car
- (setq tags-location-stack
- (cons (let ((marker (make-marker)))
- (save-excursion
- (set-buffer
- ;; find-tag-in-order does the real work.
- (find-tag-in-order
- (if next-p last-tag tagname)
- (if regexp-p
- find-tag-regexp-search-function
- find-tag-search-function)
- (if regexp-p
- find-tag-regexp-tag-order
- find-tag-tag-order)
- (if regexp-p
- find-tag-regexp-next-line-after-failure-p
- find-tag-next-line-after-failure-p)
- (if regexp-p "matching" "containing")
- (not next-p)))
- (set-marker marker (point))))
- tags-location-stack))))
- (run-hooks 'local-find-tag-hook)))))
+ ;; Record the location so we can pop back to it later.
+ (let ((marker (make-marker)))
+ (save-excursion
+ (set-buffer
+ ;; find-tag-in-order does the real work.
+ (find-tag-in-order
+ (if (and next-p last-tag) last-tag tagname)
+ (if regexp-p
+ find-tag-regexp-search-function
+ find-tag-search-function)
+ (if regexp-p
+ find-tag-regexp-tag-order
+ find-tag-tag-order)
+ (if regexp-p
+ find-tag-regexp-next-line-after-failure-p
+ find-tag-next-line-after-failure-p)
+ (if regexp-p "matching" "containing")
+ (or (not next-p) (not last-tag))))
+ (set-marker marker (point))
+ (run-hooks 'local-find-tag-hook)
+ (ring-insert tags-location-ring marker)
+ (current-buffer))))))
;;;###autoload
(defun find-tag (tagname &optional next-p regexp-p)
is the atom `-' (interactively, with prefix arg that is a negative number
or just \\[negative-argument]), pop back to the previous tag gone to.
+If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
+
+A marker representing the point when this command is invoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag: "))
- (switch-to-buffer (find-tag-noselect tagname next-p regexp-p)))
+ (let ((buf (find-tag-noselect tagname next-p regexp-p)))
+ (condition-case nil
+ (switch-to-buffer buf)
+ (error (pop-to-buffer buf)))))
;;;###autoload (define-key esc-map "." 'find-tag)
;;;###autoload
is negative (interactively, with prefix arg that is a negative number or
just \\[negative-argument]), pop back to the previous tag gone to.
+If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
+
+A marker representing the point when this command is invoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag other window: "))
is negative (interactively, with prefix arg that is a negative number or
just \\[negative-argument]), pop back to the previous tag gone to.
+If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
+
+A marker representing the point when this command is invoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag other frame: "))
(let ((pop-up-frames t))
If third arg OTHER-WINDOW is non-nil, select the buffer in another window.
+A marker representing the point when this command is invoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag regexp: " t))
;; We go through find-tag-other-window to do all the display hair there.
(funcall (if other-window 'find-tag-other-window 'find-tag)
regexp next-p t))
+;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp)
+
+;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
+
+;;;###autoload
+(defun pop-tag-mark ()
+ "Pop back to where \\[find-tag] was last invoked.
+
+This is distinct from invoking \\[find-tag] with a negative argument
+since that pops a stack of markers at which tags were found, not from
+where they were found."
+ (interactive)
+ (if (ring-empty-p find-tag-marker-ring)
+ (error "No previous locations for find-tag invocation"))
+ (let ((marker (ring-remove find-tag-marker-ring 0)))
+ (switch-to-buffer (or (marker-buffer marker)
+ (error "The marked buffer has been deleted")))
+ (goto-char (marker-position marker))
+ (set-marker marker nil nil)))
\f
;; Internal tag finding function.
;; any member of the function list ORDER (third arg). If ORDER is nil,
;; use saved state to continue a previous search.
-;; Fourth arg MATCHING is a string, an English '-ing' word, to be used in
-;; an error message.
-
-;; Fifth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
+;; Fourth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
;; point should be moved to the next line.
+;; Fifth arg MATCHING is a string, an English '-ing' word, to be used in
+;; an error message.
+
;; Algorithm is as follows. For each qualifier-func in ORDER, go to
;; beginning of tags file, and perform inner loop: for each naive match for
;; PATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using
;; specified source file and return. Qualified matches are remembered to
;; avoid repetition. State is saved so that the loop can be continued.
+(defvar tag-lines-already-matched nil) ;matches remembered here between calls
+
(defun find-tag-in-order (pattern
search-forward-func
order
first-search)
(let (file ;name of file containing tag
tag-info ;where to find the tag in FILE
- tags-table-file ;name of tags file
(first-table t)
(tag-order order)
+ (match-marker (make-marker))
goto-func
+ (case-fold-search (if (memq tags-case-fold-search '(nil t))
+ tags-case-fold-search
+ case-fold-search))
)
(save-excursion
- (or first-search ;find-tag-noselect has already done it.
- (visit-tags-table-buffer 'same))
+
+ (if first-search
+ ;; This is the start of a search for a fresh tag.
+ ;; Clear the list of tags matched by the previous search.
+ ;; find-tag-noselect has already put us in the first tags table
+ ;; buffer before we got called.
+ (setq tag-lines-already-matched nil)
+ ;; Continuing to search for the tag specified last time.
+ ;; tag-lines-already-matched lists locations matched in previous
+ ;; calls so we don't visit the same tag twice if it matches twice
+ ;; during two passes with different qualification predicates.
+ ;; Switch to the current tags table buffer.
+ (visit-tags-table-buffer 'same))
;; Get a qualified match.
(catch 'qualified-match-found
(while (or first-table
(visit-tags-table-buffer t))
- (if first-search
- (setq tag-lines-already-matched nil))
-
(and first-search first-table
;; Start at beginning of tags file.
(goto-char (point-min)))
+
(setq first-table nil)
- (setq tags-table-file buffer-file-name)
;; Iterate over the list of ordering predicates.
(while order
(while (funcall search-forward-func pattern nil t)
;; Naive match found. Qualify the match.
(and (funcall (car order) pattern)
;; Make sure it is not a previous qualified match.
- ;; Use of `memq' depends on numbers being eq.
- (not (memq (save-excursion (beginning-of-line) (point))
- tag-lines-already-matched))
+ (not (member (set-marker match-marker (save-excursion
+ (beginning-of-line)
+ (point)))
+ tag-lines-already-matched))
(throw 'qualified-match-found nil))
(if next-line-after-failure-p
(forward-line 1)))
(goto-char (point-min)))
(setq order tag-order))
;; We throw out on match, so only get here if there were no matches.
+ ;; Clear out the markers we use to avoid duplicate matches so they
+ ;; don't slow down editting and are immediately available for GC.
+ (while tag-lines-already-matched
+ (set-marker (car tag-lines-already-matched) nil nil)
+ (setq tag-lines-already-matched (cdr tag-lines-already-matched)))
+ (set-marker match-marker nil nil)
(error "No %stags %s %s" (if first-search "" "more ")
matching pattern))
-
+
;; Found a tag; extract location info.
(beginning-of-line)
- (setq tag-lines-already-matched (cons (point)
+ (setq tag-lines-already-matched (cons match-marker
tag-lines-already-matched))
;; Expand the filename, using the tags table buffer's default-directory.
- (setq file (expand-file-name (file-of-tag))
+ ;; We should be able to search for file-name backwards in file-of-tag:
+ ;; the beginning-of-line is ok except when positioned on a "file-name" tag.
+ (setq file (expand-file-name
+ (if (memq (car order) '(tag-exact-file-name-match-p
+ tag-file-name-match-p
+ tag-partial-file-name-match-p))
+ (save-excursion (next-line 1)
+ (file-of-tag))
+ (file-of-tag)))
tag-info (funcall snarf-tag-function))
;; Get the local value in the tags table buffer before switching buffers.
(setq goto-func goto-tag-location-function)
;; Find the right line in the specified file.
- (set-buffer (find-file-noselect file))
+ ;; If we are interested in compressed-files,
+ ;; we search files with extensions.
+ ;; otherwise only the real file.
+ (let* ((buffer-search-extensions (if (featurep 'jka-compr)
+ tags-compression-info-list
+ '("")))
+ the-buffer
+ (file-search-extensions buffer-search-extensions))
+ ;; search a buffer visiting the file with each possible extension
+ ;; Note: there is a small inefficiency in find-buffer-visiting :
+ ;; truename is computed even if not needed. Not too sure about this
+ ;; but I suspect truename computation accesses the disk.
+ ;; It is maybe a good idea to optimise this find-buffer-visiting.
+ ;; An alternative would be to use only get-file-buffer
+ ;; but this looks less "sure" to find the buffer for the file.
+ (while (and (not the-buffer) buffer-search-extensions)
+ (setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions))))
+ (setq buffer-search-extensions (cdr buffer-search-extensions)))
+ ;; if found a buffer but file modified, ensure we re-read !
+ (if (and the-buffer (not (verify-visited-file-modtime the-buffer)))
+ (find-file-noselect (buffer-file-name the-buffer)))
+ ;; if no buffer found, search for files with possible extensions on disk
+ (while (and (not the-buffer) file-search-extensions)
+ (if (not (file-exists-p (concat file (car file-search-extensions))))
+ (setq file-search-extensions (cdr file-search-extensions))
+ (setq the-buffer (find-file-noselect (concat file (car file-search-extensions))))))
+ (if (not the-buffer)
+ (if (featurep 'jka-compr)
+ (error "File %s (with or without extensions %s) not found" file tags-compression-info-list)
+ (error "File %s not found" file))
+ (set-buffer the-buffer)))
(widen)
(push-mark)
(funcall goto-func tag-info)
-
- ;; Give this buffer a local value of tags-file-name.
- ;; The next time visit-tags-table-buffer is called,
- ;; it will use the same tags table that found a match in this buffer.
- (make-local-variable 'tags-file-name)
- (setq tags-file-name tags-table-file)
-
+
;; Return the buffer where the tag was found.
(current-buffer))))
\f
;; It is annoying to flash messages on the screen briefly,
;; and this message is not useful. -- rms
;; (message "%s is an `etags' TAGS file" buffer-file-name)
- (mapcar (function (lambda (elt)
- (set (make-local-variable (car elt)) (cdr elt))))
- '((file-of-tag-function . etags-file-of-tag)
- (tags-table-files-function . etags-tags-table-files)
- (tags-completion-table-function . etags-tags-completion-table)
- (snarf-tag-function . etags-snarf-tag)
- (goto-tag-location-function . etags-goto-tag-location)
- (find-tag-regexp-search-function . re-search-forward)
- (find-tag-regexp-tag-order . (tag-re-match-p))
- (find-tag-regexp-next-line-after-failure-p . t)
- (find-tag-search-function . search-forward)
- (find-tag-tag-order . (tag-exact-match-p tag-word-match-p
- tag-any-match-p))
- (find-tag-next-line-after-failure-p . nil)
- (list-tags-function . etags-list-tags)
- (tags-apropos-function . etags-tags-apropos)
- (tags-included-tables-function . etags-tags-included-tables)
- (verify-tags-table-function . etags-verify-tags-table)
- ))))
+ (mapc (lambda (elt) (set (make-local-variable (car elt)) (cdr elt)))
+ '((file-of-tag-function . etags-file-of-tag)
+ (tags-table-files-function . etags-tags-table-files)
+ (tags-completion-table-function . etags-tags-completion-table)
+ (snarf-tag-function . etags-snarf-tag)
+ (goto-tag-location-function . etags-goto-tag-location)
+ (find-tag-regexp-search-function . re-search-forward)
+ (find-tag-regexp-tag-order . (tag-re-match-p))
+ (find-tag-regexp-next-line-after-failure-p . t)
+ (find-tag-search-function . search-forward)
+ (find-tag-tag-order . (tag-exact-file-name-match-p
+ tag-file-name-match-p
+ tag-exact-match-p
+ tag-implicit-name-match-p
+ tag-symbol-match-p
+ tag-word-match-p
+ tag-partial-file-name-match-p
+ tag-any-match-p))
+ (find-tag-next-line-after-failure-p . nil)
+ (list-tags-function . etags-list-tags)
+ (tags-apropos-function . etags-tags-apropos)
+ (tags-included-tables-function . etags-tags-included-tables)
+ (verify-tags-table-function . etags-verify-tags-table)
+ ))))
;; Return non-nil iff the current buffer is a valid etags TAGS file.
(defun etags-verify-tags-table ()
;; Use eq instead of = in case char-after returns nil.
- (eq (char-after 1) ?\f))
+ (eq (char-after (point-min)) ?\f))
(defun etags-file-of-tag ()
(save-excursion
- (search-backward "\f\n")
- (forward-char 2)
- (buffer-substring (point)
- (progn (skip-chars-forward "^,") (point)))))
+ (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")
+ (expand-file-name (buffer-substring (match-beginning 1) (match-end 1))
+ (file-truename default-directory))))
+
(defun etags-tags-completion-table ()
(let ((table (make-vector 511 0)))
;; \6 is the line to start searching at;
;; \7 is the char to start searching at.
(while (re-search-forward
- "^\\(\\(.+[^-a-zA-Z0-9_$]+\\)?\\([-a-zA-Z0-9_$]+\\)\
-\[^-a-zA-Z0-9_$]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\
-\\([0-9]+\\)?,\\([0-9]+\\)?\n"
+ "^\\(\\([^\177]+[^-a-zA-Z0-9_+*$:\177]+\\)?\
+\\([-a-zA-Z0-9_+*$?:]+\\)[^-a-zA-Z0-9_+*$?:\177]*\\)\177\
+\\(\\([^\n\001]+\\)\001\\)?\\([0-9]+\\)?,\\([0-9]+\\)?\n"
nil t)
(intern (if (match-beginning 5)
;; There is an explicit tag name.
(defun etags-snarf-tag ()
(let (tag-text line startpos)
- (search-forward "\177")
- (setq tag-text (buffer-substring (1- (point))
- (save-excursion (beginning-of-line)
- (point))))
- ;; Skip explicit tag name if present.
- (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
- (if (looking-at "[0-9]")
- (setq line (string-to-int (buffer-substring
- (point)
- (progn (skip-chars-forward "0-9")
- (point))))))
- (search-forward ",")
- (if (looking-at "[0-9]")
- (setq startpos (string-to-int (buffer-substring
- (point)
- (progn (skip-chars-forward "0-9")
- (point))))))
+ (if (save-excursion
+ (forward-line -1)
+ (looking-at "\f\n"))
+ ;; The match was for a source file name, not any tag within a file.
+ ;; Give text of t, meaning to go exactly to the location we specify,
+ ;; the beginning of the file.
+ (setq tag-text t
+ line nil
+ startpos (point-min))
+
+ ;; Find the end of the tag and record the whole tag text.
+ (search-forward "\177")
+ (setq tag-text (buffer-substring (1- (point))
+ (save-excursion (beginning-of-line)
+ (point))))
+ ;; Skip explicit tag name if present.
+ (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
+ (if (looking-at "[0-9]")
+ (setq line (string-to-int (buffer-substring
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point))))))
+ (search-forward ",")
+ (if (looking-at "[0-9]")
+ (setq startpos (string-to-int (buffer-substring
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point)))))))
;; Leave point on the next line of the tags file.
(forward-line 1)
(cons tag-text (cons line startpos))))
;; TAG-INFO is a cons (TEXT LINE . POSITION) where TEXT is the initial part
;; of a line containing the tag and POSITION is the character position of
-;; TEXT within the file (starting from 1); LINE is the line number. Either
+;; TEXT within the file (starting from 1); LINE is the line number. If
+;; TEXT is t, it means the tag refers to exactly LINE or POSITION
+;; (whichever is present, LINE having preference, no searching. Either
;; LINE or POSITION may be nil; POSITION is used if present. If the tag
;; isn't exactly at the given position then look around that position using
;; a search window which expands until it hits the start of file.
(defun etags-goto-tag-location (tag-info)
(let ((startpos (cdr (cdr tag-info)))
- ;; This constant is 1/2 the initial search window.
- ;; There is no sense in making it too small,
- ;; since just going around the loop once probably
- ;; costs about as much as searching 2000 chars.
- (offset 1000)
- (found nil)
- (pat (concat (if (eq selective-display t)
- "\\(^\\|\^m\\)" "^")
- (regexp-quote (car tag-info)))))
- ;; If no char pos was given, try the given line number.
- (or startpos
- (if (car (cdr tag-info))
- (setq startpos (progn (goto-line (car (cdr tag-info)))
- (point)))))
- (or startpos
- (setq startpos (point-min)))
- ;; First see if the tag is right at the specified location.
- (goto-char startpos)
- (setq found (looking-at pat))
- (while (and (not found)
- (progn
- (goto-char (- startpos offset))
- (not (bobp))))
- (setq found
- (re-search-forward pat (+ startpos offset) t)
- offset (* 3 offset))) ; expand search window
- (or found
- (re-search-forward pat nil t)
- (error "Rerun etags: `%s' not found in %s"
- pat buffer-file-name)))
- ;; Position point at the right place
- ;; if the search string matched an extra Ctrl-m at the beginning.
- (and (eq selective-display t)
- (looking-at "\^m")
- (forward-char 1))
- (beginning-of-line))
+ (line (car (cdr tag-info)))
+ offset found pat)
+ (if (eq (car tag-info) t)
+ ;; Direct file tag.
+ (cond (line (goto-line line))
+ (startpos (goto-char startpos))
+ (t (error "etags.el BUG: bogus direct file tag")))
+ ;; This constant is 1/2 the initial search window.
+ ;; There is no sense in making it too small,
+ ;; since just going around the loop once probably
+ ;; costs about as much as searching 2000 chars.
+ (setq offset 1000
+ found nil
+ pat (concat (if (eq selective-display t)
+ "\\(^\\|\^m\\)" "^")
+ (regexp-quote (car tag-info))))
+ ;; The character position in the tags table is 0-origin.
+ ;; Convert it to a 1-origin Emacs character position.
+ (if startpos (setq startpos (1+ startpos)))
+ ;; If no char pos was given, try the given line number.
+ (or startpos
+ (if line
+ (setq startpos (progn (goto-line line)
+ (point)))))
+ (or startpos
+ (setq startpos (point-min)))
+ ;; First see if the tag is right at the specified location.
+ (goto-char startpos)
+ (setq found (looking-at pat))
+ (while (and (not found)
+ (progn
+ (goto-char (- startpos offset))
+ (not (bobp))))
+ (setq found
+ (re-search-forward pat (+ startpos offset) t)
+ offset (* 3 offset))) ; expand search window
+ (or found
+ (re-search-forward pat nil t)
+ (error "Rerun etags: `%s' not found in %s"
+ pat buffer-file-name)))
+ ;; Position point at the right place
+ ;; if the search string matched an extra Ctrl-m at the beginning.
+ (and (eq selective-display t)
+ (looking-at "\^m")
+ (forward-char 1))
+ (beginning-of-line)))
(defun etags-list-tags (file)
- (goto-char 1)
- (if (not (search-forward (concat "\f\n" file ",") nil t))
- nil
+ (goto-char (point-min))
+ (when (search-forward (concat "\f\n" file ",") nil t)
(forward-line 1)
(while (not (or (eobp) (looking-at "\f")))
(let ((tag (buffer-substring (point)
(progn (skip-chars-forward "^\177")
- (point)))))
- (princ (if (looking-at "[^\n]+\001")
- ;; There is an explicit tag name; use that.
- (buffer-substring (point)
- (progn (skip-chars-forward "^\001")
- (point)))
- tag)))
+ (point))))
+ (props `(action find-tag-other-window mouse-face highlight
+ face ,tags-tag-face))
+ (pt (with-current-buffer standard-output (point))))
+ (when (looking-at "[^\n]+\001")
+ ;; There is an explicit tag name; use that.
+ (setq tag (buffer-substring (1+ (point)) ; skip \177
+ (progn (skip-chars-forward "^\001")
+ (point)))))
+ (princ tag)
+ (when (= (aref tag 0) ?\() (princ " ...)"))
+ (add-text-properties pt (with-current-buffer standard-output (point))
+ (cons 'item (cons tag props)) standard-output))
(terpri)
(forward-line 1))
t))
+(defmacro tags-with-face (face &rest body)
+ "Execute BODY, give output to `standard-output' face FACE."
+ (let ((pp (make-symbol "start")))
+ `(let ((,pp (with-current-buffer standard-output (point))))
+ ,@body
+ (put-text-property ,pp (with-current-buffer standard-output (point))
+ 'face ,face standard-output))))
+
+(defun etags-tags-apropos-additional (regexp)
+ "Display tags matching REGEXP from `tags-apropos-additional-actions'."
+ (with-current-buffer standard-output
+ (dolist (oba tags-apropos-additional-actions)
+ (princ "\n\n")
+ (tags-with-face 'highlight (princ (car oba)))
+ (princ":\n\n")
+ (let* ((props `(action ,(cadr oba) mouse-face highlight face
+ ,tags-tag-face))
+ (beg (point))
+ (symbs (car (cddr oba)))
+ (ins-symb (lambda (sy)
+ (let ((sn (symbol-name sy)))
+ (when (string-match regexp sn)
+ (add-text-properties (point)
+ (progn (princ sy) (point))
+ (cons 'item (cons sn props)))
+ (terpri))))))
+ (when (symbolp symbs)
+ (if (boundp symbs)
+ (setq symbs (symbol-value symbs))
+ (insert "symbol `" (symbol-name symbs) "' has no value\n")
+ (setq symbs nil)))
+ (if (vectorp symbs)
+ (mapatoms ins-symb symbs)
+ (dolist (sy symbs)
+ (funcall ins-symb (car sy))))
+ (sort-lines nil beg (point))))))
+
(defun etags-tags-apropos (string)
- (goto-char 1)
+ (when tags-apropos-verbose
+ (princ "Tags in file `")
+ (tags-with-face 'highlight (princ buffer-file-name))
+ (princ "':\n\n"))
+ (goto-char (point-min))
(while (re-search-forward string nil t)
(beginning-of-line)
- (princ (buffer-substring (point)
- (progn (skip-chars-forward "^\177")
- (point))))
+ (let ((tag (buffer-substring (point)
+ (progn (skip-chars-forward "^\177")
+ (point))))
+ (props `(action find-tag-other-window mouse-face highlight
+ face ,tags-tag-face))
+ (pt (with-current-buffer standard-output (point))))
+ (princ tag)
+ (when (= (aref tag 0) ?\() (princ " ...)"))
+ (add-text-properties pt (with-current-buffer standard-output (point))
+ `(item ,tag ,@props) standard-output))
(terpri)
- (forward-line 1)))
+ (forward-line 1))
+ (when tags-apropos-verbose (princ "\n")))
(defun etags-tags-table-files ()
(let ((files nil)
(goto-char (point-min))
(while (search-forward "\f\n" nil t)
(setq beg (point))
- (skip-chars-forward "^,\n")
- (or (looking-at ",include$")
- ;; Expand in the default-directory of the tags table buffer.
- (setq files (cons (expand-file-name (buffer-substring beg (point)))
- files))))
+ (end-of-line)
+ (skip-chars-backward "^," beg)
+ (or (looking-at "include$")
+ (setq files (cons (buffer-substring beg (1- (point))) files))))
(nreverse files)))
(defun etags-tags-included-tables ()
(goto-char (point-min))
(while (search-forward "\f\n" nil t)
(setq beg (point))
- (skip-chars-forward "^,\n")
- (if (looking-at ",include$")
+ (end-of-line)
+ (skip-chars-backward "^," beg)
+ (if (looking-at "include$")
;; Expand in the default-directory of the tags table buffer.
- (setq files (cons (expand-file-name (buffer-substring beg (point)))
+ (setq files (cons (expand-file-name (buffer-substring beg (1- (point))))
files))))
(nreverse files)))
\f
;; Recognize an empty file and give it local values of the tags table format
;; variables which do nothing.
-(defun recognize-empty-tags-table ()
+(defun tags-recognize-empty-tags-table ()
(and (zerop (buffer-size))
- (mapcar (function (lambda (sym)
- (set (make-local-variable sym) 'ignore)))
- '(tags-table-files-function
- tags-completion-table-function
- find-tag-regexp-search-function
- find-tag-search-function
- tags-apropos-function
- tags-included-tables-function))
+ (mapc (lambda (sym) (set (make-local-variable sym) 'ignore))
+ '(tags-table-files-function
+ tags-completion-table-function
+ find-tag-regexp-search-function
+ find-tag-search-function
+ tags-apropos-function
+ tags-included-tables-function))
(set (make-local-variable 'verify-tags-table-function)
- (function (lambda ()
- (zerop (buffer-size)))))))
+ (lambda () (zerop (buffer-size))))))
\f
-;;; Match qualifier functions for tagnames.
-;;; XXX these functions assume etags file format.
+;; Match qualifier functions for tagnames.
+;; These functions assume the etags file format defined in etc/ETAGS.EBNF.
;; This might be a neat idea, but it's too hairy at the moment.
;;(defmacro tags-with-syntax (&rest body)
-;; (` (let ((current (current-buffer))
+;; `(let ((current (current-buffer))
;; (otable (syntax-table))
;; (buffer (find-file-noselect (file-of-tag)))
;; table)
;; (setq table (syntax-table))
;; (set-buffer current)
;; (set-syntax-table table)
-;; (,@ body))
-;; (set-syntax-table otable)))))
+;; ,@body)
+;; (set-syntax-table otable))))
;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form))
-;; t if point is at a tag line that matches TAG "exactly".
+;; exact file name match, i.e. searched tag must match complete file
+;; name including directories parts if there are some.
+(defun tag-exact-file-name-match-p (tag)
+ (and (looking-at ",[0-9\n]")
+ (save-excursion (backward-char (+ 2 (length tag)))
+ (looking-at "\f\n"))))
+;; file name match as above, but searched tag must match the file
+;; name not including the directories if there are some.
+(defun tag-file-name-match-p (tag)
+ (and (looking-at ",[0-9\n]")
+ (save-excursion (backward-char (1+ (length tag)))
+ (looking-at "/"))))
+;; this / to detect we are after a directory separator is ok for unix,
+;; is there a variable that contains the regexp for directory separator
+;; on whatever operating system ?
+;; Looks like ms-win will lose here :).
+
+;; t if point is at a tag line that matches TAG exactly.
;; point should be just after a string that matches TAG.
(defun tag-exact-match-p (tag)
;; The match is really exact if there is an explicit tag name.
- (or (looking-at (concat "[^\177]*\177" (regexp-quote tag) "\001"))
- ;; We also call it "exact" if it is surrounded by symbol boundaries.
- ;; This is needed because etags does not always generate explicit names.
- (and (looking-at "\\Sw.*\177") (looking-at "\\S_.*\177")
- (save-excursion
- (backward-char (1+ (length tag)))
- (and (looking-at "\\Sw") (looking-at "\\S_"))))))
+ (or (and (eq (char-after (point)) ?\001)
+ (eq (char-after (- (point) (length tag) 1)) ?\177))
+ ;; We are not on the explicit tag name, but perhaps it follows.
+ (looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001"))))
+
+;; t if point is at a tag line that has an implicit name.
+;; point should be just after a string that matches TAG.
+(defun tag-implicit-name-match-p (tag)
+ ;; Look at the comment of the make_tag function in lib-src/etags.c for
+ ;; a textual description of the four rules.
+ (and (string-match "^[^ \t()=,;]+$" tag) ;rule #1
+ (looking-at "[ \t()=,;]?\177") ;rules #2 and #4
+ (save-excursion
+ (backward-char (1+ (length tag)))
+ (looking-at "[\n \t()=,;]")))) ;rule #3
+
+;; t if point is at a tag line that matches TAG as a symbol.
+;; point should be just after a string that matches TAG.
+(defun tag-symbol-match-p (tag)
+ (and (looking-at "\\Sw.*\177") (looking-at "\\S_.*\177")
+ (save-excursion
+ (backward-char (1+ (length tag)))
+ (and (looking-at "\\Sw") (looking-at "\\S_")))))
;; t if point is at a tag line that matches TAG as a word.
;; point should be just after a string that matches TAG.
(defun tag-word-match-p (tag)
(and (looking-at "\\b.*\177")
- (save-excursion (backward-char (1+ (length tag)))
+ (save-excursion (backward-char (length tag))
(looking-at "\\b"))))
+;; partial file name match, i.e. searched tag must match a substring
+;; of the file name (potentially including a directory separator).
+(defun tag-partial-file-name-match-p (tag)
+ (and (looking-at ".*,[0-9\n]")
+ (save-excursion (beginning-of-line)
+ (backward-char 2)
+ (looking-at "\f\n"))))
+
;; t if point is in a tag line with a tag containing TAG as a substring.
(defun tag-any-match-p (tag)
(looking-at ".*\177"))
(and (search-forward "\177" (save-excursion (end-of-line) (point)) t)
(re-search-backward re bol t)))))
\f
+(defcustom tags-loop-revert-buffers nil
+ "*Non-nil means tags-scanning loops should offer to reread changed files.
+These loops normally read each file into Emacs, but when a file
+is already visited, they use the existing buffer.
+When this flag is non-nil, they offer to revert the existing buffer
+in the case where the file has changed since you visited it."
+ :type 'boolean
+ :group 'etags)
+
;;;###autoload
(defun next-file (&optional initialize novisit)
"Select next file among files in current tags table.
Value is nil if the file was already visited;
if the file was newly read in, the value is the filename."
- (interactive "P")
+ ;; Make the interactive arg t if there was any prefix arg.
+ (interactive (list (if current-prefix-arg t)))
(cond ((not initialize)
;; Not the first run.
)
(save-excursion
;; Visit the tags table buffer to get its list of files.
(visit-tags-table-buffer)
- (setq next-file-list (tags-table-files))))
+ ;; Copy the list so we can setcdr below, and expand the file
+ ;; names while we are at it, in this buffer's default directory.
+ (setq next-file-list (mapcar 'expand-file-name (tags-table-files)))
+ ;; Iterate over all the tags table files, collecting
+ ;; a complete list of referenced file names.
+ (while (visit-tags-table-buffer t)
+ ;; Find the tail of the working list and chain on the new
+ ;; sublist for this tags table.
+ (let ((tail next-file-list))
+ (while (cdr tail)
+ (setq tail (cdr tail)))
+ ;; Use a copy so the next loop iteration will not modify the
+ ;; list later returned by (tags-table-files).
+ (if tail
+ (setcdr tail (mapcar 'expand-file-name (tags-table-files)))
+ (setq next-file-list (mapcar 'expand-file-name
+ (tags-table-files))))))))
(t
;; Initialize the list by evalling the argument.
(setq next-file-list (eval initialize))))
- (or next-file-list
- (save-excursion
- ;; Get the files from the next tags table.
- ;; When doing (visit-tags-table-buffer t),
- ;; the tags table buffer must be current.
- (if (and (visit-tags-table-buffer 'same)
- (visit-tags-table-buffer t))
- (setq next-file-list (tags-table-files))
- (and novisit
- (get-buffer " *next-file*")
- (kill-buffer " *next-file*"))
- (error "All files processed."))))
- (let ((new (not (get-file-buffer (car next-file-list)))))
+ (unless next-file-list
+ (and novisit
+ (get-buffer " *next-file*")
+ (kill-buffer " *next-file*"))
+ (error "All files processed"))
+ (let* ((next (car next-file-list))
+ (buffer (get-file-buffer next))
+ (new (not buffer)))
+ ;; Advance the list before trying to find the file.
+ ;; If we get an error finding the file, don't get stuck on it.
+ (setq next-file-list (cdr next-file-list))
+ ;; Optionally offer to revert buffers
+ ;; if the files have changed on disk.
+ (and buffer tags-loop-revert-buffers
+ (not (verify-visited-file-modtime buffer))
+ (with-current-buffer buffer
+ (revert-buffer t)))
(if (not (and new novisit))
- (set-buffer (find-file-noselect (car next-file-list) novisit))
+ (set-buffer (find-file-noselect next novisit))
;; Like find-file, but avoids random warning messages.
(set-buffer (get-buffer-create " *next-file*"))
(kill-all-local-variables)
(erase-buffer)
- (setq new (car next-file-list))
+ (setq new next)
(insert-file-contents new nil))
- (setq next-file-list (cdr next-file-list))
new))
(defvar tags-loop-operate nil
"Form for `tags-loop-continue' to eval to change one file.")
(defvar tags-loop-scan
- '(error (substitute-command-keys
- "No \\[tags-search] or \\[tags-query-replace] in progress."))
+ '(error "%s"
+ (substitute-command-keys
+ "No \\[tags-search] or \\[tags-query-replace] in progress"))
"Form for `tags-loop-continue' to eval to scan one file.
If it returns non-nil, this file needs processing by evalling
\`tags-loop-operate'. Otherwise, move on to the next file.")
+(defun tags-loop-eval (form)
+ "Evaluate FORM and return its result.
+Bind `case-fold-search' during the evaluation, depending on the value of
+`tags-case-fold-search'."
+ (let ((case-fold-search (if (memq tags-case-fold-search '(t nil))
+ tags-case-fold-search
+ case-fold-search)))
+ (eval form)))
+
+
;;;###autoload
(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 (the
argument is passed to `next-file', which see).
-Two variables control the processing we do on each file:
-the value of `tags-loop-scan' is a form to be executed on each file
-to see if it is interesting (it returns non-nil if so)
-and `tags-loop-operate' is a form to execute to operate on an interesting file
-If the latter returns non-nil, we exit; otherwise we scan the next file."
+
+Two variables control the processing we do on each file: the value of
+`tags-loop-scan' is a form to be executed on each file to see if it is
+interesting (it returns non-nil if so) and `tags-loop-operate' is a form to
+evaluate to operate on an interesting file. If the latter evaluates to
+nil, we exit; otherwise we scan the next file."
(interactive)
(let (new
+ ;; Non-nil means we have finished one file
+ ;; and should not scan it again.
+ file-finished
+ original-point
(messaged nil))
(while
(progn
;; Scan files quickly for the first or next interesting one.
- (while (or first-time
+ ;; This starts at point in the current buffer.
+ (while (or first-time file-finished
(save-restriction
(widen)
- (not (eval tags-loop-scan))))
+ (not (tags-loop-eval tags-loop-scan))))
+ ;; If nothing was found in the previous file, and
+ ;; that file isn't in a temp buffer, restore point to
+ ;; where it was.
+ (when original-point
+ (goto-char original-point))
+
+ (setq file-finished nil)
(setq new (next-file first-time t))
+
;; If NEW is non-nil, we got a temp buffer,
;; and NEW is the file name.
- (if (or messaged
- (and (not first-time)
- (> baud-rate search-slow-speed)
- (setq messaged t)))
- (message "Scanning file %s..." (or new buffer-file-name)))
+ (when (or messaged
+ (and (not first-time)
+ (> baud-rate search-slow-speed)
+ (setq messaged t)))
+ (message "Scanning file %s..." (or new buffer-file-name)))
+
(setq first-time nil)
+ (setq original-point (if new nil (point)))
(goto-char (point-min)))
;; If we visited it in a temp buffer, visit it now for real.
(let ((pos (point)))
(erase-buffer)
(set-buffer (find-file-noselect new))
+ (setq new nil) ;No longer in a temp buffer.
(widen)
- (goto-char pos)))
+ (goto-char pos))
+ (push-mark original-point t))
(switch-to-buffer (current-buffer))
;; Now operate on the file.
;; If value is non-nil, continue to scan the next file.
- (eval tags-loop-operate)))
+ (tags-loop-eval tags-loop-operate))
+ (setq file-finished t))
(and messaged
(null tags-loop-operate)
(message "Scanning file %s...found" buffer-file-name))))
(null tags-loop-operate))
;; Continue last tags-search as if by M-,.
(tags-loop-continue nil)
- (setq tags-loop-scan
- (list 're-search-forward regexp nil t)
+ (setq tags-loop-scan `(re-search-forward ',regexp nil t)
tags-loop-operate nil)
(tags-loop-continue (or file-list-form t))))
;;;###autoload
-(defun tags-query-replace (from to &optional delimited file-list-form)
- "Query-replace-regexp FROM with TO through all files listed in tags table.
+(defun tags-query-replace (from to &optional delimited file-list-form start end)
+ "Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
-If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
+If you exit (\\[keyboard-quit], RET or q), 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-scan (list 'prog1
- (list 'if (list 're-search-forward from nil t)
- ;; When we find a match, move back
- ;; to the beginning of it so perform-replace
- ;; will see it.
- '(goto-char (match-beginning 0))))
- tags-loop-operate (list 'perform-replace from to t t delimited))
+ (interactive (query-replace-read-args "Tags query replace (regexp)" t t))
+ (setq tags-loop-scan `(let ,(unless (equal from (downcase from))
+ '((case-fold-search nil)))
+ (if (re-search-forward ',from nil t)
+ ;; When we find a match, move back
+ ;; to the beginning of it so perform-replace
+ ;; will see it.
+ (goto-char (match-beginning 0))))
+ tags-loop-operate `(perform-replace ',from ',to t t ',delimited))
(tags-loop-continue (or file-list-form t)))
\f
+(defun tags-complete-tags-table-file (string predicate what)
+ (save-excursion
+ ;; If we need to ask for the tag table, allow that.
+ (let ((enable-recursive-minibuffers t))
+ (visit-tags-table-buffer))
+ (if (eq what t)
+ (all-completions string (tags-table-files) predicate)
+ (try-completion string (tags-table-files) predicate))))
+
;;;###autoload
-(defun list-tags (file)
+(defun list-tags (file &optional next-match)
"Display list of tags in file FILE.
-FILE should not contain a directory specification."
+This searches only the first table in the list, and no included tables.
+FILE should be as it appeared in the `etags' command, usually without a
+directory specification."
(interactive (list (completing-read "List tags in file: "
- (save-excursion
- (visit-tags-table-buffer)
- (mapcar 'list
- (mapcar 'file-name-nondirectory
- (tags-table-files))))
+ 'tags-complete-tags-table-file
nil t nil)))
(with-output-to-temp-buffer "*Tags List*"
- (princ "Tags in file ")
- (princ file)
- (terpri)
+ (princ "Tags in file `")
+ (tags-with-face 'highlight (princ file))
+ (princ "':\n\n")
(save-excursion
(let ((first-time t)
(gotany nil))
(if (funcall list-tags-function file)
(setq gotany t)))
(or gotany
- (error "File %s not in current tags tables" file))))))
+ (error "File %s not in current tags tables" file)))))
+ (with-current-buffer "*Tags List*"
+ (setq buffer-read-only t)
+ (apropos-mode)))
;;;###autoload
(defun tags-apropos (regexp)
"Display list of all tags in tags table REGEXP matches."
(interactive "sTags apropos (regexp): ")
(with-output-to-temp-buffer "*Tags List*"
- (princ "Tags matching regexp ")
- (prin1 regexp)
- (terpri)
+ (princ "Click mouse-2 to follow tags.\n\nTags matching regexp `")
+ (tags-with-face 'highlight (princ regexp))
+ (princ "':\n\n")
(save-excursion
(let ((first-time t))
(while (visit-tags-table-buffer (not first-time))
(setq first-time nil)
- (funcall tags-apropos-function regexp))))))
+ (funcall tags-apropos-function regexp))))
+ (etags-tags-apropos-additional regexp))
+ (with-current-buffer "*Tags List*"
+ (setq buffer-read-only t)
+ (apropos-mode)))
\f
-;;; XXX Kludge interface.
+;; XXX Kludge interface.
;; XXX If a file is in multiple tables, selection may get the wrong one.
;;;###autoload
(defun select-tags-table ()
"Select a tags table file from a menu of those you have already used.
-The list of tags tables to select from is stored in `tags-table-file-list';
+The list of tags tables to select from is stored in `tags-table-set-list';
see the doc of that variable if you want to add names to the list."
(interactive)
(pop-to-buffer "*Tags Table List*")
(setq buffer-read-only nil)
(erase-buffer)
- (setq selective-display t
- selective-display-ellipses nil)
(let ((set-list tags-table-set-list)
(desired-point nil))
- (if tags-table-list
- (progn
+ (when tags-table-list
(setq desired-point (point-marker))
(princ tags-table-list (current-buffer))
(insert "\C-m")
(prin1 (car tags-table-list) (current-buffer)) ;invisible
- (insert "\n")))
+ (insert "\n"))
(while set-list
- (if (eq (car set-list) tags-table-list)
- ;; Already printed it.
- ()
+ (unless (eq (car set-list) tags-table-list)
(princ (car set-list) (current-buffer))
(insert "\C-m")
(prin1 (car (car set-list)) (current-buffer)) ;invisible
(insert "\n"))
(setq set-list (cdr set-list)))
- (if tags-file-name
- (progn
+ (when tags-file-name
(or desired-point
(setq desired-point (point-marker)))
(insert tags-file-name "\C-m")
(prin1 tags-file-name (current-buffer)) ;invisible
- (insert "\n")))
+ (insert "\n"))
(setq set-list (delete tags-file-name
- (apply 'nconc (cons tags-table-list
+ (apply 'nconc (cons (copy-sequence tags-table-list)
(mapcar 'copy-sequence
tags-table-set-list)))))
(while set-list
(prin1 (car set-list) (current-buffer)) ;invisible
(insert "\n")
(setq set-list (delete (car set-list) set-list)))
- (goto-char 1)
+ (goto-char (point-min))
(insert-before-markers
"Type `t' to select a tags table or set of tags tables:\n\n")
(if desired-point
(goto-char desired-point))
(set-window-start (selected-window) 1 t))
(set-buffer-modified-p nil)
+ (select-tags-table-mode))
+
+(defvar select-tags-table-mode-map)
+(let ((map (make-sparse-keymap)))
+ (define-key map "t" 'select-tags-table-select)
+ (define-key map " " 'next-line)
+ (define-key map "\^?" 'previous-line)
+ (define-key map "n" 'next-line)
+ (define-key map "p" 'previous-line)
+ (define-key map "q" 'select-tags-table-quit)
+ (setq select-tags-table-mode-map map))
+
+(defun select-tags-table-mode ()
+ "Major mode for choosing a current tags table among those already loaded.
+
+\\{select-tags-table-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
(setq buffer-read-only t
+ major-mode 'select-tags-table-mode
mode-name "Select Tags Table")
- (let ((map (make-sparse-keymap)))
- (define-key map "t" 'select-tags-table-select)
- (define-key map " " 'next-line)
- (define-key map "\^?" 'previous-line)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "q" 'select-tags-table-quit)
- (use-local-map map)))
-
+ (use-local-map select-tags-table-mode-map)
+ (setq selective-display t
+ selective-display-ellipses nil))
+
(defun select-tags-table-select ()
"Select the tags table named on this line."
(interactive)
(defun select-tags-table-quit ()
"Kill the buffer and delete the selected window."
(interactive)
- (kill-buffer (current-buffer))
- (or (one-window-p)
- (delete-window)))
+ (quit-window t (selected-window)))
\f
+;; Note, there is another definition of this function in bindings.el.
;;;###autoload
(defun complete-tag ()
"Perform tags completion on the text around point.
-Completes to the set of names listed in the current tags table.
+Completes to the set of names listed in the current tags table.
The string to complete is chosen in the same way as the default
for \\[find-tag] (which see)."
(interactive)
(or tags-table-list
tags-file-name
- (error (substitute-command-keys
- "No tags table loaded. Try \\[visit-tags-table].")))
+ (error "%s"
+ (substitute-command-keys
+ "No tags table loaded; try \\[visit-tags-table]")))
(let ((pattern (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
'find-tag-default)))
(search-backward pattern)
(setq beg (point))
(forward-char (length pattern))
- (setq completion (try-completion pattern 'tags-complete-tag nil))
+ (setq completion (tags-complete-tag pattern nil nil))
(cond ((eq completion t))
((null completion)
(message "Can't find completion for \"%s\"" pattern)
(insert completion))
(t
(message "Making completion list...")
- (with-output-to-temp-buffer " *Completions*"
+ (with-output-to-temp-buffer "*Completions*"
(display-completion-list
(all-completions pattern 'tags-complete-tag nil)))
(message "Making completion list...%s" "done")))))
-;;;###autoload (define-key esc-map "\t" 'complete-tag)
+(dolist (x '("^No tags table in use; use .* to select one$"
+ "^There is no default tag$"
+ "^No previous tag locations$"
+ "^File .* is not a valid tags table$"
+ "^No \\(more \\|\\)tags \\(matching\\|containing\\) "
+ "^Rerun etags: `.*' not found in "
+ "^All files processed$"
+ "^No .* or .* in progress$"
+ "^File .* not in current tags tables$"
+ "^No tags table loaded"
+ "^Nothing to complete$"))
+ (add-to-list 'debug-ignored-errors x))
\f
(provide 'etags)