;;; etags.el --- etags facility for Emacs
-;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998
+
+;; Copyright (C) 1985, 86, 88, 89, 92, 93, 94, 95, 96, 98, 2000, 2001
;; Free Software Foundation, Inc.
-;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
+;; Author: Roland McGrath <roland@gnu.org>
+;; Maintainer: FSF
;; Keywords: tools
;; This file is part of GNU Emacs.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(require 'ring)
+(require 'button)
;;;###autoload
(defvar tags-file-name nil
;; 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 "Tags tables"
+(defgroup etags nil "Tags tables"
:group 'tools)
+;;;###autoload
+(defcustom tags-case-fold-search 'default
+ "*Whether tags operations should be case-sensitive.
+A value of t means case-insensitive, a value of nil means case-sensitive.
+Any other value means use the setting of `case-fold-search'."
+ :group 'etags
+ :type '(choice (const :tag "Case-sensitive" nil)
+ (const :tag "Case-insensitive" t)
+ (other :tag "Use default" default))
+ :version "21.1")
+
;;;###autoload
;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
(defcustom tags-table-list nil
:group 'etags
:type '(repeat file))
+;;;###autoload
+(defcustom tags-compression-info-list '("" ".Z" ".bz2" ".gz" ".tgz")
+ "*List of extensions tried by etags when jka-compr is used.
+An empty string means search the non-compressed file.
+These extensions will be tried only if jka-compr was activated
+\(i.e. via customize of `auto-compression-mode' or by calling the function
+`auto-compression-mode')."
+ :type '(repeat string)
+ :group 'etags)
+
+;; !!! tags-compression-info-list should probably be replaced by access
+;; to directory list and matching jka-compr-compression-info-list. Currently,
+;; this implementation forces each modification of
+;; jka-compr-compression-info-list to be reflected in this var.
+;; An alternative could be to say that introducing a special
+;; element in this list (e.g. t) means : try at this point
+;; using directory listing and regexp matching using
+;; jka-compr-compression-info-list.
+
+
;;;###autoload
(defcustom tags-add-tables 'ask-user
"*Control whether to add a new tags table to the current list.
:group 'etags
:type '(choice (const :tag "Do" t)
(const :tag "Don't" nil)
- (const :tag "Ask" ask-user)))
+ (other :tag "Ask" ask-user)))
(defcustom tags-revert-without-query nil
"*Non-nil means reread a TAGS table without querying, if it has changed."
"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
+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'.")
has a `find-tag-default-function' property (see `put'), that is used.
Otherwise, `find-tag-default' is used."
:group 'etags
- :type 'function)
+ :type '(choice (const nil) function))
(defcustom find-tag-marker-ring-length 16
"*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
:group 'etags
- :type 'integer)
+ :type 'integer
+ :version "20.3")
+
+(defcustom tags-tag-face 'default
+ "*Face for tags in the output of `tags-apropos'."
+ :group 'etags
+ :type 'face
+ :version "21.1")
+
+(defcustom tags-apropos-verbose nil
+ "If non-nil, print the name of the tags file in the *Tags List* buffer."
+ :group 'etags
+ :type 'boolean
+ :version "21.1")
+
+(defcustom tags-apropos-additional-actions nil
+ "Specify additional actions for `tags-apropos'.
+
+If non-nil, value should be a list of triples (TITLE FUNCTION
+TO-SEARCH). For each triple, `tags-apropos' processes TO-SEARCH and
+lists tags from it. TO-SEARCH should be an alist, obarray, or symbol.
+If it is a symbol, the symbol's value is used.
+TITLE, a string, is a title used to label the additional list of tags.
+FUNCTION is a function to call when a symbol is selected in the
+*Tags List* buffer. It will be called with one argument SYMBOL which
+is the symbol being selected.
+
+Example value:
+
+ '((\"Emacs Lisp\" Info-goto-emacs-command-node obarray)
+ (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray)
+ (\"SCWM\" scwm-documentation scwm-obarray))"
+ :group 'etags
+ :type '(repeat (list (string :tag "Title")
+ function
+ (sexp :tag "Tags to search")))
+ :version "21.1")
(defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length)
"Ring of markers which are locations from which \\[find-tag] was invoked.")
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.")
+ "Obarray of tag names defined in current tags table.")
(defvar tags-included-tables nil
"List of tags tables included by the current tags table.")
\f
;; Hooks for file formats.
-(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.
+(defvar tags-table-format-functions '(etags-recognize-tags-table
+ tags-recognize-empty-tags-table)
+ "Hook 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).")
+ "Function to do the work of `file-of-tag' (which see).
+One optional argument, a boolean specifying to return complete path (nil) or
+relative path (non-nil).")
(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.")
+ "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'.")
+ "Function to get info about a matched tag for `goto-tag-location-function'.
+One optional argument, specifying to use explicit tag (non-nil) or not (nil).
+The default is nil.")
(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'.")
(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))
+ ;; We used to initialize find-tag-marker-ring and tags-location-ring
+ ;; here, to new empty rings. But that is wrong, because those
+ ;; are global.
+
;; Value is t if we have found a valid tags table buffer.
- (let ((hooks tags-table-format-hooks))
- (while (and hooks
- (not (funcall (car hooks))))
- (setq hooks (cdr hooks)))
- hooks))
+ (run-hook-with-args-until-success 'tags-table-format-functions))
;;;###autoload
(defun visit-tags-table (file &optional local)
;; Set tags-file-name to the name from the list. It is already expanded.
(setq tags-file-name (car tags-table-list-pointer))))
+;;;###autoload
(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.
;; Expand the table name into a full file name.
(setq tags-file-name (tags-expand-table-name tags-file-name))
- (if (and (eq cont t)
- (null tags-table-list-pointer))
- ;; All out of tables.
- nil
-
+ (unless (and (eq cont t) (null tags-table-list-pointer))
;; Verify that tags-file-name names a valid tags table.
;; Bind another variable with the value of tags-file-name
;; before we switch buffers, in case tags-file-name is buffer-local.
(setq tags-table-set-list
(cons tags-table-list
tags-table-set-list)))
+ ;; Clear out buffers holding old tables.
+ (dolist (table tags-table-list)
+ ;; The list can contain items `t'.
+ (if (stringp table)
+ (let ((buffer (find-buffer-visiting table)))
+ (if buffer
+ (kill-buffer buffer)))))
(setq tags-table-list (list local-tags-file-name))))
;; Recompute tags-table-computed-list.
(defun tags-reset-tags-tables ()
"Reset tags state to cancel effect of any previous \\[visit-tags-table] or \\[find-tag]."
(interactive)
+ ;; Clear out the markers we are throwing away.
+ (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 (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-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-started-at nil
tags-table-set-list nil))
\f
-(defun file-of-tag ()
+(defun file-of-tag (&optional relative)
"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))
+If RELATIVE is non-nil, file name returned is relative to tags
+table file's directory. If RELATIVE is nil, file name returned
+is complete."
+ (funcall file-of-tag-function relative))
;;;###autoload
(defun tags-table-files ()
;; Recurse in that buffer to compute its completion table.
(if (tags-completion-table)
;; Combine the tables.
- (mapatoms (function
- (lambda (sym)
- (intern (symbol-name sym) table)))
+ (mapatoms (lambda (sym) (intern (symbol-name sym) table))
tags-completion-table))
(setq included (cdr included))))
(setq tags-completion-table table))
(all-completions string (tags-completion-table) predicate)
(try-completion string (tags-completion-table) predicate))))
\f
-;; Return a default tag to search for, based on the text at point.
-(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)))
-
;; Read a tag name from the minibuffer with defaulting and completion.
(defun find-tag-tag (string)
- (let* ((default (funcall (or find-tag-default-function
+ (let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
+ tags-case-fold-search
+ case-fold-search))
+ (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)
+ (format "%s (default %s): "
+ (substring string 0 (string-match "[ :]+\\'" string))
+ default)
string)
'tags-complete-tag
nil nil nil nil default)))
;; Get interactive args for find-tag{-noselect,-other-window,-regexp}.
(defun find-tag-interactive (prompt &optional no-default)
- (if current-prefix-arg
+ (if (and current-prefix-arg last-tag)
(list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
'-
t))
(defvar find-tag-history nil)
+;; Dynamic bondage:
+(eval-when-compile
+ (defvar etags-case-fold-search)
+ (defvar etags-syntax-table))
+
;;;###autoload
(defun find-tag-noselect (tagname &optional next-p regexp-p)
"Find tag (in current tags table) whose name contains TAGNAME.
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
+A marker representing the point when this command is invoked 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.
(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.
+ ;; Save the current buffer's value of `find-tag-hook' before
+ ;; selecting the tags table buffer. For the same reason, save value
+ ;; of `tags-file-name' in case it has a buffer-local value.
(let ((local-find-tag-hook find-tag-hook))
(if (eq '- next-p)
;; Pop back to a previous location.
(run-hooks 'local-find-tag-hook))))
;; Record whence we came.
(ring-insert find-tag-marker-ring (point-marker))
- (if next-p
+ (if (and next-p last-tag)
;; Find the same table we last used.
(visit-tags-table-buffer 'same)
;; Pick a table to use.
(set-buffer
;; find-tag-in-order does the real work.
(find-tag-in-order
- (if next-p last-tag tagname)
+ (if (and next-p last-tag) last-tag tagname)
(if regexp-p
find-tag-regexp-search-function
find-tag-search-function)
find-tag-regexp-next-line-after-failure-p
find-tag-next-line-after-failure-p)
(if regexp-p "matching" "containing")
- (not next-p)))
+ (or (not next-p) (not last-tag))))
(set-marker marker (point))
(run-hooks 'local-find-tag-hook)
(ring-insert tags-location-ring marker)
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
+A marker representing the point when this command is invoked 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)))
+ (let* ((buf (find-tag-noselect tagname next-p regexp-p))
+ (pos (with-current-buffer buf (point))))
+ (condition-case nil
+ (switch-to-buffer buf)
+ (error (pop-to-buffer buf)))
+ (goto-char pos)))
;;;###autoload (define-key esc-map "." 'find-tag)
;;;###autoload
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
+A marker representing the point when this command is invoked 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.
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
+A marker representing the point when this command is invoked 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.
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
+A marker representing the point when this command is invoked 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.
;; any member of the function list ORDER (third arg). If ORDER is nil,
;; use saved state to continue a previous search.
-;; Fourth arg MATCHING is a string, an English '-ing' word, to be used in
-;; an error message.
-
-;; Fifth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
+;; Fourth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
;; point should be moved to the next line.
+;; Fifth arg MATCHING is a string, an English '-ing' word, to be used in
+;; an error message.
+
;; Algorithm is as follows. For each qualifier-func in ORDER, go to
;; beginning of tags file, and perform inner loop: for each naive match for
;; PATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using
(tag-order order)
(match-marker (make-marker))
goto-func
+ (case-fold-search (if (memq tags-case-fold-search '(nil t))
+ tags-case-fold-search
+ case-fold-search))
)
(save-excursion
(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))
+ ;; We should be able to search for file-name backwards in file-of-tag:
+ ;; the beginning-of-line is ok except when positioned on a "file-name" tag.
+ (setq file (expand-file-name
+ (if (memq (car order) '(tag-exact-file-name-match-p
+ tag-file-name-match-p
+ tag-partial-file-name-match-p))
+ (save-excursion (next-line 1)
+ (file-of-tag))
+ (file-of-tag)))
tag-info (funcall snarf-tag-function))
;; Get the local value in the tags table buffer before switching buffers.
(setq goto-func goto-tag-location-function)
-
- ;; Find the right line in the specified file.
- (set-buffer (find-file-noselect file))
+ (tag-find-file-of-tag-noselect file)
(widen)
(push-mark)
(funcall goto-func tag-info)
;; Return the buffer where the tag was found.
(current-buffer))))
+
+(defun tag-find-file-of-tag-noselect (file)
+ ;; Find the right line in the specified file.
+ ;; If we are interested in compressed-files,
+ ;; we search files with extensions.
+ ;; otherwise only the real file.
+ (let* ((buffer-search-extensions (if (featurep 'jka-compr)
+ tags-compression-info-list
+ '("")))
+ the-buffer
+ (file-search-extensions buffer-search-extensions))
+ ;; search a buffer visiting the file with each possible extension
+ ;; Note: there is a small inefficiency in find-buffer-visiting :
+ ;; truename is computed even if not needed. Not too sure about this
+ ;; but I suspect truename computation accesses the disk.
+ ;; It is maybe a good idea to optimise this find-buffer-visiting.
+ ;; An alternative would be to use only get-file-buffer
+ ;; but this looks less "sure" to find the buffer for the file.
+ (while (and (not the-buffer) buffer-search-extensions)
+ (setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions))))
+ (setq buffer-search-extensions (cdr buffer-search-extensions)))
+ ;; if found a buffer but file modified, ensure we re-read !
+ (if (and the-buffer (not (verify-visited-file-modtime the-buffer)))
+ (find-file-noselect (buffer-file-name the-buffer)))
+ ;; if no buffer found, search for files with possible extensions on disk
+ (while (and (not the-buffer) file-search-extensions)
+ (if (not (file-exists-p (concat file (car file-search-extensions))))
+ (setq file-search-extensions (cdr file-search-extensions))
+ (setq the-buffer (find-file-noselect (concat file (car file-search-extensions))))))
+ (if (not the-buffer)
+ (if (featurep 'jka-compr)
+ (error "File %s (with or without extensions %s) not found" file tags-compression-info-list)
+ (error "File %s not found" file))
+ (set-buffer the-buffer))))
+
+(defun tag-find-file-of-tag (file)
+ (let ((buf (tag-find-file-of-tag-noselect file)))
+ (condition-case nil
+ (switch-to-buffer buf)
+ (error (pop-to-buffer buf)))))
\f
;; `etags' TAGS file format support.
;; It is annoying to flash messages on the screen briefly,
;; and this message is not useful. -- rms
;; (message "%s is an `etags' TAGS file" buffer-file-name)
- (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)
- ))))
+ (mapc (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-file-name-match-p
+ tag-exact-match-p
+ tag-implicit-name-match-p
+ tag-symbol-match-p
+ tag-word-match-p
+ tag-partial-file-name-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)
+ ))))
;; Return non-nil iff the current buffer is a valid etags TAGS file.
(defun etags-verify-tags-table ()
;; Use eq instead of = in case char-after returns nil.
- (eq (char-after 1) ?\f))
+ (eq (char-after (point-min)) ?\f))
-(defun etags-file-of-tag ()
+(defun etags-file-of-tag (&optional relative)
(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))))
+ (let ((str (buffer-substring (match-beginning 1) (match-end 1))))
+ (if relative
+ str
+ (expand-file-name str
+ (file-truename default-directory))))))
(defun etags-tags-completion-table ()
- (let ((table (make-vector 511 0)))
+ (let ((table (make-vector 511 0))
+ (progress-reporter
+ (make-progress-reporter
+ (format "Making tags completion table for %s..." buffer-file-name)
+ (point-min) (point-max))))
(save-excursion
(goto-char (point-min))
;; This monster regexp matches an etags tag line.
;; \6 is the line to start searching at;
;; \7 is the char to start searching at.
(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"
+ "^\\(\\([^\177]+[^-a-zA-Z0-9_+*$:\177]+\\)?\
+\\([-a-zA-Z0-9_+*$?:]+\\)[^-a-zA-Z0-9_+*$?:\177]*\\)\177\
+\\(\\([^\n\001]+\\)\001\\)?\\([0-9]+\\)?,\\([0-9]+\\)?\n"
nil t)
- (intern (if (match-beginning 5)
- ;; There is an explicit tag name.
- (buffer-substring (match-beginning 5) (match-end 5))
- ;; No explicit tag name. Best guess.
- (buffer-substring (match-beginning 3) (match-end 3)))
+ (intern (prog1 (if (match-beginning 5)
+ ;; There is an explicit tag name.
+ (buffer-substring (match-beginning 5) (match-end 5))
+ ;; No explicit tag name. Best guess.
+ (buffer-substring (match-beginning 3) (match-end 3)))
+ (progress-reporter-update progress-reporter (point)))
table)))
table))
-(defun etags-snarf-tag ()
- (let (tag-text line startpos)
+(defun etags-snarf-tag (&optional use-explicit)
+ (let (tag-text line startpos explicit-start)
(if (save-excursion
(forward-line -1)
(looking-at "\f\n"))
;; the beginning of the file.
(setq tag-text t
line nil
- startpos 1)
+ startpos (point-min))
;; 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 use-explicit is non nil and explicit tag is present, use it as part of
+ ;; return value. Else just skip it.
+ (setq explicit-start (point))
+ (when (and (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
+ use-explicit)
+ (setq tag-text (buffer-substring explicit-start (1- (point)))))
+
+
(if (looking-at "[0-9]")
(setq line (string-to-int (buffer-substring
(point)
(beginning-of-line)))
(defun etags-list-tags (file)
- (goto-char 1)
- (if (not (search-forward (concat "\f\n" file ",") nil t))
- nil
+ (goto-char (point-min))
+ (when (re-search-forward (concat "\f\n" "\\(" file "\\)" ",") nil t)
+ (let ((path (save-excursion (forward-line 1) (file-of-tag)))
+ ;; Get the local value in the tags table
+ ;; buffer before switching buffers.
+ (goto-func goto-tag-location-function)
+ tag tag-info pt)
(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")
- ;; There is an explicit tag name; use that.
- (buffer-substring (1+ (point)) ;skip \177
- (progn (skip-chars-forward "^\001")
- (point)))
- tag)))
+ (setq tag-info (save-excursion (funcall snarf-tag-function t))
+ tag (car tag-info)
+ pt (with-current-buffer standard-output (point)))
+ (princ tag)
+ (when (= (aref tag 0) ?\() (princ " ...)"))
+ (with-current-buffer standard-output
+ (make-text-button pt (point)
+ 'tag-info tag-info
+ 'file-path path
+ 'goto-func goto-func
+ 'action (lambda (button)
+ (let ((tag-info (button-get button 'tag-info))
+ (goto-func (button-get button 'goto-func)))
+ (tag-find-file-of-tag (button-get button 'file-path))
+ (widen)
+ (funcall goto-func tag-info)))
+ 'face 'tags-tag-face
+ 'type 'button))
(terpri)
(forward-line 1))
- t))
+ t)))
+
+(defmacro tags-with-face (face &rest body)
+ "Execute BODY, give output to `standard-output' face FACE."
+ (let ((pp (make-symbol "start")))
+ `(let ((,pp (with-current-buffer standard-output (point))))
+ ,@body
+ (put-text-property ,pp (with-current-buffer standard-output (point))
+ 'face ,face standard-output))))
+
+(defun etags-tags-apropos-additional (regexp)
+ "Display tags matching REGEXP from `tags-apropos-additional-actions'."
+ (with-current-buffer standard-output
+ (dolist (oba tags-apropos-additional-actions)
+ (princ "\n\n")
+ (tags-with-face 'highlight (princ (car oba)))
+ (princ":\n\n")
+ (let* ((beg (point))
+ (symbs (car (cddr oba)))
+ (ins-symb (lambda (sy)
+ (let ((sn (symbol-name sy)))
+ (when (string-match regexp sn)
+ (make-text-button (point)
+ (progn (princ sy) (point))
+ 'action-internal(cadr oba)
+ 'action (lambda (button) (funcall
+ (button-get button 'action-internal)
+ (button-get button 'item)))
+ 'item sn
+ 'face tags-tag-face
+ 'type 'button)
+ (terpri))))))
+ (when (symbolp symbs)
+ (if (boundp symbs)
+ (setq symbs (symbol-value symbs))
+ (insert "symbol `" (symbol-name symbs) "' has no value\n")
+ (setq symbs nil)))
+ (if (vectorp symbs)
+ (mapatoms ins-symb symbs)
+ (dolist (sy symbs)
+ (funcall ins-symb (car sy))))
+ (sort-lines nil beg (point))))))
(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)))
+ (when tags-apropos-verbose
+ (princ "Tags in file `")
+ (tags-with-face 'highlight (princ buffer-file-name))
+ (princ "':\n\n"))
+ (goto-char (point-min))
+ (let ((progress-reporter (make-progress-reporter
+ (format "Making tags apropos buffer for `%s'..."
+ string)
+ (point-min) (point-max))))
+ (while (re-search-forward string nil t)
+ (progress-reporter-update progress-reporter (point))
+ (beginning-of-line)
+
+ (let* ( ;; Get the local value in the tags table
+ ;; buffer before switching buffers.
+ (goto-func goto-tag-location-function)
+ (tag-info (save-excursion (funcall snarf-tag-function)))
+ (tag (if (eq t (car tag-info)) nil (car tag-info)))
+ (file-path (save-excursion (if tag (file-of-tag)
+ (save-excursion (next-line 1)
+ (file-of-tag)))))
+ (file-label (if tag (file-of-tag t)
+ (save-excursion (next-line 1)
+ (file-of-tag t))))
+ (pt (with-current-buffer standard-output (point))))
+ (if tag
+ (progn
+ (princ (format "[%s]: " file-label))
+ (princ tag)
+ (when (= (aref tag 0) ?\() (princ " ...)"))
+ (with-current-buffer standard-output
+ (make-text-button pt (point)
+ 'tag-info tag-info
+ 'file-path file-path
+ 'goto-func goto-func
+ 'action (lambda (button)
+ (let ((tag-info (button-get button 'tag-info))
+ (goto-func (button-get button 'goto-func)))
+ (tag-find-file-of-tag (button-get button 'file-path))
+ (widen)
+ (funcall goto-func tag-info)))
+ 'face 'tags-tag-face
+ 'type 'button)))
+ (princ (format "- %s" file-label))
+ (with-current-buffer standard-output
+ (make-text-button pt (point)
+ 'file-path file-path
+ 'action (lambda (button)
+ (tag-find-file-of-tag (button-get button 'file-path))
+ ;; Get the local value in the tags table
+ ;; buffer before switching buffers.
+ (goto-char (point-min)))
+ 'face 'tags-tag-face
+ 'type 'button))
+ ))
+ (terpri)
+ (forward-line 1))
+ (message nil))
+ (when tags-apropos-verbose (princ "\n")))
(defun etags-tags-table-files ()
(let ((files nil)
;; Recognize an empty file and give it local values of the tags table format
;; variables which do nothing.
-(defun recognize-empty-tags-table ()
+(defun tags-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))
+ (mapc (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)))))))
+ (lambda () (zerop (buffer-size))))))
\f
-;;; Match qualifier functions for tagnames.
-;;; XXX these functions assume etags file format.
+;; Match qualifier functions for tagnames.
+;; These functions assume the etags file format defined in etc/ETAGS.EBNF.
;; This might be a neat idea, but it's too hairy at the moment.
;;(defmacro tags-with-syntax (&rest body)
-;; (` (let ((current (current-buffer))
+;; `(let ((current (current-buffer))
;; (otable (syntax-table))
;; (buffer (find-file-noselect (file-of-tag)))
;; table)
;; (setq table (syntax-table))
;; (set-buffer current)
;; (set-syntax-table table)
-;; (,@ body))
-;; (set-syntax-table otable)))))
+;; ,@body)
+;; (set-syntax-table otable))))
;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form))
+;; exact file name match, i.e. searched tag must match complete file
+;; name including directories parts if there are some.
+(defun tag-exact-file-name-match-p (tag)
+ (and (looking-at ",[0-9\n]")
+ (save-excursion (backward-char (+ 2 (length tag)))
+ (looking-at "\f\n"))))
+;; file name match as above, but searched tag must match the file
+;; name not including the directories if there are some.
+(defun tag-file-name-match-p (tag)
+ (and (looking-at ",[0-9\n]")
+ (save-excursion (backward-char (1+ (length tag)))
+ (looking-at "/"))))
+;; this / to detect we are after a directory separator is ok for unix,
+;; is there a variable that contains the regexp for directory separator
+;; on whatever operating system ?
+;; Looks like ms-win will lose here :).
+
;; t if point is at a tag line that matches TAG exactly.
;; point should be just after a string that matches TAG.
(defun tag-exact-match-p (tag)
;; We are not on the explicit tag name, but perhaps it follows.
(looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001"))))
+;; t if point is at a tag line that has an implicit name.
+;; point should be just after a string that matches TAG.
+(defun tag-implicit-name-match-p (tag)
+ ;; Look at the comment of the make_tag function in lib-src/etags.c for
+ ;; a textual description of the four rules.
+ (and (string-match "^[^ \t()=,;]+$" tag) ;rule #1
+ (looking-at "[ \t()=,;]?\177") ;rules #2 and #4
+ (save-excursion
+ (backward-char (1+ (length tag)))
+ (looking-at "[\n \t()=,;]")))) ;rule #3
+
;; t if point is at a tag line that matches TAG as a symbol.
;; point should be just after a string that matches TAG.
(defun tag-symbol-match-p (tag)
(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"))))
+;; partial file name match, i.e. searched tag must match a substring
+;; of the file name (potentially including a directory separator).
+(defun tag-partial-file-name-match-p (tag)
+ (and (looking-at ".*,[0-9\n]")
+ (save-excursion (beginning-of-line)
+ (backward-char 2)
+ (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)
(and (search-forward "\177" (save-excursion (end-of-line) (point)) t)
(re-search-backward re bol t)))))
\f
+(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)
+
;;;###autoload
(defun next-file (&optional initialize novisit)
"Select next file among files in current tags table.
(t
;; Initialize the list by evalling the argument.
(setq next-file-list (eval initialize))))
- (if next-file-list
- ()
+ (unless 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))))
+ (buffer (get-file-buffer next))
+ (new (not buffer)))
;; 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))
+ ;; Optionally offer to revert buffers
+ ;; if the files have changed on disk.
+ (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))
;; Like find-file, but avoids random warning messages.
If it returns non-nil, this file needs processing by evalling
\`tags-loop-operate'. Otherwise, move on to the next file.")
+(defun tags-loop-eval (form)
+ "Evaluate FORM and return its result.
+Bind `case-fold-search' during the evaluation, depending on the value of
+`tags-case-fold-search'."
+ (let ((case-fold-search (if (memq tags-case-fold-search '(t nil))
+ tags-case-fold-search
+ case-fold-search)))
+ (eval form)))
+
+
;;;###autoload
(defun tags-loop-continue (&optional first-time)
"Continue last \\[tags-search] or \\[tags-query-replace] command.
nil, we exit; otherwise we scan the next file."
(interactive)
(let (new
+ ;; Non-nil means we have finished one file
+ ;; and should not scan it again.
+ file-finished
+ original-point
(messaged nil))
(while
(progn
;; Scan files quickly for the first or next interesting one.
- (while (or first-time
+ ;; This starts at point in the current buffer.
+ (while (or first-time file-finished
(save-restriction
(widen)
- (not (eval tags-loop-scan))))
+ (not (tags-loop-eval tags-loop-scan))))
+ ;; If nothing was found in the previous file, and
+ ;; that file isn't in a temp buffer, restore point to
+ ;; where it was.
+ (when original-point
+ (goto-char original-point))
+
+ (setq file-finished nil)
(setq new (next-file first-time t))
+
;; If NEW is non-nil, we got a temp buffer,
;; and NEW is the file name.
- (if (or messaged
- (and (not first-time)
- (> baud-rate search-slow-speed)
- (setq messaged t)))
- (message "Scanning file %s..." (or new buffer-file-name)))
+ (when (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)
+ (setq original-point (if new nil (point)))
(goto-char (point-min)))
;; If we visited it in a temp buffer, visit it now for real.
(set-buffer (find-file-noselect new))
(setq new nil) ;No longer in a temp buffer.
(widen)
- (goto-char pos)))
+ (goto-char pos))
+ (push-mark original-point t))
(switch-to-buffer (current-buffer))
;; Now operate on the file.
;; If value is non-nil, continue to scan the next file.
- (eval tags-loop-operate)))
+ (tags-loop-eval tags-loop-operate))
+ (setq file-finished t))
(and messaged
(null tags-loop-operate)
(message "Scanning file %s...found" buffer-file-name))))
(null tags-loop-operate))
;; Continue last tags-search as if by M-,.
(tags-loop-continue nil)
- (setq tags-loop-scan
- (list 're-search-forward (list 'quote regexp) nil t)
+ (setq tags-loop-scan `(re-search-forward ',regexp nil t)
tags-loop-operate nil)
(tags-loop-continue (or file-list-form t))))
;;;###autoload
-(defun tags-query-replace (from to &optional delimited file-list-form)
- "Query-replace-regexp FROM with TO through all files listed in tags table.
+(defun tags-query-replace (from to &optional delimited file-list-form start end)
+ "Do `query-replace-regexp' of FROM with TO on 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
+If you exit (\\[keyboard-quit], RET or q), 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)
- ;; 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
- (list 'quote from) (list 'quote to)
- t t (list 'quote delimited)))
+ (interactive (query-replace-read-args "Tags query replace (regexp)" t t))
+ (setq tags-loop-scan `(let ,(unless (equal from (downcase from))
+ '((case-fold-search nil)))
+ (if (re-search-forward ',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 `(perform-replace ',from ',to t t ',delimited))
(tags-loop-continue (or file-list-form t)))
\f
(defun tags-complete-tags-table-file (string predicate what)
(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))))
+ (all-completions string (tags-table-files) predicate)
+ (try-completion string (tags-table-files) predicate))))
;;;###autoload
(defun list-tags (file &optional next-match)
'tags-complete-tags-table-file
nil t nil)))
(with-output-to-temp-buffer "*Tags List*"
- (princ "Tags in file ")
- (princ file)
- (terpri)
+ (princ "Tags in file `")
+ (tags-with-face 'highlight (princ file))
+ (princ "':\n\n")
(save-excursion
(let ((first-time t)
(gotany nil))
(if (funcall list-tags-function file)
(setq gotany t)))
(or gotany
- (error "File %s not in current tags tables" file))))))
+ (error "File %s not in current tags tables" file)))))
+ (with-current-buffer "*Tags List*"
+ (require 'apropos)
+ (apropos-mode)
+ (setq buffer-read-only t)))
;;;###autoload
(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)
+ (princ "Click mouse-2 to follow tags.\n\nTags matching regexp `")
+ (tags-with-face 'highlight (princ regexp))
+ (princ "':\n\n")
(save-excursion
(let ((first-time t))
(while (visit-tags-table-buffer (not first-time))
(setq first-time nil)
- (funcall tags-apropos-function regexp))))))
+ (funcall tags-apropos-function regexp))))
+ (etags-tags-apropos-additional regexp))
+ (with-current-buffer "*Tags List*"
+ (require 'apropos)
+ (apropos-mode)
+ ;; apropos-mode is derived from fundamental-mode and it kills
+ ;; all local variables.
+ (setq buffer-read-only t)))
\f
-;;; XXX Kludge interface.
+;; XXX Kludge interface.
+
+(define-button-type 'tags-select-tags-table
+ 'action (lambda (button) (select-tags-table-select))
+ 'help-echo "RET, t or mouse-2: select tags table")
;; XXX If a file is in multiple tables, selection may get the wrong one.
;;;###autoload
(setq buffer-read-only nil)
(erase-buffer)
(let ((set-list tags-table-set-list)
- (desired-point nil))
- (if tags-table-list
- (progn
+ (desired-point nil)
+ b)
+ (when tags-table-list
(setq desired-point (point-marker))
+ (setq b (point))
(princ tags-table-list (current-buffer))
+ (make-text-button b (point) 'type 'tags-select-tags-table)
(insert "\C-m")
(prin1 (car tags-table-list) (current-buffer)) ;invisible
- (insert "\n")))
+ (insert "\n"))
(while set-list
- (if (eq (car set-list) tags-table-list)
- ;; Already printed it.
- ()
+ (unless (eq (car set-list) tags-table-list)
+ (setq b (point))
(princ (car set-list) (current-buffer))
+ (make-text-button b (point) 'type 'tags-select-tags-table)
(insert "\C-m")
(prin1 (car (car set-list)) (current-buffer)) ;invisible
(insert "\n"))
(setq set-list (cdr set-list)))
- (if tags-file-name
- (progn
+ (when tags-file-name
(or desired-point
(setq desired-point (point-marker)))
- (insert tags-file-name "\C-m")
+ (setq b (point))
+ (insert tags-file-name)
+ (make-text-button b (point) 'type 'tags-select-tags-table)
+ (insert "\C-m")
(prin1 tags-file-name (current-buffer)) ;invisible
- (insert "\n")))
+ (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")
+ (setq b (point))
+ (insert (car set-list))
+ (make-text-button b (point) 'type 'tags-select-tags-table)
+ (insert "\C-m")
(prin1 (car set-list) (current-buffer)) ;invisible
(insert "\n")
(setq set-list (delete (car set-list) set-list)))
- (goto-char 1)
+ (goto-char (point-min))
(insert-before-markers
"Type `t' to select a tags table or set of tags tables:\n\n")
(if desired-point
(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))
+(defvar select-tags-table-mode-map
+ (let ((map (copy-keymap button-buffer-map)))
+ (define-key map "t" 'push-button)
+ (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)
+ map))
(defun select-tags-table-mode ()
"Major mode for choosing a current tags table among those already loaded.
(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.
+;; Note, there is another definition of this function in bindings.el.
;;;###autoload
(defun complete-tag ()
"Perform tags completion on the text around point.
(error "%s"
(substitute-command-keys
"No tags table loaded; try \\[visit-tags-table]")))
- (let ((pattern (funcall (or find-tag-default-function
+ (let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
+ tags-case-fold-search
+ case-fold-search))
+ (pattern (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
'find-tag-default)))
beg
(search-backward pattern)
(setq beg (point))
(forward-char (length pattern))
- (setq completion (try-completion pattern 'tags-complete-tag nil))
+ (setq completion (tags-complete-tag pattern nil nil))
(cond ((eq completion t))
((null completion)
(message "Can't find completion for \"%s\"" pattern)
(display-completion-list
(all-completions pattern 'tags-complete-tag nil)))
(message "Making completion list...%s" "done")))))
+
+(dolist (x '("^No tags table in use; use .* to select one$"
+ "^There is no default tag$"
+ "^No previous tag locations$"
+ "^File .* is not a valid tags table$"
+ "^No \\(more \\|\\)tags \\(matching\\|containing\\) "
+ "^Rerun etags: `.*' not found in "
+ "^All files processed$"
+ "^No .* or .* in progress$"
+ "^File .* not in current tags tables$"
+ "^No tags table loaded"
+ "^Nothing to complete$"))
+ (add-to-list 'debug-ignored-errors x))
\f
(provide 'etags)
+;;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e
;;; etags.el ends here