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