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