mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/emacs-lisp/cl-preloaded.el: Fix the format of props in slot-descs

Browse source 
(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.
This commit is contained in:
Stefan Monnier 2021-06-24 17:32:20 -04:00
parent 1283e1db9b
commit 3788d2237d
2 changed files with 13 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

10
lisp/emacs-lisp/cl-extra.el
View file

@ -901,14 +901,8 @@ Outputs to the current buffer."
(list (cl-prin1-to-string (cl--slot-descriptor-name slot)) (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-type slot))
(cl-prin1-to-string (cl--slot-descriptor-initform slot)) (cl-prin1-to-string (cl--slot-descriptor-initform slot))
(let ((doc (let ((doc (alist-get :documentation
;; The props are an alist in a `defclass', (cl--slot-descriptor-props slot))))
;; 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))))
(if (not doc) "" (if (not doc) ""
(setq has-doc t) (setq has-doc t)
(substitute-command-keys doc))))) (substitute-command-keys doc)))))

21
lisp/emacs-lisp/cl-preloaded.el
View file

@ -124,12 +124,11 @@ supertypes from the most specific to least specific.")
(get name 'cl-struct-print)) (get name 'cl-struct-print))
(cl--find-class name))))) (cl--find-class name)))))
(defun cl--plist-remove (plist member) (defun cl--plist-to-alist (plist)
(cond (let ((res '()))
((null plist) nil) (while plist
((null member) plist) (push (cons (pop plist) (pop plist)) res))
((eq plist member) (cddr plist)) (nreverse res)))
(t `(,(car plist) ,(cadr plist) ,@(cl--plist-remove (cddr plist) member)))))
(defun cl--struct-register-child (parent tag) (defun cl--struct-register-child (parent tag)
;; Can't use (cl-typep parent 'cl-structure-class) at this stage ;; 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) (i 0)
(offset (if type 0 1))) (offset (if type 0 1)))
(dolist (slot slots) (dolist (slot slots)
(let* ((props (cddr slot)) (let* ((props (cl--plist-to-alist (cddr slot)))
(typep (plist-member props :type)) (typep (assq :type props))
(type (if typep (cadr typep) t))) (type (if (null typep) t
(setq props (delq typep props))
(cdr typep))))
(aset v i (cl--make-slot-desc (aset v i (cl--make-slot-desc
(car slot) (nth 1 slot) (car slot) (nth 1 slot)
type (cl--plist-remove props typep)))) type props)))
(puthash (car slot) (+ i offset) index-table) (puthash (car slot) (+ i offset) index-table)
(cl-incf i)) (cl-incf i))
v)) v))