mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
Make cl-defstruct use records.
* lisp/emacs-lisp/cl-extra.el (cl--describe-class) (cl--describe-class-slots): Use the new `type-of'. * lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): Use type-of. (cl--generic-struct-specializers): Adjust to new tag. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): When type is nil, use records. Use the type symbol as the tag. Use copy-record to copy structs. (cl--defstruct-predicate): New function. (cl--pcase-mutually-exclusive-p): Use it. (cl-struct-sequence-type): Can now return `record'. * lisp/emacs-lisp/cl-preloaded.el (cl--make-slot-desc): Adjust ad-hoc code to new format. (cl--struct-register-child): Work with records. (cl-struct-define): Don't touch the tag's symbol-value and symbol-function slots when we use the type as tag. * lisp/emacs-lisp/cl-print.el (cl-print-object): Adjust to new tag. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-defstruct-record): New test. * doc/lispref/records.texi, doc/misc/cl.texi: Update for records.
This commit is contained in:
parent
a2c3343029
commit
0565482838
8 changed files with 87 additions and 74 deletions
|
|
@ -775,8 +775,7 @@ including `cl-block' and `cl-eval-when'."
|
|||
(defun cl--describe-class (type &optional class)
|
||||
(unless class (setq class (cl--find-class type)))
|
||||
(let ((location (find-lisp-object-file-name type 'define-type))
|
||||
;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch.
|
||||
(metatype (cl--class-name (symbol-value (aref class 0)))))
|
||||
(metatype (type-of class)))
|
||||
(insert (symbol-name type)
|
||||
(substitute-command-keys " is a type (of kind `"))
|
||||
(help-insert-xref-button (symbol-name metatype)
|
||||
|
|
@ -901,8 +900,7 @@ including `cl-block' and `cl-eval-when'."
|
|||
"Print help description for the slots in CLASS.
|
||||
Outputs to the current buffer."
|
||||
(let* ((slots (cl--class-slots class))
|
||||
;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch.
|
||||
(metatype (cl--class-name (symbol-value (aref class 0))))
|
||||
(metatype (type-of class))
|
||||
;; ¡For EIEIO!
|
||||
(cslots (condition-case nil
|
||||
(cl-struct-slot-value metatype 'class-slots class)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue