(require 'ring)
(defvar tags-file-name nil
"*File name of tags table.
To switch to a new tags table, setting this variable is sufficient.
If you set this variable, do not also set `tags-table-list'.
Use the `etags' program to make a tags table file.")
(defgroup etags nil "Tags tables"
:group 'tools)
(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."
:group 'etags
:type '(repeat file))
(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)."
: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'.
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-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-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.
Each element is a list of strings which are file names.")
(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."
:group 'etags
:type 'hook)
(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."
: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-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].")
(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-completion-table nil
"Alist of tag names defined in current tags table.")
(defvar tags-included-tables nil
"List of tags tables included by the current tags table.")
(defvar next-file-list nil
"List of files for \\[next-file] to process.")
(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,
until one returns non-nil. The function should make buffer-local bindings
of the format-parsing tags function variables if successful.")
(defvar file-of-tag-function nil
"Function to do the work of `file-of-tag' (which see).")
(defvar tags-table-files-function nil
"Function to do the work of `tags-table-files' (which see).")
(defvar tags-completion-table-function nil
"Function to build the tags-completion-table.")
(defvar snarf-tag-function nil
"Function to get info about a matched tag for `goto-tag-location-function'.")
(defvar goto-tag-location-function nil
"Function of to go to the location in the buffer specified by a tag.
One argument, the tag info returned by `snarf-tag-function'.")
(defvar find-tag-regexp-search-function nil
"Search function passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-regexp-tag-order nil
"Tag order passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-regexp-next-line-after-failure-p nil
"Flag passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-search-function nil
"Search function passed to `find-tag-in-order' for finding a tag.")
(defvar find-tag-tag-order nil
"Tag order passed to `find-tag-in-order' for finding a tag.")
(defvar find-tag-next-line-after-failure-p nil
"Flag passed to `find-tag-in-order' for finding a tag.")
(defvar list-tags-function nil
"Function to do the work of `list-tags' (which see).")
(defvar tags-apropos-function nil
"Function to do the work of `tags-apropos' (which see).")
(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 current buffer contains valid tags file.")
(defun initialize-new-tags-table ()
(set (make-local-variable 'tags-table-files) nil)
(set (make-local-variable 'tags-completion-table) nil)
(set (make-local-variable 'tags-included-tables) nil)
(let ((hooks tags-table-format-hooks))
(while (and hooks
(not (funcall (car hooks))))
(setq hooks (cdr hooks)))
hooks))
(defun visit-tags-table (file &optional local)
"Tell tags commands to use tags table file FILE.
FILE should be the name of a file created with the `etags' program.
A directory name is ok too; it means file TAGS in that directory.
Normally \\[visit-tags-table] sets the global value of `tags-file-name'.
With a prefix arg, set the buffer-local value instead.
When you find a tag with \\[find-tag], the buffer it finds the tag
in is given a local value of this variable which is the name of the tags
file the tag was in."
(interactive (list (read-file-name "Visit tags table: (default TAGS) "
default-directory
(expand-file-name "TAGS"
default-directory)
t)
current-prefix-arg))
(or (stringp file) (signal 'wrong-type-argument (list 'stringp file)))
(let ((tags-file-name file))
(save-excursion
(or (visit-tags-table-buffer file)
(signal 'file-error (list "Visiting tags table"
"file does not exist"
file)))
(setq file tags-file-name)))
(if local
(set (make-local-variable 'tags-file-name) file)
(setq-default tags-file-name file)))
(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)
(let* ((compute-for (mapcar 'copy-sequence expanded-list))
(tables (copy-sequence compute-for)) (computed nil)
table-buffer)
(while tables
(setq computed (cons (car tables) computed)
table-buffer (get-file-buffer (car tables)))
(if (and table-buffer
(save-excursion
(tags-verify-table (buffer-file-name table-buffer))))
(save-excursion
(set-buffer table-buffer)
(if (tags-included-tables)
(setcdr tables (nconc (mapcar 'tags-expand-table-name
(tags-included-tables))
(cdr tables)))))
(setq computed (cons t computed)))
(setq tables (cdr tables)))
(setq tags-table-computed-list-for compute-for
tags-table-computed-list (nreverse computed))))))
(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))
(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)
(setcdr tables (append (tags-included-tables)
tables))))
(setq computed (cons t computed)))
(setq tables (cdr tables)))
(setq computed (nreverse computed))
(setcdr list (nconc computed (cdr (cdr list)))))
(setcdr list (cdr (cdr list)))))))
(defun tags-expand-table-name (file)
(setq file (expand-file-name file))
(if (file-directory-p file)
(expand-file-name "TAGS" file)
file))
(defun tags-table-list-member (file list)
(setq file (tags-expand-table-name file))
(while (and list
(or (eq (car list) t)
(not (string= file (tags-expand-table-name (car list))))))
(setq list (cdr list)))
list)
(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)
(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 (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)
(progn
(set-buffer (find-file-noselect file))
(or (string= file buffer-file-name)
(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)))))
(defun tags-table-including (this-file core-only)
(let ((tables tags-table-computed-list)
(found nil))
(while (and (not found)
tables)
(if core-only
(while (eq (nth 1 tables) t)
(setq tables (cdr (cdr tables))))
(if (eq (nth 1 tables) t)
(tags-table-extend-computed-list)))
(if tables
(let ((tags-file-name (car tables)))
(visit-tags-table-buffer 'same)
(if (member this-file (mapcar 'expand-file-name
(tags-table-files)))
(setq found tables))))
(setq tables (cdr tables)))
(if found
(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)
(setq could-be (car elt)))
(setq elt (cdr elt))
(if (eq t (car elt))
(setq elt (cdr elt))))
could-be))))
(defun tags-next-table ()
(while (eq (nth 1 tags-table-list-pointer) t)
(tags-table-extend-computed-list))
(setq tags-table-list-pointer (cdr tags-table-list-pointer))
(or tags-table-list-pointer
(setq tags-table-list-pointer tags-table-computed-list))
(if (eq tags-table-list-pointer tags-table-list-started-at)
(setq tags-table-list-pointer nil)
(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'.
If arg is nil or absent, choose a first buffer from information in
`tags-file-name', `tags-table-list', `tags-table-list-pointer'.
Returns t if it visits a tags table, or nil if there are no more in the list."
(cond ((eq cont 'same)
(or tags-file-name
(error "%s"
(substitute-command-keys
(concat "No tags table in use; "
"use \\[visit-tags-table] to select one")))))
((eq t cont)
(if (tags-next-table)
(while (and (not (or (get-file-buffer tags-file-name)
(file-exists-p tags-file-name)))
(tags-next-table)))))
(t
(tags-table-check-computed-list) (setq tags-file-name
(or
(if (stringp cont)
(prog1 cont
(setq cont nil)))
(cdr (assq 'tags-file-name (buffer-local-variables)))
(and default-tags-table-function
(funcall default-tags-table-function))
(and buffer-file-name
(or
(tags-table-including buffer-file-name t)
(tags-table-including buffer-file-name nil)))
(and tags-file-name
(not (tags-table-list-member tags-file-name
tags-table-computed-list))
tags-file-name)
(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))
(expand-file-name
(read-file-name "Visit tags table: (default TAGS) "
default-directory
"TAGS"
t))))))
(setq tags-file-name (tags-expand-table-name tags-file-name))
(if (and (eq cont t)
(null tags-table-list-pointer))
nil
(let ((curbuf (current-buffer))
(local-tags-file-name tags-file-name))
(if (tags-verify-table local-tags-file-name)
(progn
(bury-buffer (current-buffer))
(or cont
(let ((found (tags-table-list-member
local-tags-file-name
tags-table-computed-list)))
(if found
(setq tags-table-list-pointer found
tags-table-list-started-at found)
(let ((sets tags-table-set-list))
(while (and sets
(not (tags-table-list-member
local-tags-file-name
(car sets))))
(setq sets (cdr sets)))
(if sets
(progn
(or (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 (car sets)))
(if (and tags-table-list
(or (eq t tags-add-tables)
(and tags-add-tables
(y-or-n-p
(concat "Keep current list of "
"tags tables also? ")))))
(setq tags-table-list (cons local-tags-file-name
tags-table-list))
(message "Starting a new list of tags tables")
(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 local-tags-file-name))))
(tags-table-check-computed-list)
(setq tags-table-list-started-at tags-table-computed-list
tags-table-list-pointer
tags-table-computed-list)))))
t)
(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)
(let ((i 0))
(while (< i find-tag-marker-ring-length)
(if (aref (cddr tags-location-ring) i)
(set-marker (aref (cddr tags-location-ring) i) nil))
(if (aref (cddr find-tag-marker-ring) i)
(set-marker (aref (cddr find-tag-marker-ring) i) nil))
(setq i (1+ i))))
(setq tags-file-name nil
tags-location-ring (make-ring find-tag-marker-ring-length)
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
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.
Assumes the tags table is the current buffer.
File name returned is relative to tags table file's directory."
(funcall file-of-tag-function))
(defun tags-table-files ()
"Return a list of files in the current tags table.
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))))
(defun tags-included-tables ()
"Return a list of tags tables included by the current table.
Assumes the tags table is the current buffer."
(or tags-included-tables
(setq tags-included-tables (funcall tags-included-tables-function))))
(defun tags-completion-table ()
(or tags-completion-table
(condition-case ()
(prog2
(message "Making tags completion table for %s..." buffer-file-name)
(let ((included (tags-included-tables))
(table (funcall tags-completion-table-function)))
(save-excursion
(while included
(let ((tags-file-name (car included)))
(visit-tags-table-buffer 'same))
(if (tags-completion-table)
(mapatoms (function
(lambda (sym)
(intern (symbol-name sym) table)))
tags-completion-table))
(setq included (cdr included))))
(setq tags-completion-table table))
(message "Making tags completion table for %s...done"
buffer-file-name))
(quit (message "Tags completion table construction aborted.")
(setq tags-completion-table nil)))))
(defun tags-complete-tag (string predicate what)
(save-excursion
(let ((enable-recursive-minibuffers t))
(visit-tags-table-buffer))
(if (eq what t)
(all-completions string (tags-completion-table) predicate)
(try-completion string (tags-completion-table) predicate))))
(defun find-tag-default ()
(save-excursion
(while (looking-at "\\sw\\|\\s_")
(forward-char 1))
(if (or (re-search-backward "\\sw\\|\\s_"
(save-excursion (beginning-of-line) (point))
t)
(re-search-forward "\\(\\sw\\|\\s_\\)+"
(save-excursion (end-of-line) (point))
t))
(progn (goto-char (match-end 0))
(buffer-substring (point)
(progn (forward-sexp -1)
(while (looking-at "\\s'")
(forward-char 1))
(point))))
nil)))
(defun find-tag-tag (string)
(let* ((default (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
'find-tag-default)))
(spec (completing-read (if default
(format "%s(default %s) " string default)
string)
'tags-complete-tag
nil nil nil nil default)))
(if (equal spec "")
(or default (error "There is no default tag"))
spec)))
(defvar last-tag nil
"Last tag found by \\[find-tag].")
(defun find-tag-interactive (prompt &optional no-default)
(if current-prefix-arg
(list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
'-
t))
(list (if no-default
(read-string prompt)
(find-tag-tag prompt)))))
(defvar find-tag-history nil)
(defun find-tag-noselect (tagname &optional next-p regexp-p)
"Find tag (in current tags table) whose name contains TAGNAME.
Returns the buffer containing the tag's definition and moves its point there,
but does not select the buffer.
The default for TAGNAME is the expression in the buffer near point.
If second arg NEXT-P is t (interactively, with prefix arg), search for
another tag that matches the last tagname or regexp used. When there are
multiple matches for a tag, more exact matches are found first. If NEXT-P
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: "))
(setq find-tag-history (cons tagname find-tag-history))
(let ((local-find-tag-hook find-tag-hook))
(if (eq '- next-p)
(if (ring-empty-p tags-location-ring)
(error "No previous tag locations")
(let ((marker (ring-remove tags-location-ring 0)))
(prog1
(set-buffer (or (marker-buffer marker)
(error "The marked buffer has been deleted")))
(goto-char (marker-position marker))
(set-marker marker nil nil)
(run-hooks 'local-find-tag-hook))))
(ring-insert find-tag-marker-ring (point-marker))
(if next-p
(visit-tags-table-buffer 'same)
(visit-tags-table-buffer)
(setq last-tag tagname))
(let ((marker (make-marker)))
(save-excursion
(set-buffer
(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)
(ring-insert tags-location-ring marker)
(current-buffer))))))
(defun find-tag (tagname &optional next-p regexp-p)
"Find tag (in current tags table) whose name contains TAGNAME.
Select the buffer containing the tag's definition, and move point there.
The default for TAGNAME is the expression in the buffer around or before point.
If second arg NEXT-P is t (interactively, with prefix arg), search for
another tag that matches the last tagname or regexp used. When there are
multiple matches for a tag, more exact matches are found first. If NEXT-P
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)))
(defun find-tag-other-window (tagname &optional next-p regexp-p)
"Find tag (in current tags table) whose name contains TAGNAME.
Select the buffer containing the tag's definition in another window, and
move point there. The default for TAGNAME is the expression in the buffer
around or before point.
If second arg NEXT-P is t (interactively, with prefix arg), search for
another tag that matches the last tagname or regexp used. When there are
multiple matches for a tag, more exact matches are found first. If NEXT-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: "))
(let* ((window-point (window-point (selected-window)))
(tagbuf (find-tag-noselect tagname next-p regexp-p))
(tagpoint (progn (set-buffer tagbuf) (point))))
(set-window-point (prog1
(selected-window)
(switch-to-buffer-other-window tagbuf)
(set-window-point (selected-window) tagpoint))
window-point)))
(defun find-tag-other-frame (tagname &optional next-p)
"Find tag (in current tags table) whose name contains TAGNAME.
Select the buffer containing the tag's definition in another frame, and
move point there. The default for TAGNAME is the expression in the buffer
around or before point.
If second arg NEXT-P is t (interactively, with prefix arg), search for
another tag that matches the last tagname or regexp used. When there are
multiple matches for a tag, more exact matches are found first. If NEXT-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 frame: "))
(let ((pop-up-frames t))
(find-tag-other-window tagname next-p)))
(defun find-tag-regexp (regexp &optional next-p other-window)
"Find tag (in current tags table) whose name matches REGEXP.
Select the buffer containing the tag's definition and move point there.
If second arg NEXT-P is t (interactively, with prefix arg), search for
another tag that matches the last tagname or regexp used. When there are
multiple matches for a tag, more exact matches are found first. If NEXT-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 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))
(funcall (if other-window 'find-tag-other-window 'find-tag)
regexp next-p t))
(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)))
(defvar tag-lines-already-matched nil)
(defun find-tag-in-order (pattern
search-forward-func
order
next-line-after-failure-p
matching
first-search)
(let (file tag-info (first-table t)
(tag-order order)
(match-marker (make-marker))
goto-func
)
(save-excursion
(if first-search
(setq tag-lines-already-matched nil)
(visit-tags-table-buffer 'same))
(catch 'qualified-match-found
(while (or first-table
(visit-tags-table-buffer t))
(and first-search first-table
(goto-char (point-min)))
(setq first-table nil)
(while order
(while (funcall search-forward-func pattern nil t)
(and (funcall (car order) pattern)
(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)))
(setq order (cdr order))
(goto-char (point-min)))
(setq order tag-order))
(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))
(beginning-of-line)
(setq tag-lines-already-matched (cons match-marker
tag-lines-already-matched))
(setq file (expand-file-name (file-of-tag))
tag-info (funcall snarf-tag-function))
(setq goto-func goto-tag-location-function)
(set-buffer (find-file-noselect file))
(widen)
(push-mark)
(funcall goto-func tag-info)
(current-buffer))))
(defun etags-recognize-tags-table ()
(and (etags-verify-tags-table)
(mapcar (function (lambda (elt)
(set (make-local-variable (car elt)) (cdr elt))))
'((file-of-tag-function . etags-file-of-tag)
(tags-table-files-function . etags-tags-table-files)
(tags-completion-table-function . etags-tags-completion-table)
(snarf-tag-function . etags-snarf-tag)
(goto-tag-location-function . etags-goto-tag-location)
(find-tag-regexp-search-function . re-search-forward)
(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-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)
(tags-included-tables-function . etags-tags-included-tables)
(verify-tags-table-function . etags-verify-tags-table)
))))
(defun etags-verify-tags-table ()
(eq (char-after 1) ?\f))
(defun etags-file-of-tag ()
(save-excursion
(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)))
(save-excursion
(goto-char (point-min))
(while (re-search-forward
"^\\(\\([^\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)
(buffer-substring (match-beginning 5) (match-end 5))
(buffer-substring (match-beginning 3) (match-end 3)))
table)))
table))
(defun etags-snarf-tag ()
(let (tag-text line startpos)
(if (save-excursion
(forward-line -1)
(looking-at "\f\n"))
(setq tag-text t
line nil
startpos 1)
(search-forward "\177")
(setq tag-text (buffer-substring (1- (point))
(save-excursion (beginning-of-line)
(point))))
(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)))))))
(forward-line 1)
(cons tag-text (cons line startpos))))
(defun etags-goto-tag-location (tag-info)
(let ((startpos (cdr (cdr tag-info)))
(line (car (cdr tag-info)))
offset found pat)
(if (eq (car tag-info) t)
(cond (line (goto-line line))
(startpos (goto-char startpos))
(t (error "etags.el BUG: bogus direct file tag")))
(setq offset 1000
found nil
pat (concat (if (eq selective-display t)
"\\(^\\|\^m\\)" "^")
(regexp-quote (car tag-info))))
(if startpos (setq startpos (1+ startpos)))
(or startpos
(if line
(setq startpos (progn (goto-line line)
(point)))))
(or startpos
(setq startpos (point-min)))
(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))) (or found
(re-search-forward pat nil t)
(error "Rerun etags: `%s' not found in %s"
pat buffer-file-name)))
(and (eq selective-display t)
(looking-at "\^m")
(forward-char 1))
(beginning-of-line)))
(defun etags-list-tags (file)
(goto-char 1)
(if (not (search-forward (concat "\f\n" file ",") nil t))
nil
(forward-line 1)
(while (not (or (eobp) (looking-at "\f")))
(let ((tag (buffer-substring (point)
(progn (skip-chars-forward "^\177")
(point)))))
(princ (if (looking-at "[^\n]+\001")
(buffer-substring (1+ (point)) (progn (skip-chars-forward "^\001")
(point)))
tag)))
(terpri)
(forward-line 1))
t))
(defun etags-tags-apropos (string)
(goto-char 1)
(while (re-search-forward string nil t)
(beginning-of-line)
(princ (buffer-substring (point)
(progn (skip-chars-forward "^\177")
(point))))
(terpri)
(forward-line 1)))
(defun etags-tags-table-files ()
(let ((files nil)
beg)
(goto-char (point-min))
(while (search-forward "\f\n" nil t)
(setq beg (point))
(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 ()
(let ((files nil)
beg)
(goto-char (point-min))
(while (search-forward "\f\n" nil t)
(setq beg (point))
(end-of-line)
(skip-chars-backward "^," beg)
(if (looking-at "include$")
(setq files (cons (expand-file-name (buffer-substring beg (1- (point))))
files))))
(nreverse files)))
(defun recognize-empty-tags-table ()
(and (zerop (buffer-size))
(mapcar (function (lambda (sym)
(set (make-local-variable sym) 'ignore)))
'(tags-table-files-function
tags-completion-table-function
find-tag-regexp-search-function
find-tag-search-function
tags-apropos-function
tags-included-tables-function))
(set (make-local-variable 'verify-tags-table-function)
(function (lambda ()
(zerop (buffer-size)))))))
(defun tag-exact-match-p (tag)
(or (and (eq (char-after (point)) ?\001)
(eq (char-after (- (point) (length tag) 1)) ?\177))
(looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001"))))
(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_")))))
(defun tag-word-match-p (tag)
(and (looking-at "\\b.*\177")
(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"))))
(defun tag-any-match-p (tag)
(looking-at ".*\177"))
(defun tag-re-match-p (re)
(save-excursion
(beginning-of-line)
(let ((bol (point)))
(and (search-forward "\177" (save-excursion (end-of-line) (point)) t)
(re-search-backward re bol t)))))
(defcustom tags-loop-revert-buffers nil
"*Non-nil means tags-scanning loops should offer to reread changed files.
These loops normally read each file into Emacs, but when a file
is already visited, they use the existing buffer.
When this flag is non-nil, they offer to revert the existing buffer
in the case where the file has changed since you visited it."
:type 'boolean
:group 'etags)
(defun next-file (&optional initialize novisit)
"Select next file among files in current tags table.
A first argument of t (prefix arg, if interactive) initializes to the
beginning of the list of files in the tags table. If the argument is
neither nil nor t, it is evalled to initialize the list of files.
Non-nil second argument NOVISIT means use a temporary buffer
to save time and avoid uninteresting warnings.
Value is nil if the file was already visited;
if the file was newly read in, the value is the filename."
(interactive (list (if current-prefix-arg t)))
(cond ((not initialize)
)
((eq initialize t)
(save-excursion
(visit-tags-table-buffer)
(setq next-file-list (mapcar 'expand-file-name (tags-table-files)))
(while (visit-tags-table-buffer t)
(let ((tail next-file-list))
(while (cdr tail)
(setq tail (cdr tail)))
(if tail
(setcdr tail (mapcar 'expand-file-name (tags-table-files)))
(setq next-file-list (mapcar 'expand-file-name
(tags-table-files))))))))
(t
(setq next-file-list (eval initialize))))
(if next-file-list
()
(and novisit
(get-buffer " *next-file*")
(kill-buffer " *next-file*"))
(error "All files processed"))
(let* ((next (car next-file-list))
(buffer (get-file-buffer next))
(new (not buffer)))
(setq next-file-list (cdr next-file-list))
(and buffer tags-loop-revert-buffers
(not (verify-visited-file-modtime buffer))
(with-current-buffer buffer
(revert-buffer t)))
(if (not (and new novisit))
(set-buffer (find-file-noselect next novisit))
(set-buffer (get-buffer-create " *next-file*"))
(kill-all-local-variables)
(erase-buffer)
(setq new next)
(insert-file-contents new nil))
new))
(defvar tags-loop-operate nil
"Form for `tags-loop-continue' to eval to change one file.")
(defvar tags-loop-scan
'(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.")
(defun tags-loop-continue (&optional first-time)
"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
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))
(while
(progn
(while (or first-time
(save-restriction
(widen)
(not (eval tags-loop-scan))))
(setq new (next-file first-time t))
(if (or messaged
(and (not first-time)
(> baud-rate search-slow-speed)
(setq messaged t)))
(message "Scanning file %s..." (or new buffer-file-name)))
(setq first-time nil)
(goto-char (point-min)))
(if new
(let ((pos (point)))
(erase-buffer)
(set-buffer (find-file-noselect new))
(setq new nil) (widen)
(goto-char pos)))
(switch-to-buffer (current-buffer))
(eval tags-loop-operate)))
(and messaged
(null tags-loop-operate)
(message "Scanning file %s...found" buffer-file-name))))
(defun tags-search (regexp &optional file-list-form)
"Search through all files listed in tags table for match for REGEXP.
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue].
See documentation of variable `tags-file-name'."
(interactive "sTags search (regexp): ")
(if (and (equal regexp "")
(eq (car tags-loop-scan) 're-search-forward)
(null tags-loop-operate))
(tags-loop-continue nil)
(setq tags-loop-scan
(list 're-search-forward (list 'quote regexp) nil t)
tags-loop-operate nil)
(tags-loop-continue (or file-list-form t))))
(defun tags-query-replace (from to &optional delimited file-list-form)
"Query-replace-regexp FROM with TO through all files listed in tags table.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
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 (query-replace-read-args "Tags query replace (regexp)" t))
(setq tags-loop-scan (list 'prog1
(list 'if (list 're-search-forward
(list 'quote from) nil t)
'(goto-char (match-beginning 0))))
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
(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))))
(defun list-tags (file &optional next-match)
"Display list of tags in file FILE.
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: "
'tags-complete-tags-table-file
nil t nil)))
(with-output-to-temp-buffer "*Tags List*"
(princ "Tags in file ")
(princ file)
(terpri)
(save-excursion
(let ((first-time t)
(gotany nil))
(while (visit-tags-table-buffer (not first-time))
(setq first-time nil)
(if (funcall list-tags-function file)
(setq gotany t)))
(or gotany
(error "File %s not in current tags tables" file))))))
(defun tags-apropos (regexp)
"Display list of all tags in tags table REGEXP matches."
(interactive "sTags apropos (regexp): ")
(with-output-to-temp-buffer "*Tags List*"
(princ "Tags matching regexp ")
(prin1 regexp)
(terpri)
(save-excursion
(let ((first-time t))
(while (visit-tags-table-buffer (not first-time))
(setq first-time nil)
(funcall tags-apropos-function regexp))))))
(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-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)
(let ((set-list tags-table-set-list)
(desired-point nil))
(if tags-table-list
(progn
(setq desired-point (point-marker))
(princ tags-table-list (current-buffer))
(insert "\C-m")
(prin1 (car tags-table-list) (current-buffer)) (insert "\n")))
(while set-list
(if (eq (car set-list) tags-table-list)
()
(princ (car set-list) (current-buffer))
(insert "\C-m")
(prin1 (car (car set-list)) (current-buffer)) (insert "\n"))
(setq set-list (cdr set-list)))
(if tags-file-name
(progn
(or desired-point
(setq desired-point (point-marker)))
(insert tags-file-name "\C-m")
(prin1 tags-file-name (current-buffer)) (insert "\n")))
(setq set-list (delete tags-file-name
(apply 'nconc (cons (copy-sequence tags-table-list)
(mapcar 'copy-sequence
tags-table-set-list)))))
(while set-list
(insert (car set-list) "\C-m")
(prin1 (car set-list) (current-buffer)) (insert "\n")
(setq set-list (delete (car set-list) set-list)))
(goto-char 1)
(insert-before-markers
"Type `t' to select a tags table or set of tags tables:\n\n")
(if desired-point
(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")
(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)
(search-forward "\C-m")
(let ((name (read (current-buffer))))
(visit-tags-table name)
(select-tags-table-quit)
(message "Tags table now %s" name)))
(defun select-tags-table-quit ()
"Kill the buffer and delete the selected window."
(interactive)
(quit-window t (selected-window)))
(defun complete-tag ()
"Perform tags completion on the text around point.
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 "%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)))
beg
completion)
(or pattern
(error "Nothing to complete"))
(search-backward pattern)
(setq beg (point))
(forward-char (length pattern))
(setq completion (try-completion pattern 'tags-complete-tag nil))
(cond ((eq completion t))
((null completion)
(message "Can't find completion for \"%s\"" pattern)
(ding))
((not (string= pattern completion))
(delete-region beg (point))
(insert completion))
(t
(message "Making completion list...")
(with-output-to-temp-buffer "*Completions*"
(display-completion-list
(all-completions pattern 'tags-complete-tag nil)))
(message "Making completion list...%s" "done")))))
(provide 'etags)