Commit | Line | Data |
---|---|---|
ff1f0fa6 JB |
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))))) |