(scheme-mode-variables): Set font-lock-comment-start-skip.

[gnu-emacs] / lisp / progmodes / etags.el

diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 3b5a9d6d7b627d1b1c066d7ce3c41345e05ccb32..96af63849a461de9955451529a8dda8c372630ef 100644 (file)
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1,16 +1,18 @@
 ;;; etags.el --- etags facility for Emacs
 
 ;;; etags.el --- etags facility for Emacs
 

-;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995
+;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998,
+;;               2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007

 ;;     Free Software Foundation, Inc.
 
 ;;     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 Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; 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 2, or (at your option)
+;; 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,
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,


@@ -20,11 +22,16 @@
 
 ;; 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
 
 ;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:

 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'ring)
+(require 'button)
+

 ;;;###autoload
 (defvar tags-file-name nil
   "*File name of tags table.
 ;;;###autoload
 (defvar tags-file-name nil
   "*File name of tags table.


@@ -34,9 +41,20 @@ 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: ")
 
 ;; 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 "Tags tables"
+(defgroup etags nil "Tags tables."

   :group 'tools)
 
   :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
 ;;;###autoload
 ;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
 (defcustom tags-table-list nil


@@ -48,6 +66,26 @@ Use the `etags' program to make a tags table file."
   :group 'etags
   :type '(repeat 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.
 ;;;###autoload
 (defcustom tags-add-tables 'ask-user
   "*Control whether to add a new tags table to the current list.


@@ -57,7 +95,7 @@ to the current list (as opposed to starting a new list)."
   :group 'etags
   :type '(choice (const :tag "Do" t)
                 (const :tag "Don't" nil)
   :group 'etags
   :type '(choice (const :tag "Do" t)
                 (const :tag "Don't" nil)

-                (const :tag "Ask" ask-user)))
+                (other :tag "Ask" ask-user)))

 
 (defcustom tags-revert-without-query nil
   "*Non-nil means reread a TAGS table without querying, if it has changed."
 
 (defcustom tags-revert-without-query nil
   "*Non-nil means reread a TAGS table without querying, if it has changed."


@@ -68,7 +106,7 @@ to the current list (as opposed to starting a new list)."
   "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
   "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
+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'.")
 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'.")


@@ -104,15 +142,59 @@ 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
 has a `find-tag-default-function' property (see `put'), that is used.
 Otherwise, `find-tag-default' is used."
   :group 'etags

-  :type 'function)
+  :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 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.
 Pop back to the last location with \\[negative-argument] \\[find-tag].")
 \f
 ;; Tags table state.


@@ -123,7 +205,7 @@ Pop back to the last location with \\[negative-argument] \\[find-tag].")
 nil means it has not yet been computed; use `tags-table-files' to do so.")
 
 (defvar tags-completion-table nil
 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.")
 
 (defvar tags-included-tables nil
   "List of tags tables included by the current tags table.")


@@ -133,21 +215,25 @@ nil means it has not yet been computed; use `tags-table-files' to do so.")
 \f
 ;; Hooks for file formats.
 
 \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 file-of-tag-function nil
 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).")
+  "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
 (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
 (defvar snarf-tag-function nil

-  "Function to get info about a matched tag for `goto-tag-location-function'.")
+  "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 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'.")


@@ -170,22 +256,30 @@ One argument, the tag info returned by `snarf-tag-function'.")
 (defvar tags-included-tables-function nil
   "Function to do the work of `tags-included-tables' (which see).")
 (defvar verify-tags-table-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 current buffer contains valid tags file.")
+  "Function to return t if current buffer contains valid tags file.")

 \f
 ;; Initialize the tags table in the current buffer.
 \f
 ;; Initialize the tags table in the current buffer.

-;; Returns non-nil iff it is a valid tags table.  On
+;; 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)
 ;; 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.
   ;; 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 tags-table-mode ()
+  "Major mode for tags table file buffers."
+  (interactive)
+  (setq major-mode 'tags-table-mode)
+  (setq mode-name "Tags Table")
+  (initialize-new-tags-table))

 
 ;;;###autoload
 (defun visit-tags-table (file &optional local)
 
 ;;;###autoload
 (defun visit-tags-table (file &optional local)


@@ -198,7 +292,7 @@ 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."
 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) "
+  (interactive (list (read-file-name "Visit tags table (default TAGS): "

                                     default-directory
                                     (expand-file-name "TAGS"
                                                       default-directory)
                                     default-directory
                                     (expand-file-name "TAGS"
                                                       default-directory)


@@ -323,13 +417,13 @@ file the tag was in."
 (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).
 (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."
+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))
   (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)))
+       (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
        (if (or (verify-visited-file-modtime (current-buffer))
                ;; Decide whether to revert the file.
                ;; revert-without-query can say to revert


@@ -348,7 +442,7 @@ Returns non-nil iff it is a valid table."
            (and verify-tags-table-function
                 (funcall verify-tags-table-function))
          (revert-buffer t t)
            (and verify-tags-table-function
                 (funcall verify-tags-table-function))
          (revert-buffer t t)

-         (initialize-new-tags-table)))
+         (tags-table-mode)))

     (and (file-exists-p file)
         (progn
           (set-buffer (find-file-noselect file))
     (and (file-exists-p file)
         (progn
           (set-buffer (find-file-noselect file))


@@ -360,7 +454,7 @@ Returns non-nil iff it is a valid table."
                     (setcar tail buffer-file-name))
                 (if (eq file tags-file-name)
                     (setq tags-file-name buffer-file-name))))
                     (setcar tail buffer-file-name))
                 (if (eq file tags-file-name)
                     (setq tags-file-name buffer-file-name))))

-          (initialize-new-tags-table)))))
+          (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
 
 ;; 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


@@ -433,6 +527,7 @@ Returns non-nil iff it is a valid table."
     ;; Set tags-file-name to the name from the list.  It is already expanded.
     (setq tags-file-name (car tags-table-list-pointer))))
 
     ;; 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.
 (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.


@@ -503,7 +598,7 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
                  (car list))
                ;; Finally, prompt the user for a file name.
                (expand-file-name
                  (car list))
                ;; Finally, prompt the user for a file name.
                (expand-file-name

-                (read-file-name "Visit tags table: (default TAGS) "
+                (read-file-name "Visit tags table (default TAGS): "

                                 default-directory
                                 "TAGS"
                                 t))))))
                                 default-directory
                                 "TAGS"
                                 t))))))


