Commit 2f68cb3e authored by Eli Zaretskii's avatar Eli Zaretskii

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.
parent 7d35b3d3
......@@ -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
......
......@@ -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)))
......
;;; etags-tests.el --- Test suite for etags.el.
;; Copyright (C) 2016 Free Software Foundation, Inc.
;; Author: Eli Zaretskii <eliz@gnu.org>
;; 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"))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment