;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2015 Free
+;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2016 Free
;; Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
Example value:
- '((\"Emacs Lisp\" Info-goto-emacs-command-node obarray)
+ ((\"Emacs Lisp\" Info-goto-emacs-command-node obarray)
(\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray)
(\"SCWM\" scwm-documentation scwm-obarray))"
:group 'etags
(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)))
+ (pattern (find-tag--default))
beg)
(when pattern
(save-excursion
- (forward-char (1- (length pattern)))
+ ;; Avoid end-of-buffer error.
+ (goto-char (+ (point) (length pattern) -1))
;; The find-tag function might be overly optimistic.
(when (search-backward pattern nil t)
(setq beg (point))
(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)))
+ (default (find-tag--default))
(spec (completing-read (if default
(format "%s (default %s): "
(substring string 0 (string-match "[ :]+\\'" string))
(or default (user-error "There is no default tag"))
spec)))
+(defun find-tag--default ()
+ (funcall (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default)))
+
(defvar last-tag nil
"Last tag found by \\[find-tag].")
(point-min) (point-max))))
(save-excursion
(goto-char (point-min))
- ;; This monster regexp matches an etags tag line.
- ;; \1 is the string to match;
- ;; \2 is not interesting;
- ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN
- ;; \4 is not interesting;
- ;; \5 is the explicitly-specified tag name.
- ;; \6 is the line to start searching at;
- ;; \7 is the char to start searching at.
+ ;; This regexp matches an explicit tag name or the place where
+ ;; it would start.
(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"
+ "[\f\t\n\r()=,; ]?\177\\\(?:\\([^\n\001]+\\)\001\\)?"
nil t)
- (push (prog1 (if (match-beginning 5)
+ (push (prog1 (if (match-beginning 1)
;; 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)))
+ (buffer-substring (match-beginning 1) (match-end 1))
+ ;; No explicit tag name. Backtrack a little,
+ ;; and look for the implicit one.
+ (goto-char (match-beginning 0))
+ (skip-chars-backward "^\f\t\n\r()=,; ")
+ (prog1
+ (buffer-substring (point) (match-beginning 0))
+ (goto-char (match-end 0))))
(progress-reporter-update progress-reporter (point)))
table)))
table))
(when (symbolp symbs)
(if (boundp symbs)
(setq symbs (symbol-value symbs))
- (insert "symbol `" (symbol-name symbs) "' has no value\n")
+ (insert (format-message "symbol `%s' has no value\n" symbs))
(setq symbs nil)))
(if (vectorp symbs)
(mapatoms ins-symb symbs)
(defun etags-tags-apropos (string) ; Doc string?
(when tags-apropos-verbose
- (princ "Tags in file `")
+ (princ (substitute-command-keys "Tags in file `"))
(tags-with-face 'highlight (princ buffer-file-name))
- (princ "':\n\n"))
+ (princ (substitute-command-keys "':\n\n")))
(goto-char (point-min))
(let ((progress-reporter (make-progress-reporter
- (format "Making tags apropos buffer for `%s'..."
- string)
+ (format-message
+ "Making tags apropos buffer for `%s'..." string)
(point-min) (point-max))))
(while (re-search-forward string nil t)
(progress-reporter-update progress-reporter (point))
(with-current-buffer buffer
(revert-buffer t t)))
(if (not (and new novisit))
- (find-file next novisit)
+ (find-file next)
;; Like find-file, but avoids random warning messages.
(switch-to-buffer (get-buffer-create " *next-file*"))
(kill-all-local-variables)
"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.")
+`tags-loop-operate'. Otherwise, move on to the next file.")
(defun tags-loop-eval (form)
"Evaluate FORM and return its result.
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."
- (declare (obsolete "use `xref-find-definitions' interface instead." "25.1"))
(interactive)
(let (new
;; Non-nil means we have finished one file
;; Now operate on the file.
;; If value is non-nil, continue to scan the next file.
- (tags-loop-eval tags-loop-operate))
+ (save-restriction
+ (widen)
+ (tags-loop-eval tags-loop-operate)))
(setq file-finished t))
(and messaged
(null tags-loop-operate)
'tags-complete-tags-table-file
nil t nil)))
(with-output-to-temp-buffer "*Tags List*"
- (princ "Tags in file `")
+ (princ (substitute-command-keys "Tags in file `"))
(tags-with-face 'highlight (princ file))
- (princ "':\n\n")
+ (princ (substitute-command-keys "':\n\n"))
(save-excursion
(let ((first-time t)
(gotany nil))
(declare (obsolete xref-find-apropos "25.1"))
(interactive "sTags apropos (regexp): ")
(with-output-to-temp-buffer "*Tags List*"
- (princ "Click mouse-2 to follow tags.\n\nTags matching regexp `")
+ (princ (substitute-command-keys
+ "Click mouse-2 to follow tags.\n\nTags matching regexp `"))
(tags-with-face 'highlight (princ regexp))
- (princ "':\n\n")
+ (princ (substitute-command-keys "':\n\n"))
(save-excursion
(let ((first-time t))
(while (visit-tags-table-buffer (not first-time))
(defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p
tag-implicit-name-match-p)
- "Tag order used in `etags-xref-find' to look for definitions.")
+ "Tag order used in `xref-backend-definitions' to look for definitions.")
;;;###autoload
-(defun etags-xref-find (action id)
- (pcase action
- (`definitions (etags--xref-find-definitions id))
- (`references
- (etags--xref-find-matches id #'xref-collect-references))
- (`matches
- (etags--xref-find-matches id #'xref-collect-matches))
- (`apropos (etags--xref-find-definitions id t))))
-
-(defun etags--xref-find-matches (input fun)
- (let ((dirs (if tags-table-list
- (mapcar #'file-name-directory tags-table-list)
- ;; If no tags files are loaded, prompt for the dir.
- (list (read-directory-name "In directory: " nil nil t)))))
- (cl-mapcan (lambda (dir) (funcall fun input dir)) dirs)))
+(defun etags--xref-backend () 'etags)
+
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags)))
+ (find-tag--default))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
+ (tags-lazy-completion-table))
+
+(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
+ (etags--xref-find-definitions symbol))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql etags)) symbol)
+ (etags--xref-find-definitions symbol t))
(defun etags--xref-find-definitions (pattern &optional regexp?)
- ;; This emulates the behaviour of `find-tag-in-order' but instead of
+ ;; This emulates the behavior of `find-tag-in-order' but instead of
;; returning one match at a time all matches are returned as list.
;; NOTE: find-tag-tag-order is typically a buffer-local variable.
(let* ((xrefs '())
(with-slots (tag-info file) l
(let ((buffer (find-file-noselect file)))
(with-current-buffer buffer
- (etags-goto-tag-location tag-info)
- (point-marker)))))
+ (save-excursion
+ (etags-goto-tag-location tag-info)
+ (point-marker))))))
(cl-defmethod xref-location-line ((l xref-etags-location))
(with-slots (tag-info) l