@@ -511,11 +606,7 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
   ;; Expand the table name into a full file name.
   (setq tags-file-name (tags-expand-table-name tags-file-name))
 
   ;; Expand the table name into a full file name.
   (setq tags-file-name (tags-expand-table-name tags-file-name))
 

-  (if (and (eq cont t)
-          (null tags-table-list-pointer))
-      ;; All out of tables.
-      nil
-
+  (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.
     ;; 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.


@@ -578,6 +669,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
                              (setq tags-table-set-list
                                    (cons 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.
                          (setq tags-table-list (list local-tags-file-name))))
 
                      ;; Recompute tags-table-computed-list.


@@ -599,11 +697,19 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
        (error "File %s is not a valid tags table" local-tags-file-name)))))
 
 (defun tags-reset-tags-tables ()
        (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]."
+  "Reset tags state to cancel effect of any previous \\[visit-tags-table] or \\[find-tag]."

   (interactive)
   (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
   (setq tags-file-name nil

-       tags-location-stack 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 nil
        tags-table-computed-list nil
        tags-table-computed-list-for nil


@@ -611,11 +717,13 @@ or \\[find-tag]."
        tags-table-list-started-at nil
        tags-table-set-list nil))
 \f
        tags-table-list-started-at nil
        tags-table-set-list nil))
 \f

-(defun file-of-tag ()
+(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.
   "Return the file name of the file whose tags point is within.
 Assumes the tags table is the current buffer.

-File name returned is relative to tags table file's directory."
-  (funcall file-of-tag-function))
+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 ()
 
 ;;;###autoload
 (defun tags-table-files ()


@@ -638,29 +746,25 @@ Assumes the tags table is the current buffer."
 ;; their tags included in the completion table.
 (defun tags-completion-table ()
   (or tags-completion-table
 ;; their tags included in the completion table.
 (defun tags-completion-table ()
   (or tags-completion-table

+      ;; No cached value for this buffer.

       (condition-case ()
       (condition-case ()

-         (prog2
-          (message "Making tags completion table for %s..." buffer-file-name)
-          (let ((included (tags-included-tables))
-                (table (funcall tags-completion-table-function)))
-            (save-excursion
-              ;; Iterate over the list of included tables, and combine each
-              ;; included table's completion obarray to the parent obarray.
-              (while included
-                ;; Visit the buffer.
-                (let ((tags-file-name (car included)))
-                  (visit-tags-table-buffer 'same))
-                ;; 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)))
-                              tags-completion-table))
-                (setq included (cdr included))))
-            (setq tags-completion-table table))
-          (message "Making tags completion table for %s...done"
-                   buffer-file-name))
+         (let (current-table combined-table)
+           (message "Making tags completion table for %s..." buffer-file-name)
+           (save-excursion
+             ;; Iterate over the current list of tags tables.
+             (while (visit-tags-table-buffer (and combined-table t))
+               ;; Find possible completions in this table.
+               (setq current-table (funcall tags-completion-table-function))
+               ;; Merge this buffer's completions into the combined table.
+               (if combined-table
+                   (mapatoms
+                    (lambda (sym) (intern (symbol-name sym) combined-table))
+                    current-table)
+                 (setq combined-table current-table))))
+           (message "Making tags completion table for %s...done"
+                    buffer-file-name)
+           ;; Cache the result a buffer-local variable.
+           (setq tags-completion-table combined-table))

        (quit (message "Tags completion table construction aborted.")
              (setq tags-completion-table nil)))))
 
        (quit (message "Tags completion table construction aborted.")
              (setq tags-completion-table nil)))))
 


