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            (key (if (eq system-type 'windows-nt)
 196                     (replace-in-string key "\\\\" "/")
 197                   key))
 198            expression)
 199       (dolist (item tag-table-alist)
 200         (setq expression (car item))
 201         ;; If the car of the alist item is a string, apply it as a regexp
 202         ;; to the buffer-file-name.  Otherwise, evaluate it.  If the
 203         ;; regexp matches, or the expression evaluates non-nil, then this
 204         ;; item in tag-table-alist applies to this buffer.
 205         (when (if (stringp expression)
 206                   (string-match expression key)
 207                 (ignore-errors
 208                   (eval expression)))
 209           ;; Now evaluate the cdr of the alist item to get the name of
 210           ;; the tag table file.
 211           (setq expression (ignore-errors
 212                              (eval (cdr item))))
 213           (if (stringp expression)
 214               (push expression result)
 215             (error "Expression in tag-table-alist evaluated to non-string")))))
 216     (setq result
 217           (mapcar
 218            (lambda (name)
 219              (when (file-directory-p name)
 220                (setq name (concat (file-name-as-directory name) "TAGS")))
 221              (and (file-readable-p name)
 222                   ;; get-tag-table-buffer has side-effects
 223                   (symbol-value-in-buffer 'buffer-file-name
 224                                           (get-tag-table-buffer name))))
 225            result))
 226     (setq result (delq nil result))
 227     ;; If no TAGS file has been found, ask the user explicitly.
 228     ;; #### tags-file-name is *evil*.
 229     (or result tags-file-name
 230         (call-interactively 'visit-tags-table))
 231     (when tags-file-name
 232       (setq result (nconc result (list tags-file-name))))
 233     (or result (error "Buffer has no associated tag tables"))
 234     (delete-duplicates (nreverse result) :test 'equal)))
 235
 236 ;;;###autoload
 237 (defun visit-tags-table (file)
 238   "Tell tags commands to use tags table file FILE when all else fails.
 239 FILE should be the name of a file created with the `etags' program.
 240 A directory name is ok too; it means file TAGS in that directory."
 241   (interactive (list (read-file-name "Visit tags table: (default TAGS) "
 242                                      default-directory
 243                                      (expand-file-name "TAGS" default-directory)
 244                                      t)))
 245   (if (string-equal file "")
 246       (setq tags-file-name nil)
 247     (setq file (expand-file-name file))
 248     (when (file-directory-p file)
 249       (setq file (expand-file-name "TAGS" file)))
 250     ;; It used to be that, if a user pressed RET by mistake, the bogus
 251     ;; `tags-file-name' would remain, causing the error at
 252     ;; `buffer-tag-table'.
 253     (when (file-exists-p file)
 254       (setq tags-file-name file))))
 255
 256 (defun set-buffer-tag-table (file)
 257   "In addition to the tags tables specified by the variable `tag-table-alist',
 258 each buffer can have one additional table.  This command sets that.
 259 See the documentation for the variable `tag-table-alist' for more information."
 260   (interactive
 261    (list
 262      (read-file-name "Visit tags table: (directory sufficient) "
 263                      nil default-directory t)))
 264   (or file (error "No TAGS file name supplied"))
 265   (setq file (expand-file-name file))
 266   (when (file-directory-p file)
 267     (setq file (expand-file-name "TAGS" file)))
 268   (or (file-exists-p file) (error "TAGS file missing: %s" file))
 269   (setq buffer-tag-table file))
 270
 271 \f
 272 ;; Manipulating the tag table buffer
 273
 274 (defconst tag-table-completion-status nil
 275   "Indicates whether a completion table has been built.
 276 Either nil, t, or `disabled'.")
 277 (make-variable-buffer-local 'tag-table-completion-status)
 278
 279 (defconst tag-table-files nil
 280   "If the current buffer is a TAGS table, this holds a list of the files
 281 referenced by this file, or nil if that hasn't been computed yet.")
 282 (make-variable-buffer-local 'tag-table-files)
 283
 284 (defun get-tag-table-buffer (tag-table)
 285   "Returns a buffer visiting the given TAGS table.
 286 If appropriate, reverting the buffer, and possibly build a completion-table."
 287   (or (stringp tag-table)
 288       (error "Bad tags file name supplied: %s" tag-table))
 289   ;; Remove symbolic links from name.
 290   (setq tag-table (symlink-expand-file-name tag-table))
 291   (let (buf build-completion check-name)
 292     (setq buf (get-file-buffer tag-table))
 293     (unless buf
 294       (if (file-readable-p tag-table)
 295           (setq buf (find-file-noselect tag-table)
 296                 check-name t)
 297         (error "No such tags file: %s" tag-table)))
 298     (with-current-buffer buf
 299       ;; Make the TAGS buffer invisible.
 300       (when (and check-name
 301                  make-tags-files-invisible
 302                  (string-match "\\`[^ ]" (buffer-name)))
 303         (rename-buffer (generate-new-buffer-name
 304                         (concat " " (buffer-name)))))
 305       (or (verify-visited-file-modtime buf)
 306           (cond ((or tags-auto-read-changed-tag-files
 307                      (yes-or-no-p
 308                       (format "Tags file %s has changed, read new contents? "
 309                               tag-table)))
 310                  (when tags-auto-read-changed-tag-files
 311                    (message "Tags file %s has changed, reading new contents..."
 312                             tag-table))
 313                  (revert-buffer t t)
 314                  (when (eq tag-table-completion-status t)
 315                    (setq tag-table-completion-status nil))
 316                  (setq tag-table-files nil))))
 317       (or (eq (char-after 1) ?\f)
 318           (error "File %s not a valid tags file" tag-table))
 319       (or (memq tag-table-completion-status '(t disabled))
 320           (setq build-completion t))
 321       (when build-completion
 322         (if (ecase tags-build-completion-table
 323               ((nil) nil)
 324               ((t) t)
 325               ((ask)
 326                ;; don't bother asking for small ones
 327                (or (< (buffer-size) 20000)
 328                    (y-or-n-p
 329                     (format "Build tag completion table for %s? "
 330                             tag-table)))))
 331             ;; The user wants to build the table:
 332             (condition-case nil
 333                 (progn
 334                   (add-to-tag-completion-table)
 335                   (setq tag-table-completion-status t))
 336               ;; Allow user to C-g out correctly
 337               (quit
 338                (message "Tags completion table construction aborted")
 339                (setq tag-table-completion-status nil
 340                      quit-flag t)
 341                t))
 342           ;; The table is verboten.
 343           (setq tag-table-completion-status 'disabled))))
 344     buf))
 345
 346 (defun file-of-tag ()
 347   "Return the file name of the file whose tags point is within.
 348 Assumes the tag table is the current buffer.
 349 File name returned is relative to tag table file's directory."
 350   (let ((opoint (point))
 351         prev size)
 352     (save-excursion
 353       (goto-char (point-min))
 354       (while (< (point) opoint)
 355         (forward-line 1)
 356         (end-of-line)
 357         (skip-chars-backward "^,\n")
 358         (setq prev (point)
 359               size (read (current-buffer)))
 360         (goto-char prev)
 361         (forward-line 1)
 362         ;; New include syntax
 363         ;;   filename,include
 364         ;; tacked on to the end of a tag file means use filename
 365         ;; as a tag file before giving up.
 366         ;; Skip it here.
 367         (unless (eq size 'include)
 368           (forward-char size)))
 369       (goto-char (1- prev))
 370       (buffer-substring (point) (point-at-bol)))))
 371
 372 (defun tag-table-include-files ()
 373   "Return all file names associated with `include' directives in a tag buffer."
 374   ;; New include syntax
 375   ;;   filename,include
 376   ;; tacked on to the end of a tag file means use filename as a
 377   ;; tag file before giving up.
 378   (let ((files nil))
 379     (save-excursion
 380       (goto-char (point-min))
 381       (while (re-search-forward "\f\n\\(.*\\),include$" nil t)
 382         (push (match-string 1) files)))
 383     files))
 384
 385 (defun tag-table-files (tag-table)
 386   "Returns a list of the files referenced by the named TAGS table."
 387   (with-current-buffer (get-tag-table-buffer tag-table)
 388     (unless tag-table-files
 389       (let (files prev size)
 390         (goto-char (point-min))
 391         (while (not (eobp))
 392           (forward-line 1)
 393           (end-of-line)
 394           (skip-chars-backward "^,\n")
 395           (setq prev (point)
 396                 size (read (current-buffer)))
 397           (goto-char prev)
 398           (push (expand-file-name (buffer-substring (1- (point))
 399                                                     (point-at-bol))
 400                                   default-directory)
 401                 files)
 402           (forward-line 1)
 403           (forward-char size))
 404         (setq tag-table-files (nreverse files))))
 405     tag-table-files))
 406
 407 ;; #### should this be on previous page?
 408 (defun buffer-tag-table-files ()
 409   "Returns a list of all files referenced by all TAGS tables that
 410 this buffer uses."
 411   (apply #'append
 412          (mapcar #'tag-table-files (buffer-tag-table-list))))
 413
 414 \f
 415 ;; Building the completion table
 416
 417 ;; Test cases for building completion table; must handle these properly:
 418 ;; Lisp_Int, XSETINT, current_column \7f60,2282
 419 ;;         Lisp_Int, XSETINT, point>NumCharacters ? 0 : CharAt(\7f363,9935
 420 ;;         Lisp_Int, XSETINT, point<=FirstCharacter ? 0 : CharAt(\7f366,10108
 421 ;;       point<=FirstCharacter || CharAt(\7f378,10630
 422 ;;       point>NumCharacters || CharAt(\7f382,10825
 423 ;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,\7f191,4562
 424 ;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,\7f191,4562
 425 ;; DEFUN ("*", Ftimes,\7f1172,32079
 426 ;; DEFUN ("/=", Fneq,\7f1035,28839
 427 ;; defun_internal \7f4199,101362
 428 ;; int pure[PURESIZE / sizeof \7f53,1564
 429 ;; char staticvec1[NSTATICS * sizeof \7f667,17608
 430 ;;  Date: 04 May 87 23:53:11 PDT \7f26,1077
 431 ;; #define anymacroname(\7f324,4344
 432 ;; (define-key ctl-x-map \7f311,11784
 433 ;; (define-abbrev-table 'c-mode-abbrev-table \7f24,1016
 434 ;; static char *skip_white(\7f116,3443
 435 ;; static foo \7f348,11643
 436 ;; (defun texinfo-insert-@code \7f91,3358
 437 ;; (defvar texinfo-kindex)\7f29,1105
 438 ;; (defun texinfo-format-\. \7f548,18376
 439 ;; (defvar sm::menu-kludge-y \7f621,22726
 440 ;; (defvar *mouse-drag-window* \7f103,3642
 441 ;; (defun simula-back-level(\7f317,11263
 442 ;; } DPxAC,\7f380,14024
 443 ;; } BM_QCB;\7f69,2990
 444 ;; #define MTOS_DONE\t
 445
 446 ;; "^[^ ]+ +\\([^ ]+\\) "
 447
 448 ;; void *find_cactus_segment(\7f116,2444
 449 ;; void *find_pdb_segment(\7f162,3688
 450 ;; void init_dclpool(\7f410,10739
 451 ;; WORD insert_draw_command(\7f342,8881
 452 ;; void *req_pdbmem(\7f579,15574
 453
 454 (defvar tag-completion-table (make-vector 511 0))
 455
 456 (defvar tag-symbol)
 457 (defvar tag-table-symbol)
 458 (defvar tag-symbol-tables)
 459 (defvar buffer-tag-table-list)
 460
 461 (defmacro intern-tag-symbol (tag)
 462   `(progn
 463      (setq tag-symbol (intern ,tag tag-completion-table)
 464            tag-symbol-tables (and (boundp tag-symbol)
 465                                   (symbol-value tag-symbol)))
 466      (or (memq tag-table-symbol tag-symbol-tables)
 467          (set tag-symbol (cons tag-table-symbol tag-symbol-tables)))))
 468
 469 ;; Can't use "\\s " in these patterns because that will include newline
 470 (defconst tags-DEFUN-pattern
 471           "DEFUN[ \t]*(\"\\([^\"]+\\)\",[ \t]*\\(\\(\\sw\\|\\s_\\)+\\),\C-?")
 472 (defconst tags-array-pattern ".*[ \t]+\\([^ \[]+\\)\\[")
 473 (defconst tags-def-pattern
 474           "\\(.*[ \t]+\\)?\\**\\(\\(\\sw\\|\\s_\\)+\\)[ ();,\t]*\C-?"
 475 ;; "\\(.*[ \t]+\\)?\\(\\(\\sw\\|\\s_\\)+\\)[ ()]*\C-?"
 476 ;; "\\(\\sw\\|\\s_\\)+[ ()]*\C-?"
 477       )
 478 (defconst tags-file-pattern "^\f\n\\(.+\\),[0-9]+\n")
 479
 480 ;; #### Should make it work with the `include' directive!
 481 (defun add-to-tag-completion-table ()
 482   "Sucks the current buffer (a TAGS table) into the completion-table."
 483   (message "Adding %s to tags completion table..." buffer-file-name)
 484   (goto-char (point-min))
 485   (let ((tag-table-symbol (intern buffer-file-name tag-completion-table))
 486         ;; tag-table-symbol is used by intern-tag-symbol
 487         filename file-type name name2 tag-symbol
 488         tag-symbol-tables
 489         (case-fold-search nil))
 490     ;; Loop over the files mentioned in the TAGS file for each file,
 491     ;; try to find its major-mode, then process tags appropriately.
 492     (while (looking-at tags-file-pattern)
 493       (goto-char (match-end 0))
 494       (setq filename (file-name-sans-versions (match-string 1))
 495             ;; We used to check auto-mode-alist for the proper
 496             ;; file-type.  This was way too slow, as it had to process
 497             ;; an enormous amount of regexps for each time.  Now we
 498             ;; use the shotgun approach with only two regexps.
 499             file-type (cond ((string-match "\\.\\([cC]\\|cc\\|cxx\\)\\'"
 500                                            filename)
 501                              'c-mode)
 502                             ((string-match "\\.\\(el\\|cl\\|lisp\\)\\'"
 503                                            filename)
 504                              'lisp-mode)
 505                             ((string-match "\\.scm\\'" filename)
 506                              'scheme-mode)
 507                             (t nil)))
 508       (defvar c-mode-syntax-table)
 509       (set-syntax-table (cond ((and (eq file-type 'c-mode)
 510                                     c-mode-syntax-table)
 511                                c-mode-syntax-table)
 512                               ((eq file-type 'lisp-mode)
 513                                lisp-mode-syntax-table)
 514                               (t (standard-syntax-table))))
 515       ;; Clear loop variables.
 516       (setq name nil name2 nil)
 517       (lmessage 'progress "%s..." filename)
 518       ;; Loop over the individual tag lines.
 519       (while (not (or (eobp) (eq (char-after) ?\f)))
 520         (cond ((and (eq file-type 'c-mode)
 521                     (looking-at "DEFUN[ \t]"))
 522                ;; DEFUN
 523                (or (looking-at tags-DEFUN-pattern)
 524                    (error "DEFUN doesn't fit pattern"))
 525                (setq name (match-string 1)
 526                      name2 (match-string 2)))
 527               ;;((looking-at "\\s ")
 528               ;; skip probably bogus entry:
 529               ;;)
 530               ((and (eq file-type 'c-mode)
 531                     (looking-at ".*\\["))
 532                ;; Array
 533                (cond ((not (looking-at tags-array-pattern))
 534                       (message "array definition doesn't fit pattern")
 535                       (setq name nil))
 536                      (t
 537                       (setq name (match-string 1)))))
 538               ((and (eq file-type 'scheme-mode)
 539                     (looking-at "\\s-*(\\s-*def\\sw*\\s-*(?\\s-*\\(\\(\\sw\\|\\s_\\|:\\)+\\))?\\s-*\C-?"))
 540                ;; Something Schemish (is this really necessary??)
 541                (setq name (match-string 1)))
 542               ((looking-at tags-def-pattern)
 543                ;; ???
 544                (setq name (match-string 2))))
 545         ;; add the tags we found to the completion table
 546         (and name (intern-tag-symbol name))
 547         (and name2 (intern-tag-symbol name2))
 548         (forward-line 1)))
 549     (or (eobp) (error "Bad TAGS file")))
 550   (message "Adding %s to tags completion table...done" buffer-file-name))
 551
 552 \f
 553 ;; Interactive find-tag
 554
 555 (defvar find-tag-default-hook nil
 556   "Function to call to create a default tag.
 557 Make it buffer-local in a mode hook.  The function is called with no
 558  arguments.")
 559
 560 (defvar find-tag-hook nil
 561   "*Function to call after a tag is found.
 562 Make it buffer-local in a mode hook.  The function is called with no
 563  arguments.")
 564
 565 ;; Return a default tag to search for, based on the text at point.
 566 (defun find-tag-default ()
 567   (or (and (not (memq find-tag-default-hook '(nil find-tag-default)))
 568            (condition-case data
 569                (funcall find-tag-default-hook)
 570              (error
 571               (warn "Error in find-tag-default-hook signalled error: %s"
 572                     (error-message-string data))
 573               nil)))
 574       (symbol-near-point)))
 575
 576 ;; This function depends on the following symbols being bound properly:
 577 ;; buffer-tag-table-list,
 578 ;; tag-symbol-tables (value irrelevant, bound outside for efficiency)
 579 (defun tag-completion-predicate (tag-symbol)
 580   (and (boundp tag-symbol)
 581        (setq tag-symbol-tables (symbol-value tag-symbol))
 582        (catch 'found
 583          (while tag-symbol-tables
 584            (when (memq (car tag-symbol-tables) buffer-tag-table-list)
 585              (throw 'found t))
 586            (setq tag-symbol-tables (cdr tag-symbol-tables))))))
 587
 588 (defun buffer-tag-table-symbol-list ()
 589   (mapcar (lambda (table-name)
 590             (intern table-name tag-completion-table))
 591           (buffer-tag-table-list)))
 592
 593 (defvar find-tag-history nil "History list for find-tag-tag.")
 594
 595 (defun find-tag-tag (prompt)
 596   (let* ((default (find-tag-default))
 597          (buffer-tag-table-list (buffer-tag-table-symbol-list))
 598          tag-symbol-tables tag-name)
 599     (setq tag-name
 600           (completing-read
 601            (if default
 602                (format "%s(default %s) " prompt default)
 603              prompt)
 604            tag-completion-table 'tag-completion-predicate nil nil
 605            'find-tag-history default))
 606     tag-name))
 607
 608 (defvar last-tag-data nil
 609   "Information for continuing a tag search.
 610 Is of the form (TAG POINT MATCHING-EXACT TAG-TABLE TAG-TABLE ...).")
 611
 612 (defvar tags-loop-operate nil
 613   "Form for `tags-loop-continue' to eval to change one file.")
 614
 615 (defvar tags-loop-scan
 616   '(error "%s" (substitute-command-keys
 617                 "No \\[tags-search] or \\[tags-query-replace] in progress."))
 618   "Form for `tags-loop-continue' to eval to scan one file.
 619 If it returns non-nil, this file needs processing by evalling
 620 \`tags-loop-operate'.  Otherwise, move on to the next file.")
 621
 622 (autoload 'get-symbol-syntax-table "symbol-syntax")
 623
 624 (defun find-tag-internal (tagname)
 625   (let ((next (null tagname))
 626         (tmpnext (null tagname))
 627         ;; If tagname is a list: (TAGNAME), this indicates
 628         ;; requiring an exact symbol match.
 629         (exact (or tags-always-exact (consp tagname)))
 630         (normal-syntax-table (syntax-table))
 631         (exact-syntax-table (get-symbol-syntax-table (syntax-table)))
 632         tag-table-currently-matching-exact
 633         tag-target exact-tagname
 634         tag-tables tag-table-point file linebeg startpos buf
 635         offset found pat syn-tab)
 636     (when (consp tagname)
 637       (setq tagname (car tagname)))
 638     (cond (next
 639            (setq tagname (car last-tag-data))
 640            (setq tag-table-currently-matching-exact
 641                  (car (cdr (cdr last-tag-data)))))
 642           (t
 643            (setq tag-table-currently-matching-exact t)))
 644     ;; \_ in the tagname is used to indicate a symbol boundary.
 645     (setq exact-tagname (format "\C-?\\_%s\\_\C-a\\|\\_%s\\_" tagname tagname))
 646     (while (string-match "\\\\_" exact-tagname)
 647       (aset exact-tagname (1- (match-end 0)) ?b))
 648     (save-excursion
 649       (catch 'found
 650         ;; Loop searching for exact matches and then inexact matches.
 651         (while (not (eq tag-table-currently-matching-exact 'neither))
 652           (cond (tmpnext
 653                  (setq tag-tables (cdr (cdr (cdr last-tag-data)))
 654                        tag-table-point (car (cdr last-tag-data)))
 655                  ;; Start from the beginning of the table list on the
 656                  ;; next iteration of the loop.
 657                  (setq tmpnext nil))
 658                 (t
 659                  (setq tag-tables (buffer-tag-table-list)
 660                        tag-table-point 1)))
 661           (if tag-table-currently-matching-exact
 662               (setq tag-target exact-tagname
 663                     syn-tab exact-syntax-table)
 664             (setq tag-target tagname
 665                   syn-tab normal-syntax-table))
 666           (with-search-caps-disable-folding tag-target t
 667             (while tag-tables
 668               (set-buffer (get-tag-table-buffer (car tag-tables)))
 669               (bury-buffer (current-buffer))
 670               (goto-char (or tag-table-point (point-min)))
 671               (setq tag-table-point nil)
 672               (letf (((syntax-table) syn-tab)
 673                      (case-fold-search nil))
 674                 ;; #### should there be support for non-regexp
 675                 ;; tag searches?
 676                 (while (re-search-forward tag-target nil t)
 677                   (and (save-match-data
 678                          (save-excursion
 679                            (goto-char (match-beginning 0))
 680                            (looking-at "[^\n\C-?]*\C-?")))
 681                        ;; If we're looking for inexact matches, skip
 682                        ;; exact matches since we've visited them
 683                        ;; already.
 684                        (or tag-table-currently-matching-exact
 685                            (letf (((syntax-table) exact-syntax-table))
 686                              (save-excursion
 687                                (goto-char (match-beginning 0))
 688                                (not (looking-at exact-tagname)))))
 689                        (throw 'found t))))
 690               (setq tag-tables
 691                     (nconc (tag-table-include-files) (cdr tag-tables)))))
 692           (if (and (not exact) (eq tag-table-currently-matching-exact t))
 693               (setq tag-table-currently-matching-exact nil)
 694             (setq tag-table-currently-matching-exact 'neither)))
 695         (error "No %sentries %s %s"
 696                (if next "more " "")
 697                (if exact "matching" "containing")
 698                tagname))
 699       (beginning-of-line)
 700       (search-forward "\C-?")
 701       (setq file (expand-file-name (file-of-tag)
 702                                    ;; In XEmacs, this needs to be
 703                                    ;; relative to:
 704                                    (or (file-name-directory (car tag-tables))
 705                                        "./")))
 706       (setq linebeg (buffer-substring (1- (point)) (point-at-bol)))
 707       (search-forward ",")
 708       (setq startpos (read (current-buffer)))
 709       (setq last-tag-data
 710             (nconc (list tagname (point) tag-table-currently-matching-exact)
 711                    tag-tables))
 712       (setq buf (find-file-noselect file))
 713       (with-current-buffer buf
 714         (save-excursion
 715           (save-restriction
 716             (widen)
 717             ;; Here we search for PAT in the range [STARTPOS - OFFSET,
 718             ;; STARTPOS + OFFSET], with increasing values of OFFSET.
 719             ;;
 720             ;; We used to set the initial offset to 1000, but the
 721             ;; actual sources show that finer-grained control is
 722             ;; needed (e.g. two `hash_string's in src/symbols.c.)  So,
 723             ;; I changed 100 to 100, and (* 3 offset) to (* 5 offset).
 724             (setq offset 100)
 725             (setq pat (concat "^" (regexp-quote linebeg)))
 726             (or startpos (setq startpos (point-min)))
 727             (while (and (not found)
 728                         (progn
 729                           (goto-char (- startpos offset))
 730                           (not (bobp))))
 731               (setq found (re-search-forward pat (+ startpos offset) t))
 732               (setq offset (* 5 offset)))
 733             ;; Finally, try finding it anywhere in the buffer.
 734             (or found
 735                 (re-search-forward pat nil t)
 736                 (error "%s not found in %s" pat file))
 737             (beginning-of-line)
 738             (setq startpos (point)))))
 739       (cons buf startpos))))
 740
 741 ;;;###autoload
 742 (defun find-tag-at-point (tagname &optional other-window)
 743   "*Find tag whose name contains TAGNAME.
 744 Identical to `find-tag' but does not prompt for tag when called interactively;
 745 instead, uses tag around or before point."
 746   (interactive (if current-prefix-arg
 747                    '(nil nil)
 748                  (list (find-tag-default) nil)))
 749   (find-tag tagname other-window))
 750
 751 ;;;###autoload
 752 (defun find-tag (tagname &optional other-window)
 753   "*Find tag whose name contains TAGNAME.
 754  Selects the buffer that the tag is contained in
 755 and puts point at its definition.
 756  If TAGNAME is a null string, the expression in the buffer
 757 around or before point is used as the tag name.
 758  If called interactively with a numeric argument, searches for the next tag
 759 in the tag table that matches the tagname used in the previous find-tag.
 760  If second arg OTHER-WINDOW is non-nil, uses another window to display
 761 the tag.
 762
 763 This version of this function supports multiple active tags tables,
 764 and completion.
 765
 766 Variables of note:
 767
 768   tag-table-alist               controls which tables apply to which buffers
 769   tags-file-name                a default tags table
 770   tags-build-completion-table   controls completion behavior
 771   buffer-tag-table              another way of specifying a buffer-local table
 772   make-tags-files-invisible     whether tags tables should be very hidden
 773   tag-mark-stack-max            how many tags-based hops to remember"
 774   (interactive (if current-prefix-arg
 775                    '(nil nil)
 776                  (list (find-tag-tag "Find tag: ") nil)))
 777   (let* ((local-find-tag-hook find-tag-hook)
 778          (next (null tagname))
 779          (result (find-tag-internal tagname))
 780          (tag-buf (car result))
 781          (tag-point (cdr result)))
 782     ;; Push old position on the tags mark stack.
 783     (if (or (not next)
 784             (not (memq last-command
 785                        '(find-tag find-tag-other-window tags-loop-continue))))
 786         (push-tag-mark))
 787     (if other-window
 788         (pop-to-buffer tag-buf t)
 789       (switch-to-buffer tag-buf))
 790     (widen)
 791     (push-mark)
 792     (goto-char tag-point)
 793     (if find-tag-hook
 794                 (run-hooks 'find-tag-hook)
 795       (if local-find-tag-hook
 796                   (run-hooks 'local-find-tag-hook))))
 797   (setq tags-loop-scan (list 'find-tag nil nil)
 798                 tags-loop-operate nil)
 799   ;; Return t in case used as the tags-loop-scan.
 800   t)
 801
 802 ;;;###autoload
 803 (defun find-tag-other-window (tagname &optional next)
 804   "*Find tag whose name contains TAGNAME, in another window.
 805  Selects the buffer that the tag is contained in in another window
 806 and puts point at its definition.
 807  If TAGNAME is a null string, the expression in the buffer
 808 around or before point is used as the tag name.
 809  If second arg NEXT is non-nil (interactively, with prefix arg),
 810 searches for the next tag in the tag table
 811 that matches the tagname used in the previous find-tag.
 812
 813 This version of this function supports multiple active tags tables,
 814 and completion.
 815
 816 Variables of note:
 817
 818   tag-table-alist               controls which tables apply to which buffers
 819   tags-file-name                a default tags table
 820   tags-build-completion-table   controls completion behavior
 821   buffer-tag-table              another way of specifying a buffer-local table
 822   make-tags-files-invisible     whether tags tables should be very hidden
 823   tag-mark-stack-max            how many tags-based hops to remember"
 824   (interactive (if current-prefix-arg
 825                    '(nil t)
 826                  (list (find-tag-tag "Find tag other window: "))))
 827   (if next
 828       (find-tag nil t)
 829     (find-tag tagname t)))
 830
 831 \f
 832 ;; Completion on tags in the buffer.
 833
 834 (defun complete-symbol (&optional table predicate prettify)
 835   (let* ((end (point))
 836          (beg (save-excursion
 837                 (backward-sexp 1)
 838                 ;;(while (= (char-syntax (following-char)) ?\')
 839                 ;;  (forward-char 1))
 840                 (skip-syntax-forward "'")
 841                 (point)))
 842          (pattern (buffer-substring beg end))
 843          (table (or table obarray))
 844          (completion (try-completion pattern table predicate)))
 845     (cond ((eq completion t))
 846           ((null completion)
 847            (error "Can't find completion for \"%s\"" pattern))
 848           ((not (string-equal pattern completion))
 849            (delete-region beg end)
 850            (insert completion))
 851           (t
 852            (message "Making completion list...")
 853            (let ((list (all-completions pattern table predicate)))
 854              (if prettify
 855                  (setq list (funcall prettify list)))
 856              (with-output-to-temp-buffer "*Help*"
 857                (display-completion-list list)))
 858            (message "Making completion list...%s" "done")))))
 859
 860 ;;;###autoload
 861 (defun tag-complete-symbol ()
 862   "The function used to do tags-completion (using 'tag-completion-predicate)."
 863   (interactive)
 864   (let* ((buffer-tag-table-list (buffer-tag-table-symbol-list))
 865          tag-symbol-tables)
 866     (complete-symbol tag-completion-table 'tag-completion-predicate)))
 867
 868 \f
 869 ;; Applying a command to files mentioned in tag tables
 870
 871 (defvar next-file-list nil
 872   "List of files for next-file to process.")
 873
 874 ;;;###autoload
 875 (defun next-file (&optional initialize novisit)
 876   "Select next file among files in current tag table(s).
 877
 878 A first argument of t (prefix arg, if interactive) initializes to the
 879 beginning of the list of files in the (first) tags table.  If the argument
 880 is neither nil nor t, it is evalled to initialize the list of files.
 881
 882 Non-nil second argument NOVISIT means use a temporary buffer
 883 to save time and avoid uninteresting warnings.
 884
 885 Value is nil if the file was already visited;
 886 if the file was newly read in, the value is the filename."
 887   (interactive "P")
 888   (cond ((not initialize)
 889          ;; Not the first run.
 890          )
 891         ((eq initialize t)
 892          ;; Initialize the list from the tags table.
 893          (setq next-file-list (buffer-tag-table-files)))
 894         (t
 895          ;; Initialize the list by evalling the argument.
 896          (setq next-file-list (eval initialize))))
 897   (when (null next-file-list)
 898     (and novisit
 899          (get-buffer " *next-file*")
 900          (kill-buffer " *next-file*"))
 901     (error "All files processed"))
 902   (let* ((file (car next-file-list))
 903          (buf (get-file-buffer file))
 904          (new (not buf)))
 905     (pop next-file-list)
 906
 907     (if (not (and new novisit))
 908         (switch-to-buffer (find-file-noselect file novisit) t)
 909       ;; Like find-file, but avoids random junk.
 910       (set-buffer (get-buffer-create " *next-file*"))
 911       (kill-all-local-variables)
 912       (erase-buffer)
 913       (insert-file-contents file nil))
 914     (widen)
 915     (when (> (point) (point-min))
 916       (push-mark nil t)
 917       (goto-char (point-min)))
 918     (and new file)))
 919
 920 ;;;###autoload
 921 (defun tags-loop-continue (&optional first-time)
 922   "Continue last \\[tags-search] or \\[tags-query-replace] command.
 923 Used noninteractively with non-nil argument to begin such a command (the
 924 argument is passed to `next-file', which see).
 925 Two variables control the processing we do on each file:
 926 the value of `tags-loop-scan' is a form to be executed on each file
 927 to see if it is interesting (it returns non-nil if so)
 928 and `tags-loop-operate' is a form to execute to operate on an interesting file
 929 If the latter returns non-nil, we exit; otherwise we scan the next file."
 930   (interactive)
 931   (let ((messaged nil)
 932         (more-files-p t)
 933         new)
 934     (while more-files-p
 935       ;; Scan files quickly for the first or next interesting one.
 936       (while (or first-time
 937                  (save-restriction
 938                    (widen)
 939                    (not (eval tags-loop-scan))))
 940         (setq new (next-file first-time
 941                              tags-search-nuke-uninteresting-buffers))
 942         ;; If NEW is non-nil, we got a temp buffer,
 943         ;; and NEW is the file name.
 944         (if (or messaged
 945                 (and (not first-time)
 946                      (> (device-baud-rate) search-slow-speed)
 947                      (setq messaged t)))
 948             (lmessage 'progress
 949                 "Scanning file %s..." (or new buffer-file-name)))
 950         (setq first-time nil)
 951         (goto-char (point-min)))
 952
 953       ;; If we visited it in a temp buffer, visit it now for real.
 954       (if (and new tags-search-nuke-uninteresting-buffers)
 955           (let ((pos (point)))
 956             (erase-buffer)
 957             (set-buffer (find-file-noselect new))
 958             (widen)
 959             (goto-char pos)))
 960
 961       (switch-to-buffer (current-buffer))
 962
 963       ;; Now operate on the file.
 964       ;; If value is non-nil, continue to scan the next file.
 965       (setq more-files-p (eval tags-loop-operate)))
 966     (and messaged
 967          (null tags-loop-operate)
 968          (message "Scanning file %s...found" buffer-file-name))))
 969
 970
 971 ;;;###autoload
 972 (defun tags-search (regexp &optional file-list-form)
 973   "Search through all files listed in tags table for match for REGEXP.
 974 Stops when a match is found.
 975 To continue searching for next match, use command \\[tags-loop-continue].
 976
 977 See documentation of variable `tag-table-alist'."
 978   (interactive "sTags search (regexp): ")
 979   (if (and (equal regexp "")
 980            (eq (car tags-loop-scan) 'with-search-caps-disable-folding)
 981            (null tags-loop-operate))
 982       ;; Continue last tags-search as if by `M-,'.
 983       (tags-loop-continue nil)
 984     (setq tags-loop-scan `(with-search-caps-disable-folding ,regexp t
 985                             (re-search-forward ,regexp nil t))
 986           tags-loop-operate nil)
 987     (tags-loop-continue (or file-list-form t))))
 988
 989 ;;;###autoload
 990 (defun tags-query-replace (from to &optional delimited file-list-form)
 991   "Query-replace-regexp FROM with TO through all files listed in tags table.
 992 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
 993 If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
 994 with the command \\[tags-loop-continue].
 995
 996 See documentation of variable `tag-table-alist'."
 997   (interactive
 998    "sTags query replace (regexp): \nsTags query replace %s by: \nP")
 999   (setq tags-loop-scan `(with-search-caps-disable-folding ,from t
1000                           (if (re-search-forward ,from nil t)
1001                               ;; When we find a match, move back
1002                               ;; to the beginning of it so perform-replace
1003                               ;; will see it.
1004                               (progn (goto-char (match-beginning 0)) t)))
1005         tags-loop-operate (list 'perform-replace from to t t
1006                                 (not (null delimited))))
1007    (tags-loop-continue (or file-list-form t)))
1008 \f
1009 ;; Miscellaneous
1010
1011 ;;;###autoload
1012 (defun list-tags (file)
1013   "Display list of tags in FILE."
1014   (interactive (list (read-file-name
1015                       (if (buffer-file-name)
1016                           (format "List tags (in file, %s by default): "
1017                                   (file-name-nondirectory (buffer-file-name)))
1018                         "List tags (in file): ")
1019                       nil (buffer-file-name) t)))
1020   (find-file-noselect file)
1021   (with-output-to-temp-buffer "*Tags List*"
1022     (princ "Tags in file ")
1023     (princ file)
1024     (terpri)
1025     (save-excursion
1026       (dolist (tags-file (with-current-buffer (get-file-buffer file)
1027                            (buffer-tag-table-list)))
1028         ;; We don't want completions getting in the way.
1029         (let ((tags-build-completion-table nil))
1030           (set-buffer (get-tag-table-buffer tags-file)))
1031         (goto-char (point-min))
1032         (when
1033             (search-forward (concat "\f\n" (file-name-nondirectory file) ",")
1034                             nil t)
1035           (forward-line 1)
1036           (while (not (or (eobp) (looking-at "\f")))
1037             (princ (buffer-substring (point)
1038                                      (progn (skip-chars-forward "^\C-?")
1039                                             (point))))
1040             (terpri)
1041             (forward-line 1)))))))
1042
1043 ;;;###autoload
1044 (defun tags-apropos (string)
1045   "Display list of all tags in tag table REGEXP matches."
1046   (interactive "sTag apropos (regexp): ")
1047   (with-output-to-temp-buffer "*Tags List*"
1048     (princ "Tags matching regexp ")
1049     (prin1 string)
1050     (terpri)
1051     (save-excursion
1052       (visit-tags-table-buffer)
1053       (goto-char 1)
1054       (while (re-search-forward string nil t)
1055         (beginning-of-line)
1056         (princ (buffer-substring (point)
1057                                  (progn (skip-chars-forward "^\C-?")
1058                                         (point))))
1059         (terpri)
1060         (forward-line 1)))))
1061
1062 ;; #### copied from tags.el.  This function is *very* big in FSF.
1063 (defun visit-tags-table-buffer ()
1064   "Select the buffer containing the current tag table."
1065   (or tags-file-name
1066       (call-interactively 'visit-tags-table))
1067   (set-buffer (or (get-file-buffer tags-file-name)
1068                   (progn
1069                     (setq tag-table-files nil)
1070                     (find-file-noselect tags-file-name))))
1071   (or (verify-visited-file-modtime (get-file-buffer tags-file-name))
1072       (cond ((yes-or-no-p "Tags file has changed, read new contents? ")
1073              (revert-buffer t t)
1074              (setq tag-table-files nil))))
1075   (or (eq (char-after 1) ?\^L)
1076       (error "File %s not a valid tag table" tags-file-name)))
1077
1078 \f
1079 ;; Sample uses of find-tag-hook and find-tag-default-hook
1080
1081 ;; This is wrong.  We should either make this behavior default and
1082 ;; back it up, or not use it at all.  For now, I've commented it out.
1083 ;; --hniksic
1084
1085 ;; Example buffer-local tag finding
1086
1087 ;(add-hook 'emacs-lisp-mode-hook 'setup-emacs-lisp-default-tag-hook)
1088
1089 ;(defun setup-emacs-lisp-default-tag-hook ()
1090 ;  (cond ((eq major-mode 'emacs-lisp-mode)
1091 ;        (make-variable-buffer-local 'find-tag-default-hook)
1092 ;        (setq find-tag-default-hook 'emacs-lisp-default-tag))))
1093 ;;; Run it once immediately
1094 ;(setup-emacs-lisp-default-tag-hook)
1095 ;(when (get-buffer "*scratch*")
1096 ;  (with-current-buffer "*scratch*"
1097 ;    (setup-emacs-lisp-default-tag-hook)))
1098
1099 ;(defun emacs-lisp-default-tag ()
1100 ;  "Function to return a default tag for Emacs-Lisp mode."
1101 ;  (let ((tag (or (variable-at-point)
1102 ;                (function-at-point))))
1103 ;    (if tag (symbol-name tag))))
1104
1105 \f
1106 ;; Display short info on tag in minibuffer
1107
1108 ;; Don't pollute `M-?' -- we may need it for more important stuff.  --hniksic
1109 ;(if (null (lookup-key esc-map "?"))
1110 ;    (define-key esc-map "?" 'display-tag-info))
1111
1112 (defun display-tag-info (tagname)
1113   "Prints a description of the first tag matching TAGNAME in the echo area.
1114 If this is an elisp function, prints something like \"(defun foo (x y z)\".
1115 That is, is prints the first line of the definition of the form.
1116 If this is a C-defined elisp function, it does something more clever."
1117   (interactive (if current-prefix-arg
1118                    '(nil)
1119                  (list (find-tag-tag "Display tag info: "))))
1120   (let* ((results (find-tag-internal tagname))
1121          (tag-buf (car results))
1122          (tag-point (cdr results))
1123          info lname min max fname args)
1124     (with-current-buffer tag-buf
1125       (save-excursion
1126         (save-restriction
1127           (widen)
1128           (goto-char tag-point)
1129           (cond ((let ((case-fold-search nil))
1130                    (looking-at "^DEFUN[ \t]"))
1131                  (forward-sexp 1)
1132                  (down-list 1)
1133                  (setq lname (read (current-buffer))
1134                        fname (buffer-substring
1135                               (progn (forward-sexp 1) (point))
1136                               (progn (backward-sexp 1) (point)))
1137                        min (buffer-substring
1138                             (progn (forward-sexp 3) (point))
1139                             (progn (backward-sexp 1) (point)))
1140                        max (buffer-substring
1141                             (progn (forward-sexp 2) (point))
1142                             (progn (backward-sexp 1) (point))))
1143                  (backward-up-list 1)
1144                  (setq args (buffer-substring
1145                              (progn (forward-sexp 2) (point))
1146                              (progn (backward-sexp 1) (point))))
1147                  (setq info (format "Elisp: %s, C: %s %s, #args: %s"
1148                                     lname
1149                                     fname args
1150                                     (if (string-equal min max)
1151                                         min
1152                                       (format "from %s to %s" min max)))))
1153                 (t
1154                  (setq info
1155                        (buffer-substring
1156                         (progn (beginning-of-line) (point))
1157                         (progn (end-of-line) (point)))))))))
1158     (message "%s" info))
1159   (setq tags-loop-scan '(display-tag-info nil)
1160         tags-loop-operate nil)
1161   ;; Always return non-nil
1162   t)
1163
1164 \f
1165 ;; Tag mark stack.
1166
1167 (defvar tag-mark-stack1 nil)
1168 (defvar tag-mark-stack2 nil)
1169
1170 (defcustom tag-mark-stack-max 16
1171   "*The maximum number of elements kept on the mark-stack used
1172 by tags-search.  See also the commands `\\[push-tag-mark]' and
1173 and `\\[pop-tag-mark]'."
1174   :type 'integer
1175   :group 'etags)
1176
1177 (defun push-mark-on-stack (stack-symbol &optional max-size)
1178   (let ((stack (symbol-value stack-symbol)))
1179     (push (point-marker) stack)
1180     (cond ((and max-size
1181                 (> (length stack) max-size))
1182            (set-marker (car (nthcdr max-size stack)) nil)
1183            (setcdr (nthcdr (1- max-size) stack) nil)))
1184     (set stack-symbol stack)))
1185
1186 (defun pop-mark-from-stack (stack-symbol1 stack-symbol2 &optional max-size)
1187   (let* ((stack (or (symbol-value stack-symbol1)
1188                     (error "No more tag marks on stack")))
1189          (marker (car stack))
1190          (m-buf (marker-buffer marker)))
1191     (set stack-symbol1 (cdr stack))
1192     (or m-buf
1193         (error "Marker has no buffer"))
1194     (or (buffer-live-p m-buf)
1195         (error "Buffer has been killed"))
1196     (push-mark-on-stack stack-symbol2 max-size)
1197     (switch-to-buffer m-buf)
1198     (widen)
1199     (goto-char marker)))
1200
1201 (defun push-tag-mark ()
1202   (push-mark-on-stack 'tag-mark-stack1 tag-mark-stack-max))
1203
1204 ;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
1205
1206 ;;;###autoload
1207 (defun pop-tag-mark (arg)
1208   "Go to last tag position.
1209 `find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack.
1210 This function pops (and moves to) the tag at the top of this stack."
1211   (interactive "P")
1212   (if (not arg)
1213       (pop-mark-from-stack
1214        'tag-mark-stack1 'tag-mark-stack2 tag-mark-stack-max)
1215     (pop-mark-from-stack
1216      'tag-mark-stack2 'tag-mark-stack1 tag-mark-stack-max)))
1217
1218 \f
1219 (provide 'etags)
1220 (provide 'tags)
1221
1222 ;;; etags.el ends here