X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f9b1c0b224226e89ebb0290287ba5ee58e3108cd..863f75313be410ce600ec078cf3556162c2c9af8:/lisp/progmodes/etags.el diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index c39eed6d34..403fe0b7f9 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1,6 +1,6 @@ ;;; etags.el --- etags facility for Emacs -;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993 +;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995 ;; Free Software Foundation, Inc. ;; Author: Roland McGrath @@ -42,24 +42,33 @@ To switch to a new list of tags tables, setting this variable is sufficient. If you set this variable, do not also set `tags-file-name'. Use the `etags' program to make a tags table file.") -(defvar tags-add-tables nil - "*Non-nil means always add a new tags table to the current list. -This eliminates the need to ask the user whether to add a new tags table +;;;###autoload +(defvar tags-add-tables 'ask-user + "*Control whether to add a new tags table to the current list. +t means do; nil means don't (always start a new list). +Any other value means ask the user whether to add a new tags table to the current list (as opposed to starting a new list).") +(defvar tags-table-computed-list nil + "List of tags tables to search, computed from `tags-table-list'. +This includes tables implicitly included by other tables. The list is not +always complete: the included tables of a table are not known until that +table is read into core. An element that is `t' is a placeholder +indicating that the preceding element is a table that has not been read +into core and might contain included tables to search. +See `tags-table-check-computed-list'.") + +(defvar tags-table-computed-list-for nil + "Value of `tags-table-list' that `tags-table-computed-list' corresponds to. +If `tags-table-list' changes, `tags-table-computed-list' is thrown away and +recomputed; see `tags-table-check-computed-list'.") + (defvar tags-table-list-pointer nil - "Pointer into `tags-table-list' where the current state of searching is. -Might instead point into a list of included tags tables. + "Pointer into `tags-table-computed-list' for the current state of searching. Use `visit-tags-table-buffer' to cycle through tags tables in this list.") (defvar tags-table-list-started-at nil - "Pointer into `tags-table-list', where the current search started.") - -(defvar tags-table-parent-pointer-list nil - "Saved state of the tags table that included this one. -Each element is (POINTER . STARTED-AT), giving the values of - `tags-table-list-pointer' and `tags-table-list-started-at' from - before we moved into the current table.") + "Pointer into `tags-table-computed-list', where the current search started.") (defvar tags-table-set-list nil "List of sets of tags table which have been used together in the past. @@ -182,12 +191,16 @@ file the tag was in." default-directory) t) current-prefix-arg)) + (or (stringp file) (signal 'wrong-type-argument (list 'stringp file))) + ;; Bind tags-file-name so we can control below whether the local or + ;; global value gets set. Calling visit-tags-table-buffer will + ;; initialize a buffer for the file and set tags-file-name to the ;; Calling visit-tags-table-buffer with tags-file-name set to FILE will ;; initialize a buffer for FILE and set tags-file-name to the ;; fully-expanded name. (let ((tags-file-name file)) (save-excursion - (or (visit-tags-table-buffer 'same) + (or (visit-tags-table-buffer file) (signal 'file-error (list "Visiting tags table" "file does not exist" file))) @@ -199,52 +212,83 @@ file the tag was in." ;; Set the global value of tags-file-name. (setq-default tags-file-name file))) -;; Move tags-table-list-pointer along and set tags-file-name. -;; If NO-INCLUDES is non-nil, ignore included tags tables. -;; Returns nil when out of tables. -(defun tags-next-table (&optional no-includes) - ;; Do we have any included tables? - (if (and (not no-includes) - (visit-tags-table-buffer 'same) - (tags-included-tables)) - - ;; Move into the included tags tables. - (setq tags-table-parent-pointer-list - ;; Save the current state of what table we are in. - (cons (cons tags-table-list-pointer tags-table-list-started-at) - tags-table-parent-pointer-list) - ;; Start the pointer in the list of included tables. - tags-table-list-pointer tags-included-tables - tags-table-list-started-at tags-included-tables) - - ;; No included tables. Go to the next table in the list. - (setq tags-table-list-pointer - (cdr tags-table-list-pointer)) - (or tags-table-list-pointer - ;; Wrap around. - (setq tags-table-list-pointer tags-table-list)) - - (if (eq tags-table-list-pointer tags-table-list-started-at) - ;; We have come full circle. No more tables. - (if tags-table-parent-pointer-list - ;; Pop back to the tags table which includes this one. - (progn - ;; Restore the state variables. - (setq tags-table-list-pointer - (car (car tags-table-parent-pointer-list)) - tags-table-list-started-at - (cdr (car tags-table-parent-pointer-list)) - tags-table-parent-pointer-list - (cdr tags-table-parent-pointer-list)) - ;; Recurse to skip to the next table after the parent. - (tags-next-table t)) - ;; All out of tags tables. - (setq tags-table-list-pointer nil)))) - - (and tags-table-list-pointer - ;; Set tags-file-name to the fully-expanded name. - (setq tags-file-name - (tags-expand-table-name (car tags-table-list-pointer))))) +(defun tags-table-check-computed-list () + "Compute `tags-table-computed-list' from `tags-table-list' if necessary." + (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list))) + (or (equal tags-table-computed-list-for expanded-list) + ;; The list (or default-directory) has changed since last computed. + (let* ((compute-for (mapcar 'copy-sequence expanded-list)) + (tables (copy-sequence compute-for)) ;Mutated in the loop. + (computed nil) + table-buffer) + + (while tables + (setq computed (cons (car tables) computed) + table-buffer (get-file-buffer (car tables))) + (if (and table-buffer + ;; There is a buffer visiting the file. Now make sure + ;; it is initialized as a tag table buffer. + (save-excursion + (tags-verify-table (buffer-file-name table-buffer)))) + (save-excursion + (set-buffer table-buffer) + (if (tags-included-tables) + ;; Insert the included tables into the list we + ;; are processing. + (setcdr tables (nconc (mapcar 'tags-expand-table-name + (tags-included-tables)) + (cdr tables))))) + ;; This table is not in core yet. Insert a placeholder + ;; saying we must read it into core to check for included + ;; tables before searching the next table in the list. + (setq computed (cons t computed))) + (setq tables (cdr tables))) + + ;; Record the tags-table-list value (and the context of the + ;; current directory) we computed from. + (setq tags-table-computed-list-for compute-for + tags-table-computed-list (nreverse computed)))))) + +;; Extend `tags-table-computed-list' to remove the first `t' placeholder. +;; An element of the list that is `t' is a placeholder indicating that the +;; preceding element is a table that has not been read into core and might +;; contain included tables to search. On return, the first placeholder +;; element will be gone and the element before it read into core and its +;; included tables inserted into the list. +(defun tags-table-extend-computed-list () + (let ((list tags-table-computed-list)) + (while (not (eq (nth 1 list) t)) + (setq list (cdr list))) + (save-excursion + (if (tags-verify-table (car list)) + ;; We are now in the buffer visiting (car LIST). Extract its + ;; list of included tables and insert it into the computed list. + (let ((tables (tags-included-tables)) + (computed nil) + table-buffer) + (while tables + (setq computed (cons (car tables) computed) + table-buffer (get-file-buffer (car tables))) + (if table-buffer + (save-excursion + (set-buffer table-buffer) + (if (tags-included-tables) + ;; Insert the included tables into the list we + ;; are processing. + (setcdr tables (append (tags-included-tables) + tables)))) + ;; This table is not in core yet. Insert a placeholder + ;; saying we must read it into core to check for included + ;; tables before searching the next table in the list. + (setq computed (cons t computed))) + (setq tables (cdr tables))) + (setq computed (nreverse computed)) + ;; COMPUTED now contains the list of included tables (and + ;; tables included by them, etc.). Now splice this into the + ;; current list. + (setcdr list (nconc computed (cdr (cdr list))))) + ;; It was not a valid table, so just remove the following placeholder. + (setcdr list (cdr (cdr list))))))) ;; Expand tags table name FILE into a complete file name. (defun tags-expand-table-name (file) @@ -253,98 +297,120 @@ file the tag was in." (expand-file-name "TAGS" file) file)) -;; Return the cdr of LIST (default: tags-table-list) whose car -;; is equal to FILE after tags-expand-table-name on both sides. -(defun tags-table-list-member (file &optional list) - (or list - (setq list tags-table-list)) +;; Like member, but comparison is done after tags-expand-table-name on both +;; sides and elements of LIST that are t are skipped. +(defun tags-table-list-member (file list) (setq file (tags-expand-table-name file)) (while (and list - (not (string= file (tags-expand-table-name (car list))))) + (or (eq (car list) t) + (not (string= file (tags-expand-table-name (car list)))))) (setq list (cdr 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. -;; Search TABLES for one that has tags for THIS-FILE. Recurses on -;; included tables. Returns the tail of TABLES (or of an inner -;; included list) whose car is a table listing THIS-FILE. If -;; CORE-ONLY is non-nil, check only tags tables that are already in -;; buffers--don't visit any new files. -(defun tags-table-including (this-file tables core-only &optional recursing) - (let ((found nil)) - ;; Loop over TABLES, looking for one containing tags for THIS-FILE. +(defun tags-verify-table (file) + "Read FILE into a buffer and verify that it is a valid tags table. +Sets the current buffer to one visiting FILE (if it exists). +Returns non-nil iff it is a valid table." + (if (get-file-buffer file) + ;; 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 file)) + (setq win (or verify-tags-table-function (initialize-new-tags-table))) + (if (or (verify-visited-file-modtime (current-buffer)) + (not (yes-or-no-p + (format "Tags file %s has changed, read new contents? " + file)))) + (and win (funcall verify-tags-table-function)) + (revert-buffer t t) + (initialize-new-tags-table))) + (and (file-exists-p file) + (progn + (set-buffer (find-file-noselect file)) + (or (string= file 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 file tags-table-list))) + (if tail + (setcar tail buffer-file-name)) + (if (eq file tags-file-name) + (setq tags-file-name buffer-file-name)))) + (initialize-new-tags-table))))) + +;; Subroutine of visit-tags-table-buffer. Search the current tags tables +;; for one that has tags for THIS-FILE (or that includes a table that +;; does). Return the name of the first table table listing THIS-FILE; if +;; the table is one included by another table, it is the master table that +;; we return. If CORE-ONLY is non-nil, check only tags tables that are +;; already in buffers--don't visit any new files. +(defun tags-table-including (this-file core-only) + (let ((tables tags-table-computed-list) + (found nil)) + ;; Loop over the list, looking for a table containing tags for THIS-FILE. (while (and (not found) tables) - (let ((tags-file-name (tags-expand-table-name (car tables)))) - (if (or (get-file-buffer tags-file-name) - (and (not core-only) - (file-exists-p tags-file-name))) - (progn - ;; Select the tags table buffer and get the file list up to date. - (visit-tags-table-buffer 'same) - (or tags-table-files - (setq tags-table-files - (funcall tags-table-files-function))) - - (cond ((member this-file tags-table-files) - ;; Found it. - (setq found tables)) - - ((tags-included-tables) - ;; This table has included tables. Check them. - (let ((old tags-table-parent-pointer-list)) - (unwind-protect - (progn - (or recursing - ;; At top level (not in an included tags - ;; table), set the list to nil so we can - ;; collect just the elts from this run. - (setq tags-table-parent-pointer-list nil)) - (setq found - ;; Recurse on the list of included tables. - (tags-table-including this-file - tags-included-tables - core-only - t)) - (if found - ;; One of them lists THIS-FILE. - ;; Set the table list state variables to move - ;; us inside the list of included tables. - (setq tags-table-parent-pointer-list - (cons - (cons tags-table-list-pointer - tags-table-list-started-at) - tags-table-parent-pointer-list) - tags-table-list-pointer found - tags-table-list-started-at found - ;; Set a local variable of - ;; our caller, visit-tags-table-buffer. - ;; Set it so we won't frob lists later. - visit-tags-table-buffer-cont - 'included))) - (or recursing - ;; tags-table-parent-pointer-list now describes - ;; the path of included tables taken by recursive - ;; invocations of this function. The recursive - ;; calls have consed onto the front of the list, - ;; so it is now outermost first. We want it - ;; innermost first, so reverse it. Then append - ;; the old list (from before we were called the - ;; outermost time), to get the complete current - ;; state of included tables. - (setq tags-table-parent-pointer-list - (nconc (nreverse - tags-table-parent-pointer-list) - old)))))))))) + + (if core-only + ;; Skip tables not in core. + (while (eq (nth 1 tables) t) + (setq tables (cdr (cdr tables)))) + (if (eq (nth 1 tables) t) + ;; This table has not been read into core yet. Read it in now. + (tags-table-extend-computed-list))) + + (if tables + ;; Select the tags table buffer and get the file list up to date. + (let ((tags-file-name (car tables))) + (visit-tags-table-buffer 'same) + (if (member this-file (mapcar 'expand-file-name + (tags-table-files))) + ;; Found it. + (setq found tables)))) (setq tables (cdr tables))) - found)) + (if found + ;; Now determine if the table we found was one included by another + ;; table, not explicitly listed. We do this by checking each + ;; element of the computed list to see if it appears in the user's + ;; explicit list; the last element we will check is FOUND itself. + ;; Then we return the last one which did in fact appear in + ;; tags-table-list. + (let ((could-be nil) + (elt tags-table-computed-list)) + (while (not (eq elt (cdr found))) + (if (tags-table-list-member (car elt) tags-table-list) + ;; This table appears in the user's list, so it could be + ;; the one which includes the table we found. + (setq could-be (car elt))) + (setq elt (cdr elt)) + (if (eq t (car elt)) + (setq elt (cdr elt)))) + ;; The last element we found in the computed list before FOUND + ;; that appears in the user's list will be the table that + ;; included the one we found. + could-be)))) + +;; Subroutine of visit-tags-table-buffer. Move tags-table-list-pointer +;; along and set tags-file-name. Returns nil when out of tables. +(defun tags-next-table () + ;; If there is a placeholder element next, compute the list to replace it. + (while (eq (nth 1 tags-table-list-pointer) t) + (tags-table-extend-computed-list)) + + ;; Go to the next table in the list. + (setq tags-table-list-pointer (cdr tags-table-list-pointer)) + (or tags-table-list-pointer + ;; Wrap around. + (setq tags-table-list-pointer tags-table-computed-list)) + + (if (eq tags-table-list-pointer tags-table-list-started-at) + ;; We have come full circle. No more tables. + (setq tags-table-list-pointer nil) + ;; Set tags-file-name to the name from the list. It is already expanded. + (setq tags-file-name (car tags-table-list-pointer)))) (defun visit-tags-table-buffer (&optional cont) "Select the buffer containing the current tags table. +If optional arg is a string, visit that file as a tags table. If optional arg is t, visit the next table in `tags-table-list'. If optional arg is the atom `same', don't look for a new table; just select the buffer visiting `tags-file-name'. @@ -353,103 +419,83 @@ 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." ;; Set tags-file-name to the tags table file we want to visit. - (let ((visit-tags-table-buffer-cont cont)) - (cond ((eq visit-tags-table-buffer-cont 'same) - ;; Use the ambient value of tags-file-name. - (or tags-file-name - (error (substitute-command-keys - (concat "No tags table in use! " - "Use \\[visit-tags-table] to select one.")))) - ;; Set VISIT-TAGS-TABLE-BUFFER-CONT to nil - ;; so the code below will make sure tags-file-name - ;; is in tags-table-list. - (setq visit-tags-table-buffer-cont nil)) - - (visit-tags-table-buffer-cont - ;; Find the next table. - (if (tags-next-table) - ;; Skip over nonexistent files. - (while (and (let ((file (tags-expand-table-name tags-file-name))) - (not (or (get-file-buffer file) - (file-exists-p file)))) - (tags-next-table))))) + (cond ((eq cont 'same) + ;; Use the ambient value of tags-file-name. + (or tags-file-name + (error (substitute-command-keys + (concat "No tags table in use! " + "Use \\[visit-tags-table] to select one."))))) + + ((eq t cont) + ;; Find the next table. + (if (tags-next-table) + ;; Skip over nonexistent files. + (while (and (not (or (get-file-buffer tags-file-name) + (file-exists-p tags-file-name))) + (tags-next-table))))) - (t - ;; 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 VISIT-TAGS-TABLE-BUFFER-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 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)) + (t + ;; Pick a table out of our hat. + (tags-table-check-computed-list) ;Get it up to date, we might use it. + (setq tags-file-name + (or + ;; If passed a string, use that. + (if (stringp cont) + (prog1 cont + (setq cont nil))) + ;; 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. + (and buffer-file-name + (or + ;; First check only tables already in buffers. + (tags-table-including buffer-file-name t) + ;; Since that didn't find any, now do the + ;; expensive version: reading new files. + (tags-table-including buffer-file-name nil))) + ;; Fourth, use the user variable tags-file-name, if it is + ;; not already in the current list. + (and tags-file-name + (not (tags-table-list-member tags-file-name + tags-table-computed-list)) + 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 names a valid tags table. + ;; Bind another variable with the value of tags-file-name + ;; before we switch buffers, in case tags-file-name is buffer-local. + (let ((curbuf (current-buffer)) + (local-tags-file-name tags-file-name)) + (if (tags-verify-table local-tags-file-name) ;; We have a valid tags table. (progn @@ -457,19 +503,26 @@ Returns t if it visits a tags table, or nil if there are no more in the list." ;; doesn't get in the user's way. (bury-buffer (current-buffer)) - (if visit-tags-table-buffer-cont - ;; No list frobbing required. - nil + ;; If this was a new table selection (CONT is nil), make + ;; sure tags-table-list includes the chosen table, and + ;; update the list pointer variables. + (or cont + ;; Look in the list for the table we chose. + (let ((found (tags-table-list-member + local-tags-file-name + tags-table-computed-list))) + (if found + ;; There it is. Just switch to it. + (setq tags-table-list-pointer found + tags-table-list-started-at found) - ;; 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))))) + (not (tags-table-list-member + local-tags-file-name + (car sets)))) (setq sets (cdr sets))) (if sets ;; Found in some other set. Switch to that set. @@ -483,34 +536,54 @@ Returns t if it visits a tags table, or nil if there are no more in the list." ;; Not found in any existing set. (if (and tags-table-list - (or tags-add-tables - (y-or-n-p (concat "Keep current list of" - " tags tables also? ")))) + (or (eq t tags-add-tables) + (and tags-add-tables + (y-or-n-p + (concat "Keep current list of " + "tags tables also? "))))) ;; Add it to the current list. - (setq tags-table-list (cons tags-file-name + (setq tags-table-list (cons local-tags-file-name tags-table-list)) + ;; Make a fresh list, and store the old one. (message "Starting a new list of tags tables") - (or (memq tags-table-list tags-table-set-list) + (or (null tags-table-list) + (memq tags-table-list tags-table-set-list) (setq tags-table-set-list - (cons tags-table-list tags-table-set-list))) - (setq tags-table-list (list tags-file-name))) - (setq elt tags-table-list)))) - - ;; 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))) + (cons tags-table-list + tags-table-set-list))) + (setq tags-table-list (list local-tags-file-name)))) + + ;; Recompute tags-table-computed-list. + (tags-table-check-computed-list) + ;; Set the tags table list state variables to start + ;; over from tags-table-computed-list. + (setq tags-table-list-started-at tags-table-computed-list + tags-table-list-pointer + tags-table-computed-list))))) ;; 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))))) + (set-buffer curbuf) + (kill-local-variable 'tags-file-name) + (if (eq local-tags-file-name tags-file-name) + (setq tags-file-name nil)) + (error "File %s is not a valid tags table" local-tags-file-name))))) + +(defun tags-reset-tags-tables () + "Reset tags state to cancel effect of any previous \\[visit-tags-table] +or \\[find-tag]." + (interactive) + (setq tags-file-name nil + tags-location-stack nil + tags-table-list nil + tags-table-computed-list nil + tags-table-computed-list-for nil + tags-table-list-pointer nil + tags-table-list-started-at nil + tags-table-set-list nil)) (defun file-of-tag () "Return the file name of the file whose tags point is within. @@ -521,8 +594,9 @@ File name returned is relative to tags table file's directory." ;;;###autoload (defun tags-table-files () "Return a list of files in the current tags table. -Assumes the tags table is the current buffer. -File names returned are absolute." +Assumes the tags table is the current buffer. The file names are returned +as they appeared in the `etags' command that created the table, usually +without directory names." (or tags-table-files (setq tags-table-files (funcall tags-table-files-function)))) @@ -620,6 +694,8 @@ Assumes the tags table is the current buffer." (read-string prompt) (find-tag-tag prompt))))) +(defvar find-tag-history nil) + ;;;###autoload (defun find-tag-noselect (tagname &optional next-p regexp-p) "Find tag (in current tags table) whose name contains TAGNAME. @@ -638,6 +714,7 @@ If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp. See documentation of variable `tags-file-name'." (interactive (find-tag-interactive "Find tag: ")) + (setq find-tag-history (cons tagname find-tag-history)) ;; Save the current buffer's value of `find-tag-hook' before selecting the ;; tags table buffer. (let ((local-find-tag-hook find-tag-hook)) @@ -663,31 +740,29 @@ See documentation of variable `tags-file-name'." (visit-tags-table-buffer) ;; Record TAGNAME for a future call with NEXT-P non-nil. (setq last-tag tagname)) - (prog1 - ;; Record the location so we can pop back to it later. - (marker-buffer - (car - (setq tags-location-stack - (cons (let ((marker (make-marker))) - (save-excursion - (set-buffer - ;; find-tag-in-order does the real work. - (find-tag-in-order - (if next-p last-tag tagname) - (if regexp-p - find-tag-regexp-search-function - find-tag-search-function) - (if regexp-p - find-tag-regexp-tag-order - find-tag-tag-order) - (if regexp-p - find-tag-regexp-next-line-after-failure-p - find-tag-next-line-after-failure-p) - (if regexp-p "matching" "containing") - (not next-p))) - (set-marker marker (point)))) - tags-location-stack)))) - (run-hooks 'local-find-tag-hook))))) + ;; Record the location so we can pop back to it later. + (let ((marker (make-marker))) + (save-excursion + (set-buffer + ;; find-tag-in-order does the real work. + (find-tag-in-order + (if next-p last-tag tagname) + (if regexp-p + find-tag-regexp-search-function + find-tag-search-function) + (if regexp-p + find-tag-regexp-tag-order + find-tag-tag-order) + (if regexp-p + find-tag-regexp-next-line-after-failure-p + find-tag-next-line-after-failure-p) + (if regexp-p "matching" "containing") + (not next-p))) + (set-marker marker (point)) + (run-hooks 'local-find-tag-hook) + (setq tags-location-stack + (cons marker tags-location-stack)) + (current-buffer)))))) ;;;###autoload (defun find-tag (tagname &optional next-p regexp-p) @@ -778,6 +853,7 @@ See documentation of variable `tags-file-name'." ;; We go through find-tag-other-window to do all the display hair there. (funcall (if other-window 'find-tag-other-window 'find-tag) regexp next-p t)) +;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp) ;; Internal tag finding function. @@ -806,7 +882,6 @@ See documentation of variable `tags-file-name'." first-search) (let (file ;name of file containing tag tag-info ;where to find the tag in FILE - tags-table-file ;name of tags file (first-table t) (tag-order order) goto-func @@ -828,9 +903,9 @@ See documentation of variable `tags-file-name'." (and first-search first-table ;; Start at beginning of tags file. (goto-char (point-min))) + (setq first-table nil) - (setq tags-table-file buffer-file-name) ;; Iterate over the list of ordering predicates. (while order (while (funcall search-forward-func pattern nil t) @@ -850,7 +925,7 @@ See documentation of variable `tags-file-name'." ;; We throw out on match, so only get here if there were no matches. (error "No %stags %s %s" (if first-search "" "more ") matching pattern)) - + ;; Found a tag; extract location info. (beginning-of-line) (setq tag-lines-already-matched (cons (point) @@ -867,13 +942,7 @@ See documentation of variable `tags-file-name'." (widen) (push-mark) (funcall goto-func tag-info) - - ;; Give this buffer a local value of tags-file-name. - ;; The next time visit-tags-table-buffer is called, - ;; it will use the same tags table that found a match in this buffer. - (make-local-variable 'tags-file-name) - (setq tags-file-name tags-table-file) - + ;; Return the buffer where the tag was found. (current-buffer)))) @@ -897,8 +966,11 @@ See documentation of variable `tags-file-name'." (find-tag-regexp-tag-order . (tag-re-match-p)) (find-tag-regexp-next-line-after-failure-p . t) (find-tag-search-function . search-forward) - (find-tag-tag-order . (tag-exact-match-p tag-word-match-p - tag-any-match-p)) + (find-tag-tag-order . (tag-exact-file-name-match-p + tag-exact-match-p + tag-symbol-match-p + tag-word-match-p + tag-any-match-p)) (find-tag-next-line-after-failure-p . nil) (list-tags-function . etags-list-tags) (tags-apropos-function . etags-tags-apropos) @@ -913,10 +985,11 @@ See documentation of variable `tags-file-name'." (defun etags-file-of-tag () (save-excursion - (search-backward "\f\n") - (forward-char 2) - (buffer-substring (point) - (progn (skip-chars-forward "^,") (point))))) + (if (looking-at "./") + (re-search-forward "\\([^\n]+\\),[0-9]*\n") + (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")) + (buffer-substring (match-beginning 1) (match-end 1)))) + (defun etags-tags-completion-table () (let ((table (make-vector 511 0))) @@ -931,8 +1004,9 @@ See documentation of variable `tags-file-name'." ;; \6 is the line to start searching at; ;; \7 is the char to start searching at. (while (re-search-forward - "^\\(\\(.+[^-a-zA-Z0-9_$]+\\)?\\([-a-zA-Z0-9_$]+\\)\ -\[^-a-zA-Z0-9_$]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\\([0-9]+\\),\\([0-9]+\\)\n" + "^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ +\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ +\\([0-9]+\\)?,\\([0-9]+\\)?\n" nil t) (intern (if (match-beginning 5) ;; There is an explicit tag name. @@ -943,52 +1017,94 @@ See documentation of variable `tags-file-name'." table)) (defun etags-snarf-tag () - (let (tag-text startpos) - (search-forward "\177") - (setq tag-text (buffer-substring (1- (point)) - (save-excursion (beginning-of-line) - (point)))) - ;; Skip explicit tag name if present. - (search-forward "\001" (save-excursion (forward-line 1) (point)) t) - (search-forward ",") - (setq startpos (string-to-int (buffer-substring - (point) - (progn (skip-chars-forward "0-9") - (point))))) + (let (tag-text line startpos) + (if (save-excursion + (forward-line -1) + (looking-at "\f\n")) + ;; The match was for a source file name, not any tag within a file. + ;; Give text of t, meaning to go exactly to the location we specify, + ;; the beginning of the file. + (setq tag-text t + line nil + startpos 1) + + ;; Find the end of the tag and record the whole tag text. + (search-forward "\177") + (setq tag-text (buffer-substring (1- (point)) + (save-excursion (beginning-of-line) + (point)))) + ;; Skip explicit tag name if present. + (search-forward "\001" (save-excursion (forward-line 1) (point)) t) + (if (looking-at "[0-9]") + (setq line (string-to-int (buffer-substring + (point) + (progn (skip-chars-forward "0-9") + (point)))))) + (search-forward ",") + (if (looking-at "[0-9]") + (setq startpos (string-to-int (buffer-substring + (point) + (progn (skip-chars-forward "0-9") + (point))))))) ;; Leave point on the next line of the tags file. (forward-line 1) - (cons tag-text startpos))) - + (cons tag-text (cons line startpos)))) + +;; TAG-INFO is a cons (TEXT LINE . POSITION) where TEXT is the initial part +;; of a line containing the tag and POSITION is the character position of +;; TEXT within the file (starting from 1); LINE is the line number. If +;; TEXT is t, it means the tag refers to exactly LINE or POSITION +;; (whichever is present, LINE having preference, no searching. Either +;; LINE or POSITION may be nil; POSITION is used if present. If the tag +;; isn't exactly at the given position then look around that position using +;; a search window which expands until it hits the start of file. (defun etags-goto-tag-location (tag-info) - (let ((startpos (cdr tag-info)) - ;; This constant is 1/2 the initial search window. - ;; There is no sense in making it too small, - ;; since just going around the loop once probably - ;; costs about as much as searching 2000 chars. - (offset 1000) - (found nil) - (pat (concat (if (eq selective-display t) - "\\(^\\|\^m\\)" "^") - (regexp-quote (car tag-info))))) - (or startpos - (setq startpos (point-min))) - (while (and (not found) - (progn - (goto-char (- startpos offset)) - (not (bobp)))) - (setq found - (re-search-forward pat (+ startpos offset) t) - offset (* 3 offset))) ; expand search window - (or found - (re-search-forward pat nil t) - (error "Rerun etags: `%s' not found in %s" - pat buffer-file-name))) - ;; Position point at the right place - ;; if the search string matched an extra Ctrl-m at the beginning. - (and (eq selective-display t) - (looking-at "\^m") - (forward-char 1)) - (beginning-of-line)) + (let ((startpos (cdr (cdr tag-info))) + offset found pat) + (if (eq (car tag-info) t) + ;; Direct file tag. + (cond (line (goto-line line)) + (position (goto-char position)) + (t (error "etags.el BUG: bogus direct file tag"))) + ;; This constant is 1/2 the initial search window. + ;; There is no sense in making it too small, + ;; since just going around the loop once probably + ;; costs about as much as searching 2000 chars. + (setq offset 1000 + found nil + pat (concat (if (eq selective-display t) + "\\(^\\|\^m\\)" "^") + (regexp-quote (car tag-info)))) + ;; The character position in the tags table is 0-origin. + ;; Convert it to a 1-origin Emacs character position. + (if startpos (setq startpos (1+ startpos))) + ;; If no char pos was given, try the given line number. + (or startpos + (if (car (cdr tag-info)) + (setq startpos (progn (goto-line (car (cdr tag-info))) + (point))))) + (or startpos + (setq startpos (point-min))) + ;; First see if the tag is right at the specified location. + (goto-char startpos) + (setq found (looking-at pat)) + (while (and (not found) + (progn + (goto-char (- startpos offset)) + (not (bobp)))) + (setq found + (re-search-forward pat (+ startpos offset) t) + offset (* 3 offset))) ; expand search window + (or found + (re-search-forward pat nil t) + (error "Rerun etags: `%s' not found in %s" + pat buffer-file-name))) + ;; Position point at the right place + ;; if the search string matched an extra Ctrl-m at the beginning. + (and (eq selective-display t) + (looking-at "\^m") + (forward-char 1)) + (beginning-of-line))) (defun etags-list-tags (file) (goto-char 1) @@ -996,9 +1112,15 @@ See documentation of variable `tags-file-name'." nil (forward-line 1) (while (not (or (eobp) (looking-at "\f"))) - (princ (buffer-substring (point) - (progn (skip-chars-forward "^\177") - (point)))) + (let ((tag (buffer-substring (point) + (progn (skip-chars-forward "^\177") + (point))))) + (princ (if (looking-at "[^\n]+\001") + ;; There is an explicit tag name; use that. + (buffer-substring (point) + (progn (skip-chars-forward "^\001") + (point))) + tag))) (terpri) (forward-line 1)) t)) @@ -1019,11 +1141,10 @@ See documentation of variable `tags-file-name'." (goto-char (point-min)) (while (search-forward "\f\n" nil t) (setq beg (point)) - (skip-chars-forward "^,\n") - (or (looking-at ",include$") - ;; Expand in the default-directory of the tags table buffer. - (setq files (cons (expand-file-name (buffer-substring beg (point))) - files)))) + (end-of-line) + (skip-chars-backward "^," beg) + (or (looking-at "include$") + (setq files (cons (buffer-substring beg (1- (point))) files)))) (nreverse files))) (defun etags-tags-included-tables () @@ -1032,10 +1153,11 @@ See documentation of variable `tags-file-name'." (goto-char (point-min)) (while (search-forward "\f\n" nil t) (setq beg (point)) - (skip-chars-forward "^,\n") - (if (looking-at ",include$") + (end-of-line) + (skip-chars-backward "^," beg) + (if (looking-at "include$") ;; Expand in the default-directory of the tags table buffer. - (setq files (cons (expand-file-name (buffer-substring beg (point))) + (setq files (cons (expand-file-name (buffer-substring beg (1- (point)))) files)))) (nreverse files))) @@ -1076,17 +1198,22 @@ See documentation of variable `tags-file-name'." ;; (set-syntax-table otable))))) ;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form)) -;; t if point is at a tag line that matches TAG "exactly". +;; t if point is at a tag line that matches TAG exactly. ;; point should be just after a string that matches TAG. (defun tag-exact-match-p (tag) ;; The match is really exact if there is an explicit tag name. - (or (looking-at (concat "[^\177]*\177" (regexp-quote tag) "\001")) - ;; We also call it "exact" if it is surrounded by symbol boundaries. - ;; This is needed because etags does not always generate explicit names. - (and (looking-at "\\Sw.*\177") (looking-at "\\S_.*\177") - (save-excursion - (backward-char (1+ (length tag))) - (and (looking-at "\\Sw") (looking-at "\\S_")))))) + (or (and (eq (char-after (point)) ?\001) + (eq (char-after (- (point) (length tag) 1)) ?\177)) + ;; We are not on the explicit tag name, but perhaps it follows. + (looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001")))) + +;; t if point is at a tag line that matches TAG as a symbol. +;; point should be just after a string that matches TAG. +(defun tag-symbol-match-p (tag) + (and (looking-at "\\Sw.*\177") (looking-at "\\S_.*\177") + (save-excursion + (backward-char (1+ (length tag))) + (and (looking-at "\\Sw") (looking-at "\\S_"))))) ;; t if point is at a tag line that matches TAG as a word. ;; point should be just after a string that matches TAG. @@ -1095,6 +1222,11 @@ See documentation of variable `tags-file-name'." (save-excursion (backward-char (1+ (length tag))) (looking-at "\\b")))) +(defun tag-exact-file-name-match-p (tag) + (and (looking-at ",") + (save-excursion (backward-char (1+ (length tag))) + (looking-at "\f\n")))) + ;; t if point is in a tag line with a tag containing TAG as a substring. (defun tag-any-match-p (tag) (looking-at ".*\177")) @@ -1120,7 +1252,8 @@ Non-nil second argument NOVISIT means use a temporary buffer Value is nil if the file was already visited; if the file was newly read in, the value is the filename." - (interactive "P") + ;; Make the interactive arg t if there was any prefix arg. + (interactive (list (if current-prefix-arg t))) (cond ((not initialize) ;; Not the first run. ) @@ -1129,32 +1262,45 @@ if the file was newly read in, the value is the filename." (save-excursion ;; Visit the tags table buffer to get its list of files. (visit-tags-table-buffer) - (setq next-file-list (tags-table-files)))) + ;; Copy the list so we can setcdr below, and expand the file + ;; names while we are at it, in this buffer's default directory. + (setq next-file-list (mapcar 'expand-file-name (tags-table-files))) + ;; Iterate over all the tags table files, collecting + ;; a complete list of referenced file names. + (while (visit-tags-table-buffer t) + ;; Find the tail of the working list and chain on the new + ;; sublist for this tags table. + (let ((tail next-file-list)) + (while (cdr tail) + (setq tail (cdr tail))) + ;; Use a copy so the next loop iteration will not modify the + ;; list later returned by (tags-table-files). + (if tail + (setcdr tail (mapcar 'expand-file-name (tags-table-files))) + (setq next-file-list (mapcar 'expand-file-name + (tags-table-files)))))))) (t ;; Initialize the list by evalling the argument. (setq next-file-list (eval initialize)))) - (or next-file-list - (save-excursion - ;; Get the files from the next tags table. - ;; When doing (visit-tags-table-buffer t), - ;; the tags table buffer must be current. - (if (and (visit-tags-table-buffer 'same) - (visit-tags-table-buffer t)) - (setq next-file-list (tags-table-files)) - (and novisit - (get-buffer " *next-file*") - (kill-buffer " *next-file*")) - (error "All files processed.")))) - (let ((new (not (get-file-buffer (car next-file-list))))) + (if next-file-list + () + (and novisit + (get-buffer " *next-file*") + (kill-buffer " *next-file*")) + (error "All files processed.")) + (let* ((next (car next-file-list)) + (new (not (get-file-buffer next)))) + ;; Advance the list before trying to find the file. + ;; If we get an error finding the file, don't get stuck on it. + (setq next-file-list (cdr next-file-list)) (if (not (and new novisit)) - (set-buffer (find-file-noselect (car next-file-list) novisit)) + (set-buffer (find-file-noselect next novisit)) ;; Like find-file, but avoids random warning messages. (set-buffer (get-buffer-create " *next-file*")) (kill-all-local-variables) (erase-buffer) - (setq new (car next-file-list)) + (setq new next) (insert-file-contents new nil)) - (setq next-file-list (cdr next-file-list)) new)) (defvar tags-loop-operate nil @@ -1172,11 +1318,12 @@ If it returns non-nil, this file needs processing by evalling "Continue last \\[tags-search] or \\[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the argument is passed to `next-file', which see). -Two variables control the processing we do on each file: -the value of `tags-loop-scan' is a form to be executed on each file -to see if it is interesting (it returns non-nil if so) -and `tags-loop-operate' is a form to execute to operate on an interesting file -If the latter returns non-nil, we exit; otherwise we scan the next file." + +Two variables control the processing we do on each file: the value of +`tags-loop-scan' is a form to be executed on each file to see if it is +interesting (it returns non-nil if so) and `tags-loop-operate' is a form to +evaluate to operate on an interesting file. If the latter evaluates to +nil, we exit; otherwise we scan the next file." (interactive) (let (new (messaged nil)) @@ -1203,6 +1350,7 @@ If the latter returns non-nil, we exit; otherwise we scan the next file." (let ((pos (point))) (erase-buffer) (set-buffer (find-file-noselect new)) + (setq new nil) ;No longer in a temp buffer. (widen) (goto-char pos))) @@ -1230,7 +1378,7 @@ See documentation of variable `tags-file-name'." ;; Continue last tags-search as if by M-,. (tags-loop-continue nil) (setq tags-loop-scan - (list 're-search-forward regexp nil t) + (list 're-search-forward (list 'quote regexp) nil t) tags-loop-operate nil) (tags-loop-continue (or file-list-form t)))) @@ -1242,27 +1390,38 @@ If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace with the command \\[tags-loop-continue]. See documentation of variable `tags-file-name'." - (interactive - "sTags query replace (regexp): \nsTags query replace %s by: \nP") + (interactive (query-replace-read-args "Tags query replace (regexp)" t)) (setq tags-loop-scan (list 'prog1 - (list 'if (list 're-search-forward from nil t) + (list 'if (list 're-search-forward + (list 'quote from) nil t) ;; When we find a match, move back ;; to the beginning of it so perform-replace ;; will see it. '(goto-char (match-beginning 0)))) - tags-loop-operate (list 'perform-replace from to t t delimited)) + tags-loop-operate (list 'perform-replace + (list 'quote from) (list 'quote to) + t t (list 'quote delimited))) (tags-loop-continue (or file-list-form t))) +(defun tags-complete-tags-table-file (string predicate what) + (save-excursion + ;; If we need to ask for the tag table, allow that. + (let ((enable-recursive-minibuffers t)) + (visit-tags-table-buffer)) + (if (eq what t) + (all-completions string (mapcar 'list (tags-table-files)) + predicate) + (try-completion string (mapcar 'list (tags-table-files)) + predicate)))) + ;;;###autoload -(defun list-tags (file) +(defun list-tags (file &optional next-match) "Display list of tags in file FILE. -FILE should not contain a directory specification." +This searches only the first table in the list, and no included tables. +FILE should be as it appeared in the `etags' command, usually without a +directory specification." (interactive (list (completing-read "List tags in file: " - (save-excursion - (visit-tags-table-buffer) - (mapcar 'list - (mapcar 'file-name-nondirectory - (tags-table-files)))) + 'tags-complete-tags-table-file nil t nil))) (with-output-to-temp-buffer "*Tags List*" (princ "Tags in file ") @@ -1298,14 +1457,12 @@ FILE should not contain a directory specification." ;;;###autoload (defun select-tags-table () "Select a tags table file from a menu of those you have already used. -The list of tags tables to select from is stored in `tags-table-file-list'; +The list of tags tables to select from is stored in `tags-table-set-list'; see the doc of that variable if you want to add names to the list." (interactive) (pop-to-buffer "*Tags Table List*") (setq buffer-read-only nil) (erase-buffer) - (setq selective-display t - selective-display-ellipses nil) (let ((set-list tags-table-set-list) (desired-point nil)) (if tags-table-list @@ -1332,7 +1489,7 @@ see the doc of that variable if you want to add names to the list." (prin1 tags-file-name (current-buffer)) ;invisible (insert "\n"))) (setq set-list (delete tags-file-name - (apply 'nconc (cons tags-table-list + (apply 'nconc (cons (copy-sequence tags-table-list) (mapcar 'copy-sequence tags-table-set-list))))) (while set-list @@ -1347,17 +1504,31 @@ see the doc of that variable if you want to add names to the list." (goto-char desired-point)) (set-window-start (selected-window) 1 t)) (set-buffer-modified-p nil) + (select-tags-table-mode)) + +(defvar select-tags-table-mode-map) +(let ((map (make-sparse-keymap))) + (define-key map "t" 'select-tags-table-select) + (define-key map " " 'next-line) + (define-key map "\^?" 'previous-line) + (define-key map "n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "q" 'select-tags-table-quit) + (setq select-tags-table-mode-map map)) + +(defun select-tags-table-mode () + "Major mode for choosing a current tags table among those already loaded. + +\\{select-tags-table-mode-map}" + (interactive) + (kill-all-local-variables) (setq buffer-read-only t + major-mode 'select-tags-table-mode mode-name "Select Tags Table") - (let ((map (make-sparse-keymap))) - (define-key map "t" 'select-tags-table-select) - (define-key map " " 'next-line) - (define-key map "\^?" 'previous-line) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) - (define-key map "q" 'select-tags-table-quit) - (use-local-map map))) - + (use-local-map select-tags-table-mode-map) + (setq selective-display t + selective-display-ellipses nil)) + (defun select-tags-table-select () "Select the tags table named on this line." (interactive) @@ -1372,12 +1543,12 @@ see the doc of that variable if you want to add names to the list." (interactive) (kill-buffer (current-buffer)) (or (one-window-p) - (delete-window))) + (delete-window))) ;;;###autoload (defun complete-tag () "Perform tags completion on the text around point. -Completes to the set of names listed in the current tags table. +Completes to the set of names listed in the current tags table. The string to complete is chosen in the same way as the default for \\[find-tag] (which see)." (interactive) @@ -1405,7 +1576,7 @@ for \\[find-tag] (which see)." (insert completion)) (t (message "Making completion list...") - (with-output-to-temp-buffer " *Completions*" + (with-output-to-temp-buffer "*Completions*" (display-completion-list (all-completions pattern 'tags-complete-tag nil))) (message "Making completion list...%s" "done")))))