From: Dmitry Gutov <dgutov@yandex.ru>
Date: Thu, 25 Dec 2014 20:08:19 +0000 (+0200)
Subject: Consolidate cross-referencing commands
X-Git-Tag: emacs-25.0.90~2634^2~7
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=394ce9514f0f0b473e4e8974b8529d0389fb627e;p=emacs.git

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.
---

diff --git a/etc/NEWS b/etc/NEWS
index 16aa297aed0..37806a7fe56 100644
--- a/etc/NEWS
+++ b/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
 
 ---
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6b0f2961d65..a2bee149b7f 100644
--- a/lisp/ChangeLog
+++ b/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.
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ba70f903b4b..e73c20df263 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/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
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index b89b4cf0fe5..c6a421a3173 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
@@ -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)
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
new file mode 100644
index 00000000000..30d28ffe4c9
--- /dev/null
+++ b/lisp/progmodes/xref.el
@@ -0,0 +1,499 @@
+;; 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 `xref-find-function',
+;; `xref-identifier-at-point-function' and
+;; `xref-identifier-completion-table-function', which see.
+;;
+;; A major mode should make these variables buffer-local first.
+;;
+;; `xref-find-function' can be called in several ways, see its
+;; description.  It has to operate with "xref" and "location" values.
+;;
+;; One would usually call `make-xref' and `xref-make-file-location',
+;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
+;; them.
+;;
+;; Each identifier must be represented as a string.  Implementers can
+;; use string properties to store additional information about the
+;; identifier, but they should keep in mind that values returned from
+;; `xref-identifier-completion-table-function' should still be
+;; distinct, because the user can't see the properties when making the
+;; choice.
+;;
+;; See the functions `etags-xref-find' and `elisp-xref-find' for full
+;; examples.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'ring)
+
+(defgroup xref nil "Cross-referencing commands"
+  :group 'tools)
+
+
+;;; 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-marker (location)
+  "Return the marker for LOCATION.")
+
+(defgeneric xref-location-group (location)
+  "Return a string used to group a set of locations.
+This is typically the filename.")
+
+;;;; 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-marker ((l xref-file-location))
+  (with-slots (file line column) l
+    (with-current-buffer
+        (or (get-file-buffer file)
+            (let ((find-file-suppress-same-file-warnings t))
+              (find-file-noselect file)))
+      (save-restriction
+        (widen)
+        (save-excursion
+          (goto-char (point-min))
+          (beginning-of-line line)
+          (move-to-column column)
+          (point-marker))))))
+
+(defmethod xref-location-group ((l xref-file-location))
+  (oref l :file))
+
+(defclass xref-buffer-location (xref-location)
+  ((buffer :type buffer :initarg :buffer)
+   (position :type fixnum :initarg :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))
+
+(defmethod xref-location-marker ((l xref-buffer-location))
+  (with-slots (buffer position) l
+    (let ((m (make-marker)))
+      (move-marker m position buffer))))
+
+(defmethod xref-location-group ((l xref-buffer-location))
+  (with-slots (buffer) l
+    (or (buffer-file-name buffer)
+        (format "(buffer %s)" (buffer-name buffer)))))
+
+(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-marker ((l xref-bogus-location))
+  (user-error "%s" (oref l :message)))
+
+(defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
+
+
+;;; 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))
+
+
+;;; API
+
+(declare-function etags-xref-find "etags" (action id))
+(declare-function tags-lazy-completion-table "etags" ())
+
+;; For now, make the etags backend the default.
+(defvar xref-find-function #'etags-xref-find
+  "Function to look for cross-references.
+It can be called in several ways:
+
+ (definitions IDENTIFIER): Find definitions of IDENTIFIER.  The
+result must be a list of xref objects.  If no definitions can be
+found, return nil.
+
+ (references IDENTIFIER): Find references of IDENTIFIER.  The
+result must be a list of xref objects.  If no references can be
+found, return nil.
+
+ (apropos PATTERN): Find all symbols that match PATTERN.  PATTERN
+is a regexp.
+
+IDENTIFIER can be any string returned by
+`xref-identifier-at-point-function', or from the table returned
+by `xref-identifier-completion-table-function'.
+
+To create an xref object, call `xref-make'.")
+
+(defvar xref-identifier-at-point-function #'xref-default-identifier-at-point
+  "Function to get the relevant identifier at point.
+
+The return value must be a string or nil.  nil means no
+identifier at point found.
+
+If it's hard to determinte the identifier precisely (e.g. because
+it's a method call on unknown type), the implementation can
+return a simple string (such as symbol at point) marked with a
+special text property which `xref-find-function' would recognize
+and then delegate the work to an external process.")
+
+(defvar xref-identifier-completion-table-function #'tags-lazy-completion-table
+  "Function that returns the completion table for identifiers.")
+
+(defun xref-default-identifier-at-point ()
+  (let ((thing (thing-at-point 'symbol)))
+    (and thing (substring-no-properties thing))))
+
+
+;;; 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)
+
+(defcustom xref-marker-ring-length 16
+  "Length of the xref marker ring."
+  :type 'integer
+  :version "25.1")
+
+(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."
+  (let ((marker (xref-location-marker location)))
+    (set-buffer (marker-buffer marker))
+    (cond ((and (<= (point-min) marker) (<= marker (point-max))))
+          (widen-automatically (widen))
+          (t (error "Location is outside accessible part of buffer")))
+    (goto-char marker)))
+
+(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)))
+
+(defun xref--show-location (location)
+  (condition-case err
+      (progn
+        (xref--goto-location location)
+        (xref--display-position (point) t 1))
+    (user-error (message (error-message-string err)))))
+
+(defun xref--next-line (backward)
+  (let ((loc (xref--search-property 'xref-location backward)))
+    (when loc
+      (save-window-excursion
+        (xref--show-location loc)
+        (sit-for most-positive-fixnum)))))
+
+(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")))
+
+(defvar-local xref--window nil)
+
+(defun xref-goto-xref ()
+  "Jump to the xref at point and bury the xref buffer."
+  (interactive)
+  (let ((loc (xref--location-at-point))
+        (window xref--window))
+    (quit-window)
+    (xref--pop-to-location loc 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))
+
+(defconst xref-buffer-name "*xref*"
+  "The name of the buffer to show xrefs.")
+
+(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")))))
+
+(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 window)
+  (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))
+        (setq xref--window window)
+        (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 off to
+;; xref-show-xrefs-function.
+
+(defvar xref-show-xrefs-function 'xref--show-xref-buffer
+  "Function to display a list of xrefs.")
+
+(defun xref--show-xrefs (id kind xrefs window)
+  (cond
+   ((null xrefs)
+    (error "No known %s for: %s" kind id))
+   ((not (cdr xrefs))
+    (xref-push-marker-stack)
+    (xref--pop-to-location (xref--xref-location (car xrefs)) window))
+   (t
+    (xref-push-marker-stack)
+    (funcall xref-show-xrefs-function xrefs window))))
+
+(defun xref--read-identifier (prompt)
+  "Return the identifier at point or read it from the minibuffer."
+  (let ((id (funcall xref-identifier-at-point-function)))
+    (cond ((or current-prefix-arg (not id))
+           (completing-read prompt
+                            (funcall xref-identifier-completion-table-function)
+                            nil t id))
+          (t id))))
+
+
+;;; Commands
+
+(defun xref--find-definitions (id window)
+  (xref--show-xrefs id "definitions"
+                    (funcall xref-find-function '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 frame."
+  (interactive (list (xref--read-identifier "Find definitions of: ")))
+  (xref--find-definitions identifier 'frame))
+
+;;;###autoload
+(defun xref-find-references (identifier)
+  "Find references to the identifier at point.
+With prefix argument, prompt for the identifier."
+  (interactive (list (xref--read-identifier "Find references of: ")))
+  (xref--show-xrefs identifier "references"
+                    (funcall xref-find-function 'references identifier)
+                    nil))
+
+;;;###autoload
+(defun xref-find-apropos (pattern)
+  "Find all meaningful symbols that match PATTERN.
+The argument has the same meaning as in `apropos'."
+  (interactive (list (read-from-minibuffer
+                      "Search for pattern (word list or regexp): ")))
+  (require 'apropos)
+  (xref--show-xrefs pattern "apropos"
+                    (funcall xref-find-function 'apropos
+                             (apropos-parse-pattern
+                              (if (string-equal (regexp-quote pattern) pattern)
+                                  ;; Split into words
+                                  (or (split-string pattern "[ \t]+" t)
+                                      (user-error "No word list given"))
+                                pattern)))
+                    nil))
+
+
+;;; Key bindings
+
+;;;###autoload (define-key esc-map "." #'xref-find-definitions)
+;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
+;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
+;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
+;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
+
+
+(provide 'xref)
+
+;;; xref.el ends here