summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/eieio-core.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp/eieio-core.el')
-rw-r--r--lisp/emacs-lisp/eieio-core.el96
1 files changed, 54 insertions, 42 deletions
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 8a09f071e2e..7fcf85c1ced 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -261,6 +261,8 @@ It creates an autoload function for CNAME's constructor."
(and (eieio-object-p obj)
(object-of-class-p obj class))))
+(defvar eieio--known-slot-names nil)
+
(defun eieio-defclass-internal (cname superclasses slots options)
"Define CNAME as a new subclass of SUPERCLASSES.
SLOTS are the slots residing in that class definition, and OPTIONS
@@ -473,7 +475,7 @@ See `defclass' for more information."
(put cname 'variable-documentation docstring)))
;; Save the file location where this class is defined.
- (add-to-list 'current-load-list `(eieio-defclass . ,cname))
+ (add-to-list 'current-load-list `(define-type . ,cname))
;; We have a list of custom groups. Store them into the options.
(let ((g (eieio--class-option-assoc options :custom-groups)))
@@ -603,47 +605,48 @@ if default value is nil."
:key #'cl--slot-descriptor-name)))
(cold (car (cl-member a (eieio--class-class-slots newc)
:key #'cl--slot-descriptor-name))))
- (condition-case nil
- (if (sequencep d) (setq d (copy-sequence d)))
- ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's
- ;; skip it if it doesn't work.
- (error nil))
- ;; (if (sequencep type) (setq type (copy-sequence type)))
- ;; (if (sequencep cust) (setq cust (copy-sequence cust)))
- ;; (if (sequencep custg) (setq custg (copy-sequence custg)))
-
- ;; To prevent override information w/out specification of storage,
- ;; we need to do this little hack.
- (if cold (setq alloc :class))
-
- (if (memq alloc '(nil :instance))
- ;; In this case, we modify the INSTANCE version of a given slot.
- (progn
- ;; Only add this element if it is so-far unique
- (if (not old)
- (progn
- (eieio--perform-slot-validation-for-default slot skipnil)
- (push slot (eieio--class-slots newc))
- )
- ;; When defaultoverride is true, we are usually adding new local
- ;; attributes which must override the default value of any slot
- ;; passed in by one of the parent classes.
- (when defaultoverride
- (eieio--slot-override old slot skipnil)))
- (when init
- (cl-pushnew (cons init a) (eieio--class-initarg-tuples newc)
- :test #'equal)))
-
- ;; CLASS ALLOCATED SLOTS
- (if (not cold)
+ (cl-pushnew a eieio--known-slot-names)
+ (condition-case nil
+ (if (sequencep d) (setq d (copy-sequence d)))
+ ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's
+ ;; skip it if it doesn't work.
+ (error nil))
+ ;; (if (sequencep type) (setq type (copy-sequence type)))
+ ;; (if (sequencep cust) (setq cust (copy-sequence cust)))
+ ;; (if (sequencep custg) (setq custg (copy-sequence custg)))
+
+ ;; To prevent override information w/out specification of storage,
+ ;; we need to do this little hack.
+ (if cold (setq alloc :class))
+
+ (if (memq alloc '(nil :instance))
+ ;; In this case, we modify the INSTANCE version of a given slot.
(progn
- (eieio--perform-slot-validation-for-default slot skipnil)
- ;; Here we have found a :class version of a slot. This
- ;; requires a very different approach.
- (push slot (eieio--class-class-slots newc)))
- (when defaultoverride
- ;; There is a match, and we must override the old value.
- (eieio--slot-override cold slot skipnil))))))
+ ;; Only add this element if it is so-far unique
+ (if (not old)
+ (progn
+ (eieio--perform-slot-validation-for-default slot skipnil)
+ (push slot (eieio--class-slots newc))
+ )
+ ;; When defaultoverride is true, we are usually adding new local
+ ;; attributes which must override the default value of any slot
+ ;; passed in by one of the parent classes.
+ (when defaultoverride
+ (eieio--slot-override old slot skipnil)))
+ (when init
+ (cl-pushnew (cons init a) (eieio--class-initarg-tuples newc)
+ :test #'equal)))
+
+ ;; CLASS ALLOCATED SLOTS
+ (if (not cold)
+ (progn
+ (eieio--perform-slot-validation-for-default slot skipnil)
+ ;; Here we have found a :class version of a slot. This
+ ;; requires a very different approach.
+ (push slot (eieio--class-class-slots newc)))
+ (when defaultoverride
+ ;; There is a match, and we must override the old value.
+ (eieio--slot-override cold slot skipnil))))))
(defun eieio-copy-parents-into-subclass (newc)
"Copy into NEWC the slots of PARENTS.
@@ -720,9 +723,18 @@ Argument FN is the function calling this verifier."
;;; Get/Set slots in an object.
-;;
+
(defun eieio-oref (obj slot)
"Return the value in OBJ at SLOT in the object vector."
+ (declare (compiler-macro
+ (lambda (exp)
+ (ignore obj)
+ (pcase slot
+ ((and (or `',name (and name (pred keywordp)))
+ (guard (not (memq name eieio--known-slot-names))))
+ (macroexp--warn-and-return
+ (format "Unknown slot `%S'" name) exp 'compile-only))
+ (_ exp)))))
(cl-check-type slot symbol)
(cl-check-type obj (or eieio-object class))
(let* ((class (cond ((symbolp obj)