Commit a5024e2a authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(visit-tags-table-buffer): New local named

visit-tags-table-buffer-cont copies cont.
(tags-table-including): Set that, instead of cont.
parent 280a6a9f
...@@ -259,6 +259,10 @@ file the tag was in." ...@@ -259,6 +259,10 @@ file the tag was in."
(setq list (cdr list))) (setq list (cdr list)))
list) list)
;; Local var in visit-tags-table-buffer-cont
;; which is set by tags-table-including.
(defvar visit-tags-table-buffer-cont)
;; Subroutine of visit-tags-table-buffer. Frobs its local vars. ;; Subroutine of visit-tags-table-buffer. Frobs its local vars.
;; Search TABLES for one that has tags for THIS-FILE. Recurses on ;; Search TABLES for one that has tags for THIS-FILE. Recurses on
;; included tables. Returns the tail of TABLES (or of an inner ;; included tables. Returns the tail of TABLES (or of an inner
...@@ -312,10 +316,11 @@ file the tag was in." ...@@ -312,10 +316,11 @@ file the tag was in."
tags-table-parent-pointer-list) tags-table-parent-pointer-list)
tags-table-list-pointer found tags-table-list-pointer found
tags-table-list-started-at found tags-table-list-started-at found
;; CONT is a local variable of ;; Set a local variable of
;; our caller, visit-tags-table-buffer. ;; our caller, visit-tags-table-buffer.
;; Set it so we won't frob lists later. ;; Set it so we won't frob lists later.
cont 'included))) visit-tags-table-buffer-cont
'included)))
(or recursing (or recursing
;; tags-table-parent-pointer-list now describes ;; tags-table-parent-pointer-list now describes
;; the path of included tables taken by recursive ;; the path of included tables taken by recursive
...@@ -343,160 +348,163 @@ If arg is nil or absent, choose a first buffer from information in ...@@ -343,160 +348,163 @@ If arg is nil or absent, choose a first buffer from information in
Returns t if it visits a tags table, or nil if there are no more in the list." Returns t if it visits a tags table, or nil if there are no more in the list."
;; Set tags-file-name to the tags table file we want to visit. ;; Set tags-file-name to the tags table file we want to visit.
(cond ((eq cont 'same) (let ((visit-tags-table-buffer-cont cont))
;; Use the ambient value of tags-file-name. (cond ((eq visit-tags-table-buffer-cont 'same)
(or tags-file-name ;; Use the ambient value of tags-file-name.
(error (substitute-command-keys (or tags-file-name
(concat "No tags table in use! " (error (substitute-command-keys
"Use \\[visit-tags-table] to select one.")))) (concat "No tags table in use! "
;; Set CONT to nil so the code below will make sure tags-file-name "Use \\[visit-tags-table] to select one."))))
;; is in tags-table-list. ;; Set VISIT-TAGS-TABLE-BUFFER-CONT to nil
(setq cont nil)) ;; so the code below will make sure tags-file-name
;; is in tags-table-list.
(cont (setq visit-tags-table-buffer-cont nil))
;; Find the next table.
(if (tags-next-table) (visit-tags-table-buffer-cont
;; Skip over nonexistent files. ;; Find the next table.
(while (and (let ((file (tags-expand-table-name tags-file-name))) (if (tags-next-table)
(not (or (get-file-buffer file) ;; Skip over nonexistent files.
(file-exists-p file)))) (while (and (let ((file (tags-expand-table-name tags-file-name)))
(tags-next-table))))) (not (or (get-file-buffer file)
(file-exists-p file))))
(t (tags-next-table)))))
;; Pick a table out of our hat.
(setq tags-file-name
(or
;; First, try a local variable.
(cdr (assq 'tags-file-name (buffer-local-variables)))
;; Second, try a user-specified function to guess.
(and default-tags-table-function
(funcall default-tags-table-function))
;; Third, look for a tags table that contains
;; tags for the current buffer's file.
;; If one is found, the lists will be frobnicated,
;; and CONT will be set non-nil so we don't do it below.
(car (or
;; First check only tables already in buffers.
(save-excursion (tags-table-including buffer-file-name
tags-table-list
t))
;; Since that didn't find any, now do the
;; expensive version: reading new files.
(save-excursion (tags-table-including buffer-file-name
tags-table-list
nil))))
;; Fourth, use the user variable tags-file-name, if it is not
;; already in tags-table-list.
(and tags-file-name
(not (tags-table-list-member tags-file-name))
tags-file-name)
;; Fifth, use the user variable giving the table list.
;; Find the first element of the list that actually exists.
(let ((list tags-table-list)
file)
(while (and list
(setq file (tags-expand-table-name (car list)))
(not (get-file-buffer file))
(not (file-exists-p file)))
(setq list (cdr list)))
(car list))
;; Finally, prompt the user for a file name.
(expand-file-name
(read-file-name "Visit tags table: (default TAGS) "
default-directory
"TAGS"
t))))))
;; Expand the table name into a full file name.
(setq tags-file-name (tags-expand-table-name tags-file-name))
(if (and (eq cont t) (null tags-table-list-pointer))
;; All out of tables.
nil
;; Verify that tags-file-name is a valid tags table. (t
(if (if (get-file-buffer tags-file-name) ;; Pick a table out of our hat.
;; The file is already in a buffer. Check for the visited file (setq tags-file-name
;; having changed since we last used it. (or
(let (win) ;; First, try a local variable.
(set-buffer (get-file-buffer tags-file-name)) (cdr (assq 'tags-file-name (buffer-local-variables)))
(setq win (or verify-tags-table-function ;; Second, try a user-specified function to guess.
(initialize-new-tags-table))) (and default-tags-table-function
(if (or (verify-visited-file-modtime (current-buffer)) (funcall default-tags-table-function))
(not (yes-or-no-p ;; Third, look for a tags table that contains
"Tags file has changed, read new contents? "))) ;; tags for the current buffer's file.
(and win (funcall verify-tags-table-function)) ;; If one is found, the lists will be frobnicated,
(revert-buffer t t) ;; and VISIT-TAGS-TABLE-BUFFER-CONT
(initialize-new-tags-table))) ;; will be set non-nil so we don't do it below.
(set-buffer (find-file-noselect tags-file-name)) (car (or
(or (string= tags-file-name buffer-file-name) ;; First check only tables already in buffers.
;; find-file-noselect has changed the file name. (save-excursion (tags-table-including buffer-file-name
;; Propagate the change to tags-file-name and tags-table-list. tags-table-list
(let ((tail (member tags-file-name tags-table-list))) t))
(if tail ;; Since that didn't find any, now do the
(setcar tail buffer-file-name)) ;; expensive version: reading new files.
(setq tags-file-name buffer-file-name))) (save-excursion (tags-table-including buffer-file-name
(initialize-new-tags-table)) tags-table-list
nil))))
;; We have a valid tags table. ;; Fourth, use the user variable tags-file-name, if it is not
(progn ;; already in tags-table-list.
;; Bury the tags table buffer so it (and tags-file-name
;; doesn't get in the user's way. (not (tags-table-list-member tags-file-name))
(bury-buffer (current-buffer)) tags-file-name)
;; Fifth, use the user variable giving the table list.
(if cont ;; Find the first element of the list that actually exists.
;; No list frobbing required. (let ((list tags-table-list)
nil file)
(while (and list
;; Look in the list for the table we chose. (setq file (tags-expand-table-name (car list)))
(let ((elt (tags-table-list-member tags-file-name))) (not (get-file-buffer file))
(or elt (not (file-exists-p file)))
;; The table is not in the current set. (setq list (cdr list)))
;; Try to find it in another previously used set. (car list))
(let ((sets tags-table-set-list)) ;; Finally, prompt the user for a file name.
(while (and sets (expand-file-name
(not (setq elt (tags-table-list-member (read-file-name "Visit tags table: (default TAGS) "
tags-file-name (car sets))))) default-directory
(setq sets (cdr sets))) "TAGS"
(if sets t))))))
;; Found in some other set. Switch to that set.
(progn ;; Expand the table name into a full file name.
(setq tags-file-name (tags-expand-table-name tags-file-name))
(if (and (eq visit-tags-table-buffer-cont t) (null tags-table-list-pointer))
;; All out of tables.
nil
;; Verify that tags-file-name is a valid tags table.
(if (if (get-file-buffer tags-file-name)
;; The file is already in a buffer. Check for the visited file
;; having changed since we last used it.
(let (win)
(set-buffer (get-file-buffer tags-file-name))
(setq win (or verify-tags-table-function
(initialize-new-tags-table)))
(if (or (verify-visited-file-modtime (current-buffer))
(not (yes-or-no-p
"Tags file has changed, read new contents? ")))
(and win (funcall verify-tags-table-function))
(revert-buffer t t)
(initialize-new-tags-table)))
(set-buffer (find-file-noselect tags-file-name))
(or (string= tags-file-name buffer-file-name)
;; find-file-noselect has changed the file name.
;; Propagate the change to tags-file-name and tags-table-list.
(let ((tail (member tags-file-name tags-table-list)))
(if tail
(setcar tail buffer-file-name))
(setq tags-file-name buffer-file-name)))
(initialize-new-tags-table))
;; We have a valid tags table.
(progn
;; Bury the tags table buffer so it
;; doesn't get in the user's way.
(bury-buffer (current-buffer))
(if visit-tags-table-buffer-cont
;; No list frobbing required.
nil
;; Look in the list for the table we chose.
(let ((elt (tags-table-list-member tags-file-name)))
(or elt
;; The table is not in the current set.
;; Try to find it in another previously used set.
(let ((sets tags-table-set-list))
(while (and sets
(not (setq elt (tags-table-list-member
tags-file-name (car sets)))))
(setq sets (cdr sets)))
(if sets
;; Found in some other set. Switch to that set.
(progn
(or (memq tags-table-list tags-table-set-list)
;; Save the current list.
(setq tags-table-set-list
(cons tags-table-list
tags-table-set-list)))
(setq tags-table-list (car sets)))
;; Not found in any existing set.
(if (and tags-table-list
(y-or-n-p (concat "Add " tags-file-name
" to current list"
" of tags tables? ")))
;; Add it to the current list.
(setq tags-table-list (cons tags-file-name
tags-table-list))
;; Make a fresh list, and store the old one.
(or (memq tags-table-list tags-table-set-list) (or (memq tags-table-list tags-table-set-list)
;; Save the current list.
(setq tags-table-set-list (setq tags-table-set-list
(cons tags-table-list (cons tags-table-list tags-table-set-list)))
tags-table-set-list))) (setq tags-table-list (list tags-file-name)))
(setq tags-table-list (car sets))) (setq elt tags-table-list))))
;; Not found in any existing set. ;; Set the tags table list state variables to point at the table
(if (and tags-table-list ;; we want to use first.
(y-or-n-p (concat "Add " tags-file-name (setq tags-table-list-started-at elt
" to current list" tags-table-list-pointer elt)))
" of tags tables? ")))
;; Add it to the current list. ;; Return of t says the tags table is valid.
(setq tags-table-list (cons tags-file-name t)
tags-table-list))
;; Make a fresh list, and store the old one. ;; The buffer was not valid. Don't use it again.
(or (memq tags-table-list tags-table-set-list) (let ((file tags-file-name))
(setq tags-table-set-list (kill-local-variable 'tags-file-name)
(cons tags-table-list tags-table-set-list))) (if (eq file tags-file-name)
(setq tags-table-list (list tags-file-name))) (setq tags-file-name nil)))
(setq elt tags-table-list)))) (error "File %s is not a valid tags table" buffer-file-name)))))
;; Set the tags table list state variables to point at the table
;; we want to use first.
(setq tags-table-list-started-at elt
tags-table-list-pointer elt)))
;; Return of t says the tags table is valid.
t)
;; The buffer was not valid. Don't use it again.
(let ((file tags-file-name))
(kill-local-variable 'tags-file-name)
(if (eq file tags-file-name)
(setq tags-file-name nil)))
(error "File %s is not a valid tags table" buffer-file-name))))
(defun file-of-tag () (defun file-of-tag ()
"Return the file name of the file whose tags point is within. "Return the file name of the file whose tags point is within.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment