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