Re: Generalizing find-definition

[Helmut Eller]

On Mon, Dec 08 2014, Stefan Monnier wrote:

> Alright, let's go ahead with this.  Can you send a "latest and greatest"
> version of your code so I can install it into master?

Here we go:

>From daa6a31e4903a5dd2d1450d4118fa0703ab88006 Mon Sep 17 00:00:00 2001
From: Helmut Eller <address@hidden>
Date: Tue, 9 Dec 2014 09:37:34 +0100
Subject: [PATCH] Generalized infrastructure for find-definition

* progmodes/xref.el: New file.

* progmodes/etags.el (find-tag-marker-ring, pop-tag-mark): Move to
xref but keep aliases for backward compatibility.
(tags-reset-tags-tables): Use xref marker stack instead of
find-tag-marker-ring.
(etags--xref-backend, etags--xref-backend-var)
(etags-xref-backend-function): New xref backend.
(esc-map, ctl-x-4-map, ctl-x-5-map): Move key bindings for M-.,
M-,, C-x 4 M-., and C-x 5 M-. to xref.el

* emacs-lisp/find-func.el (find-function--xref-backend)
(find-function--xref-backend-var)
(find-function-xref-backend-function, find-function--find-xref):
New xref backend.

* progmodes/elisp-mode.el (emacs-lisp-mode): Initialize
xref-backend-function.
---
 lisp/emacs-lisp/find-func.el |   38 ++++
 lisp/progmodes/elisp-mode.el |    1 +
 lisp/progmodes/etags.el      |   88 ++++++--
 lisp/progmodes/xref.el       |  487 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 591 insertions(+), 23 deletions(-)
 create mode 100644 lisp/progmodes/xref.el

diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index c372117..405135f 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -43,6 +43,8 @@
 
 ;;; Code:
 
