mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-01 08:17:38 +00:00
lisp/emacs-lisp/eieio*.el: Reduce object header to 1 slot
* lisp/emacs-lisp/eieio-core.el (eieio--with-scoped-class): Use let-binding. (object): Remove first (constant) slot; rename second to `class-tag'. (eieio--object-class-object, eieio--object-class-name): New funs to replace eieio--object-class. (eieio--class-object, eieio--class-p): New functions. (same-class-fast-p): Make it a defsubst, change its implementation to check the class objects rather than their names. (eieio-object-p): Rewrite. (eieio-defclass): Adjust the object initialization according to the new object layout. (eieio--scoped-class): Declare it returns a class object (not a class name any more). Adjust calls accordingly (along with calls to eieio--with-scoped-class). (eieio--slot-name-index): Rename from eieio-slot-name-index and change its class arg to be a class object. Adjust callers accordingly. (eieio-slot-originating-class-p): Make its start-class arg a class object. Adjust all callers. (eieio--initarg-to-attribute): Rename from eieio-initarg-to-attribute. Make its `class' arg a class object. Adjust all callers. * lisp/emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): Use eieio--slot-name-index rather than eieio-slot-name-index. * lisp/emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects additionally to class names. * test/automated/eieio-test-methodinvoke.el (eieio-test-method-store): Adjust to new semantics of eieio--scoped-class. (eieio-test-match): Improve error feedback.
This commit is contained in:
Stefan Monnier
parent
ee93d7ad42
commit
232823a1f1
@ -1,3 +1,31 @@
|
||||
2014-12-29 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects
|
||||
additionally to class names.
|
||||
|
||||
* emacs-lisp/eieio-core.el (eieio--with-scoped-class): Use let-binding.
|
||||
(object): Remove first (constant) slot; rename second to `class-tag'.
|
||||
(eieio--object-class-object, eieio--object-class-name): New funs
|
||||
to replace eieio--object-class.
|
||||
(eieio--class-object, eieio--class-p): New functions.
|
||||
(same-class-fast-p): Make it a defsubst, change its implementation
|
||||
to check the class objects rather than their names.
|
||||
(eieio-object-p): Rewrite.
|
||||
(eieio-defclass): Adjust the object initialization according to the new
|
||||
object layout.
|
||||
(eieio--scoped-class): Declare it returns a class object (not a class
|
||||
name any more). Adjust calls accordingly (along with calls to
|
||||
eieio--with-scoped-class).
|
||||
(eieio--slot-name-index): Rename from eieio-slot-name-index and change
|
||||
its class arg to be a class object. Adjust callers accordingly.
|
||||
(eieio-slot-originating-class-p): Make its start-class arg a class
|
||||
object. Adjust all callers.
|
||||
(eieio--initarg-to-attribute): Rename from eieio-initarg-to-attribute.
|
||||
Make its `class' arg a class object. Adjust all callers.
|
||||
|
||||
* emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
|
||||
Use eieio--slot-name-index rather than eieio-slot-name-index.
|
||||
|
||||
2014-12-23 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/eieio.el (make-instance): Simplify by not adding an object
|
||||
|
||||
@ -290,7 +290,8 @@ constructor functions are considered valid.
|
||||
Second, any text properties will be stripped from strings."
|
||||
(cond ((consp proposed-value)
|
||||
;; Lists with something in them need special treatment.
|
||||
(let ((slot-idx (eieio-slot-name-index class nil slot))
|
||||
(let ((slot-idx (eieio--slot-name-index (eieio--class-v class)
|
||||
nil slot))
|
||||
(type nil)
|
||||
(classtype nil))
|
||||
(setq slot-idx (- slot-idx
|
||||
|
||||
@ -101,17 +101,14 @@ default setting for optimization purposes.")
|
||||
"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
|
||||
@ -169,8 +166,18 @@ from the default.")
|
||||
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.")
|
||||
@ -202,22 +209,35 @@ Stored outright without modifications or stripping.")))
|
||||
(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!
|
||||
@ -231,9 +251,10 @@ CLASS is a symbol."
|
||||
(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."
|
||||
@ -289,10 +310,11 @@ Return nil if that option doesn't exist."
|
||||
|
||||
(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)
|
||||
@ -648,6 +670,9 @@ See `defclass' for more information."
|
||||
;; 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)))))
|
||||
@ -765,9 +790,15 @@ See `defclass' for more information."
|
||||
;; 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..
|
||||
@ -1164,7 +1195,7 @@ IMPL is the symbol holding the method implementation."
|
||||
(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
|
||||
@ -1177,7 +1208,7 @@ IMPL is the symbol holding the method implementation."
|
||||
(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)
|
||||
@ -1291,7 +1322,7 @@ INSTANCE is the object being referenced. SLOTNAME is the offending
|
||||
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))
|
||||
|
||||
|
||||
@ -1302,8 +1333,8 @@ Argument FN is the function calling this verifier."
|
||||
(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.
|
||||
@ -1325,8 +1356,8 @@ Argument FN is the function calling this verifier."
|
||||
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.
|
||||
@ -1361,22 +1392,24 @@ Fills in OBJ's SLOT with its default value."
|
||||
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)
|
||||
@ -1384,8 +1417,8 @@ Fills in OBJ's SLOT with 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.
|
||||
@ -1413,7 +1446,7 @@ Fills in the default value in CLASS' in SLOT with VALUE."
|
||||
"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
|
||||
@ -1423,7 +1456,7 @@ so that we can protect private slots."
|
||||
(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
|
||||
@ -1432,7 +1465,7 @@ scoped class.
|
||||
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
|
||||
@ -1442,7 +1475,7 @@ reverse-lookup that name, and recurse with the associated slot value."
|
||||
(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)
|
||||
@ -1450,8 +1483,8 @@ reverse-lookup that name, and recurse with the associated slot value."
|
||||
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.
|
||||
@ -1477,20 +1510,20 @@ reverse-lookup that name, and recurse with the associated slot value."
|
||||
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)))
|
||||
@ -1660,7 +1693,7 @@ This should only be called from a generic function."
|
||||
(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))
|
||||
)
|
||||
@ -1743,7 +1776,7 @@ This should only be called from a generic function."
|
||||
(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)
|
||||
@ -1792,7 +1825,7 @@ for this common case to improve performance."
|
||||
|
||||
;; 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
|
||||
@ -1811,7 +1844,7 @@ for this common case to improve performance."
|
||||
|
||||
;; 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
|
||||
|
||||
@ -193,7 +193,7 @@ Optional argument IGNORE is an extraneous parameter."
|
||||
(let* ((chil nil)
|
||||
(obj (widget-get widget :value))
|
||||
(master-group (widget-get widget :eieio-group))
|
||||
(cv (eieio--class-v (eieio--object-class obj)))
|
||||
(cv (eieio--object-class-object obj))
|
||||
(slots (eieio--class-public-a cv))
|
||||
(flabel (eieio--class-public-custom-label cv))
|
||||
(fgroup (eieio--class-public-custom-group cv))
|
||||
@ -208,7 +208,8 @@ Optional argument IGNORE is an extraneous parameter."
|
||||
chil)))
|
||||
;; Display information about the group being shown
|
||||
(when master-group
|
||||
(let ((groups (class-option (eieio--object-class obj) :custom-groups)))
|
||||
(let ((groups (class-option (eieio--object-class-name obj)
|
||||
:custom-groups)))
|
||||
(widget-insert "Groups:")
|
||||
(while groups
|
||||
(widget-insert " ")
|
||||
@ -261,7 +262,7 @@ Optional argument IGNORE is an extraneous parameter."
|
||||
(let ((s (symbol-name
|
||||
(or
|
||||
(class-slot-initarg
|
||||
(eieio--object-class obj)
|
||||
(eieio--object-class-name obj)
|
||||
(car slots))
|
||||
(car slots)))))
|
||||
(capitalize
|
||||
@ -288,7 +289,7 @@ Optional argument IGNORE is an extraneous parameter."
|
||||
"Get the value of WIDGET."
|
||||
(let* ((obj (widget-get widget :value))
|
||||
(master-group eieio-cog)
|
||||
(cv (eieio--class-v (eieio--object-class obj)))
|
||||
(cv (eieio--object-class-object obj))
|
||||
(fgroup (eieio--class-public-custom-group cv))
|
||||
(wids (widget-get widget :children))
|
||||
(name (if (widget-get widget :eieio-show-name)
|
||||
@ -296,7 +297,7 @@ Optional argument IGNORE is an extraneous parameter."
|
||||
nil))
|
||||
(chil (if (widget-get widget :eieio-show-name)
|
||||
(nthcdr 1 wids) wids))
|
||||
(cv (eieio--class-v (eieio--object-class obj)))
|
||||
(cv (eieio--object-class-object obj))
|
||||
(slots (eieio--class-public-a cv))
|
||||
(fcust (eieio--class-public-custom cv)))
|
||||
;; If there are any prefix widgets, clear them.
|
||||
@ -451,7 +452,7 @@ Must return the created widget."
|
||||
(vector (concat "Group " (symbol-name group))
|
||||
(list 'customize-object obj (list 'quote group))
|
||||
t))
|
||||
(class-option (eieio--object-class obj) :custom-groups)))
|
||||
(class-option (eieio--object-class-name obj) :custom-groups)))
|
||||
|
||||
(defvar eieio-read-custom-group-history nil
|
||||
"History for the custom group reader.")
|
||||
@ -459,7 +460,7 @@ Must return the created widget."
|
||||
(defmethod eieio-read-customization-group ((obj eieio-default-superclass))
|
||||
"Do a completing read on the name of a customization group in OBJ.
|
||||
Return the symbol for the group, or nil"
|
||||
(let ((g (class-option (eieio--object-class obj) :custom-groups)))
|
||||
(let ((g (class-option (eieio--object-class-name obj) :custom-groups)))
|
||||
(if (= (length g) 1)
|
||||
(car g)
|
||||
;; Make the association list
|
||||
|
||||
@ -267,13 +267,13 @@ variable name of the same name as the slot."
|
||||
;; 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")
|
||||
|
||||
@ -299,9 +299,11 @@ If EXTRA, include that in the string returned to represent the symbol."
|
||||
(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")
|
||||
@ -309,7 +311,7 @@ If EXTRA, include that in the string returned to represent the symbol."
|
||||
(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")
|
||||
|
||||
@ -349,28 +351,31 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
|
||||
"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)
|
||||
@ -543,14 +548,14 @@ Use `next-method-p' to find out if there is a next method to call."
|
||||
(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
|
||||
@ -603,10 +608,10 @@ Called from the constructor routine.")
|
||||
(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)))))
|
||||
@ -627,7 +632,7 @@ not taken, then new objects of your class will not have their values
|
||||
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
|
||||
@ -883,7 +888,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
|
||||
|
||||
;;; Start of automatically extracted autoloads.
|
||||
|
||||
;;;### (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" "\
|
||||
|
||||
@ -1,3 +1,16 @@
|
||||
2014-12-29 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* automated/eieio-test-methodinvoke.el (eieio-test-method-store):
|
||||
Adjust to new semantics of eieio--scoped-class.
|
||||
(eieio-test-match): Improve error feedback.
|
||||
|
||||
2014-12-23 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* automated/eieio-tests.el: Remove dummy object names.
|
||||
|
||||
* automated/eieio-test-persist.el (persistent-with-objs-slot-subs):
|
||||
The type FOO-child is the same as FOO.
|
||||
|
||||
2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* automated/eieio-test-methodinvoke.el (eieio-test-method-store):
|
||||
|
||||
@ -61,14 +61,16 @@
|
||||
"Store current invocation class symbol in the invocation order list."
|
||||
(let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ]
|
||||
(or eieio-generic-call-key 0)))
|
||||
(c (list keysym (eieio--scoped-class))))
|
||||
;; FIXME: Don't depend on `eieio--scoped-class'!
|
||||
(c (list keysym (eieio--class-symbol (eieio--scoped-class)))))
|
||||
(push c eieio-test-method-order-list)))
|
||||
|
||||
(defun eieio-test-match (rightanswer)
|
||||
"Do a test match."
|
||||
(if (equal rightanswer eieio-test-method-order-list)
|
||||
t
|
||||
(error "eieio-test-methodinvoke.el: Test Failed!")))
|
||||
(error "eieio-test-methodinvoke.el: Test Failed: %S != %S"
|
||||
rightanswer eieio-test-method-order-list)))
|
||||
|
||||
(defvar eieio-test-call-next-method-arguments nil
|
||||
"List of passed to methods during execution of `call-next-method'.")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user