]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/etags.el
Merge branch 'emacs-25-merge'
[gnu-emacs] / lisp / progmodes / etags.el
index 8b5757b814a749ed2cadb2b07961e50368466637..dbb46a383818361b1e538a682c504e5460dc4345 100644 (file)
@@ -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
@@ -204,7 +204,7 @@ nil means it has not yet been computed;
 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.")
@@ -759,23 +759,19 @@ tags table and its (recursively) included tags tables."
   (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)))))
 
@@ -803,26 +799,24 @@ 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)))
-          (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))
@@ -834,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].")
 
@@ -1255,31 +1254,28 @@ buffer-local values of tags table format variables."
 
 
 (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))
@@ -1354,9 +1350,16 @@ hits the start of file."
            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
@@ -1455,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)
@@ -1465,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))
@@ -1624,7 +1627,8 @@ Point should be just after a string that matches 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
+       ;; 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
@@ -1749,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)
@@ -1767,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.
@@ -1841,7 +1845,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)
@@ -1913,9 +1919,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))
@@ -1937,9 +1943,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))
@@ -2075,27 +2082,23 @@ for \\[find-tag] (which see)."
 (defconst etags--xref-limit 1000)
 
 (defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p
-                                                tag-implicit-name-match-p
-                                                tag-symbol-match-p)
-  "Tag order used in `etags-xref-find' to look for definitions.")
+                                                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))
-    (`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