*** empty log message ***
[bpt/emacs.git] / lisp / progmodes / etags.el
CommitLineData
c8472948 1;;; etags.el --- etags facility for Emacs
8c8f9bc1 2
034babe1 3;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998,
4e643dd2 4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
bf349f36 5;; Free Software Foundation, Inc.
ff1f0fa6 6
5762abec 7;; Author: Roland McGrath <roland@gnu.org>
d6b8c85b 8;; Maintainer: FSF
3a801d0c
ER
9;; Keywords: tools
10
ff1f0fa6
JB
11;; This file is part of GNU Emacs.
12
b1fc2b50 13;; GNU Emacs is free software: you can redistribute it and/or modify
ff1f0fa6 14;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
ff1f0fa6
JB
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
b1fc2b50 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
ff1f0fa6 25
6010664f
SM
26;;; Commentary:
27
e5167999
ER
28;;; Code:
29
f0d732ae
AS
30(eval-when-compile
31 (require 'cl))
b533f3c5 32(require 'ring)
89228b63 33(require 'button)
b533f3c5 34
c086701a 35;;;###autoload
b6176f64
RM
36(defvar tags-file-name nil
37 "*File name of tags table.
9708f7fc 38To switch to a new tags table, setting this variable is sufficient.
b6176f64 39If you set this variable, do not also set `tags-table-list'.
9708f7fc 40Use the `etags' program to make a tags table file.")
b6176f64 41;; Make M-x set-variable tags-file-name like M-x visit-tags-table.
9ef8b0d6 42;;;###autoload (put 'tags-file-name 'variable-interactive "fVisit tags table: ")
9708f7fc 43
99730b0e 44(defgroup etags nil "Tags tables."
99783bde
RS
45 :group 'tools)
46
ece6e35a
GM
47;;;###autoload
48(defcustom tags-case-fold-search 'default
49 "*Whether tags operations should be case-sensitive.
50A value of t means case-insensitive, a value of nil means case-sensitive.
51Any other value means use the setting of `case-fold-search'."
52 :group 'etags
53 :type '(choice (const :tag "Case-sensitive" nil)
54 (const :tag "Case-insensitive" t)
55 (other :tag "Use default" default))
56 :version "21.1")
57
9708f7fc 58;;;###autoload
b6176f64 59;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
99783bde 60(defcustom tags-table-list nil
b6176f64
RM
61 "*List of file names of tags tables to search.
62An element that is a directory means the file \"TAGS\" in that directory.
63To switch to a new list of tags tables, setting this variable is sufficient.
64If you set this variable, do not also set `tags-file-name'.
99783bde
RS
65Use the `etags' program to make a tags table file."
66 :group 'etags
67 :type '(repeat file))
9708f7fc 68
ddc76b00
FP
69;;;###autoload
70(defcustom tags-compression-info-list '("" ".Z" ".bz2" ".gz" ".tgz")
71 "*List of extensions tried by etags when jka-compr is used.
72An empty string means search the non-compressed file.
73These extensions will be tried only if jka-compr was activated
1ea98518
SM
74\(i.e. via customize of `auto-compression-mode' or by calling the function
75`auto-compression-mode')."
76 :type '(repeat string)
ddc76b00
FP
77 :group 'etags)
78
1ea98518
SM
79;; !!! tags-compression-info-list should probably be replaced by access
80;; to directory list and matching jka-compr-compression-info-list. Currently,
81;; this implementation forces each modification of
82;; jka-compr-compression-info-list to be reflected in this var.
83;; An alternative could be to say that introducing a special
84;; element in this list (e.g. t) means : try at this point
85;; using directory listing and regexp matching using
86;; jka-compr-compression-info-list.
ddc76b00
FP
87
88
33633b28 89;;;###autoload
99783bde 90(defcustom tags-add-tables 'ask-user
0c37b824
RS
91 "*Control whether to add a new tags table to the current list.
92t means do; nil means don't (always start a new list).
93Any other value means ask the user whether to add a new tags table
99783bde
RS
94to the current list (as opposed to starting a new list)."
95 :group 'etags
96 :type '(choice (const :tag "Do" t)
97 (const :tag "Don't" nil)
add3e8b3 98 (other :tag "Ask" ask-user)))
99783bde
RS
99
100(defcustom tags-revert-without-query nil
101 "*Non-nil means reread a TAGS table without querying, if it has changed."
102 :group 'etags
103 :type 'boolean)
5f8cdaf2 104
a3d358c6
RM
105(defvar tags-table-computed-list nil
106 "List of tags tables to search, computed from `tags-table-list'.
107This includes tables implicitly included by other tables. The list is not
108always complete: the included tables of a table are not known until that
6010664f 109table is read into core. An element that is t is a placeholder
a3d358c6
RM
110indicating that the preceding element is a table that has not been read
111into core and might contain included tables to search.
112See `tags-table-check-computed-list'.")
113
114(defvar tags-table-computed-list-for nil
115 "Value of `tags-table-list' that `tags-table-computed-list' corresponds to.
116If `tags-table-list' changes, `tags-table-computed-list' is thrown away and
117recomputed; see `tags-table-check-computed-list'.")
118
9708f7fc 119(defvar tags-table-list-pointer nil
a3d358c6 120 "Pointer into `tags-table-computed-list' for the current state of searching.
47f3c459
RM
121Use `visit-tags-table-buffer' to cycle through tags tables in this list.")
122
123(defvar tags-table-list-started-at nil
a3d358c6 124 "Pointer into `tags-table-computed-list', where the current search started.")
9708f7fc
RM
125
126(defvar tags-table-set-list nil
127 "List of sets of tags table which have been used together in the past.
128Each element is a list of strings which are file names.")
129
130;;;###autoload
99783bde 131(defcustom find-tag-hook nil
9708f7fc
RM
132 "*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
133The value in the buffer in which \\[find-tag] is done is used,
99783bde
RS
134not the value in the buffer \\[find-tag] goes to."
135 :group 'etags
136 :type 'hook)
9708f7fc
RM
137
138;;;###autoload
99783bde 139(defcustom find-tag-default-function nil
47f3c459
RM
140 "*A function of no arguments used by \\[find-tag] to pick a default tag.
141If nil, and the symbol that is the value of `major-mode'
9708f7fc 142has a `find-tag-default-function' property (see `put'), that is used.
99783bde
RS
143Otherwise, `find-tag-default' is used."
144 :group 'etags
d639db36 145 :type '(choice (const nil) function))
9708f7fc 146
b533f3c5
RS
147(defcustom find-tag-marker-ring-length 16
148 "*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
149 :group 'etags
cd32a7ba
DN
150 :type 'integer
151 :version "20.3")
b533f3c5 152
7e7b42b2
GM
153(defcustom tags-tag-face 'default
154 "*Face for tags in the output of `tags-apropos'."
155 :group 'etags
156 :type 'face
157 :version "21.1")
158
159(defcustom tags-apropos-verbose nil
160 "If non-nil, print the name of the tags file in the *Tags List* buffer."
161 :group 'etags
162 :type 'boolean
163 :version "21.1")
164
165(defcustom tags-apropos-additional-actions nil
166 "Specify additional actions for `tags-apropos'.
167
168If non-nil, value should be a list of triples (TITLE FUNCTION
169TO-SEARCH). For each triple, `tags-apropos' processes TO-SEARCH and
170lists tags from it. TO-SEARCH should be an alist, obarray, or symbol.
171If it is a symbol, the symbol's value is used.
6010664f 172TITLE, a string, is a title used to label the additional list of tags.
7e7b42b2
GM
173FUNCTION is a function to call when a symbol is selected in the
174*Tags List* buffer. It will be called with one argument SYMBOL which
175is the symbol being selected.
176
177Example value:
178
179 '((\"Emacs Lisp\" Info-goto-emacs-command-node obarray)
180 (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray)
181 (\"SCWM\" scwm-documentation scwm-obarray))"
182 :group 'etags
61520f26
DL
183 :type '(repeat (list (string :tag "Title")
184 function
185 (sexp :tag "Tags to search")))
7e7b42b2
GM
186 :version "21.1")
187
b533f3c5
RS
188(defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length)
189 "Ring of markers which are locations from which \\[find-tag] was invoked.")
190
9708f7fc 191(defvar default-tags-table-function nil
5f8cdaf2
RS
192 "If non-nil, a function to choose a default tags file for a buffer.
193This function receives no arguments and should return the default
194tags table file to use for the current buffer.")
d74e816f 195
b533f3c5
RS
196(defvar tags-location-ring (make-ring find-tag-marker-ring-length)
197 "Ring of markers which are locations visited by \\[find-tag].
d74e816f 198Pop back to the last location with \\[negative-argument] \\[find-tag].")
9708f7fc
RM
199\f
200;; Tags table state.
201;; These variables are local in tags table buffers.
ff1f0fa6 202
9708f7fc
RM
203(defvar tags-table-files nil
204 "List of file names covered by current tags table.
205nil means it has not yet been computed; use `tags-table-files' to do so.")
206
207(defvar tags-completion-table nil
7e7b42b2 208 "Obarray of tag names defined in current tags table.")
9708f7fc
RM
209
210(defvar tags-included-tables nil
211 "List of tags tables included by the current tags table.")
212
213(defvar next-file-list nil
214 "List of files for \\[next-file] to process.")
215\f
216;; Hooks for file formats.
217
d6b8c85b
SM
218(defvar tags-table-format-functions '(etags-recognize-tags-table
219 tags-recognize-empty-tags-table)
6010664f 220 "Hook to be called in a tags table buffer to identify the type of tags table.
b533f3c5 221The functions are called in order, with no arguments,
9708f7fc
RM
222until one returns non-nil. The function should make buffer-local bindings
223of the format-parsing tags function variables if successful.")
224
225(defvar file-of-tag-function nil
79e01623
JB
226 "Function to do the work of `file-of-tag' (which see).
227One optional argument, a boolean specifying to return complete path (nil) or
228relative path (non-nil).")
9708f7fc
RM
229(defvar tags-table-files-function nil
230 "Function to do the work of `tags-table-files' (which see).")
231(defvar tags-completion-table-function nil
6010664f 232 "Function to build the `tags-completion-table'.")
9708f7fc 233(defvar snarf-tag-function nil
79e01623
JB
234 "Function to get info about a matched tag for `goto-tag-location-function'.
235One optional argument, specifying to use explicit tag (non-nil) or not (nil).
236The default is nil.")
9708f7fc
RM
237(defvar goto-tag-location-function nil
238 "Function of to go to the location in the buffer specified by a tag.
239One argument, the tag info returned by `snarf-tag-function'.")
240(defvar find-tag-regexp-search-function nil
241 "Search function passed to `find-tag-in-order' for finding a regexp tag.")
242(defvar find-tag-regexp-tag-order nil
243 "Tag order passed to `find-tag-in-order' for finding a regexp tag.")
244(defvar find-tag-regexp-next-line-after-failure-p nil
245 "Flag passed to `find-tag-in-order' for finding a regexp tag.")
246(defvar find-tag-search-function nil
247 "Search function passed to `find-tag-in-order' for finding a tag.")
248(defvar find-tag-tag-order nil
249 "Tag order passed to `find-tag-in-order' for finding a tag.")
250(defvar find-tag-next-line-after-failure-p nil
251 "Flag passed to `find-tag-in-order' for finding a tag.")
252(defvar list-tags-function nil
253 "Function to do the work of `list-tags' (which see).")
254(defvar tags-apropos-function nil
255 "Function to do the work of `tags-apropos' (which see).")
256(defvar tags-included-tables-function nil
257 "Function to do the work of `tags-included-tables' (which see).")
258(defvar verify-tags-table-function nil
e7f767c2 259 "Function to return t if current buffer contains valid tags file.")
9708f7fc
RM
260\f
261(defun initialize-new-tags-table ()
cba9bdd2
RS
262 "Initialize the tags table in the current buffer.
263Return non-nil if it is a valid tags table, and
264in that case, also make the tags table state variables
265buffer-local and set them to nil."
b6176f64
RM
266 (set (make-local-variable 'tags-table-files) nil)
267 (set (make-local-variable 'tags-completion-table) nil)
268 (set (make-local-variable 'tags-included-tables) nil)
931f525c
RS
269 ;; We used to initialize find-tag-marker-ring and tags-location-ring
270 ;; here, to new empty rings. But that is wrong, because those
271 ;; are global.
272
9708f7fc 273 ;; Value is t if we have found a valid tags table buffer.
d6b8c85b 274 (run-hook-with-args-until-success 'tags-table-format-functions))
ff1f0fa6 275
0f518b6b
JL
276;;;###autoload
277(defun tags-table-mode ()
278 "Major mode for tags table file buffers."
279 (interactive)
5ec19a11
GM
280 (setq major-mode 'tags-table-mode
281 mode-name "Tags Table"
8e004a44 282 buffer-undo-list t)
0f518b6b
JL
283 (initialize-new-tags-table))
284
c086701a 285;;;###autoload
9708f7fc
RM
286(defun visit-tags-table (file &optional local)
287 "Tell tags commands to use tags table file FILE.
ff1f0fa6 288FILE should be the name of a file created with the `etags' program.
9708f7fc
RM
289A directory name is ok too; it means file TAGS in that directory.
290
291Normally \\[visit-tags-table] sets the global value of `tags-file-name'.
292With a prefix arg, set the buffer-local value instead.
293When you find a tag with \\[find-tag], the buffer it finds the tag
294in is given a local value of this variable which is the name of the tags
295file the tag was in."
5b76833f 296 (interactive (list (read-file-name "Visit tags table (default TAGS): "
ff1f0fa6 297 default-directory
9708f7fc
RM
298 (expand-file-name "TAGS"
299 default-directory)
300 t)
301 current-prefix-arg))
aab936ad
RM
302 (or (stringp file) (signal 'wrong-type-argument (list 'stringp file)))
303 ;; Bind tags-file-name so we can control below whether the local or
304 ;; global value gets set. Calling visit-tags-table-buffer will
305 ;; initialize a buffer for the file and set tags-file-name to the
5e882a6a
RS
306 ;; Calling visit-tags-table-buffer with tags-file-name set to FILE will
307 ;; initialize a buffer for FILE and set tags-file-name to the
b6176f64 308 ;; fully-expanded name.
9806213d
RM
309 (let ((tags-file-name file))
310 (save-excursion
aab936ad 311 (or (visit-tags-table-buffer file)
9806213d
RM
312 (signal 'file-error (list "Visiting tags table"
313 "file does not exist"
314 file)))
b6176f64 315 ;; Set FILE to the expanded name.
9806213d 316 (setq file tags-file-name)))
9708f7fc 317 (if local
b6176f64 318 ;; Set the local value of tags-file-name.
47f3c459 319 (set (make-local-variable 'tags-file-name) file)
b6176f64 320 ;; Set the global value of tags-file-name.
9806213d
RM
321 (setq-default tags-file-name file)))
322
a3d358c6
RM
323(defun tags-table-check-computed-list ()
324 "Compute `tags-table-computed-list' from `tags-table-list' if necessary."
325 (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list)))
326 (or (equal tags-table-computed-list-for expanded-list)
327 ;; The list (or default-directory) has changed since last computed.
328 (let* ((compute-for (mapcar 'copy-sequence expanded-list))
329 (tables (copy-sequence compute-for)) ;Mutated in the loop.
330 (computed nil)
331 table-buffer)
332
333 (while tables
334 (setq computed (cons (car tables) computed)
335 table-buffer (get-file-buffer (car tables)))
83287e5b 336 (if (and table-buffer
c49a777a
RM
337 ;; There is a buffer visiting the file. Now make sure
338 ;; it is initialized as a tag table buffer.
339 (save-excursion
340 (tags-verify-table (buffer-file-name table-buffer))))
a3d358c6
RM
341 (save-excursion
342 (set-buffer table-buffer)
343 (if (tags-included-tables)
344 ;; Insert the included tables into the list we
345 ;; are processing.
b1c7e434
RM
346 (setcdr tables (nconc (mapcar 'tags-expand-table-name
347 (tags-included-tables))
348 (cdr tables)))))
a3d358c6
RM
349 ;; This table is not in core yet. Insert a placeholder
350 ;; saying we must read it into core to check for included
351 ;; tables before searching the next table in the list.
352 (setq computed (cons t computed)))
353 (setq tables (cdr tables)))
354
355 ;; Record the tags-table-list value (and the context of the
356 ;; current directory) we computed from.
357 (setq tags-table-computed-list-for compute-for
358 tags-table-computed-list (nreverse computed))))))
359
a3d358c6 360(defun tags-table-extend-computed-list ()
cba9bdd2
RS
361 "Extend `tags-table-computed-list' to remove the first t placeholder.
362
363An element of the list that is t is a placeholder indicating that the
364preceding element is a table that has not been read in and might
365contain included tables to search. This function reads in the first
366such table and puts its included tables into the list."
a3d358c6
RM
367 (let ((list tags-table-computed-list))
368 (while (not (eq (nth 1 list) t))
369 (setq list (cdr list)))
370 (save-excursion
371 (if (tags-verify-table (car list))
372 ;; We are now in the buffer visiting (car LIST). Extract its
373 ;; list of included tables and insert it into the computed list.
374 (let ((tables (tags-included-tables))
375 (computed nil)
376 table-buffer)
377 (while tables
378 (setq computed (cons (car tables) computed)
379 table-buffer (get-file-buffer (car tables)))
380 (if table-buffer
381 (save-excursion
382 (set-buffer table-buffer)
383 (if (tags-included-tables)
384 ;; Insert the included tables into the list we
385 ;; are processing.
386 (setcdr tables (append (tags-included-tables)
387 tables))))
388 ;; This table is not in core yet. Insert a placeholder
389 ;; saying we must read it into core to check for included
390 ;; tables before searching the next table in the list.
e99045bb
RM
391 (setq computed (cons t computed)))
392 (setq tables (cdr tables)))
a3d358c6
RM
393 (setq computed (nreverse computed))
394 ;; COMPUTED now contains the list of included tables (and
395 ;; tables included by them, etc.). Now splice this into the
396 ;; current list.
397 (setcdr list (nconc computed (cdr (cdr list)))))
398 ;; It was not a valid table, so just remove the following placeholder.
399 (setcdr list (cdr (cdr list)))))))
b6176f64 400
47f3c459 401(defun tags-expand-table-name (file)
cba9bdd2 402 "Expand tags table name FILE into a complete file name."
47f3c459
RM
403 (setq file (expand-file-name file))
404 (if (file-directory-p file)
405 (expand-file-name "TAGS" file)
406 file))
407
a3d358c6
RM
408;; Like member, but comparison is done after tags-expand-table-name on both
409;; sides and elements of LIST that are t are skipped.
410(defun tags-table-list-member (file list)
cba9bdd2
RS
411 "Like (member FILE LIST) after applying `tags-expand-table-name'.
412More precisely, apply `tags-expand-table-name' to FILE
413and each element of LIST, returning the link whose car is the first match.
414If an element of LIST is t, ignore it."
47f3c459 415 (setq file (tags-expand-table-name file))
a3d358c6
RM
416 (while (and list
417 (or (eq (car list) t)
418 (not (string= file (tags-expand-table-name (car list))))))
419 (setq list (cdr list)))
47f3c459
RM
420 list)
421
a3d358c6
RM
422(defun tags-verify-table (file)
423 "Read FILE into a buffer and verify that it is a valid tags table.
424Sets the current buffer to one visiting FILE (if it exists).
e7f767c2 425Returns non-nil if it is a valid table."
a3d358c6
RM
426 (if (get-file-buffer file)
427 ;; The file is already in a buffer. Check for the visited file
428 ;; having changed since we last used it.
429 (let (win)
430 (set-buffer (get-file-buffer file))
0f518b6b 431 (setq win (or verify-tags-table-function (tags-table-mode)))
a3d358c6 432 (if (or (verify-visited-file-modtime (current-buffer))
350ce4cf
RS
433 ;; Decide whether to revert the file.
434 ;; revert-without-query can say to revert
435 ;; or the user can say to revert.
436 (not (or (let ((tail revert-without-query)
437 (found nil))
438 (while tail
439 (if (string-match (car tail) buffer-file-name)
440 (setq found t))
441 (setq tail (cdr tail)))
442 found)
99783bde 443 tags-revert-without-query
350ce4cf
RS
444 (yes-or-no-p
445 (format "Tags file %s has changed, read new contents? "
446 file)))))
447 (and verify-tags-table-function
448 (funcall verify-tags-table-function))
a3d358c6 449 (revert-buffer t t)
0f518b6b 450 (tags-table-mode)))
a3d358c6
RM
451 (and (file-exists-p file)
452 (progn
453 (set-buffer (find-file-noselect file))
454 (or (string= file buffer-file-name)
455 ;; find-file-noselect has changed the file name.
456 ;; Propagate the change to tags-file-name and tags-table-list.
457 (let ((tail (member file tags-table-list)))
458 (if tail
459 (setcar tail buffer-file-name))
460 (if (eq file tags-file-name)
461 (setq tags-file-name buffer-file-name))))
0f518b6b 462 (tags-table-mode)))))
a3d358c6
RM
463
464;; Subroutine of visit-tags-table-buffer. Search the current tags tables
465;; for one that has tags for THIS-FILE (or that includes a table that
c3dea9ba
RM
466;; does). Return the name of the first table table listing THIS-FILE; if
467;; the table is one included by another table, it is the master table that
468;; we return. If CORE-ONLY is non-nil, check only tags tables that are
469;; already in buffers--don't visit any new files.
a3d358c6 470(defun tags-table-including (this-file core-only)
cba9bdd2
RS
471 "Search current tags tables for tags for THIS-FILE.
472Subroutine of `visit-tags-table-buffer'.
473Looks for a tags table that has such tags or that includes a table
474that has them. Returns the name of the first such table.
475Non-nil CORE-ONLY means check only tags tables that are already in
476buffers. Nil CORE-ONLY is ignored."
a3d358c6 477 (let ((tables tags-table-computed-list)
f06df563 478 (found nil))
a3d358c6 479 ;; Loop over the list, looking for a table containing tags for THIS-FILE.
47f3c459
RM
480 (while (and (not found)
481 tables)
9d591df8
RM
482
483 (if core-only
484 ;; Skip tables not in core.
485 (while (eq (nth 1 tables) t)
486 (setq tables (cdr (cdr tables))))
487 (if (eq (nth 1 tables) t)
488 ;; This table has not been read into core yet. Read it in now.
489 (tags-table-extend-computed-list)))
a3d358c6 490
3cc3f703
RM
491 (if tables
492 ;; Select the tags table buffer and get the file list up to date.
493 (let ((tags-file-name (car tables)))
494 (visit-tags-table-buffer 'same)
83287e5b
RM
495 (if (member this-file (mapcar 'expand-file-name
496 (tags-table-files)))
3cc3f703
RM
497 ;; Found it.
498 (setq found tables))))
47f3c459 499 (setq tables (cdr tables)))
3cc3f703
RM
500 (if found
501 ;; Now determine if the table we found was one included by another
82f75cca
RM
502 ;; table, not explicitly listed. We do this by checking each
503 ;; element of the computed list to see if it appears in the user's
504 ;; explicit list; the last element we will check is FOUND itself.
505 ;; Then we return the last one which did in fact appear in
506 ;; tags-table-list.
3cc3f703
RM
507 (let ((could-be nil)
508 (elt tags-table-computed-list))
509 (while (not (eq elt (cdr found)))
510 (if (tags-table-list-member (car elt) tags-table-list)
511 ;; This table appears in the user's list, so it could be
512 ;; the one which includes the table we found.
82f75cca
RM
513 (setq could-be (car elt)))
514 (setq elt (cdr elt))
515 (if (eq t (car elt))
516 (setq elt (cdr elt))))
ec623f1b
RM
517 ;; The last element we found in the computed list before FOUND
518 ;; that appears in the user's list will be the table that
83287e5b 519 ;; included the one we found.
82f75cca 520 could-be))))
9708f7fc 521
a3d358c6 522(defun tags-next-table ()
cba9bdd2
RS
523 "Move `tags-table-list-pointer' along and set `tags-file-name'.
524Subroutine of `visit-tags-table-buffer'.\
525Returns nil when out of tables."
a3d358c6
RM
526 ;; If there is a placeholder element next, compute the list to replace it.
527 (while (eq (nth 1 tags-table-list-pointer) t)
528 (tags-table-extend-computed-list))
529
530 ;; Go to the next table in the list.
531 (setq tags-table-list-pointer (cdr tags-table-list-pointer))
532 (or tags-table-list-pointer
533 ;; Wrap around.
534 (setq tags-table-list-pointer tags-table-computed-list))
535
536 (if (eq tags-table-list-pointer tags-table-list-started-at)
537 ;; We have come full circle. No more tables.
538 (setq tags-table-list-pointer nil)
539 ;; Set tags-file-name to the name from the list. It is already expanded.
540 (setq tags-file-name (car tags-table-list-pointer))))
541
97534f32 542;;;###autoload
9708f7fc
RM
543(defun visit-tags-table-buffer (&optional cont)
544 "Select the buffer containing the current tags table.
aab936ad 545If optional arg is a string, visit that file as a tags table.
9708f7fc 546If optional arg is t, visit the next table in `tags-table-list'.
9708f7fc 547If optional arg is the atom `same', don't look for a new table;
b6176f64 548 just select the buffer visiting `tags-file-name'.
47f3c459 549If arg is nil or absent, choose a first buffer from information in
b6176f64 550 `tags-file-name', `tags-table-list', `tags-table-list-pointer'.
9708f7fc 551Returns t if it visits a tags table, or nil if there are no more in the list."
b6176f64
RM
552
553 ;; Set tags-file-name to the tags table file we want to visit.
a3d358c6
RM
554 (cond ((eq cont 'same)
555 ;; Use the ambient value of tags-file-name.
556 (or tags-file-name
b0b3cce2
KH
557 (error "%s"
558 (substitute-command-keys
4fa15f59
RS
559 (concat "No tags table in use; "
560 "use \\[visit-tags-table] to select one")))))
a3d358c6
RM
561
562 ((eq t cont)
563 ;; Find the next table.
564 (if (tags-next-table)
565 ;; Skip over nonexistent files.
566 (while (and (not (or (get-file-buffer tags-file-name)
567 (file-exists-p tags-file-name)))
568 (tags-next-table)))))
569
570 (t
571 ;; Pick a table out of our hat.
572 (tags-table-check-computed-list) ;Get it up to date, we might use it.
573 (setq tags-file-name
574 (or
575 ;; If passed a string, use that.
576 (if (stringp cont)
577 (prog1 cont
578 (setq cont nil)))
579 ;; First, try a local variable.
580 (cdr (assq 'tags-file-name (buffer-local-variables)))
581 ;; Second, try a user-specified function to guess.
582 (and default-tags-table-function
583 (funcall default-tags-table-function))
584 ;; Third, look for a tags table that contains tags for the
585 ;; current buffer's file. If one is found, the lists will
586 ;; be frobnicated, and CONT will be set non-nil so we don't
587 ;; do it below.
588 (and buffer-file-name
83287e5b 589 (or
c3dea9ba
RM
590 ;; First check only tables already in buffers.
591 (tags-table-including buffer-file-name t)
592 ;; Since that didn't find any, now do the
593 ;; expensive version: reading new files.
594 (tags-table-including buffer-file-name nil)))
a3d358c6
RM
595 ;; Fourth, use the user variable tags-file-name, if it is
596 ;; not already in the current list.
597 (and tags-file-name
598 (not (tags-table-list-member tags-file-name
599 tags-table-computed-list))
600 tags-file-name)
601 ;; Fifth, use the user variable giving the table list.
602 ;; Find the first element of the list that actually exists.
603 (let ((list tags-table-list)
604 file)
605 (while (and list
606 (setq file (tags-expand-table-name (car list)))
607 (not (get-file-buffer file))
608 (not (file-exists-p file)))
609 (setq list (cdr list)))
610 (car list))
611 ;; Finally, prompt the user for a file name.
612 (expand-file-name
5b76833f 613 (read-file-name "Visit tags table (default TAGS): "
a3d358c6
RM
614 default-directory
615 "TAGS"
616 t))))))
617
618 ;; Expand the table name into a full file name.
619 (setq tags-file-name (tags-expand-table-name tags-file-name))
620
7e7b42b2 621 (unless (and (eq cont t) (null tags-table-list-pointer))
a3d358c6 622 ;; Verify that tags-file-name names a valid tags table.
229b7986
RM
623 ;; Bind another variable with the value of tags-file-name
624 ;; before we switch buffers, in case tags-file-name is buffer-local.
625 (let ((curbuf (current-buffer))
626 (local-tags-file-name tags-file-name))
627 (if (tags-verify-table local-tags-file-name)
628
629 ;; We have a valid tags table.
630 (progn
631 ;; Bury the tags table buffer so it
632 ;; doesn't get in the user's way.
633 (bury-buffer (current-buffer))
634
635 ;; If this was a new table selection (CONT is nil), make
636 ;; sure tags-table-list includes the chosen table, and
637 ;; update the list pointer variables.
638 (or cont
639 ;; Look in the list for the table we chose.
640 (let ((found (tags-table-list-member
641 local-tags-file-name
642 tags-table-computed-list)))
643 (if found
644 ;; There it is. Just switch to it.
645 (setq tags-table-list-pointer found
646 tags-table-list-started-at found)
647
648 ;; The table is not in the current set.
649 ;; Try to find it in another previously used set.
650 (let ((sets tags-table-set-list))
651 (while (and sets
652 (not (tags-table-list-member
653 local-tags-file-name
654 (car sets))))
655 (setq sets (cdr sets)))
656 (if sets
657 ;; Found in some other set. Switch to that set.
658 (progn
659 (or (memq tags-table-list tags-table-set-list)
660 ;; Save the current list.
661 (setq tags-table-set-list
662 (cons tags-table-list
663 tags-table-set-list)))
664 (setq tags-table-list (car sets)))
665
666 ;; Not found in any existing set.
667 (if (and tags-table-list
668 (or (eq t tags-add-tables)
669 (and tags-add-tables
670 (y-or-n-p
671 (concat "Keep current list of "
672 "tags tables also? ")))))
673 ;; Add it to the current list.
674 (setq tags-table-list (cons local-tags-file-name
675 tags-table-list))
676
677 ;; Make a fresh list, and store the old one.
678 (message "Starting a new list of tags tables")
679 (or (null tags-table-list)
680 (memq tags-table-list tags-table-set-list)
f06df563
RM
681 (setq tags-table-set-list
682 (cons tags-table-list
683 tags-table-set-list)))
dd2cedb9
DL
684 ;; Clear out buffers holding old tables.
685 (dolist (table tags-table-list)
cba9bdd2 686 ;; The list can contain items t.
84d51f9b
DL
687 (if (stringp table)
688 (let ((buffer (find-buffer-visiting table)))
dd2cedb9 689 (if buffer
84d51f9b 690 (kill-buffer buffer)))))
229b7986
RM
691 (setq tags-table-list (list local-tags-file-name))))
692
693 ;; Recompute tags-table-computed-list.
694 (tags-table-check-computed-list)
695 ;; Set the tags table list state variables to start
696 ;; over from tags-table-computed-list.
697 (setq tags-table-list-started-at tags-table-computed-list
698 tags-table-list-pointer
699 tags-table-computed-list)))))
700
701 ;; Return of t says the tags table is valid.
702 t)
703
704 ;; The buffer was not valid. Don't use it again.
705 (set-buffer curbuf)
a3d358c6 706 (kill-local-variable 'tags-file-name)
229b7986 707 (if (eq local-tags-file-name tags-file-name)
e98cc0af 708 (setq tags-file-name nil))
229b7986 709 (error "File %s is not a valid tags table" local-tags-file-name)))))
c6987f0b
RM
710
711(defun tags-reset-tags-tables ()
b533f3c5 712 "Reset tags state to cancel effect of any previous \\[visit-tags-table] or \\[find-tag]."
c6987f0b 713 (interactive)
466886a2
KH
714 ;; Clear out the markers we are throwing away.
715 (let ((i 0))
716 (while (< i find-tag-marker-ring-length)
717 (if (aref (cddr tags-location-ring) i)
718 (set-marker (aref (cddr tags-location-ring) i) nil))
719 (if (aref (cddr find-tag-marker-ring) i)
720 (set-marker (aref (cddr find-tag-marker-ring) i) nil))
721 (setq i (1+ i))))
c6987f0b 722 (setq tags-file-name nil
466886a2
KH
723 tags-location-ring (make-ring find-tag-marker-ring-length)
724 find-tag-marker-ring (make-ring find-tag-marker-ring-length)
c6987f0b
RM
725 tags-table-list nil
726 tags-table-computed-list nil
727 tags-table-computed-list-for nil
728 tags-table-list-pointer nil
729 tags-table-list-started-at nil
730 tags-table-set-list nil))
a128c7a0 731\f
79e01623 732(defun file-of-tag (&optional relative)
ff1f0fa6 733 "Return the file name of the file whose tags point is within.
9708f7fc 734Assumes the tags table is the current buffer.
79e01623
JB
735If RELATIVE is non-nil, file name returned is relative to tags
736table file's directory. If RELATIVE is nil, file name returned
737is complete."
738 (funcall file-of-tag-function relative))
ff1f0fa6 739
c086701a 740;;;###autoload
9708f7fc
RM
741(defun tags-table-files ()
742 "Return a list of files in the current tags table.
83287e5b
RM
743Assumes the tags table is the current buffer. The file names are returned
744as they appeared in the `etags' command that created the table, usually
745without directory names."
a128c7a0
RM
746 (or tags-table-files
747 (setq tags-table-files
748 (funcall tags-table-files-function))))
9708f7fc
RM
749
750(defun tags-included-tables ()
b6176f64
RM
751 "Return a list of tags tables included by the current table.
752Assumes the tags table is the current buffer."
9708f7fc
RM
753 (or tags-included-tables
754 (setq tags-included-tables (funcall tags-included-tables-function))))
755\f
9708f7fc 756(defun tags-completion-table ()
cba9bdd2
RS
757 "Build `tags-completion-table' on demand.
758The tags included in the completion table are those in the current
759tags table and its (recursively) included tags tables."
9708f7fc 760 (or tags-completion-table
f37de644 761 ;; No cached value for this buffer.
9708f7fc 762 (condition-case ()
f37de644
FP
763 (let (current-table combined-table)
764 (message "Making tags completion table for %s..." buffer-file-name)
765 (save-excursion
766 ;; Iterate over the current list of tags tables.
767 (while (visit-tags-table-buffer (and combined-table t))
768 ;; Find possible completions in this table.
769 (setq current-table (funcall tags-completion-table-function))
770 ;; Merge this buffer's completions into the combined table.
771 (if combined-table
772 (mapatoms
773 (lambda (sym) (intern (symbol-name sym) combined-table))
774 current-table)
775 (setq combined-table current-table))))
776 (message "Making tags completion table for %s...done"
777 buffer-file-name)
f0d732ae 778 ;; Cache the result in a buffer-local variable.
f37de644 779 (setq tags-completion-table combined-table))
9708f7fc
RM
780 (quit (message "Tags completion table construction aborted.")
781 (setq tags-completion-table nil)))))
782
b5507bc1
SM
783(defun tags-lazy-completion-table ()
784 (lexical-let ((buf (current-buffer)))
785 (lambda (string pred action)
786 (with-current-buffer buf
787 (save-excursion
788 ;; If we need to ask for the tag table, allow that.
789 (let ((enable-recursive-minibuffers t))
790 (visit-tags-table-buffer))
791 (complete-with-action action (tags-completion-table) string pred))))))
a128c7a0 792\f
ff1f0fa6 793(defun find-tag-tag (string)
cba9bdd2 794 "Read a tag name, with defaulting and completion."
8a294d90
FP
795 (let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
796 tags-case-fold-search
797 case-fold-search))
798 (default (funcall (or find-tag-default-function
9708f7fc
RM
799 (get major-mode 'find-tag-default-function)
800 'find-tag-default)))
801 (spec (completing-read (if default
ebc6b37c
SM
802 (format "%s (default %s): "
803 (substring string 0 (string-match "[ :]+\\'" string))
804 default)
9708f7fc 805 string)
b5507bc1 806 (tags-lazy-completion-table)
ab685b6b 807 nil nil nil nil default)))
b6176f64
RM
808 (if (equal spec "")
809 (or default (error "There is no default tag"))
810 spec)))
ff1f0fa6 811
21800cb8
RM
812(defvar last-tag nil
813 "Last tag found by \\[find-tag].")
814
d74e816f 815(defun find-tag-interactive (prompt &optional no-default)
cba9bdd2
RS
816 "Get interactive arguments for tag functions.
817The functions using this are `find-tag-noselect',
818`find-tag-other-window', and `find-tag-regexp'."
926861fb 819 (if (and current-prefix-arg last-tag)
d74e816f
RM
820 (list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
821 '-
822 t))
823 (list (if no-default
824 (read-string prompt)
825 (find-tag-tag prompt)))))
826
cba9bdd2 827(defvar find-tag-history nil) ; Doc string?
c5507689 828
dd2cedb9
DL
829;; Dynamic bondage:
830(eval-when-compile
831 (defvar etags-case-fold-search)
832 (defvar etags-syntax-table))
833
c086701a 834;;;###autoload
9708f7fc
RM
835(defun find-tag-noselect (tagname &optional next-p regexp-p)
836 "Find tag (in current tags table) whose name contains TAGNAME.
f90a6155 837Returns the buffer containing the tag's definition and moves its point there,
9708f7fc
RM
838but does not select the buffer.
839The default for TAGNAME is the expression in the buffer near point.
840
d74e816f
RM
841If second arg NEXT-P is t (interactively, with prefix arg), search for
842another tag that matches the last tagname or regexp used. When there are
843multiple matches for a tag, more exact matches are found first. If NEXT-P
844is the atom `-' (interactively, with prefix arg that is a negative number
845or just \\[negative-argument]), pop back to the previous tag gone to.
ff1f0fa6 846
9708f7fc
RM
847If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
848
a70ea557 849A marker representing the point when this command is invoked is pushed
b533f3c5
RS
850onto a ring and may be popped back to with \\[pop-tag-mark].
851Contrast this with the ring of marks gone to by the command.
852
9708f7fc 853See documentation of variable `tags-file-name'."
d74e816f
RM
854 (interactive (find-tag-interactive "Find tag: "))
855
c5507689 856 (setq find-tag-history (cons tagname find-tag-history))
e1cf67b6
GM
857 ;; Save the current buffer's value of `find-tag-hook' before
858 ;; selecting the tags table buffer. For the same reason, save value
859 ;; of `tags-file-name' in case it has a buffer-local value.
dc0274bd 860 (let ((local-find-tag-hook find-tag-hook))
d74e816f
RM
861 (if (eq '- next-p)
862 ;; Pop back to a previous location.
b533f3c5 863 (if (ring-empty-p tags-location-ring)
d74e816f 864 (error "No previous tag locations")
b533f3c5 865 (let ((marker (ring-remove tags-location-ring 0)))
d74e816f
RM
866 (prog1
867 ;; Move to the saved location.
b533f3c5
RS
868 (set-buffer (or (marker-buffer marker)
869 (error "The marked buffer has been deleted")))
d74e816f 870 (goto-char (marker-position marker))
eb8c3be9 871 ;; Kill that marker so it doesn't slow down editing.
d74e816f
RM
872 (set-marker marker nil nil)
873 ;; Run the user's hook. Do we really want to do this for pop?
874 (run-hooks 'local-find-tag-hook))))
b533f3c5
RS
875 ;; Record whence we came.
876 (ring-insert find-tag-marker-ring (point-marker))
926861fb 877 (if (and next-p last-tag)
d74e816f
RM
878 ;; Find the same table we last used.
879 (visit-tags-table-buffer 'same)
880 ;; Pick a table to use.
881 (visit-tags-table-buffer)
882 ;; Record TAGNAME for a future call with NEXT-P non-nil.
883 (setq last-tag tagname))
4cc32db6
RS
884 ;; Record the location so we can pop back to it later.
885 (let ((marker (make-marker)))
886 (save-excursion
887 (set-buffer
888 ;; find-tag-in-order does the real work.
889 (find-tag-in-order
926861fb 890 (if (and next-p last-tag) last-tag tagname)
4cc32db6
RS
891 (if regexp-p
892 find-tag-regexp-search-function
893 find-tag-search-function)
894 (if regexp-p
895 find-tag-regexp-tag-order
83287e5b 896 find-tag-tag-order)
4cc32db6
RS
897 (if regexp-p
898 find-tag-regexp-next-line-after-failure-p
899 find-tag-next-line-after-failure-p)
900 (if regexp-p "matching" "containing")
926861fb 901 (or (not next-p) (not last-tag))))
4cc32db6
RS
902 (set-marker marker (point))
903 (run-hooks 'local-find-tag-hook)
b533f3c5 904 (ring-insert tags-location-ring marker)
4cc32db6 905 (current-buffer))))))
ff1f0fa6 906
c086701a 907;;;###autoload
d74e816f 908(defun find-tag (tagname &optional next-p regexp-p)
9708f7fc
RM
909 "Find tag (in current tags table) whose name contains TAGNAME.
910Select the buffer containing the tag's definition, and move point there.
911The default for TAGNAME is the expression in the buffer around or before point.
c086701a 912
d74e816f
RM
913If second arg NEXT-P is t (interactively, with prefix arg), search for
914another tag that matches the last tagname or regexp used. When there are
915multiple matches for a tag, more exact matches are found first. If NEXT-P
916is the atom `-' (interactively, with prefix arg that is a negative number
917or just \\[negative-argument]), pop back to the previous tag gone to.
ff1f0fa6 918
b533f3c5
RS
919If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
920
a70ea557 921A marker representing the point when this command is invoked is pushed
b533f3c5
RS
922onto a ring and may be popped back to with \\[pop-tag-mark].
923Contrast this with the ring of marks gone to by the command.
924
9708f7fc 925See documentation of variable `tags-file-name'."
d74e816f 926 (interactive (find-tag-interactive "Find tag: "))
ebc6b37c
SM
927 (let* ((buf (find-tag-noselect tagname next-p regexp-p))
928 (pos (with-current-buffer buf (point))))
6010664f
SM
929 (condition-case nil
930 (switch-to-buffer buf)
ebc6b37c
SM
931 (error (pop-to-buffer buf)))
932 (goto-char pos)))
9708f7fc 933;;;###autoload (define-key esc-map "." 'find-tag)
ff1f0fa6 934
daa37602 935;;;###autoload
d74e816f 936(defun find-tag-other-window (tagname &optional next-p regexp-p)
9708f7fc 937 "Find tag (in current tags table) whose name contains TAGNAME.
d74e816f
RM
938Select the buffer containing the tag's definition in another window, and
939move point there. The default for TAGNAME is the expression in the buffer
940around or before point.
9708f7fc 941
d74e816f
RM
942If second arg NEXT-P is t (interactively, with prefix arg), search for
943another tag that matches the last tagname or regexp used. When there are
944multiple matches for a tag, more exact matches are found first. If NEXT-P
945is negative (interactively, with prefix arg that is a negative number or
946just \\[negative-argument]), pop back to the previous tag gone to.
9708f7fc 947
b533f3c5
RS
948If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
949
a70ea557 950A marker representing the point when this command is invoked is pushed
b533f3c5
RS
951onto a ring and may be popped back to with \\[pop-tag-mark].
952Contrast this with the ring of marks gone to by the command.
953
9708f7fc 954See documentation of variable `tags-file-name'."
d74e816f
RM
955 (interactive (find-tag-interactive "Find tag other window: "))
956
b6176f64
RM
957 ;; This hair is to deal with the case where the tag is found in the
958 ;; selected window's buffer; without the hair, point is moved in both
959 ;; windows. To prevent this, we save the selected window's point before
960 ;; doing find-tag-noselect, and restore it after.
961 (let* ((window-point (window-point (selected-window)))
d74e816f 962 (tagbuf (find-tag-noselect tagname next-p regexp-p))
49693298 963 (tagpoint (progn (set-buffer tagbuf) (point))))
b6176f64
RM
964 (set-window-point (prog1
965 (selected-window)
49693298
JB
966 (switch-to-buffer-other-window tagbuf)
967 ;; We have to set this new window's point; it
968 ;; might already have been displaying a
969 ;; different portion of tagbuf, in which case
970 ;; switch-to-buffer-other-window doesn't set
971 ;; the window's point from the buffer.
972 (set-window-point (selected-window) tagpoint))
b6176f64 973 window-point)))
9708f7fc
RM
974;;;###autoload (define-key ctl-x-4-map "." 'find-tag-other-window)
975
29add8b9 976;;;###autoload
9708f7fc 977(defun find-tag-other-frame (tagname &optional next-p)
d74e816f
RM
978 "Find tag (in current tags table) whose name contains TAGNAME.
979Select the buffer containing the tag's definition in another frame, and
980move point there. The default for TAGNAME is the expression in the buffer
981around or before point.
982
983If second arg NEXT-P is t (interactively, with prefix arg), search for
984another tag that matches the last tagname or regexp used. When there are
985multiple matches for a tag, more exact matches are found first. If NEXT-P
986is negative (interactively, with prefix arg that is a negative number or
987just \\[negative-argument]), pop back to the previous tag gone to.
daa37602 988
b533f3c5
RS
989If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
990
a70ea557 991A marker representing the point when this command is invoked is pushed
b533f3c5
RS
992onto a ring and may be popped back to with \\[pop-tag-mark].
993Contrast this with the ring of marks gone to by the command.
994
9708f7fc 995See documentation of variable `tags-file-name'."
d74e816f 996 (interactive (find-tag-interactive "Find tag other frame: "))
9708f7fc
RM
997 (let ((pop-up-frames t))
998 (find-tag-other-window tagname next-p)))
999;;;###autoload (define-key ctl-x-5-map "." 'find-tag-other-frame)
1000
daa37602 1001;;;###autoload
9708f7fc
RM
1002(defun find-tag-regexp (regexp &optional next-p other-window)
1003 "Find tag (in current tags table) whose name matches REGEXP.
1004Select the buffer containing the tag's definition and move point there.
daa37602 1005
d74e816f
RM
1006If second arg NEXT-P is t (interactively, with prefix arg), search for
1007another tag that matches the last tagname or regexp used. When there are
1008multiple matches for a tag, more exact matches are found first. If NEXT-P
1009is negative (interactively, with prefix arg that is a negative number or
1010just \\[negative-argument]), pop back to the previous tag gone to.
9708f7fc
RM
1011
1012If third arg OTHER-WINDOW is non-nil, select the buffer in another window.
1013
a70ea557 1014A marker representing the point when this command is invoked is pushed
b533f3c5
RS
1015onto a ring and may be popped back to with \\[pop-tag-mark].
1016Contrast this with the ring of marks gone to by the command.
1017
9708f7fc 1018See documentation of variable `tags-file-name'."
d74e816f
RM
1019 (interactive (find-tag-interactive "Find tag regexp: " t))
1020 ;; We go through find-tag-other-window to do all the display hair there.
1021 (funcall (if other-window 'find-tag-other-window 'find-tag)
1022 regexp next-p t))
a6125773 1023;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp)
b533f3c5
RS
1024
1025;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
1026
1027;;;###autoload
1028(defun pop-tag-mark ()
1029 "Pop back to where \\[find-tag] was last invoked.
1030
1031This is distinct from invoking \\[find-tag] with a negative argument
1032since that pops a stack of markers at which tags were found, not from
1033where they were found."
1034 (interactive)
1035 (if (ring-empty-p find-tag-marker-ring)
1036 (error "No previous locations for find-tag invocation"))
1037 (let ((marker (ring-remove find-tag-marker-ring 0)))
1038 (switch-to-buffer (or (marker-buffer marker)
1039 (error "The marked buffer has been deleted")))
1040 (goto-char (marker-position marker))
1041 (set-marker marker nil nil)))
9708f7fc 1042\f
cba9bdd2
RS
1043(defvar tag-lines-already-matched nil
1044 "Matches remembered between calls.") ; Doc string: calls to what?
b7089f3c 1045
f90a6155
JB
1046(defun find-tag-in-order (pattern
1047 search-forward-func
1048 order
1049 next-line-after-failure-p
1050 matching
1051 first-search)
cba9bdd2
RS
1052 "Internal tag-finding function.
1053PATTERN is a string to pass to arg SEARCH-FORWARD-FUNC, and to any
1054member of the function list ORDER. If ORDER is nil, use saved state
1055to continue a previous search.
1056
1057Arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
1058point should be moved to the next line.
1059
1060Arg MATCHING is a string, an English `-ing' word, to be used in an
1061error message."
1062;; Algorithm is as follows:
1063;; For each qualifier-func in ORDER, go to beginning of tags file, and
1064;; perform inner loop: for each naive match for PATTERN found using
1065;; SEARCH-FORWARD-FUNC, qualify the naive match using qualifier-func. If
1066;; it qualifies, go to the specified line in the specified source file
1067;; and return. Qualified matches are remembered to avoid repetition.
1068;; State is saved so that the loop can be continued.
9708f7fc
RM
1069 (let (file ;name of file containing tag
1070 tag-info ;where to find the tag in FILE
9708f7fc
RM
1071 (first-table t)
1072 (tag-order order)
b7089f3c 1073 (match-marker (make-marker))
9708f7fc 1074 goto-func
ece6e35a
GM
1075 (case-fold-search (if (memq tags-case-fold-search '(nil t))
1076 tags-case-fold-search
1077 case-fold-search))
9708f7fc
RM
1078 )
1079 (save-excursion
b7089f3c
RM
1080
1081 (if first-search
1082 ;; This is the start of a search for a fresh tag.
1083 ;; Clear the list of tags matched by the previous search.
1084 ;; find-tag-noselect has already put us in the first tags table
1085 ;; buffer before we got called.
1086 (setq tag-lines-already-matched nil)
1087 ;; Continuing to search for the tag specified last time.
1088 ;; tag-lines-already-matched lists locations matched in previous
1089 ;; calls so we don't visit the same tag twice if it matches twice
1090 ;; during two passes with different qualification predicates.
1091 ;; Switch to the current tags table buffer.
1092 (visit-tags-table-buffer 'same))
47f3c459 1093
9708f7fc 1094 ;; Get a qualified match.
83287e5b 1095 (catch 'qualified-match-found
47f3c459 1096
b6176f64 1097 ;; Iterate over the list of tags tables.
9708f7fc
RM
1098 (while (or first-table
1099 (visit-tags-table-buffer t))
1100
6218e8c6
RM
1101 (and first-search first-table
1102 ;; Start at beginning of tags file.
1103 (goto-char (point-min)))
5e882a6a 1104
6218e8c6 1105 (setq first-table nil)
9708f7fc 1106
b6176f64 1107 ;; Iterate over the list of ordering predicates.
9708f7fc
RM
1108 (while order
1109 (while (funcall search-forward-func pattern nil t)
1110 ;; Naive match found. Qualify the match.
1111 (and (funcall (car order) pattern)
1112 ;; Make sure it is not a previous qualified match.
b7089f3c
RM
1113 (not (member (set-marker match-marker (save-excursion
1114 (beginning-of-line)
1115 (point)))
1116 tag-lines-already-matched))
9708f7fc
RM
1117 (throw 'qualified-match-found nil))
1118 (if next-line-after-failure-p
1119 (forward-line 1)))
1120 ;; Try the next flavor of match.
1121 (setq order (cdr order))
1122 (goto-char (point-min)))
1123 (setq order tag-order))
1124 ;; We throw out on match, so only get here if there were no matches.
b7089f3c
RM
1125 ;; Clear out the markers we use to avoid duplicate matches so they
1126 ;; don't slow down editting and are immediately available for GC.
1127 (while tag-lines-already-matched
1128 (set-marker (car tag-lines-already-matched) nil nil)
1129 (setq tag-lines-already-matched (cdr tag-lines-already-matched)))
1130 (set-marker match-marker nil nil)
9708f7fc 1131 (error "No %stags %s %s" (if first-search "" "more ")
83287e5b
RM
1132 matching pattern))
1133
9708f7fc
RM
1134 ;; Found a tag; extract location info.
1135 (beginning-of-line)
b7089f3c 1136 (setq tag-lines-already-matched (cons match-marker
9708f7fc
RM
1137 tag-lines-already-matched))
1138 ;; Expand the filename, using the tags table buffer's default-directory.
fb7775eb 1139 ;; We should be able to search for file-name backwards in file-of-tag:
ddc76b00 1140 ;; the beginning-of-line is ok except when positioned on a "file-name" tag.
fb7775eb 1141 (setq file (expand-file-name
ddc76b00
FP
1142 (if (memq (car order) '(tag-exact-file-name-match-p
1143 tag-file-name-match-p
1144 tag-partial-file-name-match-p))
7caf6803 1145 (save-excursion (forward-line 1)
fb7775eb
GM
1146 (file-of-tag))
1147 (file-of-tag)))
9708f7fc
RM
1148 tag-info (funcall snarf-tag-function))
1149
b6176f64 1150 ;; Get the local value in the tags table buffer before switching buffers.
9708f7fc 1151 (setq goto-func goto-tag-location-function)
84406262 1152 (tag-find-file-of-tag-noselect file)
9708f7fc
RM
1153 (widen)
1154 (push-mark)
83287e5b
RM
1155 (funcall goto-func tag-info)
1156
9708f7fc
RM
1157 ;; Return the buffer where the tag was found.
1158 (current-buffer))))
79e01623 1159
84406262 1160(defun tag-find-file-of-tag-noselect (file)
cba9bdd2
RS
1161 "Find the right line in the specified FILE."
1162 ;; If interested in compressed-files, search files with extensions.
1163 ;; Otherwise, search only the real file.
79e01623
JB
1164 (let* ((buffer-search-extensions (if (featurep 'jka-compr)
1165 tags-compression-info-list
1166 '("")))
1167 the-buffer
1168 (file-search-extensions buffer-search-extensions))
1169 ;; search a buffer visiting the file with each possible extension
1170 ;; Note: there is a small inefficiency in find-buffer-visiting :
1171 ;; truename is computed even if not needed. Not too sure about this
1172 ;; but I suspect truename computation accesses the disk.
1173 ;; It is maybe a good idea to optimise this find-buffer-visiting.
1174 ;; An alternative would be to use only get-file-buffer
1175 ;; but this looks less "sure" to find the buffer for the file.
1176 (while (and (not the-buffer) buffer-search-extensions)
1177 (setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions))))
1178 (setq buffer-search-extensions (cdr buffer-search-extensions)))
1179 ;; if found a buffer but file modified, ensure we re-read !
1180 (if (and the-buffer (not (verify-visited-file-modtime the-buffer)))
1181 (find-file-noselect (buffer-file-name the-buffer)))
1182 ;; if no buffer found, search for files with possible extensions on disk
1183 (while (and (not the-buffer) file-search-extensions)
1184 (if (not (file-exists-p (concat file (car file-search-extensions))))
1185 (setq file-search-extensions (cdr file-search-extensions))
1186 (setq the-buffer (find-file-noselect (concat file (car file-search-extensions))))))
1187 (if (not the-buffer)
1188 (if (featurep 'jka-compr)
1189 (error "File %s (with or without extensions %s) not found" file tags-compression-info-list)
1190 (error "File %s not found" file))
1191 (set-buffer the-buffer))))
1192
cba9bdd2 1193(defun tag-find-file-of-tag (file) ; Doc string?
84406262 1194 (let ((buf (tag-find-file-of-tag-noselect file)))
79e01623
JB
1195 (condition-case nil
1196 (switch-to-buffer buf)
1197 (error (pop-to-buffer buf)))))
9708f7fc
RM
1198\f
1199;; `etags' TAGS file format support.
1200
1201(defun etags-recognize-tags-table ()
cba9bdd2
RS
1202 "If `etags-verify-tags-table', make buffer-local format variables.
1203If current buffer is a valid etags TAGS file, then give it
1204buffer-local values of tags table format variables."
b6176f64 1205 (and (etags-verify-tags-table)
9508896e
JB
1206 ;; It is annoying to flash messages on the screen briefly,
1207 ;; and this message is not useful. -- rms
1208 ;; (message "%s is an `etags' TAGS file" buffer-file-name)
dd2cedb9
DL
1209 (mapc (lambda (elt) (set (make-local-variable (car elt)) (cdr elt)))
1210 '((file-of-tag-function . etags-file-of-tag)
1211 (tags-table-files-function . etags-tags-table-files)
1212 (tags-completion-table-function . etags-tags-completion-table)
1213 (snarf-tag-function . etags-snarf-tag)
1214 (goto-tag-location-function . etags-goto-tag-location)
1215 (find-tag-regexp-search-function . re-search-forward)
1216 (find-tag-regexp-tag-order . (tag-re-match-p))
1217 (find-tag-regexp-next-line-after-failure-p . t)
1218 (find-tag-search-function . search-forward)
1219 (find-tag-tag-order . (tag-exact-file-name-match-p
ddc76b00 1220 tag-file-name-match-p
dd2cedb9 1221 tag-exact-match-p
d30ffe0e 1222 tag-implicit-name-match-p
dd2cedb9
DL
1223 tag-symbol-match-p
1224 tag-word-match-p
fb7775eb 1225 tag-partial-file-name-match-p
dd2cedb9
DL
1226 tag-any-match-p))
1227 (find-tag-next-line-after-failure-p . nil)
1228 (list-tags-function . etags-list-tags)
1229 (tags-apropos-function . etags-tags-apropos)
1230 (tags-included-tables-function . etags-tags-included-tables)
1231 (verify-tags-table-function . etags-verify-tags-table)
1232 ))))
9708f7fc
RM
1233
1234(defun etags-verify-tags-table ()
e7f767c2 1235 "Return non-nil if the current buffer is a valid etags TAGS file."
e4fc4f58 1236 ;; Use eq instead of = in case char-after returns nil.
a1906d51 1237 (eq (char-after (point-min)) ?\f))
9708f7fc 1238
cba9bdd2 1239(defun etags-file-of-tag (&optional relative) ; Doc string?
9708f7fc 1240 (save-excursion
5e0b7560 1241 (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")
79e01623
JB
1242 (let ((str (buffer-substring (match-beginning 1) (match-end 1))))
1243 (if relative
1244 str
1245 (expand-file-name str
1246 (file-truename default-directory))))))
9708f7fc 1247
aa27fbb4 1248
cba9bdd2 1249(defun etags-tags-completion-table () ; Doc string?
46de1c5a 1250 (let ((table (make-vector 511 0))
4f124fb5
EZ
1251 (progress-reporter
1252 (make-progress-reporter
1253 (format "Making tags completion table for %s..." buffer-file-name)
1254 (point-min) (point-max))))
9708f7fc
RM
1255 (save-excursion
1256 (goto-char (point-min))
4a92b718
RM
1257 ;; This monster regexp matches an etags tag line.
1258 ;; \1 is the string to match;
1259 ;; \2 is not interesting;
1260 ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN
eb6a920f
RM
1261 ;; \4 is not interesting;
1262 ;; \5 is the explicitly-specified tag name.
1263 ;; \6 is the line to start searching at;
1264 ;; \7 is the char to start searching at.
4a92b718 1265 (while (re-search-forward
a7885816 1266 "^\\(\\([^\177]+[^-a-zA-Z0-9_+*$:\177]+\\)?\
7e7b42b2
GM
1267\\([-a-zA-Z0-9_+*$?:]+\\)[^-a-zA-Z0-9_+*$?:\177]*\\)\177\
1268\\(\\([^\n\001]+\\)\001\\)?\\([0-9]+\\)?,\\([0-9]+\\)?\n"
4a92b718 1269 nil t)
46de1c5a
MY
1270 (intern (prog1 (if (match-beginning 5)
1271 ;; There is an explicit tag name.
1272 (buffer-substring (match-beginning 5) (match-end 5))
1273 ;; No explicit tag name. Best guess.
1274 (buffer-substring (match-beginning 3) (match-end 3)))
4f124fb5 1275 (progress-reporter-update progress-reporter (point)))
4a92b718 1276 table)))
9708f7fc
RM
1277 table))
1278
cba9bdd2 1279(defun etags-snarf-tag (&optional use-explicit) ; Doc string?
79e01623 1280 (let (tag-text line startpos explicit-start)
83287e5b
RM
1281 (if (save-excursion
1282 (forward-line -1)
1283 (looking-at "\f\n"))
1284 ;; The match was for a source file name, not any tag within a file.
1285 ;; Give text of t, meaning to go exactly to the location we specify,
1286 ;; the beginning of the file.
1287 (setq tag-text t
1288 line nil
a1906d51 1289 startpos (point-min))
83287e5b
RM
1290
1291 ;; Find the end of the tag and record the whole tag text.
1292 (search-forward "\177")
1293 (setq tag-text (buffer-substring (1- (point))
1294 (save-excursion (beginning-of-line)
1295 (point))))
79e01623
JB
1296 ;; If use-explicit is non nil and explicit tag is present, use it as part of
1297 ;; return value. Else just skip it.
1298 (setq explicit-start (point))
1299 (when (and (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
1300 use-explicit)
1301 (setq tag-text (buffer-substring explicit-start (1- (point)))))
1302
1303
83287e5b 1304 (if (looking-at "[0-9]")
027a4b6b
JB
1305 (setq line (string-to-number (buffer-substring
1306 (point)
1307 (progn (skip-chars-forward "0-9")
1308 (point))))))
83287e5b
RM
1309 (search-forward ",")
1310 (if (looking-at "[0-9]")
027a4b6b
JB
1311 (setq startpos (string-to-number (buffer-substring
1312 (point)
1313 (progn (skip-chars-forward "0-9")
1314 (point)))))))
9708f7fc
RM
1315 ;; Leave point on the next line of the tags file.
1316 (forward-line 1)
e1dec509
RM
1317 (cons tag-text (cons line startpos))))
1318
9708f7fc 1319(defun etags-goto-tag-location (tag-info)
cba9bdd2
RS
1320 "Go to location of tag specified by TAG-INFO.
1321TAG-INFO is a cons (TEXT LINE . POSITION).
1322TEXT is the initial part of a line containing the tag.
1323LINE is the line number.
1324POSITION is the (one-based) char position of TEXT within the file.
1325
1326If TEXT is t, it means the tag refers to exactly LINE or POSITION,
1327whichever is present, LINE having preference, no searching.
1328Either LINE or POSITION can be nil. POSITION is used if present.
1329
1330If the tag isn't exactly at the given position, then look near that
1331position using a search window that expands progressively until it
1332hits the start of file."
e1dec509 1333 (let ((startpos (cdr (cdr tag-info)))
a0f09378 1334 (line (car (cdr tag-info)))
83287e5b
RM
1335 offset found pat)
1336 (if (eq (car tag-info) t)
1337 ;; Direct file tag.
1338 (cond (line (goto-line line))
a0f09378 1339 (startpos (goto-char startpos))
83287e5b
RM
1340 (t (error "etags.el BUG: bogus direct file tag")))
1341 ;; This constant is 1/2 the initial search window.
1342 ;; There is no sense in making it too small,
1343 ;; since just going around the loop once probably
1344 ;; costs about as much as searching 2000 chars.
1345 (setq offset 1000
1346 found nil
1347 pat (concat (if (eq selective-display t)
1348 "\\(^\\|\^m\\)" "^")
1349 (regexp-quote (car tag-info))))
1350 ;; The character position in the tags table is 0-origin.
1351 ;; Convert it to a 1-origin Emacs character position.
1352 (if startpos (setq startpos (1+ startpos)))
1353 ;; If no char pos was given, try the given line number.
1354 (or startpos
a0f09378
RM
1355 (if line
1356 (setq startpos (progn (goto-line line)
83287e5b
RM
1357 (point)))))
1358 (or startpos
1359 (setq startpos (point-min)))
1360 ;; First see if the tag is right at the specified location.
1361 (goto-char startpos)
1362 (setq found (looking-at pat))
1363 (while (and (not found)
1364 (progn
1365 (goto-char (- startpos offset))
1366 (not (bobp))))
1367 (setq found
1368 (re-search-forward pat (+ startpos offset) t)
1369 offset (* 3 offset))) ; expand search window
1370 (or found
1371 (re-search-forward pat nil t)
1372 (error "Rerun etags: `%s' not found in %s"
1373 pat buffer-file-name)))
1374 ;; Position point at the right place
1375 ;; if the search string matched an extra Ctrl-m at the beginning.
1376 (and (eq selective-display t)
1377 (looking-at "\^m")
1378 (forward-char 1))
1379 (beginning-of-line)))
9708f7fc 1380
cba9bdd2 1381(defun etags-list-tags (file) ; Doc string?
a1906d51 1382 (goto-char (point-min))
79e01623
JB
1383 (when (re-search-forward (concat "\f\n" "\\(" file "\\)" ",") nil t)
1384 (let ((path (save-excursion (forward-line 1) (file-of-tag)))
1385 ;; Get the local value in the tags table
1386 ;; buffer before switching buffers.
1387 (goto-func goto-tag-location-function)
1388 tag tag-info pt)
9708f7fc
RM
1389 (forward-line 1)
1390 (while (not (or (eobp) (looking-at "\f")))
79e01623
JB
1391 (setq tag-info (save-excursion (funcall snarf-tag-function t))
1392 tag (car tag-info)
1393 pt (with-current-buffer standard-output (point)))
1394 (princ tag)
1395 (when (= (aref tag 0) ?\() (princ " ...)"))
1396 (with-current-buffer standard-output
1397 (make-text-button pt (point)
1398 'tag-info tag-info
1399 'file-path path
1400 'goto-func goto-func
1401 'action (lambda (button)
1402 (let ((tag-info (button-get button 'tag-info))
1403 (goto-func (button-get button 'goto-func)))
84406262 1404 (tag-find-file-of-tag (button-get button 'file-path))
79e01623
JB
1405 (widen)
1406 (funcall goto-func tag-info)))
1407 'face 'tags-tag-face
1408 'type 'button))
9708f7fc 1409 (terpri)
274d013d 1410 (forward-line 1))
79e01623 1411 t)))
9708f7fc 1412
7e7b42b2
GM
1413(defmacro tags-with-face (face &rest body)
1414 "Execute BODY, give output to `standard-output' face FACE."
06adf6b1 1415 (let ((pp (make-symbol "start")))
286c138d 1416 `(let ((,pp (with-current-buffer standard-output (point))))
7e7b42b2 1417 ,@body
286c138d 1418 (put-text-property ,pp (with-current-buffer standard-output (point))
7e7b42b2
GM
1419 'face ,face standard-output))))
1420
1421(defun etags-tags-apropos-additional (regexp)
1422 "Display tags matching REGEXP from `tags-apropos-additional-actions'."
1423 (with-current-buffer standard-output
1424 (dolist (oba tags-apropos-additional-actions)
1425 (princ "\n\n")
1426 (tags-with-face 'highlight (princ (car oba)))
1427 (princ":\n\n")
79e01623 1428 (let* ((beg (point))
7e7b42b2
GM
1429 (symbs (car (cddr oba)))
1430 (ins-symb (lambda (sy)
1431 (let ((sn (symbol-name sy)))
1432 (when (string-match regexp sn)
79e01623
JB
1433 (make-text-button (point)
1434 (progn (princ sy) (point))
1435 'action-internal(cadr oba)
1436 'action (lambda (button) (funcall
1437 (button-get button 'action-internal)
1438 (button-get button 'item)))
1439 'item sn
1440 'face tags-tag-face
1441 'type 'button)
7e7b42b2
GM
1442 (terpri))))))
1443 (when (symbolp symbs)
1444 (if (boundp symbs)
1445 (setq symbs (symbol-value symbs))
1446 (insert "symbol `" (symbol-name symbs) "' has no value\n")
1447 (setq symbs nil)))
1448 (if (vectorp symbs)
1449 (mapatoms ins-symb symbs)
1450 (dolist (sy symbs)
1451 (funcall ins-symb (car sy))))
1452 (sort-lines nil beg (point))))))
1453
cba9bdd2 1454(defun etags-tags-apropos (string) ; Doc string?
7e7b42b2
GM
1455 (when tags-apropos-verbose
1456 (princ "Tags in file `")
1457 (tags-with-face 'highlight (princ buffer-file-name))
1458 (princ "':\n\n"))
a1906d51 1459 (goto-char (point-min))
4f124fb5
EZ
1460 (let ((progress-reporter (make-progress-reporter
1461 (format "Making tags apropos buffer for `%s'..."
1462 string)
1463 (point-min) (point-max))))
31f98a93 1464 (while (re-search-forward string nil t)
4f124fb5 1465 (progress-reporter-update progress-reporter (point))
31f98a93
MY
1466 (beginning-of-line)
1467
1468 (let* ( ;; Get the local value in the tags table
1469 ;; buffer before switching buffers.
1470 (goto-func goto-tag-location-function)
1471 (tag-info (save-excursion (funcall snarf-tag-function)))
1472 (tag (if (eq t (car tag-info)) nil (car tag-info)))
1473 (file-path (save-excursion (if tag (file-of-tag)
7caf6803 1474 (save-excursion (forward-line 1)
31f98a93
MY
1475 (file-of-tag)))))
1476 (file-label (if tag (file-of-tag t)
7caf6803 1477 (save-excursion (forward-line 1)
31f98a93
MY
1478 (file-of-tag t))))
1479 (pt (with-current-buffer standard-output (point))))
1480 (if tag
1481 (progn
1482 (princ (format "[%s]: " file-label))
1483 (princ tag)
1484 (when (= (aref tag 0) ?\() (princ " ...)"))
1485 (with-current-buffer standard-output
1486 (make-text-button pt (point)
1487 'tag-info tag-info
1488 'file-path file-path
1489 'goto-func goto-func
1490 'action (lambda (button)
1491 (let ((tag-info (button-get button 'tag-info))
1492 (goto-func (button-get button 'goto-func)))
1493 (tag-find-file-of-tag (button-get button 'file-path))
1494 (widen)
1495 (funcall goto-func tag-info)))
1496 'face 'tags-tag-face
1497 'type 'button)))
1498 (princ (format "- %s" file-label))
1499 (with-current-buffer standard-output
1500 (make-text-button pt (point)
1501 'file-path file-path
1502 'action (lambda (button)
1503 (tag-find-file-of-tag (button-get button 'file-path))
1504 ;; Get the local value in the tags table
1505 ;; buffer before switching buffers.
1506 (goto-char (point-min)))
1507 'face 'tags-tag-face
1508 'type 'button))
1509 ))
1510 (terpri)
1511 (forward-line 1))
1512 (message nil))
7e7b42b2 1513 (when tags-apropos-verbose (princ "\n")))
9708f7fc 1514
cba9bdd2 1515(defun etags-tags-table-files () ; Doc string?
9708f7fc
RM
1516 (let ((files nil)
1517 beg)
1518 (goto-char (point-min))
1519 (while (search-forward "\f\n" nil t)
1520 (setq beg (point))
610c25c1
RS
1521 (end-of-line)
1522 (skip-chars-backward "^," beg)
1523 (or (looking-at "include$")
83287e5b 1524 (setq files (cons (buffer-substring beg (1- (point))) files))))
9708f7fc
RM
1525 (nreverse files)))
1526
cba9bdd2 1527(defun etags-tags-included-tables () ; Doc string?
9708f7fc
RM
1528 (let ((files nil)
1529 beg)
1530 (goto-char (point-min))
1531 (while (search-forward "\f\n" nil t)
1532 (setq beg (point))
610c25c1
RS
1533 (end-of-line)
1534 (skip-chars-backward "^," beg)
1535 (if (looking-at "include$")
9708f7fc 1536 ;; Expand in the default-directory of the tags table buffer.
610c25c1 1537 (setq files (cons (expand-file-name (buffer-substring beg (1- (point))))
9708f7fc
RM
1538 files))))
1539 (nreverse files)))
1540\f
1541;; Empty tags file support.
1542
7e7b42b2 1543(defun tags-recognize-empty-tags-table ()
cba9bdd2
RS
1544 "Return non-nil if current buffer is empty.
1545If empty, make buffer-local values of the tags table format variables
1546that do nothing."
9708f7fc 1547 (and (zerop (buffer-size))
dd2cedb9
DL
1548 (mapc (lambda (sym) (set (make-local-variable sym) 'ignore))
1549 '(tags-table-files-function
1550 tags-completion-table-function
1551 find-tag-regexp-search-function
1552 find-tag-search-function
1553 tags-apropos-function
1554 tags-included-tables-function))
9708f7fc 1555 (set (make-local-variable 'verify-tags-table-function)
7e7b42b2 1556 (lambda () (zerop (buffer-size))))))
9708f7fc 1557\f
7e7b42b2 1558;; Match qualifier functions for tagnames.
2aa9d1be 1559;; These functions assume the etags file format defined in etc/ETAGS.EBNF.
9708f7fc 1560
6218e8c6
RM
1561;; This might be a neat idea, but it's too hairy at the moment.
1562;;(defmacro tags-with-syntax (&rest body)
7e7b42b2 1563;; `(let ((current (current-buffer))
6218e8c6
RM
1564;; (otable (syntax-table))
1565;; (buffer (find-file-noselect (file-of-tag)))
1566;; table)
1567;; (unwind-protect
1568;; (progn
1569;; (set-buffer buffer)
1570;; (setq table (syntax-table))
1571;; (set-buffer current)
1572;; (set-syntax-table table)
7e7b42b2
GM
1573;; ,@body)
1574;; (set-syntax-table otable))))
6218e8c6 1575;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form))
8a4c10dc 1576
2aa9d1be
FP
1577;; exact file name match, i.e. searched tag must match complete file
1578;; name including directories parts if there are some.
1579(defun tag-exact-file-name-match-p (tag)
cba9bdd2
RS
1580 "Return non-nil if TAG matches complete file name.
1581Any directory part of the file name is also matched."
2aa9d1be
FP
1582 (and (looking-at ",[0-9\n]")
1583 (save-excursion (backward-char (+ 2 (length tag)))
1584 (looking-at "\f\n"))))
cba9bdd2 1585
2aa9d1be
FP
1586;; file name match as above, but searched tag must match the file
1587;; name not including the directories if there are some.
1588(defun tag-file-name-match-p (tag)
cba9bdd2 1589 "Return non-nil if TAG matches file name, excluding directory part."
2aa9d1be
FP
1590 (and (looking-at ",[0-9\n]")
1591 (save-excursion (backward-char (1+ (length tag)))
1592 (looking-at "/"))))
cba9bdd2 1593
2aa9d1be
FP
1594;; this / to detect we are after a directory separator is ok for unix,
1595;; is there a variable that contains the regexp for directory separator
1596;; on whatever operating system ?
1597;; Looks like ms-win will lose here :).
1598
eb21e7ae 1599;; t if point is at a tag line that matches TAG exactly.
9708f7fc 1600;; point should be just after a string that matches TAG.
6218e8c6 1601(defun tag-exact-match-p (tag)
cba9bdd2
RS
1602 "Return non-nil if current tag line matches TAG exactly.
1603Point should be just after a string that matches TAG."
add3312f 1604 ;; The match is really exact if there is an explicit tag name.
63aeffd5 1605 (or (and (eq (char-after (point)) ?\001)
40ce9268 1606 (eq (char-after (- (point) (length tag) 1)) ?\177))
63aeffd5 1607 ;; We are not on the explicit tag name, but perhaps it follows.
eb21e7ae
RM
1608 (looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001"))))
1609
d30ffe0e
FP
1610;; t if point is at a tag line that has an implicit name.
1611;; point should be just after a string that matches TAG.
1612(defun tag-implicit-name-match-p (tag)
cba9bdd2
RS
1613 "Return non-nil if current tag line has an implicit name.
1614Point should be just after a string that matches TAG."
d30ffe0e
FP
1615 ;; Look at the comment of the make_tag function in lib-src/etags.c for
1616 ;; a textual description of the four rules.
1617 (and (string-match "^[^ \t()=,;]+$" tag) ;rule #1
1618 (looking-at "[ \t()=,;]?\177") ;rules #2 and #4
1619 (save-excursion
1620 (backward-char (1+ (length tag)))
1621 (looking-at "[\n \t()=,;]")))) ;rule #3
1622
eb21e7ae
RM
1623;; t if point is at a tag line that matches TAG as a symbol.
1624;; point should be just after a string that matches TAG.
1625(defun tag-symbol-match-p (tag)
cba9bdd2
RS
1626 "Return non-nil if current tag line matches TAG as a symbol.
1627Point should be just after a string that matches TAG."
eb21e7ae
RM
1628 (and (looking-at "\\Sw.*\177") (looking-at "\\S_.*\177")
1629 (save-excursion
1630 (backward-char (1+ (length tag)))
1631 (and (looking-at "\\Sw") (looking-at "\\S_")))))
9708f7fc
RM
1632
1633;; t if point is at a tag line that matches TAG as a word.
1634;; point should be just after a string that matches TAG.
1635(defun tag-word-match-p (tag)
cba9bdd2
RS
1636 "Return non-nil if current tag line matches TAG as a word.
1637Point should be just after a string that matches TAG."
9708f7fc 1638 (and (looking-at "\\b.*\177")
a0f09378 1639 (save-excursion (backward-char (length tag))
9708f7fc
RM
1640 (looking-at "\\b"))))
1641
1ea98518
SM
1642;; partial file name match, i.e. searched tag must match a substring
1643;; of the file name (potentially including a directory separator).
fb7775eb 1644(defun tag-partial-file-name-match-p (tag)
cba9bdd2
RS
1645 "Return non-nil if current tag matches file name.
1646This is a substring match, and it can include directory separators.
1647Point should be just after a string that matches TAG."
1f21ea94 1648 (and (looking-at ".*,[0-9\n]")
fb7775eb
GM
1649 (save-excursion (beginning-of-line)
1650 (backward-char 2)
1651 (looking-at "\f\n"))))
5e882a6a 1652
9708f7fc
RM
1653;; t if point is in a tag line with a tag containing TAG as a substring.
1654(defun tag-any-match-p (tag)
cba9bdd2 1655 "Return non-nil if current tag line contains TAG as a substring."
9708f7fc 1656 (looking-at ".*\177"))
ff1f0fa6 1657
9708f7fc
RM
1658;; t if point is at a tag line that matches RE as a regexp.
1659(defun tag-re-match-p (re)
cba9bdd2 1660 "Return non-nil if current tag line matches regexp RE."
9708f7fc
RM
1661 (save-excursion
1662 (beginning-of-line)
1663 (let ((bol (point)))
1664 (and (search-forward "\177" (save-excursion (end-of-line) (point)) t)
1665 (re-search-backward re bol t)))))
1666\f
6613bf7a
CY
1667(defcustom tags-loop-revert-buffers nil
1668 "*Non-nil means tags-scanning loops should offer to reread changed files.
1669These loops normally read each file into Emacs, but when a file
1670is already visited, they use the existing buffer.
1671When this flag is non-nil, they offer to revert the existing buffer
1672in the case where the file has changed since you visited it."
d5792fb2
RS
1673 :type 'boolean
1674 :group 'etags)
1675
c086701a 1676;;;###autoload
9708f7fc
RM
1677(defun next-file (&optional initialize novisit)
1678 "Select next file among files in current tags table.
4f1388fd
RM
1679
1680A first argument of t (prefix arg, if interactive) initializes to the
1681beginning of the list of files in the tags table. If the argument is
1682neither nil nor t, it is evalled to initialize the list of files.
9708f7fc
RM
1683
1684Non-nil second argument NOVISIT means use a temporary buffer
1685 to save time and avoid uninteresting warnings.
1686
1687Value is nil if the file was already visited;
1688if the file was newly read in, the value is the filename."
c20032c4
RS
1689 ;; Make the interactive arg t if there was any prefix arg.
1690 (interactive (list (if current-prefix-arg t)))
4f1388fd
RM
1691 (cond ((not initialize)
1692 ;; Not the first run.
1693 )
1694 ((eq initialize t)
1695 ;; Initialize the list from the tags table.
1696 (save-excursion
1697 ;; Visit the tags table buffer to get its list of files.
1698 (visit-tags-table-buffer)
83287e5b
RM
1699 ;; Copy the list so we can setcdr below, and expand the file
1700 ;; names while we are at it, in this buffer's default directory.
1701 (setq next-file-list (mapcar 'expand-file-name (tags-table-files)))
5c9e49a9
RM
1702 ;; Iterate over all the tags table files, collecting
1703 ;; a complete list of referenced file names.
1704 (while (visit-tags-table-buffer t)
1705 ;; Find the tail of the working list and chain on the new
1706 ;; sublist for this tags table.
1707 (let ((tail next-file-list))
1708 (while (cdr tail)
1709 (setq tail (cdr tail)))
1710 ;; Use a copy so the next loop iteration will not modify the
1711 ;; list later returned by (tags-table-files).
2f14fde6 1712 (if tail
83287e5b
RM
1713 (setcdr tail (mapcar 'expand-file-name (tags-table-files)))
1714 (setq next-file-list (mapcar 'expand-file-name
1715 (tags-table-files))))))))
4f1388fd
RM
1716 (t
1717 ;; Initialize the list by evalling the argument.
1718 (setq next-file-list (eval initialize))))
7e7b42b2 1719 (unless next-file-list
5c9e49a9
RM
1720 (and novisit
1721 (get-buffer " *next-file*")
1722 (kill-buffer " *next-file*"))
4fa15f59 1723 (error "All files processed"))
f042d383 1724 (let* ((next (car next-file-list))
d5792fb2
RS
1725 (buffer (get-file-buffer next))
1726 (new (not buffer)))
f042d383
RM
1727 ;; Advance the list before trying to find the file.
1728 ;; If we get an error finding the file, don't get stuck on it.
1729 (setq next-file-list (cdr next-file-list))
d5792fb2
RS
1730 ;; Optionally offer to revert buffers
1731 ;; if the files have changed on disk.
1732 (and buffer tags-loop-revert-buffers
1733 (not (verify-visited-file-modtime buffer))
6613bf7a
CY
1734 (y-or-n-p
1735 (format
1736 (if (buffer-modified-p buffer)
1737 "File %s changed on disk. Discard your edits? "
1738 "File %s changed on disk. Reread from disk? ")
1739 next))
d5792fb2 1740 (with-current-buffer buffer
6613bf7a 1741 (revert-buffer t t)))
9708f7fc 1742 (if (not (and new novisit))
f042d383 1743 (set-buffer (find-file-noselect next novisit))
9708f7fc
RM
1744 ;; Like find-file, but avoids random warning messages.
1745 (set-buffer (get-buffer-create " *next-file*"))
1746 (kill-all-local-variables)
1747 (erase-buffer)
f042d383 1748 (setq new next)
9708f7fc 1749 (insert-file-contents new nil))
9708f7fc 1750 new))
ff1f0fa6 1751
9708f7fc
RM
1752(defvar tags-loop-operate nil
1753 "Form for `tags-loop-continue' to eval to change one file.")
1754
0f6b9c32 1755(defvar tags-loop-scan
b0b3cce2
KH
1756 '(error "%s"
1757 (substitute-command-keys
4fa15f59 1758 "No \\[tags-search] or \\[tags-query-replace] in progress"))
9708f7fc
RM
1759 "Form for `tags-loop-continue' to eval to scan one file.
1760If it returns non-nil, this file needs processing by evalling
1761\`tags-loop-operate'. Otherwise, move on to the next file.")
ff1f0fa6 1762
ece6e35a
GM
1763(defun tags-loop-eval (form)
1764 "Evaluate FORM and return its result.
1765Bind `case-fold-search' during the evaluation, depending on the value of
1766`tags-case-fold-search'."
1767 (let ((case-fold-search (if (memq tags-case-fold-search '(t nil))
1768 tags-case-fold-search
1769 case-fold-search)))
1770 (eval form)))
ddc76b00 1771
ece6e35a 1772
c086701a 1773;;;###autoload
ff1f0fa6
JB
1774(defun tags-loop-continue (&optional first-time)
1775 "Continue last \\[tags-search] or \\[tags-query-replace] command.
4f1388fd
RM
1776Used noninteractively with non-nil argument to begin such a command (the
1777argument is passed to `next-file', which see).
78809db7
RM
1778
1779Two variables control the processing we do on each file: the value of
1780`tags-loop-scan' is a form to be executed on each file to see if it is
1781interesting (it returns non-nil if so) and `tags-loop-operate' is a form to
1782evaluate to operate on an interesting file. If the latter evaluates to
1783nil, we exit; otherwise we scan the next file."
ff1f0fa6 1784 (interactive)
9708f7fc 1785 (let (new
565c8985
RS
1786 ;; Non-nil means we have finished one file
1787 ;; and should not scan it again.
1788 file-finished
04528cda 1789 original-point
9708f7fc
RM
1790 (messaged nil))
1791 (while
1792 (progn
1793 ;; Scan files quickly for the first or next interesting one.
04528cda 1794 ;; This starts at point in the current buffer.
565c8985 1795 (while (or first-time file-finished
9708f7fc
RM
1796 (save-restriction
1797 (widen)
ece6e35a 1798 (not (tags-loop-eval tags-loop-scan))))
04528cda
GM
1799 ;; If nothing was found in the previous file, and
1800 ;; that file isn't in a temp buffer, restore point to
1801 ;; where it was.
1802 (when original-point
1803 (goto-char original-point))
1804
565c8985 1805 (setq file-finished nil)
9708f7fc 1806 (setq new (next-file first-time t))
04528cda 1807
9708f7fc
RM
1808 ;; If NEW is non-nil, we got a temp buffer,
1809 ;; and NEW is the file name.
04528cda
GM
1810 (when (or messaged
1811 (and (not first-time)
1812 (> baud-rate search-slow-speed)
1813 (setq messaged t)))
1814 (message "Scanning file %s..." (or new buffer-file-name)))
1815
9708f7fc 1816 (setq first-time nil)
04528cda 1817 (setq original-point (if new nil (point)))
9708f7fc
RM
1818 (goto-char (point-min)))
1819
1820 ;; If we visited it in a temp buffer, visit it now for real.
1821 (if new
1822 (let ((pos (point)))
1823 (erase-buffer)
1824 (set-buffer (find-file-noselect new))
78809db7 1825 (setq new nil) ;No longer in a temp buffer.
9708f7fc 1826 (widen)
04528cda
GM
1827 (goto-char pos))
1828 (push-mark original-point t))
9708f7fc
RM
1829
1830 (switch-to-buffer (current-buffer))
1831
1832 ;; Now operate on the file.
1833 ;; If value is non-nil, continue to scan the next file.
ece6e35a 1834 (tags-loop-eval tags-loop-operate))
565c8985 1835 (setq file-finished t))
9708f7fc
RM
1836 (and messaged
1837 (null tags-loop-operate)
1838 (message "Scanning file %s...found" buffer-file-name))))
9708f7fc 1839;;;###autoload (define-key esc-map "," 'tags-loop-continue)
ff1f0fa6 1840
c086701a 1841;;;###autoload
4f1388fd 1842(defun tags-search (regexp &optional file-list-form)
9708f7fc 1843 "Search through all files listed in tags table for match for REGEXP.
ff1f0fa6
JB
1844Stops when a match is found.
1845To continue searching for next match, use command \\[tags-loop-continue].
1846
9708f7fc 1847See documentation of variable `tags-file-name'."
ff1f0fa6
JB
1848 (interactive "sTags search (regexp): ")
1849 (if (and (equal regexp "")
9708f7fc 1850 (eq (car tags-loop-scan) 're-search-forward)
b6176f64 1851 (null tags-loop-operate))
9708f7fc 1852 ;; Continue last tags-search as if by M-,.
ff1f0fa6 1853 (tags-loop-continue nil)
06adf6b1 1854 (setq tags-loop-scan `(re-search-forward ',regexp nil t)
9708f7fc 1855 tags-loop-operate nil)
4f1388fd 1856 (tags-loop-continue (or file-list-form t))))
ff1f0fa6 1857
c086701a 1858;;;###autoload
c575e658 1859(defun tags-query-replace (from to &optional delimited file-list-form)
056f8a11 1860 "Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
ff1f0fa6 1861Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
056f8a11 1862If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
ff1f0fa6 1863with the command \\[tags-loop-continue].
405b8be3
EZ
1864Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop.
1865Fifth and sixth arguments START and END are accepted, for compatibility
1866with `query-replace-regexp', and ignored.
ff1f0fa6 1867
c575e658
RS
1868If FILE-LIST-FORM is non-nil, it is a form to evaluate to
1869produce the list of files to search.
1870
1871See also the documentation of the variable `tags-file-name'."
17b9c33c 1872 (interactive (query-replace-read-args "Tags query replace (regexp)" t t))
06adf6b1
SM
1873 (setq tags-loop-scan `(let ,(unless (equal from (downcase from))
1874 '((case-fold-search nil)))
1875 (if (re-search-forward ',from nil t)
1876 ;; When we find a match, move back
1877 ;; to the beginning of it so perform-replace
1878 ;; will see it.
1879 (goto-char (match-beginning 0))))
1880 tags-loop-operate `(perform-replace ',from ',to t t ',delimited))
4f1388fd 1881 (tags-loop-continue (or file-list-form t)))
9708f7fc 1882\f
cba9bdd2 1883(defun tags-complete-tags-table-file (string predicate what) ; Doc string?
83287e5b
RM
1884 (save-excursion
1885 ;; If we need to ask for the tag table, allow that.
1886 (let ((enable-recursive-minibuffers t))
1887 (visit-tags-table-buffer))
1888 (if (eq what t)
725349c8
SM
1889 (all-completions string (tags-table-files) predicate)
1890 (try-completion string (tags-table-files) predicate))))
83287e5b 1891
c086701a 1892;;;###autoload
83287e5b
RM
1893(defun list-tags (file &optional next-match)
1894 "Display list of tags in file FILE.
1895This searches only the first table in the list, and no included tables.
1896FILE should be as it appeared in the `etags' command, usually without a
1897directory specification."
1898 (interactive (list (completing-read "List tags in file: "
1899 'tags-complete-tags-table-file
1900 nil t nil)))
1901 (with-output-to-temp-buffer "*Tags List*"
7e7b42b2
GM
1902 (princ "Tags in file `")
1903 (tags-with-face 'highlight (princ file))
1904 (princ "':\n\n")
83287e5b
RM
1905 (save-excursion
1906 (let ((first-time t)
1907 (gotany nil))
1908 (while (visit-tags-table-buffer (not first-time))
1909 (setq first-time nil)
1910 (if (funcall list-tags-function file)
1911 (setq gotany t)))
1912 (or gotany
7e7b42b2
GM
1913 (error "File %s not in current tags tables" file)))))
1914 (with-current-buffer "*Tags List*"
a6e7bdf1 1915 (require 'apropos)
6ef254ec
RS
1916 (with-no-warnings
1917 (apropos-mode))
79e01623 1918 (setq buffer-read-only t)))
ff1f0fa6 1919
c086701a 1920;;;###autoload
9708f7fc
RM
1921(defun tags-apropos (regexp)
1922 "Display list of all tags in tags table REGEXP matches."
1923 (interactive "sTags apropos (regexp): ")
ff1f0fa6 1924 (with-output-to-temp-buffer "*Tags List*"
7e7b42b2
GM
1925 (princ "Click mouse-2 to follow tags.\n\nTags matching regexp `")
1926 (tags-with-face 'highlight (princ regexp))
1927 (princ "':\n\n")
ff1f0fa6 1928 (save-excursion
47f3c459
RM
1929 (let ((first-time t))
1930 (while (visit-tags-table-buffer (not first-time))
1931 (setq first-time nil)
7e7b42b2
GM
1932 (funcall tags-apropos-function regexp))))
1933 (etags-tags-apropos-additional regexp))
1934 (with-current-buffer "*Tags List*"
7caf6803 1935 (eval-and-compile (require 'apropos))
89228b63
JB
1936 (apropos-mode)
1937 ;; apropos-mode is derived from fundamental-mode and it kills
1938 ;; all local variables.
1939 (setq buffer-read-only t)))
9708f7fc 1940\f
1ea98518 1941;; XXX Kludge interface.
aa228418 1942
36278af3 1943(define-button-type 'tags-select-tags-table
29878150 1944 'action 'select-tags-table-select
36278af3
MY
1945 'help-echo "RET, t or mouse-2: select tags table")
1946
9708f7fc 1947;; XXX If a file is in multiple tables, selection may get the wrong one.
29add8b9 1948;;;###autoload
9708f7fc
RM
1949(defun select-tags-table ()
1950 "Select a tags table file from a menu of those you have already used.
168e43e7 1951The list of tags tables to select from is stored in `tags-table-set-list';
9708f7fc
RM
1952see the doc of that variable if you want to add names to the list."
1953 (interactive)
1954 (pop-to-buffer "*Tags Table List*")
9099b373
GM
1955 (setq buffer-read-only nil
1956 buffer-undo-list t)
9708f7fc 1957 (erase-buffer)
9708f7fc 1958 (let ((set-list tags-table-set-list)
36278af3
MY
1959 (desired-point nil)
1960 b)
7e7b42b2 1961 (when tags-table-list
29878150
SM
1962 (setq desired-point (point-marker))
1963 (setq b (point))
1964 (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer))
1965 (make-text-button b (point) 'type 'tags-select-tags-table
1966 'etags-table (car tags-table-list))
7e7b42b2 1967 (insert "\n"))
9708f7fc 1968 (while set-list
7e7b42b2 1969 (unless (eq (car set-list) tags-table-list)
36278af3 1970 (setq b (point))
29878150
SM
1971 (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer))
1972 (make-text-button b (point) 'type 'tags-select-tags-table
1973 'etags-table (car (car set-list)))
9708f7fc
RM
1974 (insert "\n"))
1975 (setq set-list (cdr set-list)))
7e7b42b2 1976 (when tags-file-name
29878150
SM
1977 (or desired-point
1978 (setq desired-point (point-marker)))
1979 (setq b (point))
1980 (insert (abbreviate-file-name tags-file-name))
1981 (make-text-button b (point) 'type 'tags-select-tags-table
1982 'etags-table tags-file-name)
7e7b42b2 1983 (insert "\n"))
9708f7fc 1984 (setq set-list (delete tags-file-name
9993b561 1985 (apply 'nconc (cons (copy-sequence tags-table-list)
9708f7fc
RM
1986 (mapcar 'copy-sequence
1987 tags-table-set-list)))))
1988 (while set-list
36278af3 1989 (setq b (point))
29878150
SM
1990 (insert (abbreviate-file-name (car set-list)))
1991 (make-text-button b (point) 'type 'tags-select-tags-table
1992 'etags-table (car set-list))
9708f7fc
RM
1993 (insert "\n")
1994 (setq set-list (delete (car set-list) set-list)))
a1906d51 1995 (goto-char (point-min))
9708f7fc
RM
1996 (insert-before-markers
1997 "Type `t' to select a tags table or set of tags tables:\n\n")
1998 (if desired-point
1999 (goto-char desired-point))
2000 (set-window-start (selected-window) 1 t))
2001 (set-buffer-modified-p nil)
ef90db45
RS
2002 (select-tags-table-mode))
2003
cba9bdd2 2004(defvar select-tags-table-mode-map ; Doc string?
29878150
SM
2005 (let ((map (make-sparse-keymap)))
2006 (set-keymap-parent map button-buffer-map)
36278af3
MY
2007 (define-key map "t" 'push-button)
2008 (define-key map " " 'next-line)
2009 (define-key map "\^?" 'previous-line)
2010 (define-key map "n" 'next-line)
2011 (define-key map "p" 'previous-line)
2012 (define-key map "q" 'select-tags-table-quit)
2013 map))
ef90db45 2014
29878150 2015(define-derived-mode select-tags-table-mode fundamental-mode "Select Tags Table"
ef90db45
RS
2016 "Major mode for choosing a current tags table among those already loaded.
2017
2018\\{select-tags-table-mode-map}"
29878150
SM
2019 (setq buffer-read-only t))
2020
2021(defun select-tags-table-select (button)
9708f7fc 2022 "Select the tags table named on this line."
29878150
SM
2023 (interactive (list (or (button-at (line-beginning-position))
2024 (error "No tags table on current line"))))
2025 (let ((name (button-get button 'etags-table)))
9708f7fc
RM
2026 (visit-tags-table name)
2027 (select-tags-table-quit)
2028 (message "Tags table now %s" name)))
49116ac0 2029
9708f7fc
RM
2030(defun select-tags-table-quit ()
2031 "Kill the buffer and delete the selected window."
2032 (interactive)
7591cf05 2033 (quit-window t (selected-window)))
9708f7fc 2034\f
1ea98518 2035;; Note, there is another definition of this function in bindings.el.
9708f7fc
RM
2036;;;###autoload
2037(defun complete-tag ()
2038 "Perform tags completion on the text around point.
83287e5b 2039Completes to the set of names listed in the current tags table.
9708f7fc 2040The string to complete is chosen in the same way as the default
ab13123a 2041for \\[find-tag] (which see)."
9708f7fc 2042 (interactive)
ab13123a
RM
2043 (or tags-table-list
2044 tags-file-name
b0b3cce2
KH
2045 (error "%s"
2046 (substitute-command-keys
4fa15f59 2047 "No tags table loaded; try \\[visit-tags-table]")))
8a294d90
FP
2048 (let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
2049 tags-case-fold-search
2050 case-fold-search))
2051 (pattern (funcall (or find-tag-default-function
9708f7fc
RM
2052 (get major-mode 'find-tag-default-function)
2053 'find-tag-default)))
b5507bc1 2054 (comp-table (tags-lazy-completion-table))
9708f7fc
RM
2055 beg
2056 completion)
2057 (or pattern
2058 (error "Nothing to complete"))
2059 (search-backward pattern)
2060 (setq beg (point))
2061 (forward-char (length pattern))
b5507bc1 2062 (setq completion (try-completion pattern comp-table))
9708f7fc
RM
2063 (cond ((eq completion t))
2064 ((null completion)
2065 (message "Can't find completion for \"%s\"" pattern)
2066 (ding))
2067 ((not (string= pattern completion))
2068 (delete-region beg (point))
2069 (insert completion))
2070 (t
2071 (message "Making completion list...")
c6d38ae2 2072 (with-output-to-temp-buffer "*Completions*"
9708f7fc 2073 (display-completion-list
b5507bc1 2074 (all-completions pattern comp-table nil)
f5fab556 2075 pattern))
9708f7fc 2076 (message "Making completion list...%s" "done")))))
dd2cedb9
DL
2077
2078(dolist (x '("^No tags table in use; use .* to select one$"
2079 "^There is no default tag$"
2080 "^No previous tag locations$"
2081 "^File .* is not a valid tags table$"
2082 "^No \\(more \\|\\)tags \\(matching\\|containing\\) "
2083 "^Rerun etags: `.*' not found in "
2084 "^All files processed$"
2085 "^No .* or .* in progress$"
2086 "^File .* not in current tags tables$"
2087 "^No tags table loaded"
2088 "^Nothing to complete$"))
2089 (add-to-list 'debug-ignored-errors x))
9708f7fc
RM
2090\f
2091(provide 'etags)
e5167999 2092
29878150 2093;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e
e5167999 2094;;; etags.el ends here