@@ -675,32 +779,18 @@ Assumes the tags table is the current buffer."
        (all-completions string (tags-completion-table) predicate)
       (try-completion string (tags-completion-table) predicate))))
 \f
        (all-completions string (tags-completion-table) predicate)
       (try-completion string (tags-completion-table) predicate))))
 \f

-;; Return a default tag to search for, based on the text at point.
-(defun find-tag-default ()
-  (save-excursion
-    (while (looking-at "\\sw\\|\\s_")
-      (forward-char 1))
-    (if (or (re-search-backward "\\sw\\|\\s_"
-                               (save-excursion (beginning-of-line) (point))
-                               t)
-           (re-search-forward "\\(\\sw\\|\\s_\\)+"
-                              (save-excursion (end-of-line) (point))
-                              t))
-       (progn (goto-char (match-end 0))
-              (buffer-substring (point)
-                                (progn (forward-sexp -1)
-                                       (while (looking-at "\\s'")
-                                         (forward-char 1))
-                                       (point))))
-      nil)))
-

 ;; Read a tag name from the minibuffer with defaulting and completion.
 (defun find-tag-tag (string)
 ;; Read a tag name from the minibuffer with defaulting and completion.
 (defun find-tag-tag (string)

-  (let* ((default (funcall (or find-tag-default-function
+  (let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
+                                    tags-case-fold-search
+                                  case-fold-search))
+        (default (funcall (or find-tag-default-function

                               (get major-mode 'find-tag-default-function)
                               'find-tag-default)))
         (spec (completing-read (if default
                               (get major-mode 'find-tag-default-function)
                               'find-tag-default)))
         (spec (completing-read (if default

-                                   (format "%s(default %s) " string default)
+                                   (format "%s (default %s): "
+                                           (substring string 0 (string-match "[ :]+\\'" string))
+                                           default)

                                  string)
                                'tags-complete-tag
                                nil nil nil nil default)))
                                  string)
                                'tags-complete-tag
                                nil nil nil nil default)))


@@ -713,7 +803,7 @@ Assumes the tags table is the current buffer."
 
 ;; Get interactive args for find-tag{-noselect,-other-window,-regexp}.
 (defun find-tag-interactive (prompt &optional no-default)
 
 ;; 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))
       (list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
                    '-
                  t))


@@ -723,6 +813,11 @@ Assumes the tags table is the current buffer."
 
 (defvar find-tag-history nil)
 
 
 (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.
 ;;;###autoload
 (defun find-tag-noselect (tagname &optional next-p regexp-p)
   "Find tag (in current tags table) whose name contains TAGNAME.


@@ -738,29 +833,35 @@ 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.
 
 
 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: "))
 
   (setq find-tag-history (cons tagname find-tag-history))
 See documentation of variable `tags-file-name'."
   (interactive (find-tag-interactive "Find tag: "))
 
   (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.
+  ;; 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.
   (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")
            (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.
            (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))))
              (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.
          ;; Find the same table we last used.
          (visit-tags-table-buffer 'same)
        ;; Pick a table to use.


@@ -773,7 +874,7 @@ See documentation of variable `tags-file-name'."
          (set-buffer
           ;; find-tag-in-order does the real work.
           (find-tag-in-order
          (set-buffer
           ;; find-tag-in-order does the real work.
           (find-tag-in-order

-           (if next-p last-tag tagname)
+           (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-search-function
              find-tag-search-function)


@@ -784,11 +885,10 @@ See documentation of variable `tags-file-name'."
                find-tag-regexp-next-line-after-failure-p
              find-tag-next-line-after-failure-p)
            (if regexp-p "matching" "containing")
                find-tag-regexp-next-line-after-failure-p
              find-tag-next-line-after-failure-p)
            (if regexp-p "matching" "containing")

-           (not next-p)))
+           (or (not next-p) (not last-tag))))

          (set-marker marker (point))
          (run-hooks 'local-find-tag-hook)
          (set-marker marker (point))
          (run-hooks 'local-find-tag-hook)

-         (setq tags-location-stack
-               (cons marker tags-location-stack))
+         (ring-insert tags-location-ring marker)

          (current-buffer))))))
 
 ;;;###autoload
          (current-buffer))))))
 
 ;;;###autoload


@@ -803,9 +903,20 @@ multiple matches for a tag, more exact matches are found first.  If NEXT-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.
 
 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: "))
 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))
+        (pos (with-current-buffer buf (point))))
+    (condition-case nil
+       (switch-to-buffer buf)
+      (error (pop-to-buffer buf)))
+    (goto-char pos)))

 ;;;###autoload (define-key esc-map "." 'find-tag)
 
 ;;;###autoload
 ;;;###autoload (define-key esc-map "." 'find-tag)
 
 ;;;###autoload


@@ -821,6 +932,12 @@ multiple matches for a tag, more exact matches are found first.  If NEXT-P
 is negative (interactively, with prefix arg that is a negative number or
 just \\[negative-argument]), pop back to the previous tag gone to.
 
 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: "))
 
 See documentation of variable `tags-file-name'."
   (interactive (find-tag-interactive "Find tag other window: "))
 


@@ -856,6 +973,12 @@ multiple matches for a tag, more exact matches are found first.  If NEXT-P
 is negative (interactively, with prefix arg that is a negative number or
 just \\[negative-argument]), pop back to the previous tag gone to.
 
 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))
 See documentation of variable `tags-file-name'."
   (interactive (find-tag-interactive "Find tag other frame: "))
   (let ((pop-up-frames t))


@@ -875,12 +998,34 @@ just \\[negative-argument]), pop back to the previous tag gone to.
 
 If third arg OTHER-WINDOW is non-nil, select the buffer in another window.
 
 
 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)
 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.
 
 \f
 ;; Internal tag finding function.
 


@@ -888,12 +1033,12 @@ See documentation of variable `tags-file-name'."
 ;; any member of the function list ORDER (third arg).  If ORDER is nil,
 ;; use saved state to continue a previous search.
 
 ;; 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.
 
 ;; 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
 ;; 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


@@ -915,6 +1060,9 @@ See documentation of variable `tags-file-name'."
        (tag-order order)
        (match-marker (make-marker))
        goto-func
        (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
 
        )
     (save-excursion
 


@@ -976,20 +1124,66 @@ See documentation of variable `tags-file-name'."
       (setq tag-lines-already-matched (cons match-marker
                                            tag-lines-already-matched))
       ;; Expand the filename, using the tags table buffer's default-directory.
       (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)
            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))
+      (tag-find-file-of-tag-noselect file)

       (widen)
       (push-mark)
       (funcall goto-func tag-info)
 
       ;; Return the buffer where the tag was found.
       (current-buffer))))
       (widen)
       (push-mark)
       (funcall goto-func tag-info)
 
       ;; Return the buffer where the tag was found.
       (current-buffer))))

+
+(defun tag-find-file-of-tag-noselect (file)
+  ;; Find the right line in the specified 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))))
+
+(defun tag-find-file-of-tag (file)
+  (let ((buf (tag-find-file-of-tag-noselect file)))
+    (condition-case nil
+       (switch-to-buffer buf)
+      (error (pop-to-buffer buf)))))

 \f
 ;; `etags' TAGS file format support.
 
 \f
 ;; `etags' TAGS file format support.
 


