CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
(and (symbolp class) (eieio--class-p (eieio--class-v class))))
+(defun eieio--class-print-name (class)
+ "Return a printed representation of CLASS."
+ (format "#<class %s>" (eieio-class-name class)))
+
(defun eieio-class-name (class)
"Return a Lisp like symbol name for CLASS."
- ;; FIXME: What's a "Lisp like symbol name"?
- ;; FIXME: CLOS returns a symbol, but the code returns a string.
- (if (eieio--class-p class) (setq class (eieio--class-symbol class)))
- (cl-check-type class class)
- ;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
- ;; and I wanted a string. Arg!
- (format "#<class %s>" (symbol-name class)))
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (eieio--class-symbol class))
(define-obsolete-function-alias 'class-name #'eieio-class-name "24.4")
(defalias 'eieio--class-constructor #'identity
(newc (if (and oldc (not (eieio--class-default-object-cache oldc)))
;; The oldc class is a stub setup by eieio-defclass-autoload.
;; Reuse it instead of creating a new one, so that existing
- ;; references are still valid.
+ ;; references stay valid.
oldc
(eieio--class-make cname)))
(groups nil) ;; list of groups id'd from slots
;; Attach slot symbols into a hashtable, and store the index of
;; this slot as the value this table.
(let* ((cnt 0)
- (pubsyms (eieio--class-public-a newc))
- (prots (eieio--class-protection newc))
(oa (make-hash-table :test #'eq)))
- (while pubsyms
- (let ((newsym (list cnt)))
- (setf (gethash (car pubsyms) oa) newsym)
- (setq cnt (1+ cnt))
- (if (car prots) (setcdr newsym (car prots))))
- (setq pubsyms (cdr pubsyms)
- prots (cdr prots)))
+ (dolist (pubsym (eieio--class-public-a newc))
+ (setf (gethash pubsym oa) cnt)
+ (setq cnt (1+ cnt)))
(setf (eieio--class-symbol-hashtable newc) oa))
;; Set up a specialized doc string.
slot. If the slot is ok, return VALUE.
Argument FN is the function calling this verifier."
(if (and (eq value eieio-unbound) (not eieio-skip-typecheck))
- (slot-unbound instance (eieio--object-class-name instance) slotname fn)
+ (slot-unbound instance (eieio--object-class-object instance) slotname fn)
value))
\f
If SLOT is the value created with :initarg instead,
reverse-lookup that name, and recurse with the associated slot value."
;; Removed checks to outside this call
- (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
- (fsi (car fsym)))
+ (let* ((fsi (gethash slot (eieio--class-symbol-hashtable class))))
(if (integerp fsi)
(+ (eval-when-compile eieio--object-num-slots) fsi)
(let ((fn (eieio--initarg-to-attribute class slot)))
;; but hide it so we don't trigger indefinitely.
`(,(car whole) (identity ,(car slots))
,@(cdr slots)))))))
- (apply #'eieio-constructor ',name slots))))))
+ (apply #'make-instance ',name slots))))))
-;;; CLOS style implementation of object creators.
-;;
-(defun make-instance (class &rest initargs)
- "Make a new instance of CLASS based on INITARGS.
-CLASS is a class symbol. For example:
-
- (make-instance 'foo)
-
- INITARGS is a property list with keywords based on the :initarg
-for each slot. For example:
-
- (make-instance 'foo :slot1 value1 :slotN valueN)
-
-Compatibility note:
-
-If the first element of INITARGS is a string, it is used as the
-name of the class.
-
-In EIEIO, the class' constructor requires a name for use when printing.
-`make-instance' in CLOS doesn't use names the way Emacs does, so the
-class is used as the name slot instead when INITARGS doesn't start with
-a string."
- (apply (eieio--class-constructor class) initargs))
-
-\f
;;; Get/Set slots in an object.
;;
(defmacro oref (obj slot)
(defalias 'slot-value 'eieio-oref)
(defalias 'set-slot-value 'eieio-oset)
+(make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
(defmacro oref-default (obj slot)
"Get the default value of OBJ (maybe a class) for SLOT.
(declare (obsolete eieio-named "25.1")))
(defun eieio-object-name (obj &optional extra)
- "Return a Lisp like symbol string for object OBJ.
+ "Return a printed representation for object OBJ.
If EXTRA, include that in the string returned to represent the symbol."
(cl-check-type obj eieio-object)
(format "#<%s %s%s>" (eieio--object-class-name obj)
(defun eieio-object-class-name (obj)
"Return a Lisp like symbol name for OBJ's class."
(cl-check-type obj eieio-object)
- (eieio-class-name (eieio--object-class-name obj)))
+ (eieio-class-name (eieio--object-class-object obj)))
(define-obsolete-function-alias
'object-class-name 'eieio-object-class-name "24.4")
child (pop p)))
(if child t))))
+(defun eieio-slot-descriptor-name (slot) slot)
+
+(defun eieio-class-slots (class)
+ "Return list of slots available in instances of CLASS."
+ ;; FIXME: This only gives the instance slots and ignores the
+ ;; class-allocated slots.
+ ;; FIXME: It only gives the slot's *names* rather than actual
+ ;; slot descriptors.
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (eieio--class-public-a class))
+
(defun object-slots (obj)
"Return list of slots available in OBJ."
+ (declare (obsolete eieio-class-slots "25.1"))
(cl-check-type obj eieio-object)
- (eieio--class-public-a (eieio--object-class-object obj)))
+ (eieio-class-slots (eieio--object-class-object obj)))
(defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
(cl-check-type class eieio--class)
;;; Here are some CLOS items that need the CL package
;;
+;; FIXME: Shouldn't this be a more complex gv-expander which extracts the
+;; common code between oref and oset, so as to reduce the redundant work done
+;; in (push foo (oref bar baz)), like we do for the `nth' expander?
(gv-define-simple-setter eieio-oref eieio-oset)
\f
(defalias 'standard-class 'eieio-default-superclass)
-(cl-defgeneric eieio-constructor (class &rest slots)
- "Default constructor for CLASS `eieio-default-superclass'.")
+(cl-defgeneric make-instance (class &rest initargs)
+ "Make a new instance of CLASS based on INITARGS.
+For example:
+
+ (make-instance 'foo)
+
+INITARGS is a property list with keywords based on the `:initarg'
+for each slot. For example:
+
+ (make-instance 'foo :slot1 value1 :slotN valueN)")
-(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
+(define-obsolete-function-alias 'constructor #'make-instance "25.1")
-(cl-defmethod eieio-constructor
- ((class (subclass eieio-default-superclass)) &rest slots)
+(cl-defmethod make-instance
+ ((class (subclass eieio-default-superclass)) &rest slots)
"Default constructor for CLASS `eieio-default-superclass'.
-SLOTS are the initialization slots used by `shared-initialize'.
+SLOTS are the initialization slots used by `initialize-instance'.
This static method is called when an object is constructed.
It allocates the vector used to represent an EIEIO object, and then
-calls `shared-initialize' on that object."
+calls `initialize-instance' on that object."
(let* ((new-object (copy-sequence (eieio--class-default-object-cache
- (eieio--class-v class)))))
+ (eieio--class-object class)))))
(if (and slots
(let ((x (car slots)))
(or (stringp x) (null x))))
;; Return the created object.
new-object))
+;; FIXME: CLOS uses "&rest INITARGS" instead.
(cl-defgeneric shared-initialize (obj slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine.")
(eieio-oset obj rn (car (cdr slots)))))
(setq slots (cdr (cdr slots)))))
+;; FIXME: CLOS uses "&rest INITARGS" instead.
(cl-defgeneric initialize-instance (this &optional slots)
"Construct the new object THIS based on SLOTS.")
;; First, see if any of our defaults are `lambda', and
;; re-evaluate them and apply the value to our slots.
(let* ((this-class (eieio--object-class-object this))
- (slot (eieio--class-public-a this-class))
(defaults (eieio--class-public-d this-class)))
- (while slot
+ (dolist (slot (eieio--class-public-a this-class))
;; For each slot, see if we need to evaluate it.
;;
;; Paul Landes said in an email:
;; > web.
(let ((dflt (eieio-default-eval-maybe (car defaults))))
(when (not (eq dflt (car defaults)))
- (eieio-oset this (car slot) dflt) ))
+ (eieio-oset this slot dflt) ))
;; Next.
- (setq slot (cdr slot)
- defaults (cdr defaults))))
+ (setq defaults (cdr defaults))))
;; Shared initialize will parse our slots for us.
(shared-initialize this slots))
In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but
EIEIO can only dispatch on the first argument, so the first two are swapped."
- (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object)
+ (signal 'unbound-slot (list (eieio-class-name class)
+ (eieio-object-name object)
slot-name fn)))
(cl-defgeneric clone (obj &rest params)
((consp thing)
(eieio-list-prin1 thing))
((eieio--class-p thing)
- (princ (eieio-class-name thing)))
+ (princ (eieio--class-print-name thing)))
(t (prin1 thing))))
(defun eieio-list-prin1 (list)
Used as advice around `edebug-prin1-to-string', held in the
variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
`prin1-to-string' when appropriate."
- (cond ((eieio--class-p object) (eieio-class-name object))
+ (cond ((eieio--class-p object) (eieio--class-print-name object))
((eieio-object-p object) (object-print object))
((and (listp object) (or (eieio--class-p (car object))
(eieio-object-p (car object))))
projects / emacs.git / commitdiff