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