emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

emacs-28 86da812: Migrate Xref off EIEIO


From: Dmitry Gutov
Subject: emacs-28 86da812: Migrate Xref off EIEIO
Date: Thu, 30 Sep 2021 17:03:34 -0400 (EDT)

branch: emacs-28
commit 86da812afb2572c7fead2bb07570b976bffd7c55
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>

    Migrate Xref off EIEIO
    
    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'.
---
 etc/NEWS                                |  14 +++
 lisp/progmodes/etags.el                 |  37 ++++----
 lisp/progmodes/xref.el                  | 154 ++++++++++++++------------------
 test/lisp/progmodes/elisp-mode-tests.el |  22 +++--
 4 files changed, 104 insertions(+), 123 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index b9f5830..10a4657 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
 
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index e6af2b1..f53b09d 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -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
@@ -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))))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 8906f63..f151a98 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -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,
@@ -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)
 
@@ -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.")
 
@@ -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))
@@ -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
@@ -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))
@@ -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
@@ -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)
diff --git a/test/lisp/progmodes/elisp-mode-tests.el 
b/test/lisp/progmodes/elisp-mode-tests.el
index bc94aaa..a3449c2 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -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))
 
@@ -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.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]