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@xemacs.org>
  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 default))
 602     tag-name))
 603
 604 (defvar last-tag-data nil
 605   "Information for continuing a tag search.
 606 Is of the form (TAG POINT MATCHING-EXACT TAG-TABLE TAG-TABLE ...).")
 607
 608 (defvar tags-loop-operate nil
 609   "Form for `tags-loop-continue' to eval to change one file.")
 610
 611 (defvar tags-loop-scan
 612   '(error "%s" (substitute-command-keys
 613                 "No \\[tags-search] or \\[tags-query-replace] in progress."))
 614   "Form for `tags-loop-continue' to eval to scan one file.
 615 If it returns non-nil, this file needs processing by evalling
 616 \`tags-loop-operate'.  Otherwise, move on to the next file.")
 617
 618 (autoload 'get-symbol-syntax-table "symbol-syntax")
 619
 620 (defun find-tag-internal (tagname)
 621   (let ((next (null tagname))
 622         (tmpnext (null tagname))
 623         ;; If tagname is a list: (TAGNAME), this indicates
 624         ;; requiring an exact symbol match.
 625         (exact (or tags-always-exact (consp tagname)))
 626         (normal-syntax-table (syntax-table))
 627         (exact-syntax-table (get-symbol-syntax-table (syntax-table)))
 628         tag-table-currently-matching-exact
 629         tag-target exact-tagname
 630         tag-tables tag-table-point file linebeg startpos buf
 631         offset found pat syn-tab)
 632     (when (consp tagname)
 633       (setq tagname (car tagname)))
 634     (cond (next
 635            (setq tagname (car last-tag-data))
 636            (setq tag-table-currently-matching-exact
 637                  (car (cdr (cdr last-tag-data)))))
 638           (t
 639            (setq tag-table-currently-matching-exact t)))
 640     ;; \_ in the tagname is used to indicate a symbol boundary.
 641     (setq exact-tagname (concat "\\_" tagname "\\_"))
 642     (while (string-match "\\\\_" exact-tagname)
 643       (aset exact-tagname (1- (match-end 0)) ?b))
 644     (save-excursion
 645       (catch 'found
 646         ;; Loop searching for exact matches and then inexact matches.
 647         (while (not (eq tag-table-currently-matching-exact 'neither))
 648           (cond (tmpnext
 649                  (setq tag-tables (cdr (cdr (cdr last-tag-data)))
 650                        tag-table-point (car (cdr last-tag-data)))
 651                  ;; Start from the beginning of the table list on the
 652                  ;; next iteration of the loop.
 653                  (setq tmpnext nil))
 654                 (t
 655                  (setq tag-tables (buffer-tag-table-list)
 656                        tag-table-point 1)))
 657           (if tag-table-currently-matching-exact
 658               (setq tag-target exact-tagname
 659                     syn-tab exact-syntax-table)
 660             (setq tag-target tagname
 661                   syn-tab normal-syntax-table))
 662           (with-search-caps-disable-folding tag-target t
 663             (while tag-tables
 664               (set-buffer (get-tag-table-buffer (car tag-tables)))
 665               (bury-buffer (current-buffer))
 666               (goto-char (or tag-table-point (point-min)))
 667               (setq tag-table-point nil)
 668               (letf (((syntax-table) syn-tab)
 669                      (case-fold-search nil))
 670                 ;; #### should there be support for non-regexp
 671                 ;; tag searches?
 672                 (while (re-search-forward tag-target nil t)
 673                   (and (save-match-data
 674                          (looking-at "[^\n\C-?]*\C-?"))
 675                        ;; If we're looking for inexact matches, skip
 676                        ;; exact matches since we've visited them
 677                        ;; already.
 678                        (or tag-table-currently-matching-exact
 679                            (letf (((syntax-table) exact-syntax-table))
 680                              (save-excursion
 681                                (goto-char (match-beginning 0))
 682                                (not (looking-at exact-tagname)))))
 683                        (throw 'found t))))
 684               (setq tag-tables
 685                     (nconc (tag-table-include-files) (cdr tag-tables)))))
 686           (if (and (not exact) (eq tag-table-currently-matching-exact t))
 687               (setq tag-table-currently-matching-exact nil)
 688             (setq tag-table-currently-matching-exact 'neither)))
 689         (error "No %sentries %s %s"
 690                (if next "more " "")
 691                (if exact "matching" "containing")
 692                tagname))
 693       (search-forward "\C-?")
 694       (setq file (expand-file-name (file-of-tag)
 695                                    ;; In XEmacs, this needs to be
 696                                    ;; relative to:
 697                                    (or (file-name-directory (car tag-tables))
 698                                        "./")))
 699       (setq linebeg (buffer-substring (1- (point)) (point-at-bol)))
 700       (search-forward ",")
 701       (setq startpos (read (current-buffer)))
 702       (setq last-tag-data
 703             (nconc (list tagname (point) tag-table-currently-matching-exact)
 704                    tag-tables))
 705       (setq buf (find-file-noselect file))
 706       (with-current-buffer buf
 707         (save-excursion
 708           (save-restriction
 709             (widen)
 710             ;; Here we search for PAT in the range [STARTPOS - OFFSET,
 711             ;; STARTPOS + OFFSET], with increasing values of OFFSET.
 712             ;;
 713             ;; We used to set the initial offset to 1000, but the
 714             ;; actual sources show that finer-grained control is
 715             ;; needed (e.g. two `hash_string's in src/symbols.c.)  So,
 716             ;; I changed 100 to 100, and (* 3 offset) to (* 5 offset).
 717             (setq offset 100)
 718             (setq pat (concat "^" (regexp-quote linebeg)))
 719             (or startpos (setq startpos (point-min)))
 720             (while (and (not found)
 721                         (progn
 722                           (goto-char (- startpos offset))
 723                           (not (bobp))))
 724               (setq found (re-search-forward pat (+ startpos offset) t))
 725               (setq offset (* 5 offset)))
 726             ;; Finally, try finding it anywhere in the buffer.
 727             (or found
 728                 (re-search-forward pat nil t)
 729                 (error "%s not found in %s" pat file))
 730             (beginning-of-line)
 731             (setq startpos (point)))))
 732       (cons buf startpos))))
 733
 734 ;;;###autoload
 735 (defun find-tag (tagname &optional other-window)
 736   "*Find tag whose name contains TAGNAME.
 737  Selects the buffer that the tag is contained in
 738 and puts point at its definition.
 739  If TAGNAME is a null string, the expression in the buffer
 740 around or before point is used as the tag name.
 741  If called interactively with a numeric argument, searches for the next tag
 742 in the tag table that matches the tagname used in the previous find-tag.
 743  If second arg OTHER-WINDOW is non-nil, uses another window to display
 744 the tag.
 745
 746 This version of this function supports multiple active tags tables,
 747 and completion.
 748
 749 Variables of note:
 750
 751   tag-table-alist               controls which tables apply to which buffers
 752   tags-file-name                a default tags table
 753   tags-build-completion-table   controls completion behavior
 754   buffer-tag-table              another way of specifying a buffer-local table
 755   make-tags-files-invisible     whether tags tables should be very hidden
 756   tag-mark-stack-max            how many tags-based hops to remember"
 757   (interactive (if current-prefix-arg
 758                    '(nil nil)
 759                  (list (find-tag-tag "Find tag: ") nil)))
 760   (let* ((local-find-tag-hook find-tag-hook)
 761          (next (null tagname))
 762          (result (find-tag-internal tagname))
 763          (tag-buf (car result))
 764          (tag-point (cdr result)))
 765     ;; Push old position on the tags mark stack.
 766     (if (or (not next)
 767             (not (memq last-command
 768                        '(find-tag find-tag-other-window tags-loop-continue))))
 769         (push-tag-mark))
 770     (if other-window
 771         (pop-to-buffer tag-buf)
 772       (switch-to-buffer tag-buf))
 773     (widen)
 774     (push-mark)
 775     (goto-char tag-point)
 776     (if find-tag-hook
 777                 (run-hooks 'find-tag-hook)
 778       (if local-find-tag-hook
 779                   (run-hooks 'local-find-tag-hook))))
 780   (setq tags-loop-scan (list 'find-tag nil nil)
 781                 tags-loop-operate nil)
 782   ;; Return t in case used as the tags-loop-scan.
 783   t)
 784
 785 ;;;###autoload
 786 (defun find-tag-other-window (tagname &optional next)
 787   "*Find tag whose name contains TAGNAME.
 788  Selects the buffer that the tag is contained in in another window
 789 and puts point at its definition.
 790  If TAGNAME is a null string, the expression in the buffer
 791 around or before point is used as the tag name.
 792  If second arg NEXT is non-nil (interactively, with prefix arg),
 793 searches for the next tag in the tag table
 794 that matches the tagname used in the previous find-tag.
 795
 796 This version of this function supports multiple active tags tables,
 797 and completion.
 798
 799 Variables of note:
 800
 801   tag-table-alist               controls which tables apply to which buffers
 802   tags-file-name                a default tags table
 803   tags-build-completion-table   controls completion behavior
 804   buffer-tag-table              another way of specifying a buffer-local table
 805   make-tags-files-invisible     whether tags tables should be very hidden
 806   tag-mark-stack-max            how many tags-based hops to remember"
 807   (interactive (if current-prefix-arg
 808                    '(nil t)
 809                  (list (find-tag-tag "Find tag other window: "))))
 810   (if next
 811       (find-tag nil t)
 812     (find-tag tagname t)))
 813
 814 \f
 815 ;; Completion on tags in the buffer.
 816
 817 (defun complete-symbol (&optional table predicate prettify)
 818   (let* ((end (point))
 819          (beg (save-excursion
 820                 (backward-sexp 1)
 821                 ;;(while (= (char-syntax (following-char)) ?\')
 822                 ;;  (forward-char 1))
 823                 (skip-syntax-forward "'")
 824                 (point)))
 825          (pattern (buffer-substring beg end))
 826          (table (or table obarray))
 827          (completion (try-completion pattern table predicate)))
 828     (cond ((eq completion t))
 829           ((null completion)
 830            (error "Can't find completion for \"%s\"" pattern))
 831           ((not (string-equal pattern completion))
 832            (delete-region beg end)
 833            (insert completion))
 834           (t
 835            (message "Making completion list...")
 836            (let ((list (all-completions pattern table predicate)))
 837              (if prettify
 838                  (setq list (funcall prettify list)))
 839              (with-output-to-temp-buffer "*Help*"
 840                (display-completion-list list)))
 841            (message "Making completion list...%s" "done")))))
 842
 843 ;;;###autoload
 844 (defun tag-complete-symbol ()
 845   "The function used to do tags-completion (using 'tag-completion-predicate)."
 846   (interactive)
 847   (let* ((buffer-tag-table-list (buffer-tag-table-symbol-list))
 848          tag-symbol-tables)
 849     (complete-symbol tag-completion-table 'tag-completion-predicate)))
 850
 851 \f
 852 ;; Applying a command to files mentioned in tag tables
 853
 854 (defvar next-file-list nil
 855   "List of files for next-file to process.")
 856
 857 ;;;###autoload
 858 (defun next-file (&optional initialize novisit)
 859   "Select next file among files in current tag table(s).
 860
 861 A first argument of t (prefix arg, if interactive) initializes to the
 862 beginning of the list of files in the (first) tags table.  If the argument
 863 is neither nil nor t, it is evalled to initialize the list of files.
 864
 865 Non-nil second argument NOVISIT means use a temporary buffer
 866 to save time and avoid uninteresting warnings.
 867
 868 Value is nil if the file was already visited;
 869 if the file was newly read in, the value is the filename."
 870   (interactive "P")
 871   (cond ((not initialize)
 872          ;; Not the first run.
 873          )
 874         ((eq initialize t)
 875          ;; Initialize the list from the tags table.
 876          (setq next-file-list (buffer-tag-table-files)))
 877         (t
 878          ;; Initialize the list by evalling the argument.
 879          (setq next-file-list (eval initialize))))
 880   (when (null next-file-list)
 881     (and novisit
 882          (get-buffer " *next-file*")
 883          (kill-buffer " *next-file*"))
 884     (error "All files processed"))
 885   (let* ((file (car next-file-list))
 886          (buf (get-file-buffer file))
 887          (new (not buf)))
 888     (pop next-file-list)
 889
 890     (if (not (and new novisit))
 891         (switch-to-buffer (find-file-noselect file novisit) t)
 892       ;; Like find-file, but avoids random junk.
 893       (set-buffer (get-buffer-create " *next-file*"))
 894       (kill-all-local-variables)
 895       (erase-buffer)
 896       (insert-file-contents file nil))
 897     (widen)
 898     (when (> (point) (point-min))
 899       (push-mark nil t)
 900       (goto-char (point-min)))
 901     (and new file)))
 902
 903 ;;;###autoload
 904 (defun tags-loop-continue (&optional first-time)
 905   "Continue last \\[tags-search] or \\[tags-query-replace] command.
 906 Used noninteractively with non-nil argument to begin such a command (the
 907 argument is passed to `next-file', which see).
 908 Two variables control the processing we do on each file:
 909 the value of `tags-loop-scan' is a form to be executed on each file
 910 to see if it is interesting (it returns non-nil if so)
 911 and `tags-loop-operate' is a form to execute to operate on an interesting file
 912 If the latter returns non-nil, we exit; otherwise we scan the next file."
 913   (interactive)
 914   (let ((messaged nil)
 915         (more-files-p t)
 916         new)
 917     (while more-files-p
 918       ;; Scan files quickly for the first or next interesting one.
 919       (while (or first-time
 920                  (save-restriction
 921                    (widen)
 922                    (not (eval tags-loop-scan))))
 923         (setq new (next-file first-time
 924                              tags-search-nuke-uninteresting-buffers))
 925         ;; If NEW is non-nil, we got a temp buffer,
 926         ;; and NEW is the file name.
 927         (if (or messaged
 928                 (and (not first-time)
 929                      (> (device-baud-rate) search-slow-speed)
 930                      (setq messaged t)))
 931             (lmessage 'progress
 932                 "Scanning file %s..." (or new buffer-file-name)))
 933         (setq first-time nil)
 934         (goto-char (point-min)))
 935
 936       ;; If we visited it in a temp buffer, visit it now for real.
 937       (if (and new tags-search-nuke-uninteresting-buffers)
 938           (let ((pos (point)))
 939             (erase-buffer)
 940             (set-buffer (find-file-noselect new))
 941             (widen)
 942             (goto-char pos)))
 943
 944       (switch-to-buffer (current-buffer))
 945
 946       ;; Now operate on the file.
 947       ;; If value is non-nil, continue to scan the next file.
 948       (setq more-files-p (eval tags-loop-operate)))
 949     (and messaged
 950          (null tags-loop-operate)
 951          (message "Scanning file %s...found" buffer-file-name))))
 952
 953
 954 ;;;###autoload
 955 (defun tags-search (regexp &optional file-list-form)
 956   "Search through all files listed in tags table for match for REGEXP.
 957 Stops when a match is found.
 958 To continue searching for next match, use command \\[tags-loop-continue].
 959
 960 See documentation of variable `tag-table-alist'."
 961   (interactive "sTags search (regexp): ")
 962   (if (and (equal regexp "")
 963            (eq (car tags-loop-scan) 'with-search-caps-disable-folding)
 964            (null tags-loop-operate))
 965       ;; Continue last tags-search as if by `M-,'.
 966       (tags-loop-continue nil)
 967     (setq tags-loop-scan `(with-search-caps-disable-folding ,regexp t
 968                             (re-search-forward ,regexp nil t))
 969           tags-loop-operate nil)
 970     (tags-loop-continue (or file-list-form t))))
 971
 972 ;;;###autoload
 973 (defun tags-query-replace (from to &optional delimited file-list-form)
 974   "Query-replace-regexp FROM with TO through all files listed in tags table.
 975 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
 976 If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
 977 with the command \\[tags-loop-continue].
 978
 979 See documentation of variable `tag-table-alist'."
 980   (interactive
 981    "sTags query replace (regexp): \nsTags query replace %s by: \nP")
 982   (setq tags-loop-scan `(with-search-caps-disable-folding ,from t
 983                           (if (re-search-forward ,from nil t)
 984                               ;; When we find a match, move back
 985                               ;; to the beginning of it so perform-replace
 986                               ;; will see it.
 987                               (progn (goto-char (match-beginning 0)) t)))
 988         tags-loop-operate (list 'perform-replace from to t t
 989                                 (not (null delimited))))
 990    (tags-loop-continue (or file-list-form t)))
 991 \f
 992 ;; Miscellaneous
 993
 994 ;;;###autoload
 995 (defun list-tags (file)
 996   "Display list of tags in FILE."
 997   (interactive (list (read-file-name
 998                       (if (buffer-file-name)
 999                           (format "List tags (in file, %s by default): "
1000                                   (file-name-nondirectory (buffer-file-name)))
1001                         "List tags (in file): ")
1002                       nil (buffer-file-name) t)))
1003   (find-file-noselect file)
1004   (with-output-to-temp-buffer "*Tags List*"
1005     (princ "Tags in file ")
1006     (princ file)
1007     (terpri)
1008     (save-excursion
1009       (dolist (tags-file (with-current-buffer (get-file-buffer file)
1010                            (buffer-tag-table-list)))
1011         ;; We don't want completions getting in the way.
1012         (let ((tags-build-completion-table nil))
1013           (set-buffer (get-tag-table-buffer tags-file)))
1014         (goto-char (point-min))
1015         (when
1016             (search-forward (concat "\f\n" (file-name-nondirectory file) ",")
1017                             nil t)
1018           (forward-line 1)
1019           (while (not (or (eobp) (looking-at "\f")))
1020             (princ (buffer-substring (point)
1021                                      (progn (skip-chars-forward "^\C-?")
1022                                             (point))))
1023             (terpri)
1024             (forward-line 1)))))))
1025
1026 ;;;###autoload
1027 (defun tags-apropos (string)
1028   "Display list of all tags in tag table REGEXP matches."
1029   (interactive "sTag apropos (regexp): ")
1030   (with-output-to-temp-buffer "*Tags List*"
1031     (princ "Tags matching regexp ")
1032     (prin1 string)
1033     (terpri)
1034     (save-excursion
1035       (visit-tags-table-buffer)
1036       (goto-char 1)
1037       (while (re-search-forward string nil t)
1038         (beginning-of-line)
1039         (princ (buffer-substring (point)
1040                                  (progn (skip-chars-forward "^\C-?")
1041                                         (point))))
1042         (terpri)
1043         (forward-line 1)))))
1044
1045 ;; #### copied from tags.el.  This function is *very* big in FSF.
1046 (defun visit-tags-table-buffer ()
1047   "Select the buffer containing the current tag table."
1048   (or tags-file-name
1049       (call-interactively 'visit-tags-table))
1050   (set-buffer (or (get-file-buffer tags-file-name)
1051                   (progn
1052                     (setq tag-table-files nil)
1053                     (find-file-noselect tags-file-name))))
1054   (or (verify-visited-file-modtime (get-file-buffer tags-file-name))
1055       (cond ((yes-or-no-p "Tags file has changed, read new contents? ")
1056              (revert-buffer t t)
1057              (setq tag-table-files nil))))
1058   (or (eq (char-after 1) ?\^L)
1059       (error "File %s not a valid tag table" tags-file-name)))
1060
1061 \f
1062 ;; Sample uses of find-tag-hook and find-tag-default-hook
1063
1064 ;; This is wrong.  We should either make this behavior default and
1065 ;; back it up, or not use it at all.  For now, I've commented it out.
1066 ;; --hniksic
1067
1068 ;; Example buffer-local tag finding
1069
1070 ;(add-hook 'emacs-lisp-mode-hook 'setup-emacs-lisp-default-tag-hook)
1071
1072 ;(defun setup-emacs-lisp-default-tag-hook ()
1073 ;  (cond ((eq major-mode 'emacs-lisp-mode)
1074 ;        (make-variable-buffer-local 'find-tag-default-hook)
1075 ;        (setq find-tag-default-hook 'emacs-lisp-default-tag))))
1076 ;;; Run it once immediately
1077 ;(setup-emacs-lisp-default-tag-hook)
1078 ;(when (get-buffer "*scratch*")
1079 ;  (with-current-buffer "*scratch*"
1080 ;    (setup-emacs-lisp-default-tag-hook)))
1081
1082 ;(defun emacs-lisp-default-tag ()
1083 ;  "Function to return a default tag for Emacs-Lisp mode."
1084 ;  (let ((tag (or (variable-at-point)
1085 ;                (function-at-point))))
1086 ;    (if tag (symbol-name tag))))
1087
1088 \f
1089 ;; Display short info on tag in minibuffer
1090
1091 ;; Don't pollute `M-?' -- we may need it for more important stuff.  --hniksic
1092 ;(if (null (lookup-key esc-map "?"))
1093 ;    (define-key esc-map "?" 'display-tag-info))
1094
1095 (defun display-tag-info (tagname)
1096   "Prints a description of the first tag matching TAGNAME in the echo area.
1097 If this is an elisp function, prints something like \"(defun foo (x y z)\".
1098 That is, is prints the first line of the definition of the form.
1099 If this is a C-defined elisp function, it does something more clever."
1100   (interactive (if current-prefix-arg
1101                    '(nil)
1102                  (list (find-tag-tag "Display tag info: "))))
1103   (let* ((results (find-tag-internal tagname))
1104          (tag-buf (car results))
1105          (tag-point (cdr results))
1106          info lname min max fname args)
1107     (with-current-buffer tag-buf
1108       (save-excursion
1109         (save-restriction
1110           (widen)
1111           (goto-char tag-point)
1112           (cond ((let ((case-fold-search nil))
1113                    (looking-at "^DEFUN[ \t]"))
1114                  (forward-sexp 1)
1115                  (down-list 1)
1116                  (setq lname (read (current-buffer))
1117                        fname (buffer-substring
1118                               (progn (forward-sexp 1) (point))
1119                               (progn (backward-sexp 1) (point)))
1120                        min (buffer-substring
1121                             (progn (forward-sexp 3) (point))
1122                             (progn (backward-sexp 1) (point)))
1123                        max (buffer-substring
1124                             (progn (forward-sexp 2) (point))
1125                             (progn (backward-sexp 1) (point))))
1126                  (backward-up-list 1)
1127                  (setq args (buffer-substring
1128                              (progn (forward-sexp 2) (point))
1129                              (progn (backward-sexp 1) (point))))
1130                  (setq info (format "Elisp: %s, C: %s %s, #args: %s"
1131                                     lname
1132                                     fname args
1133                                     (if (string-equal min max)
1134                                         min
1135                                       (format "from %s to %s" min max)))))
1136                 (t
1137                  (setq info
1138                        (buffer-substring
1139                         (progn (beginning-of-line) (point))
1140                         (progn (end-of-line) (point)))))))))
1141     (message "%s" info))
1142   (setq tags-loop-scan '(display-tag-info nil)
1143         tags-loop-operate nil)
1144   ;; Always return non-nil
1145   t)
1146
1147 \f
1148 ;; Tag mark stack.
1149
1150 (defvar tag-mark-stack1 nil)
1151 (defvar tag-mark-stack2 nil)
1152
1153 (defcustom tag-mark-stack-max 16
1154   "*The maximum number of elements kept on the mark-stack used
1155 by tags-search.  See also the commands `\\[push-tag-mark]' and
1156 and `\\[pop-tag-mark]'."
1157   :type 'integer
1158   :group 'etags)
1159
1160 (defun push-mark-on-stack (stack-symbol &optional max-size)
1161   (let ((stack (symbol-value stack-symbol)))
1162     (push (point-marker) stack)
1163     (cond ((and max-size
1164                 (> (length stack) max-size))
1165            (set-marker (car (nthcdr max-size stack)) nil)
1166            (setcdr (nthcdr (1- max-size) stack) nil)))
1167     (set stack-symbol stack)))
1168
1169 (defun pop-mark-from-stack (stack-symbol1 stack-symbol2 &optional max-size)
1170   (let* ((stack (or (symbol-value stack-symbol1)
1171                     (error "No more tag marks on stack")))
1172          (marker (car stack))
1173          (m-buf (marker-buffer marker)))
1174     (set stack-symbol1 (cdr stack))
1175     (or m-buf
1176         (error "Marker has no buffer"))
1177     (or (buffer-live-p m-buf)
1178         (error "Buffer has been killed"))
1179     (push-mark-on-stack stack-symbol2 max-size)
1180     (switch-to-buffer m-buf)
1181     (widen)
1182     (goto-char marker)))
1183
1184 (defun push-tag-mark ()
1185   (push-mark-on-stack 'tag-mark-stack1 tag-mark-stack-max))
1186
1187 ;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
1188
1189 ;;;###autoload
1190 (defun pop-tag-mark (arg)
1191   "Go to last tag position.
1192 `find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack.
1193 This function pops (and moves to) the tag at the top of this stack."
1194   (interactive "P")
1195   (if (not arg)
1196       (pop-mark-from-stack
1197        'tag-mark-stack1 'tag-mark-stack2 tag-mark-stack-max)
1198     (pop-mark-from-stack
1199      'tag-mark-stack2 'tag-mark-stack1 tag-mark-stack-max)))
1200
1201 \f
1202 (provide 'etags)
1203 (provide 'tags)
1204
1205 ;;; etags.el ends here