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