;;; 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
use function `tags-table-files' to do so.")
(defvar tags-completion-table nil
- "Obarray of tag names defined in current tags table.")
+ "List of tag names defined in current tags table.")
(defvar tags-included-tables nil
"List of tags tables included by the current tags table.")
(or tags-completion-table
;; No cached value for this buffer.
(condition-case ()
- (let (current-table combined-table)
+ (let (tables cont)
(message "Making tags completion table for %s..." buffer-file-name)
(save-excursion
;; Iterate over the current list of tags tables.
- (while (visit-tags-table-buffer (and combined-table t))
+ (while (visit-tags-table-buffer cont)
;; Find possible completions in this table.
- (setq current-table (funcall tags-completion-table-function))
- ;; Merge this buffer's completions into the combined table.
- (if combined-table
- (mapatoms
- (lambda (sym) (intern (symbol-name sym) combined-table))
- current-table)
- (setq combined-table current-table))))
+ (push (funcall tags-completion-table-function) tables)
+ (setq cont t)))
(message "Making tags completion table for %s...done"
buffer-file-name)
;; Cache the result in a buffer-local variable.
- (setq tags-completion-table combined-table))
+ (setq tags-completion-table
+ (nreverse (delete-dups (apply #'nconc tables)))))
(quit (message "Tags completion table construction aborted.")
(setq tags-completion-table nil)))))
(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)))
- (search-backward pattern)
- (setq beg (point))
- (forward-char (length pattern))
- (list beg (point) (tags-lazy-completion-table) :exclusive 'no))))))
+ ;; 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))
+ (forward-char (length pattern))
+ (list beg (point) (tags-lazy-completion-table) :exclusive 'no)))))))
\f
(defun find-tag-tag (string)
"Read a tag name, with defaulting and completion."
(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].")
Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
+ (declare (obsolete xref-find-definitions "25.1"))
(interactive (find-tag-interactive "Find tag: "))
(let* ((buf (find-tag-noselect tagname next-p regexp-p))
(pos (with-current-buffer buf (point))))
(defun etags-tags-completion-table () ; Doc string?
- (let ((table (make-vector 511 0))
+ (let (table
(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.
- ;; \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)
- (intern (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))
pat (concat (if (eq selective-display t)
"\\(^\\|\^m\\)" "^")
(regexp-quote (car tag-info))))
- ;; The character position in the tags table is 0-origin.
+ ;; The character position in the tags table is 0-origin and counts CRs.
;; Convert it to a 1-origin Emacs character position.
- (if startpos (setq startpos (1+ startpos)))
+ (when startpos
+ (setq startpos (1+ startpos))
+ (when (and line
+ (eq 1 (coding-system-eol-type buffer-file-coding-system)))
+ ;; Act as if CRs were elided from all preceding lines.
+ ;; Although this doesn't always give exactly the correct position,
+ ;; it does typically improve the guess.
+ (setq startpos (- startpos (1- line)))))
;; If no char pos was given, try the given line number.
(or startpos
(if line
(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))
;; 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
+ ;; Rules #2 and #4, and a check that there's no explicit name.
+ (looking-at "[ \t()=,;]?\177\\(?:[0-9]+\\)?,\\(?:[0-9]+\\)?$")
(save-excursion
(backward-char (1+ (length tag)))
(looking-at "[\n \t()=,;]")))) ;rule #3
(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))
;; we hit the limit rarely.
(defconst etags--xref-limit 1000)
+(defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p
+ tag-implicit-name-match-p)
+ "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))
- (`apropos (etags--xref-find-definitions id t))))
+(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 '())
(while (visit-tags-table-buffer (not first-time))
(setq first-time nil)
(dolist (order-fun (cond (regexp? find-tag-regexp-tag-order)
- (t find-tag-tag-order)))
+ (t etags-xref-find-definitions-tag-order)))
(goto-char (point-min))
(while (and (funcall search-fun pattern nil t)
(< (hash-table-count marks) etags--xref-limit))
(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
+ (nth 1 tag-info)))
\f
(provide 'etags)