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