[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 394ce95 1/2: Consolidate cross-referencing commands
|
From: |
Dmitry Gutov |
|
Subject: |
[Emacs-diffs] master 394ce95 1/2: Consolidate cross-referencing commands |
|
Date: |
Thu, 25 Dec 2014 20:20:23 +0000 |
branch: master
commit 394ce9514f0f0b473e4e8974b8529d0389fb627e
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>
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.
---
etc/NEWS | 19 ++
lisp/ChangeLog | 30 +++
lisp/progmodes/elisp-mode.el | 88 ++++++--
lisp/progmodes/etags.el | 97 ++++++---
lisp/progmodes/xref.el | 499 ++++++++++++++++++++++++++++++++++++++++++
5 files changed, 682 insertions(+), 51 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 16aa297..37806a7 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 6b0f296..a2bee14 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,33 @@
+2014-12-25 Helmut Eller <address@hidden>
+ Dmitry Gutov <address@hidden>
+
+ 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 <address@hidden>
* cus-start.el (resize-mini-windows): Make it customizable.
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ba70f90..e73c20d 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 b89b4cf..c6a421a 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 0000000..30d28ff
--- /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