Re: Generalizing find-definition

[Helmut Eller <eller.helmut@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1543 bytes --]

On Mon, Dec 08 2014, Stefan Monnier wrote:

> What happened to the other contenders?

Nothing in particular.  The competition is still open.

>> +  (setq-local xref-backend-function 'xref-elisp-backend-function)
>>    (add-hook 'completion-at-point-functions
>>              #'elisp-completion-at-point nil 'local))
>
> Hmm, so xref-elisp-backend-function is not in elisp-mode.el?
> That's too bad.

The elisp backend code needs to define a subclass of xref-backend-class
and that can't be done without loading xref.el and eieio, I think.
elisp-mode is needed to create the *scratch* buffer and it seemed to me
that loading xref.el so early increases startup time for no good reason.

find-func.el might be a reasonable place for the elisp-xref backend
code.

>> +(defvaralias 'find-tag-marker-ring 'xref--marker-ring)
>> +(make-obsolete-variable 'find-tag-marker-ring nil "25.1")
>
> You can use define-obsolete-variable-alias.

OK.

>> +;; For now, make the etags backend the default.
>> +(defvar xref-backend-function 'etags-xref-backend-function)
>
> IIUC this is the main interface between xref and its backends, so it
> very much needs a good docstring.

I added a docstring here and in a few other places.

> Also, I don't understand why it should be a function that returns
> a "backend object" rather than being the backend object itself.

The indirection makes it easier to autoload xref.el.  If emacs-lisp-mode
wants to create a backend object it has to load xref.el first, which as
I said above seems undesirable.

Updated patch:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Generalized-infrastructure-for-find-definition.patch --]
[-- Type: text/x-diff, Size: 27172 bytes --]

From 031e27d9836aa6e0dc6223f3beaf3d0120e4007a Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Mon, 8 Dec 2014 20:26:50 +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

* progmodes/elisp-mode.el (emacs-lisp-mode): Initialize
xref-backend-function.
---
 lisp/ChangeLog               |   18 ++
 lisp/progmodes/elisp-mode.el |    1 +
 lisp/progmodes/etags.el      |   80 +++++--
 lisp/progmodes/xref.el       |  522 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 598 insertions(+), 23 deletions(-)
 create mode 100644 lisp/progmodes/xref.el

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b3cb2fa..46baac5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,21 @@
+2014-12-07  Helmut Eller  <eller.helmut@gmail.com>
+
+	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
+
+	* progmodes/elisp-mode.el (emacs-lisp-mode): Initialize
+	xref-backend-function.
+
 2014-12-05  Juri Linkov  <juri@linkov.net>
 
 	* comint.el (comint-history-isearch-search)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ba70f90..b9caf69 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 #'xref-elisp-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..cd2e00b 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)))
 \f
 (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,57 @@ 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)))))
+
+\f
+;;; 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)
+
+(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 (funcall search-fun pattern nil t)
+	    (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 ((_ etags--xref-backend)
+						 prompt init)
+  (let ((string (read-from-minibuffer prompt init)))
+    (cond ((string-match "^\"" string)
+	   `(rx ,(read string)))
+	  (t
+	   string))))
+
 \f
 (provide 'etags)
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
new file mode 100644
index 0000000..6afc82d
--- /dev/null
+++ b/lisp/progmodes/xref.el
@@ -0,0 +1,522 @@
+;; 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 `xref--elisp-backend'
+;; and `etags--xref-backend' classes for examples.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'ring)
+(require 'find-func) ; for elisp backend
+
+\f
+;;; 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)))
+
+\f
+;;; 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))
+
+\f
+;;; 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 init)
+  (read-from-minibuffer prompt (xref-identifier-to-string backend init)))
+
+(defmethod xref-identifier-to-string (_backend identifier)
+  (with-output-to-string (princ identifier)))
+
+\f
+;;; 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))))
+
+\f
+;;; 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)))))
+
+\f
+(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)))))
+
+\f
+;;; 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)))))
+
+\f
+;; 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))))
+
+\f
+;;; 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))
+
+\f
+;;; 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))
+
+\f
+;;; ELisp backend
+
+;; This is defined here and not in elisp-mode.el so that we don't need
+;; to load xref.el just to create the *scratch* buffer.
+
+;; For now, this is just a wrapper around find-func.el in particular
+;; `find-definition-noselect'.
+
+(defclass xref--elisp-backend (xref-backend-class) ())
+
+(defvar xref--elisp-backend-var (make-instance 'xref--elisp-backend))
+
+;;;###autoload
+(defun xref-elisp-backend-function () xref--elisp-backend-var)
+
+(defun xref--elisp-find-definition (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 ((_ xref--elisp-backend) id)
+  (let ((sym (intern-soft id)))
+    (if (null sym)
+	'()
+      (let ((fun (if (fboundp sym) (xref--elisp-find-definition sym nil)))
+	    (var (if (boundp sym) (xref--elisp-find-definition sym 'defvar))))
+	(remove nil (list fun var))))))
+
+\f
+(provide 'xref)
+
+;;; xref.el ends here
-- 
1.7.10.4