+(require 'xref)
+
 ;;; User variables:
 
 (defgroup find-function nil
@@ -578,6 +580,42 @@ Set mark before moving, if the buffer already existed."
   (define-key ctl-x-4-map "V" 'find-variable-other-window)
   (define-key ctl-x-5-map "V" 'find-variable-other-frame))
 
+
+;;; Xref backend
+
+(defclass find-function--xref-backend (xref-backend-class) ())
+
+(defvar find-function--xref-backend-var
+  (make-instance 'find-function--xref-backend))
+
+;;;###autoload
+(defun find-function-xref-backend-function () find-function--xref-backend-var)
+
+(defun find-function--find-xref (symbol type)
+  (let ((loc (condition-case err
+                (let ((loc (save-excursion
+                             (find-definition-noselect symbol type))))
+                  (xref-make-buffer-location (car loc) (or (cdr loc) 1)))
+              (error
+               (xref-make-bogus-location (error-message-string err)))))
+       (desc (format "(%s %s)" (or type 'defun) symbol)))
+    (xref-make desc loc)))
+
+;; FIXME: include other stuff likes faces, compiler-macros, methods...
+(defmethod xref-lookup-definitions ((_ find-function--xref-backend) id)
+  (let ((sym (intern-soft id)))
+    (if (null sym)
+       '()
+      (let ((fun (if (fboundp sym) (find-function--find-xref sym nil)))
+           (var (if (boundp sym) (find-function--find-xref sym 'defvar))))
+       (remove nil (list fun var))))))
+
+(defmethod xref-read-identifier-from-minibuffer
+  ((b find-function--xref-backend) prompt id)
+  (completing-read prompt obarray nil nil
+                  (if id (xref-identifier-to-string b id))))
+
+
 (provide 'find-func)
 
 ;;; find-func.el ends here
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ba70f90..fa97890 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -231,6 +231,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
   (setq imenu-case-fold-search nil)
   (setq-local eldoc-documentation-function
               #'elisp-eldoc-documentation-function)
+  (setq-local xref-backend-function #'find-function-xref-backend-function)
   (add-hook 'completion-at-point-functions
             #'elisp-completion-at-point nil 'local))
 
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index b89b4cf..8696d8c 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -28,6 +28,7 @@
 
 (require 'ring)
 (require 'button)
+(require 'xref)
 
 ;;;###autoload
 (defvar tags-file-name nil
@@ -182,8 +183,8 @@ 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.")
+(define-obsolete-variable-alias 'find-tag-marker-ring 'xref--marker-ring
+  "25.1")
 
 (defvar default-tags-table-function nil
   "If non-nil, a function to choose a default tags file for a buffer.
@@ -716,12 +717,10 @@ Returns t if it visits a tags table, or nil if there are 
no more in the list."
     (while (< i find-tag-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-table-list nil
        tags-table-computed-list nil
        tags-table-computed-list-for nil
@@ -898,7 +897,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 +953,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 +993,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 +1017,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)
@@ -1049,20 +1045,8 @@ See documentation of variable `tags-file-name'."
 ;;;###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 +1843,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 +2060,65 @@ 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 backed
+
+(defclass etags--xref-backend (xref-backend-class) ())
+
+(defvar etags--xref-backend-var (make-instance 'etags--xref-backend))
+
+;;;###autoload
+(defun etags-xref-backend-function () etags--xref-backend-var)
+
+;; 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)
+
+(defmethod xref-lookup-definitions ((_ etags--xref-backend) id)
+  ;; 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)
+        (regexp? (consp id))
+        (pattern (if regexp? (cadr id) id))
+        (search-fun (if regexp? #'re-search-forward #'search-forward))
+        (marks (make-hash-table :test 'equal)))
+    (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)))
+
+;; If the text in the minibuffer starts with " it's interpreted as a
+;; regexp.  This is an example for a non-trivial identifier type.
+(defmethod xref-read-identifier-from-minibuffer ((b etags--xref-backend)
+                                                prompt id)
+  (let ((string (completing-read prompt (tags-lazy-completion-table) nil nil
+                                (if id (xref-identifier-to-string b id)))))
+    (cond ((string-match "^\"" string)
+          `(rx ,(read string)))
+         (t
+          string))))
+
 
 (provide 'etags)
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
new file mode 100644
index 0000000..fd8d87b
--- /dev/null
+++ b/lisp/progmodes/xref.el
@@ -0,0 +1,487 @@
+;; xref.el --- Cross referencing commands              -*-lexical-binding:t-*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a somewhat generic infrastructure for cross
+;; referencing commands, in particular "find-definition".  Some part of
+;; the functionality must be implemented in a language dependent way
+;; and that's done by defining a "backend".  The generic code finds
+;; the backend by calling the function stored in the variable
+;; `xref-backend-function'.  A language specific mode usually makes
+;; `xref-backend-function' buffer local before storing into it.
+;;
+;; A backend is an instance of the EIEIO class `xref-backend-class'.
+;; Various generic functions (in the EIEIO sense of the word) are
+;; defined on xref-backend-class.  A language specific mode usually
+;; creates a subclasses of xref-backend-class and provides specialized
+;; methods for the generic functions.  See the `etags--xref-backend'
+;; and `find-function--xref-backend' classes for examples.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'ring)
+
+
+;;; Locations
+
+(defclass xref-location () ()
+  :documentation "A location represents a position in a file or buffer.")
+
+;; If a backend decides to subclass xref-location it can provide
+;; methods for some of the following functions:
+(defgeneric xref-location-buffer (location)
+  "Return the buffer for LOCATION.")
+
+(defgeneric xref-location-position (location)
+  "Return the position in LOCATIONs buffer.")
+
+(defgeneric xref-location= (location1 location2)
+  "Return t if two locations are equal.")
+
+(defmethod xref-location= ((l1 xref-location) l2)
+  (equal l1 l2))
+
+;;;; Commonly needed location classes are defined here:
+
+;; FIXME: might be useful to have an optional "hint" i.e. a string to
+;; search for in case the line number is sightly out of date.
+(defclass xref-file-location (xref-location)
+  ((file :type string :initarg :file)
+   (line :type fixnum :initarg :line)
+   (column :type fixnum :initarg :column))
+  :documentation "A file location is a file/line/column triple.
+Line numbers start from 1 and columns from 0.")
+
+(defun xref-make-file-location (file line column)
+  "Create and return a new xref-file-location."
+  (make-instance 'xref-file-location :file file :line line :column column))
+
+(defmethod xref-location-buffer ((l xref-file-location))
+  (with-slots (file) l
+    (or (get-file-buffer file)
+       (let ((find-file-suppress-same-file-warnings t))
+         (find-file-noselect file)))))
+
+(defmethod xref-location-position ((l xref-file-location))
+  (with-slots (line column) l
+    (with-current-buffer (xref-location-buffer l)
+      (save-restriction
+       (widen)
+       (save-excursion
+         (goto-char (point-min))
+         (beginning-of-line line)
+         (move-to-column column)
+         (point))))))
+
+(defclass xref-buffer-location (xref-location)
+  ((buffer :type buffer :initarg :buffer :reader xref-location-buffer)
+   (position :type fixnum :initarg :position :reader xref-location-position)))
+
+(defun xref-make-buffer-location (buffer position)
+  "Create and return a new xref-buffer-location."
+  (make-instance 'xref-buffer-location :buffer buffer :position position))
+
+(defclass xref-bogus-location (xref-location)
+  ((message :type string :initarg :message
+           :reader xref-bogus-location-message))
+  :documentation "Bogus locations are sometimes useful to
+indicate errors, e.g. when we know that a function exists but the
+actual location is not known.")
+
+(defun xref-make-bogus-location (message)
+  "Create and return a new xref-bogus-location."
+  (make-instance 'xref-bogus-location :message message))
+
+(defmethod xref-location-buffer ((l xref-bogus-location))
+  (with-slots (message) l
+    (error "%s" message)))
+
+(defmethod xref-location-position ((l xref-bogus-location))
+  (with-slots (message) l
+    (error "%s" message)))
+
+
+;;; cross reference
+
+(defclass xref--xref ()
+  ((description :type string :initarg :description
+               :reader xref--xref-description)
+   (location :type xref-location :initarg :location
+            :reader xref--xref-location))
+  :comment "An xref is used to display and locate constructs like
+variables or functions.")
+
+(defun xref-make (description location)
+  "Create and return an new xref.
+DESCRIPTION is a short string to describe the xref.
+LOCATION is an `xref-location'."
+  (make-instance 'xref--xref :description description :location location))
+
+
+;;; Backend
+
+;; Ugly name because defclass stores the class object in the symbol.
+(defclass xref-backend-class () ()
+  :documentation "Abstract superclass for backends.")
+
+;; For now, make the etags backend the default.
+(defvar xref-backend-function #'etags-xref-backend-function
+  "Function called to find the current xref-backend.
+The function is called with no arguments and should return
+a subclass of `xref-backend-class'.")
+
+(defun xref--backend ()
+  (funcall xref-backend-function))
+
+;;;; Backend interface functions
+
+(defgeneric xref-lookup-definitions (backend identifier)
+  "Find definitions of IDENTIFIER.
+The result is a list of `xref--xref' objects.
+If no definition can be found, return nil.")
+
+(defgeneric xref-lookup-references (backend identifier)
+  "Find references of IDENTIFIER.
+The result is a list of `xref--xref' objects.
+If no reference can be found, return nil.")
+
+;; An identifier is backend specific.  By default it's a string but it
+;; can be any type, expect nil.
+(defgeneric xref-identifier-at-point (backend)
+  "Search and return the identfier near point.
+If no identifier can be found, return nil.")
+
+(defgeneric xref-read-identifier-from-minibuffer (backend prompt init)
+  "Read an identifier from the minibuffer.
+PROMPT is a string used for prompting.
+INIT is either an identifier or nil.")
+
+(defgeneric xref-identifier-to-string (backend identifier)
+  "Return a string representing IDENTIFIER.")
+
+;; default implementation for identifiers
+(defmethod xref-identifier-at-point (_backend)
+  (let ((thing (thing-at-point 'symbol)))
+    (and thing (substring-no-properties thing))))
+
+(defmethod xref-read-identifier-from-minibuffer (backend prompt id)
+  (read-from-minibuffer prompt
+                       (if id (xref-identifier-to-string backend id))))
+
+(defmethod xref-identifier-to-string (_backend identifier)
+  (with-output-to-string (princ identifier)))
+
+
+;;; misc utilities
+(defun xref--alistify (list key test)
+  "Partition the elements of LIST into an alist.
+KEY extracts the key from an element and TEST is used to compare
+keys."
+  (let ((alist '()))
+    (dolist (e list)
+      (let* ((k (funcall key e))
+            (probe (cl-assoc k alist :test test)))
+       (if probe
+           (setcdr probe (cons e (cdr probe)))
+          (push (cons k (list e)) alist))))
+    ;; Put them back in order.
+    (cl-loop for (key . value) in (reverse alist)
+             collect (cons key (reverse value)))))
+
+(defun xref--insert-propertized (props &rest strings)
+  "Insert STRINGS with text properties PROPS."
+  (let ((start (point)))
+    (apply #'insert strings)
+    (add-text-properties start (point) props)))
+
+(defun xref--search-property (property &optional backward)
+    "Search the next text range where text property PROPERTY is non-nil.
+Return the value of PROPERTY.  If BACKWARD is non-nil, search
+backward."
+  (let ((next (if backward
+                 #'previous-single-char-property-change
+               #'next-single-char-property-change))
+        (start (point))
+        (value nil))
+    (while (progn
+             (goto-char (funcall next (point) property))
+             (not (or (setq value (get-text-property (point) property))
+                      (eobp)
+                      (bobp)))))
+    (cond (value)
+         (t (goto-char start) nil))))
+
+
+;;; Marker stack  (M-. pushes, M-, pops)
+
+(defconst xref--marker-ring-length 16)
+
+(defvar xref--marker-ring (make-ring xref--marker-ring-length)
+  "Ring of markers to implement the marker stack.")
+
+(defun xref-push-marker-stack ()
+  "Add point to the marker stack."
+  (ring-insert xref--marker-ring (point-marker)))
+
+;;;###autoload
+(defun xref-pop-marker-stack ()
+  "Pop back to where \\[xref-find-definitions] was last invoked."
+  (interactive)
+  (let ((ring xref--marker-ring))
+    (when (ring-empty-p ring)
+      (error "Marker stack is empty"))
+    (let ((marker (ring-remove 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))))
+
+;; etags.el needs this
+(defun xref-clear-marker-stack ()
+  "Discard all markers from the marker stack."
+  (let ((ring xref--marker-ring))
+    (while (not (ring-empty-p ring))
+      (let ((marker (ring-remove ring)))
+       (set-marker marker nil nil)))))
+
+
+(defun xref--goto-location (location)
+  "Set buffer and point according to xref-location LOCATION."
+  (set-buffer (xref-location-buffer location))
+  (let ((pos (xref-location-position location)))
+    (cond ((and (<= (point-min) pos) (<= pos (point-max))))
+         (widen-automatically (widen))
+         (t (error "Location is outside accessible part of buffer")))
+    (goto-char pos)))
+
+(defun xref--pop-to-location (location &optional window)
+  "Goto xref-location LOCATION and display the buffer.
+WINDOW controls how the buffer is displayed:
+  nil      -- switch-to-buffer
+  'window  -- pop-to-buffer (other window)
+  'frame   -- pop-to-buffer (other frame)"
+  (xref--goto-location location)
+  (cl-ecase window
+    ((nil)  (switch-to-buffer (current-buffer)))
+    (window (pop-to-buffer (current-buffer) t))
+    (frame  (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t)))))
+
+
+;;; XREF buffer (part of the UI)
+
+;; The xref buffer is used to display a set of xrefs.
+
+(defun xref--display-position (pos other-window recenter-arg)
+  ;; show the location, but don't hijack focus.
+  (with-selected-window (display-buffer (current-buffer) other-window)
+    (goto-char pos)
+    (recenter recenter-arg)))
+
+(defgeneric xref--show-location (location))
+(defmethod xref--show-location ((l xref-bogus-location))
+  (with-slots (message) l
+    (message "%s" message)))
+
+(defmethod xref--show-location (location)
+  (xref--goto-location location)
+  (xref--display-position (point) t 1))
+
+(defun xref--next-line (backward)
+  (let ((loc (xref--search-property 'xref-location backward)))
+    (when loc
+      (xref--show-location loc))))
+
+(defun xref-next-line ()
+  "Move to the next xref and display its source in the other window."
+  (interactive)
+  (xref--next-line nil))
+
+(defun xref-prev-line ()
+  "Move to the previous xref and display its source in the other window."
+  (interactive)
+  (xref--next-line t))
+
+(defun xref--location-at-point ()
+  (or (get-text-property (point) 'xref-location)
+      (error "No reference at point")))
+
+(defun xref-goto-xref ()
+  "Jump to the xref at point and close the xref buffer."
+  (interactive)
+  (xref--show-location (xref--location-at-point))
+  (quit-window))
+
+(define-derived-mode xref--xref-buffer-mode fundamental-mode "XREF"
+  "Mode for displaying cross refenences."
+  (setq buffer-read-only t))
+
+(let ((map xref--xref-buffer-mode-map))
+  (define-key map (kbd "q") #'quit-window)
+  (define-key map [remap next-line] #'xref-next-line)
+  (define-key map [remap previous-line] #'xref-prev-line)
+  (define-key map (kbd "RET") #'xref-goto-xref)
+
+  ;; suggested by Johan Claesson "to further reduce finger movement":
+  (define-key map (kbd ".") #'xref-next-line)
+  (define-key map (kbd ",") #'xref-prev-line))
+
+(defun xref--buffer-name () "*xref*")
+
+(defun xref--insert-xrefs (xref-alist)
+  "Insert XREF-ALIST in the current-buffer.
+XREF-ALIST is of the form ((GROUP . (XREF ...)) ...).  Where
+GROUP is a string for decoration purposes and XREF is an
+`xref--xref' object."
+  (cl-loop for ((group . xrefs) . more1) on xref-alist do
+           (xref--insert-propertized '(face bold) group "\n")
+           (cl-loop for (xref . more2) on xrefs do
+                   (insert "  ")
+                   (with-slots (description location) xref
+                     (xref--insert-propertized
+                      (list 'xref-location location
+                            'face 'font-lock-keyword-face)
+                      description))
+                   (when (or more1 more2)
+                     (insert "\n")))))
+
+(defgeneric xref-location-group (location)
+  "Return a string used to group a set of locations.
+This is typically the filename.")
+
+(defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
+(defmethod xref-location-group ((l xref-file-location))
+  (with-slots (file) l
+    file))
+(defmethod xref-location-group ((l xref-buffer-location))
+  (with-slots (buffer) l
+    (or (buffer-file-name buffer)
+       (format "(buffer %s)" (buffer-name buffer)))))
+
+(defun xref--analyze (xrefs)
+  "Find common filenames in XREFS.
+Return an alist of the form ((FILENAME . (XREF ...)) ...)."
+  (xref--alistify xrefs
+                 (lambda (x)
+                   (xref-location-group (xref--xref-location x)))
+                 #'equal))
+
+(defun xref--show-xref-buffer (xrefs)
+  (let ((xref-alist (xref--analyze xrefs)))
+    (with-current-buffer (get-buffer-create (xref--buffer-name))
+      (let ((inhibit-read-only t))
+       (erase-buffer)
+       (xref--insert-xrefs xref-alist)
+       (xref--xref-buffer-mode)
+       (pop-to-buffer (current-buffer))
+       (goto-char (point-min))
+       (current-buffer)))))
+
+
+;; This part of the UI seems fairly uncontroversial: it reads the
+;; identifier and deals with the single definition case.
+;;
+;; The controversial multiple definitions case is handed of to
+;; xref-show-xrefs-function.
+
+(defun xref--unique-location (xrefs)
+  "If it exists, return the single location in the list XREFS.
+If there are multiple or no locations in XREFS return nil."
+  (and xrefs
+       (let ((loc (xref--xref-location (car xrefs))))
+        (and (cl-every (lambda (x)
+                         (xref-location= (xref--xref-location x) loc))
+                       (cdr xrefs))
+             loc))))
+
+(defvar xref-show-xrefs-function 'xref--show-xref-buffer
+  "Function to display a list of xrefs.")
+
+(defun xref--show-xrefs (id kind xrefs window)
+  (let ((1loc (xref--unique-location xrefs)))
+    (cond ((null xrefs)
+          (error "No known %s for: %s"
+                 kind (xref-identifier-to-string (xref--backend) id)))
+         (1loc
+          (xref-push-marker-stack)
+          (xref--pop-to-location 1loc window))
+         (t
+          (xref-push-marker-stack)
+          (funcall xref-show-xrefs-function xrefs)))))
+
+(defun xref--read-identifier (prompt)
+  "Return the identifier at point or read it from the minibuffer."
+  (let* ((backend (xref--backend))
+        (id (xref-identifier-at-point backend)))
+    (cond ((or current-prefix-arg (not id))
+          (xref-read-identifier-from-minibuffer backend prompt id))
+         (t id))))
+
+
+;;; Commands
+
+(defun xref--find-definitions (id window)
+  (xref--show-xrefs id "definitions"
+                   (xref-lookup-definitions (xref--backend) id)
+                   window))
+
+;;;###autoload
+(defun xref-find-definitions (identifier)
+  "Find the definition of the identifier at point.
+With prefix argument, prompt for the identifier."
+  (interactive (list (xref--read-identifier "Find definitions of: ")))
+  (xref--find-definitions identifier nil))
+
+;;;###autoload
+(defun xref-find-definitions-other-window (identifier)
+  "Like `xref-find-definitions' but switch to the other window."
+  (interactive (list (xref--read-identifier "Find definitions of: ")))
+  (xref--find-definitions identifier 'window))
+
+;;;###autoload
+(defun xref-find-definitions-other-frame (identifier)
+  "Like `xref-find-definitions' but switch to the other window."
+  (interactive (list (xref--read-identifier "Find definitions of: ")))
+  (xref--find-definitions identifier 'frame))
+
+;;;###autoload
+(defun xref-find-references (identifier)
+  "Find references for the identifier at point.
+With prefix argument, prompt for the identifier."
+  (interactive (list (xref--read-identifier "Find references of: ")))
+  (xref--show-xrefs identifier "references"
+                   (xref-lookup-references (xref--backend) identifier)
+                   nil))
+
+
+;;; Key bindings
+
+;;;###autoload
+(progn
+  (define-key esc-map "." #'xref-find-definitions)
+  (define-key esc-map "," #'xref-pop-marker-stack)
+  (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
+  (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame))
+
+
+(provide 'xref)
+
+;;; xref.el ends here
-- 
1.7.10.4