[Emacs-diffs] master 2f68cb3: Fix bugs with buffer-local tags tables

[Eli Zaretskii]

branch: master
commit 2f68cb3e0502a9dc69613e97a5a5079ebf9249fb
Author: Eli Zaretskii <address@hidden>
Commit: Eli Zaretskii <address@hidden>

    Fix bugs with buffer-local tags tables
    
    * lisp/progmodes/etags.el (visit-tags-table): After
    'visit-tags-table-buffer' returns, retrieve the value of
    'tags-file-name' from the buffer we started in.  Force
    recomputation of 'tags-completion-table' next time it is used,
    since the list of tags table has changed.
    (visit-tags-table-buffer): Accept an additional optional argument
    CBUF, the buffer in which to start processing, and switch to that
    buffer if CBUF is non-nil.  All callers changed to supply a
    non-nil CBUF when they call 'visit-tags-table-buffer' in a loop.
    Doc fix.
    (tags-completion-table): Accept an optional argument, the buffer
    for which to build 'tags-completion-table', and build that
    buffer's completion table.
    (tags-lazy-completion-table): Pass the current buffer to
    'tags-completion-table'.
    (tags-file-name): Don't say in the doc string that setting this
    variable directly is enough; say that 'visit-tags-table' should be
    used for that.  (Bug#158)  (Bug#17326)  (Bug#23164)
    
    * doc/emacs/maintaining.texi (Select Tags Table): Delete the
    advice to set 'tags-file-name' directly.
    
    * test/lisp/progmodes/etags-tests.el: New tests.
---
 doc/emacs/maintaining.texi         |    8 +-
 lisp/progmodes/etags.el            |  152 +++++++++++++++++++++---------------
 test/lisp/progmodes/etags-tests.el |   83 ++++++++++++++++++++
 3 files changed, 176 insertions(+), 67 deletions(-)

diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 13668cc..de4fb43 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -2552,10 +2552,10 @@ directory as the default.
 @vindex tags-file-name
   Emacs does not actually read in the tags table contents until you
 try to use them; all @code{visit-tags-table} does is store the file
-name in the variable @code{tags-file-name}, and setting the variable
-yourself is just as good.  The variable's initial value is @code{nil};
-that value tells all the commands for working with tags tables that
-they must ask for a tags table file name to use.
+name in the variable @code{tags-file-name}, and not much more.  The
+variable's initial value is @code{nil}; that value tells all the
+commands for working with tags tables that they must ask for a tags
+table file name to use.
 
   Using @code{visit-tags-table} when a tags table is already loaded
 gives you a choice: you can add the new tags table to the current list
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 7d4521c..c72f061 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -33,8 +33,9 @@
 ;;;###autoload
 (defvar tags-file-name nil
   "File name of tags table.
-To switch to a new tags table, setting this variable is sufficient.
-If you set this variable, do not also set `tags-table-list'.
+To switch to a new tags table, do not set this variable; instead,
+invoke `visit-tags-table', which is the only reliable way of
+setting the value of this variable, whether buffer-local or global.
 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 (purecopy "fVisit 
tags table: "))
@@ -288,7 +289,8 @@ FILE should be the name of a file created with the `etags' 
program.
 A directory name is ok too; it means file TAGS in that directory.
 
 Normally \\[visit-tags-table] sets the global value of `tags-file-name'.
-With a prefix arg, set the buffer-local value instead.
+With a prefix arg, set the buffer-local value instead.  When called
+from Lisp, if the optional arg LOCAL is non-nil, set the local value.
 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."
@@ -304,19 +306,28 @@ file the tag was in."
   ;; Calling visit-tags-table-buffer with tags-file-name set to FILE will
   ;; initialize a buffer for FILE and set tags-file-name to the
   ;; fully-expanded name.
-  (let ((tags-file-name file))
+  (let ((tags-file-name file)
+        (cbuf (current-buffer)))
     (save-excursion
       (or (visit-tags-table-buffer file)
          (signal 'file-missing (list "Visiting tags table"
                                      "No such file or directory"
                                      file)))
-      ;; Set FILE to the expanded name.
-      (setq file tags-file-name)))
+      ;; Set FILE to the expanded name.  Do that in the buffer we
+      ;; started from, because visit-tags-table-buffer switches
+      ;; buffers after updating tags-file-name, so if tags-file-name
+      ;; is local in the buffer we started, that value is only visible
+      ;; in that buffer.
+      (setq file (with-current-buffer cbuf tags-file-name))))
   (if local
-      ;; Set the local value of tags-file-name.
-      (set (make-local-variable 'tags-file-name) file)
+      (progn
+        ;; Force recomputation of tags-completion-table.
+        (setq-local tags-completion-table nil)
+        ;; Set the local value of tags-file-name.
+        (setq-local tags-file-name file))
     ;; Set the global value of tags-file-name.
-    (setq-default tags-file-name file)))
+    (setq-default tags-file-name file)
+    (setq tags-completion-table nil)))
 
 (defun tags-table-check-computed-list ()
   "Compute `tags-table-computed-list' from `tags-table-list' if necessary."
@@ -540,17 +551,21 @@ Returns nil when out of tables."
     (setq tags-file-name (car tags-table-list-pointer))))
 
 ;;;###autoload
