emacs-diffs
[Top][All Lists]
Advanced

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

master 3788d22: * lisp/emacs-lisp/cl-preloaded.el: Fix the format of pro


From: Stefan Monnier
Subject: master 3788d22: * lisp/emacs-lisp/cl-preloaded.el: Fix the format of props in slot-descs
Date: Thu, 24 Jun 2021 17:32:25 -0400 (EDT)

branch: master
commit 3788d2237d4c65b67b95e33d1aca8d8b41780429
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * lisp/emacs-lisp/cl-preloaded.el: Fix the format of props in slot-descs
    
    (cl--plist-remove): Remove.
    (cl--plist-to-alist): New function.
    (cl-struct-define): Use it to convert slots's properties to the
    format expected by `cl-slot-descriptor`.
    
    * lisp/emacs-lisp/cl-extra.el (cl--describe-class-slots): Revert last
    changes, not needed any more.
---
 lisp/emacs-lisp/cl-extra.el     | 10 ++--------
 lisp/emacs-lisp/cl-preloaded.el | 21 +++++++++++----------
 2 files changed, 13 insertions(+), 18 deletions(-)

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index c30349d..3840d13 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -901,14 +901,8 @@ Outputs to the current buffer."
                (list (cl-prin1-to-string (cl--slot-descriptor-name slot))
                      (cl-prin1-to-string (cl--slot-descriptor-type slot))
                      (cl-prin1-to-string (cl--slot-descriptor-initform slot))
-                     (let ((doc
-                            ;; The props are an alist in a `defclass',
-                            ;; but a plist when describing a `cl-defstruct'.
-                            (if (consp (car (cl--slot-descriptor-props slot)))
-                                (alist-get :documentation
-                                           (cl--slot-descriptor-props slot))
-                              (plist-get (cl--slot-descriptor-props slot)
-                                         :documentation))))
+                     (let ((doc (alist-get :documentation
+                                           (cl--slot-descriptor-props slot))))
                        (if (not doc) ""
                          (setq has-doc t)
                          (substitute-command-keys doc)))))
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 7365e23..ef60b26 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -124,12 +124,11 @@ supertypes from the most specific to least specific.")
                             (get name 'cl-struct-print))
           (cl--find-class name)))))
 
-(defun cl--plist-remove (plist member)
-  (cond
-   ((null plist) nil)
-   ((null member) plist)
-   ((eq plist member) (cddr plist))
-   (t `(,(car plist) ,(cadr plist) ,@(cl--plist-remove (cddr plist) member)))))
+(defun cl--plist-to-alist (plist)
+  (let ((res '()))
+    (while plist
+      (push (cons (pop plist) (pop plist)) res))
+    (nreverse res)))
 
 (defun cl--struct-register-child (parent tag)
   ;; Can't use (cl-typep parent 'cl-structure-class) at this stage
@@ -164,12 +163,14 @@ supertypes from the most specific to least specific.")
                        (i 0)
                        (offset (if type 0 1)))
                    (dolist (slot slots)
-                     (let* ((props (cddr slot))
-                            (typep (plist-member props :type))
-                            (type (if typep (cadr typep) t)))
+                     (let* ((props (cl--plist-to-alist (cddr slot)))
+                            (typep (assq :type props))
+                            (type (if (null typep) t
+                                    (setq props (delq typep props))
+                                    (cdr typep))))
                        (aset v i (cl--make-slot-desc
                                   (car slot) (nth 1 slot)
-                                  type (cl--plist-remove props typep))))
+                                  type props)))
                      (puthash (car slot) (+ i offset) index-table)
                      (cl-incf i))
                    v))



reply via email to

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