home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #19 / NN_1992_19.iso / spool / alt / lucidem / help / 382 < prev    next >
Encoding:
Text File  |  1992-09-04  |  47.3 KB  |  1,358 lines
  1. x-gateway: rodan.UU.NET from help-lucid-emacs to alt.lucid-emacs.help; Fri, 4 Sep 1992 15:19:06 EDT
  2. Date: Fri, 4 Sep 1992 21:17:31 +0200
  3. From: h.b.furuseth%usit.uio.no@lucid.com
  4. Message-ID: <9209041917.AAdurin13402@durin.uio.no>
  5. Subject: Re: tags-query-replace
  6. Newsgroups: alt.lucid-emacs.help
  7. Path: sparky!uunet!wendy-fate.uu.net!help-lucid-emacs
  8. Sender: help-lucid-emacs-request@lucid.com
  9. Lines: 1347
  10.  
  11. > complains
  12. > 
  13. >       Wrong type argument: syntax-table-p, nil
  14. > 
  15. > What do I need to do make it work?
  16.  
  17. That does not happen to me.  But here is a fix I wrote some time ago
  18. for lemacs-19.2/lisp/packages/etags.el.  It probably still has bugs,
  19. but at least it works better, and gives fewer warnings when compiled.
  20.  
  21.  
  22. Regards,
  23.  
  24. Hallvard
  25.  
  26. ;; Enhanced tags facility for Emacs.
  27. ;; Copyright 1985, 1986, 1988, 1990 Free Software Foundation, Inc.
  28.  
  29. ;; This file is part of GNU Emacs.
  30.  
  31. ;; GNU Emacs is distributed in the hope that it will be useful,
  32. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  33. ;; accepts responsibility to anyone for the consequences of using it
  34. ;; or for whether it serves any particular purpose or works at all,
  35. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  36. ;; License for full details.
  37.  
  38. ;; Everyone is granted permission to copy, modify and redistribute
  39. ;; GNU Emacs, but only under the conditions described in the
  40. ;; GNU Emacs General Public License.   A copy of this license is
  41. ;; supposed to have been given to you along with GNU Emacs so you
  42. ;; can know your rights and responsibilities.  It should be in a
  43. ;; file named COPYING.  Among other things, the copyright notice
  44. ;; and this notice must be preserved on all copies.
  45.  
  46. ;; Created by: Joe Wells, jbw@bucsf.bu.edu
  47. ;; Created on: Thu Mar 22 20:17:40 1990
  48. ;; Last modified by: Jamie Zawinski <jwz@lucid.com>
  49. ;; Last modified on: Wed Jan  1 15:09:18 1992
  50. ;; Filename: tags-fix.el
  51. ;; Purpose: enhanced tags functionality
  52. ;; Change log: 
  53. ;; 
  54. ;; Wed Jan  1 15:09:18 1992  Jamie Zawinski <jwz@lucid.com>
  55. ;;
  56. ;;      * Added Harlan's definition of visit-tags-table.  
  57. ;;      Renamed variable tags-always-build-completion-table to
  58. ;;      tags-build-completion-table and changed its semantics.
  59. ;;      Made the explicit buffer-local tags file be searched 
  60. ;;      first instead of last.
  61. ;;
  62. ;; Sun May 10 15:48:00 1992  Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
  63. ;;
  64. ;;    Inserted visit-tags-table-buffer from tags.el, handle
  65. ;;    tag-file-name=nil, improved some doc strings and variable declarations.
  66. ;;
  67. ;; Fri Mar 29 01:48:06 1991  Jamie Zawinski <jwz@lucid.com>
  68. ;;
  69. ;;    * Made link-chasing and invisible-tags-files optional.
  70. ;;    Renamed delete and remove-duplicates to avoid possible name conflicts.
  71. ;;    Moved "provide" to end.  Added some documentation.
  72. ;; 
  73. ;; Sat Sep 22 22:28:33 1990  Joseph Wells  (jbw at bucsf.bu.edu)
  74. ;; 
  75. ;;     * Added handling for case where tag is typedef name immediately
  76. ;;     following struct definition.
  77. ;; 
  78. ;; Thu Sep 13 21:09:15 1990  Joseph Wells  (jbw at bucsf.bu.edu)
  79. ;; 
  80. ;;     * Fixed behavior not to bomb on missing tag table file.
  81. ;; 
  82.  
  83. ;; Sat Aug 11 18:07:01 1990  Joe Wells  (jbw at dodge.uswest.com)
  84. ;; 
  85. ;;     * Moved calling find-tag-default-hook into find-tag-default.  Put
  86. ;;     it inside a condition-case.  Use find-tag-default method when
  87. ;;     find-tag-default-hook fails or returns nil.
  88. ;; 
  89. ;; Wed Jul 25 17:16:43 1990  Joe Wells  (jbw at dodge.uswest.com)
  90. ;; 
  91. ;;     * Made it an error for a buffer to have no associated tag tables.
  92. ;; 
  93.  
  94. ;; enhancements:
  95. ;;  1. default tag tables based on filename
  96. ;;  2. multiple tag tables possible per file
  97. ;;  3. tag name completion for find-tag
  98. ;;  4. find-tag using regexp
  99. ;;  5. tag name completion in the buffer
  100. ;;  6. find-tag-default now works at beginning of tag
  101. ;;  7. buffer-local find-tag hook (used for info enhancement)
  102. ;;  8. buffer-local find-tag-default hook (used for info enhancement)
  103. ;;  9. show short info on tag match in minibuffer
  104. ;; 10. stack for backtracking from find-tag
  105. ;; 11. widen buffers for tags-search
  106. ;; 12. display message on successful search
  107. ;; 13. don't pull all files into memory for tags-search
  108. ;; 14. don't leave searched buffers on top of buffer list
  109. ;; 15. find-tag can specify exact symbol matches
  110. ;; 16. find-tag-default specifies an exact symbol match
  111. ;; 17. tags-files can be invisible
  112.  
  113. ;; configuration variables:
  114. ;;   tag-table-alist        controls which tables apply to which buffers
  115. ;;   tags-file-name        a default tags table
  116. ;;   buffer-tag-table        another way of specifying a buffer-local table
  117. ;;   make-tags-files-invisible    whether tags tables should be very hidden
  118. ;;   tag-mark-stack-max        how many tags-based hops to remember
  119.  
  120. ;; TODO:
  121. ;; 1. place cursor in echo area while searching
  122. ;; 2. document!
  123. ;; 3. determine semantics of interactively setting the tags file for a buffer
  124.  
  125. ;; Comments with **** mean something is left to be done.
  126.  
  127. ;; Derived from the original lisp/tags.el.
  128.  
  129. ;; Ideas and code from the work of the following people:
  130. ;; Andy Norman <ange@hplb.hpl.hp.com>, author of ange-tags.el
  131. ;; Ramana Rao <rao@arisia.xerox.com>
  132. ;; John Sturdy <jcgs@harlqn.co.uk>, author of tags-helper.el
  133. ;; Henry Kautz <kautz@allegra.att.com>, author of tag-completion.el
  134. ;; Dan LaLiberte <liberte@cs.uiuc.edu>, author of local-tags.el
  135. ;; Tom Dietterich <tgd@turing.cs.orst.edu>, author of quest.el
  136. ;; The author(s) of lisp/simple.el
  137. ;; Duke Briscoe <briscoe@cs.yale.edu>
  138. ;; Lynn Slater <lrs@indetech.com>, author of location.el
  139. ;; Shinichirou Sugou <shin@sgtp.apple.juice.or.jp>
  140. ;; an unidentified anonymous elisp hacker
  141.  
  142. ;; Installation instructions:
  143. ;;
  144. ;; Name this file tags-fix.el.
  145. ;; Put tags-fix.el, symlink-fix.el, symbol-syntax.el in your load path.
  146. ;;
  147. ;; Put the following code in your .emacs (or lisp/default.el)
  148. ;;
  149. ;;(fmakunbound 'visit-tags-table) ; obsolete
  150. ;;(fmakunbound 'find-tag)
  151. ;;(autoload 'find-tag "tags-fix" nil t)
  152. ;;(fmakunbound 'find-tag-other-window)
  153. ;;(autoload 'find-tag-other-window "tags-fix" nil t)
  154. ;;(fmakunbound 'lisp-complete-symbol)
  155. ;;(autoload 'lisp-complete-symbol "tags-fix" nil t)
  156. ;;(fmakunbound 'tag-complete-symbol)
  157. ;;(autoload 'tag-complete-symbol "tags-fix" nil t)
  158. ;;(fmakunbound 'next-file)
  159. ;;(autoload 'next-file "tags-fix" nil t)
  160. ;;(fmakunbound 'tags-loop-continue)
  161. ;;(autoload 'tags-loop-continue "tags-fix" nil t)
  162. ;;(fmakunbound 'tags-search)
  163. ;;(autoload 'tags-search "tags-fix" nil t)
  164. ;;(fmakunbound 'tags-query-replace)
  165. ;;(autoload 'tags-query-replace "tags-fix" nil t)
  166. ;;(fmakunbound 'display-tag-info)
  167. ;;(autoload 'display-tag-info "tags-fix" nil t)
  168. ;;(fmakunbound 'pop-tag-mark)
  169. ;;(autoload 'pop-tag-mark "tags-fix" nil t)
  170. ;;
  171. ;;(define-key esc-map "?" 'display-tag-info)
  172. ;;(define-key esc-map "*" 'pop-tag-mark)
  173. ;;
  174. ;;;; The following are not really implemented:
  175. ;;;;(fmakunbound 'set-buffer-tag-table)
  176. ;;;;(autoload 'set-buffer-tag-table "tags-fix" nil t)
  177. ;;(fmakunbound 'list-tags)
  178. ;;;;(autoload 'list-tags "tags-fix" nil t)
  179. ;;(fmakunbound 'tags-apropos)
  180. ;;;;(autoload 'tags-apropos "tags-fix" nil t)
  181.  
  182.  
  183. ;; Auxiliary functions
  184.  
  185. (defun tags-delete (item list)
  186.   "delete the item from the list, testing with equal.  Copies the list."
  187.   (cond ((null list)
  188.      nil)
  189.     ((equal item (car list))
  190.      (tags-delete item (cdr list)))
  191.     (t
  192.      (cons (car list) (tags-delete item (cdr list))))))
  193.  
  194. (defun tags-remove-duplicates (list)
  195.   "delete equal duplicates from the list; copies the list."
  196.   (cond ((null list)
  197.      nil)
  198.     (t
  199.      (cons (car list)
  200.            (tags-remove-duplicates (tags-delete (car list) (cdr list)))))))
  201.  
  202. ;; derived from generate-new-buffer
  203. (defun generate-new-buffer-name (name)
  204.   "Foo"
  205.   (if (not (get-buffer name))
  206.       name
  207.     (let ((count 1)
  208.       (template (concat name "<%d>"))
  209.       tempname)
  210.       (catch 'found
  211.     (while t
  212.       (setq tempname (format template count))
  213.       (if (not (get-buffer tempname))
  214.           (throw 'found tempname))
  215.       (setq count (1+ count)))))))
  216.  
  217.  
  218. ;; Tag tables for a buffer
  219.  
  220. (defvar tags-build-completion-table 'ask
  221.   "*If this variable is nil, then tags completion is disabled.
  222. If this variable is t, then things which prompt for tags will do so with 
  223.  completion across all known tags.
  224. If this variable is the symbol `ask', then you will be asked whether each
  225.  tags table should be added to the completion list as it is read in.
  226.  (With the exception that for very small tags tables, you will not be asked,
  227.  since they can be parsed quickly.)")
  228.  
  229.  
  230. (defvar tag-table-alist nil
  231.   "*A list which determines which tags files should be active for a 
  232. given buffer.  This is not really an association list, in that all 
  233. elements are checked.  The CAR of each element of this list is a 
  234. pattern against which the buffer's file name is compared; if it 
  235. matches, then the CDR of the list should be the name of the tags
  236. table to use.  If more than one element of this list matches the
  237. buffer's file name, then all of the associated tags tables will be
  238. used.  Earlier ones will be searched first.
  239.  
  240. If the CAR of elements of this list are strings, then they are treated
  241. as regular-expressions against which the file is compared (like the
  242. auto-mode-alist).  If they are not strings, then they are evaluated.
  243. If they evaluate to non-nil, then the current buffer is considered to
  244. match.
  245.  
  246. If the CDR of the elements of this list are strings, then they are
  247. assumed to name a TAGS file.  If they name a directory, then the string
  248. \"TAGS\" is appended to them to get the file name.  If they are not 
  249. strings, then they are evaluated, and must return an appropriate string.
  250.  
  251. For example:
  252.   (setq tag-table-alist
  253.     '((\"/usr/src/public/perl/\" . \"/usr/src/public/perl/perl-3.0/\")
  254.      (\"\\\\.el$\" . \"/usr/local/emacs/src/\")
  255.      (\"/jbw/gnu/\" . \"/usr15/degree/stud/jbw/gnu/\")
  256.      (\"\" . \"/usr/local/emacs/src/\")
  257.      ))
  258.  
  259. This means that anything in the /usr/src/public/perl/ directory should use
  260. the TAGS file /usr/src/public/perl/perl-3.0/TAGS; and file ending in .el should
  261. use the TAGS file /usr/local/emacs/src/TAGS; and anything in or below the
  262. directory /jbw/gnu/ should use the TAGS file /usr15/degree/stud/jbw/gnu/TAGS.
  263. A file called something like \"/usr/jbw/foo.el\" would use both the TAGS files
  264. /usr/local/emacs/src/TAGS and /usr15/degree/stud/jbw/gnu/TAGS (in that order)
  265. because it matches both patterns.
  266.  
  267. If the buffer-local variable `buffer-tag-table' is set, then it names a tags
  268. table that is searched before all others when find-tag is executed from this
  269. buffer.
  270.  
  271. If there is a file called \"TAGS\" in the same directory as the file in 
  272. question, then that tags file will always be used as well (after the
  273. `buffer-tag-table' but before the tables specified by this list.)
  274.  
  275. If the variable tags-file-name is set, then the tags file it names will apply
  276. to all buffers (for backwards compatibility.)  It is searched first.
  277. ")
  278.  
  279. (defvar buffer-tag-table nil
  280.   "*The name of one TAGS table to be used for this buffer in addition to the
  281. TAGS tables that the variable `tag-table-alist' specifies.  You can set this
  282. with meta-x set-buffer-tag-table.  See the documentation for the variable
  283. `tag-table-alist' for more information.")
  284. (make-variable-buffer-local 'buffer-tag-table)
  285.  
  286. (defvar tags-file-name nil
  287.   "*The name of the tags-table used by all buffers.  This is for backwards
  288. compatibility, and is largely supplanted by the variable tag-table-alist.")
  289. ;; (setq tags-file-name nil)  ; nuke previous value.  Is this cool?
  290.  
  291. ;; This will be used if it's loaded; don't force it on those who don't want it.
  292. ;;(autoload 'symlink-expand-file-name "symlink-fix")
  293.  
  294. (defun buffer-tag-table-list ()
  295.   "Returns a list (ordered) of the tags tables which should be used for 
  296. the current buffer."
  297.   (let (result expression)
  298.     (if buffer-tag-table
  299.     (setq result (cons buffer-tag-table result)))
  300.     (if (file-readable-p (concat default-directory "TAGS"))
  301.     (setq result (cons (concat default-directory "TAGS") result)))
  302.     (let ((key (or buffer-file-name
  303.            (concat default-directory (buffer-name))))
  304.       (alist tag-table-alist))
  305.       (while alist
  306.     (setq expression (car (car alist)))
  307.     ;; If the car of the alist item is a string, apply it as a regexp
  308.     ;; to the buffer-file-name.  Otherwise, evaluate it.  If the
  309.     ;; regexp matches, or the expression evaluates non-nil, then this
  310.     ;; item in tag-table-alist applies to this buffer.
  311.     (if (if (stringp expression)
  312.         (string-match (car (car alist)) key)
  313.           (condition-case nil
  314.           (eval expression)
  315.         (error nil)))
  316.         ;; Now evaluate the cdr of the alist item to get the name of
  317.         ;; the tag table file.
  318.         (progn
  319.           (setq expression 
  320.             (condition-case nil
  321.             (eval (cdr (car alist)))
  322.               (error nil)))
  323.           (if (stringp expression)
  324.           (setq result (cons expression result))
  325.         (error "Expression in tag-table-alist evaluated to non-string"))))
  326.     (setq alist (cdr alist))))
  327.     (or result tags-file-name
  328.     ;; **** I don't know if this is the right place to do this,
  329.     ;; **** Maybe it would be better to do this after (delq nil result).
  330.     (call-interactively 'visit-tags-table))
  331.     (if tags-file-name
  332.     (setq result (nconc result (list tags-file-name))))
  333.     (setq result
  334.       (mapcar
  335.        (function
  336.         (lambda (name)
  337.           (if (file-directory-p name)
  338.           (setq name (concat name "TAGS")))
  339.           (if (file-readable-p name)
  340.           (save-excursion
  341.             ;; get-tag-table-buffer has side-effects
  342.             (set-buffer (get-tag-table-buffer name))
  343.             buffer-file-name))))
  344.        result))
  345.     (setq result (delq nil result))
  346.     (or result (error "Buffer has no associated tag tables"))
  347.     (tags-remove-duplicates (nreverse result))))
  348.  
  349. (defun visit-tags-table (file)
  350.   "Tell tags commands to use tags table file FILE first.
  351. FILE should be the name of a file created with the `etags' program.
  352. A directory name is ok too; it means file TAGS in that directory."
  353.   (interactive (list (read-file-name "Visit tags table: (default TAGS) "
  354.                      default-directory
  355.                      (expand-file-name "TAGS" default-directory)
  356.                      t)))
  357.   (if (string-equal file "") 
  358.       (setq tags-file-name nil)
  359.       (progn
  360.         (setq file (expand-file-name file))
  361.         (if (file-directory-p file)
  362.             (setq file (expand-file-name "TAGS" file)))
  363.         (setq tags-file-name file))))
  364.  
  365. ;; **** What should the semantics of this be?
  366. (defun set-buffer-tag-table (file)
  367.   "In addition to the tags tables specified by the variable `tag-table-alist',
  368. each buffer can have one additional table.  This command sets that.
  369. See the documentation for the variable `tag-table-alist' for more information."
  370.   (interactive
  371.    (list
  372.      (read-file-name "Visit tags table: (directory sufficient) "
  373.              nil default-directory t)))
  374.   (or file (error "No TAGS file name supplied"))
  375.   (setq file (expand-file-name file))
  376.   (if (file-directory-p file)
  377.       (setq file (concat file "TAGS")))
  378.   (or (file-exists-p file) (error "TAGS file missing: %s" file))
  379.   (setq buffer-tag-table file))
  380.  
  381.  
  382. ;; Manipulating the tag table buffer
  383.  
  384. (defconst tag-table-completion-status nil
  385.   "Indicates whether a completion table has been built, or has explicitly not 
  386. been built.  this is nil, t, or 'disabled.")
  387. (make-variable-buffer-local 'tag-table-completion-status)
  388.  
  389. (defvar make-tags-files-invisible nil
  390.   "*If true, TAGS-files will not show up in buffer-lists or be 
  391. selectable (or deletable.)")
  392.  
  393. (defconst tag-table-files nil
  394.   "If the current buffer is a TAGS table, this holds a list of the files 
  395. referenced by this file, or nil if that hasn't been computed yet.")
  396. (make-variable-buffer-local 'tag-table-files)
  397.  
  398. (defun get-tag-table-buffer (tag-table)
  399.   "Returns a buffer visiting the give TAGS table, reverting if appropriate,
  400. and possibly building a completion-table."
  401.   (or (stringp tag-table)
  402.       (error "Bad tags file name supplied: %s" tag-table))
  403.   ;; add support for removing symbolic links from name
  404.   (if (fboundp 'symlink-expand-file-name)
  405.       (setq tag-table (symlink-expand-file-name tag-table)))
  406.   (let (buf build-completion check-name)
  407.     (setq buf (get-file-buffer tag-table))
  408.     (or buf
  409.     (if (file-readable-p tag-table)
  410.         (setq buf (find-file-noselect tag-table)
  411.           check-name t)
  412.       (error "No such tags file: %s" tag-table)))
  413.     (save-excursion
  414.       (set-buffer buf)
  415.       ;; make the TAGS buffer invisible
  416.       (if (and check-name
  417.            make-tags-files-invisible
  418.            (string-match "\\`[^ ]" (buffer-name)))
  419.       (rename-buffer (generate-new-buffer-name
  420.               (concat " " (buffer-name)))))
  421.       (or (verify-visited-file-modtime buf)
  422.       (cond ((yes-or-no-p
  423.           (format "Tags file %s has changed, read new contents? "
  424.               tag-table))
  425.          (revert-buffer t t)
  426.          (if (eq tag-table-completion-status t)
  427.              (setq tag-table-completion-status nil))
  428.          (setq tag-table-files nil))))
  429.       (or (eq (char-after 1) ?\f)
  430.       (error "File %s not a valid tags file" tag-table))
  431.       (or (memq tag-table-completion-status '(t disabled))
  432.       (setq build-completion t))
  433.       (and build-completion
  434.        (if (cond
  435.         ((eq tags-build-completion-table nil)
  436.          nil)
  437.         ((eq tags-build-completion-table t)
  438.          t)
  439.         ((eq tags-build-completion-table 'ask)
  440.          ;; don't bother asking for small ones
  441.          (or (< (buffer-size) 20000)
  442.              (y-or-n-p
  443.               (format "Build tag completion table for %s? "
  444.                   tag-table))))
  445.         (t (error
  446.             "tags-build-completion-table is not t, nil, or ask.")))
  447.            (condition-case foo
  448.            (progn
  449.              (add-to-tag-completion-table)
  450.              (setq tag-table-completion-status t))
  451.          ;; Allow user to C-g out correctly
  452.          (quit
  453.           (setq tag-table-completion-status nil)
  454.           (setq quit-flag t)
  455.           (eval t)))
  456.          (setq tag-table-completion-status 'disabled))))
  457.     buf))
  458.  
  459. ;; This function is unchanged from lisp/tags.el:
  460. (defun file-of-tag ()
  461.   "Return the file name of the file whose tags point is within.
  462. Assumes the tag table is the current buffer.
  463. File name returned is relative to tag table file's directory."
  464.   (let ((opoint (point))
  465.     prev size)
  466.     (save-excursion
  467.      (goto-char (point-min))
  468.      (while (< (point) opoint)
  469.        (forward-line 1)
  470.        (end-of-line)
  471.        (skip-chars-backward "^,\n")
  472.        (setq prev (point))
  473.        (setq size (read (current-buffer)))
  474.        (goto-char prev)
  475.        (forward-line 1)
  476.        (forward-char size))
  477.      (goto-char (1- prev))
  478.      (buffer-substring (point)
  479.                (progn (beginning-of-line) (point))))))
  480.  
  481. (defun tag-table-files (tag-table)
  482.   "Returns a list of the files referenced by the named TAGS table."
  483.   (save-excursion
  484.     (set-buffer (get-tag-table-buffer tag-table))
  485.     (or tag-table-files
  486.     (let (files prev size)
  487.       (goto-char (point-min))
  488.       (while (not (eobp))
  489.         (forward-line 1)
  490.         (end-of-line)
  491.         (skip-chars-backward "^,\n")
  492.         (setq prev (point))
  493.         (setq size (read (current-buffer)))
  494.         (goto-char prev)
  495.         (setq files (cons (expand-file-name
  496.                    (buffer-substring (1- (point))
  497.                          (save-excursion
  498.                            (beginning-of-line)
  499.                            (point)))
  500.                    default-directory)
  501.                   files))
  502.         (forward-line 1)
  503.         (forward-char size))
  504.       (setq tag-table-files (nreverse files))))
  505.     tag-table-files))
  506.  
  507. ;; **** should this be on previous page?
  508. (defun buffer-tag-table-files ()
  509.   "Returns a list of all files referenced by all TAGS tables that 
  510. this buffer uses."
  511.   (apply (function append)
  512.      (mapcar (function tag-table-files)
  513.          (buffer-tag-table-list))))
  514.  
  515.  
  516. ;; Building the completion table
  517.  
  518. ;; Test cases for building completion table; must handle these properly:
  519. ;; Lisp_Int, XSETINT, current_column 60,2282
  520. ;;       Lisp_Int, XSETINT, point>NumCharacters ? 0 : CharAt(363,9935
  521. ;;       Lisp_Int, XSETINT, point<=FirstCharacter ? 0 : CharAt(366,10108
  522. ;;     point<=FirstCharacter || CharAt(378,10630
  523. ;;     point>NumCharacters || CharAt(382,10825
  524. ;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,191,4562
  525. ;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,191,4562
  526. ;; DEFUN ("*", Ftimes,1172,32079
  527. ;; DEFUN ("/=", Fneq,1035,28839
  528. ;; defun_internal 4199,101362
  529. ;; int pure[PURESIZE / sizeof 53,1564
  530. ;; char staticvec1[NSTATICS * sizeof 667,17608
  531. ;;  Date: 04 May 87 23:53:11 PDT 26,1077
  532. ;; #define anymacroname(324,4344
  533. ;; (define-key ctl-x-map 311,11784
  534. ;; (define-abbrev-table 'c-mode-abbrev-table 24,1016
  535. ;; static char *skip_white(116,3443
  536. ;; static foo 348,11643
  537. ;; (defun texinfo-insert-@code 91,3358
  538. ;; (defvar texinfo-kindex)29,1105
  539. ;; (defun texinfo-format-\. 548,18376
  540. ;; (defvar sm::menu-kludge-y 621,22726
  541. ;; (defvar *mouse-drag-window* 103,3642
  542. ;; (defun simula-back-level(317,11263
  543. ;; } DPxAC,380,14024
  544. ;; } BM_QCB;69,2990
  545. ;; #define MTOS_DONE\t
  546.  
  547. ;; "^[^ ]+ +\\([^ ]+\\) "
  548.  
  549. ;; void *find_cactus_segment(116,2444
  550. ;; void *find_pdb_segment(162,3688
  551. ;; void init_dclpool(410,10739
  552. ;; WORD insert_draw_command(342,8881
  553. ;; void *req_pdbmem(579,15574
  554.  
  555. (defvar tag-completion-table (make-vector 511 0))
  556.  
  557. (defvar tag-symbol)
  558. (defvar tag-table-symbol)
  559. (defvar tag-symbol-tables)
  560. (defvar buffer-tag-table-list)
  561.  
  562. ;; make two versions of this, macro and non-macro,
  563. ;; and have the correct one used depending whether it's byte compiled
  564. ;; (well I think that's a little silly -- only lusers run interpreted! -jwz)
  565. (defmacro intern-tag-symbol (tag)
  566.   (`(progn
  567.       (setq tag-symbol (intern (, tag) tag-completion-table)
  568.         tag-symbol-tables (and (boundp tag-symbol)
  569.                    (symbol-value tag-symbol)))
  570.       (or (memq tag-table-symbol tag-symbol-tables)
  571.       (set tag-symbol (cons tag-table-symbol tag-symbol-tables))))))
  572.  
  573. (defun intern-tag-symbol2 (tag)
  574.   (setq tag-symbol (intern tag tag-completion-table)
  575.     tag-symbol-tables (and (boundp tag-symbol)
  576.                    (symbol-value tag-symbol)))
  577.   (or (memq tag-table-symbol tag-symbol-tables)
  578.       (set tag-symbol (cons tag-table-symbol tag-symbol-tables))))
  579.  
  580. ;; This won't be evaluated at during byte-compilation, thus ensuring the
  581. ;; macro version will be used then.  Since the macro version is too slow
  582. ;; to use unless its usages are byte-compiled, we want to make sure we use
  583. ;; the non-macro version if we are using the non byte-compiled version of
  584. ;; add-to-tag-completion-table.
  585. (fset 'intern-tag-symbol (symbol-function 'intern-tag-symbol2))
  586.  
  587. ;; Can't use "\\s " in these patterns because that will include newline
  588. (defconst tags-DEFUN-pattern
  589.           "DEFUN[ \t]*(\"\\([^\"]+\\)\",[ \t]*\\(\\(\\sw\\|\\s_\\)+\\),\C-?")
  590. (defconst tags-array-pattern ".*[ \t]+\\([^ \[]+\\)\\[")
  591. (defconst tags-def-pattern
  592.           "\\(.*[ \t]+\\)?\\(\\(\\sw\\|\\s_\\)+\\)[ ();,\t]*\C-?"
  593. ;; "\\(.*[ \t]+\\)?\\(\\(\\sw\\|\\s_\\)+\\)[ ()]*\C-?"
  594. ;; "\\(\\sw\\|\\s_\\)+[ ()]*\C-?"
  595.       )
  596. (defconst tags-file-pattern "^\f\n\\([^,]+\\),[0-9]+\n")
  597.  
  598. (defun add-to-tag-completion-table ()
  599.   "Sucks the current buffer (a TAGS table) into the completion-table."
  600.   (message "Adding %s to tags completion table..."
  601.        buffer-file-name)
  602.   (goto-char (point-min))
  603.   (let ((tag-table-symbol (intern buffer-file-name tag-completion-table))
  604.     (original-syntax-table (syntax-table))
  605.     ;; tag-table-symbol is used by intern-tag-symbol
  606.     filename file-type name name2 tag-symbol eol-point
  607.     tag-symbol-tables file-type-syntax-table)
  608.     (unwind-protect
  609.     ;; loop over the files mentioned in the TAGS file
  610.     ;; for each file, try to find its major-mode,
  611.     ;; then process tags appropriately
  612.     (while (looking-at tags-file-pattern)
  613.       (goto-char (match-end 0))
  614.       (setq filename (buffer-substring (match-beginning 1) (match-end 1)))
  615.       (setq filename (file-name-sans-versions filename))
  616.       ;; clear loop variables
  617.       (setq file-type nil)
  618.       (setq file-type-syntax-table nil)
  619.       (setq name nil name2 nil)
  620.       (let ((alist auto-mode-alist)
  621.         (case-fold-search (eq system-type 'vax-vms)))
  622.         ;; loop over pairs of regexps and major-modes
  623.         (while (and (not file-type) alist)
  624.           (if (string-match (car (car alist)) filename)
  625.           (setq file-type (cdr (car alist))))
  626.           (setq alist (cdr alist))))
  627.       ;; try to find a syntax table whose name begins with the major-mode
  628.       (if file-type
  629.           (setq file-type-syntax-table
  630.             (intern (concat (symbol-name file-type)
  631.                     "-syntax-table"))))
  632.       ;;      (message "%s %s" filename file-type-syntax-table)
  633.       (if (and file-type-syntax-table (boundp file-type-syntax-table))
  634.           (set-syntax-table (symbol-value file-type-syntax-table))
  635.         (set-syntax-table (standard-syntax-table)))
  636.       ;; loop over the individual tag lines
  637.       (while (not (or (eobp) (eq (following-char) ?\f)))
  638.         (cond ((and (eq file-type 'c-mode)
  639.             (let ((case-fold-search nil))
  640.               (looking-at "DEFUN[ \t]")))
  641.            (or (looking-at tags-DEFUN-pattern)
  642.                (error "DEFUN doesn't fit pattern"))
  643.            (setq name (buffer-substring (match-beginning 1)
  644.                         (match-end 1)))
  645.            (setq name2 (buffer-substring (match-beginning 2)
  646.                          (match-end 2))))
  647.           ((looking-at "\\s ")
  648.            ;; skip probably bogus entry:
  649.            )
  650.           ((and (eq file-type 'c-mode)
  651.             (looking-at ".*\\["))
  652.            (or (looking-at tags-array-pattern)
  653.                (error "array definition doesn't fit pattern"))
  654.            (setq name (buffer-substring (match-beginning 1)
  655.                         (match-end 1))))
  656.           ((looking-at tags-def-pattern)
  657.            (setq name (buffer-substring (match-beginning 2)
  658.                         (match-end 2)))))
  659.         ;; add the tags we found to the completion table
  660.         (if name (intern-tag-symbol name))
  661.         (if name2 (intern-tag-symbol name2))
  662.         (forward-line 1)))
  663.       (set-syntax-table original-syntax-table))
  664.     (or (eobp) (error "Bad TAGS file")))
  665.   (message "Adding %s to tags completion table...done"
  666.        buffer-file-name))
  667.  
  668.  
  669. ;; Interactive find-tag
  670.  
  671. (defvar find-tag-default-hook nil
  672.   "****Function to call to create a default tag.
  673. Make it buffer-local in a mode hook.
  674. The function is called with no args.")
  675.  
  676. (defvar find-tag-hook nil
  677.   "****Function to call after a hook is found.
  678. Make it buffer-local in a mode hook.
  679. The function is called with no args.")
  680.  
  681. ;; Return a default tag to search for, based on the text at point.
  682. (defun find-tag-default ()
  683.   (or (and (boundp 'find-tag-default-hook)
  684.        (not (memq find-tag-default-hook '(nil find-tag-default)))
  685.        (condition-case data
  686.            (funcall find-tag-default-hook)
  687.          (error
  688.           (message "value of find-tag-default-hook signalled error: %s"
  689.                data)
  690.           (sit-for 1)
  691.           nil)))
  692.       (save-excursion
  693.     (if (not (memq (char-syntax (preceding-char)) '(?w ?_)))
  694.         (while (not (looking-at "\\sw\\|\\s_\\|\\'"))
  695.           (forward-char 1)))
  696.     (while (looking-at "\\sw\\|\\s_")
  697.       (forward-char 1))
  698.     (if (re-search-backward "\\sw\\|\\s_" nil t)
  699.         (regexp-quote
  700.          (progn (forward-char 1)
  701.             (buffer-substring (point)
  702.                       (progn (forward-sexp -1)
  703.                          (while (looking-at "\\s'")
  704.                            (forward-char 1))
  705.                          (point)))))
  706.       nil))))
  707.  
  708. ;;"\\(\\s \\|\\s.\\|\\s\(\\|\\s\)\\|\\s'\\|\\s\"\\|\\s$\\|\\s/\\|\\s\\\\|\\s<\\|\\s>\\)"
  709. ;;"[ \";]"
  710.  
  711. ;;(defun non-symbol-char-regexp ()
  712. ;;  (let ((i 0)
  713. ;;    (numchars (length (syntax-table)))
  714. ;;    symbol-chars)
  715. ;;    (while (< i numchars)
  716. ;;      (if (memq (char-syntax i) '(?w ?_))
  717. ;;      (setq symbol-chars (cons i symbol-chars)))
  718. ;;      (setq i (1+ i)))
  719. ;;    (concat symbol-chars)))
  720.  
  721. ;; This function depends on the following symbols being bound properly:
  722. ;; buffer-tag-table-list,
  723. ;; tag-symbol-tables (value irrelevant, bound outside for efficiency)
  724. (defun tag-completion-predicate (tag-symbol)
  725.   (and (boundp tag-symbol)
  726.        (setq tag-symbol-tables (symbol-value tag-symbol))
  727.        (catch 'found
  728.      (while tag-symbol-tables
  729.        (if (memq (car tag-symbol-tables) buffer-tag-table-list)
  730.            (throw 'found t))
  731.        (setq tag-symbol-tables (cdr tag-symbol-tables))))))
  732.  
  733. (defun buffer-tag-table-symbol-list ()
  734.   (mapcar (function
  735.        (lambda (table-name)
  736.          (intern table-name tag-completion-table)))
  737.       (buffer-tag-table-list)))
  738.     
  739. ;;(defun strip-regexp-border (pattern)
  740. ;;  ;; Avoid displaying ugly regexp borders to the user
  741. ;;  (cond (pattern
  742. ;;     (if (or (string-match "\\`\\[[^\]]+\\]" pattern)
  743. ;;         ;;(string-match "\\`\\\\(\\([^\\\\]\\|\\\\[^\)]\\)+\\\\)"
  744. ;;         ;;              pattern)
  745. ;;         ;;(string-match "\\`\\\\[b<>`'WsS]" pattern)
  746. ;;         )
  747. ;;         (setq pattern (substring pattern
  748. ;;                      (match-end 0))))
  749. ;;     (if (or (string-match "\\[[^\]]+\\]\\'" pattern)
  750. ;;         ;;(string-match "\\\\(\\([^\\\\]\\|\\\\[^\)]\\)+\\\\)\\'"
  751. ;;         ;;              pattern)
  752. ;;         ;;(string-match "\\\\[b<>`'WsS]\\'" pattern)
  753. ;;         )
  754. ;;         (setq pattern (substring pattern 0
  755. ;;                      (match-beginning 0))))))
  756. ;;  pattern)
  757.  
  758. (defun find-tag-tag (prompt)
  759.   (let* ((default (find-tag-default))
  760.      (buffer-tag-table-list (buffer-tag-table-symbol-list))
  761.      tag-symbol-tables tag-name)
  762.     (setq tag-name
  763.       (completing-read
  764.        (if default
  765.            (format "%s(default %s) " prompt default)
  766.          prompt)
  767.        tag-completion-table 'tag-completion-predicate nil nil))
  768.     (if (string-equal tag-name "")
  769.     (list default)            ;indicate exact symbol match
  770.       tag-name)))
  771.  
  772. (defvar last-tag-data nil
  773. "Information for continuing a tag search.
  774. Is of the form (TAG POINT TAG-TABLE TAG-TABLE ...).")
  775.  
  776. (defvar tags-loop-form nil
  777.   "Form for tags-loop-continue to eval to process one file.
  778. If it returns nil, it is through with one file; move on to next.")
  779.  
  780. (autoload 'get-symbol-syntax-table "symbol-syntax")
  781.  
  782. (defun find-tag-internal (tagname)
  783.   "Foo"
  784.   (let ((local-find-tag-hook find-tag-hook)
  785.     (next (null tagname))
  786.     (exact (consp tagname))
  787.     symbol-border tag-target
  788.     tag-tables tag-table-point file linebeg startpos target buf
  789.     offset found pat syn-tab)
  790.     (if exact (setq tagname (car tagname)))
  791.     (cond (next
  792.        (setq tag-tables (cdr (cdr last-tag-data)))
  793.        (setq tagname (car last-tag-data))
  794.        (setq tag-table-point (car (cdr last-tag-data))))
  795.       (t
  796.        (setq tag-tables (buffer-tag-table-list))
  797.        (setq tag-table-point 1)))
  798.     ;; If tagname is a list: (TAGNAME), this indicates requiring an exact
  799.     ;; symbol match.  Similarly, \_ in the tagname is used to indicate a
  800.     ;; symbol boundary.
  801.     (cond ((or exact
  802.            (string-match "\\\\_" tagname))
  803.        (setq symbol-border t)
  804.        (if exact
  805.            (setq tag-target (concat "\\_" tagname "\\_"))
  806.          (setq tag-target (copy-sequence tagname)))
  807.        (while (string-match "\\\\_" tag-target)
  808.          (aset tag-target (1- (match-end 0)) ?b))
  809.        (setq syn-tab (get-symbol-syntax-table (syntax-table)))
  810.        ;;       (let ((i 0)
  811.        ;;         (len (length tag-target))
  812.        ;;         j)
  813.        ;;         (while (< i len)
  814.        ;;           (cond ((eq ?\\ (aref tag-target i))
  815.        ;;              (setq j (1+ i))
  816.        ;;              (if (eq ?_ (aref tag-target j))
  817.        ;;              (aset tag-target j ?b))))
  818.        ;;           (setq i (1+ i))))
  819.        )
  820.       (t
  821.        (setq tag-target tagname)
  822.        (setq syn-tab (syntax-table))))
  823.     (save-excursion
  824.       (catch 'found
  825.     (while tag-tables
  826.       (set-buffer (get-tag-table-buffer (car tag-tables)))
  827.       (bury-buffer (current-buffer))
  828.       (goto-char (or tag-table-point (point-min)))
  829.       (setq tag-table-point nil)
  830.       (let ((osyn (syntax-table))
  831.         case-fold-search)
  832.         (set-syntax-table syn-tab)
  833.         (unwind-protect
  834.         ;; **** should there be support for non-regexp tag searches?
  835.         (while (re-search-forward tag-target nil t)
  836.           (if (looking-at "[^\n\C-?]*\C-?")
  837.               (throw 'found t)))
  838.           (set-syntax-table osyn)))
  839.       (setq tag-tables (cdr tag-tables)))
  840.     (error "No %sentries %s %s"
  841.            (if next "more " "")
  842.            (if exact "matching" "containing")
  843.            tagname))
  844.       (search-forward "\C-?")
  845.       (setq file (expand-file-name (file-of-tag)))
  846.       (setq linebeg
  847.         (buffer-substring (1- (point))
  848.                   (save-excursion (beginning-of-line) (point))))
  849.       (search-forward ",")
  850.       (setq startpos (read (current-buffer)))
  851.       (setq last-tag-data (nconc (list tagname (point)) tag-tables)))
  852.     (setq buf (find-file-noselect file))
  853.     (save-excursion
  854.       (set-buffer buf)
  855.       (save-excursion
  856.     (save-restriction
  857.       (widen)
  858.       (setq offset 1000)
  859.       (setq pat (concat "^" (regexp-quote linebeg)))
  860.       (or startpos (setq startpos (point-min)))
  861.       (while (and (not found)
  862.               (progn
  863.             (goto-char (- startpos offset))
  864.             (not (bobp))))
  865.         (setq found (re-search-forward pat (+ startpos offset) t))
  866.         (setq offset (* 3 offset)))
  867.       (or found
  868.           (re-search-forward pat nil t)
  869.           (error "%s not found in %s" pat file))
  870.       (beginning-of-line)
  871.       (setq startpos (point)))))
  872.     (cons buf startpos)))
  873.  
  874. (defun find-tag (tagname &optional other-window)
  875.   "*Find tag whose name contains TAGNAME.
  876.  Selects the buffer that the tag is contained in
  877. and puts point at its definition.
  878.  If TAGNAME is a null string, the expression in the buffer
  879. around or before point is used as the tag name.
  880.  If called interactively with a numeric argument, searches for the next tag
  881. in the tag table that matches the tagname used in the previous find-tag.
  882.  If second arg OTHER-WINDOW is non-nil, uses another window to display
  883. the tag.
  884.  
  885. This version of this function supports multiple active tags tables,
  886. and completion.
  887.  
  888. Variables of note:
  889.  
  890.   tag-table-alist        controls which tables apply to which buffers
  891.   tags-file-name        a default tags table
  892.   tags-build-completion-table   controls completion behavior
  893.   buffer-tag-table        another way of specifying a buffer-local table
  894.   make-tags-files-invisible    whether tags tables should be very hidden
  895.   tag-mark-stack-max        how many tags-based hops to remember"
  896.   (interactive (if current-prefix-arg
  897.            '(nil nil)
  898.          (list (find-tag-tag "Find tag: ") nil)))
  899.   (let* ((local-find-tag-hook find-tag-hook)
  900.      (next (null tagname))
  901.      (result (find-tag-internal tagname))
  902.      (tag-buf (car result))
  903.      (tag-point (cdr result)))
  904.     ;; push old position
  905.     (if (or (not next)
  906.         (not (memq last-command
  907.                '(find-tag find-tag-other-window tags-loop-continue))))
  908.     (push-tag-mark))
  909.     (if other-window
  910.     (pop-to-buffer tag-buf)
  911.       (switch-to-buffer tag-buf))
  912.     (widen)
  913.     (push-mark)
  914.     (goto-char tag-point)
  915.     (if find-tag-hook
  916.     (funcall find-tag-hook)
  917.       (if local-find-tag-hook
  918.       (funcall local-find-tag-hook))))
  919.   (setq tags-loop-form (list 'find-tag nil nil))
  920.   ;; Return t in case used as the tags-loop-form.
  921.   t)
  922.  
  923. ;; This function is unchanged from lisp/tags.el:
  924. (defun find-tag-other-window (tagname)
  925.   "*Find tag whose name contains TAGNAME.
  926.  Selects the buffer that the tag is contained in in another window
  927. and puts point at its definition.
  928.  If TAGNAME is a null string, the expression in the buffer
  929. around or before point is used as the tag name.
  930.  If second arg NEXT is non-nil (interactively, with prefix arg),
  931. searches for the next tag in the tag table
  932. that matches the tagname used in the previous find-tag.
  933.  
  934. This version of this function supports multiple active tags tables,
  935. and completion.
  936.  
  937. Variables of note:
  938.  
  939.   tag-table-alist        controls which tables apply to which buffers
  940.   tags-file-name        a default tags table
  941.   tags-build-completion-table   controls completion behavior
  942.   buffer-tag-table        another way of specifying a buffer-local table
  943.   make-tags-files-invisible    whether tags tables should be very hidden
  944.   tag-mark-stack-max        how many tags-based hops to remember"
  945.   (interactive (if current-prefix-arg
  946.            '(nil)
  947.          (list (find-tag-tag "Find tag other window: "))))
  948.   (find-tag tagname t))
  949.  
  950.  
  951. ;; Completion on tags in the buffer
  952.  
  953. (defun lisp-complete-symbol ()
  954.   "*Perform completion on Lisp symbol preceding point.
  955. That symbol is compared against the symbols that exist
  956. and any additional characters determined by what is there
  957. are inserted.
  958. If the symbol starts just after an open-parenthesis,
  959. only symbols with function definitions are considered.
  960. Otherwise, all symbols with function definitions, values
  961. or properties are considered."
  962.   (interactive)
  963.   (let ((buffer-syntax (syntax-table)))
  964.     (unwind-protect
  965.     (progn
  966.       (if lisp-mode-syntax-table
  967.           (set-syntax-table lisp-mode-syntax-table))
  968.       (let ((fn (save-excursion
  969.               (backward-sexp 1)
  970.               (while (= (char-syntax (following-char)) ?\')
  971.             (forward-char 1))
  972.               (eq (preceding-char) ?\())))
  973.         (complete-symbol
  974.          obarray
  975.          (if fn
  976.          'fboundp
  977.            (function
  978.         (lambda (sym)
  979.           (or (boundp sym)
  980.               (fboundp sym)
  981.               (symbol-plist sym)))))
  982.          (if (not fn)
  983.          ;; prettify the completion list by marking fns with " <f>"
  984.          (function
  985.           (lambda (list)
  986.             (let (new)
  987.               (while list
  988.             (setq new (cons (if (fboundp (intern (car list)))
  989.                         (list (car list) " <f>")
  990.                       (car list))
  991.                     new))
  992.             (setq list (cdr list)))
  993.               (nreverse new))))))))
  994.       ;; unwind-protected
  995.       (set-syntax-table buffer-syntax))))
  996.  
  997. (defun complete-symbol (&optional table predicate prettify)
  998.   (let* ((end (point))
  999.      (beg (save-excursion
  1000.         (backward-sexp 1)
  1001.         (while (= (char-syntax (following-char)) ?\')
  1002.           (forward-char 1))
  1003.         (point)))
  1004.      (pattern (buffer-substring beg end))
  1005.      (table (or table obarray))
  1006.      (completion (try-completion pattern table predicate)))
  1007.     (cond ((eq completion t))
  1008.       ((null completion)
  1009.        (message "Can't find completion for \"%s\"" pattern)
  1010.        (ding))
  1011.       ((not (string-equal pattern completion))
  1012.        (delete-region beg end)
  1013.        (insert completion))
  1014.       (t
  1015.        (message "Making completion list...")
  1016.        (let ((list (all-completions pattern table predicate)))
  1017.          (if prettify
  1018.          (setq list (funcall prettify list)))
  1019.          (with-output-to-temp-buffer "*Help*"
  1020.            (display-completion-list list)))
  1021.        (message "Making completion list...%s" "done")))))
  1022.  
  1023. (defun tag-complete-symbol ()
  1024.   "The function used to do tags-completion (using 'tag-completion-predicate)."
  1025.   (interactive)
  1026.   (let* ((buffer-tag-table-list (buffer-tag-table-symbol-list))
  1027.      tag-symbol-tables)
  1028.     (complete-symbol tag-completion-table 'tag-completion-predicate)))
  1029.  
  1030.  
  1031. ;; Applying a command to files mentioned in tag tables
  1032.  
  1033. (defvar next-file-list nil
  1034.   "List of files for next-file to process.")
  1035.  
  1036. (defun next-file (&optional initialize)
  1037.   "Select next file among files in current tag table(s).
  1038. Non-nil argument (prefix arg, if interactive) initializes to the beginning 
  1039. of the list of files in the (first) tag table."
  1040.   (interactive "P")
  1041.   (if initialize
  1042.       (setq next-file-list (buffer-tag-table-files)))
  1043.   (or next-file-list
  1044.       (error "All files processed."))
  1045.   (let* ((file (car next-file-list))
  1046.      (buf (get-file-buffer file))
  1047.      new)
  1048.     (setq next-file-list (cdr next-file-list))
  1049.     (or buf
  1050.     (setq buf (find-file-noselect file)
  1051.           new t))
  1052.     (switch-to-buffer buf t)
  1053.     (widen)
  1054.     (cond ((> (point) (point-min))
  1055.        (push-mark nil t)
  1056.        (goto-char (point-min))))
  1057.     new))
  1058.  
  1059. (defun tags-loop-continue (&optional first-time)
  1060.   "Continue last \\[tags-search] or \\[tags-query-replace] command.
  1061. Used noninteractively with non-nil argument
  1062. to begin such a command.  See variable tags-loop-form."
  1063.   (interactive)
  1064.   (let (buf-is-new message)
  1065.     (cond (first-time
  1066.        (setq buf-is-new (next-file t))
  1067.        (message "Scanning file %s..." buffer-file-name)
  1068.        (setq message t)))
  1069.     ;; **** (let ((cursor-in-echo-area t)))
  1070.     (while (not (eval tags-loop-form))
  1071.       (if (and buf-is-new (not (buffer-modified-p)))
  1072.       (kill-buffer (current-buffer)))
  1073.       (setq buf-is-new (next-file))
  1074.       (message "Scanning file %s..." buffer-file-name)
  1075.       (setq message t))
  1076.     (switch-to-buffer (current-buffer))
  1077.     (if message
  1078.     (message "Scanning file %s...done" buffer-file-name))))
  1079.  
  1080. ;; This function is unchanged from lisp/tags.el:
  1081. (defun tags-search (regexp)
  1082.   "Search through all files listed in tag table for match for REGEXP.
  1083. Stops when a match is found.
  1084. To continue searching for next match, use command \\[tags-loop-continue].
  1085.  
  1086. See documentation of variable tag-table-alist."
  1087.   (interactive "sTags search (regexp): ")
  1088.   (if (and (equal regexp "")
  1089.        (eq (car tags-loop-form) 're-search-forward))
  1090.       (tags-loop-continue nil)
  1091.     (setq tags-loop-form
  1092.       (list 're-search-forward regexp nil t))
  1093.     (tags-loop-continue t)))
  1094.  
  1095. ;; This function is unchanged from lisp/tags.el:
  1096. (defun tags-query-replace (from to &optional delimited)
  1097.   "Query-replace-regexp FROM with TO through all files listed in tag table.
  1098. Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
  1099. If you exit (C-G or ESC), you can resume the query-replace
  1100. with the command \\[tags-loop-continue].
  1101.  
  1102. See documentation of variable tag-table-alist."
  1103.   (interactive "sTags query replace (regexp): \nsTags query replace %s by: \nP")
  1104.   (setq tags-loop-form
  1105.     (list 'and (list 'save-excursion
  1106.              (list 're-search-forward from nil t))
  1107.           (list 'not (list 'perform-replace from to t t 
  1108.                    (not (null delimited))))))
  1109.   (tags-loop-continue t))
  1110.  
  1111.  
  1112. ;; Miscellaneous
  1113.  
  1114. ;; **** need to alter
  1115. ;; This function is unchanged from lisp/tags.el:
  1116. (defun list-tags (string)
  1117.   "Display list of tags in file FILE.
  1118. FILE should not contain a directory spec
  1119. unless it has one in the tag table."
  1120.   (interactive "sList tags (in file): ")
  1121.   (with-output-to-temp-buffer "*Tags List*"
  1122.     (princ "Tags in file ")
  1123.     (princ string)
  1124.     (terpri)
  1125.     (save-excursion
  1126.      (visit-tags-table-buffer)
  1127.      (goto-char 1)
  1128.      (search-forward (concat "\f\n" string ","))
  1129.      (forward-line 1)
  1130.      (while (not (or (eobp) (looking-at "\f")))
  1131.        (princ (buffer-substring (point)
  1132.                 (progn (skip-chars-forward "^\C-?")
  1133.                        (point))))
  1134.        (terpri)
  1135.        (forward-line 1)))))
  1136.  
  1137. ;; **** need to alter
  1138. ;; This function is unchanged from lisp/tags.el:
  1139. (defun tags-apropos (string)
  1140.   "Display list of all tags in tag table REGEXP matches."
  1141.   (interactive "sTag apropos (regexp): ")
  1142.   (with-output-to-temp-buffer "*Tags List*"
  1143.     (princ "Tags matching regexp ")
  1144.     (prin1 string)
  1145.     (terpri)
  1146.     (save-excursion
  1147.      (visit-tags-table-buffer)
  1148.      (goto-char 1)
  1149.      (while (re-search-forward string nil t)
  1150.        (beginning-of-line)
  1151.        (princ (buffer-substring (point)
  1152.                 (progn (skip-chars-forward "^\C-?")
  1153.                        (point))))
  1154.        (terpri)
  1155.        (forward-line 1)))))
  1156.  
  1157. ;; **** copied from tags.el
  1158. (defun visit-tags-table-buffer ()
  1159.   "Select the buffer containing the current tag table.
  1160. This is a file whose name is in the variable tags-file-name."
  1161.   (or tags-file-name
  1162.       (call-interactively 'visit-tags-table))
  1163.   (set-buffer (or (get-file-buffer tags-file-name)
  1164.           (progn
  1165.             (setq tag-table-files nil)
  1166.             (find-file-noselect tags-file-name))))
  1167.   (or (verify-visited-file-modtime (get-file-buffer tags-file-name))
  1168.       (cond ((yes-or-no-p "Tags file has changed, read new contents? ")
  1169.          (revert-buffer t t)
  1170.          (setq tag-table-files nil))))
  1171.   (or (eq (char-after 1) ?\^L)
  1172.       (error "File %s not a valid tag table" tags-file-name)))
  1173.  
  1174.  
  1175. ;; Sample uses of find-tag-hook and find-tag-default-hook
  1176.  
  1177. ;; Example buffer-local tag finding
  1178.  
  1179. (or (boundp 'emacs-lisp-mode-hook)
  1180.     (setq emacs-lisp-mode-hook nil))
  1181. (if (eq (car-safe emacs-lisp-mode-hook) 'lambda)
  1182.     (setq emacs-lisp-mode-hook (list emacs-lisp-mode-hook)))
  1183. (or (memq 'setup-emacs-lisp-default-tag-hook emacs-lisp-mode-hook)
  1184.     (setq emacs-lisp-mode-hook
  1185.       (cons 'setup-emacs-lisp-default-tag-hook emacs-lisp-mode-hook)))
  1186.  
  1187. (defun setup-emacs-lisp-default-tag-hook ()
  1188.   (cond ((eq major-mode 'emacs-lisp-mode)
  1189.      (make-variable-buffer-local 'find-tag-default-hook)
  1190.      (setq find-tag-default-hook 'emacs-lisp-default-tag))))
  1191. ;; Run it once immediately
  1192. (setup-emacs-lisp-default-tag-hook)
  1193. (if (get-buffer "*scratch*")
  1194.     (save-excursion (set-buffer "*scratch*")
  1195.             (setup-emacs-lisp-default-tag-hook)))
  1196.  
  1197. (defun emacs-lisp-default-tag ()
  1198.   "Function to return a default tag for Emacs-Lisp mode."
  1199.   (let ((tag (or (variable-at-point)
  1200.          (function-called-at-point))))
  1201.     (if tag (symbol-name tag))))
  1202.  
  1203. ;;(defun Info-find-tag-hook ()
  1204. ;;  "Function to call after finding a tag in Info-mode."
  1205. ;;  (let ((onode Info-current-node)
  1206. ;;    (ofile Info-current-file)
  1207. ;;    (opoint (point)))
  1208. ;;    (if (not (string= "*info*" (buffer-name)))
  1209. ;;    (progn                ; replace current *info* file
  1210. ;;      (kill-buffer "*info*")
  1211. ;;      (rename-buffer "*info*")))
  1212. ;;    (or (eq major-mode 'Info-mode)
  1213. ;;    (Info-mode))
  1214. ;;    (setq Info-current-file
  1215. ;;      (file-name-sans-versions buffer-file-name))
  1216. ;;    (Info-select-node)
  1217. ;;    (or (and (equal onode Info-current-node)
  1218. ;;         (equal ofile Info-current-file))
  1219. ;;    (setq Info-history (cons (list ofile onode opoint)
  1220. ;;                 Info-history)))))
  1221. ;;
  1222. ;;;; Info-mode does not have a hook, so patch in the necessary calls.
  1223. ;;
  1224. ;;(require 'info)
  1225. ;;
  1226. ;;;; Only do this once
  1227. ;;(fset 'Info-mode
  1228. ;;      (append (symbol-function 'Info-mode)
  1229. ;;          (list '(make-local-variable 'find-tag-hook)
  1230. ;;            '(setq find-tag-hook 'Info-find-tag-hook)
  1231. ;;            '(modify-syntax-entry ?\' "."))))
  1232.  
  1233.  
  1234. ;; Display short info on tag in minibuffer
  1235.  
  1236. (if (null (lookup-key esc-map "?"))
  1237.     (define-key esc-map "?" 'display-tag-info))
  1238.  
  1239. (defun display-tag-info (tagname)
  1240.   "Prints a description of the first tag matching TAGNAME in the echo area.
  1241. If this is an elisp function, prints something like \"(defun foo (x y z)\".
  1242. That is, is prints the first line of the definition of the form.
  1243. If this is a C-defined elisp function, it does something more clever."
  1244.   (interactive (if current-prefix-arg
  1245.            '(nil)
  1246.          (list (find-tag-tag "Display tag info: "))))
  1247.   (let* ((results (find-tag-internal tagname))
  1248.      (tag-buf (car results))
  1249.      (tag-point (cdr results))
  1250.      info lname min max fname args)
  1251.     (save-excursion
  1252.       (set-buffer tag-buf)
  1253.       (save-excursion
  1254.     (save-restriction
  1255.       (widen)
  1256.       (goto-char tag-point)
  1257.       (cond ((let ((case-fold-search nil))
  1258.            (looking-at "^DEFUN[ \t]"))
  1259.          (forward-sexp 1)
  1260.          (down-list 1)
  1261.          (setq lname (read (current-buffer))
  1262.                fname (buffer-substring
  1263.                   (progn (forward-sexp 1) (point))
  1264.                   (progn (backward-sexp 1) (point)))
  1265.                min (buffer-substring
  1266.                 (progn (forward-sexp 3) (point))
  1267.                 (progn (backward-sexp 1) (point)))
  1268.                max (buffer-substring
  1269.                 (progn (forward-sexp 2) (point))
  1270.                 (progn (backward-sexp 1) (point))))
  1271.          (backward-up-list 1)
  1272.          (setq args (buffer-substring
  1273.                  (progn (forward-sexp 2) (point))
  1274.                  (progn (backward-sexp 1) (point))))
  1275.          (setq info (format "Elisp: %s, C: %s %s, #args: %s"
  1276.                     lname
  1277.                     fname args
  1278.                     (if (string-equal min max)
  1279.                     min
  1280.                       (format "from %s to %s" min max)))))
  1281.         (t
  1282.          (setq info
  1283.                (buffer-substring
  1284.             (progn (beginning-of-line) (point))
  1285.             (progn (end-of-line) (point)))))))))
  1286.     (message "%s" info))
  1287.   (setq tags-loop-form '(display-tag-info nil))
  1288.   ;; Always return non-nil
  1289.   t)
  1290.  
  1291.  
  1292. ;; Keep track of old locations before finding tags
  1293.  
  1294. (defvar tag-mark-stack1 nil)
  1295. (defvar tag-mark-stack2 nil)
  1296. (defvar tag-mark-stack-max 16
  1297.   "*The maximum number of elements kept on the mark-stack used
  1298. by tags-search.  See also the commands push-tag-mark (\\[push-tag-mark])
  1299. and pop-tag-mark. (\\[pop-tag-mark]).")
  1300.  
  1301. (defun push-mark-on-stack (stack-symbol &optional max-size)
  1302.   (let ((stack (symbol-value stack-symbol)))
  1303.     (setq stack (cons (point-marker) stack))
  1304.     (cond ((and max-size
  1305.         (> (length stack) max-size))
  1306.        (set-marker (car (nthcdr max-size stack)) nil)
  1307.        (setcdr (nthcdr (1- max-size) stack) nil)))
  1308.     (set stack-symbol stack)))
  1309.  
  1310. (defun pop-mark-from-stack (stack-symbol1 stack-symbol2 &optional max-size)
  1311.   (let* ((stack (or (symbol-value stack-symbol1)
  1312.             (error "No more tag marks on stack")))
  1313.      (marker (car stack))
  1314.      (m-buf (marker-buffer marker)))
  1315.     (set stack-symbol1 (cdr stack))
  1316.     (or m-buf
  1317.     (error "Marker has no buffer"))
  1318.     (if (null (buffer-name m-buf))
  1319.     (error "Buffer has been killed"))
  1320.     (push-mark-on-stack stack-symbol2 max-size)
  1321.     (switch-to-buffer m-buf)
  1322.     (widen)
  1323.     (goto-char (marker-position marker))))
  1324.  
  1325. (defun push-tag-mark ()
  1326.   (push-mark-on-stack 'tag-mark-stack1 tag-mark-stack-max))
  1327.  
  1328. (if (memq (lookup-key esc-map "*") '(nil undefined))
  1329.     (define-key esc-map "*" 'pop-tag-mark))
  1330.  
  1331. (defun pop-tag-mark (arg)
  1332.   "find-tag maintains a mark-stack seperate from the \\[set-mark-command] mark-stack.
  1333. This function pops (and moves to) the tag at the top of this stack."
  1334.   (interactive "P")
  1335.   (if (not arg)
  1336.       (pop-mark-from-stack
  1337.        'tag-mark-stack1 'tag-mark-stack2 tag-mark-stack-max)
  1338.     (pop-mark-from-stack
  1339.      'tag-mark-stack2 'tag-mark-stack1 tag-mark-stack-max)))
  1340.  
  1341.  
  1342.  
  1343. ;; John Sturdy <jcgs@harlqn.co.uk>
  1344. ;; (defun lookup-tag (use-rec-edit)
  1345. ;;   "Show a tag from the current tags name list in the other window for
  1346. ;; reference, then restore the window layout after a pause. With prefix
  1347. ;; arg, go into a recursive edit instead of pausing."
  1348. ;;   (interactive "P")
  1349. ;;   (save-window-excursion
  1350. ;;     (save-excursion
  1351. ;;       (find-tag-other-window (completing-read "Tag name: " tags-name-list))
  1352. ;;       (if use-rec-edit
  1353. ;;           (recursive-edit)
  1354. ;;         (sit-for show-tag-time)))))
  1355.  
  1356. ;(provide 'tags-fix)
  1357. (provide 'tags)
  1358.