summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2021-12-04 13:47:19 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2021-12-04 13:47:35 -0500
commitde727b5886fb4a81df2dc17d9d094e915c1e9fb4 (patch)
treec7e1f3ae109eb8cc6c11abf9391b25bf8d15b8cf /lisp/emacs-lisp
parent63be97fb050545cc33ae5d857188ad45fbe27715 (diff)
downloademacs-de727b5886fb4a81df2dc17d9d094e915c1e9fb4.tar.gz
emacs-de727b5886fb4a81df2dc17d9d094e915c1e9fb4.tar.bz2
emacs-de727b5886fb4a81df2dc17d9d094e915c1e9fb4.zip
eieio-core.el: Allow assignment to cl-structs through `slot-value`
* lisp/emacs-lisp/eieio-core.el (eieio--validate-slot-value): Obey the `:read-only` property of the slot. (eieio-oset): Allow use on cl-structs as well. (eieio-read-only): New error. * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test--struct): Make the last field read-only. (eieio-test-defstruct-slot-value): Test that cl-struct slots can be assigned via `slot-value`.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/eieio-core.el19
1 files changed, 12 insertions, 7 deletions
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 7c5babcf54c..ca47ec77f76 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -450,7 +450,7 @@ See `defclass' for more information."
))
;; Now that everything has been loaded up, all our lists are backwards!
- ;; Fix that up now and then them into vectors.
+ ;; Fix that up now and turn them into vectors.
(cl-callf (lambda (slots) (apply #'vector (nreverse slots)))
(eieio--class-slots newc))
(cl-callf nreverse (eieio--class-initarg-tuples newc))
@@ -704,11 +704,15 @@ an error."
nil
;; Trim off object IDX junk added in for the object index.
(setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
- (let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class)
- slot-idx))))
- (if (not (eieio--perform-slot-validation st value))
- (signal 'invalid-slot-type
- (list (eieio--class-name class) slot st value))))))
+ (let* ((sd (aref (eieio--class-slots class)
+ slot-idx))
+ (st (cl--slot-descriptor-type sd)))
+ (cond
+ ((not (eieio--perform-slot-validation st value))
+ (signal 'invalid-slot-type
+ (list (eieio--class-name class) slot st value)))
+ ((alist-get :read-only (cl--slot-descriptor-props sd))
+ (signal 'eieio-read-only (list (eieio--class-name class) slot)))))))
(defun eieio--validate-class-slot-value (class slot-idx value slot)
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
@@ -813,7 +817,7 @@ Fills in CLASS's SLOT with its default value."
(defun eieio-oset (obj slot value)
"Do the work for the macro `oset'.
Fills in OBJ's SLOT with VALUE."
- (cl-check-type obj eieio-object)
+ (cl-check-type obj (or eieio-object cl-structure-object))
(cl-check-type slot symbol)
(let* ((class (eieio--object-class obj))
(c (eieio--slot-name-index class slot)))
@@ -1063,6 +1067,7 @@ method invocation orders of the involved classes."
;;
(define-error 'invalid-slot-name "Invalid slot name")
(define-error 'invalid-slot-type "Invalid slot type")
+(define-error 'eieio-read-only "Read-only slot")
(define-error 'unbound-slot "Unbound slot")
(define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy")