Skip to content

Commit

Permalink
Migrate Xref off EIEIO
Browse files Browse the repository at this point in the history 
To improve performance and flexibility (bug#50777).

* lisp/progmodes/xref.el (xref-location): Remove.
(xref-file-location): Change to cl-struct.
(xref-buffer-location, xref-bogus-location): Ditto.
(xref-item, xref-match-item): Same.
And update all method definitions accordingly.
(xref--insert-xrefs): Don't use 'oref', use 'xref-item-location'.
(xref--insert-xrefs, xref-show-definitions-completing-read):
Insetad of 'with-slots', use 'xref-item-summary' and
'xref-item-location'.

* lisp/progmodes/etags.el (xref-etags-location):
Change from EIEIO class into a cl-struct.
(xref-etags-apropos-location): Ditto.
Update all method definitions.

* test/lisp/progmodes/elisp-mode-tests.el (xref-elisp-test-run):
Avoid using 'oref'.
  • Loading branch information
@dgutov
dgutov committed Sep 30, 2021
1 parent 5c73dfc commit 86da812
Show file tree
Hide file tree
Showing 4 changed files with 104 additions and 123 deletions.
14 changes: 14 additions & 0 deletions etc/NEWS
View file
Expand Up @@ -3294,6 +3294,20 @@ file:

(add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1))

** Xref migrated from EIEIO to cl-defstruct for its core objects.
This means that 'oref' and 'with-slots' no longer works on them, and
'make-instance' can no longer be used to create those instances (which
wasn't recommended anyway). Packages should keep to using the
functions like 'xref-make', 'xref-make-match', 'xref-make-*-location',
as well as accessor functions 'xref-item-summary' and
'xref-item-location'.

Among the benefits are better performance (noticeable when there are a
lot of matches) and improved flexibility: 'xref-match-item' instances
do not require that 'location' inherits from 'xref-location' anymore
(that class was removed), so packages can create new location types to
use with "match items" without adding EIEIO as a dependency.


* Incompatible Lisp Changes in Emacs 28.1

Expand Down
37 changes: 15 additions & 22 deletions lisp/progmodes/etags.el
View file
Expand Up @@ -2161,18 +2161,16 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
(nreverse res))))
tags-apropos-additional-actions))

(defclass xref-etags-location (xref-location)
((tag-info :type list :initarg :tag-info)
(file :type string :initarg :file
:reader xref-location-group))
:documentation "Location of an etags tag.")
(cl-defstruct (xref-etags-location
(:constructor xref-make-etags-location (tag-info file)))
"Location of an etags tag."
tag-info file)

(defun xref-make-etags-location (tag-info file)
(make-instance 'xref-etags-location :tag-info tag-info
:file (expand-file-name file)))
(cl-defmethod xref-location-group ((l xref-etags-location))
(xref-etags-location-file l))

(cl-defmethod xref-location-marker ((l xref-etags-location))
(with-slots (tag-info file) l
(pcase-let (((cl-struct xref-etags-location tag-info file) l))
(let ((buffer (find-file-noselect file)))
(with-current-buffer buffer
(save-excursion
Expand All @@ -2182,25 +2180,20 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
(point-marker)))))))

(cl-defmethod xref-location-line ((l xref-etags-location))
(with-slots (tag-info) l
(pcase-let (((cl-struct xref-etags-location tag-info) l))
(nth 1 tag-info)))

(defclass xref-etags-apropos-location (xref-location)
((symbol :type symbol :initarg :symbol)
(goto-fun :type function :initarg :goto-fun)
(group :type string :initarg :group
:reader xref-location-group))
:documentation "Location of an additional apropos etags symbol.")
(cl-defstruct (xref-etags-apropos-location
(:constructor xref-make-etags-apropos-location (symbol goto-fun group)))
"Location of an additional apropos etags symbol."
symbol goto-fun group)

(defun xref-make-etags-apropos-location (symbol goto-fun group)
(make-instance 'xref-etags-apropos-location
:symbol symbol
:goto-fun goto-fun
:group group))
(cl-defmethod xref-location-group ((l xref-etags-apropos-location))
(xref-etags-apropos-location-group l))

(cl-defmethod xref-location-marker ((l xref-etags-apropos-location))
(save-window-excursion
(with-slots (goto-fun symbol) l
(pcase-let (((cl-struct xref-etags-apropos-location goto-fun symbol) l))
(funcall goto-fun symbol)
(point-marker))))

Expand Down
154 changes: 65 additions & 89 deletions lisp/progmodes/xref.el
View file
Expand Up @@ -46,9 +46,9 @@
;;
;; One would usually call `make-xref' and `xref-make-file-location',
;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
;; them. More generally, a location must be an instance of an EIEIO
;; class inheriting from `xref-location' and implementing
;; `xref-location-group' and `xref-location-marker'.
;; them. More generally, a location must be an instance of a type for
;; which methods `xref-location-group' and `xref-location-marker' are
;; implemented.
;;
;; There's a special kind of xrefs we call "match xrefs", which
;; correspond to search results. For these values,
Expand All @@ -62,12 +62,15 @@
;; distinct, because the user can't see the properties when making the
;; choice.
;;
;; Older versions of Xref used EIEIO for implementation of the
;; built-in types, and included a class called `xref-location' which
;; was supposed to be inherited from. Neither is true anymore.
;;
;; See the etags and elisp-mode implementations for full examples.

;;; Code:

(require 'cl-lib)
(require 'eieio)
(require 'ring)
(require 'project)

Expand All @@ -78,9 +81,6 @@

;;; Locations

(defclass xref-location () ()
:documentation "A location represents a position in a file or buffer.")

(cl-defgeneric xref-location-marker (location)
"Return the marker for LOCATION.")

Expand Down Expand Up @@ -121,19 +121,20 @@ in its full absolute form."

;; FIXME: might be useful to have an optional "hint" i.e. a string to
;; search for in case the line number is slightly out of date.
(defclass xref-file-location (xref-location)
((file :type string :initarg :file :reader xref-location-group)
(line :type fixnum :initarg :line :reader xref-location-line)
(column :type fixnum :initarg :column :reader xref-file-location-column))
:documentation "A file location is a file/line/column triple.
Line numbers start from 1 and columns from 0.")
(cl-defstruct (xref-file-location
(:constructor xref-make-file-location (file line column)))
"A file location is a file/line/column triple.
Line numbers start from 1 and columns from 0."
file line column)

(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))
(cl-defmethod xref-location-group ((l xref-file-location))
(xref-file-location-file l))

(cl-defmethod xref-location-line ((l xref-file-location))
(xref-file-location-line l))

(cl-defmethod xref-location-marker ((l xref-file-location))
(with-slots (file line column) l
(pcase-let (((cl-struct xref-file-location file line column) l))
(with-current-buffer
(or (get-file-buffer file)
(let ((find-file-suppress-same-file-warnings t))
Expand All @@ -151,77 +152,51 @@ Line numbers start from 1 and columns from 0.")
(forward-char column))
(point-marker))))))

(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))
(cl-defstruct (xref-buffer-location
(:constructor xref-make-buffer-location (buffer position)))
buffer position)

(cl-defmethod xref-location-marker ((l xref-buffer-location))
(with-slots (buffer position) l
(pcase-let (((cl-struct xref-buffer-location buffer position) l))
(let ((m (make-marker)))
(move-marker m position buffer))))

(cl-defmethod xref-location-group ((l xref-buffer-location))
(with-slots (buffer) l
(pcase-let (((cl-struct xref-buffer-location 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))
(cl-defstruct (xref-bogus-location
(:constructor xref-make-bogus-location (message)))
"Bogus locations are sometimes useful to indicate errors,
e.g. when we know that a function exists but the actual location
is not known."
message)

(cl-defmethod xref-location-marker ((l xref-bogus-location))
(user-error "%s" (oref l message)))
(user-error "%s" (xref-bogus-location-message l)))

(cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")


;;; Cross-reference

(defclass xref-item ()
((summary :type string :initarg :summary
:reader xref-item-summary
:documentation "One line which will be displayed for
this item in the output buffer.")
(location :initarg :location
:reader xref-item-location
:documentation "An object describing how to navigate
to the reference's target."))
:comment "An xref item describes a reference to a location
somewhere.")

(defun xref-make (summary location)
"Create and return a new `xref-item'.
SUMMARY is a short string to describe the xref.
LOCATION is an `xref-location'."
(make-instance 'xref-item :summary summary :location location))

(defclass xref-match-item ()
((summary :type string :initarg :summary
:reader xref-item-summary)
(location :initarg :location
:type xref-location
:reader xref-item-location)
(length :initarg :length :reader xref-match-length))
:comment "A match xref item describes a search result.")

(defun xref-make-match (summary location length)
"Create and return a new `xref-match-item'.
SUMMARY is a short string to describe the xref.
LOCATION is an `xref-location'.
LENGTH is the match length, in characters."
(make-instance 'xref-match-item :summary summary
:location location :length length))
(cl-defstruct (xref-item
(:constructor xref-make (summary location))
(:noinline t))
"An xref item describes a reference to a location somewhere."
summary location)

(cl-defstruct (xref-match-item
(:include xref-item)
(:constructor xref-make-match (summary location length))
(:noinline t))
"A match xref item describes a search result."
length)

(cl-defgeneric xref-match-length ((item xref-match-item))
"Return the length of the match."
(xref-match-item-length item))


;;; API
Expand Down Expand Up @@ -970,7 +945,7 @@ GROUP is a string for decoration purposes and XREF is an
for max-line-width =
(cl-loop for xref in xrefs
maximize (let ((line (xref-location-line
(oref xref location))))
(xref-item-location xref))))
(and line (1+ (floor (log line 10))))))
for line-format = (and max-line-width
(format "%%%dd: " max-line-width))
Expand All @@ -985,7 +960,7 @@ GROUP is a string for decoration purposes and XREF is an
(xref--insert-propertized '(face xref-file-header xref-group t)
group "\n")
(cl-loop for xref in xrefs do
(with-slots (summary location) xref
(pcase-let (((cl-struct xref-item summary location) xref))
(let* ((line (xref-location-line location))
(prefix
(cond
Expand Down Expand Up @@ -1206,22 +1181,23 @@ between them by typing in the minibuffer with completion."
(cl-loop for ((group . xrefs) . more1) on xref-alist
do
(cl-loop for (xref . more2) on xrefs do
(with-slots (summary location) xref
(let* ((line (xref-location-line location))
(line-fmt
(if line
(format #("%d:" 0 2 (face xref-line-number))
line)
""))
(group-prefix
(substring group group-prefix-length))
(group-fmt
(propertize group-prefix
'face 'xref-file-header
'xref--group group-prefix))
(candidate
(format "%s:%s%s" group-fmt line-fmt summary)))
(push (cons candidate xref) xref-alist-with-line-info)))))
(let* ((summary (xref-item-summary xref))
(location (xref-item-location xref))
(line (xref-location-line location))
(line-fmt
(if line
(format #("%d:" 0 2 (face xref-line-number))
line)
""))
(group-prefix
(substring group group-prefix-length))
(group-fmt
(propertize group-prefix
'face 'xref-file-header
'xref--group group-prefix))
(candidate
(format "%s:%s%s" group-fmt line-fmt summary)))
(push (cons candidate xref) xref-alist-with-line-info))))

(setq xref (if (not (cdr xrefs))
(car xrefs)
Expand Down
22 changes: 10 additions & 12 deletions test/lisp/progmodes/elisp-mode-tests.el
View file
Expand Up @@ -316,27 +316,27 @@
(expected (pop expected-xrefs))
(expected-xref (or (when (consp expected) (car expected)) expected))
(expected-source (when (consp expected) (cdr expected)))
(xref-file (xref-elisp-location-file (oref xref location)))
(xref-file (xref-elisp-location-file (xref-item-location xref)))
(expected-file (xref-elisp-location-file
(oref expected-xref location))))
(xref-item-location expected-xref))))

;; Make sure file names compare as strings.
(when (file-name-absolute-p xref-file)
(setf (xref-elisp-location-file (oref xref location))
(file-truename (xref-elisp-location-file (oref xref location)))))
(setf (xref-elisp-location-file (xref-item-location xref))
(file-truename (xref-elisp-location-file (xref-item-location xref)))))
(when (file-name-absolute-p expected-file)
(setf (xref-elisp-location-file (oref expected-xref location))
(setf (xref-elisp-location-file (xref-item-location expected-xref))
(file-truename (xref-elisp-location-file
(oref expected-xref location)))))
(xref-item-location expected-xref)))))

;; Downcase the filenames for case-insensitive file systems.
(when xref--case-insensitive
(setf (xref-elisp-location-file (oref xref location))
(downcase (xref-elisp-location-file (oref xref location))))
(setf (xref-elisp-location-file (xref-item-location xref))
(downcase (xref-elisp-location-file (xref-item-location xref))))

(setf (xref-elisp-location-file (oref expected-xref location))
(setf (xref-elisp-location-file (xref-item-location expected-xref))
(downcase (xref-elisp-location-file
(oref expected-xref location)))))
(xref-item-location expected-xref)))))

(should (equal xref expected-xref))

Expand Down Expand Up @@ -417,8 +417,6 @@ to (xref-elisp-test-descr-to-target xref)."

;; FIXME: defconst

;; FIXME: eieio defclass

;; Possible ways of defining the default method implementation for a
;; generic function. We declare these here, so we know we cover all
;; cases, and we don't rely on other code not changing.
Expand Down

0 comments on commit 86da812

Please sign in to comment.