cgit.sxemacs.org Git - sxemacs/blob - lisp/etags.el

   1 ;;; etags.el --- etags facility for Emacs
   2
   3 ;; Copyright 1985, 1986, 1988, 1990, 1997, 2003 Free Software Foundation, Inc.
   4
   5 ;; Author: Their Name is Legion (see list below)
   6 ;; Maintainer: SXEmacs Development Team
   7 ;; Keywords: tools
   8
   9 ;; This file is part of SXEmacs.
  10
  11 ;; SXEmacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; SXEmacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Synched up with: XEmacs 21.5.27 (+CVS-20061118) and then immediately
  25 ;;; diverged from it. :-) --SY.
  26
  27 ;;; Commentary:
  28
  29 ;; This file is completely different from FSF's etags.el.  It appears
  30 ;; that an early version of this file (tags.el) has been rewritten by
  31 ;; two different people; we got one, FSF got the other.  Various
  32 ;; people have said that our version is better and faster.
  33
  34 ;; TODO:
  35 ;; - DOCUMENT!
  36
  37 ;; Derived from the original lisp/tags.el.
  38
  39 ;; Ideas and code from the work of the following people:
  40 ;; Andy Norman <ange@hplb.hpl.hp.com>, author of ange-tags.el
  41 ;; Ramana Rao <rao@arisia.xerox.com>
  42 ;; John Sturdy <jcgs@harlqn.co.uk>, author of tags-helper.el
  43 ;; Henry Kautz <kautz@allegra.att.com>, author of tag-completion.el
  44 ;; Dan LaLiberte <liberte@cs.uiuc.edu>, author of local-tags.el
  45 ;; Tom Dietterich <tgd@turing.cs.orst.edu>, author of quest.el
  46 ;; The author(s) of lisp/simple.el
  47 ;; Duke Briscoe <briscoe@cs.yale.edu>
  48 ;; Lynn Slater <lrs@indetech.com>, author of location.el
  49 ;; Shinichirou Sugou <shin@sgtp.apple.juice.or.jp>
  50 ;; an unidentified anonymous elisp hacker
  51 ;; Kyle Jones <kyle_jones@wonderworks.com>
  52 ;;   added "Exact match, then inexact" code
  53 ;;   added support for include directive.
  54 ;; Hrvoje Niksic <hniksic@xemacs.org>
  55 ;;   various changes.
  56 ;; Steve Youngs <steve@sxemacs.org>
  57 ;;   fix support for include directive
  58
  59 ;;; Code:
  60 ;; Can we use the lightning fast cl-loop DSO?
  61 (eval-and-compile
  62   (ignore-errors (require 'cl-loop))
  63   (if (featurep 'cl-loop)
  64       (progn
  65         (fset #'tag-loop #'cl:loop)
  66         (put 'tag-loop 'byte-compile 'byte-compile-cl:loop)
  67         (put 'tag-loop 'lisp-indent-hook 'defun)
  68         (put 'tag-loop 'lisp-indent-function 'defun)
  69         (fset #'tag-dolist #'cl:dolist)
  70         (put 'tag-dolist 'byte-compile 'byte-compile-cl:dolist)
  71         (put 'tag-dolist 'lisp-indent-hook 1)
  72         (put 'tag-dolist 'lisp-indent-function 1)
  73         (globally-declare-boundp
  74          '(key expression inc-files tables)))
  75     (fset #'tag-loop #'loop)
  76     (fset #'tag-dolist #'dolist)))
  77
  78 \f
  79 ;;; User variables.
  80
  81 (defgroup etags nil
  82   "Etags facility for Emacs.
  83
  84 This lib provides some useful tools for working with TAGS tables
  85 that were created with the etags binary \(also distributed with this
  86 emacs\)."
  87   :prefix "tags-"
  88   :group 'tools)
  89
  90 (defcustom tags-build-completion-table t
  91   "*When non-nil, build a completion table from all known tags.
  92 Otherwise disable tag completion."
  93   :type 'boolean
  94   :group 'etags)
  95
  96 (defcustom tags-always-exact nil
  97   "*If this variable is non-nil, then tags always looks for exact matches.
  98 If it is nil (the default), tags will first go through exact matches,
  99 then through the non-exact ones."
 100   :type 'boolean
 101   :group 'etags)
 102
 103 (defcustom tag-table-alist nil
 104   "*A list which determines which tags files are active for a buffer.
 105 This is not really an association list, in that all elements are
 106 checked.  The CAR of each element of this list is a pattern against
 107 which the buffer's file name is compared; if it matches, then the CDR
 108 of the list should be the name of the tags table to use.  If more than
 109 one element of this list matches the buffer's file name, then all of
 110 the associated tags tables will be used.  Earlier ones will be
 111 searched first.
 112
 113 If the CAR of elements of this list are strings, then they are treated
 114 as regular-expressions against which the file is compared (like the
 115 auto-mode-alist).  If they are not strings, then they are evaluated.
 116 If they evaluate to non-nil, then the current buffer is considered to
 117 match.
 118
 119 If the CDR of the elements of this list are strings, then they are
 120 assumed to name a TAGS file.  If they name a directory, then the string
 121 \"TAGS\" is appended to them to get the file name.  If they are not
 122 strings, then they are evaluated, and must return an appropriate string.
 123
 124 For example:
 125   (setq tag-table-alist
 126         '((\"/usr/src/public/perl/\" . \"/usr/src/public/perl/perl-3.0/\")
 127          (\"\\\\.el$\" . \"/usr/local/emacs/src/\")
 128          (\"/jbw/gnu/\" . \"/usr15/degree/stud/jbw/gnu/\")
 129          (\"\" . \"/usr/local/emacs/src/\")
 130          ))
 131
 132 This means that anything in the /usr/src/public/perl/ directory should use
 133 the TAGS file /usr/src/public/perl/perl-3.0/TAGS; and file ending in .el should
 134 use the TAGS file /usr/local/emacs/src/TAGS; and anything in or below the
 135 directory /jbw/gnu/ should use the TAGS file /usr15/degree/stud/jbw/gnu/TAGS.
 136 A file called something like \"/usr/jbw/foo.el\" would use both the TAGS files
 137 /usr/local/emacs/src/TAGS and /usr15/degree/stud/jbw/gnu/TAGS (in that order)
 138 because it matches both patterns.
 139
 140 If the buffer-local variable `buffer-tag-table' is set, then it names a tags
 141 table that is searched before all others when find-tag is executed from this
 142 buffer.
 143
 144 If there is a file called \"TAGS\" in the same directory as the file in
 145 question, then that tags file will always be used as well (after the
 146 `buffer-tag-table' but before the tables specified by this list.)
 147
 148 If the variable tags-file-name is set, then the tags file it names will apply
 149 to all buffers (for backwards compatibility.)  It is searched first."
 150   :type '(repeat (cons :format "%v"
 151                        (choice :value ""
 152                                (regexp :tag "Buffer regexp")
 153                                sexp)
 154                        (choice :value ""
 155                                (string :tag "Tag file or directory")
 156                                sexp)))
 157   :group 'etags)
 158
 159 (defvar buffer-tag-table nil
 160   "*The additional name of one TAGS table to be used for this buffer.
 161 You can set this with `\\[set-buffer-tag-table]'.  See the documentation
 162 for the variable `tag-table-alist' for more information.")
 163 (make-variable-buffer-local 'buffer-tag-table)
 164
 165 (defvar tags-file-name nil
 166   "The name of the tags-table used by all buffers.
 167 This is for backwards compatibility, and is largely supplanted by the
 168 variable tag-table-alist.")
 169
 170 (defcustom tags-auto-read-changed-tag-files nil
 171   "*If non-nil, always re-read changed TAGS file without prompting.
 172 If nil, prompt whether to re-read the changed TAGS file."
 173   :type 'boolean
 174   :group 'etags)
 175
 176 (defcustom make-tags-files-invisible nil
 177   "*If non-nil, TAGS-files will not show up in buffer-lists or be
 178 selectable (or deletable.)"
 179   :type 'boolean
 180   :group 'etags)
 181
 182 (defcustom tags-search-nuke-uninteresting-buffers t
 183   "*If non-nil, keep newly-visited files if they contain the search target.
 184 This affects the `tags-search' and `tags-query-replace' commands."
 185   :type 'boolean
 186   :group 'etags)
 187
 188 (defcustom tags-check-parent-directories-for-tag-files t
 189   "*If non-nil, look for TAGS files in all parent directories."
 190   :type 'boolean
 191   :group 'etags)
 192
 193 (defcustom tags-exuberant-ctags-optimization-p nil
 194   "*If this variable is nil (the default), then exact tag search is able
 195 to find tag names in the name part of the tagtable (enclosed by  ^?..^A)
 196 and in the sourceline part of the tagtable ( enclosed by ^..^?).
 197 This is needed by xemacs etags as not every tag has a name field.
 198 It is slower for large tables and less precise than the other option.
 199
 200 If it is non-nil, then exact tag will only search tag names in the name
 201 part (enclosed by ^?..^A). This is faster and more precise than the other
 202 option. This is only usable with exuberant etags, as it has a name field
 203 entry for every tag."
 204 :type 'boolean
 205 :group 'etags)
 206
 207 \f
 208 ;; Buffer tag tables.
 209
 210 (defun buffer-tag-table-list ()
 211   "Returns a list (ordered) of the tags tables which should be used for
 212 the current buffer."
 213   (let (result)
 214     ;; Explicitly set buffer-tag-table
 215     (when buffer-tag-table
 216       (push buffer-tag-table result))
 217     ;; Current directory
 218     (when (file-readable-p (concat default-directory "TAGS"))
 219       (push (concat default-directory "TAGS") result))
 220     ;; Parent directories
 221     (when tags-check-parent-directories-for-tag-files
 222       (let ((cur default-directory))
 223         (while (not (and (equal (file-name-as-directory cur) cur)
 224                          (equal (directory-file-name cur) cur)))
 225           (setq cur (expand-file-name ".." cur))
 226           (let ((parent-tag-file (expand-file-name "TAGS" cur)))
 227             (when (file-readable-p parent-tag-file)
 228               (push parent-tag-file result))))))
 229     ;; tag-table-alist
 230     (let ((key (or buffer-file-name
 231                    (concat default-directory (buffer-name))))
 232           expression)
 233       (tag-dolist (item tag-table-alist)
 234         (setq expression (car item))
 235         ;; If the car of the alist item is a string, apply it as a regexp
 236         ;; to the buffer-file-name.  Otherwise, evaluate it.  If the
 237         ;; regexp matches, or the expression evaluates non-nil, then this
 238         ;; item in tag-table-alist applies to this buffer.
 239         (when (if (stringp expression)
 240                   (string-match expression key)
 241                 (ignore-errors
 242                   (eval expression)))
 243           ;; Now evaluate the cdr of the alist item to get the name of
 244           ;; the tag table file.
 245           (setq expression (ignore-errors
 246                              (eval (cdr item))))
 247           (if (stringp expression)
 248               (push expression result)
 249             (error "Expression in tag-table-alist evaluated to non-string")))))
 250     (setq result
 251           (mapcar
 252            #'(lambda (name)
 253                (when (file-directory-p name)
 254                  (setq name (expand-file-name "TAGS" name)))
 255                (and (file-readable-p name)
 256                     ;; get-tag-table-buffer has side-effects
 257                     (symbol-value-in-buffer 'buffer-file-name
 258                                             (get-tag-table-buffer name))))
 259            result))
 260     (setq result (delq nil result))
 261     ;; If no TAGS file has been found, ask the user explicitly.
 262     ;; #### tags-file-name is *evil*.
 263     (or result tags-file-name
 264         (call-interactively 'visit-tags-table))
 265     (when tags-file-name
 266       (setq result (nconc result (list tags-file-name))))
 267     ;; Lets see if we can deal with "include" TAGS files here
 268     (let ((tag-files result)
 269           inc-files)
 270       (while tag-files
 271         (set-buffer (find-file-noselect (car tag-files)))
 272         (when (setq inc-files (tag-table-include-files))
 273           (tag-loop for file in inc-files
 274             do (with-current-buffer (find-file-noselect file)
 275                  (or (and (tag-table-include-files)
 276                           (setq inc-files (append inc-files
 277                                                   (tag-table-include-files))))
 278                      (setq result (append result (list file)))))))
 279         (setq tag-files (cdr tag-files))))
 280     (or result (error "Buffer has no associated tag tables"))
 281     (delete-duplicates (nreverse result) :test 'equal)))
 282
 283 ;;;###autoload
 284 (defun visit-tags-table (file)
 285   "Tell tags commands to use tags table file FILE when all else fails.
 286 FILE should be the name of a file created with the `etags' program.
 287 A directory name is ok too; it means file TAGS in that directory."
 288   (interactive (list (read-file-name "Visit tags table: (default TAGS) "
 289                                      default-directory
 290                                      (expand-file-name "TAGS" default-directory)
 291                                      t)))
 292   (if (string-equal file "")
 293       (setq tags-file-name nil)
 294     (setq file (expand-file-name file))
 295     (when (file-directory-p file)
 296       (setq file (expand-file-name "TAGS" file)))
 297     ;; It used to be that, if a user pressed RET by mistake, the bogus
 298     ;; `tags-file-name' would remain, causing the error at
 299     ;; `buffer-tag-table'.
 300     (when (file-exists-p file)
 301       (setq tags-file-name file))))
 302
 303 (defun set-buffer-tag-table (file)
 304   "In addition to the tags tables specified by the variable `tag-table-alist',
 305 each buffer can have one additional table.  This command sets that.
 306 See the documentation for the variable `tag-table-alist' for more information."
 307   (interactive
 308    (list
 309      (read-file-name "Visit tags table: (directory sufficient) "
 310                      nil default-directory t)))
 311   (or file (error "No TAGS file name supplied"))
 312   (setq file (expand-file-name file))
 313   (when (file-directory-p file)
 314     (setq file (expand-file-name "TAGS" file)))
 315   (or (file-exists-p file) (error "TAGS file missing: %s" file))
 316   (setq buffer-tag-table file))
 317
 318 \f
 319 ;; Manipulating the tag table buffer
 320
 321 (defconst tag-table-completion-status nil
 322   "Indicates whether a completion table has been built.
 323 Either nil, t, or `disabled'.")
 324 (make-variable-buffer-local 'tag-table-completion-status)
 325
 326 (defvar tag-table-files nil
 327   "List of files referenced by the known TAGS tables.")
 328
 329 (defun get-tag-table-buffer (tag-table)
 330   "Returns a buffer visiting the given TAGS table.
 331 If appropriate, reverting the buffer, and possibly build a completion-table."
 332   (or (stringp tag-table)
 333       (error "Bad tags file name supplied: %s" tag-table))
 334   ;; Remove symbolic links from name.
 335   (setq tag-table (symlink-expand-file-name tag-table))
 336   (let (buf build-completion check-name)
 337     (setq buf (get-file-buffer tag-table))
 338     (unless buf
 339       (if (file-readable-p tag-table)
 340           (setq buf (find-file-noselect tag-table)
 341                 check-name t)
 342         (error "No such tags file: %s" tag-table)))
 343     (with-current-buffer buf
 344       ;; Make the TAGS buffer invisible.
 345       (when (and check-name
 346                  make-tags-files-invisible
 347                  (string-match "\\`[^ ]" (buffer-name)))
 348         (rename-buffer (generate-new-buffer-name
 349                         (concat " " (buffer-name)))))
 350       (or (verify-visited-file-modtime buf)
 351           (cond ((or tags-auto-read-changed-tag-files
 352                      (yes-or-no-p
 353                       (format "Tags file %s has changed, read new contents? "
 354                               tag-table)))
 355                  (when tags-auto-read-changed-tag-files
 356                    (message "Tags file %s has changed, reading new contents..."
 357                             tag-table))
 358                  (revert-buffer t t)
 359                  (when (eq tag-table-completion-status t)
 360                    (setq tag-table-completion-status nil)))))
 361       (or (eq (char-after 1) ?\f)
 362           (error "File %s not a valid tags file" tag-table))
 363       (or (memq tag-table-completion-status '(t disabled))
 364           (setq build-completion t))
 365       (when build-completion
 366         (if tags-build-completion-table
 367             (condition-case nil
 368                 (progn
 369                   (if tags-exuberant-ctags-optimization-p
 370                       (add-to-tag-completion-table-exuberant-ctags)
 371                     (let ((multi (tag-table-include-files)))
 372                       (if multi
 373                           (tag-loop for file in multi
 374                             do (with-current-buffer (find-file-noselect file)
 375                                  (or (and (tag-table-include-files)
 376                                           (setq multi (append multi
 377                                                               (tag-table-include-files))))
 378                                      (add-to-tag-completion-table))))
 379                         (add-to-tag-completion-table))))
 380                   (setq tag-table-completion-status t))
 381               ;; Allow user to C-g out correctly
 382               (quit
 383                (message "Tags completion table construction aborted")
 384                (setq tag-table-completion-status nil
 385                      quit-flag t)
 386                t))
 387           ;; The table is verboten.
 388           (setq tag-table-completion-status 'disabled))))
 389     buf))
 390
 391 (defun file-of-tag ()
 392   "Return the file name of the file whose tags point is within.
 393 Assumes the tag table is the current buffer.
 394 File name returned is relative to tag table file's directory."
 395   (let ((opoint (point))
 396         prev size)
 397     (save-excursion
 398       (goto-char (point-min))
 399       (while (< (point) opoint)
 400         (forward-line 1)
 401         (end-of-line)
 402         (skip-chars-backward "^,\n")
 403         (setq prev (point)
 404               size (read (current-buffer)))
 405         (goto-char prev)
 406         (forward-line 1)
 407         ;; New include syntax
 408         ;;   filename,include
 409         ;; tacked on to the end of a tag file means use filename
 410         ;; as a tag file before giving up.
 411         ;; Skip it here.
 412         (unless (eq size 'include)
 413           (forward-char size)))
 414       (goto-char (1- prev))
 415       (buffer-substring (point) (point-at-bol)))))
 416
 417 (defun tag-table-include-files ()
 418   "Return all file names associated with `include' directives in a tag buffer."
 419   ;; New include syntax
 420   ;;   filename,include
 421   ;; tacked on to the end of a tag file means use filename as a
 422   ;; tag file before giving up.
 423   (let ((files nil))
 424     (save-excursion
 425       (goto-char (point-min))
 426       (while (re-search-forward "\f\n\\(.*\\),include$" nil t)
 427         (push (match-string 1) files)))
 428     files))
 429
 430 (defvar tag-table-files-bloom (make-bloom)
 431   "Bloom filter for tag table file list.")
 432
 433 (defun tag-table-files-from-includes ()
 434   "Used by `tag-table-files' when dealing with included tables."
 435   (let ((tables (tag-table-include-files)))
 436     (tag-loop for tag-table in tables
 437       do (with-current-buffer (find-file-noselect tag-table)
 438            (or (and (tag-table-include-files)
 439                     (setq tables (append tables
 440                                          (tag-table-include-files))))
 441                (tag-table-files tag-table))))))
 442
 443 (defun tag-table-files (tag-table)
 444   "Returns a list of the files referenced by TAG-TABLE."
 445   (with-current-buffer (get-tag-table-buffer tag-table)
 446     (if (tag-table-include-files)
 447         (tag-table-files-from-includes)
 448       (let (file files prev size)
 449         (goto-char (point-min))
 450         (while (not (eobp))
 451           (forward-line 1)
 452           (end-of-line)
 453           (skip-chars-backward "^,\n")
 454           (setq prev (point)
 455                 size (read (current-buffer)))
 456           (goto-char prev)
 457           (setq file (expand-file-name (buffer-substring (1- (point))
 458                                                          (point-at-bol))
 459                                        default-directory))
 460           (unless (bloom-owns-p tag-table-files-bloom file)
 461             (bloom-add tag-table-files-bloom file)
 462             (push file files))
 463           (forward-line 1)
 464           (forward-char size))
 465         (setq tag-table-files (append tag-table-files files))))
 466     tag-table-files))
 467
 468 (defun tag-table-directories (tag-table)
 469   "Return a sorted list of directories referenced by TAG-TABLE."
 470   (sort (remove-duplicates (mapfam #'file-dirname
 471                                    :result-type #'list
 472                                    (tag-table-files tag-table))
 473                            :test #'string=)
 474         #'string<))
 475
 476 (defun buffer-tag-table-files ()
 477   "Returns a list of all files referenced by all TAGS tables that
 478 this buffer uses."
 479   (when (zerop (bloom-size tag-table-files-bloom))
 480     (tag-loop for table in (buffer-tag-table-list)
 481       do (tag-table-files table)))
 482   tag-table-files)
 483
 484 \f
 485 ;; Building the completion table
 486
 487 ;; Test cases for building completion table; must handle these properly:
 488 ;; Lisp_Int, XSETINT, current_column \7f60,2282
 489 ;;         Lisp_Int, XSETINT, point>NumCharacters ? 0 : CharAt(\7f363,9935
 490 ;;         Lisp_Int, XSETINT, point<=FirstCharacter ? 0 : CharAt(\7f366,10108
 491 ;;       point<=FirstCharacter || CharAt(\7f378,10630
 492 ;;       point>NumCharacters || CharAt(\7f382,10825
 493 ;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,\7f191,4562
 494 ;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,\7f191,4562
 495 ;; DEFUN ("*", Ftimes,\7f1172,32079
 496 ;; DEFUN ("/=", Fneq,\7f1035,28839
 497 ;; defun_internal \7f4199,101362
 498 ;; int pure[PURESIZE / sizeof \7f53,1564
 499 ;; char staticvec1[NSTATICS * sizeof \7f667,17608
 500 ;;  Date: 04 May 87 23:53:11 PDT \7f26,1077
 501 ;; #define anymacroname(\7f324,4344
 502 ;; (define-key ctl-x-map \7f311,11784
 503 ;; (define-abbrev-table 'c-mode-abbrev-table \7f24,1016
 504 ;; static char *skip_white(\7f116,3443
 505 ;; static foo \7f348,11643
 506 ;; (defun texinfo-insert-@code \7f91,3358
 507 ;; (defvar texinfo-kindex)\7f29,1105
 508 ;; (defun texinfo-format-\. \7f548,18376
 509 ;; (defvar sm::menu-kludge-y \7f621,22726
 510 ;; (defvar *mouse-drag-window* \7f103,3642
 511 ;; (defun simula-back-level(\7f317,11263
 512 ;; } DPxAC,\7f380,14024
 513 ;; } BM_QCB;\7f69,2990
 514 ;; #define MTOS_DONE\t
 515
 516 ;; "^[^ ]+ +\\([^ ]+\\) "
 517
 518 ;; void *find_cactus_segment(\7f116,2444
 519 ;; void *find_pdb_segment(\7f162,3688
 520 ;; void init_dclpool(\7f410,10739
 521 ;; WORD insert_draw_command(\7f342,8881
 522 ;; void *req_pdbmem(\7f579,15574
 523
 524 (defvar tag-completion-table (make-hash-table :test #'eq :size 4096))
 525
 526 (defvar buffer-tag-table-list)
 527
 528 (defun add-tag-symbol (tag)
 529   "Turn TAG into a symbol and add it to `tag-completion-table'."
 530   (let* ((key (make-symbol tag))
 531          (val key))
 532       (puthash key val tag-completion-table)))
 533
 534 ;; Can't use "\\s-" in these patterns because that will include newline
 535 ;; \2 matches an explicit name.
 536 (defconst tags-explicit-name-pattern "\177\\(\\([^\n\001]+\\)\001\\)?")
 537 ;; \1 matches Lisp-name, \2 matches C-name, \5 (from
 538 ;; tags-explicit-name-pattern) matches explicit name.
 539 (defconst tags-DEFUN-pattern
 540   (concat "DEFUN[ \t]*(\"\\([^\"]+\\)\",[ \t]*" #r"\(\(\sw\|\s_\)+\),"
 541           tags-explicit-name-pattern))
 542 ;; \1 matches an array name.  Explicit names unused?
 543 (defconst tags-array-pattern ".*[ \t]+\\([^ \[]+\\)\\[")
 544 ;; \2 matches a Lispish name, \5 (from tags-explicit-name-pattern) matches
 545 ;; explicit name.
 546 (defconst tags-def-pattern
 547   (concat "\\(.*[ \t]+\\)?\\**\\(\\(\\sw\\|\\s_\\)+\\)[ ();,\t]*"
 548 ;; "\\(.*[ \t]+\\)?\\(\\(\\sw\\|\\s_\\)+\\)[ ()]*"
 549 ;; "\\(\\sw\\|\\s_\\)+[ ()]*"
 550           tags-explicit-name-pattern)
 551       )
 552 ;; \1 matches Schemish name, \4 (from tags-explicit-name-pattern) matches
 553 ;; explicit name
 554 (defconst tags-schemish-pattern
 555   (concat #r"\s-*(\s-*def\sw*\s-*(?\s-*\(\(\sw\|\s_\|:\)+\))?\s-*"
 556           tags-explicit-name-pattern))
 557 (defconst tags-file-pattern "^\f\n\\(.+\\),[0-9]+\n")
 558
 559 (defun add-to-tag-completion-table-exuberant-ctags ()
 560   "Sucks the current buffer (a TAGS table) into the completion-table.
 561 This is a version which is optimized for exuberant etags and will not
 562 work with xemacs etags."
 563   (message "Adding %s to tags completion table..." buffer-file-name)
 564   (goto-char (point-min))
 565   (let ((case-fold-search nil)
 566         name)
 567     (while (re-search-forward tags-explicit-name-pattern nil t)
 568       ;; no need to check the mode here
 569       (setq name (match-string 2))
 570       (add-tag-symbol name)))
 571   (message "Adding %s to tags completion table...done" buffer-file-name))
 572
 573 (defun add-to-tag-completion-table ()
 574   "Sucks the current buffer (a TAGS table) into the completion-table."
 575   (message "Adding %s to tags completion table..." buffer-file-name)
 576   (goto-char (point-min))
 577   (let ((case-fold-search nil)
 578         filename file-type name name2 name3)
 579     ;; Loop over the files mentioned in the TAGS file for each file,
 580     ;; try to find its major-mode, then process tags appropriately.
 581     (while (looking-at tags-file-pattern)
 582       (goto-char (match-end 0))
 583       (setq filename (file-name-sans-versions (match-string 1))
 584             ;; We used to check auto-mode-alist for the proper
 585             ;; file-type.  This was way too slow, as it had to process
 586             ;; an enormous amount of regexps for each time.  Now we
 587             ;; use the shotgun approach with only two regexps.
 588             file-type (cond ((string-match #r"\.\([cC]\|cc\|cxx\)\'"
 589                                            filename)
 590                              'c-mode)
 591                             ((string-match #r"\.\(el\|cl\|lisp\)\'"
 592                                            filename)
 593                              'lisp-mode)
 594                             ((string-match #r"\.scm\'" filename)
 595                              'scheme-mode)
 596                             (t nil)))
 597       (defvar c-mode-syntax-table)
 598       (set-syntax-table (cond ((and (eq file-type 'c-mode)
 599                                     c-mode-syntax-table)
 600                                c-mode-syntax-table)
 601                               ((eq file-type 'lisp-mode)
 602                                lisp-mode-syntax-table)
 603                               (t (standard-syntax-table))))
 604       ;; Clear loop variables.
 605       (setq name nil name2 nil name3 nil)
 606       (lmessage 'progress "%s..." filename)
 607       ;; Loop over the individual tag lines.
 608       (while (not (or (eobp) (eq (char-after) ?\f)))
 609         (cond ((and (eq file-type 'c-mode)
 610                     (looking-at "DEFUN[ \t]"))
 611                ;; DEFUN
 612                (or (looking-at tags-DEFUN-pattern)
 613                    (error "DEFUN doesn't fit pattern"))
 614                (setq name (match-string 1)
 615                      name2 (match-string 2)
 616                      name3 (match-string 5)))
 617               ;;((looking-at "\\s-")
 618               ;; skip probably bogus entry:
 619               ;;)
 620               ((and (eq file-type 'c-mode)
 621                     (looking-at ".*\\["))
 622                ;; Array
 623                (cond ((not (looking-at tags-array-pattern))
 624                       (message "array definition doesn't fit pattern")
 625                       (setq name nil))
 626                      (t
 627                       (setq name (match-string 1)))))
 628               ((and (eq file-type 'scheme-mode)
 629                     (looking-at tags-schemish-pattern))
 630                ;; Something Schemish (is this really necessary??)
 631                (setq name (match-string 1)
 632                      name2 (match-string 4)))
 633               ((looking-at tags-def-pattern)
 634                ;; ???
 635                (setq name (match-string 2)
 636                      name2 (match-string 5))))
 637         ;; add the tags we found to the completion table
 638         (and name (add-tag-symbol name))
 639         (and name2 (add-tag-symbol name2))
 640         (and name3 (add-tag-symbol name3))
 641         (forward-line 1)))
 642     (or (eobp) (error "Bad TAGS file")))
 643   (message "Adding %s to tags completion table...done" buffer-file-name))
 644
 645 \f
 646
 647 ;; Interactive find-tag
 648
 649 (defcustom find-tag-hook nil
 650   "*Hook called after a tag is found."
 651   :type 'hook
 652   :group 'etags)
 653
 654 (defun find-tag-default ()
 655   "Return a default tag to search for, based on the text at point."
 656   (symbol-near-point))
 657
 658 (defun buffer-tag-table-symbol-list ()
 659   (mapfam
 660    #'(lambda (table-name)
 661        (puthash (make-symbol table-name)
 662                 (make-symbol table-name) tag-completion-table))
 663    :result-type #'list
 664    (buffer-tag-table-list)))
 665
 666 (defvar find-tag-history nil
 667   "History list for find-tag-tag.")
 668
 669 (defun find-tag-tag (prompt)
 670   (let* ((default (find-tag-default))
 671          (buffer-tag-table-list (buffer-tag-table-symbol-list))
 672          (table tag-completion-table)
 673          tag-name)
 674     (setq tag-name
 675           (completing-read
 676            (if default
 677                (format "%s(default %s) " prompt default)
 678              prompt)
 679            (hash-values-to-vector table) nil nil nil
 680            'find-tag-history default))
 681     tag-name))
 682
 683 (defvar last-tag-data nil
 684   "Information for continuing a tag search.
 685 Is of the form (TAG POINT MATCHING-EXACT TAG-TABLE TAG-TABLE ...).")
 686
 687 (defvar tags-loop-operate nil
 688   "Form for `tags-loop-continue' to eval to change one file.")
 689
 690 (defvar tags-loop-scan
 691   '(error "%s" (substitute-command-keys
 692                 "No \\[tags-search] or \\[tags-query-replace] in progress."))
 693   "Form for `tags-loop-continue' to eval to scan one file.
 694 If it returns non-nil, this file needs processing by evalling
 695 \`tags-loop-operate'.  Otherwise, move on to the next file.")
 696
 697 (autoload 'get-symbol-syntax-table "symbol-syntax")
 698
 699 (defun find-tag-internal (tagname)
 700
 701   (let ((next (null tagname))
 702         (tmpnext (null tagname))
 703         ;; If tagname is a list: (TAGNAME), this indicates
 704         ;; requiring an exact symbol match.
 705         (exact (or tags-always-exact (consp tagname)))
 706         (normal-syntax-table (syntax-table))
 707         (exact-syntax-table (get-symbol-syntax-table (syntax-table)))
 708         tag-table-currently-matching-exact
 709         tag-target exact-tagname
 710         tag-tables tag-table-point file linebeg line startpos buf
 711         offset found pat syn-tab)
 712     (when (consp tagname)
 713       (setq tagname (car tagname)))
 714     (cond (next
 715            (setq tagname (car last-tag-data))
 716            (setq tag-table-currently-matching-exact
 717                  (car (cdr (cdr last-tag-data)))))
 718           (t
 719            (setq tag-table-currently-matching-exact t)))
 720     ;; \_ in the tagname is used to indicate a symbol boundary.
 721     (if tags-exuberant-ctags-optimization-p
 722         (setq exact-tagname (format "\C-?%s\C-a" tagname))
 723       (setq exact-tagname (format "\C-?%s\C-a\\|\
 724 \\_%s.?\C-?[0-9]*,[0-9]*$" tagname tagname))
 725       )
 726     (while (string-match #r"\\_" exact-tagname)
 727       (aset exact-tagname (1- (match-end 0)) ?b))
 728     (save-excursion
 729       (catch 'found
 730         ;; Loop searching for exact matches and then inexact matches.
 731         (while (not (eq tag-table-currently-matching-exact 'neither))
 732           (cond (tmpnext
 733                  (setq tag-tables (cdr (cdr (cdr last-tag-data)))
 734                        tag-table-point (car (cdr last-tag-data)))
 735                  ;; Start from the beginning of the table list on the
 736                  ;; next iteration of the loop.
 737                  (setq tmpnext nil))
 738                 (t
 739                  (setq tag-tables (buffer-tag-table-list)
 740                        tag-table-point 1)))
 741           (if tag-table-currently-matching-exact
 742               (setq tag-target exact-tagname
 743                     syn-tab exact-syntax-table)
 744             (setq tag-target tagname
 745                   syn-tab normal-syntax-table))
 746           (with-search-caps-disable-folding tag-target t
 747             (while tag-tables
 748               (set-buffer (get-tag-table-buffer (car tag-tables)))
 749               (bury-buffer (current-buffer))
 750               (goto-char (or tag-table-point (point-min)))
 751               (setq tag-table-point nil)
 752               (letf (((syntax-table) syn-tab)
 753                      (case-fold-search nil))
 754                 ;; #### should there be support for non-regexp
 755                 ;; tag searches?
 756                 (while (re-search-forward tag-target nil t)
 757                   (and (save-match-data
 758                          (save-excursion
 759                            (goto-char (match-beginning 0))
 760                            (looking-at "[^\n\C-?]*\C-?")))
 761                        ;; If we're looking for inexact matches, skip
 762                        ;; exact matches since we've visited them
 763                        ;; already.
 764                        (or tag-table-currently-matching-exact
 765                            (letf (((syntax-table) exact-syntax-table))
 766                              (save-excursion
 767                                (goto-char (match-beginning 0))
 768                                (not (looking-at exact-tagname)))))
 769                        (throw 'found t))))
 770               (setq tag-tables
 771                     (nconc (tag-table-include-files) (cdr tag-tables)))))
 772           (if (and (not exact) (eq tag-table-currently-matching-exact t))
 773               (setq tag-table-currently-matching-exact nil)
 774             (setq tag-table-currently-matching-exact 'neither)))
 775         (error "No %sentries %s %s"
 776                (if next "more " "")
 777                (if exact "matching" "containing")
 778                tagname))
 779       (beginning-of-line)
 780
 781       ;; from here down, synched with FSF 20.7
 782       ;; etags-snarf-tag and etags-goto-tag-location. --ben
 783
 784       (if (save-excursion
 785             (forward-line -1)
 786             (looking-at "\f\n"))
 787           (progn
 788             ;; The match was for a source file name, not any tag
 789             ;; within a file.  Give text of t, meaning to go exactly
 790             ;; to the location we specify, the beginning of the file.
 791             (setq linebeg t
 792                   line nil
 793                   startpos 1)
 794             (setq file
 795                   (expand-file-name (file-of-tag)
 796                                     ;; In SXEmacs, this needs to be
 797                                     ;; relative to:
 798                                     (or (file-dirname (car tag-tables))
 799                                         "./"))))
 800         (search-forward "\C-?")
 801         (setq file
 802               (expand-file-name (file-of-tag)
 803                                 ;; In SXEmacs, this needs to be
 804                                 ;; relative to:
 805                                 (or (file-dirname (car tag-tables))
 806                                     "./")))
 807         (setq linebeg (buffer-substring (1- (point)) (point-at-bol)))
 808         ;; Skip explicit tag name if present.
 809         (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
 810         (if (looking-at "[0-9]")
 811             (setq line (string-to-int (buffer-substring
 812                                        (point)
 813                                        (progn (skip-chars-forward "0-9")
 814                                               (point))))))
 815         (search-forward ",")
 816         (if (looking-at "[0-9]")
 817             (setq startpos (string-to-int (buffer-substring
 818                                            (point)
 819                                            (progn (skip-chars-forward "0-9")
 820                                                   (point)))))))
 821       ;; Leave point on the next line of the tags file.
 822       (forward-line 1)
 823       (setq last-tag-data
 824             (nconc (list tagname (point) tag-table-currently-matching-exact)
 825                    tag-tables))
 826       (setq buf (find-file-noselect file))
 827
 828       ;; LINEBEG is the initial part of a line containing the tag and
 829       ;; STARTPOS is the character position of LINEBEG within the file
 830       ;; (starting from 1); LINE is the line number.  If LINEBEG is t,
 831       ;; it means the tag refers to exactly LINE or STARTPOS
 832       ;; (whichever is present, LINE having preference, no searching).
 833       ;; Either LINE or STARTPOS may be nil; STARTPOS is used if
 834       ;; present.  If the tag isn't exactly at the given position then
 835       ;; look around that position using a search window which expands
 836       ;; until it hits the start of file.
 837
 838       (with-current-buffer buf
 839         (save-excursion
 840           (save-restriction
 841             (widen)
 842             (if (eq linebeg t)
 843                 ;; Direct file tag.
 844                 (cond (line (goto-line line))
 845                       (startpos (goto-char startpos))
 846                       (t (error "etags.el BUG: bogus direct file tag")))
 847               ;; Here we search for PAT in the range [STARTPOS - OFFSET,
 848               ;; STARTPOS + OFFSET], with increasing values of OFFSET.
 849               ;;
 850               ;; We used to set the initial offset to 1000, but the
 851               ;; actual sources show that finer-grained control is
 852               ;; needed (e.g. two `hash_string's in src/symbols.c.)  So,
 853               ;; I changed 1000 to 100, and (* 3 offset) to (* 5 offset).
 854               (setq offset 100)
 855               (setq pat (concat (if (eq selective-display t)
 856                                     "\\(^\\|\^m\\)" "^")
 857                                 (regexp-quote linebeg)))
 858
 859               ;; The character position in the tags table is 0-origin.
 860               ;; Convert it to a 1-origin Emacs character position.
 861               (if startpos (setq startpos (1+ startpos)))
 862               ;; If no char pos was given, try the given line number.
 863               (or startpos
 864                   (if line
 865                       (setq startpos (progn (goto-line line)
 866                                             (point)))))
 867               (or startpos
 868                   (setq startpos (point-min)))
 869               ;; First see if the tag is right at the specified location.
 870               (goto-char startpos)
 871               (setq found (looking-at pat))
 872               (while (and (not found)
 873                           (progn
 874                             (goto-char (- startpos offset))
 875                             (not (bobp))))
 876                 (setq found
 877                       (re-search-forward pat (+ startpos offset) t)
 878                       offset (* 5 offset))) ; expand search window
 879               ;; Finally, try finding it anywhere in the buffer.
 880               (or found
 881                   (re-search-forward pat nil t)
 882                   (error "Rerun etags: `%s' not found in %s"
 883                          pat file))))
 884           ;; Position point at the right place
 885           ;; if the search string matched an extra Ctrl-m at the beginning.
 886           (and (eq selective-display t)
 887                (looking-at "\^m")
 888                (forward-char 1))
 889           (beginning-of-line)
 890           (setq startpos (point))))
 891       (cons buf startpos))))
 892
 893 ;;;###autoload
 894 (defun find-tag-at-point (tagname &optional other-window)
 895   "*Find tag whose name contains TAGNAME.
 896 Identical to `find-tag' but does not prompt for tag when called interactively;
 897 instead, uses tag around or before point."
 898   (interactive (list (find-tag-default) nil))
 899   (if current-prefix-arg
 900       (find-tag tagname 'other-window)
 901     (find-tag tagname)))
 902
 903 ;;;###autoload
 904 (defun find-tag (tagname &optional other-window)
 905   "Find tag whose name contains TAGNAME.
 906
 907 Selects the buffer that the tag is contained in and puts point at
 908 its definition.  If TAGNAME is a null string, the expression in
 909 the buffer around or before point is used as the tag name.  If
 910 called interactively with a numeric argument, searches for the
 911 next tag in the tag table that matches the tagname used in the
 912 previous find-tag.  If second arg OTHER-WINDOW is non-nil, uses
 913 another window to display the tag.
 914
 915 This version of this function supports multiple active tags tables,
 916 and completion.
 917
 918 Variables of note:
 919
 920   tag-table-alist               controls which tables apply to which buffers
 921   tags-file-name                a default tags table
 922   tags-build-completion-table   controls completion behavior
 923   buffer-tag-table              another way of specifying a buffer-local table
 924   make-tags-files-invisible     whether tags tables should be very hidden
 925   tag-mark-stack-max            how many tags-based hops to remember"
 926   (interactive (list (find-tag-tag "Find tag: ") nil))
 927   (let* ((next (null tagname))
 928          (result (find-tag-internal tagname))
 929          (tag-buf (car result))
 930          (tag-point (cdr result))
 931          (other-window (or other-window current-prefix-arg)))
 932     ;; Push old position on the tags mark stack.
 933     (if (or (not next)
 934             (not (memq last-command
 935                        '(find-tag find-tag-other-window tags-loop-continue))))
 936         (push-tag-mark))
 937     (if other-window
 938         (pop-to-buffer tag-buf t)
 939       (switch-to-buffer tag-buf))
 940     (widen)
 941     (push-mark)
 942     (goto-char tag-point)
 943     (run-hooks 'find-tag-hook))
 944   (setq tags-loop-scan (list 'find-tag nil nil)
 945         tags-loop-operate nil)
 946   ;; Return t in case used as the tags-loop-scan.
 947   t)
 948
 949 ;;;###autoload
 950 (defun find-tag-other-window (tagname &optional next)
 951   "*Find tag whose name contains TAGNAME, in another window.
 952  Selects the buffer that the tag is contained in in another window
 953 and puts point at its definition.
 954  If TAGNAME is a null string, the expression in the buffer
 955 around or before point is used as the tag name.
 956  If second arg NEXT is non-nil (interactively, with prefix arg),
 957 searches for the next tag in the tag table
 958 that matches the tagname used in the previous find-tag.
 959
 960 This version of this function supports multiple active tags tables,
 961 and completion.
 962
 963 Variables of note:
 964
 965   tag-table-alist               controls which tables apply to which buffers
 966   tags-file-name                a default tags table
 967   tags-build-completion-table   controls completion behavior
 968   buffer-tag-table              another way of specifying a buffer-local table
 969   make-tags-files-invisible     whether tags tables should be very hidden
 970   tag-mark-stack-max            how many tags-based hops to remember"
 971   (interactive (list (find-tag-tag "Find tag other window: ")))
 972   (if (or next current-prefix-arg)
 973       (find-tag nil t)
 974     (find-tag tagname t)))
 975
 976 \f
 977 ;; Completion on tags in the buffer.
 978
 979 \f
 980 ;; Applying a command to files mentioned in tag tables
 981
 982 (defvar next-file-list nil
 983   "List of files for next-file to process.")
 984
 985 ;;;###autoload
 986 (defun next-file (&optional initialize novisit)
 987   "Select next file among files in current tag table(s).
 988
 989 A first argument of t (prefix arg, if interactive) initializes to the
 990 beginning of the list of files in the (first) tags table.  If the argument
 991 is neither nil nor t, it is evalled to initialize the list of files.
 992
 993 Non-nil second argument NOVISIT means use a temporary buffer
 994 to save time and avoid uninteresting warnings.
 995
 996 Value is nil if the file was already visited;
 997 if the file was newly read in, the value is the filename."
 998   (interactive "P")
 999   (cond ((not initialize)
1000          ;; Not the first run.
1001          )
1002         ((eq initialize t)
1003          ;; Initialize the list from the tags table.
1004          (setq next-file-list (buffer-tag-table-files)))
1005         (t
1006          ;; Initialize the list by evalling the argument.
1007          (setq next-file-list (eval initialize))))
1008   (when (null next-file-list)
1009     (and novisit
1010          (get-buffer " *next-file*")
1011          (kill-buffer " *next-file*"))
1012     (error "All files processed"))
1013   (let* ((file (car next-file-list))
1014          (buf (get-file-buffer file))
1015          (new (not buf)))
1016     (pop next-file-list)
1017
1018     (if (not (and new novisit))
1019         (switch-to-buffer (find-file-noselect file novisit) t)
1020       ;; Like find-file, but avoids random junk.
1021       (set-buffer (get-buffer-create " *next-file*"))
1022       (kill-all-local-variables)
1023       (erase-buffer)
1024       (insert-file-contents file nil))
1025     (widen)
1026     (when (> (point) (point-min))
1027       (push-mark nil t)
1028       (goto-char (point-min)))
1029     (and new file)))
1030
1031 ;;;###autoload
1032 (defun tags-loop-continue (&optional first-time)
1033   "Continue last \\[tags-search] or \\[tags-query-replace] command.
1034 Used noninteractively with non-nil argument to begin such a command (the
1035 argument is passed to `next-file', which see).
1036 Two variables control the processing we do on each file:
1037 the value of `tags-loop-scan' is a form to be executed on each file
1038 to see if it is interesting (it returns non-nil if so)
1039 and `tags-loop-operate' is a form to execute to operate on an interesting file
1040 If the latter returns non-nil, we exit; otherwise we scan the next file."
1041   (interactive)
1042   (let ((messaged nil)
1043         (more-files-p t)
1044         new)
1045     (while more-files-p
1046       ;; Scan files quickly for the first or next interesting one.
1047       (while (or first-time
1048                  (save-restriction
1049                    (widen)
1050                    (not (eval tags-loop-scan))))
1051         (setq new (next-file first-time
1052                              tags-search-nuke-uninteresting-buffers))
1053         ;; If NEW is non-nil, we got a temp buffer,
1054         ;; and NEW is the file name.
1055         (if (or messaged
1056                 (and (not first-time)
1057                      (> (device-baud-rate) search-slow-speed)
1058                      (setq messaged t)))
1059             (lmessage 'progress
1060                 "Scanning file %s..." (or new buffer-file-name)))
1061         (setq first-time nil)
1062         (goto-char (point-min)))
1063
1064       ;; If we visited it in a temp buffer, visit it now for real.
1065       (if (and new tags-search-nuke-uninteresting-buffers)
1066           (let ((pos (point)))
1067             (erase-buffer)
1068             (set-buffer (find-file-noselect new))
1069             (widen)
1070             (goto-char pos)))
1071
1072       (switch-to-buffer (current-buffer))
1073
1074       ;; Now operate on the file.
1075       ;; If value is non-nil, continue to scan the next file.
1076       (setq more-files-p (eval tags-loop-operate)))
1077     (and messaged
1078          (null tags-loop-operate)
1079          (message "Scanning file %s...found" buffer-file-name))))
1080
1081 ;;;###autoload
1082 (defun tags-search (regexp &optional file-list-form)
1083   "Search through all files listed in tags table for match for REGEXP.
1084 Stops when a match is found.
1085 To continue searching for next match, use command \\[tags-loop-continue].
1086
1087 See documentation of variable `tag-table-alist'."
1088   (interactive "sTags search (regexp): ")
1089   (if (and (equal regexp "")
1090            (eq (car tags-loop-scan) 'with-search-caps-disable-folding)
1091            (null tags-loop-operate))
1092       ;; Continue last tags-search as if by `M-,'.
1093       (tags-loop-continue nil)
1094     (setq tags-loop-scan `(with-search-caps-disable-folding ,regexp t
1095                             (re-search-forward ,regexp nil t))
1096           tags-loop-operate nil)
1097     (tags-loop-continue (or file-list-form t))))
1098
1099 ;;;###autoload
1100 (defun tags-query-replace (from to &optional delimited file-list-form)
1101   "Query-replace-regexp FROM with TO through all files listed in tags table.
1102 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
1103 If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
1104 with the command \\[tags-loop-continue].
1105
1106 See documentation of variable `tag-table-alist'."
1107   (interactive
1108    "sTags query replace (regexp): \nsTags query replace %s by: \nP")
1109   (setq tags-loop-scan `(with-search-caps-disable-folding ,from t
1110                           (if (re-search-forward ,from nil t)
1111                               ;; When we find a match, move back
1112                               ;; to the beginning of it so perform-replace
1113                               ;; will see it.
1114                               (progn (goto-char (match-beginning 0)) t)))
1115         tags-loop-operate (list 'perform-replace from to t t
1116                                 (not (null delimited))))
1117    (tags-loop-continue (or file-list-form t)))
1118 \f
1119 ;; Miscellaneous
1120 (defun find-tag-regex (tagname)
1121   "Use `igrep-find' to find all occurances of tag with TAGNAME."
1122   (interactive (if current-prefix-arg
1123                    (list (current-word))
1124                  (list (find-tag-tag "Find tag: "))))
1125   (and-fboundp #'igrep-find
1126     (igrep-find "grep" tagname (tag-table-directories tags-file-name))))
1127
1128 (defun taglist-find-tag ()
1129   "Jump to a tag from the \"*Tags List*\" buffer.
1130 With a prefix arg, jump to the tag in another window."
1131   (interactive)
1132   (save-excursion
1133     (progn (goto-char (point-at-eol))
1134            (backward-word))
1135     (let ((tagname (find-tag-default)))
1136       (if current-prefix-arg
1137           (find-tag tagname 'other-window)
1138         (find-tag tagname)))))
1139
1140 (defun taglist-display-tag-info ()
1141   "Display in the minibuffer short info of tag.
1142
1143 See `display-tag-info'."
1144   (interactive)
1145   (save-excursion
1146     (progn (goto-char (point-at-eol))
1147            (backward-word))
1148     (let ((tagname (find-tag-default)))
1149       (display-tag-info tagname))))
1150
1151 (defvar taglist-mode-map
1152   (let ((map (make-keymap 'taglist-mode-map)))
1153     (suppress-keymap map)
1154     (define-key map [return] #'taglist-find-tag)
1155     (define-key map [\?] #'taglist-display-tag-info)
1156     (define-key map [n] #'next-line)
1157     (define-key map [p] #'previous-line)
1158     (define-key map [q] #'bury-buffer)
1159     (define-key map [space] #'scroll-up-command)
1160     (define-key map [next] #'scroll-up-command)
1161     (define-key map [delete] #'scroll-down-command)
1162     (define-key map [backspace] #'scroll-down-command)
1163     (define-key map [prior] #'scroll-down-command)
1164     map)
1165   "Keymap for `taglist-mode'.")
1166
1167 (define-derived-mode taglist-mode fundamental-mode "Etags"
1168   "A simple mode for navigating around a tags list."
1169   :group 'etags
1170   (set-buffer-modified-p nil))
1171
1172 ;;;###autoload
1173 (defun list-tags (file &optional other-window)
1174   "Display list of tags in FILE.
1175
1176 With optional prefix arg, OTHER-WINDOW, display list there."
1177   (interactive (list (read-file-name
1178                       (if (buffer-file-name)
1179                           (format "List tags (in file, %s by default): "
1180                                   (file-basename (buffer-file-name)))
1181                         "List tags (in file): ")
1182                       nil (buffer-file-name) t)))
1183   (find-file-noselect file)
1184   (let* ((taglist-buf (get-buffer-create "*Tags List*"))
1185          (standard-output taglist-buf))
1186     (with-current-buffer taglist-buf
1187       (erase-buffer)
1188       (insert (format "Tags in file: %s\n\n" file)))
1189     (save-excursion
1190       (tag-dolist (tags-file (with-current-buffer (get-file-buffer file)
1191                                (buffer-tag-table-list)))
1192         ;; We don't want completions getting in the way.
1193         (let ((tags-build-completion-table nil))
1194           (set-buffer (get-tag-table-buffer tags-file)))
1195         (goto-char (point-min))
1196         (when
1197             (re-search-forward (concat "\f\n.*" (file-basename file) ",")
1198                             nil t)
1199           (forward-line 1)
1200           (while (not (or (eobp) (looking-at "\f")))
1201             (princ (buffer-substring (point)
1202                                      (progn (skip-chars-forward "^\C-?")
1203                                             (point))))
1204             (terpri)
1205             (forward-line 1)))))
1206     (if current-prefix-arg
1207         (pop-to-buffer taglist-buf)
1208       (switch-to-buffer taglist-buf))
1209     (goto-char (point-min))
1210     (forward-line 2)
1211     (taglist-mode)))
1212
1213 ;;;###autoload
1214 (defun tags-apropos (string &optional other-window)
1215   "Display list of all tags in tag table REGEXP matches.
1216
1217 With optional prefix arg, OTHER-WINDOW, display list there."
1218   (interactive "sTag apropos (regexp): ")
1219   (let* ((taglist-buf (get-buffer-create "*Tags List*"))
1220          (standard-output taglist-buf))
1221     (with-current-buffer taglist-buf
1222       (erase-buffer)
1223       (insert (format "Tags matching regexp: %S\n\n" string)))
1224     (save-excursion
1225       (tag-loop for file in (buffer-tag-table-list)
1226         do (progn
1227              (set-buffer (find-file-noselect file))
1228              (goto-char (point-min))
1229              (while (re-search-forward string nil t)
1230                (beginning-of-line)
1231                (princ (buffer-substring (point)
1232                                         (progn (skip-chars-forward "^\C-?")
1233                                                (point))))
1234                (terpri)
1235                (forward-line 1)))))
1236     (if current-prefix-arg
1237         (pop-to-buffer taglist-buf)
1238       (switch-to-buffer taglist-buf))
1239     (goto-char (point-min))
1240     (forward-line 2)
1241     (taglist-mode)))
1242
1243
1244 \f
1245 ;; Display short info on tag in minibuffer
1246
1247 ;; Don't pollute `M-?' -- we may need it for more important stuff.  --hniksic
1248 ;(if (null (lookup-key esc-map "?"))
1249 ;    (define-key esc-map "?" 'display-tag-info))
1250
1251 (defun display-tag-info (tagname)
1252   "Prints a description of the first tag matching TAGNAME in the echo area.
1253 If this is an elisp function, prints something like \"(defun foo (x y z)\".
1254 That is, is prints the first line of the definition of the form.
1255 If this is a C-defined elisp function, it does something more clever."
1256   (interactive (if current-prefix-arg
1257                    '(nil)
1258                  (list (find-tag-tag "Display tag info: "))))
1259   (let* ((results (find-tag-internal tagname))
1260          (tag-buf (car results))
1261          (tag-point (cdr results))
1262          info lname min max fname args)
1263     (with-current-buffer tag-buf
1264       (save-excursion
1265         (save-restriction
1266           (widen)
1267           (goto-char tag-point)
1268           (cond ((let ((case-fold-search nil))
1269                    (looking-at (concat "^DEFUN(\"" tagname)))
1270                  (forward-sexp 1)
1271                  (down-list 1)
1272                  (setq lname (read (current-buffer))
1273                        fname (buffer-substring
1274                               (progn (forward-sexp 1) (point))
1275                               (progn (backward-sexp 1) (point)))
1276                        min (buffer-substring
1277                             (progn (forward-sexp 2) (point))
1278                             (progn (backward-sexp 1) (point)))
1279                        max (buffer-substring
1280                             (progn (forward-sexp 2) (point))
1281                             (progn (backward-sexp 1) (point))))
1282                  (search-forward "*/")
1283                  (setq args (buffer-substring
1284                              (progn (forward-sexp 1) (point))
1285                              (progn (backward-sexp 1) (point))))
1286                  (setq info (format "Elisp: %s, C: %s %s, #args: %s"
1287                                     lname
1288                                     fname args
1289                                     (if (string-equal min max)
1290                                         min
1291                                       (format "from %s to %s" min max)))))
1292                 (t
1293                  (setq info
1294                        (buffer-substring
1295                         (progn (beginning-of-line) (point))
1296                         (progn (end-of-line) (point)))))))))
1297     (message "%s" info))
1298   (setq tags-loop-scan '(display-tag-info nil)
1299         tags-loop-operate nil)
1300   ;; Always return non-nil
1301   t)
1302
1303 \f
1304 ;; Tag mark stack.
1305
1306 (defvar tag-mark-stack1 nil)
1307 (defvar tag-mark-stack2 nil)
1308
1309 (defcustom tag-mark-stack-max 16
1310   "*The maximum number of elements kept on the mark-stack used
1311 by tags-search.  See also the commands `\\[push-tag-mark]' and
1312 and `\\[pop-tag-mark]'."
1313   :type 'integer
1314   :group 'etags)
1315
1316 (defun push-mark-on-stack (stack-symbol &optional max-size)
1317   (let ((stack (symbol-value stack-symbol)))
1318     (push (point-marker) stack)
1319     (cond ((and max-size
1320                 (> (length stack) max-size))
1321            (set-marker (car (nthcdr max-size stack)) nil)
1322            (setcdr (nthcdr (1- max-size) stack) nil)))
1323     (set stack-symbol stack)))
1324
1325 (defun pop-mark-from-stack (stack-symbol1 stack-symbol2 &optional max-size)
1326   (let* ((stack (or (symbol-value stack-symbol1)
1327                     (error "No more tag marks on stack")))
1328          (marker (car stack))
1329          (m-buf (marker-buffer marker)))
1330     (set stack-symbol1 (cdr stack))
1331     (or m-buf
1332         (error "Marker has no buffer"))
1333     (or (buffer-live-p m-buf)
1334         (error "Buffer has been killed"))
1335     (push-mark-on-stack stack-symbol2 max-size)
1336     (switch-to-buffer m-buf)
1337     (widen)
1338     (goto-char marker)))
1339
1340 (defun push-tag-mark ()
1341   (push-mark-on-stack 'tag-mark-stack1 tag-mark-stack-max))
1342
1343 ;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
1344
1345 ;;;###autoload
1346 (defun pop-tag-mark (arg)
1347   "Go to last tag position.
1348 `find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack.
1349 This function pops (and moves to) the tag at the top of this stack."
1350   (interactive "P")
1351   (if (not arg)
1352       (pop-mark-from-stack
1353        'tag-mark-stack1 'tag-mark-stack2 tag-mark-stack-max)
1354     (pop-mark-from-stack
1355      'tag-mark-stack2 'tag-mark-stack1 tag-mark-stack-max)))
1356
1357 \f
1358 (provide 'etags)
1359 (provide 'tags)
1360
1361 ;;; etags.el ends here