diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2021-06-24 17:32:20 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2021-06-24 17:32:20 -0400 |
commit | 3788d2237d4c65b67b95e33d1aca8d8b41780429 (patch) | |
tree | 10958829590b9512e6ffdbbe71941e6c31490289 /lisp/emacs-lisp | |
parent | 1283e1db9b7750a90472e7d557fdd75fcaff6446 (diff) | |
download | emacs-3788d2237d4c65b67b95e33d1aca8d8b41780429.tar.gz emacs-3788d2237d4c65b67b95e33d1aca8d8b41780429.tar.bz2 emacs-3788d2237d4c65b67b95e33d1aca8d8b41780429.zip |
* 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.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/cl-extra.el | 10 | ||||
-rw-r--r-- | 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 c30349de6bb..3840d13ecff 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 7365e23186a..ef60b266f9e 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)) |