;;; etags.el --- etags facility for Emacs
-
-;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995
+;; 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 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-file-order nil
- "Function which checks for complete and correct match, for file name as tag.")
(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
(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
(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
(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)))
(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.
+ ;; included the one we found.
could-be))))
;; Subroutine of visit-tags-table-buffer. Move tags-table-list-pointer
(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: "))
(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)
- (search-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)
;; Record the location so we can pop back to it later.
(let ((marker (make-marker)))
(save-excursion
- (setq search-tag (if next-p last-tag tagname))
(set-buffer
;; find-tag-in-order does the real work.
(find-tag-in-order
find-tag-search-function)
(if regexp-p
find-tag-regexp-tag-order
- (if (string-match "\\b.*\\.\\w*" search-tag)
- find-tag-file-order
- find-tag-tag-order))
+ find-tag-tag-order)
(if regexp-p
find-tag-regexp-next-line-after-failure-p
find-tag-next-line-after-failure-p)
(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
- match-type
)
(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.
- (setq match-type
- (catch 'qualified-match-found
+ (catch 'qualified-match-found
;; Iterate over the list of tags tables.
(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)))
- (or first-table
- (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)))
-
+ 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))
(set-buffer (find-file-noselect file))
(widen)
(push-mark)
- (if (eq match-type 'tag-filename-match-p)
- (goto-char (point-min))
- (funcall goto-func tag-info))
-
+ (funcall goto-func tag-info)
+
;; 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-filename-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-file-order . (tag-filename-match-p))
(find-tag-next-line-after-failure-p . nil)
(list-tags-function . etags-list-tags)
(tags-apropos-function . etags-tags-apropos)
(defun etags-file-of-tag ()
(save-excursion
- (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))))
+ (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 ()
(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)))))
- ;; 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))
+ (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-filename-match-p (tag)
+(defun tag-exact-file-name-match-p (tag)
(and (looking-at ",")
- (save-excursion (backward-char (1+ (length tag)))
- (looking-at "\\b"))))
+ (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)
(save-excursion
;; Visit the tags table buffer to get its list of files.
(visit-tags-table-buffer)
- ;; Copy the list so we can setcdr below.
- (setq next-file-list (copy-sequence (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)
;; Use a copy so the next loop iteration will not modify the
;; list later returned by (tags-table-files).
(if tail
- (setcdr tail (copy-sequence (tags-table-files)))
- (setq next-file-list (copy-sequence (tags-table-files))))))))
+ (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))))
(and novisit
(get-buffer " *next-file*")
(kill-buffer " *next-file*"))
- (error "All files processed."))
+ (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.
"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.")
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 (filename &optional next-match)
- "Gives the list of functions available in file \"filename\"
-Searches only in \"tags-file-name\"."
- (interactive "sFunctions in File: ")
- (let (file-list)
- (setq file-list (tags-locate-file-in-tags-table filename
- (if next-match next-match nil)))
- (if file-list
- (tags-list-functions-in-file (nth 1 (car file-list))
- (nth 2 (car file-list)))
- (message (format "%s not found in tags table" filename)))))
+(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))))))
;;;###autoload
(defun tags-apropos (regexp)
(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
-(defun tags-list-functions-in-file (pos tag-file)
- "Lists the functions for the given file. Backend for `list-tags'."
- (let ((tag-buf (find-file-noselect tag-file))
- (result-buf (get-buffer-create "*Tags Function List*"))
- function
- beg
- map)
- (save-excursion
- (set-buffer result-buf)
- (erase-buffer)
- (set-buffer tag-buf)
- (goto-char pos)
- (forward-line 1)
- (beginning-of-line)
- ; C-l marks end of information of a file in TAGS.
- (while (and (not (looking-at "^\C-l")) (not (eobp)))
- ; skip mere #defines, typedefs and struct definitions
- (if (not (or (looking-at "^#define\\s-+[a-zA-Z0-9_]+\\s-+")
- (looking-at "^typedef\\s-+")
- (looking-at "^\\s-*}")))
- (progn
- (setq beg (point))
- (skip-chars-forward "^\C-?(")
- (setq function (buffer-substring beg (point)))
- (save-excursion
- (set-buffer result-buf)
- (insert (concat function "\n")))))
- (forward-line 1)
- (beginning-of-line)))
- (switch-to-buffer "*Tags Function List*")
- (goto-char 1)
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)))
-
-(defun tags-locate-file-in-tags-table (filename first-search)
- "This function is used to locate `filename' in `tags-table-list'.
- Its internally used by the functions `find-file-from-tags' and
- `tags-list-tags-in-file'. If `first-search' is t, search continues from where
- it left off last time. Else, its a fresh search."
- (let (tag-list current-tags-buffer beg file found-file-list next-tag-file)
- (setq tag-list tags-table-list)
- (catch 'found-file
- (setq found-file-list nil
- next-tag-file nil)
- (while tag-list
- (setq current-tags-buffer (find-file-noselect (car tag-list)))
- (save-excursion
- (set-buffer current-tags-buffer)
- (if (or next-tag-file
- (not first-search))
- (goto-char (point-min)))
- (if (search-forward filename nil t)
- (if (tag-filename-match-p filename)
- (progn
- (beginning-of-line)
- (setq beg (point))
- (skip-chars-forward "^,")
- (or (looking-at ",include$")
- (setq file (expand-file-name (buffer-substring beg
- (point)))))
- (if (string-match filename (file-name-nondirectory file))
- (progn
- (setq found-file-list (cons (list file (point)
- (buffer-file-name))
- found-file-list))
- (throw 'found-file found-file-list))))))
- (setq tag-list (cdr tag-list))
- (setq next-tag-file 't)))
- (throw 'found-file found-file-list))))
-
(provide 'etags)
;;; etags.el ends here