root/trunk/lisp/progmodes/etags.el

;;; etags.el --- etags facility for Emacs

;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998,
;;               2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;;      Free Software Foundation, Inc.

;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: FSF
;; Keywords: tools

;; 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 3, 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, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(require 'ring)
(require 'button)

;;;###autoload
(defvar tags-file-name nil
  "*File name of tags table.
To switch to a new tags table, setting this variable is sufficient.
If you set this variable, do not also set `tags-table-list'.
Use the `etags' program to make a tags table file.")
;; 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.
(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."
  :group 'etags
  :type '(repeat file))

;;;###autoload
(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)."
  :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-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-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
(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."
  :group 'etags
  :type 'hook)

;;;###autoload
(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."
  :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-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].")

;; Tags table state.
;; These variables are local in tags table buffers.

(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
  "Obarray of tag names defined in current tags table.")

(defvar tags-included-tables nil
  "List of tags tables included by the current tags table.")

(defvar next-file-list nil
  "List of files for \\[next-file] to process.")

;; Hooks for file formats.

(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 file-of-tag-function nil
  "Function to do the work of `file-of-tag' (which see).
One optional argument, a boolean specifying to return complete path (nil) or
relative path (non-nil).")
(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'.")
(defvar snarf-tag-function nil
  "Function to get info about a matched tag for `goto-tag-location-function'.
One optional argument, specifying to use explicit tag (non-nil) or not (nil).
The default is nil.")
(defvar goto-tag-location-function nil
  "Function of to go to the location in the buffer specified by a tag.
One argument, the tag info returned by `snarf-tag-function'.")
(defvar find-tag-regexp-search-function nil
  "Search function passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-regexp-tag-order nil
  "Tag order passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-regexp-next-line-after-failure-p nil
  "Flag passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-search-function nil
  "Search function passed to `find-tag-in-order' for finding a tag.")
(defvar find-tag-tag-order nil
  "Tag order passed to `find-tag-in-order' for finding a tag.")
(defvar find-tag-next-line-after-failure-p nil
  "Flag passed to `find-tag-in-order' for finding a tag.")
(defvar list-tags-function nil
  "Function to do the work of `list-tags' (which see).")
(defvar tags-apropos-function nil
  "Function to do the work of `tags-apropos' (which see).")
(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 if current buffer contains valid tags file.")

;; Initialize the tags table in the current buffer.
;; Returns non-nil if 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 '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.
  (run-hook-with-args-until-success 'tags-table-format-functions))

;;;###autoload
(defun tags-table-mode ()
  "Major mode for tags table file buffers."
  (interactive)
  (setq major-mode 'tags-table-mode
        mode-name "Tags Table"
        buffer-undo-list t)
  (initialize-new-tags-table))

;;;###autoload
(defun visit-tags-table (file &optional local)
  "Tell tags commands to use tags 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.

Normally \\[visit-tags-table] sets the global value of `tags-file-name'.
With a prefix arg, set the buffer-local value instead.
When you find a tag with \\[find-tag], the buffer it finds the tag
in is given a local value of this variable which is the name of the tags
file the tag was in."
  (interactive (list (read-file-name "Visit tags table (default TAGS): "
                                     default-directory
                                     (expand-file-name "TAGS"
                                                       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 file)
          (signal 'file-error (list "Visiting tags table"
                                    "file does not exist"
                                    file)))
      ;; Set FILE to the expanded name.
      (setq file tags-file-name)))
  (if local
      ;; Set the local value of tags-file-name.
      (set (make-local-variable 'tags-file-name) file)
    ;; Set the global value of tags-file-name.
    (setq-default tags-file-name file)))

(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)
  (setq file (expand-file-name file))
  (if (file-directory-p file)
      (expand-file-name "TAGS" file)
    file))

;; 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))
  (while (and list
              (or (eq (car list) t)
                  (not (string= file (tags-expand-table-name (car list))))))
    (setq list (cdr list)))
  list)

(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 if 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 (tags-table-mode)))
        (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)
          (tags-table-mode)))
    (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))))
           (tags-table-mode)))))

;; 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 the list, looking for a table containing tags for THIS-FILE.
    (while (and (not found)
                tables)

      (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)))
    (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))))

;;;###autoload
(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'.
If arg is nil or absent, choose a first buffer from information in
 `tags-file-name', `tags-table-list', `tags-table-list-pointer'.
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.
  (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
         ;; 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
            ;; Bury the tags table buffer so it
            ;; 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 cont
                ;; Look in the list for the table we chose.
                (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-table-list-member
                                        local-tags-file-name
                                        (car sets))))
                        (setq sets (cdr sets)))
                      (if sets
                          ;; Found in some other set.  Switch to that set.
                          (progn
                            (or (memq tags-table-list tags-table-set-list)
                                ;; Save the current list.
                                (setq tags-table-set-list
                                      (cons tags-table-list
                                            tags-table-set-list)))
                            (setq tags-table-list (car sets)))

                        ;; Not found in any existing set.
                        (if (and tags-table-list
                                 (or (eq t tags-add-tables)
                                     (and tags-add-tables
                                          (y-or-n-p
                                           (concat "Keep current list of "
                                                   "tags tables also? ")))))
                            ;; Add it to the current list.
                            (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)
                              (memq tags-table-list tags-table-set-list)
                              (setq tags-table-set-list
                                    (cons tags-table-list
                                          tags-table-set-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.
        (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))

(defun file-of-tag (&optional relative)
  "Return the file name of the file whose tags point is within.
Assumes the tags table is the current buffer.
If RELATIVE is non-nil, file name returned is relative to tags
table file's directory. If RELATIVE is nil, file name returned
is complete."
  (funcall file-of-tag-function relative))

;;;###autoload
(defun tags-table-files ()
  "Return a list of files in the current tags table.
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))))

(defun tags-included-tables ()
  "Return a list of tags tables included by the current table.
Assumes the tags table is the current buffer."
  (or tags-included-tables
      (setq tags-included-tables (funcall tags-included-tables-function))))

;; Build tags-completion-table on demand.  The single current tags table
;; and its included tags tables (and their included tables, etc.) have
;; their tags included in the completion table.
(defun