Mercurial > emacs

comparison lisp/progmodes/etags.el @ 1138:f2897f71f361

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*** empty log message ***
author Roland McGrath <roland@gnu.org>
date Mon, 14 Sep 1992 20:19:24 +0000
parents 4d4c177b980f
children 283fa748ba99
comparison
equal deleted inserted replaced
1137:6f2689fa1c37 1138:f2897f71f361
161 default-directory 161 default-directory
162 (expand-file-name "TAGS" 162 (expand-file-name "TAGS"
163 default-directory) 163 default-directory)
164 t) 164 t)
165 current-prefix-arg)) 165 current-prefix-arg))
166 (if (file-directory-p file) 166 (let ((tags-file-name file))
167 (setq file (expand-file-name "TAGS" file))) 167 (save-excursion
168 (or (visit-tags-file t)
169 (signal 'file-error (list "Visiting tags table"
170 "file does not exist"
171 file)))
172 (setq file tags-file-name)))
168 (if local 173 (if local
169 (setq tags-file-name file) 174 (setq tags-file-name file)
170 (kill-local-variable 'tags-file-name) 175 (kill-local-variable 'tags-file-name)
171 (setq-default tags-file-name file)) 176 (setq-default tags-file-name file)))
172 (save-excursion 177
173 (visit-tags-file t))) 178 ;; Move tags-table-list-pointer along and set tags-file-name.
179 ;; Returns nil when out of tables.
180 (defun tags-next-table ()
181 (if (tags-included-tables)
182 (progn
183 ;; Move into the included tags tables.
184 (if tags-table-list-pointer
185 (setq tags-table-parent-pointer-list
186 (cons tags-table-list-pointer
187 tags-table-parent-pointer-list)))
188 (setq tags-table-list-pointer tags-included-tables))
189
190 (if tags-table-list-pointer
191 ;; Go to the next table in the list.
192 (setq tags-table-list-pointer
193 (cdr tags-table-list-pointer))
194
195 ;; Pop back to the tags table which includes this one.
196 (setq tags-table-list-pointer
197 (car tags-table-parent-pointer-list)
198 tags-table-parent-pointer-list
199 (cdr tags-table-parent-pointer-list))))
200
201 (and tags-table-list-pointer
202 (setq tags-file-name
203 (or (car tags-table-list-pointer)
204 ;; nil means look for TAGS in current directory.
205 (expand-file-name "TAGS" default-directory)))))
174 206
175 (defun visit-tags-table-buffer (&optional cont) 207 (defun visit-tags-table-buffer (&optional cont)
176 "Select the buffer containing the current tags table. 208 "Select the buffer containing the current tags table.
177 If optional arg is t, visit the next table in `tags-table-list'. 209 If optional arg is t, visit the next table in `tags-table-list'.
178 If optional arg is the atom `reset', reset to the head of `tags-table-list'. 210 If optional arg is the atom `reset', reset to the head of `tags-table-list'.
179 If optional arg is the atom `same', don't look for a new table; 211 If optional arg is the atom `same', don't look for a new table;
180 just select the buffer. 212 just select the buffer.
181 If arg is nil or absent, choose a buffer from information in 213 If arg is nil or absent, choose a buffer from information in
182 `tags-file-name', `tags-table-list', `tags-table-list-pointer'. 214 `tags-file-name', `tags-table-list', `tags-table-list-pointer'.
183 Returns t if it visits a tags table, or nil if there are no more in the list." 215 Returns t if it visits a tags table, or nil if there are no more in the list."
184 (if (eq cont 'same) 216 (cond ((eq cont 'same)
185 (let ((tags-file-name (car tags-table-list-pointer))) 217 (let ((tags-file-name (car tags-table-list-pointer)))
186 (if (null tags-file-name) 218 (and tags-file-name
187 nil 219 (visit-tags-file nil)))
188 (visit-tags-file nil) 220
189 t)) 221 (cont
190 (let ((put-in-list t)) 222 (if (eq cont 'reset)
191 (if (cond ((eq cont 'reset) 223 (setq tags-table-list-pointer tags-table-list)
192 (setq tags-table-list-pointer tags-table-list 224 (tags-next-table))
193 cont nil) 225
194 nil) 226 (while (and (not (visit-tags-file nil)) ;Skip over nonexistent files.
195 (cont 227 (tags-next-table)))
196 (setq tags-table-list-pointer (cdr tags-table-list-pointer)) 228 (not (null tags-table-list-pointer)))
197 (if (tags-included-tables) 229
198 (progn 230 (t
199 ;; Move into the included tags tables. 231 (setq tags-file-name
200 (if tags-table-list-pointer 232 (or (cdr (assq 'tags-file-name (buffer-local-variables)))
201 (setq tags-table-parent-pointer-list 233 (and default-tags-table-function
202 (cons tags-table-list-pointer 234 (funcall default-tags-table-function))
203 tags-table-parent-pointer-list))) 235 ;; Look for a tags table that contains
204 (setq tags-table-list-pointer tags-included-tables))) 236 ;; tags for the current buffer's file.
205 (or tags-table-list-pointer 237 (let ((tables tags-table-list)
206 ;; Pop back to the tags table after the one which includes 238 (this-file (buffer-file-name))
207 ;; this one. 239 (found nil))
208 (setq tags-table-list-pointer 240 (save-excursion
209 (car tags-table-parent-pointer-list) 241 (while tables
210 tags-table-parent-pointer-list 242 (let ((tags-file-name (car tables)))
211 (cdr tags-table-parent-pointer-list))) 243 (if (and (file-exists-p tags-file-name)
212 (setq put-in-list nil) 244 (progn
213 (null tags-table-list-pointer))) 245 (visit-tags-file nil)
214 ;; No more tags table files in the list. 246 (or tags-table-files
215 nil 247 (setq tags-table-files
216 (setq tags-file-name 248 (funcall
217 (or (if cont 249 tags-table-files-function)))
218 (and tags-table-list-pointer 250 (assoc this-file tags-file-files)))
219 (or (car tags-table-list-pointer) 251 (setq found (car tables)
220 ;; nil means look for TAGS in current directory. 252 tables nil)
221 (if (file-exists-p 253 (setq tables (cdr tables))))))
222 (expand-file-name "TAGS" 254 found)
223 default-directory)) 255 (car tags-table-list-pointer)
224 (expand-file-name "TAGS" 256 tags-file-name
225 default-directory)))) 257 (expand-file-name
226 (cdr (assq 'tags-file-name (buffer-local-variables)))) 258 (read-file-name "Visit tags table: (default TAGS) "
227 (and default-tags-table-function 259 default-directory
228 (funcall default-tags-table-function)) 260 (expand-file-name "TAGS"
229 ;; Look for a tags table that contains 261 default-directory)
230 ;; tags for the current buffer's file. 262 t))))
231 (let ((tables tags-table-list) 263 (visit-tags-file t)))))
232 (this-file (buffer-file-name)) 264
233 (found nil)) 265 ;; Visit tags-file-name and check that it's a valid tags table. Returns
234 (save-excursion 266 ;; nil and does nothing if tags-file-name does not exist. Otherwise, on
235 (while tables 267 ;; return tags-table-list and tags-table-list-pointer point to
236 (if (assoc this-file 268 ;; tags-file-name.
237 (let ((tags-file-name (car tables)))
238 (visit-tags-file nil)
239 (or tags-table-files
240 (setq tags-table-files
241 (funcall
242 tags-table-files-function)))))
243 (setq found (car tables)
244 tables nil)
245 (setq tables (cdr tables)))))
246 found)
247 (car tags-table-list-pointer)
248 tags-file-name
249 (expand-file-name
250 (read-file-name "Visit tags table: (default TAGS) "
251 default-directory
252 (expand-file-name "TAGS" default-directory)
253 t))))
254 (visit-tags-file put-in-list)
255 t))))
256
257 ;; Visit tags-file-name and check that it's a valid tags table.
258 ;; On return, tags-table-list and tags-table-list-pointer
259 ;; point to tags-file-name.
260 (defun visit-tags-file (put-in-list) 269 (defun visit-tags-file (put-in-list)
261 ;; FILE is never changed, but we don't just use tags-file-name
262 ;; directly because we don't want to get its buffer-local value
263 ;; in the buffer we switch to.
264 (let ((file tags-file-name)) 270 (let ((file tags-file-name))
265 (if (file-directory-p file) 271 (if (file-directory-p file)
266 (setq file (expand-file-name "TAGS" file))) 272 (setq file (expand-file-name "TAGS" file)))
267 (if (if (get-file-buffer file) 273 (if (or (get-file-buffer file)
268 (let (win) 274 (file-exists-p file))
269 (set-buffer (get-file-buffer file)) 275 (if (if (get-file-buffer file)
270 (setq win (or verify-tags-table-function 276 (let (win)
271 (initialize-new-tags-table))) 277 (set-buffer (get-file-buffer file))
272 (if (or (verify-visited-file-modtime (current-buffer)) 278 (setq win (or verify-tags-table-function
273 (not (yes-or-no-p 279 (initialize-new-tags-table)))
274 "Tags file has changed, read new contents? "))) 280 (if (or (verify-visited-file-modtime (current-buffer))
275 (and win (funcall verify-tags-table-function)) 281 (not (yes-or-no-p
276 (revert-buffer t t) 282 "Tags file has changed, read new contents? ")))
277 (initialize-new-tags-table))) 283 (and win (funcall verify-tags-table-function))
278 (set-buffer (find-file-noselect file)) 284 (revert-buffer t t)
279 (or (string= file buffer-file-name) 285 (initialize-new-tags-table)))
280 ;; find-file-noselect has changed the file name. 286 (set-buffer (find-file-noselect file))
281 ;; Propagate the change to tags-file-name and tags-table-list. 287 (or (string= file buffer-file-name)
282 (let ((tail (assoc file tags-table-list))) 288 ;; find-file-noselect has changed the file name.
283 (if tail 289 ;; Propagate change to tags-file-name and tags-table-list.
284 (setcar tail buffer-file-name)) 290 (let ((tail (assoc file tags-table-list)))
285 (setq tags-file-name buffer-file-name))) 291 (if tail
286 (initialize-new-tags-table)) 292 (setcar tail buffer-file-name))
293 (setq tags-file-name buffer-file-name)))
294 (initialize-new-tags-table))
287 295
288 (if (and put-in-list 296 (if (and put-in-list
289 (not (equal file (car tags-table-list-pointer)))) 297 (not (equal file (car tags-table-list-pointer))))
290 (let (elt) 298 (let (elt)
291 ;; Bury the tags table buffer so it 299 ;; Bury the tags table buffer so it
292 ;; doesn't get in the user's way. 300 ;; doesn't get in the user's way.
293 (bury-buffer (current-buffer)) 301 (bury-buffer (current-buffer))
294 ;; Look for this file in the current list of tags files. 302 ;; Look for this file in the current list of tags files.
295 (if (setq elt (member file tags-table-list)) 303 (if (setq elt (member file tags-table-list))
296 (if (eq elt tags-table-list) 304 (if (eq elt tags-table-list)
297 ;; Already at the head of the list. 305 ;; Already at the head of the list.
298 () 306 ()
299 ;; Rotate this element to the head of the search list. 307 ;; Rotate this element to the head of the search list.
300 (setq tags-table-list-pointer (nconc elt tags-table-list)) 308 (setq tags-table-list-pointer
301 (while (not (eq (cdr tags-table-list) elt)) 309 (nconc elt tags-table-list))
302 (setq tags-table-list (cdr tags-table-list))) 310 (while (not (eq (cdr tags-table-list) elt))
303 (setcdr tags-table-list nil) 311 (setq tags-table-list (cdr tags-table-list)))
304 (setq tags-table-list tags-table-list-pointer)) 312 (setcdr tags-table-list nil)
305 ;; The table is not in the current set. 313 (setq tags-table-list tags-table-list-pointer))
306 ;; Try to find it in another previously used set. 314 ;; The table is not in the current set.
307 (let ((sets tags-table-set-list)) 315 ;; Try to find it in another previously used set.
308 (while (and sets 316 (let ((sets tags-table-set-list))
309 (not (setq elt (member file 317 (while (and sets
310 (car sets))))) 318 (not (setq elt (member file
311 (setq sets (cdr sets))) 319 (car sets)))))
312 (if sets 320 (setq sets (cdr sets)))
313 (progn 321 (if sets
314 ;; Found in some other set. Switch to that set, making 322 (progn
315 ;; the selected tags table the head of the search list. 323 ;; Found in some other set. Switch to that
316 (or (memq tags-table-list tags-table-set-list) 324 ;; set, making the selected tags table the head
317 ;; Save the current list. 325 ;; of the search list.
318 (setq tags-table-set-list 326 (or (memq tags-table-list tags-table-set-list)
319 (cons tags-table-list tags-table-set-list))) 327 ;; Save the current list.
320 (setq tags-table-list (car sets)) 328 (setq tags-table-set-list
321 (if (eq elt tags-table-list) 329 (cons tags-table-list
322 ;; Already at the head of the list 330 tags-table-set-list)))
323 () 331 (setq tags-table-list (car sets))
324 ;; Rotate this element to the head of the list. 332 (if (eq elt tags-table-list)
325 (setq tags-table-list-pointer 333 ;; Already at the head of the list
326 (nconc elt tags-table-list)) 334 ()
327 (while (not (eq (cdr tags-table-list) elt)) 335 ;; Rotate this element to the head of the list.
328 (setq tags-table-list (cdr tags-table-list))) 336 (setq tags-table-list-pointer
329 (setcdr tags-table-list nil) 337 (nconc elt tags-table-list))
330 (setq tags-table-list tags-table-list-pointer) 338 (while (not (eq (cdr tags-table-list) elt))
331 (setcar sets tags-table-list))) 339 (setq tags-table-list (cdr tags-table-list)))
332 ;; Not found in any current set. 340 (setcdr tags-table-list nil)
333 (if (and tags-table-list 341 (setq tags-table-list tags-table-list-pointer)
334 (y-or-n-p 342 (setcar sets tags-table-list)))
335 (concat "Add " file 343 ;; Not found in any current set.
336 " to current list of tags tables? "))) 344 (if (and tags-table-list
337 ;; Add it to the current list. 345 (y-or-n-p
338 (setq tags-table-list 346 (concat "Add " file " to current list"
339 (cons file tags-table-list)) 347 " of tags tables? ")))
340 ;; Make a fresh list, and store the old one. 348 ;; Add it to the current list.
341 (or (memq tags-table-list tags-table-set-list) 349 (setq tags-table-list
342 (setq tags-table-set-list 350 (cons file tags-table-list))
343 (cons tags-table-list tags-table-set-list))) 351 ;; Make a fresh list, and store the old one.
344 (setq tags-table-list (cons file nil))) 352 (or (memq tags-table-list tags-table-set-list)
345 (setq tags-table-list-pointer tags-table-list)))))) 353 (setq tags-table-set-list
354 (cons tags-table-list
355 tags-table-set-list)))
356 (setq tags-table-list (cons file nil)))
357 (setq tags-table-list-pointer tags-table-list))))
358 t)
359 t)
346 360
347 ;; The buffer was not valid. Don't use it again. 361 ;; The buffer was not valid. Don't use it again.
348 (kill-local-variable 'tags-file-name) 362 (kill-local-variable 'tags-file-name)
349 (setq tags-file-name nil) 363 (setq tags-file-name nil)
350 (error "File %s is not a valid tags table" buffer-file-name)))) 364 (error "File %s is not a valid tags table" buffer-file-name)))))
351 365
352 (defun file-of-tag () 366 (defun file-of-tag ()
353 "Return the file name of the file whose tags point is within. 367 "Return the file name of the file whose tags point is within.
354 Assumes the tags table is the current buffer. 368 Assumes the tags table is the current buffer.
355 File name returned is relative to tags table file's directory." 369 File name returned is relative to tags table file's directory."