@@ -1000,43 +1194,52 @@ See documentation of variable `tags-file-name'."
        ;; 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)
        ;; 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-file-name-match-p
-                                       tag-exact-match-p
-                                       tag-symbol-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)
-                ))))
-
-;; Return non-nil iff the current buffer is a valid etags TAGS file.
+       (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)
+              ))))
+

 (defun etags-verify-tags-table ()
 (defun etags-verify-tags-table ()

+  "Return non-nil if the current buffer is a valid etags TAGS file."

   ;; Use eq instead of = in case char-after returns nil.
   ;; 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 ()
+(defun etags-file-of-tag (&optional relative)

   (save-excursion
     (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")
   (save-excursion
     (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")

-    (expand-file-name (buffer-substring (match-beginning 1) (match-end 1))
-                     (file-truename default-directory))))
+    (let ((str (buffer-substring (match-beginning 1) (match-end 1))))
+      (if relative
+         str
+       (expand-file-name str
+                         (file-truename default-directory))))))

 
 
 (defun etags-tags-completion-table ()
 
 
 (defun etags-tags-completion-table ()

-  (let ((table (make-vector 511 0)))
+  (let ((table (make-vector 511 0))
+       (progress-reporter
+        (make-progress-reporter
+         (format "Making tags completion table for %s..." buffer-file-name)
+         (point-min) (point-max))))

     (save-excursion
       (goto-char (point-min))
       ;; This monster regexp matches an etags tag line.
     (save-excursion
       (goto-char (point-min))
       ;; This monster regexp matches an etags tag line.


@@ -1048,20 +1251,21 @@ See documentation of variable `tags-file-name'."
       ;;   \6 is the line to start searching at;
       ;;   \7 is the char to start searching at.
       (while (re-search-forward
       ;;   \6 is the line to start searching at;
       ;;   \7 is the char to start searching at.
       (while (re-search-forward

-             "^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\
-\[^-a-zA-Z0-9_$?:\177]*\\)\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)
              nil t)

-       (intern (if (match-beginning 5)
-                   ;; There is an explicit tag name.
-                   (buffer-substring (match-beginning 5) (match-end 5))
-                 ;; No explicit tag name.  Best guess.
-                 (buffer-substring (match-beginning 3) (match-end 3)))
+       (intern (prog1 (if (match-beginning 5)
+                          ;; There is an explicit tag name.
+                          (buffer-substring (match-beginning 5) (match-end 5))
+                        ;; No explicit tag name.  Best guess.
+                        (buffer-substring (match-beginning 3) (match-end 3)))
+                 (progress-reporter-update progress-reporter (point)))

                table)))
     table))
 
                table)))
     table))
 

