diff options
| author | Stefan Monnier | 2014-12-29 12:11:09 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2014-12-29 12:11:09 -0500 |
| commit | 232823a1f163cebeafdab20ea2eb3f2da9645185 (patch) | |
| tree | 59df22737fb162918c05c533ee9b19548a6b21b3 | |
| parent | ee93d7ad4291a0946efe3197481cfbeff92f29b8 (diff) | |
| download | emacs-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/ChangeLog | 28 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-base.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 131 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-custom.el | 15 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 43 | ||||
| -rw-r--r-- | test/ChangeLog | 13 | ||||
| -rw-r--r-- | test/automated/eieio-test-methodinvoke.el | 6 |
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 @@ | |||
| 1 | 2014-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 | |||
| 1 | 2014-12-23 Stefan Monnier <monnier@iro.umontreal.ca> | 29 | 2014-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. | |||
| 290 | Second, any text properties will be stripped from strings." | 290 | Second, 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.") | |||
| 169 | Stored outright without modifications or stripping."))) | 166 | Stored 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. |
| 213 | CLASS is a symbol." | 230 | CLASS 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 | |||
| 1291 | slot. If the slot is ok, return VALUE. | 1322 | slot. If the slot is ok, return VALUE. |
| 1292 | Argument FN is the function calling this verifier." | 1323 | Argument 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." | |||
| 1325 | Fills in OBJ's SLOT with its default value." | 1356 | Fills 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." | |||
| 1361 | Fills in OBJ's SLOT with VALUE." | 1392 | Fills 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." | |||
| 1384 | Fills in the default value in CLASS' in SLOT with VALUE." | 1417 | Fills 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. |
| 1414 | This is for testing if the class currently in scope is the class that defines SLOT | 1447 | This is for testing if the class currently in scope is the class that defines SLOT |
| 1415 | so that we can protect private slots." | 1448 | so 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. |
| 1428 | The slot is a symbol which is installed in CLASS by the `defclass' | 1461 | The slot is a symbol which is installed in CLASS by the `defclass' |
| 1429 | call. OBJ can be nil, but if it is an object, and the slot in question | 1462 | call. OBJ can be nil, but if it is an object, and the slot in question |
| @@ -1432,7 +1465,7 @@ scoped class. | |||
| 1432 | If SLOT is the value created with :initarg instead, | 1465 | If SLOT is the value created with :initarg instead, |
| 1433 | reverse-lookup that name, and recurse with the associated slot value." | 1466 | reverse-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." | |||
| 1477 | If SET-ALL is non-nil, then when a default is nil, that value is | 1510 | If SET-ALL is non-nil, then when a default is nil, that value is |
| 1478 | reset. If SET-ALL is nil, the slots are only reset if the default is | 1511 | reset. If SET-ALL is nil, the slots are only reset if the default is |
| 1479 | not nil." | 1512 | not 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. |
| 1491 | If there is no translation, pass it in directly (so we can cheat if | 1524 | If there is no translation, pass it in directly (so we can cheat if |
| 1492 | need be... May remove that later...)" | 1525 | need 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. |
| 461 | Return the symbol for the group, or nil" | 462 | Return 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. |
| 274 | If EXTRA, include that in the string returned to represent the symbol." | 274 | If 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. |
| 605 | Called from the constructor routine." | 610 | Called 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 | |||
| 627 | dynamically set from SLOTS." | 632 | dynamically 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 @@ | |||
| 1 | 2014-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 | |||
| 7 | 2014-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 | |||
| 1 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> | 14 | 2014-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'.") |