;;; etags.el --- etags facility for Emacs
-
-;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994
+;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998
;; Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Code:
+(require 'ring)
+
;;;###autoload
(defvar tags-file-name nil
"*File name of tags table.
;; Make M-x set-variable tags-file-name like M-x visit-tags-table.
;;;###autoload (put 'tags-file-name 'variable-interactive "fVisit tags table: ")
+(defgroup etags nil "Tags tables"
+ :group 'tools)
+
;;;###autoload
;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
-(defvar tags-table-list nil
+(defcustom tags-table-list nil
"*List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
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.")
+Use the `etags' program to make a tags table file."
+ :group 'etags
+ :type '(repeat file))
;;;###autoload
-(defvar tags-add-tables 'ask-user
+(defcustom 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).")
+to the current list (as opposed to starting a new list)."
+ :group 'etags
+ :type '(choice (const :tag "Do" t)
+ (const :tag "Don't" nil)
+ (other :tag "Ask" ask-user)))
+
+(defcustom tags-revert-without-query nil
+ "*Non-nil means reread a TAGS table without querying, if it has changed."
+ :group 'etags
+ :type 'boolean)
(defvar tags-table-computed-list nil
"List of tags tables to search, computed from `tags-table-list'.
Each element is a list of strings which are file names.")
;;;###autoload
-(defvar find-tag-hook nil
+(defcustom find-tag-hook nil
"*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
The value in the buffer in which \\[find-tag] is done is used,
-not the value in the buffer \\[find-tag] goes to.")
+not the value in the buffer \\[find-tag] goes to."
+ :group 'etags
+ :type 'hook)
;;;###autoload
-(defvar find-tag-default-function nil
+(defcustom find-tag-default-function nil
"*A function of no arguments used by \\[find-tag] to pick a default tag.
If nil, and the symbol that is the value of `major-mode'
has a `find-tag-default-function' property (see `put'), that is used.
-Otherwise, `find-tag-default' is used.")
+Otherwise, `find-tag-default' is used."
+ :group 'etags
+ :type 'function)
+
+(defcustom find-tag-marker-ring-length 16
+ "*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
+ :group 'etags
+ :type 'integer
+ :version "20.3")
+
+(defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length)
+ "Ring of markers which are locations from which \\[find-tag] was invoked.")
(defvar default-tags-table-function nil
"If non-nil, a function to choose a default tags file for a buffer.
This function receives no arguments and should return the default
tags table file to use for the current buffer.")
-(defvar tags-location-stack nil
- "List of markers which are locations visited by \\[find-tag].
+(defvar tags-location-ring (make-ring find-tag-marker-ring-length)
+ "Ring of markers which are locations visited by \\[find-tag].
Pop back to the last location with \\[negative-argument] \\[find-tag].")
\f
;; Tags table state.
;; These variables are local in tags table buffers.
-(defvar tag-lines-already-matched nil
- "List of positions of beginnings of lines within the tags table
-that are already matched.")
-
(defvar tags-table-files nil
"List of file names covered by current tags table.
nil means it has not yet been computed; use `tags-table-files' to do so.")
(defvar tags-table-format-hooks '(etags-recognize-tags-table
recognize-empty-tags-table)
- "List of functions to be called in a tags table buffer to identify
-the type of tags table. The functions are called in order, with no arguments,
+ "List of functions to be called in a tags table buffer to identify the type of tags table.
+The functions are called in order, with no arguments,
until one returns non-nil. The function should make buffer-local bindings
of the format-parsing tags function variables if successful.")
(defvar tags-included-tables-function nil
"Function to do the work of `tags-included-tables' (which see).")
(defvar verify-tags-table-function nil
- "Function to return t iff the current buffer contains a valid
-\(already initialized\) tags file.")
+ "Function to return t iff current buffer contains valid tags file.")
\f
;; Initialize the tags table in the current buffer.
;; Returns non-nil iff it is a valid tags table. On
;; non-nil return, the tags table state variable are
;; made buffer-local and initialized to nil.
(defun initialize-new-tags-table ()
- (set (make-local-variable 'tag-lines-already-matched) nil)
(set (make-local-variable 'tags-table-files) nil)
(set (make-local-variable 'tags-completion-table) nil)
(set (make-local-variable 'tags-included-tables) nil)
+ (setq find-tag-marker-ring (make-ring find-tag-marker-ring-length))
+ (setq tags-location-ring (make-ring find-tag-marker-ring-length))
;; Value is t if we have found a valid tags table buffer.
(let ((hooks tags-table-format-hooks))
(while (and hooks
;; 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
(while tables
(setq computed (cons (car tables) computed)
table-buffer (get-file-buffer (car tables)))
- (if (and table-buffer
+ (if (and table-buffer
;; There is a buffer visiting the file. Now make sure
;; it is initialized as a tag table buffer.
(save-excursion
(if (tags-included-tables)
;; Insert the included tables into the list we
;; are processing.
- (setcdr tables (append (tags-included-tables)
- (cdr tables)))))
+ (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.
(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))
+ ;; Decide whether to revert the file.
+ ;; revert-without-query can say to revert
+ ;; or the user can say to revert.
+ (not (or (let ((tail revert-without-query)
+ (found nil))
+ (while tail
+ (if (string-match (car tail) buffer-file-name)
+ (setq found t))
+ (setq tail (cdr tail)))
+ found)
+ tags-revert-without-query
+ (yes-or-no-p
+ (format "Tags file %s has changed, read new contents? "
+ file)))))
+ (and verify-tags-table-function
+ (funcall verify-tags-table-function))
(revert-buffer t t)
(initialize-new-tags-table)))
(and (file-exists-p file)
;; 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 (tags-table-files))
+ (if (member this-file (mapcar 'expand-file-name
+ (tags-table-files)))
;; Found it.
(setq found tables))))
(setq tables (cdr tables)))
(if found
;; Now determine if the table we found was one included by another
- ;; table, not explicitly listed.
+ ;; 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 (cons (car elt) could-be)))
- (setq elt (cdr elt)))
+ (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. This will be the head of the
- ;; COULD-BE list.
- (car could-be)))))
+ ;; 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.
(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.")))))
+ (error "%s"
+ (substitute-command-keys
+ (concat "No tags table in use; "
+ "use \\[visit-tags-table] to select one")))))
((eq t cont)
;; Find the next table.
;; be frobnicated, and CONT will be set non-nil so we don't
;; do it below.
(and buffer-file-name
- (or
+ (or
;; First check only tables already in buffers.
(tags-table-including buffer-file-name t)
;; Since that didn't find any, now do the
(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]."
+ "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-location-ring (progn
+ (mapcar (lambda (m)
+ (set-marker m nil))
+ tags-location-ring)
+ (make-ring find-tag-marker-ring-length))
+ find-tag-marker-ring (progn
+ (mapcar (lambda (m)
+ (set-marker m nil))
+ find-tag-marker-ring)
+ (make-ring find-tag-marker-ring-length))
tags-table-list nil
tags-table-computed-list nil
tags-table-computed-list-for nil
;;;###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))))
(spec (completing-read (if default
(format "%s(default %s) " string default)
string)
- 'tags-complete-tag)))
+ 'tags-complete-tag
+ nil nil nil nil default)))
(if (equal spec "")
(or default (error "There is no default tag"))
spec)))
If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
+A marker representing the point when this command is onvoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag: "))
(let ((local-find-tag-hook find-tag-hook))
(if (eq '- next-p)
;; Pop back to a previous location.
- (if (null tags-location-stack)
+ (if (ring-empty-p tags-location-ring)
(error "No previous tag locations")
- (let ((marker (car tags-location-stack)))
- ;; Pop the stack.
- (setq tags-location-stack (cdr tags-location-stack))
+ (let ((marker (ring-remove tags-location-ring 0)))
(prog1
;; Move to the saved location.
- (set-buffer (marker-buffer marker))
+ (set-buffer (or (marker-buffer marker)
+ (error "The marked buffer has been deleted")))
(goto-char (marker-position marker))
;; Kill that marker so it doesn't slow down editing.
(set-marker marker nil nil)
;; Run the user's hook. Do we really want to do this for pop?
(run-hooks 'local-find-tag-hook))))
+ ;; Record whence we came.
+ (ring-insert find-tag-marker-ring (point-marker))
(if next-p
;; Find the same table we last used.
(visit-tags-table-buffer 'same)
(not next-p)))
(set-marker marker (point))
(run-hooks 'local-find-tag-hook)
- (setq tags-location-stack
- (cons marker tags-location-stack))
+ (ring-insert tags-location-ring marker)
(current-buffer))))))
;;;###autoload
is the atom `-' (interactively, with prefix arg that is a negative number
or just \\[negative-argument]), pop back to the previous tag gone to.
+If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
+
+A marker representing the point when this command is onvoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag: "))
(switch-to-buffer (find-tag-noselect tagname next-p regexp-p)))
is negative (interactively, with prefix arg that is a negative number or
just \\[negative-argument]), pop back to the previous tag gone to.
+If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
+
+A marker representing the point when this command is onvoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag other window: "))
is negative (interactively, with prefix arg that is a negative number or
just \\[negative-argument]), pop back to the previous tag gone to.
+If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
+
+A marker representing the point when this command is onvoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag other frame: "))
(let ((pop-up-frames t))
If third arg OTHER-WINDOW is non-nil, select the buffer in another window.
+A marker representing the point when this command is onvoked is pushed
+onto a ring and may be popped back to with \\[pop-tag-mark].
+Contrast this with the ring of marks gone to by the command.
+
See documentation of variable `tags-file-name'."
(interactive (find-tag-interactive "Find tag regexp: " t))
;; 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)
+
+;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
+
+;;;###autoload
+(defun pop-tag-mark ()
+ "Pop back to where \\[find-tag] was last invoked.
+
+This is distinct from invoking \\[find-tag] with a negative argument
+since that pops a stack of markers at which tags were found, not from
+where they were found."
+ (interactive)
+ (if (ring-empty-p find-tag-marker-ring)
+ (error "No previous locations for find-tag invocation"))
+ (let ((marker (ring-remove find-tag-marker-ring 0)))
+ (switch-to-buffer (or (marker-buffer marker)
+ (error "The marked buffer has been deleted")))
+ (goto-char (marker-position marker))
+ (set-marker marker nil nil)))
\f
;; Internal tag finding function.
;; specified source file and return. Qualified matches are remembered to
;; avoid repetition. State is saved so that the loop can be continued.
+(defvar tag-lines-already-matched nil) ;matches remembered here between calls
+
(defun find-tag-in-order (pattern
search-forward-func
order
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)
+ (match-marker (make-marker))
goto-func
)
(save-excursion
- (or first-search ;find-tag-noselect has already done it.
- (visit-tags-table-buffer 'same))
+
+ (if first-search
+ ;; This is the start of a search for a fresh tag.
+ ;; Clear the list of tags matched by the previous search.
+ ;; find-tag-noselect has already put us in the first tags table
+ ;; buffer before we got called.
+ (setq tag-lines-already-matched nil)
+ ;; Continuing to search for the tag specified last time.
+ ;; tag-lines-already-matched lists locations matched in previous
+ ;; calls so we don't visit the same tag twice if it matches twice
+ ;; during two passes with different qualification predicates.
+ ;; Switch to the current tags table buffer.
+ (visit-tags-table-buffer 'same))
;; Get a qualified match.
(catch 'qualified-match-found
(while (or first-table
(visit-tags-table-buffer t))
- (if first-search
- (setq tag-lines-already-matched nil))
-
(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)
;; Naive match found. Qualify the match.
(and (funcall (car order) pattern)
;; Make sure it is not a previous qualified match.
- ;; Use of `memq' depends on numbers being eq.
- (not (memq (save-excursion (beginning-of-line) (point))
- tag-lines-already-matched))
+ (not (member (set-marker match-marker (save-excursion
+ (beginning-of-line)
+ (point)))
+ tag-lines-already-matched))
(throw 'qualified-match-found nil))
(if next-line-after-failure-p
(forward-line 1)))
(goto-char (point-min)))
(setq order tag-order))
;; We throw out on match, so only get here if there were no matches.
+ ;; Clear out the markers we use to avoid duplicate matches so they
+ ;; don't slow down editting and are immediately available for GC.
+ (while tag-lines-already-matched
+ (set-marker (car tag-lines-already-matched) nil nil)
+ (setq tag-lines-already-matched (cdr tag-lines-already-matched)))
+ (set-marker match-marker nil nil)
(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)
+ (setq tag-lines-already-matched (cons match-marker
tag-lines-already-matched))
;; Expand the filename, using the tags table buffer's default-directory.
(setq file (expand-file-name (file-of-tag))
(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))))
\f
(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
+ (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))
(defun etags-file-of-tag ()
(save-excursion
- (search-backward "\f\n")
- (forward-char 2)
- (buffer-substring (point)
- (progn (skip-chars-forward "^,") (point)))))
+ (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")
+ (expand-file-name (buffer-substring (match-beginning 1) (match-end 1))
+ (file-truename default-directory))))
+
(defun etags-tags-completion-table ()
(let ((table (make-vector 511 0)))
;; \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\\)?\
+ "^\\(\\([^\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)
(defun etags-snarf-tag ()
(let (tag-text line 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)
- (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))))))
+ (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 (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. Either
+;; 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 (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)))))
- ;; 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))
+ (line (car (cdr tag-info)))
+ offset found pat)
+ (if (eq (car tag-info) t)
+ ;; Direct file tag.
+ (cond (line (goto-line line))
+ (startpos (goto-char startpos))
+ (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 line
+ (setq startpos (progn (goto-line line)
+ (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)
(point)))))
(princ (if (looking-at "[^\n]+\001")
;; There is an explicit tag name; use that.
- (buffer-substring (point)
+ (buffer-substring (1+ (point)) ;skip \177
(progn (skip-chars-forward "^\001")
(point)))
tag)))
(end-of-line)
(skip-chars-backward "^," beg)
(or (looking-at "include$")
- ;; Expand in the default-directory of the tags table buffer.
- (setq files (cons (expand-file-name (buffer-substring beg (1- (point))))
- files))))
+ (setq files (cons (buffer-substring beg (1- (point))) files))))
(nreverse files)))
(defun etags-tags-included-tables ()
;; point should be just after a string that matches TAG.
(defun tag-word-match-p (tag)
(and (looking-at "\\b.*\177")
- (save-excursion (backward-char (1+ (length tag)))
+ (save-excursion (backward-char (length tag))
(looking-at "\\b"))))
+(defun tag-exact-file-name-match-p (tag)
+ (and (looking-at ",")
+ (save-excursion (backward-char (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"))
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.
)
(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
"Form for `tags-loop-continue' to eval to change one file.")
(defvar tags-loop-scan
- '(error (substitute-command-keys
- "No \\[tags-search] or \\[tags-query-replace] in progress."))
+ '(error "%s"
+ (substitute-command-keys
+ "No \\[tags-search] or \\[tags-query-replace] in progress"))
"Form for `tags-loop-continue' to eval to scan one file.
If it returns non-nil, this file needs processing by evalling
\`tags-loop-operate'. Otherwise, move on to the next file.")
"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))
(let ((pos (point)))
(erase-buffer)
(set-buffer (find-file-noselect new))
+ (setq new nil) ;No longer in a temp buffer.
(widen)
(goto-char pos)))
;; 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))))
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)))
\f
+(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 ")
(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
(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)
(defun select-tags-table-quit ()
"Kill the buffer and delete the selected window."
(interactive)
- (kill-buffer (current-buffer))
- (or (one-window-p)
- (delete-window)))
+ (quit-window t (selected-window)))
\f
+;;; Note, there is another definition of this function in bindings.el.
;;;###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)
(or tags-table-list
tags-file-name
- (error (substitute-command-keys
- "No tags table loaded. Try \\[visit-tags-table].")))
+ (error "%s"
+ (substitute-command-keys
+ "No tags table loaded; try \\[visit-tags-table]")))
(let ((pattern (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
'find-tag-default)))
(display-completion-list
(all-completions pattern 'tags-complete-tag nil)))
(message "Making completion list...%s" "done")))))
-
-;;;###autoload (define-key esc-map "\t" 'complete-tag)
\f
(provide 'etags)