Re: Generalizing find-definition

[Dmitry Gutov <dgutov@yandex.ru>]

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

Helmut Eller <eller.helmut@gmail.com> writes:

> I don't mind.  Rewrites welcome!

Ok, thanks. The modified proposal attached.

To be honest, now I can better see the appeal of using the classes here.
For instance, in the modified API a backend has to return `:none' in its
identifier-at-point implementation if not found, because otherwise the
default implementation will be called (and it's hard to implement the
overriding otherwise).

Although we could use a plist (or alist) instead of a
function-with-multiple-calling-conventions.

Suppose we end up using your implementation, do you think there could be
a reasonable case where a xref-backend-function creates a non-trivial
instance of its backend class, with instance vars, etc? Because
otherwise it'll remain an odd wart. Then the variable can just hold the
class symbol, and instantiation can be performed on-demain, or even each
time it's used: it's cheap anyway.

> Actually, the location stuff was the primary reason I started using
> EIEIO.  In SLIME we have quite a zoo of location variants (not based on
> EIEIO), e.g. file+byteoffset, file+charoffsets, search-strings, and
> something that we call "source-paths".  A source-path describes a path
> in the SEXP tree; sounds weird but works surprisingly well for Lisp
> syntax.
>
> Just want to say that locations should be very flexible.

Right, I can see how EIEIO can be useful in this case, so this is the
part I mostly left untouched, for now. However, it could be simplified:

* I'm pretty sure the default implementation of `xref-location=' will
  cover 99% of all cases.

* There's no real need for the above and `xref--unique-location'. We can
  just require the implementations to return lists without duplicates. I
  would think that most would do that even without being asked.

* What is `xref--show-location' for? Why do we want to allow certain
  types to override this behavior? I think `xref--show-xref-buffer' is
  also suspect at this stage of implementation.

`xref-location-group' is quite neat, though. But depending on whether we
really want to make this lighter-weight, the class hierarchy here can be
replaced with some ad-hoc polymorphism (so we could say that a location
can either be a (buffer position) (file line column), or, say, a closure
for the most general case).

-

I kept `etags--xref-read-identifier', but I don't particularly like it:
in other places, when we want to use a regexp, that's usually a
different command, or a prefix argument, etc. Inputting quotes to make
the contents work as a regexp is... odd.

-

The "identifier at point" and "read identifier" makes me wonder how it
would work with more complex languages, where we delegate a lot of logic
to an external server process. Will a two-request workflow become usual?
First ask the server what's at point, and then send it back with a
specific question. I guess some existing packages would be hard to adapt
to that.

-

We should probably port Jorgen's tests.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Modified xref proposal --]
[-- Type: text/x-diff, Size: 26546 bytes --]

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ba70f90..d2b4b21 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -227,10 +227,12 @@ Blank lines separate paragraphs.  Semicolons start comments.
 
 \\{emacs-lisp-mode-map}"
   :group 'lisp
+  (defvar xref-backend)
   (lisp-mode-variables nil nil 'elisp)
   (setq imenu-case-fold-search nil)
   (setq-local eldoc-documentation-function
               #'elisp-eldoc-documentation-function)
+  (setq-local xref-backend #'elisp-xref-backend)
   (add-hook 'completion-at-point-functions
             #'elisp-completion-at-point nil 'local))
 
@@ -548,6 +550,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-backend (action &optional id &rest args)
+  (pcase action
+    (`definitions (elisp--xref-lookup-definitions id))
+    (`read-identifier (elisp--xref-read-identifier id (car args)))))
+
+(defun elisp--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: unify with `elisp--company-location'.
+(defun elisp--xref-lookup-definitions (id)
+  (let ((sym (intern-soft id)))
+    (when sym
+      (let ((fun (if (fboundp sym) (elisp--find-xref sym nil)))
+            (var (if (boundp sym) (elisp--find-xref sym 'defvar))))
+        (remove nil (list fun var))))))
+
+(defun elisp--xref-read-identifier (id prompt)
+  (completing-read prompt obarray nil nil id))
+
 ;;; Elisp Interaction mode
 
 (defvar lisp-interaction-mode-map
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index b89b4cf..2a8a20d 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,63 @@ 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 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-backend (action &optional id &rest args)
+  (pcase action
+    (`definitions (etags--xref-lookup-definitions id))
+    (`read-identifier (etags--xref-read-identifier id (car args)))))
+
+(defun etags--xref-lookup-definitions (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.
+(defun etags--xref-read-identifier (id prompt)
+  (let ((string (completing-read prompt (tags-lazy-completion-table)
+                                 nil nil id)))
+    (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..f8c372e
--- /dev/null
+++ b/lisp/progmodes/xref.el
@@ -0,0 +1,486 @@
+;; 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".  It's a function,
+;; stored in the variable `xref-backend'.  A language-specific mode
+;; usually makes that variable buffer-local before storing into it.
+;;
+;; For `xref-backend' calling conventions, see its description.  In
+;; some cases, it has to operate with "xref" and "location" instances.
+;; One would usually call `make-xref' and `xref-make-file-location' or
+;; `xref-make-buffer-location' to create them.
+;;
+;; Another core notion is an identifier. Its representation is
+;; backend-specific.  By default it's a string but it can be any type.
+;; Two of the actions in `xref-backend' convert it to a string and back.
+;;
+;; See the functions `etags-xref-backend' and `elisp-xref-backend'
+;; for full examples.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'ring)
+
+\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 a 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
+
+;; For now, make the etags backend the default.
+(defvar xref-backend #'etags-xref-backend
+  "The current xref-backend.
+This function can be called with different sets of arguments, as
+described below.
+
+Required:
+
+ (definitions IDENTIFIER): Find definitions of IDENTIFIER.  The
+result must be a list of `xref--xref' objects.  If no definition
+can be found, return nil.
+
+ (references IDENTIFIER): Find references of IDENTIFIER.  The
+result must be a list of `xref--xref' objects.  If no reference
+can be found, return nil.
+
+Optional:
+
+ (read-identifier INIT PROMPT): Read an identifier from the
+minibuffer.  PROMPT is a string used for prompting.  INIT is
+either an identifier to use as the initial value or nil.
+
+ (identifier-at-point): Search and return the identfier near
+point.  If no identifier can be found, return `:none'.
+
+ (identifier-to-string IDENTIFIER): Return a string representing
+IDENTIFIER.")
+
+;;;; Backend interface functions
+
+(defun xref--call-backend (action &rest args)
+  (apply xref-backend action args))
+
+(defun xref--identifier-at-point ()
+  (let ((res (or (xref--call-backend 'identifier-at-point)
+                 (let ((thing (thing-at-point 'symbol)))
+                   (and thing (substring-no-properties thing))))))
+    (unless (eq res :none) res)))
+
+(defun xref--identifier-to-string (identifier)
+  (or (xref--call-backend 'identifier-to-string 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 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 ((id (xref--identifier-at-point)))
+    (cond ((or current-prefix-arg (not id))
+           (or (xref--call-backend 'read-identifier id prompt)
+               (read-from-minibuffer prompt
+                                     (if id (xref--identifier-to-string id)))))
+          (t id))))
+
+\f
+;;; Commands
+
+(defun xref--find-definitions (id window)
+  (xref--show-xrefs id "definitions"
+                    (xref--call-backend 'definitions 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--call-backend 'references 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
+(provide 'xref)
+
+;;; xref.el ends here