aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-12-29 12:11:09 -0500
committerStefan Monnier2014-12-29 12:11:09 -0500
commit232823a1f163cebeafdab20ea2eb3f2da9645185 (patch)
tree59df22737fb162918c05c533ee9b19548a6b21b3
parentee93d7ad4291a0946efe3197481cfbeff92f29b8 (diff)
downloademacs-232823a1f163cebeafdab20ea2eb3f2da9645185.tar.gz
emacs-232823a1f163cebeafdab20ea2eb3f2da9645185.zip
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.
-rw-r--r--lisp/ChangeLog28
-rw-r--r--lisp/emacs-lisp/eieio-base.el3
-rw-r--r--lisp/emacs-lisp/eieio-core.el131
-rw-r--r--lisp/emacs-lisp/eieio-custom.el15
-rw-r--r--lisp/emacs-lisp/eieio.el43
-rw-r--r--test/ChangeLog13
-rw-r--r--test/automated/eieio-test-methodinvoke.el6
7 files changed, 161 insertions, 78 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1a0383814cd..209c833fbe3 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,31 @@
12014-12-29 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects
4 additionally to class names.
5
6 * emacs-lisp/eieio-core.el (eieio--with-scoped-class): Use let-binding.
7 (object): Remove first (constant) slot; rename second to `class-tag'.
8 (eieio--object-class-object, eieio--object-class-name): New funs
9 to replace eieio--object-class.
10 (eieio--class-object, eieio--class-p): New functions.
11 (same-class-fast-p): Make it a defsubst, change its implementation
12 to check the class objects rather than their names.
13 (eieio-object-p): Rewrite.
14 (eieio-defclass): Adjust the object initialization according to the new
15 object layout.
16 (eieio--scoped-class): Declare it returns a class object (not a class
17 name any more). Adjust calls accordingly (along with calls to
18 eieio--with-scoped-class).
19 (eieio--slot-name-index): Rename from eieio-slot-name-index and change
20 its class arg to be a class object. Adjust callers accordingly.
21 (eieio-slot-originating-class-p): Make its start-class arg a class
22 object. Adjust all callers.
23 (eieio--initarg-to-attribute): Rename from eieio-initarg-to-attribute.
24 Make its `class' arg a class object. Adjust all callers.
25
26 * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
27 Use eieio--slot-name-index rather than eieio-slot-name-index.
28
12014-12-23 Stefan Monnier <monnier@iro.umontreal.ca> 292014-12-23 Stefan Monnier <monnier@iro.umontreal.ca>
2 30
3 * emacs-lisp/eieio.el (make-instance): Simplify by not adding an object 31 * emacs-lisp/eieio.el (make-instance): Simplify by not adding an object
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 8a09dac2dff..e841ed664c0 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -290,7 +290,8 @@ constructor functions are considered valid.
290Second, any text properties will be stripped from strings." 290Second, any text properties will be stripped from strings."
291 (cond ((consp proposed-value) 291 (cond ((consp proposed-value)
292 ;; Lists with something in them need special treatment. 292 ;; Lists with something in them need special treatment.
293 (let ((slot-idx (eieio-slot-name-index class nil slot)) 293 (let ((slot-idx (eieio--slot-name-index (eieio--class-v class)
294 nil slot))
294 (type nil) 295 (type nil)
295 (classtype nil)) 296 (classtype nil))
296 (setq slot-idx (- slot-idx 297 (setq slot-idx (- slot-idx
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 299df8db378..924886c5ba1 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -101,17 +101,14 @@ default setting for optimization purposes.")
101 "A stack of the classes currently in scope during method invocation.") 101 "A stack of the classes currently in scope during method invocation.")
102 102
103(defun eieio--scoped-class () 103(defun eieio--scoped-class ()
104 "Return the class currently in scope, or nil." 104 "Return the class object currently in scope, or nil."
105 (car-safe eieio--scoped-class-stack)) 105 (car-safe eieio--scoped-class-stack))
106 106
107(defmacro eieio--with-scoped-class (class &rest forms) 107(defmacro eieio--with-scoped-class (class &rest forms)
108 "Set CLASS as the currently scoped class while executing FORMS." 108 "Set CLASS as the currently scoped class while executing FORMS."
109 (declare (indent 1)) 109 (declare (indent 1))
110 `(unwind-protect 110 `(let ((eieio--scoped-class-stack (cons ,class eieio--scoped-class-stack)))
111 (progn 111 ,@forms))
112 (push ,class eieio--scoped-class-stack)
113 ,@forms)
114 (pop eieio--scoped-class-stack)))
115 112
116;;; 113;;;
117;; Field Accessors 114;; Field Accessors
@@ -169,8 +166,18 @@ from the default.")
169Stored outright without modifications or stripping."))) 166Stored outright without modifications or stripping.")))
170 167
171(eieio--define-field-accessors object 168(eieio--define-field-accessors object
172 (-unused-0 ;;Constant slot, set to `object'. 169 ;; `class-tag' holds a symbol, which is not the class name, but is instead
173 (class "class struct defining OBJ"))) 170 ;; properly prefixed as an internal EIEIO thingy and which holds the class
171 ;; object/struct in its `symbol-value' slot.
172 ((class-tag "tag containing the class struct")))
173
174(defsubst eieio--object-class-object (obj)
175 (symbol-value (eieio--object-class-tag obj)))
176
177(defsubst eieio--object-class-name (obj)
178 ;; FIXME: Most uses of this function should be changed to use
179 ;; eieio--object-class-object instead!
180 (eieio--class-symbol (eieio--object-class-object obj)))
174 181
175;; FIXME: The constants below should have an `eieio-' prefix added!! 182;; FIXME: The constants below should have an `eieio-' prefix added!!
176(defconst eieio--method-static 0 "Index into :static tag on a method.") 183(defconst eieio--method-static 0 "Index into :static tag on a method.")
@@ -202,22 +209,35 @@ Stored outright without modifications or stripping.")))
202 (t `(,type ,obj)))) 209 (t `(,type ,obj))))
203 (signal 'wrong-type-argument (list ',type ,obj)))) 210 (signal 'wrong-type-argument (list ',type ,obj))))
204 211
205(defmacro eieio--class-v (class) 212(defmacro eieio--class-v (class) ;Use a macro, so it acts as a GV place.
206 "Internal: Return the class vector from the CLASS symbol." 213 "Internal: Return the class vector from the CLASS symbol."
207 (declare (debug t)) 214 (declare (debug t))
208 ;; No check: If eieio gets this far, it has probably been checked already. 215 ;; No check: If eieio gets this far, it has probably been checked already.
209 `(get ,class 'eieio-class-definition)) 216 `(get ,class 'eieio-class-definition))
210 217
218(defsubst eieio--class-object (class)
219 "Return the class object."
220 (if (symbolp class) (eieio--class-v class) class))
221
222(defsubst eieio--class-p (class)
223 "Return non-nil if CLASS is a valid class object."
224 (condition-case nil
225 (eq (aref class 0) 'defclass)
226 (error nil)))
227
211(defsubst class-p (class) 228(defsubst class-p (class)
212 "Return non-nil if CLASS is a valid class vector. 229 "Return non-nil if CLASS is a valid class vector.
213CLASS is a symbol." 230CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
214 ;; this new method is faster since it doesn't waste time checking lots of 231 ;; this new method is faster since it doesn't waste time checking lots of
215 ;; things. 232 ;; things.
216 (condition-case nil 233 (condition-case nil
217 (eq (aref (eieio--class-v class) 0) 'defclass) 234 (eq (aref (eieio--class-v class) 0) 'defclass)
218 (error nil))) 235 (error nil)))
219 236
220(defun eieio-class-name (class) "Return a Lisp like symbol name for CLASS." 237(defun eieio-class-name (class)
238 "Return a Lisp like symbol name for CLASS."
239 ;; FIXME: What's a "Lisp like symbol name"?
240 ;; FIXME: CLOS returns a symbol, but the code returns a string.
221 (eieio--check-type class-p class) 241 (eieio--check-type class-p class)
222 ;; I think this is supposed to return a symbol, but to me CLASS is a symbol, 242 ;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
223 ;; and I wanted a string. Arg! 243 ;; and I wanted a string. Arg!
@@ -231,9 +251,10 @@ CLASS is a symbol."
231(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." 251(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check."
232 `(eieio--class-children (eieio--class-v ,class))) 252 `(eieio--class-children (eieio--class-v ,class)))
233 253
234(defmacro same-class-fast-p (obj class) 254(defsubst same-class-fast-p (obj class-name)
235 "Return t if OBJ is of class-type CLASS with no error checking." 255 "Return t if OBJ is of class-type CLASS-NAME with no error checking."
236 `(eq (eieio--object-class ,obj) ,class)) 256 ;; (eq (eieio--object-class-name obj) class)
257 (eq (eieio--object-class-object obj) (eieio--class-object class-name)))
237 258
238(defmacro class-constructor (class) 259(defmacro class-constructor (class)
239 "Return the symbol representing the constructor of CLASS." 260 "Return the symbol representing the constructor of CLASS."
@@ -289,10 +310,11 @@ Return nil if that option doesn't exist."
289 310
290(defsubst eieio-object-p (obj) 311(defsubst eieio-object-p (obj)
291 "Return non-nil if OBJ is an EIEIO object." 312 "Return non-nil if OBJ is an EIEIO object."
292 (condition-case nil 313 (and (arrayp obj)
293 (and (eq (aref obj 0) 'object) 314 (condition-case nil
294 (class-p (eieio--object-class obj))) 315 (eq (aref (eieio--object-class-object obj) 0) 'defclass)
295 (error nil))) 316 (error nil))))
317
296(defalias 'object-p 'eieio-object-p) 318(defalias 'object-p 'eieio-object-p)
297 319
298(defsubst class-abstract-p (class) 320(defsubst class-abstract-p (class)
@@ -648,6 +670,9 @@ See `defclass' for more information."
648 ;; FIXME: We should move more of eieio-defclass into the 670 ;; FIXME: We should move more of eieio-defclass into the
649 ;; defclass macro so we don't have to use `eval' and require 671 ;; defclass macro so we don't have to use `eval' and require
650 ;; `gv' at run-time. 672 ;; `gv' at run-time.
673 ;; FIXME: The defmethod above only defines a part of the generic
674 ;; function, but the define-setter below affects the whole
675 ;; generic function!
651 (eval `(gv-define-setter ,acces (eieio--store eieio--object) 676 (eval `(gv-define-setter ,acces (eieio--store eieio--object)
652 (list 'eieio-oset eieio--object '',name 677 (list 'eieio-oset eieio--object '',name
653 eieio--store))))) 678 eieio--store)))))
@@ -765,9 +790,15 @@ See `defclass' for more information."
765 ;; Create the cached default object. 790 ;; Create the cached default object.
766 (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) 791 (let ((cache (make-vector (+ (length (eieio--class-public-a newc))
767 (eval-when-compile eieio--object-num-slots)) 792 (eval-when-compile eieio--object-num-slots))
768 nil))) 793 nil))
769 (aset cache 0 'object) 794 ;; We don't strictly speaking need to use a symbol, but the old
770 (setf (eieio--object-class cache) cname) 795 ;; code used the class's name rather than the class's object, so
796 ;; we follow this preference for using a symbol, which is probably
797 ;; convenient to keep the printed representation of such Elisp
798 ;; objects readable.
799 (tag (intern (format "eieio-class-tag--%s" cname))))
800 (set tag newc)
801 (setf (eieio--object-class-tag cache) tag)
771 (let ((eieio-skip-typecheck t)) 802 (let ((eieio-skip-typecheck t))
772 ;; All type-checking has been done to our satisfaction 803 ;; All type-checking has been done to our satisfaction
773 ;; before this call. Don't waste our time in this call.. 804 ;; before this call. Don't waste our time in this call..
@@ -1164,7 +1195,7 @@ IMPL is the symbol holding the method implementation."
1164 (list method local-args)) 1195 (list method local-args))
1165 1196
1166 ;; We do have an object. Make sure it is the right type. 1197 ;; We do have an object. Make sure it is the right type.
1167 (if (not (child-of-class-p (eieio--object-class (car local-args)) 1198 (if (not (child-of-class-p (eieio--object-class-object (car local-args))
1168 class)) 1199 class))
1169 1200
1170 ;; If not the right kind of object, call no applicable 1201 ;; If not the right kind of object, call no applicable
@@ -1177,7 +1208,7 @@ IMPL is the symbol holding the method implementation."
1177 (eieio-generic-call-key eieio--method-primary) 1208 (eieio-generic-call-key eieio--method-primary)
1178 (eieio-generic-call-arglst local-args) 1209 (eieio-generic-call-arglst local-args)
1179 ) 1210 )
1180 (eieio--with-scoped-class class 1211 (eieio--with-scoped-class (eieio--class-v class)
1181 (apply impl local-args))))))) 1212 (apply impl local-args)))))))
1182 1213
1183(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) 1214(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
@@ -1291,7 +1322,7 @@ INSTANCE is the object being referenced. SLOTNAME is the offending
1291slot. If the slot is ok, return VALUE. 1322slot. If the slot is ok, return VALUE.
1292Argument FN is the function calling this verifier." 1323Argument FN is the function calling this verifier."
1293 (if (and (eq value eieio-unbound) (not eieio-skip-typecheck)) 1324 (if (and (eq value eieio-unbound) (not eieio-skip-typecheck))
1294 (slot-unbound instance (eieio--object-class instance) slotname fn) 1325 (slot-unbound instance (eieio--object-class-name instance) slotname fn)
1295 value)) 1326 value))
1296 1327
1297 1328
@@ -1302,8 +1333,8 @@ Argument FN is the function calling this verifier."
1302 (eieio--check-type (or eieio-object-p class-p) obj) 1333 (eieio--check-type (or eieio-object-p class-p) obj)
1303 (eieio--check-type symbolp slot) 1334 (eieio--check-type symbolp slot)
1304 (if (class-p obj) (eieio-class-un-autoload obj)) 1335 (if (class-p obj) (eieio-class-un-autoload obj))
1305 (let* ((class (if (class-p obj) obj (eieio--object-class obj))) 1336 (let* ((class (if (class-p obj) obj (eieio--object-class-name obj)))
1306 (c (eieio-slot-name-index class obj slot))) 1337 (c (eieio--slot-name-index (eieio--class-v class) obj slot)))
1307 (if (not c) 1338 (if (not c)
1308 ;; It might be missing because it is a :class allocated slot. 1339 ;; It might be missing because it is a :class allocated slot.
1309 ;; Let's check that info out. 1340 ;; Let's check that info out.
@@ -1325,8 +1356,8 @@ Argument FN is the function calling this verifier."
1325Fills in OBJ's SLOT with its default value." 1356Fills in OBJ's SLOT with its default value."
1326 (eieio--check-type (or eieio-object-p class-p) obj) 1357 (eieio--check-type (or eieio-object-p class-p) obj)
1327 (eieio--check-type symbolp slot) 1358 (eieio--check-type symbolp slot)
1328 (let* ((cl (if (eieio-object-p obj) (eieio--object-class obj) obj)) 1359 (let* ((cl (if (eieio-object-p obj) (eieio--object-class-name obj) obj))
1329 (c (eieio-slot-name-index cl obj slot))) 1360 (c (eieio--slot-name-index (eieio--class-v cl) obj slot)))
1330 (if (not c) 1361 (if (not c)
1331 ;; It might be missing because it is a :class allocated slot. 1362 ;; It might be missing because it is a :class allocated slot.
1332 ;; Let's check that info out. 1363 ;; Let's check that info out.
@@ -1361,22 +1392,24 @@ Fills in OBJ's SLOT with its default value."
1361Fills in OBJ's SLOT with VALUE." 1392Fills in OBJ's SLOT with VALUE."
1362 (eieio--check-type eieio-object-p obj) 1393 (eieio--check-type eieio-object-p obj)
1363 (eieio--check-type symbolp slot) 1394 (eieio--check-type symbolp slot)
1364 (let ((c (eieio-slot-name-index (eieio--object-class obj) obj slot))) 1395 (let* ((class (eieio--object-class-object obj))
1396 (c (eieio--slot-name-index class obj slot)))
1365 (if (not c) 1397 (if (not c)
1366 ;; It might be missing because it is a :class allocated slot. 1398 ;; It might be missing because it is a :class allocated slot.
1367 ;; Let's check that info out. 1399 ;; Let's check that info out.
1368 (if (setq c 1400 (if (setq c
1369 (eieio-class-slot-name-index (eieio--object-class obj) slot)) 1401 (eieio-class-slot-name-index (eieio--class-symbol class) slot))
1370 ;; Oset that slot. 1402 ;; Oset that slot.
1371 (progn 1403 (progn
1372 (eieio-validate-class-slot-value (eieio--object-class obj) c value slot) 1404 (eieio-validate-class-slot-value (eieio--class-symbol class)
1373 (aset (eieio--class-class-allocation-values (eieio--class-v (eieio--object-class obj))) 1405 c value slot)
1406 (aset (eieio--class-class-allocation-values class)
1374 c value)) 1407 c value))
1375 ;; See oref for comment on `slot-missing' 1408 ;; See oref for comment on `slot-missing'
1376 (slot-missing obj slot 'oset value) 1409 (slot-missing obj slot 'oset value)
1377 ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) 1410 ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
1378 ) 1411 )
1379 (eieio-validate-slot-value (eieio--object-class obj) c value slot) 1412 (eieio-validate-slot-value (eieio--class-symbol class) c value slot)
1380 (aset obj c value)))) 1413 (aset obj c value))))
1381 1414
1382(defun eieio-oset-default (class slot value) 1415(defun eieio-oset-default (class slot value)
@@ -1384,8 +1417,8 @@ Fills in OBJ's SLOT with VALUE."
1384Fills in the default value in CLASS' in SLOT with VALUE." 1417Fills in the default value in CLASS' in SLOT with VALUE."
1385 (eieio--check-type class-p class) 1418 (eieio--check-type class-p class)
1386 (eieio--check-type symbolp slot) 1419 (eieio--check-type symbolp slot)
1387 (eieio--with-scoped-class class 1420 (eieio--with-scoped-class (eieio--class-v class)
1388 (let* ((c (eieio-slot-name-index class nil slot))) 1421 (let* ((c (eieio--slot-name-index (eieio--class-v class) nil slot)))
1389 (if (not c) 1422 (if (not c)
1390 ;; It might be missing because it is a :class allocated slot. 1423 ;; It might be missing because it is a :class allocated slot.
1391 ;; Let's check that info out. 1424 ;; Let's check that info out.
@@ -1413,7 +1446,7 @@ Fills in the default value in CLASS' in SLOT with VALUE."
1413 "Return non-nil if START-CLASS is the first class to define SLOT. 1446 "Return non-nil if START-CLASS is the first class to define SLOT.
1414This is for testing if the class currently in scope is the class that defines SLOT 1447This is for testing if the class currently in scope is the class that defines SLOT
1415so that we can protect private slots." 1448so that we can protect private slots."
1416 (let ((par (eieio-class-parents-fast start-class)) 1449 (let ((par (eieio--class-parent start-class))
1417 (ret t)) 1450 (ret t))
1418 (if (not par) 1451 (if (not par)
1419 t 1452 t
@@ -1423,7 +1456,7 @@ so that we can protect private slots."
1423 (setq par (cdr par))) 1456 (setq par (cdr par)))
1424 ret))) 1457 ret)))
1425 1458
1426(defun eieio-slot-name-index (class obj slot) 1459(defun eieio--slot-name-index (class obj slot)
1427 "In CLASS for OBJ find the index of the named SLOT. 1460 "In CLASS for OBJ find the index of the named SLOT.
1428The slot is a symbol which is installed in CLASS by the `defclass' 1461The slot is a symbol which is installed in CLASS by the `defclass'
1429call. OBJ can be nil, but if it is an object, and the slot in question 1462call. OBJ can be nil, but if it is an object, and the slot in question
@@ -1432,7 +1465,7 @@ scoped class.
1432If SLOT is the value created with :initarg instead, 1465If SLOT is the value created with :initarg instead,
1433reverse-lookup that name, and recurse with the associated slot value." 1466reverse-lookup that name, and recurse with the associated slot value."
1434 ;; Removed checks to outside this call 1467 ;; Removed checks to outside this call
1435 (let* ((fsym (gethash slot (eieio--class-symbol-hashtable (eieio--class-v class)))) 1468 (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
1436 (fsi (car fsym))) 1469 (fsi (car fsym)))
1437 (if (integerp fsi) 1470 (if (integerp fsi)
1438 (cond 1471 (cond
@@ -1442,7 +1475,7 @@ reverse-lookup that name, and recurse with the associated slot value."
1442 (eieio--scoped-class) 1475 (eieio--scoped-class)
1443 (or (child-of-class-p class (eieio--scoped-class)) 1476 (or (child-of-class-p class (eieio--scoped-class))
1444 (and (eieio-object-p obj) 1477 (and (eieio-object-p obj)
1445 (child-of-class-p class (eieio--object-class obj))))) 1478 (child-of-class-p class (eieio--object-class-object obj)))))
1446 (+ (eval-when-compile eieio--object-num-slots) fsi)) 1479 (+ (eval-when-compile eieio--object-num-slots) fsi))
1447 ((and (eq (cdr fsym) 'private) 1480 ((and (eq (cdr fsym) 'private)
1448 (or (and (eieio--scoped-class) 1481 (or (and (eieio--scoped-class)
@@ -1450,8 +1483,8 @@ reverse-lookup that name, and recurse with the associated slot value."
1450 eieio-initializing-object)) 1483 eieio-initializing-object))
1451 (+ (eval-when-compile eieio--object-num-slots) fsi)) 1484 (+ (eval-when-compile eieio--object-num-slots) fsi))
1452 (t nil)) 1485 (t nil))
1453 (let ((fn (eieio-initarg-to-attribute class slot))) 1486 (let ((fn (eieio--initarg-to-attribute class slot)))
1454 (if fn (eieio-slot-name-index class obj fn) nil))))) 1487 (if fn (eieio--slot-name-index class obj fn) nil)))))
1455 1488
1456(defun eieio-class-slot-name-index (class slot) 1489(defun eieio-class-slot-name-index (class slot)
1457 "In CLASS find the index of the named SLOT. 1490 "In CLASS find the index of the named SLOT.
@@ -1477,20 +1510,20 @@ reverse-lookup that name, and recurse with the associated slot value."
1477If SET-ALL is non-nil, then when a default is nil, that value is 1510If SET-ALL is non-nil, then when a default is nil, that value is
1478reset. If SET-ALL is nil, the slots are only reset if the default is 1511reset. If SET-ALL is nil, the slots are only reset if the default is
1479not nil." 1512not nil."
1480 (eieio--with-scoped-class (eieio--object-class obj) 1513 (eieio--with-scoped-class (eieio--object-class-object obj)
1481 (let ((eieio-initializing-object t) 1514 (let ((eieio-initializing-object t)
1482 (pub (eieio--class-public-a (eieio--class-v (eieio--object-class obj))))) 1515 (pub (eieio--class-public-a (eieio--object-class-object obj))))
1483 (while pub 1516 (while pub
1484 (let ((df (eieio-oref-default obj (car pub)))) 1517 (let ((df (eieio-oref-default obj (car pub))))
1485 (if (or df set-all) 1518 (if (or df set-all)
1486 (eieio-oset obj (car pub) df))) 1519 (eieio-oset obj (car pub) df)))
1487 (setq pub (cdr pub)))))) 1520 (setq pub (cdr pub))))))
1488 1521
1489(defun eieio-initarg-to-attribute (class initarg) 1522(defun eieio--initarg-to-attribute (class initarg)
1490 "For CLASS, convert INITARG to the actual attribute name. 1523 "For CLASS, convert INITARG to the actual attribute name.
1491If there is no translation, pass it in directly (so we can cheat if 1524If there is no translation, pass it in directly (so we can cheat if
1492need be... May remove that later...)" 1525need be... May remove that later...)"
1493 (let ((tuple (assoc initarg (eieio--class-initarg-tuples (eieio--class-v class))))) 1526 (let ((tuple (assoc initarg (eieio--class-initarg-tuples class))))
1494 (if tuple 1527 (if tuple
1495 (cdr tuple) 1528 (cdr tuple)
1496 nil))) 1529 nil)))
@@ -1660,7 +1693,7 @@ This should only be called from a generic function."
1660 (load (nth 1 (symbol-function firstarg)))) 1693 (load (nth 1 (symbol-function firstarg))))
1661 ;; Determine the class to use. 1694 ;; Determine the class to use.
1662 (cond ((eieio-object-p firstarg) 1695 (cond ((eieio-object-p firstarg)
1663 (setq mclass (eieio--object-class firstarg))) 1696 (setq mclass (eieio--object-class-name firstarg)))
1664 ((class-p firstarg) 1697 ((class-p firstarg)
1665 (setq mclass firstarg)) 1698 (setq mclass firstarg))
1666 ) 1699 )
@@ -1743,7 +1776,7 @@ This should only be called from a generic function."
1743 (let ((rval nil) (lastval nil) (found nil)) 1776 (let ((rval nil) (lastval nil) (found nil))
1744 (while lambdas 1777 (while lambdas
1745 (if (car lambdas) 1778 (if (car lambdas)
1746 (eieio--with-scoped-class (cdr (car lambdas)) 1779 (eieio--with-scoped-class (eieio--class-v (cdr (car lambdas)))
1747 (let* ((eieio-generic-call-key (car keys)) 1780 (let* ((eieio-generic-call-key (car keys))
1748 (has-return-val 1781 (has-return-val
1749 (or (= eieio-generic-call-key eieio--method-primary) 1782 (or (= eieio-generic-call-key eieio--method-primary)
@@ -1792,7 +1825,7 @@ for this common case to improve performance."
1792 1825
1793 ;; Determine the class to use. 1826 ;; Determine the class to use.
1794 (cond ((eieio-object-p firstarg) 1827 (cond ((eieio-object-p firstarg)
1795 (setq mclass (eieio--object-class firstarg))) 1828 (setq mclass (eieio--object-class-name firstarg)))
1796 ((not firstarg) 1829 ((not firstarg)
1797 (error "Method %s called on nil" method)) 1830 (error "Method %s called on nil" method))
1798 (t 1831 (t
@@ -1811,7 +1844,7 @@ for this common case to improve performance."
1811 1844
1812 ;; Now loop through all occurrences forms which we must execute 1845 ;; Now loop through all occurrences forms which we must execute
1813 ;; (which are happily sorted now) and execute them all! 1846 ;; (which are happily sorted now) and execute them all!
1814 (eieio--with-scoped-class (cdr lambdas) 1847 (eieio--with-scoped-class (eieio--class-v (cdr lambdas))
1815 (let* ((rval nil) (lastval nil) 1848 (let* ((rval nil) (lastval nil)
1816 (eieio-generic-call-key eieio--method-primary) 1849 (eieio-generic-call-key eieio--method-primary)
1817 ;; Use the cdr, as the first element is the fcn 1850 ;; Use the cdr, as the first element is the fcn
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 8172cbeef6f..15a11ddb20f 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -193,7 +193,7 @@ Optional argument IGNORE is an extraneous parameter."
193 (let* ((chil nil) 193 (let* ((chil nil)
194 (obj (widget-get widget :value)) 194 (obj (widget-get widget :value))
195 (master-group (widget-get widget :eieio-group)) 195 (master-group (widget-get widget :eieio-group))
196 (cv (eieio--class-v (eieio--object-class obj))) 196 (cv (eieio--object-class-object obj))
197 (slots (eieio--class-public-a cv)) 197 (slots (eieio--class-public-a cv))
198 (flabel (eieio--class-public-custom-label cv)) 198 (flabel (eieio--class-public-custom-label cv))
199 (fgroup (eieio--class-public-custom-group cv)) 199 (fgroup (eieio--class-public-custom-group cv))
@@ -208,7 +208,8 @@ Optional argument IGNORE is an extraneous parameter."
208 chil))) 208 chil)))
209 ;; Display information about the group being shown 209 ;; Display information about the group being shown
210 (when master-group 210 (when master-group
211 (let ((groups (class-option (eieio--object-class obj) :custom-groups))) 211 (let ((groups (class-option (eieio--object-class-name obj)
212 :custom-groups)))
212 (widget-insert "Groups:") 213 (widget-insert "Groups:")
213 (while groups 214 (while groups
214 (widget-insert " ") 215 (widget-insert " ")
@@ -261,7 +262,7 @@ Optional argument IGNORE is an extraneous parameter."
261 (let ((s (symbol-name 262 (let ((s (symbol-name
262 (or 263 (or
263 (class-slot-initarg 264 (class-slot-initarg
264 (eieio--object-class obj) 265 (eieio--object-class-name obj)
265 (car slots)) 266 (car slots))
266 (car slots))))) 267 (car slots)))))
267 (capitalize 268 (capitalize
@@ -288,7 +289,7 @@ Optional argument IGNORE is an extraneous parameter."
288 "Get the value of WIDGET." 289 "Get the value of WIDGET."
289 (let* ((obj (widget-get widget :value)) 290 (let* ((obj (widget-get widget :value))
290 (master-group eieio-cog) 291 (master-group eieio-cog)
291 (cv (eieio--class-v (eieio--object-class obj))) 292 (cv (eieio--object-class-object obj))
292 (fgroup (eieio--class-public-custom-group cv)) 293 (fgroup (eieio--class-public-custom-group cv))
293 (wids (widget-get widget :children)) 294 (wids (widget-get widget :children))
294 (name (if (widget-get widget :eieio-show-name) 295 (name (if (widget-get widget :eieio-show-name)
@@ -296,7 +297,7 @@ Optional argument IGNORE is an extraneous parameter."
296 nil)) 297 nil))
297 (chil (if (widget-get widget :eieio-show-name) 298 (chil (if (widget-get widget :eieio-show-name)
298 (nthcdr 1 wids) wids)) 299 (nthcdr 1 wids) wids))
299 (cv (eieio--class-v (eieio--object-class obj))) 300 (cv (eieio--object-class-object obj))
300 (slots (eieio--class-public-a cv)) 301 (slots (eieio--class-public-a cv))
301 (fcust (eieio--class-public-custom cv))) 302 (fcust (eieio--class-public-custom cv)))
302 ;; If there are any prefix widgets, clear them. 303 ;; If there are any prefix widgets, clear them.
@@ -451,7 +452,7 @@ Must return the created widget."
451 (vector (concat "Group " (symbol-name group)) 452 (vector (concat "Group " (symbol-name group))
452 (list 'customize-object obj (list 'quote group)) 453 (list 'customize-object obj (list 'quote group))
453 t)) 454 t))
454 (class-option (eieio--object-class obj) :custom-groups))) 455 (class-option (eieio--object-class-name obj) :custom-groups)))
455 456
456(defvar eieio-read-custom-group-history nil 457(defvar eieio-read-custom-group-history nil
457 "History for the custom group reader.") 458 "History for the custom group reader.")
@@ -459,7 +460,7 @@ Must return the created widget."
459(defmethod eieio-read-customization-group ((obj eieio-default-superclass)) 460(defmethod eieio-read-customization-group ((obj eieio-default-superclass))
460 "Do a completing read on the name of a customization group in OBJ. 461 "Do a completing read on the name of a customization group in OBJ.
461Return the symbol for the group, or nil" 462Return the symbol for the group, or nil"
462 (let ((g (class-option (eieio--object-class obj) :custom-groups))) 463 (let ((g (class-option (eieio--object-class-name obj) :custom-groups)))
463 (if (= (length g) 1) 464 (if (= (length g) 1)
464 (car g) 465 (car g)
465 ;; Make the association list 466 ;; Make the association list
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 51b8c3d2b4a..e80791f9f75 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -267,13 +267,13 @@ variable name of the same name as the slot."
267;; well embedded into an object. 267;; well embedded into an object.
268;; 268;;
269(define-obsolete-function-alias 269(define-obsolete-function-alias
270 'object-class-fast #'eieio--object-class "24.4") 270 'object-class-fast #'eieio--object-class-name "24.4")
271 271
272(defun eieio-object-name (obj &optional extra) 272(defun eieio-object-name (obj &optional extra)
273 "Return a Lisp like symbol string for object OBJ. 273 "Return a Lisp like symbol string for object OBJ.
274If EXTRA, include that in the string returned to represent the symbol." 274If EXTRA, include that in the string returned to represent the symbol."
275 (eieio--check-type eieio-object-p obj) 275 (eieio--check-type eieio-object-p obj)
276 (format "#<%s %s%s>" (symbol-name (eieio--object-class obj)) 276 (format "#<%s %s%s>" (eieio--object-class-name obj)
277 (eieio-object-name-string obj) (or extra ""))) 277 (eieio-object-name-string obj) (or extra "")))
278(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4") 278(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
279 279
@@ -299,9 +299,11 @@ If EXTRA, include that in the string returned to represent the symbol."
299(define-obsolete-function-alias 299(define-obsolete-function-alias
300 'object-set-name-string 'eieio-object-set-name-string "24.4") 300 'object-set-name-string 'eieio-object-set-name-string "24.4")
301 301
302(defun eieio-object-class (obj) "Return the class struct defining OBJ." 302(defun eieio-object-class (obj)
303 "Return the class struct defining OBJ."
304 ;; FIXME: We say we return a "struct" but we return a symbol instead!
303 (eieio--check-type eieio-object-p obj) 305 (eieio--check-type eieio-object-p obj)
304 (eieio--object-class obj)) 306 (eieio--object-class-name obj))
305(define-obsolete-function-alias 'object-class #'eieio-object-class "24.4") 307(define-obsolete-function-alias 'object-class #'eieio-object-class "24.4")
306;; CLOS name, maybe? 308;; CLOS name, maybe?
307(define-obsolete-function-alias 'class-of #'eieio-object-class "24.4") 309(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."
309(defun eieio-object-class-name (obj) 311(defun eieio-object-class-name (obj)
310 "Return a Lisp like symbol name for OBJ's class." 312 "Return a Lisp like symbol name for OBJ's class."
311 (eieio--check-type eieio-object-p obj) 313 (eieio--check-type eieio-object-p obj)
312 (eieio-class-name (eieio--object-class obj))) 314 (eieio-class-name (eieio--object-class-name obj)))
313(define-obsolete-function-alias 315(define-obsolete-function-alias
314 'object-class-name 'eieio-object-class-name "24.4") 316 'object-class-name 'eieio-object-class-name "24.4")
315 317
@@ -349,28 +351,31 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
349 "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." 351 "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses."
350 (eieio--check-type eieio-object-p obj) 352 (eieio--check-type eieio-object-p obj)
351 ;; class will be checked one layer down 353 ;; class will be checked one layer down
352 (child-of-class-p (eieio--object-class obj) class)) 354 (child-of-class-p (eieio--object-class-object obj) class))
353;; Backwards compatibility 355;; Backwards compatibility
354(defalias 'obj-of-class-p 'object-of-class-p) 356(defalias 'obj-of-class-p 'object-of-class-p)
355 357
356(defun child-of-class-p (child class) 358(defun child-of-class-p (child class)
357 "Return non-nil if CHILD class is a subclass of CLASS." 359 "Return non-nil if CHILD class is a subclass of CLASS."
358 (eieio--check-type class-p class) 360 (setq child (eieio--class-object child))
359 (eieio--check-type class-p child) 361 (eieio--check-type eieio--class-p child)
360 ;; `eieio-default-superclass' is never mentioned in eieio--class-parent, 362 ;; `eieio-default-superclass' is never mentioned in eieio--class-parent,
361 ;; so we have to special case it here. 363 ;; so we have to special case it here.
362 (or (eq class 'eieio-default-superclass) 364 (or (eq class 'eieio-default-superclass)
363 (let ((p nil)) 365 (let ((p nil))
366 (setq class (eieio--class-object class))
367 (eieio--check-type eieio--class-p class)
364 (while (and child (not (eq child class))) 368 (while (and child (not (eq child class)))
365 (setq p (append p (eieio--class-parent (eieio--class-v child))) 369 ;; FIXME: eieio--class-parent should return class-objects rather than
366 child (car p) 370 ;; class-names!
367 p (cdr p))) 371 (setq p (append p (eieio--class-parent child))
372 child (eieio--class-v (pop p))))
368 (if child t)))) 373 (if child t))))
369 374
370(defun object-slots (obj) 375(defun object-slots (obj)
371 "Return list of slots available in OBJ." 376 "Return list of slots available in OBJ."
372 (eieio--check-type eieio-object-p obj) 377 (eieio--check-type eieio-object-p obj)
373 (eieio--class-public-a (eieio--class-v (eieio--object-class obj)))) 378 (eieio--class-public-a (eieio--object-class-object obj)))
374 379
375(defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." 380(defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
376 (eieio--check-type class-p class) 381 (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."
543 (let ((newargs (or replacement-args eieio-generic-call-arglst)) 548 (let ((newargs (or replacement-args eieio-generic-call-arglst))
544 (next (car eieio-generic-call-next-method-list)) 549 (next (car eieio-generic-call-next-method-list))
545 ) 550 )
546 (if (or (not next) (not (car next))) 551 (if (not (and next (car next)))
547 (apply #'no-next-method (car newargs) (cdr newargs)) 552 (apply #'no-next-method (car newargs) (cdr newargs))
548 (let* ((eieio-generic-call-next-method-list 553 (let* ((eieio-generic-call-next-method-list
549 (cdr eieio-generic-call-next-method-list)) 554 (cdr eieio-generic-call-next-method-list))
550 (eieio-generic-call-arglst newargs) 555 (eieio-generic-call-arglst newargs)
551 (fcn (car next)) 556 (fcn (car next))
552 ) 557 )
553 (eieio--with-scoped-class (cdr next) 558 (eieio--with-scoped-class (eieio--class-v (cdr next))
554 (apply fcn newargs)) )))) 559 (apply fcn newargs)) ))))
555 560
556;;; Here are some CLOS items that need the CL package 561;;; Here are some CLOS items that need the CL package
@@ -603,10 +608,10 @@ Called from the constructor routine.")
603(defmethod shared-initialize ((obj eieio-default-superclass) slots) 608(defmethod shared-initialize ((obj eieio-default-superclass) slots)
604 "Set slots of OBJ with SLOTS which is a list of name/value pairs. 609 "Set slots of OBJ with SLOTS which is a list of name/value pairs.
605Called from the constructor routine." 610Called from the constructor routine."
606 (eieio--with-scoped-class (eieio--object-class obj) 611 (eieio--with-scoped-class (eieio--object-class-object obj)
607 (while slots 612 (while slots
608 (let ((rn (eieio-initarg-to-attribute (eieio--object-class obj) 613 (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj)
609 (car slots)))) 614 (car slots))))
610 (if (not rn) 615 (if (not rn)
611 (slot-missing obj (car slots) 'oset (car (cdr slots))) 616 (slot-missing obj (car slots) 'oset (car (cdr slots)))
612 (eieio-oset obj rn (car (cdr slots))))) 617 (eieio-oset obj rn (car (cdr slots)))))
@@ -627,7 +632,7 @@ not taken, then new objects of your class will not have their values
627dynamically set from SLOTS." 632dynamically set from SLOTS."
628 ;; First, see if any of our defaults are `lambda', and 633 ;; First, see if any of our defaults are `lambda', and
629 ;; re-evaluate them and apply the value to our slots. 634 ;; re-evaluate them and apply the value to our slots.
630 (let* ((this-class (eieio--class-v (eieio--object-class this))) 635 (let* ((this-class (eieio--object-class-object this))
631 (slot (eieio--class-public-a this-class)) 636 (slot (eieio--class-public-a this-class))
632 (defaults (eieio--class-public-d this-class))) 637 (defaults (eieio--class-public-d this-class)))
633 (while slot 638 (while slot
@@ -883,7 +888,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
883 888
884;;; Start of automatically extracted autoloads. 889;;; Start of automatically extracted autoloads.
885 890
886;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "3a6fffe3af331fe960f967d0da99e8e9") 891;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "2b4c57cf907e879e8bbc88d8f0e2de4c")
887;;; Generated autoloads from eieio-custom.el 892;;; Generated autoloads from eieio-custom.el
888 893
889(autoload 'customize-object "eieio-custom" "\ 894(autoload 'customize-object "eieio-custom" "\
diff --git a/test/ChangeLog b/test/ChangeLog
index bcc619a7f97..53e2c49c9d7 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,16 @@
12014-12-29 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * automated/eieio-test-methodinvoke.el (eieio-test-method-store):
4 Adjust to new semantics of eieio--scoped-class.
5 (eieio-test-match): Improve error feedback.
6
72014-12-23 Stefan Monnier <monnier@iro.umontreal.ca>
8
9 * automated/eieio-tests.el: Remove dummy object names.
10
11 * automated/eieio-test-persist.el (persistent-with-objs-slot-subs):
12 The type FOO-child is the same as FOO.
13
12014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> 142014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
2 15
3 * automated/eieio-test-methodinvoke.el (eieio-test-method-store): 16 * automated/eieio-test-methodinvoke.el (eieio-test-method-store):
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el
index 3f86d8fcc99..f99ee8d1f46 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -61,14 +61,16 @@
61 "Store current invocation class symbol in the invocation order list." 61 "Store current invocation class symbol in the invocation order list."
62 (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ] 62 (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ]
63 (or eieio-generic-call-key 0))) 63 (or eieio-generic-call-key 0)))
64 (c (list keysym (eieio--scoped-class)))) 64 ;; FIXME: Don't depend on `eieio--scoped-class'!
65 (c (list keysym (eieio--class-symbol (eieio--scoped-class)))))
65 (push c eieio-test-method-order-list))) 66 (push c eieio-test-method-order-list)))
66 67
67(defun eieio-test-match (rightanswer) 68(defun eieio-test-match (rightanswer)
68 "Do a test match." 69 "Do a test match."
69 (if (equal rightanswer eieio-test-method-order-list) 70 (if (equal rightanswer eieio-test-method-order-list)
70 t 71 t
71 (error "eieio-test-methodinvoke.el: Test Failed!"))) 72 (error "eieio-test-methodinvoke.el: Test Failed: %S != %S"
73 rightanswer eieio-test-method-order-list)))
72 74
73(defvar eieio-test-call-next-method-arguments nil 75(defvar eieio-test-call-next-method-arguments nil
74 "List of passed to methods during execution of `call-next-method'.") 76 "List of passed to methods during execution of `call-next-method'.")