aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRoland McGrath1992-07-16 19:57:57 +0000
committerRoland McGrath1992-07-16 19:57:57 +0000
commit9708f7fcf2870094f275d4e4a9dfd07f52a4a940 (patch)
tree99d5ad85526d84e552269200e752058f7a76d774
parent0716883099912b79e0c4717a78db67677539aee5 (diff)
downloademacs-9708f7fcf2870094f275d4e4a9dfd07f52a4a940.tar.gz
emacs-9708f7fcf2870094f275d4e4a9dfd07f52a4a940.zip
*** empty log message ***
-rw-r--r--lisp/progmodes/etags.el1221
1 files changed, 956 insertions, 265 deletions
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 36093105c6e..8922d6365a8 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1,6 +1,6 @@
1;;; etags.el --- tags facility for Emacs. 1;; Tags facility for Emacs.
2 2;; Copyright (C) 1985, 1986, 1988, 1989, 1991, 1992
3;; Copyright (C) 1985, 1986, 1988, 1992 Free Software Foundation, Inc. 3;; Free Software Foundation, Inc.
4 4
5;; This file is part of GNU Emacs. 5;; This file is part of GNU Emacs.
6 6
@@ -18,111 +18,376 @@
18;; along with GNU Emacs; see the file COPYING. If not, write to 18;; along with GNU Emacs; see the file COPYING. If not, write to
19;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 19;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20 20
21
22;;;###autoload 21;;;###autoload
23(defvar tags-file-name nil "\ 22(defvar tags-file-name nil "\
24*File name of tag table. 23*File name of tags table.
25To switch to a new tag table, setting this variable is sufficient. 24To switch to a new tags table, setting this variable is sufficient.
26Use the `etags' program to make a tag table file.") 25Use the `etags' program to make a tags table file.")
26
27;;;###autoload
28(defvar tags-table-list nil
29 "*List of names of tags table files which are currently being searched.
30An element of nil means to look for a file \"TAGS\" in the current directory.
31Use `visit-tags-table-buffer' to cycle through tags tables in this list.")
32
33(defvar tags-table-list-pointer nil
34 "Pointer into `tags-table-list', or into a list of included tags tables,
35where the current state of searching is. Use `visit-tags-table-buffer' to
36cycle through tags tables in this list.")
37
38(defvar tags-table-parent-pointer-list nil
39 "List of values to restore into `tags-table-list-pointer' when it hits nil.")
40
41(defvar tags-table-set-list nil
42 "List of sets of tags table which have been used together in the past.
43Each element is a list of strings which are file names.")
44
45;;;###autoload
46(defvar find-tag-hook nil
47 "*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
48The value in the buffer in which \\[find-tag] is done is used,
49not the value in the buffer \\[find-tag] goes to.")
50
51;;;###autoload
52(defvar find-tag-default-function nil
53 "*If non-nil, a function of no arguments used by \\[find-tag] to pick a
54default tag. If nil, and the symbol that is the value of `major-mode'
55has a `find-tag-default-function' property (see `put'), that is used.
56Otherwise, `find-tag-default' is used.")
57
58;;;###autoload
59(defvar default-tags-table-function nil
60 "*If non-nil, a function of no arguments to choose a default tags file
61for a particular buffer.")
62
63;; Tags table state.
64;; These variables are local in tags table buffers.
27 65
28(defvar tag-table-files nil 66(defvar tag-lines-already-matched nil
29 "List of file names covered by current tag table. 67 "List of positions of beginnings of lines within the tags table
30nil means it has not been computed yet; do (tag-table-files) to compute it.") 68that are already matched.")
31 69
32(defvar last-tag nil 70(defvar tags-table-files nil
33 "Tag found by the last find-tag.") 71 "List of file names covered by current tags table.
72nil means it has not yet been computed; use `tags-table-files' to do so.")
73
74(defvar tags-completion-table nil
75 "Alist of tag names defined in current tags table.")
76
77(defvar tags-included-tables nil
78 "List of tags tables included by the current tags table.")
79
80(defvar next-file-list nil
81 "List of files for \\[next-file] to process.")
82
83;; Hooks for file formats.
84
85(defvar tags-table-format-hooks '(etags-recognize-tags-table
86 recognize-empty-tags-table
87 ctags-recognize-tags-table) ;standard? XXX
88 "List of functions to be called in a tags table buffer to identify
89the type of tags table. The functions are called in order, with no arguments,
90until one returns non-nil. The function should make buffer-local bindings
91of the format-parsing tags function variables if successful.")
92
93(defvar file-of-tag-function nil
94 "Function to do the work of `file-of-tag' (which see).")
95(defvar tags-table-files-function nil
96 "Function to do the work of `tags-table-files' (which see).")
97(defvar tags-completion-table-function nil
98 "Function to build the tags-completion-table.")
99(defvar snarf-tag-function nil
100 "Function to get info about a matched tag for `goto-tag-location-function'.")
101(defvar goto-tag-location-function nil
102 "Function of to go to the location in the buffer specified by a tag.
103One argument, the tag info returned by `snarf-tag-function'.")
104(defvar find-tag-regexp-search-function nil
105 "Search function passed to `find-tag-in-order' for finding a regexp tag.")
106(defvar find-tag-regexp-tag-order nil
107 "Tag order passed to `find-tag-in-order' for finding a regexp tag.")
108(defvar find-tag-regexp-next-line-after-failure-p nil
109 "Flag passed to `find-tag-in-order' for finding a regexp tag.")
110(defvar find-tag-search-function nil
111 "Search function passed to `find-tag-in-order' for finding a tag.")
112(defvar find-tag-tag-order nil
113 "Tag order passed to `find-tag-in-order' for finding a tag.")
114(defvar find-tag-next-line-after-failure-p nil
115 "Flag passed to `find-tag-in-order' for finding a tag.")
116(defvar list-tags-function nil
117 "Function to do the work of `list-tags' (which see).")
118(defvar tags-apropos-function nil
119 "Function to do the work of `tags-apropos' (which see).")
120(defvar tags-included-tables-function nil
121 "Function to do the work of `tags-included-tables' (which see).")
122(defvar verify-tags-table-function nil
123 "Function to return t iff the current buffer vontains a valid
124\(already initialized\) tags file.")
125
126(defun initialize-new-tags-table ()
127 "Initialize the tags table in the current buffer.
128Returns non-nil iff it is a valid tags table."
129 (make-local-variable 'tag-lines-already-matched)
130 (make-local-variable 'tags-table-files)
131 (make-local-variable 'tags-completion-table)
132 (make-local-variable 'tags-included-tables)
133 (setq tags-table-files nil
134 tag-lines-already-matched nil
135 tags-completion-table nil
136 tags-included-tables nil)
137 ;; Value is t if we have found a valid tags table buffer.
138 (let ((hooks tags-table-format-hooks))
139 (while (and hooks
140 (not (funcall (car hooks))))
141 (setq hooks (cdr hooks)))
142 hooks))
34 143
35;;;###autoload 144;;;###autoload
36(defun visit-tags-table (file) 145(defun visit-tags-table (file &optional local)
37 "Tell tags commands to use tag table file FILE. 146 "Tell tags commands to use tags table file FILE.
38FILE should be the name of a file created with the `etags' program. 147FILE should be the name of a file created with the `etags' program.
39A directory name is ok too; it means file TAGS in that directory." 148A directory name is ok too; it means file TAGS in that directory.
149
150Normally \\[visit-tags-table] sets the global value of `tags-file-name'.
151With a prefix arg, set the buffer-local value instead.
152When you find a tag with \\[find-tag], the buffer it finds the tag
153in is given a local value of this variable which is the name of the tags
154file the tag was in."
40 (interactive (list (read-file-name "Visit tags table: (default TAGS) " 155 (interactive (list (read-file-name "Visit tags table: (default TAGS) "
41 default-directory 156 default-directory
42 (concat default-directory "TAGS") 157 (expand-file-name "TAGS"
43 t))) 158 default-directory)
159 t)
160 current-prefix-arg))
44 (setq file (expand-file-name file)) 161 (setq file (expand-file-name file))
45 ;; Get rid of the prefixes added by the automounter.
46 (if (and (string-match "^/tmp_mnt/" file)
47 (file-exists-p (file-name-directory
48 (substring file (1- (match-end 0))))))
49 (setq file (substring file (1- (match-end 0)))))
50 (if (file-directory-p file) 162 (if (file-directory-p file)
51 (setq file (concat file "TAGS"))) 163 (setq file (expand-file-name "TAGS" file)))
52 (setq tag-table-files nil 164 (if local
53 tags-file-name file)) 165 (setq tags-file-name file)
54 166 (kill-local-variable 'tags-file-name)
55(defun visit-tags-table-buffer () 167 (setq-default tags-file-name file))
56 "Select the buffer containing the current tag table. 168 (save-excursion
57This is a file whose name is in the variable tags-file-name." 169 (visit-tags-file t)))
58 (or tags-file-name 170
59 (call-interactively 'visit-tags-table)) 171(defun visit-tags-table-buffer (&optional cont)
60 (set-buffer (or (get-file-buffer tags-file-name) 172 "Select the buffer containing the current tags table.
61 (progn 173If optional arg is t, visit the next table in `tags-table-list'.
62 (setq tag-table-files nil) 174If optional arg is the atom `reset', reset to the head of `tags-table-list'.
63 (find-file-noselect tags-file-name)))) 175If optional arg is the atom `same', don't look for a new table;
64 (or (verify-visited-file-modtime (get-file-buffer tags-file-name)) 176 just select the buffer.
65 (cond ((yes-or-no-p "Tags file has changed, read new contents? ") 177If arg is nil or absent, choose a buffer from information in
66 (revert-buffer t t) 178`tags-file-name', `tags-table-list', `tags-table-list-pointer'.
67 (setq tag-table-files nil)))) 179Returns t if it visits a tags table, or nil if there are no more in the list."
68 (or (eq (char-after 1) ?\^L) 180 (if (eq cont 'same)
69 (error "File %s not a valid tag table" tags-file-name))) 181 (let ((tags-file-name (car tags-table-list-pointer)))
182 (if (null tags-file-name)
183 nil
184 (visit-tags-file nil)
185 t))
186 (let ((put-in-list t))
187 (if (cond ((eq cont 'reset)
188 (setq tags-table-list-pointer tags-table-list
189 cont nil)
190 nil)
191 (cont
192 (setq tags-table-list-pointer (cdr tags-table-list-pointer))
193 (if (tags-included-tables)
194 (progn
195 ;; Move into the included tags tables.
196 (if tags-table-list-pointer
197 (setq tags-table-parent-pointer-list
198 (cons tags-table-list-pointer
199 tags-table-parent-pointer-list)))
200 (setq tags-table-list-pointer tags-included-tables)))
201 (or tags-table-list-pointer
202 ;; Pop back to the tags table after the one which includes
203 ;; this one.
204 (setq tags-table-list-pointer
205 (car tags-table-parent-pointer-list)
206 tags-table-parent-pointer-list
207 (cdr tags-table-parent-pointer-list)))
208 (setq put-in-list nil)
209 (null tags-table-list-pointer)))
210 ;; No more tags table files in the list.
211 nil
212 (setq tags-file-name
213 (or (if cont
214 (and tags-table-list-pointer
215 (or (car tags-table-list-pointer)
216 ;; nil means look for TAGS in current directory.
217 (if (file-exists-p
218 (expand-file-name "TAGS"
219 default-directory))
220 (expand-file-name "TAGS"
221 default-directory))))
222 (cdr (assq 'tags-file-name (buffer-local-variables))))
223 (and default-tags-table-function
224 (funcall default-tags-table-function))
225 (car tags-table-list-pointer)
226 tags-file-name
227 (expand-file-name
228 (read-file-name "Visit tags table: (default TAGS) "
229 default-directory
230 (expand-file-name "TAGS" default-directory)
231 t))))
232 (if (file-directory-p tags-file-name)
233 (setq tags-file-name (expand-file-name "TAGS" tags-file-name)))
234 (visit-tags-file put-in-list)
235 t))))
236
237;; Visit tags-file-name and check that it's a valid tags table.
238;; On return, tags-table-list and tags-table-list-pointer
239;; point to tags-file-name.
240(defun visit-tags-file (put-in-list)
241 ;; FILE is never changed, but we don't just use tags-file-name
242 ;; directly because we don't want to get its buffer-local value
243 ;; in the buffer we switch to.
244 (let ((file tags-file-name))
245 (if (if (get-file-buffer file)
246 (let (win)
247 (set-buffer (get-file-buffer file))
248 (setq win (or verify-tags-table-function
249 (initialize-new-tags-table)))
250 (if (or (verify-visited-file-modtime (current-buffer))
251 (not (yes-or-no-p
252 "Tags file has changed, read new contents? ")))
253 (and win (funcall verify-tags-table-function))
254 (revert-buffer t t)
255 (initialize-new-tags-table)))
256 (set-buffer (find-file-noselect file))
257 (initialize-new-tags-table))
258
259 (if (and put-in-list
260 (not (equal file (car tags-table-list-pointer))))
261 (let (elt)
262 ;; Bury the tags table buffer so it
263 ;; doesn't get in the user's way.
264 (bury-buffer (current-buffer))
265 ;; Look for this file in the current list of tags files.
266 (if (setq elt (member file tags-table-list))
267 (if (eq elt tags-table-list)
268 ;; Already at the head of the list.
269 ()
270 ;; Rotate this element to the head of the search list.
271 (setq tags-table-list-pointer (nconc elt tags-table-list))
272 (while (not (eq (cdr tags-table-list) elt))
273 (setq tags-table-list (cdr tags-table-list)))
274 (setcdr tags-table-list nil)
275 (setq tags-table-list tags-table-list-pointer))
276 ;; The table is not in the current set.
277 ;; Try to find it in another previously used set.
278 (let ((sets tags-table-set-list))
279 (while (and sets
280 (not (setq elt (member file
281 (car sets)))))
282 (setq sets (cdr sets)))
283 (if sets
284 (progn
285 ;; Found in some other set. Switch to that set, making
286 ;; the selected tags table the head of the search list.
287 (or (memq tags-table-list tags-table-set-list)
288 ;; Save the current list.
289 (setq tags-table-set-list
290 (cons tags-table-list tags-table-set-list)))
291 (setq tags-table-list (car sets))
292 (if (eq elt tags-table-list)
293 ;; Already at the head of the list
294 ()
295 ;; Rotate this element to the head of the list.
296 (setq tags-table-list-pointer
297 (nconc elt tags-table-list))
298 (while (not (eq (cdr tags-table-list) elt))
299 (setq tags-table-list (cdr tags-table-list)))
300 (setcdr tags-table-list nil)
301 (setq tags-table-list tags-table-list-pointer)
302 (setcar sets tags-table-list)))
303 ;; Not found in any current set.
304 (if (and tags-table-list
305 (y-or-n-p
306 (concat "Add " file
307 " to current list of tags tables? ")))
308 ;; Add it to the current list.
309 (setq tags-table-list
310 (cons file tags-table-list))
311 ;; Make a fresh list, and store the old one.
312 (or (memq tags-table-list tags-table-set-list)
313 (setq tags-table-set-list
314 (cons tags-table-list tags-table-set-list)))
315 (setq tags-table-list (cons file nil)))
316 (setq tags-table-list-pointer tags-table-list))))))
317
318 ;; The buffer was not valid. Don't use it again.
319 (kill-local-variable 'tags-file-name)
320 (setq tags-file-name nil)
321 (error "File %s is not a valid tags table" buffer-file-name))))
70 322
71(defun file-of-tag () 323(defun file-of-tag ()
72 "Return the file name of the file whose tags point is within. 324 "Return the file name of the file whose tags point is within.
73Assumes the tag table is the current buffer. 325Assumes the tags table is the current buffer.
74File name returned is relative to tag table file's directory." 326File name returned is relative to tags table file's directory."
75 (let ((opoint (point)) 327 (funcall file-of-tag-function))
76 prev size)
77 (save-excursion
78 (goto-char (point-min))
79 (while (< (point) opoint)
80 (forward-line 1)
81 (end-of-line)
82 (skip-chars-backward "^,\n")
83 (setq prev (point))
84 (setq size (read (current-buffer)))
85 (goto-char prev)
86 (forward-line 1)
87 (forward-char size))
88 (goto-char (1- prev))
89 (buffer-substring (point)
90 (progn (beginning-of-line) (point))))))
91 328
92;;;###autoload 329;;;###autoload
93(defun tag-table-files () 330(defun tags-table-files ()
94 "Return a list of files in the current tag table. 331 "Return a list of files in the current tags table.
95File names returned are absolute." 332File names returned are absolute."
96 (save-excursion 333 (save-excursion
97 (visit-tags-table-buffer) 334 (visit-tags-table-buffer)
98 (or tag-table-files 335 (or tags-table-files
99 (let (files) 336 (setq tags-table-files
100 (goto-char (point-min)) 337 (funcall tags-table-files-function)))))
101 (while (not (eobp)) 338
102 (forward-line 1) 339(defun tags-included-tables ()
103 (end-of-line) 340 "Return a list of tags tables included by the current table."
104 (skip-chars-backward "^,\n") 341 (or tags-included-tables
105 (setq prev (point)) 342 (setq tags-included-tables (funcall tags-included-tables-function))))
106 (setq size (read (current-buffer))) 343
107 (goto-char prev) 344;; Build tags-completion-table on demand. The single current tags table
108 (setq files (cons (expand-file-name 345;; and its included tags tables (and their included tables, etc.) have
109 (buffer-substring (1- (point)) 346;; their tags included in the completion table.
110 (save-excursion 347(defun tags-completion-table ()
111 (beginning-of-line) 348 (or tags-completion-table
112 (point))) 349 (condition-case ()
113 (file-name-directory tags-file-name)) 350 (prog2
114 files)) 351 (message "Making tags completion table for %s..." buffer-file-name)
115 (forward-line 1) 352 (let ((included (tags-included-tables))
116 (forward-char size)) 353 (table (funcall tags-completion-table-function)))
117 (setq tag-table-files (nreverse files)))))) 354 (save-excursion
355 (while included
356 (let ((tags-file-name (car included)))
357 (visit-tags-file nil))
358 (if (tags-completion-table)
359 (mapatoms (function
360 (lambda (sym)
361 (intern (symbol-name sym) table)))
362 tags-completion-table))
363 (setq included (cdr included))))
364 (setq tags-completion-table table))
365 (message "Making tags completion table for %s...done"
366 buffer-file-name))
367 (quit (message "Tags completion table construction aborted.")
368 (setq tags-completion-table nil)))))
369
370;; Completion function for tags. Does normal try-completion,
371;; but builds tags-completion-table on demand.
372(defun tags-complete-tag (string predicate what)
373 (save-excursion
374 (visit-tags-table-buffer)
375 (if (eq what t)
376 (all-completions string (tags-completion-table) predicate)
377 (try-completion string (tags-completion-table) predicate))))
118 378
119;; Return a default tag to search for, based on the text at point. 379;; Return a default tag to search for, based on the text at point.
120(defun find-tag-default () 380(defun find-tag-default ()
121 (save-excursion 381 (save-excursion
122 (while (looking-at "\\sw\\|\\s_") 382 (while (looking-at "\\sw\\|\\s_")
123 (forward-char 1)) 383 (forward-char 1))
124 (if (re-search-backward "\\sw\\|\\s_" nil t) 384 (if (or (re-search-backward "\\sw\\|\\s_"
125 (progn (forward-char 1) 385 (save-excursion (beginning-of-line) (point))
386 t)
387 (re-search-forward "\\(\\sw\\|\\s_\\)+"
388 (save-excursion (end-of-line) (point))
389 t))
390 (progn (goto-char (match-end 0))
126 (buffer-substring (point) 391 (buffer-substring (point)
127 (progn (forward-sexp -1) 392 (progn (forward-sexp -1)
128 (while (looking-at "\\s'") 393 (while (looking-at "\\s'")
@@ -130,255 +395,681 @@ File names returned are absolute."
130 (point)))) 395 (point))))
131 nil))) 396 nil)))
132 397
398;; Read a tag name from the minibuffer with defaulting and completion.
133(defun find-tag-tag (string) 399(defun find-tag-tag (string)
134 (let* ((default (find-tag-default)) 400 (let* ((default (funcall (or find-tag-default-function
135 (spec (read-string 401 (get major-mode 'find-tag-default-function)
136 (if default 402 'find-tag-default)))
137 (format "%s(default %s) " string default) 403 (spec (completing-read (if default
138 string)))) 404 (format "%s(default %s) " string default)
405 string)
406 'tags-complete-tag)))
139 (list (if (equal spec "") 407 (list (if (equal spec "")
140 default 408 (or default (error "There is no default tag"))
141 spec)))) 409 spec))))
142 410
143(defun tags-tag-match (tagname exact)
144 "Search for a match to the given tagname."
145 (if (not exact)
146 (search-forward tagname nil t)
147 (not (error-occurred
148 (while
149 (progn
150 (search-forward tagname)
151 (let ((before (char-syntax (char-after (1- (match-beginning 1)))))
152 (after (char-syntax (char-after (match-end 1)))))
153 (not (or (= before ?w) (= before ?_))
154 (= after ?w) (= after ?_)))
155 ))))
156 )
157 )
158
159(defun find-tag-noselect (tagname exact &optional next)
160 "Find a tag and return its buffer, but don't select or display it."
161 (let (buffer file linebeg startpos (obuf (current-buffer)))
162 ;; save-excursion will do the wrong thing if the buffer containing the
163 ;; tag being searched for is current-buffer
164 (unwind-protect
165 (progn
166 (visit-tags-table-buffer)
167 (if (not next)
168 (goto-char (point-min))
169 (setq tagname last-tag))
170 (setq last-tag tagname)
171 (while (progn
172 (if (not (tags-tag-match tagname exact))
173 (error "No %sentries matching %s"
174 (if next "more " "") tagname))
175 (not (looking-at "[^\n\177]*\177"))))
176 (search-forward "\177")
177 (setq file (expand-file-name (file-of-tag)
178 (file-name-directory tags-file-name)))
179 (setq linebeg
180 (buffer-substring (1- (point))
181 (save-excursion (beginning-of-line) (point))))
182 (search-forward ",")
183 (setq startpos (read (current-buffer)))
184 (prog1
185 (set-buffer (find-file-noselect file))
186 (widen)
187 (push-mark)
188 (let ((offset 1000)
189 found
190 (pat (concat "^" (regexp-quote linebeg))))
191 (or startpos (setq startpos (point-min)))
192 (while (and (not found)
193 (progn
194 (goto-char (- startpos offset))
195 (not (bobp))))
196 (setq found
197 (re-search-forward pat (+ startpos offset) t))
198 (setq offset (* 3 offset)))
199 (or found
200 (re-search-forward pat nil t)
201 (error "%s not found in %s" pat file)))
202 (beginning-of-line)))
203 (set-buffer obuf))
204 ))
205
206;;;###autoload 411;;;###autoload
207(defun find-tag (tagname &optional next other-window) 412(defun find-tag-noselect (tagname &optional next-p regexp-p)
208 "Find tag (in current tag table) whose name contains TAGNAME. 413 "Find tag (in current tags table) whose name contains TAGNAME.
209 Selects the buffer that the tag is contained in 414Returns the buffer containing the tag's definition moves its point there,
210and puts point at its definition. 415but does not select the buffer.
211 If TAGNAME is a null string, the expression in the buffer 416The default for TAGNAME is the expression in the buffer near point.
212around or before point is used as the tag name. 417
213 If second arg NEXT is non-nil (interactively, with prefix arg), 418If second arg NEXT-P is non-nil (interactively, with prefix arg), search
214searches for the next tag in the tag table 419for another tag that matches the last tagname or regexp used. When there
215that matches the tagname used in the previous find-tag. 420are multiple matches for a tag, more exact matches are found first.
216 421
217See documentation of variable tags-file-name." 422If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
423
424See documentation of variable `tags-file-name'."
218 (interactive (if current-prefix-arg 425 (interactive (if current-prefix-arg
219 '(nil t) 426 '(nil t)
220 (find-tag-tag "Find tag: "))) 427 (find-tag-tag "Find tag: ")))
221 (let ((tagbuf (find-tag-noselect tagname nil next))) 428 (let ((local-find-tag-hook find-tag-hook))
222 (if other-window 429 (if (not next-p)
223 (switch-to-buffer-other-window tagbuf) 430 (visit-tags-table-buffer 'reset))
224 (switch-to-buffer tagbuf)) 431 (find-tag-in-order tagname
225 ) 432 (if regexp-p
226;; I turned this off because people complain that it causes trouble 433 find-tag-regexp-search-function
227;; when they find a tag during a tags-search. M-0 M-. is easy enough. --RMS 434 find-tag-search-function)
228;; (setq tags-loop-form '(find-tag nil t)) 435 (if regexp-p
229 ;; Return t in case used as the tags-loop-form. 436 find-tag-regexp-tag-order
230 t) 437 find-tag-tag-order)
438 (if regexp-p
439 find-tag-regexp-next-line-after-failure-p
440 find-tag-next-line-after-failure-p)
441 (if regexp-p "matching" "containing")
442 (not next-p))
443 (run-hooks 'local-find-tag-hook)))
231 444
232;;;###autoload 445;;;###autoload
233(define-key esc-map "." 'find-tag) 446(defun find-tag (tagname &optional next-p)
447 "Find tag (in current tags table) whose name contains TAGNAME.
448Select the buffer containing the tag's definition, and move point there.
449The default for TAGNAME is the expression in the buffer around or before point.
234 450
235;;;###autoload 451If second arg NEXT-P is non-nil (interactively, with prefix arg), search
236(defun find-tag-other-window (tagname &optional next) 452for another tag that matches the last tagname used. When there are
237 "Find tag (in current tag table) whose name contains TAGNAME. 453multiple matches, more exact matches are found first.
238 Selects the buffer that the tag is contained in in another window
239and puts point at its definition.
240 If TAGNAME is a null string, the expression in the buffer
241around or before point is used as the tag name.
242 If second arg NEXT is non-nil (interactively, with prefix arg),
243searches for the next tag in the tag table
244that matches the tagname used in the previous find-tag.
245 454
246See documentation of variable tags-file-name." 455See documentation of variable `tags-file-name'."
247 (interactive (if current-prefix-arg 456 (interactive (if current-prefix-arg
248 '(nil t) 457 '(nil t)
249 (find-tag-tag "Find tag other window: "))) 458 (find-tag-tag "Find tag other window: ")))
250 (find-tag tagname next t)) 459 (switch-to-buffer (find-tag-noselect tagname next-p)))
251;;;###autoload 460;;;###autoload (define-key esc-map "." 'find-tag)
252(define-key ctl-x-4-map "." 'find-tag-other-window)
253 461
254;;;###autoload 462;;;###autoload
255(defun find-tag-other-frame (tagname &optional next) 463(defun find-tag-other-window (tagname &optional next-p)
464 "Find tag (in current tags table) whose name contains TAGNAME.
465Select the buffer containing the tag's definition
466in another window, and move point there.
467The default for TAGNAME is the expression in the buffer around or before point.
468
469If second arg NEXT-P is non-nil (interactively, with prefix arg), search
470for another tag that matches the last tagname used. When there are
471multiple matches, more exact matches are found first.
472
473See documentation of variable `tags-file-name'."
474 (interactive (if current-prefix-arg
475 '(nil t)
476 (find-tag-tag "Find tag other window: ")))
477 (switch-to-buffer-other-window (find-tag-noselect tagname next-p)))
478;;;###autoload (define-key ctl-x-4-map "." 'find-tag-other-window)
479
480(defun find-tag-other-frame (tagname &optional next-p)
256 "Find tag (in current tag table) whose name contains TAGNAME. 481 "Find tag (in current tag table) whose name contains TAGNAME.
257 Selects the buffer that the tag is contained in in another frame 482 Selects the buffer that the tag is contained in in another frame
258and puts point at its definition. 483and puts point at its definition.
259 If TAGNAME is a null string, the expression in the buffer 484 If TAGNAME is a null string, the expression in the buffer
260around or before point is used as the tag name. 485around or before point is used as the tag name.
261 If second arg NEXT is non-nil (interactively, with prefix arg), 486 If second arg NEXT-P is non-nil (interactively, with prefix arg),
262searches for the next tag in the tag table 487searches for the next tag in the tag table
263that matches the tagname used in the previous find-tag. 488that matches the tagname used in the previous find-tag.
264 489
265See documentation of variable tags-file-name." 490See documentation of variable `tags-file-name'."
266 (interactive (if current-prefix-arg 491 (interactive (if current-prefix-arg
267 '(nil t) 492 '(nil t)
268 (find-tag-tag "Find tag other window: "))) 493 (find-tag-tag "Find tag other window: ")))
269 (let ((pop-up-screens t)) 494 (let ((pop-up-frames t))
270 (find-tag tagname next t))) 495 (find-tag-other-window tagname next-p)))
496;;;###autoload (define-key ctl-x-5-map "." 'find-tag-other-frame)
497
271;;;###autoload 498;;;###autoload
272(define-key ctl-x-5-map "." 'find-tag-other-frame) 499(defun find-tag-regexp (regexp &optional next-p other-window)
500 "Find tag (in current tags table) whose name matches REGEXP.
501Select the buffer containing the tag's definition and move point there.
273 502
274(defvar next-file-list nil 503If second arg NEXT-P is non-nil (interactively, with prefix arg), search
275 "List of files for next-file to process.") 504for another tag that matches the last tagname used.
505
506If third arg OTHER-WINDOW is non-nil, select the buffer in another window.
507
508See documentation of variable `tags-file-name'."
509 (interactive (if current-prefix-arg
510 '(nil t)
511 (read-string "Find tag regexp: ")))
512 (funcall (if other-window 'switch-to-buffer-other-window 'switch-to-buffer)
513 (find-tag-noselect regexp next-p t)))
514
515;; Internal tag finding function.
516
517;; PATTERN is a string to pass to second arg SEARCH-FORWARD-FUNC, and to
518;; any member of the function list ORDER (third arg). If ORDER is nil,
519;; use saved state to continue a previous search.
520
521;; Fourth arg MATCHING is a string, an English '-ing' word, to be used in
522;; an error message.
523
524;; Fifth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
525;; point should be moved to the next line.
526
527;; Algorithm is as follows. For each qualifier-func in ORDER, go to
528;; beginning of tags file, and perform inner loop: for each naive match for
529;; PATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using
530;; qualifier-func. If it qualifies, go to the specified line in the
531;; specified source file and return. Qualified matches are remembered to
532;; avoid repetition. State is saved so that the loop can be continued.
533
534(defun find-tag-in-order (pattern search-forward-func order
535 next-line-after-failure-p matching
536 first-search)
537 (let (file ;name of file containing tag
538 tag-info ;where to find the tag in FILE
539 tags-table-file ;name of tags file
540 (first-table t)
541 (tag-order order)
542 goto-func
543 )
544 (save-excursion
545 (or first-search
546 (visit-tags-table-buffer))
547 ;; Get a qualified match.
548 (catch 'qualified-match-found
549 (while (or first-table
550 (visit-tags-table-buffer t))
551
552 (if first-search
553 (setq tag-lines-already-matched nil))
554
555 (if first-table
556 (setq first-table nil)
557 ;; Start at beginning of tags file.
558 (goto-char (point-min)))
559
560 (setq tags-table-file buffer-file-name)
561 (while order
562 (while (funcall search-forward-func pattern nil t)
563 ;; Naive match found. Qualify the match.
564 (and (funcall (car order) pattern)
565 ;; Make sure it is not a previous qualified match.
566 ;; Use of `memq' depends on numbers being eq.
567 (not (memq (save-excursion (beginning-of-line) (point))
568 tag-lines-already-matched))
569 (throw 'qualified-match-found nil))
570 (if next-line-after-failure-p
571 (forward-line 1)))
572 ;; Try the next flavor of match.
573 (setq order (cdr order))
574 (goto-char (point-min)))
575 (setq order tag-order))
576 ;; We throw out on match, so only get here if there were no matches.
577 (error "No %stags %s %s" (if first-search "" "more ")
578 matching pattern))
579
580 ;; Found a tag; extract location info.
581 (beginning-of-line)
582 (setq tag-lines-already-matched (cons (point)
583 tag-lines-already-matched))
584 ;; Expand the filename, using the tags table buffer's default-directory.
585 (setq file (expand-file-name (file-of-tag))
586 tag-info (funcall snarf-tag-function))
587
588 ;; Get the local value in the tags table buffer.
589 (setq goto-func goto-tag-location-function)
590
591 ;; Find the right line in the specified file.
592 (set-buffer (find-file-noselect file))
593 (widen)
594 (push-mark)
595 (funcall goto-func tag-info)
596
597 ;; Give this buffer a local value of tags-file-name.
598 ;; The next time visit-tags-table-buffer is called,
599 ;; it will use the same tags table that found a match in this buffer.
600 (make-local-variable 'tags-file-name)
601 (setq tags-file-name tags-table-file)
602
603 ;; Return the buffer where the tag was found.
604 (current-buffer))))
605
606;; `etags' TAGS file format support.
607
608(defun etags-recognize-tags-table ()
609 (and (eq (char-after 1) ?\f)
610 (message "%s is an `etags' TAGS file" buffer-file-name)
611 (mapcar (function (lambda (elt)
612 (make-local-variable (car elt))
613 (set (car elt) (cdr elt))))
614 '((file-of-tag-function . etags-file-of-tag)
615 (tags-table-files-function . etags-tags-table-files)
616 (tags-completion-table-function . etags-tags-completion-table)
617 (snarf-tag-function . etags-snarf-tag)
618 (goto-tag-location-function . etags-goto-tag-location)
619 (find-tag-regexp-search-function . re-search-forward)
620 (find-tag-regexp-tag-order . (tag-re-match-p))
621 (find-tag-regexp-next-line-after-failuire-p . t)
622 (find-tag-search-function . search-forward)
623 (find-tag-tag-order . (tag-exact-match-p tag-word-match-p
624 tag-any-match-p))
625 (find-tag-next-line-after-failure-p . nil)
626 (list-tags-function . etags-list-tags)
627 (tags-apropos-function . etags-tags-apropos)
628 (tags-included-tables-function . etags-tags-included-tables)
629 (verify-tags-table-function . etags-verify-tags-table)
630 ))))
631
632(defun etags-verify-tags-table ()
633 (= (char-after 1) ?\f))
634
635(defun etags-file-of-tag ()
636 (save-excursion
637 (search-backward "\f\n")
638 (forward-char 2)
639 (buffer-substring (point)
640 (progn (skip-chars-forward "^,") (point)))))
641
642(defun etags-tags-completion-table ()
643 (let ((table (make-vector 511 0)))
644 (save-excursion
645 (goto-char (point-min))
646 (while (search-forward "\177" nil t)
647 ;; Handle multiple \177's on a line.
648 (save-excursion
649 (skip-chars-backward "^-A-Za-z0-9_$\n") ;sym syntax? XXX
650 (or (bolp)
651 (intern (buffer-substring
652 (point)
653 (progn
654 (skip-chars-backward "-A-Za-z0-9_$")
655 ;; ??? New
656 ;; `::' in the middle of a C++ tag.
657 (and (= (preceding-char) ?:)
658 (= (char-after (- (point) 2)) ?:)
659 (progn
660 (backward-char 2)
661 (skip-chars-backward
662 "-A-Za-z0-9_$")))
663 (point)))
664 table)))))
665 table))
666
667(defun etags-snarf-tag ()
668 (let (tag-text startpos)
669 (search-forward "\177")
670 (setq tag-text (buffer-substring (1- (point))
671 (save-excursion (beginning-of-line)
672 (point))))
673 (search-forward ",")
674 (setq startpos (string-to-int (buffer-substring
675 (point)
676 (progn (skip-chars-forward "0-9")
677 (point)))))
678 ;; Leave point on the next line of the tags file.
679 (forward-line 1)
680 (cons tag-text startpos)))
681
682(defun etags-goto-tag-location (tag-info)
683 (let ((startpos (cdr tag-info))
684 ;; This constant is 1/2 the initial search window.
685 ;; There is no sense in making it too small,
686 ;; since just going around the loop once probably
687 ;; costs about as much as searching 2000 chars.
688 (offset 1000)
689 (found nil)
690 (pat (concat "^" (regexp-quote (car tag-info)))))
691 (or startpos
692 (setq startpos (point-min)))
693 (while (and (not found)
694 (progn
695 (goto-char (- startpos offset))
696 (not (bobp))))
697 (setq found
698 (re-search-forward pat (+ startpos offset) t)
699 offset (* 3 offset))) ; expand search window
700 (or found
701 (re-search-forward pat nil t)
702 (error "`%s' not found in %s; time to rerun etags"
703 pat buffer-file-name)))
704 (beginning-of-line))
705
706(defun etags-list-tags (file)
707 (goto-char 1)
708 (if (not (search-forward (concat "\f\n" file ",") nil t))
709 nil
710 (forward-line 1)
711 (while (not (or (eobp) (looking-at "\f")))
712 (princ (buffer-substring (point)
713 (progn (skip-chars-forward "^\177")
714 (point))))
715 (terpri)
716 (forward-line 1))))
717
718(defun etags-tags-apropos (string)
719 (goto-char 1)
720 (while (re-search-forward string nil t)
721 (beginning-of-line)
722 (princ (buffer-substring (point)
723 (progn (skip-chars-forward "^\177")
724 (point))))
725 (terpri)
726 (forward-line 1)))
727
728(defun etags-tags-table-files ()
729 (let ((files nil)
730 beg)
731 (goto-char (point-min))
732 (while (search-forward "\f\n" nil t)
733 (setq beg (point))
734 (skip-chars-forward "^,\n")
735 (or (looking-at ",include$")
736 ;; Expand in the default-directory of the tags table buffer.
737 (setq files (cons (expand-file-name (buffer-substring beg (point)))
738 files))))
739 (nreverse files)))
740
741(defun etags-tags-included-tables ()
742 (let ((files nil)
743 beg)
744 (goto-char (point-min))
745 (while (search-forward "\f\n" nil t)
746 (setq beg (point))
747 (skip-chars-forward "^,\n")
748 (if (looking-at ",include$")
749 ;; Expand in the default-directory of the tags table buffer.
750 (setq files (cons (expand-file-name (buffer-substring beg (point)))
751 files))))
752 (nreverse files)))
753
754;; Empty tags file support.
755
756(defun recognize-empty-tags-table ()
757 (and (zerop (buffer-size))
758 (mapcar (function (lambda (sym)
759 (make-local-variable sym)
760 (set sym (function (lambda (&rest ignore) nil)))))
761 '(tags-table-files-function
762 tags-completion-table-function
763 find-tag-regexp-search-function
764 find-tag-search-function
765 tags-apropos-function
766 tags-included-tables-function))
767 (set (make-local-variable 'verify-tags-table-function)
768 (function (lambda ()
769 (zerop (buffer-size)))))))
770
771;;; Match qualifier functions for tagnames.
772
773;; t if point is at a tag line that matches TAG "exactly".
774;; point should be just after a string that matches TAG.
775(defun tag-exact-match-p (tag)
776 (and (looking-at "[ \t();,]?.*\177")
777 (let ((c (char-after (- (point) (length tag)))))
778 (or (= c ?\n) (= c ?\ ) (= c ?\t)))))
779
780;; t if point is at a tag line that matches TAG as a word.
781;; point should be just after a string that matches TAG.
782(defun tag-word-match-p (tag)
783 (and (looking-at "\\b.*\177")
784 (save-excursion (backward-char (1+ (length tag)))
785 (looking-at "\\b"))))
786
787;; t if point is in a tag line with a tag containing TAG as a substring.
788(defun tag-any-match-p (tag)
789 (looking-at ".*\177"))
276 790
791;; t if point is at a tag line that matches RE as a regexp.
792(defun tag-re-match-p (re)
793 (save-excursion
794 (beginning-of-line)
795 (let ((bol (point)))
796 (and (search-forward "\177" (save-excursion (end-of-line) (point)) t)
797 (re-search-backward re bol t)))))
798
277;;;###autoload 799;;;###autoload
278(defun next-file (&optional initialize) 800(defun next-file (&optional initialize novisit)
279 "Select next file among files in current tag table. 801 "Select next file among files in current tags table.
280Non-nil argument (prefix arg, if interactive) 802Non-nil first argument (prefix arg, if interactive)
281initializes to the beginning of the list of files in the tag table." 803initializes to the beginning of the list of files in the tags table.
804
805Non-nil second argument NOVISIT means use a temporary buffer
806 to save time and avoid uninteresting warnings.
807
808Value is nil if the file was already visited;
809if the file was newly read in, the value is the filename."
282 (interactive "P") 810 (interactive "P")
283 (if initialize 811 (and initialize
284 (setq next-file-list (tag-table-files))) 812 (save-excursion
813 (visit-tags-table-buffer 'reset)
814 (setq next-file-list (tags-table-files))))
285 (or next-file-list 815 (or next-file-list
286 (error "All files processed.")) 816 (save-excursion
287 (find-file (car next-file-list)) 817 ;; When doing (visit-tag-table-buffer t),
288 (setq next-file-list (cdr next-file-list))) 818 ;; the tags table buffer must be current.
819 (if (and (visit-tags-table-buffer 'same)
820 (visit-tags-table-buffer t))
821 (setq next-file-list (tags-table-files))
822 (and novisit
823 (get-buffer " *next-file*")
824 (kill-buffer " *next-file*"))
825 (error "All files processed."))))
826 (let ((new (not (get-file-buffer (car next-file-list)))))
827 (if (not (and new novisit))
828 (set-buffer (find-file-noselect (car next-file-list) novisit))
829 ;; Like find-file, but avoids random warning messages.
830 (set-buffer (get-buffer-create " *next-file*"))
831 (kill-all-local-variables)
832 (erase-buffer)
833 (setq new (car next-file-list))
834 (insert-file-contents new nil))
835 (setq next-file-list (cdr next-file-list))
836 new))
289 837
290(defvar tags-loop-form nil 838(defvar tags-loop-operate nil
291 "Form for tags-loop-continue to eval to process one file. 839 "Form for `tags-loop-continue' to eval to change one file.")
292If it returns nil, it is through with one file; move on to next.") 840
841(defvar tags-loop-scan nil
842 "Form for `tags-loop-continue' to eval to scan one file.
843If it returns non-nil, this file needs processing by evalling
844\`tags-loop-operate'. Otherwise, move on to the next file.")
293 845
294;;;###autoload 846;;;###autoload
295(defun tags-loop-continue (&optional first-time) 847(defun tags-loop-continue (&optional first-time)
296 "Continue last \\[tags-search] or \\[tags-query-replace] command. 848 "Continue last \\[tags-search] or \\[tags-query-replace] command.
297Used noninteractively with non-nil argument 849Used noninteractively with non-nil argument to begin such a command.
298to begin such a command. See variable tags-loop-form." 850Two variables control the processing we do on each file:
851the value of `tags-loop-scan' is a form to be executed on each file
852to see if it is interesting (it returns non-nil if so)
853and `tags-loop-operate' is a form to execute to operate on an interesting file
854If the latter returns non-nil, we exit; otherwise we scan the next file."
299 (interactive) 855 (interactive)
300 (if first-time 856 (let (new
301 (progn (next-file t) 857 (messaged nil))
302 (goto-char (point-min)))) 858 (while
303 (while (not (eval tags-loop-form)) 859 (progn
304 (next-file) 860 ;; Scan files quickly for the first or next interesting one.
305 (message "Scanning file %s..." buffer-file-name) 861 (while (or first-time
306 (goto-char (point-min)))) 862 (save-restriction
307;;;###autoload 863 (widen)
308(define-key esc-map "," 'tags-loop-continue) 864 (not (eval tags-loop-scan))))
865 (setq new (next-file first-time t))
866 ;; If NEW is non-nil, we got a temp buffer,
867 ;; and NEW is the file name.
868 (if (or messaged
869 (and (not first-time)
870 (> baud-rate search-slow-speed)
871 (setq messaged t)))
872 (message "Scanning file %s..." (or new buffer-file-name)))
873 (setq first-time nil)
874 (goto-char (point-min)))
875
876 ;; If we visited it in a temp buffer, visit it now for real.
877 (if new
878 (let ((pos (point)))
879 (erase-buffer)
880 (set-buffer (find-file-noselect new))
881 (widen)
882 (goto-char pos)))
883
884 (switch-to-buffer (current-buffer))
885
886 ;; Now operate on the file.
887 ;; If value is non-nil, continue to scan the next file.
888 (eval tags-loop-operate)))
889 (and messaged
890 (null tags-loop-operate)
891 (message "Scanning file %s...found" buffer-file-name))))
892
893;;;###autoload (define-key esc-map "," 'tags-loop-continue)
309 894
310;;;###autoload 895;;;###autoload
311(defun tags-search (regexp) 896(defun tags-search (regexp)
312 "Search through all files listed in tag table for match for REGEXP. 897 "Search through all files listed in tags table for match for REGEXP.
313Stops when a match is found. 898Stops when a match is found.
314To continue searching for next match, use command \\[tags-loop-continue]. 899To continue searching for next match, use command \\[tags-loop-continue].
315 900
316See documentation of variable tags-file-name." 901See documentation of variable `tags-file-name'."
317 (interactive "sTags search (regexp): ") 902 (interactive "sTags search (regexp): ")
318 (if (and (equal regexp "") 903 (if (and (equal regexp "")
319 (eq (car tags-loop-form) 're-search-forward)) 904 (eq (car tags-loop-scan) 're-search-forward)
905 (eq tags-loop-operate t))
906 ;; Continue last tags-search as if by M-,.
320 (tags-loop-continue nil) 907 (tags-loop-continue nil)
321 (setq tags-loop-form 908 (setq tags-loop-scan
322 (list 're-search-forward regexp nil t)) 909 (list 're-search-forward regexp nil t)
910 tags-loop-operate nil)
323 (tags-loop-continue t))) 911 (tags-loop-continue t)))
324 912
325;;;###autoload 913;;;###autoload
326(defun tags-query-replace (from to &optional delimited) 914(defun tags-query-replace (from to &optional delimited)
327 "Query-replace-regexp FROM with TO through all files listed in tag table. 915 "Query-replace-regexp FROM with TO through all files listed in tags table.
328Third arg DELIMITED (prefix arg) means replace only word-delimited matches. 916Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
329If you exit (C-G or ESC), you can resume the query-replace 917If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
330with the command \\[tags-loop-continue]. 918with the command \\[tags-loop-continue].
331 919
332See documentation of variable tags-file-name." 920See documentation of variable `tags-file-name'."
333 (interactive "sTags query replace (regexp): \nsTags query replace %s by: \nP") 921 (interactive
334 (setq tags-loop-form 922 "sTags query replace (regexp): \nsTags query replace %s by: \nP")
335 (list 'and (list 'save-excursion 923 (setq tags-loop-scan (list 'prog1 (list 're-search-forward from nil t)
336 (list 're-search-forward from nil t)) 924 '(goto-char (point-min))) ;??? XXX
337 (list 'not (list 'perform-replace from to t t 925 tags-loop-operate (list 'perform-replace from to t t delimited))
338 (not (null delimited))))))
339 (tags-loop-continue t)) 926 (tags-loop-continue t))
340 927
341;;;###autoload 928;;;###autoload
342(defun list-tags (string) 929(defun list-tags (file)
343 "Display list of tags in file FILE. 930 "Display list of tags in file FILE.
344FILE should not contain a directory spec 931FILE should not contain a directory specification
345unless it has one in the tag table." 932unless it has one in the tags table."
346 (interactive "sList tags (in file): ") 933 (interactive (list (completing-read "List tags in file: " nil
934 'tags-table-files t nil)))
347 (with-output-to-temp-buffer "*Tags List*" 935 (with-output-to-temp-buffer "*Tags List*"
348 (princ "Tags in file ") 936 (princ "Tags in file ")
349 (princ string) 937 (princ file)
350 (terpri) 938 (terpri)
351 (save-excursion 939 (save-excursion
352 (visit-tags-table-buffer) 940 (let ((first-time t)
353 (goto-char 1) 941 (gotany nil))
354 (search-forward (concat "\f\n" string ",")) 942 (while (visit-tags-table-buffer (if first-time 'reset t))
355 (forward-line 1) 943 (if (funcall list-tags-function file)
356 (while (not (or (eobp) (looking-at "\f"))) 944 (setq gotany t)))
357 (princ (buffer-substring (point) 945 (or gotany
358 (progn (skip-chars-forward "^\177") 946 (error "File %s not in current tags tables"))))))
359 (point))))
360 (terpri)
361 (forward-line 1)))))
362 947
363;;;###autoload 948;;;###autoload
364(defun tags-apropos (string) 949(defun tags-apropos (regexp)
365 "Display list of all tags in tag table REGEXP matches." 950 "Display list of all tags in tags table REGEXP matches."
366 (interactive "sTag apropos (regexp): ") 951 (interactive "sTags apropos (regexp): ")
367 (with-output-to-temp-buffer "*Tags List*" 952 (with-output-to-temp-buffer "*Tags List*"
368 (princ "Tags matching regexp ") 953 (princ "Tags matching regexp ")
369 (prin1 string) 954 (prin1 regexp)
370 (terpri) 955 (terpri)
371 (save-excursion 956 (save-excursion
372 (visit-tags-table-buffer) 957 (let ((first-time nil))
373 (goto-char 1) 958 (while (visit-tags-table-buffer (if first-time 'reset t))
374 (while (re-search-forward string nil t) 959 (funcall tags-apropos-function))))))
375 (beginning-of-line) 960
376 (princ (buffer-substring (point) 961;;; XXX Kludge interface.
377 (progn (skip-chars-forward "^\177")
378 (point))))
379 (terpri)
380 (forward-line 1)))))
381 962
382(provide 'etags) 963;; XXX If a file is in multiple tables, selection may get the wrong one.
964(defun select-tags-table ()
965 "Select a tags table file from a menu of those you have already used.
966The list of tags tables to select from is stored in `tags-table-file-list';
967see the doc of that variable if you want to add names to the list."
968 (interactive)
969 (pop-to-buffer "*Tags Table List*")
970 (setq buffer-read-only nil)
971 (erase-buffer)
972 (setq selective-display t
973 selective-display-ellipses nil)
974 (let ((set-list tags-table-set-list)
975 (desired-point nil))
976 (if tags-table-list
977 (progn
978 (setq desired-point (point-marker))
979 (princ tags-table-list (current-buffer))
980 (insert "\C-m")
981 (prin1 (car tags-table-list) (current-buffer)) ;invisible
982 (insert "\n")))
983 (while set-list
984 (if (eq (car set-list) tags-table-list)
985 ;; Already printed it.
986 ()
987 (princ (car set-list) (current-buffer))
988 (insert "\C-m")
989 (prin1 (car (car set-list)) (current-buffer)) ;invisible
990 (insert "\n"))
991 (setq set-list (cdr set-list)))
992 (if tags-file-name
993 (progn
994 (or desired-point
995 (setq desired-point (point-marker)))
996 (insert tags-file-name "\C-m")
997 (prin1 tags-file-name (current-buffer)) ;invisible
998 (insert "\n")))
999 (setq set-list (delete tags-file-name
1000 (apply 'nconc (cons tags-table-list
1001 (mapcar 'copy-sequence
1002 tags-table-set-list)))))
1003 (while set-list
1004 (insert (car set-list) "\C-m")
1005 (prin1 (car set-list) (current-buffer)) ;invisible
1006 (insert "\n")
1007 (setq set-list (delete (car set-list) set-list)))
1008 (goto-char 1)
1009 (insert-before-markers
1010 "Type `t' to select a tags table or set of tags tables:\n\n")
1011 (if desired-point
1012 (goto-char desired-point))
1013 (set-window-start (selected-window) 1 t))
1014 (set-buffer-modified-p nil)
1015 (setq buffer-read-only t
1016 mode-name "Select Tags Table")
1017 (let ((map (make-sparse-keymap)))
1018 (define-key map "t" 'select-tags-table-select)
1019 (define-key map " " 'next-line)
1020 (define-key map "\^?" 'previous-line)
1021 (define-key map "n" 'next-line)
1022 (define-key map "p" 'previous-line)
1023 (define-key map "q" 'select-tags-table-quit)
1024 (use-local-map map)))
1025
1026(defun select-tags-table-select ()
1027 "Select the tags table named on this line."
1028 (interactive)
1029 (search-forward "\C-m")
1030 (let ((name (read (current-buffer))))
1031 (visit-tags-table name)
1032 (select-tags-table-quit)
1033 (message "Tags table now %s" name)))
383 1034
384;;; etags.el ends here 1035(defun select-tags-table-quit ()
1036 "Kill the buffer and delete the selected window."
1037 (interactive)
1038 (kill-buffer (current-buffer))
1039 (or (one-window-p)
1040 (delete-window)))
1041
1042;;;###autoload
1043(defun complete-tag ()
1044 "Perform tags completion on the text around point.
1045Completes to the set of names listed in the current tags table.
1046The string to complete is chosen in the same way as the default
1047for \\[find-tag] (which see). See also `visit-tags-table-buffer'."
1048 (interactive)
1049 (let ((pattern (funcall (or find-tag-default-function
1050 (get major-mode 'find-tag-default-function)
1051 'find-tag-default)))
1052 beg
1053 completion)
1054 (or pattern
1055 (error "Nothing to complete"))
1056 (search-backward pattern)
1057 (setq beg (point))
1058 (forward-char (length pattern))
1059 (setq completion (try-completion pattern 'tags-complete-tag nil))
1060 (cond ((eq completion t))
1061 ((null completion)
1062 (message "Can't find completion for \"%s\"" pattern)
1063 (ding))
1064 ((not (string= pattern completion))
1065 (delete-region beg (point))
1066 (insert completion))
1067 (t
1068 (message "Making completion list...")
1069 (with-output-to-temp-buffer " *Completions*"
1070 (display-completion-list
1071 (all-completions pattern 'tags-complete-tag nil)))
1072 (message "Making completion list...%s" "done")))))
1073;;;###autoload (define-key esc-map "?" 'complete-tag) ;? XXX
1074
1075(provide 'etags)