Consolidate cross-referencing commands

Move autoloaded bindings for `M-.', `M-,', `C-x 4 .' and
`C-x 5 .' from etags.el to xref.el.

* progmodes/xref.el: New file.

* progmodes/elisp-mode.el (elisp--identifier-types): New variable.
(elisp--identifier-location): New function, extracted from
`elisp--company-location'.
(elisp--company-location): Use it.
(elisp--identifier-completion-table): New variable.
(elisp-completion-at-point): Use it.
(emacs-lisp-mode): Set the local values of `xref-find-function'
and `xref-identifier-completion-table-function'.
(elisp-xref-find, elisp--xref-find-definitions)
(elisp--xref-identifier-completion-table): New functions.

* progmodes/etags.el (find-tag-marker-ring): Mark obsolete in
favor of `xref--marker-ring'.
(tags-lazy-completion-table): Autoload.
(tags-reset-tags-tables): Use `xref-clear-marker-stack'.
(find-tag-noselect): Use `xref-push-marker-stack'.
(pop-tag-mark): Make an alias for `xref-pop-marker-stack'.
(etags--xref-limit): New constant.
(etags-xref-find, etags--xref-find-definitions): New functions.

Author: dgutov

etc/NEWS

@@ -434,6 +434,25 @@ By default, 32 spaces and four TABs are considered to be too much but
 `tildify-ignored-environments-alist' variables (as well as a few
 helper functions) obsolete.
 
+** xref
+The new package provides generic framework and new commands to find
+and move to definitions, as well as pop back to the original location.
+
+*** New key bindings
+`xref-find-definitions' replaces `find-tag' and provides an interface
+to pick one destination among several.  Hence, `tags-toop-continue' is
+unbound.  `xref-pop-marker-stack' replaces `pop-tag-mark', but uses an
+easier binding, which is now unoccupied (`M-,').
+`xref-find-definitions-other-window' replaces `find-tag-other-window'.
+`xref-find-definitions-other-frame' replaces `find-tag-other-frame'.
+`xref-find-apropos' replaces `find-tag-regexp'.
+
+*** New variables
+`find-tag-marker-ring-length' is now an obsolete alias for
+`xref-marker-ring-length'.  `find-tag-marker-ring' is now an obsolete
+alias for a private variable.  `xref-push-marker-stack' and
+`xref-pop-marker-stack' should be used to mutate it instead.
+
 ** Obsolete packages
 
 ---

lisp/ChangeLog

@@ -1,3 +1,33 @@
+2014-12-25  Helmut Eller  <eller.helmut@gmail.com>
+            Dmitry Gutov  <dgutov@yandex.ru>
+
+	Consolidate cross-referencing commands.
+
+	Move autoloaded bindings for `M-.', `M-,', `C-x 4 .' and
+	`C-x 5 .' from etags.el to xref.el.
+
+	* progmodes/xref.el: New file.
+
+	* progmodes/elisp-mode.el (elisp--identifier-types): New variable.
+	(elisp--identifier-location): New function, extracted from
+	`elisp--company-location'.
+	(elisp--company-location): Use it.
+	(elisp--identifier-completion-table): New variable.
+	(elisp-completion-at-point): Use it.
+	(emacs-lisp-mode): Set the local values of `xref-find-function'
+	and `xref-identifier-completion-table-function'.
+	(elisp-xref-find, elisp--xref-find-definitions)
+	(elisp--xref-identifier-completion-table): New functions.
+
+	* progmodes/etags.el (find-tag-marker-ring): Mark obsolete in
+	favor of `xref--marker-ring'.
+	(tags-lazy-completion-table): Autoload.
+	(tags-reset-tags-tables): Use `xref-clear-marker-stack'.
+	(find-tag-noselect): Use `xref-push-marker-stack'.
+	(pop-tag-mark): Make an alias for `xref-pop-marker-stack'.
+	(etags--xref-limit): New constant.
+	(etags-xref-find, etags--xref-find-definitions): New functions.
+
 2014-12-25  Martin Rudalics  <rudalics@gmx.at>
 
 	* cus-start.el (resize-mini-windows): Make it customizable.

lisp/progmodes/elisp-mode.el

@@ -227,10 +227,15 @@ Blank lines separate paragraphs.  Semicolons start comments.
 
 \\{emacs-lisp-mode-map}"
   :group 'lisp
+  (defvar xref-find-function)
+  (defvar xref-identifier-completion-table-function)
   (lisp-mode-variables nil nil 'elisp)
   (setq imenu-case-fold-search nil)
   (setq-local eldoc-documentation-function
               #'elisp-eldoc-documentation-function)
+  (setq-local xref-find-function #'elisp-xref-find)
+  (setq-local xref-identifier-completion-table-function
+              #'elisp--xref-identifier-completion-table)
   (add-hook 'completion-at-point-functions
             #'elisp-completion-at-point nil 'local))
 
@@ -414,17 +419,39 @@ It can be quoted, or be inside a quoted form."
 
 (declare-function find-library-name "find-func" (library))
 
+(defvar elisp--identifier-types '(defun defvar feature defface))
+
+(defun elisp--identifier-location (type sym)
+  (pcase (cons type sym)
+    (`(defun . ,(pred fboundp))
+     (find-definition-noselect sym nil))
+    (`(defvar . ,(pred boundp))
+     (find-definition-noselect sym 'defvar))
+    (`(defface . ,(pred facep))
+     (find-definition-noselect sym 'defface))
+    (`(feature . ,(pred featurep))
+     (require 'find-func)
+     (cons (find-file-noselect (find-library-name
+                                (symbol-name sym)))
+           1))))
+
 (defun elisp--company-location (str)
-  (let ((sym (intern-soft str)))
-    (cond
-     ((fboundp sym) (find-definition-noselect sym nil))
-     ((boundp sym) (find-definition-noselect sym 'defvar))
-     ((featurep sym)
-      (require 'find-func)
-      (cons (find-file-noselect (find-library-name
-                                 (symbol-name sym)))
-            0))
-     ((facep sym) (find-definition-noselect sym 'defface)))))
+  (catch 'res
+    (let ((sym (intern-soft str)))
+      (when sym
+        (dolist (type elisp--identifier-types)
+          (let ((loc (elisp--identifier-location type sym)))
+            (and loc (throw 'res loc))))))))
+
+(defvar elisp--identifier-completion-table
+  (apply-partially #'completion-table-with-predicate
+                   obarray
+                   (lambda (sym)
+                     (or (boundp sym)
+                         (fboundp sym)
+                         (featurep sym)
+                         (symbol-plist sym)))
+                   'strict))
 
 (defun elisp-completion-at-point ()
   "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
@@ -466,13 +493,8 @@ It can be quoted, or be inside a quoted form."
                            :company-docsig #'elisp--company-doc-string
                            :company-location #'elisp--company-location))
                     ((elisp--form-quoted-p beg)
-                     (list nil obarray
-                           ;; Don't include all symbols
-                           ;; (bug#16646).
-                           :predicate (lambda (sym)
-                                        (or (boundp sym)
-                                            (fboundp sym)
-                                            (symbol-plist sym)))
+                     ;; Don't include all symbols (bug#16646).
+                     (list nil elisp--identifier-completion-table
                            :annotation-function
                            (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
                            :company-doc-buffer #'elisp--company-doc-buffer
@@ -548,6 +570,38 @@ It can be quoted, or be inside a quoted form."
 (define-obsolete-function-alias
   'lisp-completion-at-point 'elisp-completion-at-point "25.1")
 
+;;; Xref backend
+
+(declare-function xref-make-buffer-location "xref" (buffer position))
+(declare-function xref-make-bogus-location "xref" (message))
+(declare-function xref-make "xref" (description location))
+
+(defun elisp-xref-find (action id)
+  (when (eq action 'definitions)
+    (let ((sym (intern-soft id)))
+      (when sym
+        (remove nil (elisp--xref-find-definitions sym))))))
+
+(defun elisp--xref-find-definitions (symbol)
+  (save-excursion
+    (mapcar
+     (lambda (type)
+       (let ((loc
+              (condition-case err
+                  (let ((buf-pos (elisp--identifier-location type symbol)))
+                    (when buf-pos
+                      (xref-make-buffer-location (car buf-pos)
+                                                 (or (cdr buf-pos) 1))))
+                (error
+                 (xref-make-bogus-location (error-message-string err))))))
+         (when loc
+           (xref-make (format "(%s %s)" type symbol)
+                      loc))))
+     elisp--identifier-types)))
+
+(defun elisp--xref-identifier-completion-table ()
+  elisp--identifier-completion-table)
+
 ;;; Elisp Interaction mode
 
 (defvar lisp-interaction-mode-map

lisp/progmodes/etags.el

@@ -28,6 +28,7 @@
 
 (require 'ring)
 (require 'button)
+(require 'xref)
 
 ;;;###autoload
 (defvar tags-file-name nil
@@ -141,11 +142,8 @@ Otherwise, `find-tag-default' is used."
   :group 'etags
   :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
-  :version "20.3")
+(define-obsolete-variable-alias 'find-tag-marker-ring-length
+  'xref-marker-ring-length "25.1")
 
 (defcustom tags-tag-face 'default
   "Face for tags in the output of `tags-apropos'."
@@ -182,15 +180,18 @@ Example value:
 		       (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.")
+(defvaralias 'find-tag-marker-ring 'xref--marker-ring)
+(make-obsolete-variable
+ 'find-tag-marker-ring
+ "use `xref-push-marker-stack' or `xref-pop-marker-stack' instead."
+ "25.1")
 
 (defvar default-tags-table-function nil
   "If non-nil, a function to choose a default tags file for a buffer.
 This function receives no arguments and should return the default
 tags table file to use for the current buffer.")
 
-(defvar tags-location-ring (make-ring find-tag-marker-ring-length)
+(defvar tags-location-ring (make-ring xref-marker-ring-length)
   "Ring of markers which are locations visited by \\[find-tag].
 Pop back to the last location with \\[negative-argument] \\[find-tag].")
 
@@ -713,15 +714,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
   (interactive)
   ;; Clear out the markers we are throwing away.
   (let ((i 0))
-    (while (< i find-tag-marker-ring-length)
+    (while (< i xref-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))))
+  (xref-clear-marker-stack)
   (setq tags-file-name nil
-	tags-location-ring (make-ring find-tag-marker-ring-length)
-	find-tag-marker-ring (make-ring find-tag-marker-ring-length)
+	tags-location-ring (make-ring xref-marker-ring-length)
 	tags-table-list nil
 	tags-table-computed-list nil
 	tags-table-computed-list-for nil
@@ -780,6 +779,7 @@ tags table and its (recursively) included tags tables."
 	(quit (message "Tags completion table construction aborted.")
 	      (setq tags-completion-table nil)))))
 
+;;;###autoload
 (defun tags-lazy-completion-table ()
   (let ((buf (current-buffer)))
     (lambda (string pred action)
@@ -898,7 +898,7 @@ See documentation of variable `tags-file-name'."
 	      ;; Run the user's hook.  Do we really want to do this for pop?
 	      (run-hooks 'local-find-tag-hook))))
       ;; Record whence we came.
-      (ring-insert find-tag-marker-ring (point-marker))
+      (xref-push-marker-stack)
       (if (and next-p last-tag)
 	  ;; Find the same table we last used.
 	  (visit-tags-table-buffer 'same)
@@ -954,7 +954,6 @@ See documentation of variable `tags-file-name'."
 	(switch-to-buffer buf)
       (error (pop-to-buffer buf)))
     (goto-char pos)))
-;;;###autoload (define-key esc-map "." 'find-tag)
 
 ;;;###autoload
 (defun find-tag-other-window (tagname &optional next-p regexp-p)
@@ -995,7 +994,6 @@ See documentation of variable `tags-file-name'."
 			;; the window's point from the buffer.
 			(set-window-point (selected-window) tagpoint))
 		      window-point)))
-;;;###autoload (define-key ctl-x-4-map "." 'find-tag-other-window)
 
 ;;;###autoload
 (defun find-tag-other-frame (tagname &optional next-p)
@@ -1020,7 +1018,6 @@ See documentation of variable `tags-file-name'."
   (interactive (find-tag-interactive "Find tag other frame: "))
   (let ((pop-up-frames t))
     (find-tag-other-window tagname next-p)))
-;;;###autoload (define-key ctl-x-5-map "." 'find-tag-other-frame)
 
 ;;;###autoload
 (defun find-tag-regexp (regexp &optional next-p other-window)
@@ -1044,25 +1041,10 @@ See documentation of variable `tags-file-name'."
   ;; We go through find-tag-other-window to do all the display hair there.
   (funcall (if other-window 'find-tag-other-window 'find-tag)
 	   regexp next-p t))
-;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp)
-
-;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
 
 ;;;###autoload
-(defun pop-tag-mark ()
-  "Pop back to where \\[find-tag] was last invoked.
+(defalias 'pop-tag-mark 'xref-pop-marker-stack)
 
-This is distinct from invoking \\[find-tag] with a negative argument
-since that pops a stack of markers at which tags were found, not from
-where they were found."
-  (interactive)
-  (if (ring-empty-p find-tag-marker-ring)
-      (error "No previous locations for find-tag invocation"))
-  (let ((marker (ring-remove find-tag-marker-ring 0)))
-    (switch-to-buffer (or (marker-buffer marker)
-                          (error "The marked buffer has been deleted")))
-    (goto-char (marker-position marker))
-    (set-marker marker nil nil)))
 
 (defvar tag-lines-already-matched nil
   "Matches remembered between calls.") ; Doc string: calls to what?
@@ -1859,7 +1841,6 @@ nil, we exit; otherwise we scan the next file."
     (and messaged
 	 (null tags-loop-operate)
 	 (message "Scanning file %s...found" buffer-file-name))))
-;;;###autoload (define-key esc-map "," 'tags-loop-continue)
 
 ;;;###autoload
 (defun tags-search (regexp &optional file-list-form)
@@ -2077,6 +2058,54 @@ for \\[find-tag] (which see)."
       (completion-in-region (car comp-data) (cadr comp-data)
 			    (nth 2 comp-data)
 			    (plist-get (nthcdr 3 comp-data) :predicate)))))
+
+
+;;; Xref backend
+
+;; Stop searching if we find more than xref-limit matches, as the xref
+;; infrastracture is not designed to handle very long lists.
+;; Switching to some kind of lazy list might be better, but hopefully
+;; we hit the limit rarely.
+(defconst etags--xref-limit 1000)
+
+;;;###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-find-definitions (pattern &optional regexp?)
+  ;; This emulates the behaviour 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 '())
+         (first-time t)
+         (search-fun (if regexp? #'re-search-forward #'search-forward))
+         (marks (make-hash-table :test 'equal))
+         (case-fold-search (if (memq tags-case-fold-search '(nil t))
+                               tags-case-fold-search
+                             case-fold-search)))
+    (save-excursion
+      (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)))
+          (goto-char (point-min))
+          (while (and (funcall search-fun pattern nil t)
+                      (< (hash-table-count marks) etags--xref-limit))
+            (when (funcall order-fun pattern)
+              (beginning-of-line)
+              (cl-destructuring-bind (hint line &rest pos) (etags-snarf-tag)
+                (unless (eq hint t) ; hint==t if we are in a filename line
+                  (let* ((file (file-of-tag))
+                         (mark-key (cons file line)))
+                    (unless (gethash mark-key marks)
+                      (let ((loc (xref-make-file-location
+                                  (expand-file-name file) line 0)))
+                        (push (xref-make hint loc) xrefs)
+                        (puthash mark-key t marks)))))))))))
+    (nreverse xrefs)))
+
 
 (provide 'etags)