X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9fcd66daf819294168e86ea5eb50c241b1d9fa11..a8231e00cbad60652ff7ab6ae51a758f1d939971:/lisp/progmodes/etags.el diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index d03032d0ab..890d55294c 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1,6 +1,6 @@ ;;; 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 @@ -171,7 +171,7 @@ is the symbol being selected. 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 @@ -799,13 +799,12 @@ If no tags table is loaded, do nothing and return 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))) + ;; 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)) @@ -817,9 +816,7 @@ If no tags table is loaded, do nothing and return nil." (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)) @@ -831,6 +828,11 @@ If no tags table is loaded, do nothing and return nil." (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].") @@ -1259,24 +1261,21 @@ buffer-local values of tags table format variables." (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)) @@ -1459,7 +1458,7 @@ hits the start of file." (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) @@ -1469,13 +1468,13 @@ hits the start of file." (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)) @@ -1754,7 +1753,7 @@ if the file was newly read in, the value is the filename." (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) @@ -1772,7 +1771,7 @@ if the file was newly read in, the value is the filename." "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. @@ -1795,7 +1794,6 @@ Two variables control the processing we do on each file: the value of 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 @@ -1846,7 +1844,9 @@ nil, we exit; otherwise we scan the next 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) @@ -1918,9 +1918,9 @@ directory specification." '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)) @@ -1942,9 +1942,10 @@ directory specification." (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)) @@ -2081,28 +2082,25 @@ for \\[find-tag] (which see)." (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 'symbol)) - (`matches (etags--xref-find-matches id 'regexp)) - (`apropos (etags--xref-find-definitions id t)))) - -(defun etags--xref-find-matches (input kind) - (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) - (xref-collect-matches input dir kind)) - 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 '()) @@ -2148,8 +2146,9 @@ for \\[find-tag] (which see)." (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