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