1 ;;; etags.el --- etags facility for Emacs
3 ;; Copyright 1985, 1986, 1988, 1990, 1997 Free Software Foundation, Inc.
5 ;; Author: Their Name is Legion (see list below)
6 ;; Maintainer: XEmacs Development Team
9 ;; This file is part of XEmacs.
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
26 ;;; Synched up with: Not synched with FSF.
30 ;; This file is completely different from FSF's etags.el. It appears
31 ;; that an early version of this file (tags.el) has been rewritten by
32 ;; two different people; we got one, FSF got the other. Various
33 ;; people have said that our version is better and faster.
38 ;; Derived from the original lisp/tags.el.
40 ;; Ideas and code from the work of the following people:
41 ;; Andy Norman <ange@hplb.hpl.hp.com>, author of ange-tags.el
42 ;; Ramana Rao <rao@arisia.xerox.com>
43 ;; John Sturdy <jcgs@harlqn.co.uk>, author of tags-helper.el
44 ;; Henry Kautz <kautz@allegra.att.com>, author of tag-completion.el
45 ;; Dan LaLiberte <liberte@cs.uiuc.edu>, author of local-tags.el
46 ;; Tom Dietterich <tgd@turing.cs.orst.edu>, author of quest.el
47 ;; The author(s) of lisp/simple.el
48 ;; Duke Briscoe <briscoe@cs.yale.edu>
49 ;; Lynn Slater <lrs@indetech.com>, author of location.el
50 ;; Shinichirou Sugou <shin@sgtp.apple.juice.or.jp>
51 ;; an unidentified anonymous elisp hacker
52 ;; Kyle Jones <kyle_jones@wonderworks.com>
53 ;; added "Exact match, then inexact" code
54 ;; added support for include directive.
55 ;; Hrvoje Niksic <hniksic@srce.hr>
62 "Etags facility for Emacs.
63 Using etags, you can create tag tables for any number of files, and
64 easily access the symbols in those files, using the `\\[find-tag]'
70 (defcustom tags-build-completion-table 'ask
71 "*If this variable is nil, then tags completion is disabled.
72 If it is t, then things which prompt for tags will do so with completion
73 across all known tags.
74 If it is the symbol `ask', you will be asked whether each tags table
75 should be added to the completion list as it is read in. (With the
76 exception that for very small tags tables, you will not be asked,
77 since they can be parsed quickly.)"
78 :type '(choice (const :tag "Disabled" nil)
79 (const :tag "Complete All" t)
80 (const :tag "Ask" ask))
83 (defcustom tags-always-exact nil
84 "*If this variable is non-nil, then tags always looks for exact matches.
85 If it is nil (the default), tags will first go through exact matches,
86 then through the non-exact ones."
90 (defcustom tag-table-alist nil
91 "*A list which determines which tags files are active for a buffer.
92 This is not really an association list, in that all elements are
93 checked. The CAR of each element of this list is a pattern against
94 which the buffer's file name is compared; if it matches, then the CDR
95 of the list should be the name of the tags table to use. If more than
96 one element of this list matches the buffer's file name, then all of
97 the associated tags tables will be used. Earlier ones will be
100 If the CAR of elements of this list are strings, then they are treated
101 as regular-expressions against which the file is compared (like the
102 auto-mode-alist). If they are not strings, then they are evaluated.
103 If they evaluate to non-nil, then the current buffer is considered to
106 If the CDR of the elements of this list are strings, then they are
107 assumed to name a TAGS file. If they name a directory, then the string
108 \"TAGS\" is appended to them to get the file name. If they are not
109 strings, then they are evaluated, and must return an appropriate string.
112 (setq tag-table-alist
113 '((\"/usr/src/public/perl/\" . \"/usr/src/public/perl/perl-3.0/\")
114 (\"\\\\.el$\" . \"/usr/local/emacs/src/\")
115 (\"/jbw/gnu/\" . \"/usr15/degree/stud/jbw/gnu/\")
116 (\"\" . \"/usr/local/emacs/src/\")
119 This means that anything in the /usr/src/public/perl/ directory should use
120 the TAGS file /usr/src/public/perl/perl-3.0/TAGS; and file ending in .el should
121 use the TAGS file /usr/local/emacs/src/TAGS; and anything in or below the
122 directory /jbw/gnu/ should use the TAGS file /usr15/degree/stud/jbw/gnu/TAGS.
123 A file called something like \"/usr/jbw/foo.el\" would use both the TAGS files
124 /usr/local/emacs/src/TAGS and /usr15/degree/stud/jbw/gnu/TAGS (in that order)
125 because it matches both patterns.
127 If the buffer-local variable `buffer-tag-table' is set, then it names a tags
128 table that is searched before all others when find-tag is executed from this
131 If there is a file called \"TAGS\" in the same directory as the file in
132 question, then that tags file will always be used as well (after the
133 `buffer-tag-table' but before the tables specified by this list.)
135 If the variable tags-file-name is set, then the tags file it names will apply
136 to all buffers (for backwards compatibility.) It is searched first."
137 :type '(repeat (cons :format "%v"
139 (regexp :tag "Buffer regexp")
142 (string :tag "Tag file or directory")
146 (defvar buffer-tag-table nil
147 "*The additional name of one TAGS table to be used for this buffer.
148 You can set this with `\\[set-buffer-tag-table]'. See the documentation
149 for the variable `tag-table-alist' for more information.")
150 (make-variable-buffer-local 'buffer-tag-table)
152 (defvar tags-file-name nil
153 "The name of the tags-table used by all buffers.
154 This is for backwards compatibility, and is largely supplanted by the
155 variable tag-table-alist.")
157 (defcustom tags-auto-read-changed-tag-files nil
158 "*If non-nil, always re-read changed TAGS file without prompting.
159 If nil, prompt whether to re-read the changed TAGS file."
163 (defcustom make-tags-files-invisible nil
164 "*If non-nil, TAGS-files will not show up in buffer-lists or be
165 selectable (or deletable.)"
169 (defcustom tags-search-nuke-uninteresting-buffers t
170 "*If non-nil, keep newly-visited files if they contain the search target.
171 This affects the `tags-search' and `tags-query-replace' commands."
176 ;; Buffer tag tables.
178 (defun buffer-tag-table-list ()
179 "Returns a list (ordered) of the tags tables which should be used for
182 ;; Explicitly set buffer-tag-table
183 (when buffer-tag-table
184 (push buffer-tag-table result))
186 (when (file-readable-p (concat default-directory "TAGS"))
187 (push (concat default-directory "TAGS") result))
189 (let ((parent-tag-file (expand-file-name "../TAGS" default-directory)))
190 (when (file-readable-p parent-tag-file)
191 (push parent-tag-file result)))
193 (let ((key (or buffer-file-name
194 (concat default-directory (buffer-name))))
196 (dolist (item tag-table-alist)
197 (setq expression (car item))
198 ;; If the car of the alist item is a string, apply it as a regexp
199 ;; to the buffer-file-name. Otherwise, evaluate it. If the
200 ;; regexp matches, or the expression evaluates non-nil, then this
201 ;; item in tag-table-alist applies to this buffer.
202 (when (if (stringp expression)
203 (string-match expression key)
206 ;; Now evaluate the cdr of the alist item to get the name of
207 ;; the tag table file.
208 (setq expression (ignore-errors
210 (if (stringp expression)
211 (push expression result)
212 (error "Expression in tag-table-alist evaluated to non-string")))))
216 (when (file-directory-p name)
217 (setq name (concat (file-name-as-directory name) "TAGS")))
218 (and (file-readable-p name)
219 ;; get-tag-table-buffer has side-effects
220 (symbol-value-in-buffer 'buffer-file-name
221 (get-tag-table-buffer name))))
223 (setq result (delq nil result))
224 ;; If no TAGS file has been found, ask the user explicitly.
225 ;; #### tags-file-name is *evil*.
226 (or result tags-file-name
227 (call-interactively 'visit-tags-table))
229 (setq result (nconc result (list tags-file-name))))
230 (or result (error "Buffer has no associated tag tables"))
231 (delete-duplicates (nreverse result) :test 'equal)))
234 (defun visit-tags-table (file)
235 "Tell tags commands to use tags table file FILE when all else fails.
236 FILE should be the name of a file created with the `etags' program.
237 A directory name is ok too; it means file TAGS in that directory."
238 (interactive (list (read-file-name "Visit tags table: (default TAGS) "
240 (expand-file-name "TAGS" default-directory)
242 (if (string-equal file "")
243 (setq tags-file-name nil)
244 (setq file (expand-file-name file))
245 (when (file-directory-p file)
246 (setq file (expand-file-name "TAGS" file)))
247 ;; It used to be that, if a user pressed RET by mistake, the bogus
248 ;; `tags-file-name' would remain, causing the error at
249 ;; `buffer-tag-table'.
250 (when (file-exists-p file)
251 (setq tags-file-name file))))
253 (defun set-buffer-tag-table (file)
254 "In addition to the tags tables specified by the variable `tag-table-alist',
255 each buffer can have one additional table. This command sets that.
256 See the documentation for the variable `tag-table-alist' for more information."
259 (read-file-name "Visit tags table: (directory sufficient) "
260 nil default-directory t)))
261 (or file (error "No TAGS file name supplied"))
262 (setq file (expand-file-name file))
263 (when (file-directory-p file)
264 (setq file (expand-file-name "TAGS" file)))
265 (or (file-exists-p file) (error "TAGS file missing: %s" file))
266 (setq buffer-tag-table file))
269 ;; Manipulating the tag table buffer
271 (defconst tag-table-completion-status nil
272 "Indicates whether a completion table has been built.
273 Either nil, t, or `disabled'.")
274 (make-variable-buffer-local 'tag-table-completion-status)
276 (defconst tag-table-files nil
277 "If the current buffer is a TAGS table, this holds a list of the files
278 referenced by this file, or nil if that hasn't been computed yet.")
279 (make-variable-buffer-local 'tag-table-files)
281 (defun get-tag-table-buffer (tag-table)
282 "Returns a buffer visiting the given TAGS table.
283 If appropriate, reverting the buffer, and possibly build a completion-table."
284 (or (stringp tag-table)
285 (error "Bad tags file name supplied: %s" tag-table))
286 ;; Remove symbolic links from name.
287 (setq tag-table (symlink-expand-file-name tag-table))
288 (let (buf build-completion check-name)
289 (setq buf (get-file-buffer tag-table))
291 (if (file-readable-p tag-table)
292 (setq buf (find-file-noselect tag-table)
294 (error "No such tags file: %s" tag-table)))
295 (with-current-buffer buf
296 ;; Make the TAGS buffer invisible.
297 (when (and check-name
298 make-tags-files-invisible
299 (string-match "\\`[^ ]" (buffer-name)))
300 (rename-buffer (generate-new-buffer-name
301 (concat " " (buffer-name)))))
302 (or (verify-visited-file-modtime buf)
303 (cond ((or tags-auto-read-changed-tag-files
305 (format "Tags file %s has changed, read new contents? "
307 (when tags-auto-read-changed-tag-files
308 (message "Tags file %s has changed, reading new contents..."
311 (when (eq tag-table-completion-status t)
312 (setq tag-table-completion-status nil))
313 (setq tag-table-files nil))))
314 (or (eq (char-after 1) ?\f)
315 (error "File %s not a valid tags file" tag-table))
316 (or (memq tag-table-completion-status '(t disabled))
317 (setq build-completion t))
318 (when build-completion
319 (if (ecase tags-build-completion-table
323 ;; don't bother asking for small ones
324 (or (< (buffer-size) 20000)
326 (format "Build tag completion table for %s? "
328 ;; The user wants to build the table:
331 (add-to-tag-completion-table)
332 (setq tag-table-completion-status t))
333 ;; Allow user to C-g out correctly
335 (message "Tags completion table construction aborted")
336 (setq tag-table-completion-status nil
339 ;; The table is verboten.
340 (setq tag-table-completion-status 'disabled))))
343 (defun file-of-tag ()
344 "Return the file name of the file whose tags point is within.
345 Assumes the tag table is the current buffer.
346 File name returned is relative to tag table file's directory."
347 (let ((opoint (point))
350 (goto-char (point-min))
351 (while (< (point) opoint)
354 (skip-chars-backward "^,\n")
356 size (read (current-buffer)))
359 ;; New include syntax
361 ;; tacked on to the end of a tag file means use filename
362 ;; as a tag file before giving up.
364 (unless (eq size 'include)
365 (forward-char size)))
366 (goto-char (1- prev))
367 (buffer-substring (point) (point-at-bol)))))
369 (defun tag-table-include-files ()
370 "Return all file names associated with `include' directives in a tag buffer."
371 ;; New include syntax
373 ;; tacked on to the end of a tag file means use filename as a
374 ;; tag file before giving up.
377 (goto-char (point-min))
378 (while (re-search-forward "\f\n\\(.*\\),include$" nil t)
379 (push (match-string 1) files)))
382 (defun tag-table-files (tag-table)
383 "Returns a list of the files referenced by the named TAGS table."
384 (with-current-buffer (get-tag-table-buffer tag-table)
385 (unless tag-table-files
386 (let (files prev size)
387 (goto-char (point-min))
391 (skip-chars-backward "^,\n")
393 size (read (current-buffer)))
395 (push (expand-file-name (buffer-substring (1- (point))
401 (setq tag-table-files (nreverse files))))
404 ;; #### should this be on previous page?
405 (defun buffer-tag-table-files ()
406 "Returns a list of all files referenced by all TAGS tables that
409 (mapcar #'tag-table-files (buffer-tag-table-list))))
412 ;; Building the completion table
414 ;; Test cases for building completion table; must handle these properly:
415 ;; Lisp_Int, XSETINT, current_column
\7f60,2282
416 ;; Lisp_Int, XSETINT, point>NumCharacters ? 0 : CharAt(
\7f363,9935
417 ;; Lisp_Int, XSETINT, point<=FirstCharacter ? 0 : CharAt(
\7f366,10108
418 ;; point<=FirstCharacter || CharAt(
\7f378,10630
419 ;; point>NumCharacters || CharAt(
\7f382,10825
420 ;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,
\7f191,4562
421 ;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,
\7f191,4562
422 ;; DEFUN ("*", Ftimes,
\7f1172,32079
423 ;; DEFUN ("/=", Fneq,
\7f1035,28839
424 ;; defun_internal
\7f4199,101362
425 ;; int pure[PURESIZE / sizeof
\7f53,1564
426 ;; char staticvec1[NSTATICS * sizeof
\7f667,17608
427 ;; Date: 04 May 87 23:53:11 PDT
\7f26,1077
428 ;; #define anymacroname(
\7f324,4344
429 ;; (define-key ctl-x-map
\7f311,11784
430 ;; (define-abbrev-table 'c-mode-abbrev-table
\7f24,1016
431 ;; static char *skip_white(
\7f116,3443
432 ;; static foo
\7f348,11643
433 ;; (defun texinfo-insert-@code
\7f91,3358
434 ;; (defvar texinfo-kindex)
\7f29,1105
435 ;; (defun texinfo-format-\.
\7f548,18376
436 ;; (defvar sm::menu-kludge-y
\7f621,22726
437 ;; (defvar *mouse-drag-window*
\7f103,3642
438 ;; (defun simula-back-level(
\7f317,11263
439 ;; } DPxAC,
\7f380,14024
440 ;; } BM_QCB;
\7f69,2990
441 ;; #define MTOS_DONE\t
443 ;; "^[^ ]+ +\\([^ ]+\\) "
445 ;; void *find_cactus_segment(
\7f116,2444
446 ;; void *find_pdb_segment(
\7f162,3688
447 ;; void init_dclpool(
\7f410,10739
448 ;; WORD insert_draw_command(
\7f342,8881
449 ;; void *req_pdbmem(
\7f579,15574
451 (defvar tag-completion-table (make-vector 511 0))
454 (defvar tag-table-symbol)
455 (defvar tag-symbol-tables)
456 (defvar buffer-tag-table-list)
458 (defmacro intern-tag-symbol (tag)
460 (setq tag-symbol (intern ,tag tag-completion-table)
461 tag-symbol-tables (and (boundp tag-symbol)
462 (symbol-value tag-symbol)))
463 (or (memq tag-table-symbol tag-symbol-tables)
464 (set tag-symbol (cons tag-table-symbol tag-symbol-tables)))))
466 ;; Can't use "\\s " in these patterns because that will include newline
467 (defconst tags-DEFUN-pattern
468 "DEFUN[ \t]*(\"\\([^\"]+\\)\",[ \t]*\\(\\(\\sw\\|\\s_\\)+\\),\C-?")
469 (defconst tags-array-pattern ".*[ \t]+\\([^ \[]+\\)\\[")
470 (defconst tags-def-pattern
471 "\\(.*[ \t]+\\)?\\**\\(\\(\\sw\\|\\s_\\)+\\)[ ();,\t]*\C-?"
472 ;; "\\(.*[ \t]+\\)?\\(\\(\\sw\\|\\s_\\)+\\)[ ()]*\C-?"
473 ;; "\\(\\sw\\|\\s_\\)+[ ()]*\C-?"
475 (defconst tags-file-pattern "^\f\n\\(.+\\),[0-9]+\n")
477 ;; #### Should make it work with the `include' directive!
478 (defun add-to-tag-completion-table ()
479 "Sucks the current buffer (a TAGS table) into the completion-table."
480 (message "Adding %s to tags completion table..." buffer-file-name)
481 (goto-char (point-min))
482 (let ((tag-table-symbol (intern buffer-file-name tag-completion-table))
483 ;; tag-table-symbol is used by intern-tag-symbol
484 filename file-type name name2 tag-symbol
486 (case-fold-search nil))
487 ;; Loop over the files mentioned in the TAGS file for each file,
488 ;; try to find its major-mode, then process tags appropriately.
489 (while (looking-at tags-file-pattern)
490 (goto-char (match-end 0))
491 (setq filename (file-name-sans-versions (match-string 1))
492 ;; We used to check auto-mode-alist for the proper
493 ;; file-type. This was way too slow, as it had to process
494 ;; an enormous amount of regexps for each time. Now we
495 ;; use the shotgun approach with only two regexps.
496 file-type (cond ((string-match "\\.\\([cC]\\|cc\\|cxx\\)\\'"
499 ((string-match "\\.\\(el\\|cl\\|lisp\\)\\'"
502 ((string-match "\\.scm\\'" filename)
505 (set-syntax-table (cond ((and (eq file-type 'c-mode)
508 ((eq file-type 'lisp-mode)
509 lisp-mode-syntax-table)
510 (t (standard-syntax-table))))
511 ;; Clear loop variables.
512 (setq name nil name2 nil)
513 (lmessage 'progress "%s..." filename)
514 ;; Loop over the individual tag lines.
515 (while (not (or (eobp) (eq (char-after) ?\f)))
516 (cond ((and (eq file-type 'c-mode)
517 (looking-at "DEFUN[ \t]"))
519 (or (looking-at tags-DEFUN-pattern)
520 (error "DEFUN doesn't fit pattern"))
521 (setq name (match-string 1)
522 name2 (match-string 2)))
523 ;;((looking-at "\\s ")
524 ;; skip probably bogus entry:
526 ((and (eq file-type 'c-mode)
527 (looking-at ".*\\["))
529 (cond ((not (looking-at tags-array-pattern))
530 (message "array definition doesn't fit pattern")
533 (setq name (match-string 1)))))
534 ((and (eq file-type 'scheme-mode)
535 (looking-at "\\s-*(\\s-*def\\sw*\\s-*(?\\s-*\\(\\(\\sw\\|\\s_\\|:\\)+\\))?\\s-*\C-?"))
536 ;; Something Schemish (is this really necessary??)
537 (setq name (match-string 1)))
538 ((looking-at tags-def-pattern)
540 (setq name (match-string 2))))
541 ;; add the tags we found to the completion table
542 (and name (intern-tag-symbol name))
543 (and name2 (intern-tag-symbol name2))
545 (or (eobp) (error "Bad TAGS file")))
546 (message "Adding %s to tags completion table...done" buffer-file-name))
549 ;; Interactive find-tag
551 (defvar find-tag-default-hook nil
552 "Function to call to create a default tag.
553 Make it buffer-local in a mode hook. The function is called with no
556 (defvar find-tag-hook nil
557 "*Function to call after a tag is found.
558 Make it buffer-local in a mode hook. The function is called with no
561 ;; Return a default tag to search for, based on the text at point.
562 (defun find-tag-default ()
563 (or (and (not (memq find-tag-default-hook '(nil find-tag-default)))
565 (funcall find-tag-default-hook)
567 (warn "Error in find-tag-default-hook signalled error: %s"
568 (error-message-string data))
570 (symbol-near-point)))
572 ;; This function depends on the following symbols being bound properly:
573 ;; buffer-tag-table-list,
574 ;; tag-symbol-tables (value irrelevant, bound outside for efficiency)
575 (defun tag-completion-predicate (tag-symbol)
576 (and (boundp tag-symbol)
577 (setq tag-symbol-tables (symbol-value tag-symbol))
579 (while tag-symbol-tables
580 (when (memq (car tag-symbol-tables) buffer-tag-table-list)
582 (setq tag-symbol-tables (cdr tag-symbol-tables))))))
584 (defun buffer-tag-table-symbol-list ()
585 (mapcar (lambda (table-name)
586 (intern table-name tag-completion-table))
587 (buffer-tag-table-list)))
589 (defvar find-tag-history nil "History list for find-tag-tag.")
591 (defun find-tag-tag (prompt)
592 (let* ((default (find-tag-default))
593 (buffer-tag-table-list (buffer-tag-table-symbol-list))
594 tag-symbol-tables tag-name)
598 (format "%s(default %s) " prompt default)
600 tag-completion-table 'tag-completion-predicate nil nil
602 (if (string-equal tag-name "")
603 ;; #### - This is a really LAME way of doing it! --Stig
604 default ;indicate exact symbol match
607 (defvar last-tag-data nil
608 "Information for continuing a tag search.
609 Is of the form (TAG POINT MATCHING-EXACT TAG-TABLE TAG-TABLE ...).")
611 (defvar tags-loop-operate nil
612 "Form for `tags-loop-continue' to eval to change one file.")
614 (defvar tags-loop-scan
615 '(error "%s" (substitute-command-keys
616 "No \\[tags-search] or \\[tags-query-replace] in progress."))
617 "Form for `tags-loop-continue' to eval to scan one file.
618 If it returns non-nil, this file needs processing by evalling
619 \`tags-loop-operate'. Otherwise, move on to the next file.")
621 (autoload 'get-symbol-syntax-table "symbol-syntax")
623 (defun find-tag-internal (tagname)
624 (let ((next (null tagname))
625 (tmpnext (null tagname))
626 ;; If tagname is a list: (TAGNAME), this indicates
627 ;; requiring an exact symbol match.
628 (exact (or tags-always-exact (consp tagname)))
629 (normal-syntax-table (syntax-table))
630 (exact-syntax-table (get-symbol-syntax-table (syntax-table)))
631 tag-table-currently-matching-exact
632 tag-target exact-tagname
633 tag-tables tag-table-point file linebeg startpos buf
634 offset found pat syn-tab)
635 (when (consp tagname)
636 (setq tagname (car tagname)))
638 (setq tagname (car last-tag-data))
639 (setq tag-table-currently-matching-exact
640 (car (cdr (cdr last-tag-data)))))
642 (setq tag-table-currently-matching-exact t)))
643 ;; \_ in the tagname is used to indicate a symbol boundary.
644 (setq exact-tagname (concat "\\_" tagname "\\_"))
645 (while (string-match "\\\\_" exact-tagname)
646 (aset exact-tagname (1- (match-end 0)) ?b))
649 ;; Loop searching for exact matches and then inexact matches.
650 (while (not (eq tag-table-currently-matching-exact 'neither))
652 (setq tag-tables (cdr (cdr (cdr last-tag-data)))
653 tag-table-point (car (cdr last-tag-data)))
654 ;; Start from the beginning of the table list on the
655 ;; next iteration of the loop.
658 (setq tag-tables (buffer-tag-table-list)
660 (if tag-table-currently-matching-exact
661 (setq tag-target exact-tagname
662 syn-tab exact-syntax-table)
663 (setq tag-target tagname
664 syn-tab normal-syntax-table))
665 (with-search-caps-disable-folding tag-target t
667 (set-buffer (get-tag-table-buffer (car tag-tables)))
668 (bury-buffer (current-buffer))
669 (goto-char (or tag-table-point (point-min)))
670 (setq tag-table-point nil)
671 (letf (((syntax-table) syn-tab)
672 (case-fold-search nil))
673 ;; #### should there be support for non-regexp
675 (while (re-search-forward tag-target nil t)
676 (and (save-match-data
677 (looking-at "[^\n\C-?]*\C-?"))
678 ;; If we're looking for inexact matches, skip
679 ;; exact matches since we've visited them
681 (or tag-table-currently-matching-exact
682 (letf (((syntax-table) exact-syntax-table))
684 (goto-char (match-beginning 0))
685 (not (looking-at exact-tagname)))))
688 (nconc (tag-table-include-files) (cdr tag-tables)))))
689 (if (and (not exact) (eq tag-table-currently-matching-exact t))
690 (setq tag-table-currently-matching-exact nil)
691 (setq tag-table-currently-matching-exact 'neither)))
692 (error "No %sentries %s %s"
694 (if exact "matching" "containing")
696 (search-forward "\C-?")
697 (setq file (expand-file-name (file-of-tag)
698 ;; In XEmacs, this needs to be
700 (or (file-name-directory (car tag-tables))
702 (setq linebeg (buffer-substring (1- (point)) (point-at-bol)))
704 (setq startpos (read (current-buffer)))
706 (nconc (list tagname (point) tag-table-currently-matching-exact)
708 (setq buf (find-file-noselect file))
709 (with-current-buffer buf
713 ;; Here we search for PAT in the range [STARTPOS - OFFSET,
714 ;; STARTPOS + OFFSET], with increasing values of OFFSET.
716 ;; We used to set the initial offset to 1000, but the
717 ;; actual sources show that finer-grained control is
718 ;; needed (e.g. two `hash_string's in src/symbols.c.) So,
719 ;; I changed 100 to 100, and (* 3 offset) to (* 5 offset).
721 (setq pat (concat "^" (regexp-quote linebeg)))
722 (or startpos (setq startpos (point-min)))
723 (while (and (not found)
725 (goto-char (- startpos offset))
727 (setq found (re-search-forward pat (+ startpos offset) t))
728 (setq offset (* 5 offset)))
729 ;; Finally, try finding it anywhere in the buffer.
731 (re-search-forward pat nil t)
732 (error "%s not found in %s" pat file))
734 (setq startpos (point)))))
735 (cons buf startpos))))
738 (defun find-tag (tagname &optional other-window)
739 "*Find tag whose name contains TAGNAME.
740 Selects the buffer that the tag is contained in
741 and puts point at its definition.
742 If TAGNAME is a null string, the expression in the buffer
743 around or before point is used as the tag name.
744 If called interactively with a numeric argument, searches for the next tag
745 in the tag table that matches the tagname used in the previous find-tag.
746 If second arg OTHER-WINDOW is non-nil, uses another window to display
749 This version of this function supports multiple active tags tables,
754 tag-table-alist controls which tables apply to which buffers
755 tags-file-name a default tags table
756 tags-build-completion-table controls completion behavior
757 buffer-tag-table another way of specifying a buffer-local table
758 make-tags-files-invisible whether tags tables should be very hidden
759 tag-mark-stack-max how many tags-based hops to remember"
760 (interactive (if current-prefix-arg
762 (list (find-tag-tag "Find tag: ") nil)))
763 (let* ((local-find-tag-hook find-tag-hook)
764 (next (null tagname))
765 (result (find-tag-internal tagname))
766 (tag-buf (car result))
767 (tag-point (cdr result)))
768 ;; Push old position on the tags mark stack.
770 (not (memq last-command
771 '(find-tag find-tag-other-window tags-loop-continue))))
774 (pop-to-buffer tag-buf)
775 (switch-to-buffer tag-buf))
778 (goto-char tag-point)
780 (run-hooks 'find-tag-hook)
781 (if local-find-tag-hook
782 (run-hooks 'local-find-tag-hook))))
783 (setq tags-loop-scan (list 'find-tag nil nil)
784 tags-loop-operate nil)
785 ;; Return t in case used as the tags-loop-scan.
789 (defun find-tag-other-window (tagname &optional next)
790 "*Find tag whose name contains TAGNAME.
791 Selects the buffer that the tag is contained in in another window
792 and puts point at its definition.
793 If TAGNAME is a null string, the expression in the buffer
794 around or before point is used as the tag name.
795 If second arg NEXT is non-nil (interactively, with prefix arg),
796 searches for the next tag in the tag table
797 that matches the tagname used in the previous find-tag.
799 This version of this function supports multiple active tags tables,
804 tag-table-alist controls which tables apply to which buffers
805 tags-file-name a default tags table
806 tags-build-completion-table controls completion behavior
807 buffer-tag-table another way of specifying a buffer-local table
808 make-tags-files-invisible whether tags tables should be very hidden
809 tag-mark-stack-max how many tags-based hops to remember"
810 (interactive (if current-prefix-arg
812 (list (find-tag-tag "Find tag other window: "))))
815 (find-tag tagname t)))
818 ;; Completion on tags in the buffer.
820 (defun complete-symbol (&optional table predicate prettify)
824 ;;(while (= (char-syntax (following-char)) ?\')
826 (skip-syntax-forward "'")
828 (pattern (buffer-substring beg end))
829 (table (or table obarray))
830 (completion (try-completion pattern table predicate)))
831 (cond ((eq completion t))
833 (error "Can't find completion for \"%s\"" pattern))
834 ((not (string-equal pattern completion))
835 (delete-region beg end)
838 (message "Making completion list...")
839 (let ((list (all-completions pattern table predicate)))
841 (setq list (funcall prettify list)))
842 (with-output-to-temp-buffer "*Help*"
843 (display-completion-list list)))
844 (message "Making completion list...%s" "done")))))
847 (defun tag-complete-symbol ()
848 "The function used to do tags-completion (using 'tag-completion-predicate)."
850 (let* ((buffer-tag-table-list (buffer-tag-table-symbol-list))
852 (complete-symbol tag-completion-table 'tag-completion-predicate)))
855 ;; Applying a command to files mentioned in tag tables
857 (defvar next-file-list nil
858 "List of files for next-file to process.")
861 (defun next-file (&optional initialize novisit)
862 "Select next file among files in current tag table(s).
864 A first argument of t (prefix arg, if interactive) initializes to the
865 beginning of the list of files in the (first) tags table. If the argument
866 is neither nil nor t, it is evalled to initialize the list of files.
868 Non-nil second argument NOVISIT means use a temporary buffer
869 to save time and avoid uninteresting warnings.
871 Value is nil if the file was already visited;
872 if the file was newly read in, the value is the filename."
874 (cond ((not initialize)
875 ;; Not the first run.
878 ;; Initialize the list from the tags table.
879 (setq next-file-list (buffer-tag-table-files)))
881 ;; Initialize the list by evalling the argument.
882 (setq next-file-list (eval initialize))))
883 (when (null next-file-list)
885 (get-buffer " *next-file*")
886 (kill-buffer " *next-file*"))
887 (error "All files processed"))
888 (let* ((file (car next-file-list))
889 (buf (get-file-buffer file))
893 (if (not (and new novisit))
894 (switch-to-buffer (find-file-noselect file novisit) t)
895 ;; Like find-file, but avoids random junk.
896 (set-buffer (get-buffer-create " *next-file*"))
897 (kill-all-local-variables)
899 (insert-file-contents file nil))
901 (when (> (point) (point-min))
903 (goto-char (point-min)))
907 (defun tags-loop-continue (&optional first-time)
908 "Continue last \\[tags-search] or \\[tags-query-replace] command.
909 Used noninteractively with non-nil argument to begin such a command (the
910 argument is passed to `next-file', which see).
911 Two variables control the processing we do on each file:
912 the value of `tags-loop-scan' is a form to be executed on each file
913 to see if it is interesting (it returns non-nil if so)
914 and `tags-loop-operate' is a form to execute to operate on an interesting file
915 If the latter returns non-nil, we exit; otherwise we scan the next file."
921 ;; Scan files quickly for the first or next interesting one.
922 (while (or first-time
925 (not (eval tags-loop-scan))))
926 (setq new (next-file first-time
927 tags-search-nuke-uninteresting-buffers))
928 ;; If NEW is non-nil, we got a temp buffer,
929 ;; and NEW is the file name.
931 (and (not first-time)
932 (> (device-baud-rate) search-slow-speed)
935 "Scanning file %s..." (or new buffer-file-name)))
936 (setq first-time nil)
937 (goto-char (point-min)))
939 ;; If we visited it in a temp buffer, visit it now for real.
940 (if (and new tags-search-nuke-uninteresting-buffers)
943 (set-buffer (find-file-noselect new))
947 (switch-to-buffer (current-buffer))
949 ;; Now operate on the file.
950 ;; If value is non-nil, continue to scan the next file.
951 (setq more-files-p (eval tags-loop-operate)))
953 (null tags-loop-operate)
954 (message "Scanning file %s...found" buffer-file-name))))
958 (defun tags-search (regexp &optional file-list-form)
959 "Search through all files listed in tags table for match for REGEXP.
960 Stops when a match is found.
961 To continue searching for next match, use command \\[tags-loop-continue].
963 See documentation of variable `tag-table-alist'."
964 (interactive "sTags search (regexp): ")
965 (if (and (equal regexp "")
966 (eq (car tags-loop-scan) 'with-search-caps-disable-folding)
967 (null tags-loop-operate))
968 ;; Continue last tags-search as if by `M-,'.
969 (tags-loop-continue nil)
970 (setq tags-loop-scan `(with-search-caps-disable-folding ,regexp t
971 (re-search-forward ,regexp nil t))
972 tags-loop-operate nil)
973 (tags-loop-continue (or file-list-form t))))
976 (defun tags-query-replace (from to &optional delimited file-list-form)
977 "Query-replace-regexp FROM with TO through all files listed in tags table.
978 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
979 If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
980 with the command \\[tags-loop-continue].
982 See documentation of variable `tag-table-alist'."
984 "sTags query replace (regexp): \nsTags query replace %s by: \nP")
985 (setq tags-loop-scan `(with-search-caps-disable-folding ,from t
986 (if (re-search-forward ,from nil t)
987 ;; When we find a match, move back
988 ;; to the beginning of it so perform-replace
990 (progn (goto-char (match-beginning 0)) t)))
991 tags-loop-operate (list 'perform-replace from to t t
992 (not (null delimited))))
993 (tags-loop-continue (or file-list-form t)))
998 (defun list-tags (file)
999 "Display list of tags in FILE."
1000 (interactive (list (read-file-name
1001 (if (buffer-file-name)
1002 (format "List tags (in file, %s by default): "
1003 (file-name-nondirectory (buffer-file-name)))
1004 "List tags (in file): ")
1005 nil (buffer-file-name) t)))
1006 (find-file-noselect file)
1007 (with-output-to-temp-buffer "*Tags List*"
1008 (princ "Tags in file ")
1012 (dolist (tags-file (with-current-buffer (get-file-buffer file)
1013 (buffer-tag-table-list)))
1014 ;; We don't want completions getting in the way.
1015 (let ((tags-build-completion-table nil))
1016 (set-buffer (get-tag-table-buffer tags-file)))
1017 (goto-char (point-min))
1019 (search-forward (concat "\f\n" (file-name-nondirectory file) ",")
1022 (while (not (or (eobp) (looking-at "\f")))
1023 (princ (buffer-substring (point)
1024 (progn (skip-chars-forward "^\C-?")
1027 (forward-line 1)))))))
1030 (defun tags-apropos (string)
1031 "Display list of all tags in tag table REGEXP matches."
1032 (interactive "sTag apropos (regexp): ")
1033 (with-output-to-temp-buffer "*Tags List*"
1034 (princ "Tags matching regexp ")
1038 (visit-tags-table-buffer)
1040 (while (re-search-forward string nil t)
1042 (princ (buffer-substring (point)
1043 (progn (skip-chars-forward "^\C-?")
1046 (forward-line 1)))))
1048 ;; #### copied from tags.el. This function is *very* big in FSF.
1049 (defun visit-tags-table-buffer ()
1050 "Select the buffer containing the current tag table."
1052 (call-interactively 'visit-tags-table))
1053 (set-buffer (or (get-file-buffer tags-file-name)
1055 (setq tag-table-files nil)
1056 (find-file-noselect tags-file-name))))
1057 (or (verify-visited-file-modtime (get-file-buffer tags-file-name))
1058 (cond ((yes-or-no-p "Tags file has changed, read new contents? ")
1060 (setq tag-table-files nil))))
1061 (or (eq (char-after 1) ?\^L)
1062 (error "File %s not a valid tag table" tags-file-name)))
1065 ;; Sample uses of find-tag-hook and find-tag-default-hook
1067 ;; This is wrong. We should either make this behaviour default and
1068 ;; back it up, or not use it at all. For now, I've commented it out.
1071 ;; Example buffer-local tag finding
1073 ;(add-hook 'emacs-lisp-mode-hook 'setup-emacs-lisp-default-tag-hook)
1075 ;(defun setup-emacs-lisp-default-tag-hook ()
1076 ; (cond ((eq major-mode 'emacs-lisp-mode)
1077 ; (make-variable-buffer-local 'find-tag-default-hook)
1078 ; (setq find-tag-default-hook 'emacs-lisp-default-tag))))
1079 ;;; Run it once immediately
1080 ;(setup-emacs-lisp-default-tag-hook)
1081 ;(when (get-buffer "*scratch*")
1082 ; (with-current-buffer "*scratch*"
1083 ; (setup-emacs-lisp-default-tag-hook)))
1085 ;(defun emacs-lisp-default-tag ()
1086 ; "Function to return a default tag for Emacs-Lisp mode."
1087 ; (let ((tag (or (variable-at-point)
1088 ; (function-at-point))))
1089 ; (if tag (symbol-name tag))))
1092 ;; Display short info on tag in minibuffer
1094 ;; Don't pollute `M-?' -- we may need it for more important stuff. --hniksic
1095 ;(if (null (lookup-key esc-map "?"))
1096 ; (define-key esc-map "?" 'display-tag-info))
1098 (defun display-tag-info (tagname)
1099 "Prints a description of the first tag matching TAGNAME in the echo area.
1100 If this is an elisp function, prints something like \"(defun foo (x y z)\".
1101 That is, is prints the first line of the definition of the form.
1102 If this is a C-defined elisp function, it does something more clever."
1103 (interactive (if current-prefix-arg
1105 (list (find-tag-tag "Display tag info: "))))
1106 (let* ((results (find-tag-internal tagname))
1107 (tag-buf (car results))
1108 (tag-point (cdr results))
1109 info lname min max fname args)
1110 (with-current-buffer tag-buf
1114 (goto-char tag-point)
1115 (cond ((let ((case-fold-search nil))
1116 (looking-at "^DEFUN[ \t]"))
1119 (setq lname (read (current-buffer))
1120 fname (buffer-substring
1121 (progn (forward-sexp 1) (point))
1122 (progn (backward-sexp 1) (point)))
1123 min (buffer-substring
1124 (progn (forward-sexp 3) (point))
1125 (progn (backward-sexp 1) (point)))
1126 max (buffer-substring
1127 (progn (forward-sexp 2) (point))
1128 (progn (backward-sexp 1) (point))))
1129 (backward-up-list 1)
1130 (setq args (buffer-substring
1131 (progn (forward-sexp 2) (point))
1132 (progn (backward-sexp 1) (point))))
1133 (setq info (format "Elisp: %s, C: %s %s, #args: %s"
1136 (if (string-equal min max)
1138 (format "from %s to %s" min max)))))
1142 (progn (beginning-of-line) (point))
1143 (progn (end-of-line) (point)))))))))
1144 (message "%s" info))
1145 (setq tags-loop-scan '(display-tag-info nil)
1146 tags-loop-operate nil)
1147 ;; Always return non-nil
1153 (defvar tag-mark-stack1 nil)
1154 (defvar tag-mark-stack2 nil)
1156 (defcustom tag-mark-stack-max 16
1157 "*The maximum number of elements kept on the mark-stack used
1158 by tags-search. See also the commands `\\[push-tag-mark]' and
1159 and `\\[pop-tag-mark]'."
1163 (defun push-mark-on-stack (stack-symbol &optional max-size)
1164 (let ((stack (symbol-value stack-symbol)))
1165 (push (point-marker) stack)
1166 (cond ((and max-size
1167 (> (length stack) max-size))
1168 (set-marker (car (nthcdr max-size stack)) nil)
1169 (setcdr (nthcdr (1- max-size) stack) nil)))
1170 (set stack-symbol stack)))
1172 (defun pop-mark-from-stack (stack-symbol1 stack-symbol2 &optional max-size)
1173 (let* ((stack (or (symbol-value stack-symbol1)
1174 (error "No more tag marks on stack")))
1175 (marker (car stack))
1176 (m-buf (marker-buffer marker)))
1177 (set stack-symbol1 (cdr stack))
1179 (error "Marker has no buffer"))
1180 (or (buffer-live-p m-buf)
1181 (error "Buffer has been killed"))
1182 (push-mark-on-stack stack-symbol2 max-size)
1183 (switch-to-buffer m-buf)
1185 (goto-char marker)))
1187 (defun push-tag-mark ()
1188 (push-mark-on-stack 'tag-mark-stack1 tag-mark-stack-max))
1190 ;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
1192 (defun pop-tag-mark (arg)
1193 "Go to last tag position.
1194 `find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack.
1195 This function pops (and moves to) the tag at the top of this stack."
1198 (pop-mark-from-stack
1199 'tag-mark-stack1 'tag-mark-stack2 tag-mark-stack-max)
1200 (pop-mark-from-stack
1201 'tag-mark-stack2 'tag-mark-stack1 tag-mark-stack-max)))