-(defun visit-tags-table-buffer (&optional cont)
+(defun visit-tags-table-buffer (&optional cont cbuf)
   "Select the buffer containing the current tags table.
-If optional arg is a string, visit that file as a tags table.
-If optional arg is t, visit the next table in `tags-table-list'.
-If optional arg is the atom `same', don't look for a new table;
+Optional arg CONT specifies which tags table to visit.
+If CONT is a string, visit that file as a tags table.
+If CONT is t, visit the next table in `tags-table-list'.
+If CONT is the atom `same', don't look for a new table;
  just select the buffer visiting `tags-file-name'.
-If arg is nil or absent, choose a first buffer from information in
+If CONT is nil or absent, choose a first buffer from information in
  `tags-file-name', `tags-table-list', `tags-table-list-pointer'.
+Optional second arg CBUF, if non-nil, specifies the initial buffer,
+which is important if that buffer has a local value of `tags-file-name'.
 Returns t if it visits a tags table, or nil if there are no more in the list."
 
   ;; Set tags-file-name to the tags table file we want to visit.
+  (if cbuf (set-buffer cbuf))
   (cond ((eq cont 'same)
         ;; Use the ambient value of tags-file-name.
         (or tags-file-name
@@ -752,28 +767,33 @@ Assumes the tags table is the current buffer."
   (or tags-included-tables
       (setq tags-included-tables (funcall tags-included-tables-function))))
 
-(defun tags-completion-table ()
-  "Build `tags-completion-table' on demand.
+(defun tags-completion-table (&optional buf)
+  "Build `tags-completion-table' on demand for a buffer's tags tables.
+Optional argument BUF specifies the buffer for which to build
+\`tags-completion-table', and defaults to the current buffer.
 The tags included in the completion table are those in the current
-tags table and its (recursively) included tags tables."
-  (or tags-completion-table
-      ;; No cached value for this buffer.
-      (condition-case ()
-         (let (tables cont)
-           (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 cont)
-               ;; Find possible completions in this table.
-                (push (funcall tags-completion-table-function) tables)
-                (setq cont t)))
-           (message "Making tags completion table for %s...done"
-                    buffer-file-name)
-           ;; Cache the result in a buffer-local variable.
-           (setq tags-completion-table
-                  (nreverse (delete-dups (apply #'nconc tables)))))
-       (quit (message "Tags completion table construction aborted.")
-             (setq tags-completion-table nil)))))
+tags table for BUF and its (recursively) included tags tables."
+  (if (not buf) (setq buf (current-buffer)))
+  (with-current-buffer buf
+    (or tags-completion-table
+        ;; No cached value for this buffer.
+        (condition-case ()
+            (let (tables cont)
+              (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 cont buf)
+                  ;; Find possible completions in this table.
+                  (push (funcall tags-completion-table-function) tables)
+                  (setq cont t)))
+              (message "Making tags completion table for %s...done"
+                       buffer-file-name)
+              ;; Cache the result in a variable.
+              (setq tags-completion-table
+                    (nreverse (delete-dups (apply #'nconc tables)))))
+          (quit (message "Tags completion table construction aborted.")
+                (setq tags-completion-table nil))))))
 
 ;;;###autoload
 (defun tags-lazy-completion-table ()
@@ -784,7 +804,9 @@ tags table and its (recursively) included tags tables."
           ;; If we need to ask for the tag table, allow that.
           (let ((enable-recursive-minibuffers t))
             (visit-tags-table-buffer))
-          (complete-with-action action (tags-completion-table) string 
pred))))))
+          (complete-with-action action
+                                (tags-completion-table buf)
+                                string pred))))))
 
 ;;;###autoload (defun tags-completion-at-point-function ()
 ;;;###autoload   (if (or tags-table-list tags-file-name)
@@ -1084,6 +1106,7 @@ error message."
        (case-fold-search (if (memq tags-case-fold-search '(nil t))
                              tags-case-fold-search
                            case-fold-search))
+        (cbuf (current-buffer))
        )
     (save-excursion
 
@@ -1104,8 +1127,7 @@ error message."
       (catch 'qualified-match-found
 
        ;; Iterate over the list of tags tables.
-       (while (or first-table
-                  (visit-tags-table-buffer t))
+       (while (or first-table (visit-tags-table-buffer t cbuf))
 
          (and first-search first-table
               ;; Start at beginning of tags file.
@@ -1707,25 +1729,26 @@ if the file was newly read in, the value is the 
filename."
        ((eq initialize t)
         ;; Initialize the list from the tags table.
         (save-excursion
-          ;; Visit the tags table buffer to get its list of files.
-          (visit-tags-table-buffer)
-          ;; Copy the list so we can setcdr below, and expand the file
-          ;; names while we are at it, in this buffer's default directory.
-          (setq next-file-list (mapcar 'expand-file-name (tags-table-files)))
-          ;; Iterate over all the tags table files, collecting
-          ;; a complete list of referenced file names.
-          (while (visit-tags-table-buffer t)
-            ;; Find the tail of the working list and chain on the new
-            ;; sublist for this tags table.
-            (let ((tail next-file-list))
-              (while (cdr tail)
-                (setq tail (cdr tail)))
-              ;; Use a copy so the next loop iteration will not modify the
-              ;; list later returned by (tags-table-files).
-              (if tail
-                  (setcdr tail (mapcar 'expand-file-name (tags-table-files)))
-                (setq next-file-list (mapcar 'expand-file-name
-                                             (tags-table-files))))))))
+           (let ((cbuf (current-buffer)))
+             ;; Visit the tags table buffer to get its list of files.
+             (visit-tags-table-buffer)
+             ;; Copy the list so we can setcdr below, and expand the file
+             ;; names while we are at it, in this buffer's default directory.
+             (setq next-file-list (mapcar 'expand-file-name 
(tags-table-files)))
+             ;; Iterate over all the tags table files, collecting
+             ;; a complete list of referenced file names.
+             (while (visit-tags-table-buffer t cbuf)
+               ;; Find the tail of the working list and chain on the new
+               ;; sublist for this tags table.
+               (let ((tail next-file-list))
+                 (while (cdr tail)
+                   (setq tail (cdr tail)))
+                 ;; Use a copy so the next loop iteration will not modify the
+                 ;; list later returned by (tags-table-files).
+                 (if tail
+                     (setcdr tail (mapcar 'expand-file-name 
(tags-table-files)))
+                   (setq next-file-list (mapcar 'expand-file-name
+                                                (tags-table-files)))))))))
        (t
         ;; Initialize the list by evalling the argument.
         (setq next-file-list (eval initialize))))
@@ -1921,8 +1944,9 @@ directory specification."
     (princ (substitute-command-keys "':\n\n"))
     (save-excursion
       (let ((first-time t)
-           (gotany nil))
-       (while (visit-tags-table-buffer (not first-time))
+           (gotany nil)
+            (cbuf (current-buffer)))
+       (while (visit-tags-table-buffer (not first-time) cbuf)
          (setq first-time nil)
          (if (funcall list-tags-function file)
              (setq gotany t)))
@@ -1945,8 +1969,9 @@ directory specification."
     (tags-with-face 'highlight (princ regexp))
     (princ (substitute-command-keys "':\n\n"))
     (save-excursion
-      (let ((first-time t))
-       (while (visit-tags-table-buffer (not first-time))
+      (let ((first-time t)
+            (cbuf (current-buffer)))
+       (while (visit-tags-table-buffer (not first-time) cbuf)
          (setq first-time nil)
          (funcall tags-apropos-function regexp))))
     (etags-tags-apropos-additional regexp))
@@ -2107,9 +2132,10 @@ for \\[find-tag] (which see)."
          (marks (make-hash-table :test 'equal))
          (case-fold-search (if (memq tags-case-fold-search '(nil t))
                                tags-case-fold-search
-                             case-fold-search)))
+                             case-fold-search))
+         (cbuf (current-buffer)))
     (save-excursion
-      (while (visit-tags-table-buffer (not first-time))
+      (while (visit-tags-table-buffer (not first-time) cbuf)
         (setq first-time nil)
         (dolist (order-fun (cond (regexp? find-tag-regexp-tag-order)
                                  (t etags-xref-find-definitions-tag-order)))
diff --git a/test/lisp/progmodes/etags-tests.el 
b/test/lisp/progmodes/etags-tests.el
new file mode 100644
index 0000000..a715bba
--- /dev/null
+++ b/test/lisp/progmodes/etags-tests.el
@@ -0,0 +1,83 @@
+;;; etags-tests.el --- Test suite for etags.el.
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Eli Zaretskii <address@hidden>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'etags)
+
+(defvar his-masters-voice t)
+
+(defun y-or-n-p (_prompt)
+  "Replacement for `y-or-n-p' that returns what we tell it to."
+  his-masters-voice)
+
+(ert-deftest etags-bug-158 ()
+  "Test finding tags with local and global tags tables."
+  (let ((buf-with-global-tags (get-buffer-create "*buf-global*"))
+        (buf-with-local-tags (get-buffer-create "*buf-local*"))
+        xref-buf)
+    (set-buffer buf-with-global-tags)
+    (setq default-directory (expand-file-name "."))
+    (visit-tags-table "./manual/etags/ETAGS.good_1")
+    ;; Check that tags in ETAGS.good_1 are recognized.
+    (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t"))
+    (should (bufferp xref-buf))
+    (kill-buffer xref-buf)
+    (setq xref-buf (xref-find-definitions "PrintAdd"))
+    (should (bufferp xref-buf))
+    (kill-buffer xref-buf)
+    ;; Check that tags not in ETAGS.good_1, but in ETAGS.good_3, are
+    ;; NOT recognized.
+    (should-error (xref-find-definitions "intNumber") :type 'user-error)
+    (kill-buffer xref-buf)
+    (set-buffer buf-with-local-tags)
+    (setq default-directory (expand-file-name "."))
+    (let (his-masters-voice)
+      (visit-tags-table "./manual/etags/ETAGS.good_3" t))
+    ;; Check that tags in ETAGS.good_1 are recognized.
+    (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t"))
+    (should (bufferp xref-buf))
+    (kill-buffer xref-buf)
+    (setq xref-buf (xref-find-definitions "PrintAdd"))
+    (should (bufferp xref-buf))
+    (kill-buffer xref-buf)
+    ;; Check that tags in ETAGS.good_3 are recognized.  This is a test
+    ;; for bug#158.
+    (setq xref-buf (xref-find-definitions "intNumber"))
+    (should (or (null xref-buf)
+                (bufferp xref-buf)))
+    ;; Bug #17326
+    (should (string= (file-name-nondirectory
+                      (buffer-local-value 'tags-file-name buf-with-local-tags))
+                     "ETAGS.good_3"))
+    (should (string= (file-name-nondirectory
+                      (default-value 'tags-file-name))
+                     "ETAGS.good_1"))
+    (if (bufferp xref-buf) (kill-buffer xref-buf))))
+
+(ert-deftest etags-bug-23164 ()
+  "Test that setting a local value of tags table doesn't signal errors."
+  (set-buffer (get-buffer-create "*foobar*"))
+  (fundamental-mode)
+  (visit-tags-table "./manual/etags/ETAGS.good_3" t)
+  (should (equal (should-error (xref-find-definitions "foobar123"))
+                 '(user-error "No definitions found for: foobar123"))))