"A stack of the classes currently in scope during method invocation.")
(defun eieio--scoped-class ()
- "Return the class currently in scope, or nil."
+ "Return the class object currently in scope, or nil."
(car-safe eieio--scoped-class-stack))
(defmacro eieio--with-scoped-class (class &rest forms)
"Set CLASS as the currently scoped class while executing FORMS."
(declare (indent 1))
- `(unwind-protect
- (progn
- (push ,class eieio--scoped-class-stack)
- ,@forms)
- (pop eieio--scoped-class-stack)))
+ `(let ((eieio--scoped-class-stack (cons ,class eieio--scoped-class-stack)))
+ ,@forms))
;;;
;; Field Accessors
Stored outright without modifications or stripping.")))
(eieio--define-field-accessors object
- (-unused-0 ;;Constant slot, set to `object'.
- (class "class struct defining OBJ")))
+ ;; `class-tag' holds a symbol, which is not the class name, but is instead
+ ;; properly prefixed as an internal EIEIO thingy and which holds the class
+ ;; object/struct in its `symbol-value' slot.
+ ((class-tag "tag containing the class struct")))
+
+(defsubst eieio--object-class-object (obj)
+ (symbol-value (eieio--object-class-tag obj)))
+
+(defsubst eieio--object-class-name (obj)
+ ;; FIXME: Most uses of this function should be changed to use
+ ;; eieio--object-class-object instead!
+ (eieio--class-symbol (eieio--object-class-object obj)))
;; FIXME: The constants below should have an `eieio-' prefix added!!
(defconst eieio--method-static 0 "Index into :static tag on a method.")
(t `(,type ,obj))))
(signal 'wrong-type-argument (list ',type ,obj))))
-(defmacro eieio--class-v (class)
+(defmacro eieio--class-v (class) ;Use a macro, so it acts as a GV place.
"Internal: Return the class vector from the CLASS symbol."
(declare (debug t))
;; No check: If eieio gets this far, it has probably been checked already.
`(get ,class 'eieio-class-definition))
+(defsubst eieio--class-object (class)
+ "Return the class object."
+ (if (symbolp class) (eieio--class-v class) class))
+
+(defsubst eieio--class-p (class)
+ "Return non-nil if CLASS is a valid class object."
+ (condition-case nil
+ (eq (aref class 0) 'defclass)
+ (error nil)))
+
(defsubst class-p (class)
"Return non-nil if CLASS is a valid class vector.
-CLASS is a symbol."
+CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
;; this new method is faster since it doesn't waste time checking lots of
;; things.
(condition-case nil
(eq (aref (eieio--class-v class) 0) 'defclass)
(error nil)))
-(defun eieio-class-name (class) "Return a Lisp like symbol name for 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.
(eieio--check-type class-p class)
;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
;; and I wanted a string. Arg!
(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check."
`(eieio--class-children (eieio--class-v ,class)))
-(defmacro same-class-fast-p (obj class)
- "Return t if OBJ is of class-type CLASS with no error checking."
- `(eq (eieio--object-class ,obj) ,class))
+(defsubst same-class-fast-p (obj class-name)
+ "Return t if OBJ is of class-type CLASS-NAME with no error checking."
+ ;; (eq (eieio--object-class-name obj) class)
+ (eq (eieio--object-class-object obj) (eieio--class-object class-name)))
(defmacro class-constructor (class)
"Return the symbol representing the constructor of CLASS."
(defsubst eieio-object-p (obj)
"Return non-nil if OBJ is an EIEIO object."
- (condition-case nil
- (and (eq (aref obj 0) 'object)
- (class-p (eieio--object-class obj)))
- (error nil)))
+ (and (arrayp obj)
+ (condition-case nil
+ (eq (aref (eieio--object-class-object obj) 0) 'defclass)
+ (error nil))))
+
(defalias 'object-p 'eieio-object-p)
(defsubst class-abstract-p (class)
;; FIXME: We should move more of eieio-defclass into the
;; defclass macro so we don't have to use `eval' and require
;; `gv' at run-time.
+ ;; FIXME: The defmethod above only defines a part of the generic
+ ;; function, but the define-setter below affects the whole
+ ;; generic function!
(eval `(gv-define-setter ,acces (eieio--store eieio--object)
(list 'eieio-oset eieio--object '',name
eieio--store)))))
;; Create the cached default object.
(let ((cache (make-vector (+ (length (eieio--class-public-a newc))
(eval-when-compile eieio--object-num-slots))
- nil)))
- (aset cache 0 'object)
- (setf (eieio--object-class cache) cname)
+ nil))
+ ;; We don't strictly speaking need to use a symbol, but the old
+ ;; code used the class's name rather than the class's object, so
+ ;; we follow this preference for using a symbol, which is probably
+ ;; convenient to keep the printed representation of such Elisp
+ ;; objects readable.
+ (tag (intern (format "eieio-class-tag--%s" cname))))
+ (set tag newc)
+ (setf (eieio--object-class-tag cache) tag)
(let ((eieio-skip-typecheck t))
;; All type-checking has been done to our satisfaction
;; before this call. Don't waste our time in this call..
(list method local-args))
;; We do have an object. Make sure it is the right type.
- (if (not (child-of-class-p (eieio--object-class (car local-args))
+ (if (not (child-of-class-p (eieio--object-class-object (car local-args))
class))
;; If not the right kind of object, call no applicable
(eieio-generic-call-key eieio--method-primary)
(eieio-generic-call-arglst local-args)
)
- (eieio--with-scoped-class class
+ (eieio--with-scoped-class (eieio--class-v class)
(apply impl local-args)))))))
(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
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 instance) slotname fn)
+ (slot-unbound instance (eieio--object-class-name instance) slotname fn)
value))
\f
(eieio--check-type (or eieio-object-p class-p) obj)
(eieio--check-type symbolp slot)
(if (class-p obj) (eieio-class-un-autoload obj))
- (let* ((class (if (class-p obj) obj (eieio--object-class obj)))
- (c (eieio-slot-name-index class obj slot)))
+ (let* ((class (if (class-p obj) obj (eieio--object-class-name obj)))
+ (c (eieio--slot-name-index (eieio--class-v class) obj slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
Fills in OBJ's SLOT with its default value."
(eieio--check-type (or eieio-object-p class-p) obj)
(eieio--check-type symbolp slot)
- (let* ((cl (if (eieio-object-p obj) (eieio--object-class obj) obj))
- (c (eieio-slot-name-index cl obj slot)))
+ (let* ((cl (if (eieio-object-p obj) (eieio--object-class-name obj) obj))
+ (c (eieio--slot-name-index (eieio--class-v cl) obj slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
Fills in OBJ's SLOT with VALUE."
(eieio--check-type eieio-object-p obj)
(eieio--check-type symbolp slot)
- (let ((c (eieio-slot-name-index (eieio--object-class obj) obj slot)))
+ (let* ((class (eieio--object-class-object obj))
+ (c (eieio--slot-name-index class obj slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
(if (setq c
- (eieio-class-slot-name-index (eieio--object-class obj) slot))
+ (eieio-class-slot-name-index (eieio--class-symbol class) slot))
;; Oset that slot.
(progn
- (eieio-validate-class-slot-value (eieio--object-class obj) c value slot)
- (aset (eieio--class-class-allocation-values (eieio--class-v (eieio--object-class obj)))
+ (eieio-validate-class-slot-value (eieio--class-symbol class)
+ c value slot)
+ (aset (eieio--class-class-allocation-values class)
c value))
;; See oref for comment on `slot-missing'
(slot-missing obj slot 'oset value)
;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
)
- (eieio-validate-slot-value (eieio--object-class obj) c value slot)
+ (eieio-validate-slot-value (eieio--class-symbol class) c value slot)
(aset obj c value))))
(defun eieio-oset-default (class slot value)
Fills in the default value in CLASS' in SLOT with VALUE."
(eieio--check-type class-p class)
(eieio--check-type symbolp slot)
- (eieio--with-scoped-class class
- (let* ((c (eieio-slot-name-index class nil slot)))
+ (eieio--with-scoped-class (eieio--class-v class)
+ (let* ((c (eieio--slot-name-index (eieio--class-v class) nil slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
"Return non-nil if START-CLASS is the first class to define SLOT.
This is for testing if the class currently in scope is the class that defines SLOT
so that we can protect private slots."
- (let ((par (eieio-class-parents-fast start-class))
+ (let ((par (eieio--class-parent start-class))
(ret t))
(if (not par)
t
(setq par (cdr par)))
ret)))
-(defun eieio-slot-name-index (class obj slot)
+(defun eieio--slot-name-index (class obj slot)
"In CLASS for OBJ find the index of the named SLOT.
The slot is a symbol which is installed in CLASS by the `defclass'
call. OBJ can be nil, but if it is an object, and the slot in question
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 (eieio--class-v class))))
+ (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
(fsi (car fsym)))
(if (integerp fsi)
(cond
(eieio--scoped-class)
(or (child-of-class-p class (eieio--scoped-class))
(and (eieio-object-p obj)
- (child-of-class-p class (eieio--object-class obj)))))
+ (child-of-class-p class (eieio--object-class-object obj)))))
(+ (eval-when-compile eieio--object-num-slots) fsi))
((and (eq (cdr fsym) 'private)
(or (and (eieio--scoped-class)
eieio-initializing-object))
(+ (eval-when-compile eieio--object-num-slots) fsi))
(t nil))
- (let ((fn (eieio-initarg-to-attribute class slot)))
- (if fn (eieio-slot-name-index class obj fn) nil)))))
+ (let ((fn (eieio--initarg-to-attribute class slot)))
+ (if fn (eieio--slot-name-index class obj fn) nil)))))
(defun eieio-class-slot-name-index (class slot)
"In CLASS find the index of the named SLOT.
If SET-ALL is non-nil, then when a default is nil, that value is
reset. If SET-ALL is nil, the slots are only reset if the default is
not nil."
- (eieio--with-scoped-class (eieio--object-class obj)
+ (eieio--with-scoped-class (eieio--object-class-object obj)
(let ((eieio-initializing-object t)
- (pub (eieio--class-public-a (eieio--class-v (eieio--object-class obj)))))
+ (pub (eieio--class-public-a (eieio--object-class-object obj))))
(while pub
(let ((df (eieio-oref-default obj (car pub))))
(if (or df set-all)
(eieio-oset obj (car pub) df)))
(setq pub (cdr pub))))))
-(defun eieio-initarg-to-attribute (class initarg)
+(defun eieio--initarg-to-attribute (class initarg)
"For CLASS, convert INITARG to the actual attribute name.
If there is no translation, pass it in directly (so we can cheat if
need be... May remove that later...)"
- (let ((tuple (assoc initarg (eieio--class-initarg-tuples (eieio--class-v class)))))
+ (let ((tuple (assoc initarg (eieio--class-initarg-tuples class))))
(if tuple
(cdr tuple)
nil)))
(load (nth 1 (symbol-function firstarg))))
;; Determine the class to use.
(cond ((eieio-object-p firstarg)
- (setq mclass (eieio--object-class firstarg)))
+ (setq mclass (eieio--object-class-name firstarg)))
((class-p firstarg)
(setq mclass firstarg))
)
(let ((rval nil) (lastval nil) (found nil))
(while lambdas
(if (car lambdas)
- (eieio--with-scoped-class (cdr (car lambdas))
+ (eieio--with-scoped-class (eieio--class-v (cdr (car lambdas)))
(let* ((eieio-generic-call-key (car keys))
(has-return-val
(or (= eieio-generic-call-key eieio--method-primary)
;; Determine the class to use.
(cond ((eieio-object-p firstarg)
- (setq mclass (eieio--object-class firstarg)))
+ (setq mclass (eieio--object-class-name firstarg)))
((not firstarg)
(error "Method %s called on nil" method))
(t
;; Now loop through all occurrences forms which we must execute
;; (which are happily sorted now) and execute them all!
- (eieio--with-scoped-class (cdr lambdas)
+ (eieio--with-scoped-class (eieio--class-v (cdr lambdas))
(let* ((rval nil) (lastval nil)
(eieio-generic-call-key eieio--method-primary)
;; Use the cdr, as the first element is the fcn
;; well embedded into an object.
;;
(define-obsolete-function-alias
- 'object-class-fast #'eieio--object-class "24.4")
+ 'object-class-fast #'eieio--object-class-name "24.4")
(defun eieio-object-name (obj &optional extra)
"Return a Lisp like symbol string for object OBJ.
If EXTRA, include that in the string returned to represent the symbol."
(eieio--check-type eieio-object-p obj)
- (format "#<%s %s%s>" (symbol-name (eieio--object-class obj))
+ (format "#<%s %s%s>" (eieio--object-class-name obj)
(eieio-object-name-string obj) (or extra "")))
(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
(define-obsolete-function-alias
'object-set-name-string 'eieio-object-set-name-string "24.4")
-(defun eieio-object-class (obj) "Return the class struct defining OBJ."
+(defun eieio-object-class (obj)
+ "Return the class struct defining OBJ."
+ ;; FIXME: We say we return a "struct" but we return a symbol instead!
(eieio--check-type eieio-object-p obj)
- (eieio--object-class obj))
+ (eieio--object-class-name obj))
(define-obsolete-function-alias 'object-class #'eieio-object-class "24.4")
;; CLOS name, maybe?
(define-obsolete-function-alias 'class-of #'eieio-object-class "24.4")
(defun eieio-object-class-name (obj)
"Return a Lisp like symbol name for OBJ's class."
(eieio--check-type eieio-object-p obj)
- (eieio-class-name (eieio--object-class obj)))
+ (eieio-class-name (eieio--object-class-name obj)))
(define-obsolete-function-alias
'object-class-name 'eieio-object-class-name "24.4")
"Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses."
(eieio--check-type eieio-object-p obj)
;; class will be checked one layer down
- (child-of-class-p (eieio--object-class obj) class))
+ (child-of-class-p (eieio--object-class-object obj) class))
;; Backwards compatibility
(defalias 'obj-of-class-p 'object-of-class-p)
(defun child-of-class-p (child class)
"Return non-nil if CHILD class is a subclass of CLASS."
- (eieio--check-type class-p class)
- (eieio--check-type class-p child)
+ (setq child (eieio--class-object child))
+ (eieio--check-type eieio--class-p child)
;; `eieio-default-superclass' is never mentioned in eieio--class-parent,
;; so we have to special case it here.
(or (eq class 'eieio-default-superclass)
(let ((p nil))
+ (setq class (eieio--class-object class))
+ (eieio--check-type eieio--class-p class)
(while (and child (not (eq child class)))
- (setq p (append p (eieio--class-parent (eieio--class-v child)))
- child (car p)
- p (cdr p)))
+ ;; FIXME: eieio--class-parent should return class-objects rather than
+ ;; class-names!
+ (setq p (append p (eieio--class-parent child))
+ child (eieio--class-v (pop p))))
(if child t))))
(defun object-slots (obj)
"Return list of slots available in OBJ."
(eieio--check-type eieio-object-p obj)
- (eieio--class-public-a (eieio--class-v (eieio--object-class obj))))
+ (eieio--class-public-a (eieio--object-class-object obj)))
(defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
(eieio--check-type class-p class)
(let ((newargs (or replacement-args eieio-generic-call-arglst))
(next (car eieio-generic-call-next-method-list))
)
- (if (or (not next) (not (car next)))
+ (if (not (and next (car next)))
(apply #'no-next-method (car newargs) (cdr newargs))
(let* ((eieio-generic-call-next-method-list
(cdr eieio-generic-call-next-method-list))
(eieio-generic-call-arglst newargs)
(fcn (car next))
)
- (eieio--with-scoped-class (cdr next)
+ (eieio--with-scoped-class (eieio--class-v (cdr next))
(apply fcn newargs)) ))))
;;; Here are some CLOS items that need the CL package
(defmethod shared-initialize ((obj eieio-default-superclass) slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine."
- (eieio--with-scoped-class (eieio--object-class obj)
+ (eieio--with-scoped-class (eieio--object-class-object obj)
(while slots
- (let ((rn (eieio-initarg-to-attribute (eieio--object-class obj)
- (car slots))))
+ (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj)
+ (car slots))))
(if (not rn)
(slot-missing obj (car slots) 'oset (car (cdr slots)))
(eieio-oset obj rn (car (cdr slots)))))
dynamically set from 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--class-v (eieio--object-class this)))
+ (let* ((this-class (eieio--object-class-object this))
(slot (eieio--class-public-a this-class))
(defaults (eieio--class-public-d this-class)))
(while slot
\f
;;; Start of automatically extracted autoloads.
\f
-;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "3a6fffe3af331fe960f967d0da99e8e9")
+;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "2b4c57cf907e879e8bbc88d8f0e2de4c")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
projects / emacs.git / commitdiff