Mercurial > emacs
annotate lisp/progmodes/etags.el @ 727:540b047ece4d
*** empty log message ***
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Wed, 24 Jun 1992 05:09:26 +0000 |
parents | 8a533acedb77 |
children | 98bdd205ec6f |
rev | line source |
---|---|
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; etags.el --- tags facility for Emacs. |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
727 | 3 ;; Copyright (C) 1985, 1986, 1988, 1992 Free Software Foundation, Inc. |
342 | 4 |
5 ;; This file is part of GNU Emacs. | |
6 | |
7 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
8 ;; it under the terms of the GNU General Public License as published by | |
727 | 9 ;; the Free Software Foundation; either version 2, or (at your option) |
342 | 10 ;; any later version. |
11 | |
12 ;; GNU Emacs is distributed in the hope that it will be useful, | |
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 ;; GNU General Public License for more details. | |
16 | |
17 ;; You should have received a copy of the GNU General Public License | |
18 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
20 | |
21 | |
360 | 22 ;;;###autoload |
23 (defvar tags-file-name nil "\ | |
24 *File name of tag table. | |
25 To switch to a new tag table, setting this variable is sufficient. | |
26 Use the `etags' program to make a tag table file.") | |
342 | 27 |
28 (defvar tag-table-files nil | |
29 "List of file names covered by current tag table. | |
30 nil means it has not been computed yet; do (tag-table-files) to compute it.") | |
31 | |
32 (defvar last-tag nil | |
33 "Tag found by the last find-tag.") | |
34 | |
360 | 35 ;;;###autoload |
342 | 36 (defun visit-tags-table (file) |
37 "Tell tags commands to use tag table file FILE. | |
38 FILE should be the name of a file created with the `etags' program. | |
39 A directory name is ok too; it means file TAGS in that directory." | |
40 (interactive (list (read-file-name "Visit tags table: (default TAGS) " | |
41 default-directory | |
42 (concat default-directory "TAGS") | |
43 t))) | |
44 (setq file (expand-file-name file)) | |
45 (if (file-directory-p file) | |
46 (setq file (concat file "TAGS"))) | |
47 (setq tag-table-files nil | |
48 tags-file-name file)) | |
49 | |
50 (defun visit-tags-table-buffer () | |
51 "Select the buffer containing the current tag table. | |
52 This is a file whose name is in the variable tags-file-name." | |
53 (or tags-file-name | |
54 (call-interactively 'visit-tags-table)) | |
55 (set-buffer (or (get-file-buffer tags-file-name) | |
56 (progn | |
57 (setq tag-table-files nil) | |
58 (find-file-noselect tags-file-name)))) | |
59 (or (verify-visited-file-modtime (get-file-buffer tags-file-name)) | |
60 (cond ((yes-or-no-p "Tags file has changed, read new contents? ") | |
61 (revert-buffer t t) | |
62 (setq tag-table-files nil)))) | |
63 (or (eq (char-after 1) ?\^L) | |
64 (error "File %s not a valid tag table" tags-file-name))) | |
65 | |
66 (defun file-of-tag () | |
67 "Return the file name of the file whose tags point is within. | |
68 Assumes the tag table is the current buffer. | |
69 File name returned is relative to tag table file's directory." | |
70 (let ((opoint (point)) | |
71 prev size) | |
72 (save-excursion | |
73 (goto-char (point-min)) | |
74 (while (< (point) opoint) | |
75 (forward-line 1) | |
76 (end-of-line) | |
77 (skip-chars-backward "^,\n") | |
78 (setq prev (point)) | |
79 (setq size (read (current-buffer))) | |
80 (goto-char prev) | |
81 (forward-line 1) | |
82 (forward-char size)) | |
83 (goto-char (1- prev)) | |
84 (buffer-substring (point) | |
85 (progn (beginning-of-line) (point)))))) | |
86 | |
360 | 87 ;;;###autoload |
342 | 88 (defun tag-table-files () |
89 "Return a list of files in the current tag table. | |
90 File names returned are absolute." | |
91 (save-excursion | |
92 (visit-tags-table-buffer) | |
93 (or tag-table-files | |
94 (let (files) | |
95 (goto-char (point-min)) | |
96 (while (not (eobp)) | |
97 (forward-line 1) | |
98 (end-of-line) | |
99 (skip-chars-backward "^,\n") | |
100 (setq prev (point)) | |
101 (setq size (read (current-buffer))) | |
102 (goto-char prev) | |
103 (setq files (cons (expand-file-name | |
104 (buffer-substring (1- (point)) | |
105 (save-excursion | |
106 (beginning-of-line) | |
107 (point))) | |
108 (file-name-directory tags-file-name)) | |
109 files)) | |
110 (forward-line 1) | |
111 (forward-char size)) | |
112 (setq tag-table-files (nreverse files)))))) | |
113 | |
114 ;; Return a default tag to search for, based on the text at point. | |
115 (defun find-tag-default () | |
116 (save-excursion | |
117 (while (looking-at "\\sw\\|\\s_") | |
118 (forward-char 1)) | |
119 (if (re-search-backward "\\sw\\|\\s_" nil t) | |
120 (progn (forward-char 1) | |
121 (buffer-substring (point) | |
122 (progn (forward-sexp -1) | |
123 (while (looking-at "\\s'") | |
124 (forward-char 1)) | |
125 (point)))) | |
126 nil))) | |
127 | |
128 (defun find-tag-tag (string) | |
129 (let* ((default (find-tag-default)) | |
130 (spec (read-string | |
131 (if default | |
132 (format "%s(default %s) " string default) | |
133 string)))) | |
134 (list (if (equal spec "") | |
135 default | |
136 spec)))) | |
137 | |
474 | 138 (defun tags-tag-match (tagname exact) |
139 "Search for a match to the given tagname." | |
140 (if (not exact) | |
141 (search-forward tagname nil t) | |
142 (not (error-occurred | |
143 (while | |
144 (progn | |
145 (search-forward tagname) | |
146 (let ((before (char-syntax (char-after (1- (match-beginning 1))))) | |
147 (after (char-syntax (char-after (match-end 1))))) | |
148 (not (or (= before ?w) (= before ?_)) | |
149 (= after ?w) (= after ?_))) | |
150 )))) | |
151 ) | |
152 ) | |
153 | |
450
0bac8c701777
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
449
diff
changeset
|
154 (defun find-tag-noselect (tagname exact &optional next) |
0bac8c701777
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
449
diff
changeset
|
155 "Find a tag and return its buffer, but don't select or display it." |
474 | 156 (let (buffer file linebeg startpos (obuf (current-buffer))) |
157 ;; save-excursion will do the wrong thing if the buffer containing the | |
158 ;; tag being searched for is current-buffer | |
159 (unwind-protect | |
160 (progn | |
161 (visit-tags-table-buffer) | |
162 (if (not next) | |
163 (goto-char (point-min)) | |
164 (setq tagname last-tag)) | |
165 (setq last-tag tagname) | |
166 (while (progn | |
167 (if (not (tags-tag-match tagname exact)) | |
168 (error "No %sentries matching %s" | |
169 (if next "more " "") tagname)) | |
170 (not (looking-at "[^\n\177]*\177")))) | |
171 (search-forward "\177") | |
172 (setq file (expand-file-name (file-of-tag) | |
173 (file-name-directory tags-file-name))) | |
174 (setq linebeg | |
175 (buffer-substring (1- (point)) | |
176 (save-excursion (beginning-of-line) (point)))) | |
177 (search-forward ",") | |
178 (setq startpos (read (current-buffer))) | |
179 (prog1 | |
180 (set-buffer (find-file-noselect file)) | |
181 (widen) | |
182 (push-mark) | |
183 (let ((offset 1000) | |
184 found | |
185 (pat (concat "^" (regexp-quote linebeg)))) | |
186 (or startpos (setq startpos (point-min))) | |
187 (while (and (not found) | |
188 (progn | |
189 (goto-char (- startpos offset)) | |
190 (not (bobp)))) | |
191 (setq found | |
192 (re-search-forward pat (+ startpos offset) t)) | |
193 (setq offset (* 3 offset))) | |
194 (or found | |
195 (re-search-forward pat nil t) | |
196 (error "%s not found in %s" pat file))) | |
197 (beginning-of-line))) | |
198 (set-buffer obuf)) | |
450
0bac8c701777
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
449
diff
changeset
|
199 )) |
0bac8c701777
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
449
diff
changeset
|
200 |
360 | 201 ;;;###autoload |
342 | 202 (defun find-tag (tagname &optional next other-window) |
203 "Find tag (in current tag table) whose name contains TAGNAME. | |
204 Selects the buffer that the tag is contained in | |
205 and puts point at its definition. | |
206 If TAGNAME is a null string, the expression in the buffer | |
207 around or before point is used as the tag name. | |
208 If second arg NEXT is non-nil (interactively, with prefix arg), | |
209 searches for the next tag in the tag table | |
210 that matches the tagname used in the previous find-tag. | |
211 | |
212 See documentation of variable tags-file-name." | |
213 (interactive (if current-prefix-arg | |
214 '(nil t) | |
215 (find-tag-tag "Find tag: "))) | |
449
4a1a5ad2d9d0
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
360
diff
changeset
|
216 (let ((tagbuf (find-tag-noselect tagname nil next))) |
342 | 217 (if other-window |
449
4a1a5ad2d9d0
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
360
diff
changeset
|
218 (switch-to-buffer-other-window tagbuf) |
4a1a5ad2d9d0
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
360
diff
changeset
|
219 (switch-to-buffer tagbuf)) |
4a1a5ad2d9d0
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
360
diff
changeset
|
220 ) |
342 | 221 (setq tags-loop-form '(find-tag nil t)) |
222 ;; Return t in case used as the tags-loop-form. | |
223 t) | |
224 | |
360 | 225 ;;;###autoload |
226 (define-key esc-map "." 'find-tag) | |
227 | |
228 ;;;###autoload | |
342 | 229 (defun find-tag-other-window (tagname &optional next) |
230 "Find tag (in current tag table) whose name contains TAGNAME. | |
231 Selects the buffer that the tag is contained in in another window | |
232 and puts point at its definition. | |
233 If TAGNAME is a null string, the expression in the buffer | |
234 around or before point is used as the tag name. | |
235 If second arg NEXT is non-nil (interactively, with prefix arg), | |
236 searches for the next tag in the tag table | |
237 that matches the tagname used in the previous find-tag. | |
238 | |
239 See documentation of variable tags-file-name." | |
240 (interactive (if current-prefix-arg | |
241 '(nil t) | |
242 (find-tag-tag "Find tag other window: "))) | |
243 (find-tag tagname next t)) | |
360 | 244 ;;;###autoload |
245 (define-key ctl-x-4-map "." 'find-tag-other-window) | |
342 | 246 |
727 | 247 ;;;###autoload |
248 (defun find-tag-other-frame (tagname &optional next) | |
249 "Find tag (in current tag table) whose name contains TAGNAME. | |
250 Selects the buffer that the tag is contained in in another frame | |
251 and puts point at its definition. | |
252 If TAGNAME is a null string, the expression in the buffer | |
253 around or before point is used as the tag name. | |
254 If second arg NEXT is non-nil (interactively, with prefix arg), | |
255 searches for the next tag in the tag table | |
256 that matches the tagname used in the previous find-tag. | |
257 | |
258 See documentation of variable tags-file-name." | |
259 (interactive (if current-prefix-arg | |
260 '(nil t) | |
261 (find-tag-tag "Find tag other window: "))) | |
262 (let ((pop-up-screens t)) | |
263 (find-tag tagname next t))) | |
264 ;;;###autoload | |
265 (define-key ctl-x-5-map "." 'find-tag-other-frame) | |
266 | |
342 | 267 (defvar next-file-list nil |
268 "List of files for next-file to process.") | |
269 | |
360 | 270 ;;;###autoload |
342 | 271 (defun next-file (&optional initialize) |
272 "Select next file among files in current tag table. | |
273 Non-nil argument (prefix arg, if interactive) | |
274 initializes to the beginning of the list of files in the tag table." | |
275 (interactive "P") | |
276 (if initialize | |
277 (setq next-file-list (tag-table-files))) | |
278 (or next-file-list | |
279 (error "All files processed.")) | |
280 (find-file (car next-file-list)) | |
281 (setq next-file-list (cdr next-file-list))) | |
282 | |
283 (defvar tags-loop-form nil | |
284 "Form for tags-loop-continue to eval to process one file. | |
285 If it returns nil, it is through with one file; move on to next.") | |
286 | |
360 | 287 ;;;###autoload |
342 | 288 (defun tags-loop-continue (&optional first-time) |
289 "Continue last \\[tags-search] or \\[tags-query-replace] command. | |
290 Used noninteractively with non-nil argument | |
291 to begin such a command. See variable tags-loop-form." | |
292 (interactive) | |
293 (if first-time | |
294 (progn (next-file t) | |
295 (goto-char (point-min)))) | |
296 (while (not (eval tags-loop-form)) | |
297 (next-file) | |
298 (message "Scanning file %s..." buffer-file-name) | |
299 (goto-char (point-min)))) | |
360 | 300 ;;;###autoload |
301 (define-key esc-map "," 'tags-loop-continue) | |
342 | 302 |
360 | 303 ;;;###autoload |
342 | 304 (defun tags-search (regexp) |
305 "Search through all files listed in tag table for match for REGEXP. | |
306 Stops when a match is found. | |
307 To continue searching for next match, use command \\[tags-loop-continue]. | |
308 | |
309 See documentation of variable tags-file-name." | |
310 (interactive "sTags search (regexp): ") | |
311 (if (and (equal regexp "") | |
312 (eq (car tags-loop-form) 're-search-forward)) | |
313 (tags-loop-continue nil) | |
314 (setq tags-loop-form | |
315 (list 're-search-forward regexp nil t)) | |
316 (tags-loop-continue t))) | |
317 | |
360 | 318 ;;;###autoload |
342 | 319 (defun tags-query-replace (from to &optional delimited) |
320 "Query-replace-regexp FROM with TO through all files listed in tag table. | |
321 Third arg DELIMITED (prefix arg) means replace only word-delimited matches. | |
322 If you exit (C-G or ESC), you can resume the query-replace | |
323 with the command \\[tags-loop-continue]. | |
324 | |
325 See documentation of variable tags-file-name." | |
326 (interactive "sTags query replace (regexp): \nsTags query replace %s by: \nP") | |
327 (setq tags-loop-form | |
328 (list 'and (list 'save-excursion | |
329 (list 're-search-forward from nil t)) | |
330 (list 'not (list 'perform-replace from to t t | |
331 (not (null delimited)))))) | |
332 (tags-loop-continue t)) | |
333 | |
360 | 334 ;;;###autoload |
342 | 335 (defun list-tags (string) |
336 "Display list of tags in file FILE. | |
337 FILE should not contain a directory spec | |
338 unless it has one in the tag table." | |
339 (interactive "sList tags (in file): ") | |
340 (with-output-to-temp-buffer "*Tags List*" | |
341 (princ "Tags in file ") | |
342 (princ string) | |
343 (terpri) | |
344 (save-excursion | |
345 (visit-tags-table-buffer) | |
346 (goto-char 1) | |
347 (search-forward (concat "\f\n" string ",")) | |
348 (forward-line 1) | |
349 (while (not (or (eobp) (looking-at "\f"))) | |
350 (princ (buffer-substring (point) | |
351 (progn (skip-chars-forward "^\177") | |
352 (point)))) | |
353 (terpri) | |
354 (forward-line 1))))) | |
355 | |
360 | 356 ;;;###autoload |
342 | 357 (defun tags-apropos (string) |
358 "Display list of all tags in tag table REGEXP matches." | |
359 (interactive "sTag apropos (regexp): ") | |
360 (with-output-to-temp-buffer "*Tags List*" | |
361 (princ "Tags matching regexp ") | |
362 (prin1 string) | |
363 (terpri) | |
364 (save-excursion | |
365 (visit-tags-table-buffer) | |
366 (goto-char 1) | |
367 (while (re-search-forward string nil t) | |
368 (beginning-of-line) | |
369 (princ (buffer-substring (point) | |
370 (progn (skip-chars-forward "^\177") | |
371 (point)))) | |
372 (terpri) | |
373 (forward-line 1))))) | |
474 | 374 |
584 | 375 (provide 'etags) |
376 | |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
377 ;;; etags.el ends here |