-(defun etags-snarf-tag ()
-  (let (tag-text line startpos)
+(defun etags-snarf-tag (&optional use-explicit)
+  (let (tag-text line startpos explicit-start)

     (if (save-excursion
          (forward-line -1)
          (looking-at "\f\n"))
     (if (save-excursion
          (forward-line -1)
          (looking-at "\f\n"))


@@ -1070,26 +1274,32 @@ See documentation of variable `tags-file-name'."
        ;; the beginning of the file.
        (setq tag-text t
              line nil
        ;; the beginning of the file.
        (setq tag-text t
              line nil

-             startpos 1)
+             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))))
 
       ;; 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 use-explicit is non nil and explicit tag is present, use it as part of
+      ;; return value. Else just skip it.
+      (setq explicit-start (point))
+      (when (and (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
+                use-explicit)
+       (setq tag-text (buffer-substring explicit-start (1- (point)))))
+
+

       (if (looking-at "[0-9]")
       (if (looking-at "[0-9]")

-         (setq line (string-to-int (buffer-substring
-                                    (point)
-                                    (progn (skip-chars-forward "0-9")
-                                           (point))))))
+         (setq line (string-to-number (buffer-substring
+                                        (point)
+                                        (progn (skip-chars-forward "0-9")
+                                               (point))))))

       (search-forward ",")
       (if (looking-at "[0-9]")
       (search-forward ",")
       (if (looking-at "[0-9]")

-         (setq startpos (string-to-int (buffer-substring
-                                        (point)
-                                        (progn (skip-chars-forward "0-9")
-                                               (point)))))))
+         (setq startpos (string-to-number (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))))
     ;; Leave point on the next line of the tags file.
     (forward-line 1)
     (cons tag-text (cons line startpos))))


@@ -1152,33 +1362,138 @@ See documentation of variable `tags-file-name'."
     (beginning-of-line)))
 
 (defun etags-list-tags (file)
     (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 (re-search-forward (concat "\f\n" "\\(" file "\\)" ",") nil t)
+    (let ((path (save-excursion (forward-line 1) (file-of-tag)))
+         ;; Get the local value in the tags table
+         ;; buffer before switching buffers.
+         (goto-func goto-tag-location-function)
+         tag tag-info pt)

     (forward-line 1)
     (while (not (or (eobp) (looking-at "\f")))
     (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 (1+ (point)) ;skip \177
-                                    (progn (skip-chars-forward "^\001")
-                                           (point)))
-                tag)))
+      (setq tag-info (save-excursion (funcall snarf-tag-function t))
+           tag (car tag-info)
+           pt (with-current-buffer standard-output (point)))
+      (princ tag)
+      (when (= (aref tag 0) ?\() (princ " ...)"))
+      (with-current-buffer standard-output
+       (make-text-button pt (point)
+                         'tag-info tag-info
+                         'file-path path
+                         'goto-func goto-func
+                         'action (lambda (button)
+                                   (let ((tag-info (button-get button 'tag-info))
+                                         (goto-func (button-get button 'goto-func)))
+                                     (tag-find-file-of-tag (button-get button 'file-path))
+                                     (widen)
+                                     (funcall goto-func tag-info)))
+                         'face 'tags-tag-face
+                         'type 'button))

       (terpri)
       (forward-line 1))
       (terpri)
       (forward-line 1))

-    t))
+    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* ((beg (point))
+            (symbs (car (cddr oba)))
+             (ins-symb (lambda (sy)
+                         (let ((sn (symbol-name sy)))
+                           (when (string-match regexp sn)
+                             (make-text-button (point)
+                                         (progn (princ sy) (point))
+                                         'action-internal(cadr oba)
+                                         'action (lambda (button) (funcall
+                                                                   (button-get button 'action-internal)
+                                                                   (button-get button 'item)))
+                                         'item sn
+                                         'face tags-tag-face
+                                         'type 'button)
+                             (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)
 
 (defun etags-tags-apropos (string)

-  (goto-char 1)
-  (while (re-search-forward string nil t)
-    (beginning-of-line)
-    (princ (buffer-substring (point)
-                            (progn (skip-chars-forward "^\177")
-                                   (point))))
-    (terpri)
-    (forward-line 1)))
+  (when tags-apropos-verbose
+    (princ "Tags in file `")
+    (tags-with-face 'highlight (princ buffer-file-name))
+    (princ "':\n\n"))
+  (goto-char (point-min))
+  (let ((progress-reporter (make-progress-reporter
+                           (format "Making tags apropos buffer for `%s'..."
+                                   string)
+                           (point-min) (point-max))))
+    (while (re-search-forward string nil t)
+      (progress-reporter-update progress-reporter (point))
+      (beginning-of-line)
+
+      (let* ( ;; Get the local value in the tags table
+            ;; buffer before switching buffers.
+            (goto-func goto-tag-location-function)
+            (tag-info (save-excursion (funcall snarf-tag-function)))
+            (tag (if (eq t (car tag-info)) nil (car tag-info)))
+            (file-path (save-excursion (if tag (file-of-tag)
+                                         (save-excursion (next-line 1)
+                                                         (file-of-tag)))))
+            (file-label (if tag (file-of-tag t)
+                          (save-excursion (next-line 1)
+                                          (file-of-tag t))))
+            (pt (with-current-buffer standard-output (point))))
+       (if tag
+           (progn
+             (princ (format "[%s]: " file-label))
+             (princ tag)
+             (when (= (aref tag 0) ?\() (princ " ...)"))
+             (with-current-buffer standard-output
+               (make-text-button pt (point)
+                                 'tag-info tag-info
+                                 'file-path file-path
+                                 'goto-func goto-func
+                                 'action (lambda (button)
+                                           (let ((tag-info (button-get button 'tag-info))
+                                                 (goto-func (button-get button 'goto-func)))
+                                             (tag-find-file-of-tag (button-get button 'file-path))
+                                             (widen)
+                                             (funcall goto-func tag-info)))
+                                 'face 'tags-tag-face
+                                 'type 'button)))
+         (princ (format "- %s" file-label))
+         (with-current-buffer standard-output
+           (make-text-button pt (point)
+                             'file-path file-path
+                             'action (lambda (button)
+                                       (tag-find-file-of-tag (button-get button 'file-path))
+                                       ;; Get the local value in the tags table
+                                       ;; buffer before switching buffers.
+                                       (goto-char (point-min)))
+                             'face 'tags-tag-face
+                             'type 'button))
+         ))
+      (terpri)
+      (forward-line 1))
+    (message nil))
+  (when tags-apropos-verbose (princ "\n")))

 
 (defun etags-tags-table-files ()
   (let ((files nil)
 
 (defun etags-tags-table-files ()
   (let ((files nil)


@@ -1210,26 +1525,24 @@ See documentation of variable `tags-file-name'."
 
 ;; Recognize an empty file and give it local values of the tags table format
 ;; variables which do nothing.
 
 ;; 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))
   (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)
        (set (make-local-variable 'verify-tags-table-function)

-           (function (lambda ()
-                       (zerop (buffer-size)))))))
+            (lambda () (zerop (buffer-size))))))

 \f
 \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)
 
 ;; 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)
 ;;        (otable (syntax-table))
 ;;        (buffer (find-file-noselect (file-of-tag)))
 ;;        table)


@@ -1239,10 +1552,27 @@ See documentation of variable `tags-file-name'."
 ;;          (setq table (syntax-table))
 ;;          (set-buffer current)
 ;;          (set-syntax-table 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))
 
 ;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form))
 

+;; 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)
 ;; 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)


@@ -1252,6 +1582,17 @@ See documentation of variable `tags-file-name'."
       ;; We are not on the explicit tag name, but perhaps it follows.
       (looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001"))))
 
       ;; 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)
 ;; 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)


@@ -1267,10 +1608,13 @@ See documentation of variable `tags-file-name'."
        (save-excursion (backward-char (length tag))
                       (looking-at "\\b"))))
 
        (save-excursion (backward-char (length tag))
                       (looking-at "\\b"))))
 

-(defun tag-exact-file-name-match-p (tag)
-  (and (looking-at ",")
-       (save-excursion (backward-char (length tag))
-                      (looking-at "\f\n"))))
+;; 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)
 
 ;; t if point is in a tag line with a tag containing TAG as a substring.
 (defun tag-any-match-p (tag)


@@ -1284,6 +1628,15 @@ See documentation of variable `tags-file-name'."
       (and (search-forward "\177" (save-excursion (end-of-line) (point)) t)
           (re-search-backward re bol t)))))
 \f
       (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.
 ;;;###autoload
 (defun next-file (&optional initialize novisit)
   "Select next file among files in current tags table.


@@ -1327,17 +1680,23 @@ if the file was newly read in, the value is the filename."
        (t
         ;; Initialize the list by evalling the argument.
         (setq next-file-list (eval initialize))))
        (t
         ;; Initialize the list by evalling the argument.
         (setq next-file-list (eval initialize))))

-  (if 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))
     (and novisit
         (get-buffer " *next-file*")
         (kill-buffer " *next-file*"))
     (error "All files processed"))
   (let* ((next (car next-file-list))

-        (new (not (get-file-buffer next))))
+        (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))
     ;; 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 next novisit))
       ;; Like find-file, but avoids random warning messages.
     (if (not (and new novisit))
        (set-buffer (find-file-noselect next novisit))
       ;; Like find-file, but avoids random warning messages.


@@ -1359,6 +1718,16 @@ if the file was newly read in, the value is the filename."
 If it returns non-nil, this file needs processing by evalling
 \`tags-loop-operate'.  Otherwise, move on to the next 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.
 ;;;###autoload
 (defun tags-loop-continue (&optional first-time)
   "Continue last \\[tags-search] or \\[tags-query-replace] command.


@@ -1372,23 +1741,38 @@ evaluate to operate on an interesting file.  If the latter evaluates to
 nil, we exit; otherwise we scan the next file."
   (interactive)
   (let (new
 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.
        (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)
                     (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))
            (setq new (next-file first-time t))

+

            ;; If NEW is non-nil, we got a temp buffer,
            ;; and NEW is the file name.
            ;; 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 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.
            (goto-char (point-min)))
 
          ;; If we visited it in a temp buffer, visit it now for real.


@@ -1398,13 +1782,15 @@ nil, we exit; otherwise we scan the next file."
                (set-buffer (find-file-noselect new))
                (setq new nil)          ;No longer in a temp buffer.
                (widen)
                (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.
 
          (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))))
     (and messaged
         (null tags-loop-operate)
         (message "Scanning file %s...found" buffer-file-name))))


@@ -1423,30 +1809,27 @@ See documentation of variable `tags-file-name'."
           (null tags-loop-operate))
       ;; Continue last tags-search as if by M-,.
       (tags-loop-continue nil)
           (null tags-loop-operate))
       ;; Continue last tags-search as if by M-,.
       (tags-loop-continue nil)

-    (setq tags-loop-scan
-         (list 're-search-forward (list 'quote 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
          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.
 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'."
 with the command \\[tags-loop-continue].
 
 See documentation of variable `tags-file-name'."

-  (interactive (query-replace-read-args "Tags query replace (regexp)" t))
-  (setq tags-loop-scan (list 'prog1
-                            (list 'if (list 're-search-forward
-                                            (list 'quote 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
-                               (list 'quote from) (list 'quote to)
-                               t t (list 'quote 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)
   (tags-loop-continue (or file-list-form t)))
 \f
 (defun tags-complete-tags-table-file (string predicate what)


@@ -1455,10 +1838,8 @@ See documentation of variable `tags-file-name'."
     (let ((enable-recursive-minibuffers t))
       (visit-tags-table-buffer))
     (if (eq what t)
     (let ((enable-recursive-minibuffers t))
       (visit-tags-table-buffer))
     (if (eq what t)

-       (all-completions string (mapcar 'list (tags-table-files))
-                        predicate)
-      (try-completion string (mapcar 'list (tags-table-files))
-                     predicate))))
+       (all-completions string (tags-table-files) predicate)
+      (try-completion string (tags-table-files) predicate))))

 
 ;;;###autoload
 (defun list-tags (file &optional next-match)
 
 ;;;###autoload
 (defun list-tags (file &optional next-match)


@@ -1470,9 +1851,9 @@ directory specification."
                                      'tags-complete-tags-table-file
                                      nil t nil)))
   (with-output-to-temp-buffer "*Tags List*"
                                      '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))
     (save-excursion
       (let ((first-time t)
            (gotany nil))


@@ -1481,23 +1862,39 @@ directory specification."
          (if (funcall list-tags-function file)
              (setq gotany t)))
        (or gotany
          (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*"
+    (require 'apropos)
+    (with-no-warnings
+      (apropos-mode))
+    (setq buffer-read-only t)))

 
 ;;;###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*"
 
 ;;;###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)
     (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*"
+    (require 'apropos)
+    (apropos-mode)
+    ;; apropos-mode is derived from fundamental-mode and it kills
+    ;; all local variables.
+    (setq buffer-read-only t)))

 \f
 \f

-;;; XXX Kludge interface.
+;; XXX Kludge interface.
+
+(define-button-type 'tags-select-tags-table
+  'action 'select-tags-table-select
+  'help-echo "RET, t or mouse-2: select tags table")

 
 ;; XXX If a file is in multiple tables, selection may get the wrong one.
 ;;;###autoload
 
 ;; XXX If a file is in multiple tables, selection may get the wrong one.
 ;;;###autoload


@@ -1510,40 +1907,43 @@ see the doc of that variable if you want to add names to the list."
   (setq buffer-read-only nil)
   (erase-buffer)
   (let ((set-list tags-table-set-list)
   (setq buffer-read-only nil)
   (erase-buffer)
   (let ((set-list tags-table-set-list)

-       (desired-point nil))
-    (if tags-table-list
-       (progn
-         (setq desired-point (point-marker))
-         (princ tags-table-list (current-buffer))
-         (insert "\C-m")
-         (prin1 (car tags-table-list) (current-buffer)) ;invisible
-         (insert "\n")))
+       (desired-point nil)
+       b)
+    (when tags-table-list
+      (setq desired-point (point-marker))
+      (setq b (point))
+      (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer))
+      (make-text-button b (point) 'type 'tags-select-tags-table
+                        'etags-table (car tags-table-list))
+      (insert "\n"))

     (while set-list
     (while set-list

-      (if (eq (car set-list) tags-table-list)
-         ;; Already printed it.
-         ()
-       (princ (car set-list) (current-buffer))
-       (insert "\C-m")
-       (prin1 (car (car set-list)) (current-buffer)) ;invisible
+      (unless (eq (car set-list) tags-table-list)
+       (setq b (point))
+       (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer))
+       (make-text-button b (point) 'type 'tags-select-tags-table
+                          'etags-table (car (car set-list)))

        (insert "\n"))
       (setq set-list (cdr set-list)))
        (insert "\n"))
       (setq set-list (cdr set-list)))

-    (if tags-file-name
-       (progn
-         (or desired-point
-             (setq desired-point (point-marker)))
-         (insert tags-file-name "\C-m")
-         (prin1 tags-file-name (current-buffer)) ;invisible
-         (insert "\n")))
+    (when tags-file-name
+      (or desired-point
+          (setq desired-point (point-marker)))
+      (setq b (point))
+      (insert (abbreviate-file-name tags-file-name))
+      (make-text-button b (point) 'type 'tags-select-tags-table
+                        'etags-table tags-file-name)
+      (insert "\n"))

     (setq set-list (delete tags-file-name
                           (apply 'nconc (cons (copy-sequence tags-table-list)
                                               (mapcar 'copy-sequence
                                                       tags-table-set-list)))))
     (while set-list
     (setq set-list (delete tags-file-name
                           (apply 'nconc (cons (copy-sequence tags-table-list)
                                               (mapcar 'copy-sequence
                                                       tags-table-set-list)))))
     (while set-list

-      (insert (car set-list) "\C-m")
-      (prin1 (car set-list) (current-buffer)) ;invisible
+      (setq b (point))
+      (insert (abbreviate-file-name (car set-list)))
+      (make-text-button b (point) 'type 'tags-select-tags-table
+                          'etags-table (car set-list))

       (insert "\n")
       (setq set-list (delete (car set-list) set-list)))
       (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
     (insert-before-markers
      "Type `t' to select a tags table or set of tags tables:\n\n")
     (if desired-point


@@ -1552,34 +1952,28 @@ see the doc of that variable if you want to add names to the list."
   (set-buffer-modified-p nil)
   (select-tags-table-mode))
 
   (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 ()
+(defvar select-tags-table-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map button-buffer-map)
+    (define-key map "t" 'push-button)
+    (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)
+    map))
+
+(define-derived-mode select-tags-table-mode fundamental-mode "Select Tags Table"

   "Major mode for choosing a current tags table among those already loaded.
 
 \\{select-tags-table-mode-map}"
   "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")
-  (use-local-map select-tags-table-mode-map)
-  (setq selective-display t
-       selective-display-ellipses nil))
-
-(defun select-tags-table-select ()
+  (setq buffer-read-only t))
+
+(defun select-tags-table-select (button)

   "Select the tags table named on this line."
   "Select the tags table named on this line."

-  (interactive)
-  (search-forward "\C-m")
-  (let ((name (read (current-buffer))))
+  (interactive (list (or (button-at (line-beginning-position))
+                         (error "No tags table on current line"))))
+  (let ((name (button-get button 'etags-table)))

     (visit-tags-table name)
     (select-tags-table-quit)
     (message "Tags table now %s" name)))
     (visit-tags-table name)
     (select-tags-table-quit)
     (message "Tags table now %s" name)))


@@ -1587,11 +1981,9 @@ see the doc of that variable if you want to add names to the list."
 (defun select-tags-table-quit ()
   "Kill the buffer and delete the selected window."
   (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
 \f

-;;; Note, there is another definition of this function in bindings.el.
+;; Note, there is another definition of this function in bindings.el.

 ;;;###autoload
 (defun complete-tag ()
   "Perform tags completion on the text around point.
 ;;;###autoload
 (defun complete-tag ()
   "Perform tags completion on the text around point.


@@ -1604,7 +1996,10 @@ for \\[find-tag] (which see)."
       (error "%s"
             (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
+  (let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
+                                   tags-case-fold-search
+                                 case-fold-search))
+       (pattern (funcall (or find-tag-default-function

                              (get major-mode 'find-tag-default-function)
                              'find-tag-default)))
        beg
                              (get major-mode 'find-tag-default-function)
                              'find-tag-default)))
        beg


@@ -1614,7 +2009,7 @@ for \\[find-tag] (which see)."
     (search-backward pattern)
     (setq beg (point))
     (forward-char (length pattern))
     (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)
     (cond ((eq completion t))
          ((null completion)
           (message "Can't find completion for \"%s\"" pattern)


@@ -1626,9 +2021,24 @@ for \\[find-tag] (which see)."
           (message "Making completion list...")
           (with-output-to-temp-buffer "*Completions*"
             (display-completion-list
           (message "Making completion list...")
           (with-output-to-temp-buffer "*Completions*"
             (display-completion-list

-             (all-completions pattern 'tags-complete-tag nil)))
+             (all-completions pattern 'tags-complete-tag nil)
+             pattern))

           (message "Making completion list...%s" "done")))))
           (message "Making completion list...%s" "done")))))

+
+(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)
 
 \f
 (provide 'etags)
 

+;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e

 ;;; etags.el ends here
 ;;; etags.el ends here