git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/etags.el

   1 ;;; etags.el --- etags facility for Emacs
   2
   3 ;; Copyright 1985, 1986, 1988, 1990, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Their Name is Legion (see list below)
   6 ;; Maintainer: XEmacs Development Team
   7 ;; Keywords: tools
   8
   9 ;; This file is part of XEmacs.
  10
  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)
  14 ;; any later version.
  15
  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.
  20
  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.
  25
  26 ;;; Synched up with: Not synched with FSF.
  27
  28 ;;; Commentary:
  29
  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.
  34
  35 ;; TODO:
  36 ;; - DOCUMENT!
  37
  38 ;; Derived from the original lisp/tags.el.
  39
  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>
  56 ;;   various changes.
  57
  58 \f
  59 ;;; User variables.
  60
  61 (defgroup etags nil
  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]'
  65 command."
  66   :prefix "tags-"
  67   :group 'tools)
  68
  69
  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))
  81   :group 'etags)
  82
  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."
  87   :type 'boolean
  88   :group 'etags)
  89
  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
  98 searched first.
  99
 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
 104 match.
 105
 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.
 110
 111 For example:
 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/\")
 117          ))
 118
 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.
 126
 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
 129 buffer.
 130
 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.)
 134
 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"
 138                        (choice :value ""
 139                                (regexp :tag "Buffer regexp")
 140                                sexp)
 141                        (choice :value ""
 142                                (string :tag "Tag file or directory")
 143                                sexp)))
 144   :group 'etags)
 145
 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)
 151
 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.")
 156
 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."
 160   :type 'boolean
 161   :group 'etags)
 162
 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.)"
 166   :type 'boolean
 167   :group 'etags)
 168
 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."
 172   :type 'boolean
 173   :group 'etags)
 174
 175 \f
 176 ;; Buffer tag tables.
 177
 178 (defun buffer-tag-table-list ()
 179   "Returns a list (ordered) of the tags tables which should be used for
 180 the current buffer."
 181   (let (result)
 182     ;; Explicitly set buffer-tag-table
 183     (when buffer-tag-table
 184       (push buffer-tag-table result))
 185     ;; Current directory
 186     (when (file-readable-p (concat default-directory "TAGS"))
 187       (push (concat default-directory "TAGS") result))
 188     ;; Parent directory
 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)))
 192     ;; tag-table-alist
 193     (let ((key (or buffer-file-name
 194                    (concat default-directory (buffer-name))))
 195           expression)
 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)
 204                 (ignore-errors
 205                   (eval expression)))
 206           ;; Now evaluate the cdr of the alist item to get the name of
 207           ;; the tag table file.
 208           (setq expression (ignore-errors
 209                              (eval (cdr item))))
 210           (if (stringp expression)
 211               (push expression result)
 212             (error "Expression in tag-table-alist evaluated to non-string")))))
 213     (setq result
 214           (mapcar
 215            (lambda (name)
 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))))
 222            result))
 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))
 228     (when tags-file-name
 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)))
 232
 233 ;;;###autoload
 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) "
 239                                      default-directory
 240                                      (expand-file-name "TAGS" default-directory)
 241                                      t)))
 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))))
 252
 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."
 257   (interactive
 258    (list
 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))
 267
 268 \f
 269 ;; Manipulating the tag table buffer
 270
 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)
 275
 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)
 280
 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))
 290     (unless buf
 291       (if (file-readable-p tag-table)
 292           (setq buf (find-file-noselect tag-table)
 293                 check-name t)
 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
 304                      (yes-or-no-p
 305                       (format "Tags file %s has changed, read new contents? "
 306                               tag-table)))
 307                  (when tags-auto-read-changed-tag-files
 308                    (message "Tags file %s has changed, reading new contents..."
 309                             tag-table))
 310                  (revert-buffer t t)
 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
 320               ((nil) nil)
 321               ((t) t)
 322               ((ask)
 323                ;; don't bother asking for small ones
 324                (or (< (buffer-size) 20000)
 325                    (y-or-n-p
 326                     (format "Build tag completion table for %s? "
 327                             tag-table)))))
 328             ;; The user wants to build the table:
 329             (condition-case nil
 330                 (progn
 331                   (add-to-tag-completion-table)
 332                   (setq tag-table-completion-status t))
 333               ;; Allow user to C-g out correctly
 334               (quit
 335                (message "Tags completion table construction aborted")
 336                (setq tag-table-completion-status nil
 337                      quit-flag t)
 338                t))
 339           ;; The table is verboten.
 340           (setq tag-table-completion-status 'disabled))))
 341     buf))
 342
 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))
 348         prev size)
 349     (save-excursion
 350       (goto-char (point-min))
 351       (while (< (point) opoint)
 352         (forward-line 1)
 353         (end-of-line)
 354         (skip-chars-backward "^,\n")
 355         (setq prev (point)
 356               size (read (current-buffer)))
 357         (goto-char prev)
 358         (forward-line 1)
 359         ;; New include syntax
 360         ;;   filename,include
 361         ;; tacked on to the end of a tag file means use filename
 362         ;; as a tag file before giving up.
 363         ;; Skip it here.
 364         (unless (eq size 'include)
 365           (forward-char size)))
 366       (goto-char (1- prev))
 367       (buffer-substring (point) (point-at-bol)))))
 368
 369 (defun tag-table-include-files ()
 370   "Return all file names associated with `include' directives in a tag buffer."
 371   ;; New include syntax
 372   ;;   filename,include
 373   ;; tacked on to the end of a tag file means use filename as a
 374   ;; tag file before giving up.
 375   (let ((files nil))
 376     (save-excursion
 377       (goto-char (point-min))
 378       (while (re-search-forward "\f\n\\(.*\\),include$" nil t)
 379         (push (match-string 1) files)))
 380     files))
 381
 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))
 388         (while (not (eobp))
 389           (forward-line 1)
 390           (end-of-line)
 391           (skip-chars-backward "^,\n")
 392           (setq prev (point)
 393                 size (read (current-buffer)))
 394           (goto-char prev)
 395           (push (expand-file-name (buffer-substring (1- (point))
 396                                                     (point-at-bol))
 397                                   default-directory)
 398                 files)
 399           (forward-line 1)
 400           (forward-char size))
 401         (setq tag-table-files (nreverse files))))
 402     tag-table-files))
 403
 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
 407 this buffer uses."
 408   (apply #'nconc
 409          (mapcar #'tag-table-files (buffer-tag-table-list))))
 410
 411 \f
 412 ;; Building the completion table
 413
 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
 442
 443 ;; "^[^ ]+ +\\([^ ]+\\) "
 444
 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
 450
 451 (defvar tag-completion-table (make-vector 511 0))
 452
 453 (defvar tag-symbol)
 454 (defvar tag-table-symbol)
 455 (defvar tag-symbol-tables)
 456 (defvar buffer-tag-table-list)
 457
 458 (defmacro intern-tag-symbol (tag)
 459   `(progn
 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)))))
 465
 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-?"
 474       )
 475 (defconst tags-file-pattern "^\f\n\\(.+\\),[0-9]+\n")
 476
 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
 485         tag-symbol-tables
 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\\)\\'"
 497                                            filename)
 498                              'c-mode)
 499                             ((string-match "\\.\\(el\\|cl\\|lisp\\)\\'"
 500                                            filename)
 501                              'lisp-mode)
 502                             ((string-match "\\.scm\\'" filename)
 503                              'scheme-mode)
 504                             (t nil)))
 505       (set-syntax-table (cond ((and (eq file-type 'c-mode)
 506                                     c-mode-syntax-table)
 507                                c-mode-syntax-table)
 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]"))
 518                ;; DEFUN
 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:
 525               ;;)
 526               ((and (eq file-type 'c-mode)
 527                     (looking-at ".*\\["))
 528                ;; Array
 529                (cond ((not (looking-at tags-array-pattern))
 530                       (message "array definition doesn't fit pattern")
 531                       (setq name nil))
 532                      (t
 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)
 539                ;; ???
 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))
 544         (forward-line 1)))
 545     (or (eobp) (error "Bad TAGS file")))
 546   (message "Adding %s to tags completion table...done" buffer-file-name))
 547
 548 \f
 549 ;; Interactive find-tag
 550
 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
 554  arguments.")
 555
 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
 559  arguments.")
 560
 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)))
 564            (condition-case data
 565                (funcall find-tag-default-hook)
 566              (error
 567               (warn "Error in find-tag-default-hook signalled error: %s"
 568                     (error-message-string data))
 569               nil)))
 570       (symbol-near-point)))
 571
 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))
 578        (catch 'found
 579          (while tag-symbol-tables
 580            (when (memq (car tag-symbol-tables) buffer-tag-table-list)
 581              (throw 'found t))
 582            (setq tag-symbol-tables (cdr tag-symbol-tables))))))
 583
 584 (defun buffer-tag-table-symbol-list ()
 585   (mapcar (lambda (table-name)
 586             (intern table-name tag-completion-table))
 587           (buffer-tag-table-list)))
 588
 589 (defvar find-tag-history nil "History list for find-tag-tag.")
 590
 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)
 595     (setq tag-name
 596           (completing-read
 597            (if default
 598                (format "%s(default %s) " prompt default)
 599              prompt)
 600            tag-completion-table 'tag-completion-predicate nil nil
 601            'find-tag-history))
 602     (if (string-equal tag-name "")
 603         ;; #### - This is a really LAME way of doing it!  --Stig
 604         default                 ;indicate exact symbol match
 605       tag-name)))
 606
 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 ...).")
 610
 611 (defvar tags-loop-operate nil
 612   "Form for `tags-loop-continue' to eval to change one file.")
 613
 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.")
 620
 621 (autoload 'get-symbol-syntax-table "symbol-syntax")
 622
 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)))
 637     (cond (next
 638            (setq tagname (car last-tag-data))
 639            (setq tag-table-currently-matching-exact
 640                  (car (cdr (cdr last-tag-data)))))
 641           (t
 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))
 647     (save-excursion
 648       (catch 'found
 649         ;; Loop searching for exact matches and then inexact matches.
 650         (while (not (eq tag-table-currently-matching-exact 'neither))
 651           (cond (tmpnext
 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.
 656                  (setq tmpnext nil))
 657                 (t
 658                  (setq tag-tables (buffer-tag-table-list)
 659                        tag-table-point 1)))
 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
 666             (while tag-tables
 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
 674                 ;; tag searches?
 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
 680                        ;; already.
 681                        (or tag-table-currently-matching-exact
 682                            (letf (((syntax-table) exact-syntax-table))
 683                              (save-excursion
 684                                (goto-char (match-beginning 0))
 685                                (not (looking-at exact-tagname)))))
 686                        (throw 'found t))))
 687               (setq tag-tables
 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"
 693                (if next "more " "")
 694                (if exact "matching" "containing")
 695                tagname))
 696       (search-forward "\C-?")
 697       (setq file (expand-file-name (file-of-tag)
 698                                    ;; In XEmacs, this needs to be
 699                                    ;; relative to:
 700                                    (or (file-name-directory (car tag-tables))
 701                                        "./")))
 702       (setq linebeg (buffer-substring (1- (point)) (point-at-bol)))
 703       (search-forward ",")
 704       (setq startpos (read (current-buffer)))
 705       (setq last-tag-data
 706             (nconc (list tagname (point) tag-table-currently-matching-exact)
 707                    tag-tables))
 708       (setq buf (find-file-noselect file))
 709       (with-current-buffer buf
 710         (save-excursion
 711           (save-restriction
 712             (widen)
 713             ;; Here we search for PAT in the range [STARTPOS - OFFSET,
 714             ;; STARTPOS + OFFSET], with increasing values of OFFSET.
 715             ;;
 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).
 720             (setq offset 100)
 721             (setq pat (concat "^" (regexp-quote linebeg)))
 722             (or startpos (setq startpos (point-min)))
 723             (while (and (not found)
 724                         (progn
 725                           (goto-char (- startpos offset))
 726                           (not (bobp))))
 727               (setq found (re-search-forward pat (+ startpos offset) t))
 728               (setq offset (* 5 offset)))
 729             ;; Finally, try finding it anywhere in the buffer.
 730             (or found
 731                 (re-search-forward pat nil t)
 732                 (error "%s not found in %s" pat file))
 733             (beginning-of-line)
 734             (setq startpos (point)))))
 735       (cons buf startpos))))
 736
 737 ;;;###autoload
 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
 747 the tag.
 748
 749 This version of this function supports multiple active tags tables,
 750 and completion.
 751
 752 Variables of note:
 753
 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
 761                    '(nil nil)
 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.
 769     (if (or (not next)
 770             (not (memq last-command
 771                        '(find-tag find-tag-other-window tags-loop-continue))))
 772         (push-tag-mark))
 773     (if other-window
 774         (pop-to-buffer tag-buf)
 775       (switch-to-buffer tag-buf))
 776     (widen)
 777     (push-mark)
 778     (goto-char tag-point)
 779     (if find-tag-hook
 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.
 786   t)
 787
 788 ;;;###autoload
 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.
 798
 799 This version of this function supports multiple active tags tables,
 800 and completion.
 801
 802 Variables of note:
 803
 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
 811                    '(nil t)
 812                  (list (find-tag-tag "Find tag other window: "))))
 813   (if next
 814       (find-tag nil t)
 815     (find-tag tagname t)))
 816
 817 \f
 818 ;; Completion on tags in the buffer.
 819
 820 (defun complete-symbol (&optional table predicate prettify)
 821   (let* ((end (point))
 822          (beg (save-excursion
 823                 (backward-sexp 1)
 824                 ;;(while (= (char-syntax (following-char)) ?\')
 825                 ;;  (forward-char 1))
 826                 (skip-syntax-forward "'")
 827                 (point)))
 828          (pattern (buffer-substring beg end))
 829          (table (or table obarray))
 830          (completion (try-completion pattern table predicate)))
 831     (cond ((eq completion t))
 832           ((null completion)
 833            (error "Can't find completion for \"%s\"" pattern))
 834           ((not (string-equal pattern completion))
 835            (delete-region beg end)
 836            (insert completion))
 837           (t
 838            (message "Making completion list...")
 839            (let ((list (all-completions pattern table predicate)))
 840              (if prettify
 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")))))
 845
 846 ;;;###autoload
 847 (defun tag-complete-symbol ()
 848   "The function used to do tags-completion (using 'tag-completion-predicate)."
 849   (interactive)
 850   (let* ((buffer-tag-table-list (buffer-tag-table-symbol-list))
 851          tag-symbol-tables)
 852     (complete-symbol tag-completion-table 'tag-completion-predicate)))
 853
 854 \f
 855 ;; Applying a command to files mentioned in tag tables
 856
 857 (defvar next-file-list nil
 858   "List of files for next-file to process.")
 859
 860 ;;;###autoload
 861 (defun next-file (&optional initialize novisit)
 862   "Select next file among files in current tag table(s).
 863
 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.
 867
 868 Non-nil second argument NOVISIT means use a temporary buffer
 869 to save time and avoid uninteresting warnings.
 870
 871 Value is nil if the file was already visited;
 872 if the file was newly read in, the value is the filename."
 873   (interactive "P")
 874   (cond ((not initialize)
 875          ;; Not the first run.
 876          )
 877         ((eq initialize t)
 878          ;; Initialize the list from the tags table.
 879          (setq next-file-list (buffer-tag-table-files)))
 880         (t
 881          ;; Initialize the list by evalling the argument.
 882          (setq next-file-list (eval initialize))))
 883   (when (null next-file-list)
 884     (and novisit
 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))
 890          (new (not buf)))
 891     (pop next-file-list)
 892
 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)
 898       (erase-buffer)
 899       (insert-file-contents file nil))
 900     (widen)
 901     (when (> (point) (point-min))
 902       (push-mark nil t)
 903       (goto-char (point-min)))
 904     (and new file)))
 905
 906 ;;;###autoload
 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."
 916   (interactive)
 917   (let ((messaged nil)
 918         (more-files-p t)
 919         new)
 920     (while more-files-p
 921       ;; Scan files quickly for the first or next interesting one.
 922       (while (or first-time
 923                  (save-restriction
 924                    (widen)
 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.
 930         (if (or messaged
 931                 (and (not first-time)
 932                      (> (device-baud-rate) search-slow-speed)
 933                      (setq messaged t)))
 934             (lmessage 'progress
 935                 "Scanning file %s..." (or new buffer-file-name)))
 936         (setq first-time nil)
 937         (goto-char (point-min)))
 938
 939       ;; If we visited it in a temp buffer, visit it now for real.
 940       (if (and new tags-search-nuke-uninteresting-buffers)
 941           (let ((pos (point)))
 942             (erase-buffer)
 943             (set-buffer (find-file-noselect new))
 944             (widen)
 945             (goto-char pos)))
 946
 947       (switch-to-buffer (current-buffer))
 948
 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)))
 952     (and messaged
 953          (null tags-loop-operate)
 954          (message "Scanning file %s...found" buffer-file-name))))
 955
 956
 957 ;;;###autoload
 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].
 962
 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))))
 974
 975 ;;;###autoload
 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].
 981
 982 See documentation of variable `tag-table-alist'."
 983   (interactive
 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
 989                               ;; will see it.
 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)))
 994 \f
 995 ;; Miscellaneous
 996
 997 ;;;###autoload
 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 ")
1009     (princ file)
1010     (terpri)
1011     (save-excursion
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))
1018         (when
1019             (search-forward (concat "\f\n" (file-name-nondirectory file) ",")
1020                             nil t)
1021           (forward-line 1)
1022           (while (not (or (eobp) (looking-at "\f")))
1023             (princ (buffer-substring (point)
1024                                      (progn (skip-chars-forward "^\C-?")
1025                                             (point))))
1026             (terpri)
1027             (forward-line 1)))))))
1028
1029 ;;;###autoload
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 ")
1035     (prin1 string)
1036     (terpri)
1037     (save-excursion
1038       (visit-tags-table-buffer)
1039       (goto-char 1)
1040       (while (re-search-forward string nil t)
1041         (beginning-of-line)
1042         (princ (buffer-substring (point)
1043                                  (progn (skip-chars-forward "^\C-?")
1044                                         (point))))
1045         (terpri)
1046         (forward-line 1)))))
1047
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."
1051   (or tags-file-name
1052       (call-interactively 'visit-tags-table))
1053   (set-buffer (or (get-file-buffer tags-file-name)
1054                   (progn
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? ")
1059              (revert-buffer t t)
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)))
1063
1064 \f
1065 ;; Sample uses of find-tag-hook and find-tag-default-hook
1066
1067 ;; This is wrong.  We should either make this behavior default and
1068 ;; back it up, or not use it at all.  For now, I've commented it out.
1069 ;; --hniksic
1070
1071 ;; Example buffer-local tag finding
1072
1073 ;(add-hook 'emacs-lisp-mode-hook 'setup-emacs-lisp-default-tag-hook)
1074
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)))
1084
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))))
1090
1091 \f
1092 ;; Display short info on tag in minibuffer
1093
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))
1097
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
1104                    '(nil)
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
1111       (save-excursion
1112         (save-restriction
1113           (widen)
1114           (goto-char tag-point)
1115           (cond ((let ((case-fold-search nil))
1116                    (looking-at "^DEFUN[ \t]"))
1117                  (forward-sexp 1)
1118                  (down-list 1)
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"
1134                                     lname
1135                                     fname args
1136                                     (if (string-equal min max)
1137                                         min
1138                                       (format "from %s to %s" min max)))))
1139                 (t
1140                  (setq info
1141                        (buffer-substring
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
1148   t)
1149
1150 \f
1151 ;; Tag mark stack.
1152
1153 (defvar tag-mark-stack1 nil)
1154 (defvar tag-mark-stack2 nil)
1155
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]'."
1160   :type 'integer
1161   :group 'etags)
1162
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)))
1171
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))
1178     (or m-buf
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)
1184     (widen)
1185     (goto-char marker)))
1186
1187 (defun push-tag-mark ()
1188   (push-mark-on-stack 'tag-mark-stack1 tag-mark-stack-max))
1189
1190 ;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
1191
1192 ;;;###autoload
1193 (defun pop-tag-mark (arg)
1194   "Go to last tag position.
1195 `find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack.
1196 This function pops (and moves to) the tag at the top of this stack."
1197   (interactive "P")
1198   (if (not arg)
1199       (pop-mark-from-stack
1200        'tag-mark-stack1 'tag-mark-stack2 tag-mark-stack-max)
1201     (pop-mark-from-stack
1202      'tag-mark-stack2 'tag-mark-stack1 tag-mark-stack-max)))
1203
1204 \f
1205 (provide 'etags)
1206 (provide 'tags)
1207
1208 ;;; etags.el ends here