diff options
| author | Stefan Monnier | 2015-01-08 00:24:24 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2015-01-08 00:24:24 -0500 |
| commit | 54181569d255322bdae321dc3fddeb465780fbe0 (patch) | |
| tree | c1ac30021555f7cf3d86599b920f3996ebfe4ec2 | |
| parent | 1599688e95802c34f35819f5600a48a81248732c (diff) | |
| download | emacs-54181569d255322bdae321dc3fddeb465780fbe0.tar.gz emacs-54181569d255322bdae321dc3fddeb465780fbe0.zip | |
* emacs-lisp/eieio-generic.el: New file.
* lisp/emacs-lisp/eieio-core.el: Move all generic function code to
eieio-generic.el.
(eieio--defmethod): Declare.
* lisp/emacs-lisp/eieio.el: Require eieio-generic. Move all generic
function code to eieio-generic.el.
* lisp/emacs-lisp/eieio-opt.el (eieio-help-generic): Move to
eieio-generic.el.
* lisp/emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): Update call
to eieio--generic-call.
* lisp/emacs-lisp/eieio-base.el (eieio-instance-inheritor): Don't use
<class>-child type.
* test/automated/eieio-test-methodinvoke.el (eieio-test-method-store):
Update reference to eieio--generic-call-key.
* test/automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use
<foo>-child-p.
| -rw-r--r-- | lisp/ChangeLog | 15 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-base.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 685 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-datadebug.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-generic.el | 904 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-opt.el | 65 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 139 | ||||
| -rw-r--r-- | test/ChangeLog | 8 | ||||
| -rw-r--r-- | test/automated/eieio-test-methodinvoke.el | 4 | ||||
| -rw-r--r-- | test/automated/eieio-tests.el | 6 |
10 files changed, 941 insertions, 893 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 808fab10ff8..66b3b8eb061 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,18 @@ | |||
| 1 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/eieio-generic.el: New file. | ||
| 4 | * emacs-lisp/eieio-core.el: Move all generic function code to | ||
| 5 | eieio-generic.el. | ||
| 6 | (eieio--defmethod): Declare. | ||
| 7 | * emacs-lisp/eieio.el: Require eieio-generic. Move all generic | ||
| 8 | function code to eieio-generic.el. | ||
| 9 | * emacs-lisp/eieio-opt.el (eieio-help-generic): Move to | ||
| 10 | eieio-generic.el. | ||
| 11 | * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): Update call | ||
| 12 | to eieio--generic-call. | ||
| 13 | * emacs-lisp/eieio-base.el (eieio-instance-inheritor): Don't use | ||
| 14 | <class>-child type. | ||
| 15 | |||
| 1 | 2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> | 16 | 2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 17 | ||
| 3 | * emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie): | 18 | * emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie): |
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index c3ea823f95c..9931fbd114e 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*- | 1 | ;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;;; Copyright (C) 2000-2002, 2004-2005, 2007-2014 Free Software | 3 | ;;; Copyright (C) 2000-2002, 2004-2005, 2007-2015 Free Software |
| 4 | ;;; Foundation, Inc. | 4 | ;;; Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | 6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
| @@ -40,7 +40,7 @@ | |||
| 40 | ;; error if a slot is unbound. | 40 | ;; error if a slot is unbound. |
| 41 | (defclass eieio-instance-inheritor () | 41 | (defclass eieio-instance-inheritor () |
| 42 | ((parent-instance :initarg :parent-instance | 42 | ((parent-instance :initarg :parent-instance |
| 43 | :type eieio-instance-inheritor-child | 43 | :type eieio-instance-inheritor |
| 44 | :documentation | 44 | :documentation |
| 45 | "The parent of this instance. | 45 | "The parent of this instance. |
| 46 | If a slot of this class is referenced, and is unbound, then the parent | 46 | If a slot of this class is referenced, and is unbound, then the parent |
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index f7a26d2dedb..fba4d8f50c7 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -186,24 +186,6 @@ Stored outright without modifications or stripping."))) | |||
| 186 | ;; eieio--object-class-object instead! | 186 | ;; eieio--object-class-object instead! |
| 187 | (eieio--class-symbol (eieio--object-class-object obj))) | 187 | (eieio--class-symbol (eieio--object-class-object obj))) |
| 188 | 188 | ||
| 189 | ;; FIXME: The constants below should have an `eieio-' prefix added!! | ||
| 190 | (defconst eieio--method-static 0 "Index into :static tag on a method.") | ||
| 191 | (defconst eieio--method-before 1 "Index into :before tag on a method.") | ||
| 192 | (defconst eieio--method-primary 2 "Index into :primary tag on a method.") | ||
| 193 | (defconst eieio--method-after 3 "Index into :after tag on a method.") | ||
| 194 | (defconst eieio--method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") | ||
| 195 | (defconst eieio--method-generic-before 4 "Index into generic :before tag on a method.") | ||
| 196 | (defconst eieio--method-generic-primary 5 "Index into generic :primary tag on a method.") | ||
| 197 | (defconst eieio--method-generic-after 6 "Index into generic :after tag on a method.") | ||
| 198 | (defconst eieio--method-num-slots 7 "Number of indexes into a method's vector.") | ||
| 199 | |||
| 200 | (defsubst eieio-specialized-key-to-generic-key (key) | ||
| 201 | "Convert a specialized KEY into a generic method key." | ||
| 202 | (cond ((eq key eieio--method-static) 0) ;; don't convert | ||
| 203 | ((< key eieio--method-num-lists) (+ key 3)) ;; The conversion | ||
| 204 | (t key) ;; already generic.. maybe. | ||
| 205 | )) | ||
| 206 | |||
| 207 | 189 | ||
| 208 | ;;; Important macros used internally in eieio. | 190 | ;;; Important macros used internally in eieio. |
| 209 | ;; | 191 | ;; |
| @@ -266,44 +248,6 @@ CLASS is a symbol." ;FIXME: Is it a vector or a symbol? | |||
| 266 | (declare (debug t)) | 248 | (declare (debug t)) |
| 267 | `(eieio--class-symbol (eieio--class-v ,class))) | 249 | `(eieio--class-symbol (eieio--class-v ,class))) |
| 268 | 250 | ||
| 269 | (defsubst generic-p (method) | ||
| 270 | "Return non-nil if symbol METHOD is a generic function. | ||
| 271 | Only methods have the symbol `eieio-method-hashtable' as a property | ||
| 272 | \(which contains a list of all bindings to that method type.)" | ||
| 273 | (and (fboundp method) (get method 'eieio-method-hashtable))) | ||
| 274 | |||
| 275 | (defun generic-primary-only-p (method) | ||
| 276 | "Return t if symbol METHOD is a generic function with only primary methods. | ||
| 277 | Only methods have the symbol `eieio-method-hashtable' as a property (which | ||
| 278 | contains a list of all bindings to that method type.) | ||
| 279 | Methods with only primary implementations are executed in an optimized way." | ||
| 280 | (and (generic-p method) | ||
| 281 | (let ((M (get method 'eieio-method-tree))) | ||
| 282 | (not (or (>= 0 (length (aref M eieio--method-primary))) | ||
| 283 | (aref M eieio--method-static) | ||
| 284 | (aref M eieio--method-before) | ||
| 285 | (aref M eieio--method-after) | ||
| 286 | (aref M eieio--method-generic-before) | ||
| 287 | (aref M eieio--method-generic-primary) | ||
| 288 | (aref M eieio--method-generic-after))) | ||
| 289 | ))) | ||
| 290 | |||
| 291 | (defun generic-primary-only-one-p (method) | ||
| 292 | "Return t if symbol METHOD is a generic function with only primary methods. | ||
| 293 | Only methods have the symbol `eieio-method-hashtable' as a property (which | ||
| 294 | contains a list of all bindings to that method type.) | ||
| 295 | Methods with only primary implementations are executed in an optimized way." | ||
| 296 | (and (generic-p method) | ||
| 297 | (let ((M (get method 'eieio-method-tree))) | ||
| 298 | (not (or (/= 1 (length (aref M eieio--method-primary))) | ||
| 299 | (aref M eieio--method-static) | ||
| 300 | (aref M eieio--method-before) | ||
| 301 | (aref M eieio--method-after) | ||
| 302 | (aref M eieio--method-generic-before) | ||
| 303 | (aref M eieio--method-generic-primary) | ||
| 304 | (aref M eieio--method-generic-after))) | ||
| 305 | ))) | ||
| 306 | |||
| 307 | (defmacro eieio--class-option-assoc (list option) | 251 | (defmacro eieio--class-option-assoc (list option) |
| 308 | "Return from LIST the found OPTION, or nil if it doesn't exist." | 252 | "Return from LIST the found OPTION, or nil if it doesn't exist." |
| 309 | `(car-safe (cdr (memq ,option ,list)))) | 253 | `(car-safe (cdr (memq ,option ,list)))) |
| @@ -418,6 +362,8 @@ It creates an autoload function for CNAME's constructor." | |||
| 418 | (cl-every (lambda (elem) (cl-typep elem ',elem-type)) | 362 | (cl-every (lambda (elem) (cl-typep elem ',elem-type)) |
| 419 | list))))) | 363 | list))))) |
| 420 | 364 | ||
| 365 | (declare-function eieio--defmethod "eieio-generic" (method kind argclass code)) | ||
| 366 | |||
| 421 | (defun eieio-defclass (cname superclasses slots options-and-doc) | 367 | (defun eieio-defclass (cname superclasses slots options-and-doc) |
| 422 | ;; FIXME: Most of this should be moved to the `defclass' macro. | 368 | ;; FIXME: Most of this should be moved to the `defclass' macro. |
| 423 | "Define CNAME as a new subclass of SUPERCLASSES. | 369 | "Define CNAME as a new subclass of SUPERCLASSES. |
| @@ -1133,154 +1079,6 @@ the new child class." | |||
| 1133 | ))))) | 1079 | ))))) |
| 1134 | 1080 | ||
| 1135 | 1081 | ||
| 1136 | ;;; CLOS methods and generics | ||
| 1137 | ;; | ||
| 1138 | |||
| 1139 | (defun eieio--defgeneric-init-form (method doc-string) | ||
| 1140 | "Form to use for the initial definition of a generic." | ||
| 1141 | (while (and (fboundp method) (symbolp (symbol-function method))) | ||
| 1142 | ;; Follow aliases, so methods applied to obsolete aliases still work. | ||
| 1143 | (setq method (symbol-function method))) | ||
| 1144 | |||
| 1145 | (cond | ||
| 1146 | ((or (not (fboundp method)) | ||
| 1147 | (eq 'autoload (car-safe (symbol-function method)))) | ||
| 1148 | ;; Make sure the method tables are installed. | ||
| 1149 | (eieiomt-install method) | ||
| 1150 | ;; Construct the actual body of this function. | ||
| 1151 | (put method 'function-documentation doc-string) | ||
| 1152 | (eieio-defgeneric-form method)) | ||
| 1153 | ((generic-p method) (symbol-function method)) ;Leave it as-is. | ||
| 1154 | (t (error "You cannot create a generic/method over an existing symbol: %s" | ||
| 1155 | method)))) | ||
| 1156 | |||
| 1157 | (defun eieio-defgeneric-form (method) | ||
| 1158 | "The lambda form that would be used as the function defined on METHOD. | ||
| 1159 | All methods should call the same EIEIO function for dispatch. | ||
| 1160 | DOC-STRING is the documentation attached to METHOD." | ||
| 1161 | (lambda (&rest local-args) | ||
| 1162 | (eieio-generic-call method local-args))) | ||
| 1163 | |||
| 1164 | (defun eieio--defgeneric-form-primary-only (method) | ||
| 1165 | "The lambda form that would be used as the function defined on METHOD. | ||
| 1166 | All methods should call the same EIEIO function for dispatch. | ||
| 1167 | DOC-STRING is the documentation attached to METHOD." | ||
| 1168 | (lambda (&rest local-args) | ||
| 1169 | (eieio--generic-call-primary-only method local-args))) | ||
| 1170 | |||
| 1171 | (declare-function no-applicable-method "eieio" (object method &rest args)) | ||
| 1172 | |||
| 1173 | (defvar eieio-generic-call-arglst nil | ||
| 1174 | "When using `call-next-method', provides a context for parameters.") | ||
| 1175 | (defvar eieio-generic-call-key nil | ||
| 1176 | "When using `call-next-method', provides a context for the current key. | ||
| 1177 | Keys are a number representing :before, :primary, and :after methods.") | ||
| 1178 | (defvar eieio-generic-call-next-method-list nil | ||
| 1179 | "When executing a PRIMARY or STATIC method, track the 'next-method'. | ||
| 1180 | During executions, the list is first generated, then as each next method | ||
| 1181 | is called, the next method is popped off the stack.") | ||
| 1182 | |||
| 1183 | (defun eieio--defgeneric-form-primary-only-one (method class impl) | ||
| 1184 | "The lambda form that would be used as the function defined on METHOD. | ||
| 1185 | All methods should call the same EIEIO function for dispatch. | ||
| 1186 | CLASS is the class symbol needed for private method access. | ||
| 1187 | IMPL is the symbol holding the method implementation." | ||
| 1188 | (lambda (&rest local-args) | ||
| 1189 | ;; This is a cool cheat. Usually we need to look up in the | ||
| 1190 | ;; method table to find out if there is a method or not. We can | ||
| 1191 | ;; instead make that determination at load time when there is | ||
| 1192 | ;; only one method. If the first arg is not a child of the class | ||
| 1193 | ;; of that one implementation, then clearly, there is no method def. | ||
| 1194 | (if (not (eieio-object-p (car local-args))) | ||
| 1195 | ;; Not an object. Just signal. | ||
| 1196 | (signal 'no-method-definition | ||
| 1197 | (list method local-args)) | ||
| 1198 | |||
| 1199 | ;; We do have an object. Make sure it is the right type. | ||
| 1200 | (if (not (child-of-class-p (eieio--object-class-object (car local-args)) | ||
| 1201 | class)) | ||
| 1202 | |||
| 1203 | ;; If not the right kind of object, call no applicable | ||
| 1204 | (apply #'no-applicable-method (car local-args) | ||
| 1205 | method local-args) | ||
| 1206 | |||
| 1207 | ;; It is ok, do the call. | ||
| 1208 | ;; Fill in inter-call variables then evaluate the method. | ||
| 1209 | (let ((eieio-generic-call-next-method-list nil) | ||
| 1210 | (eieio-generic-call-key eieio--method-primary) | ||
| 1211 | (eieio-generic-call-arglst local-args) | ||
| 1212 | ) | ||
| 1213 | (eieio--with-scoped-class (eieio--class-v class) | ||
| 1214 | (apply impl local-args))))))) | ||
| 1215 | |||
| 1216 | (defun eieio-unbind-method-implementations (method) | ||
| 1217 | "Make the generic method METHOD have no implementations. | ||
| 1218 | It will leave the original generic function in place, | ||
| 1219 | but remove reference to all implementations of METHOD." | ||
| 1220 | (put method 'eieio-method-tree nil) | ||
| 1221 | (put method 'eieio-method-hashtable nil)) | ||
| 1222 | |||
| 1223 | (defun eieio--method-optimize-primary (method) | ||
| 1224 | (when eieio-optimize-primary-methods-flag | ||
| 1225 | ;; Optimizing step: | ||
| 1226 | ;; | ||
| 1227 | ;; If this method, after this setup, only has primary methods, then | ||
| 1228 | ;; we can setup the generic that way. | ||
| 1229 | (let ((doc-string (documentation method 'raw))) | ||
| 1230 | (put method 'function-documentation doc-string) | ||
| 1231 | ;; Use `defalias' so as to interact properly with nadvice.el. | ||
| 1232 | (defalias method | ||
| 1233 | (if (generic-primary-only-p method) | ||
| 1234 | ;; If there is only one primary method, then we can go one more | ||
| 1235 | ;; optimization step. | ||
| 1236 | (if (generic-primary-only-one-p method) | ||
| 1237 | (let* ((M (get method 'eieio-method-tree)) | ||
| 1238 | (entry (car (aref M eieio--method-primary)))) | ||
| 1239 | (eieio--defgeneric-form-primary-only-one | ||
| 1240 | method (car entry) (cdr entry))) | ||
| 1241 | (eieio--defgeneric-form-primary-only method)) | ||
| 1242 | (eieio-defgeneric-form method)))))) | ||
| 1243 | |||
| 1244 | (defun eieio--defmethod (method kind argclass code) | ||
| 1245 | "Work part of the `defmethod' macro defining METHOD with ARGS." | ||
| 1246 | (let ((key | ||
| 1247 | ;; Find optional keys. | ||
| 1248 | (cond ((memq kind '(:BEFORE :before)) eieio--method-before) | ||
| 1249 | ((memq kind '(:AFTER :after)) eieio--method-after) | ||
| 1250 | ((memq kind '(:STATIC :static)) eieio--method-static) | ||
| 1251 | ((memq kind '(:PRIMARY :primary nil)) eieio--method-primary) | ||
| 1252 | ;; Primary key. | ||
| 1253 | ;; (t eieio--method-primary) | ||
| 1254 | (t (error "Unknown method kind %S" kind))))) | ||
| 1255 | |||
| 1256 | (while (and (fboundp method) (symbolp (symbol-function method))) | ||
| 1257 | ;; Follow aliases, so methods applied to obsolete aliases still work. | ||
| 1258 | (setq method (symbol-function method))) | ||
| 1259 | |||
| 1260 | ;; Make sure there is a generic (when called from defclass). | ||
| 1261 | (eieio--defalias | ||
| 1262 | method (eieio--defgeneric-init-form | ||
| 1263 | method (or (documentation code) | ||
| 1264 | (format "Generically created method `%s'." method)))) | ||
| 1265 | ;; Create symbol for property to bind to. If the first arg is of | ||
| 1266 | ;; the form (varname vartype) and `vartype' is a class, then | ||
| 1267 | ;; that class will be the type symbol. If not, then it will fall | ||
| 1268 | ;; under the type `primary' which is a non-specific calling of the | ||
| 1269 | ;; function. | ||
| 1270 | (if argclass | ||
| 1271 | (if (not (class-p argclass)) ;FIXME: Accept cl-defstructs! | ||
| 1272 | (error "Unknown class type %s in method parameters" | ||
| 1273 | argclass)) | ||
| 1274 | ;; Generics are higher. | ||
| 1275 | (setq key (eieio-specialized-key-to-generic-key key))) | ||
| 1276 | ;; Put this lambda into the symbol so we can find it. | ||
| 1277 | (eieiomt-add method code key argclass) | ||
| 1278 | ) | ||
| 1279 | |||
| 1280 | (eieio--method-optimize-primary method) | ||
| 1281 | |||
| 1282 | method) | ||
| 1283 | |||
| 1284 | ;;; Slot type validation | 1082 | ;;; Slot type validation |
| 1285 | 1083 | ||
| 1286 | ;; This is a hideous hack for replacing `typep' from cl-macs, to avoid | 1084 | ;; This is a hideous hack for replacing `typep' from cl-macs, to avoid |
| @@ -1663,492 +1461,13 @@ method invocation orders of the involved classes." | |||
| 1663 | 'class-precedence-list 'eieio--class-precedence-list "24.4") | 1461 | 'class-precedence-list 'eieio--class-precedence-list "24.4") |
| 1664 | 1462 | ||
| 1665 | 1463 | ||
| 1666 | ;;; CLOS generics internal function handling | ||
| 1667 | ;; | ||
| 1668 | |||
| 1669 | (define-obsolete-variable-alias 'eieio-pre-method-execution-hooks | ||
| 1670 | 'eieio-pre-method-execution-functions "24.3") | ||
| 1671 | (defvar eieio-pre-method-execution-functions nil | ||
| 1672 | "Abnormal hook run just before an EIEIO method is executed. | ||
| 1673 | The hook function must accept one argument, the list of forms | ||
| 1674 | about to be executed.") | ||
| 1675 | |||
| 1676 | (defun eieio-generic-call (method args) | ||
| 1677 | "Call METHOD with ARGS. | ||
| 1678 | ARGS provides the context on which implementation to use. | ||
| 1679 | This should only be called from a generic function." | ||
| 1680 | ;; We must expand our arguments first as they are always | ||
| 1681 | ;; passed in as quoted symbols | ||
| 1682 | (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil) | ||
| 1683 | (eieio-generic-call-arglst args) | ||
| 1684 | (firstarg nil) | ||
| 1685 | (primarymethodlist nil)) | ||
| 1686 | ;; get a copy | ||
| 1687 | (setq newargs args | ||
| 1688 | firstarg (car newargs)) | ||
| 1689 | ;; Is the class passed in autoloaded? | ||
| 1690 | ;; Since class names are also constructors, they can be autoloaded | ||
| 1691 | ;; via the autoload command. Check for this, and load them in. | ||
| 1692 | ;; It is ok if it doesn't turn out to be a class. Probably want that | ||
| 1693 | ;; function loaded anyway. | ||
| 1694 | (if (and (symbolp firstarg) | ||
| 1695 | (fboundp firstarg) | ||
| 1696 | (autoloadp (symbol-function firstarg))) | ||
| 1697 | (autoload-do-load (symbol-function firstarg))) | ||
| 1698 | ;; Determine the class to use. | ||
| 1699 | (cond ((eieio-object-p firstarg) | ||
| 1700 | (setq mclass (eieio--object-class-name firstarg))) | ||
| 1701 | ((class-p firstarg) | ||
| 1702 | (setq mclass firstarg)) | ||
| 1703 | ) | ||
| 1704 | ;; Make sure the class is a valid class | ||
| 1705 | ;; mclass can be nil (meaning a generic for should be used. | ||
| 1706 | ;; mclass cannot have a value that is not a class, however. | ||
| 1707 | (unless (or (null mclass) (class-p mclass)) | ||
| 1708 | (error "Cannot dispatch method %S on class %S" | ||
| 1709 | method mclass) | ||
| 1710 | ) | ||
| 1711 | ;; Now create a list in reverse order of all the calls we have | ||
| 1712 | ;; make in order to successfully do this right. Rules: | ||
| 1713 | ;; 1) Only call generics if scoped-class is not defined | ||
| 1714 | ;; This prevents multiple calls in the case of recursion | ||
| 1715 | ;; 2) Only call static if this is a static method. | ||
| 1716 | ;; 3) Only call specifics if the definition allows for them. | ||
| 1717 | ;; 4) Call in order based on :before, :primary, and :after | ||
| 1718 | (when (eieio-object-p firstarg) | ||
| 1719 | ;; Non-static calls do all this stuff. | ||
| 1720 | |||
| 1721 | ;; :after methods | ||
| 1722 | (setq tlambdas | ||
| 1723 | (if mclass | ||
| 1724 | (eieiomt-method-list method eieio--method-after mclass) | ||
| 1725 | (list (eieio-generic-form method eieio--method-after nil))) | ||
| 1726 | ;;(or (and mclass (eieio-generic-form method eieio--method-after mclass)) | ||
| 1727 | ;; (eieio-generic-form method eieio--method-after nil)) | ||
| 1728 | ) | ||
| 1729 | (setq lambdas (append tlambdas lambdas) | ||
| 1730 | keys (append (make-list (length tlambdas) eieio--method-after) keys)) | ||
| 1731 | |||
| 1732 | ;; :primary methods | ||
| 1733 | (setq tlambdas | ||
| 1734 | (or (and mclass (eieio-generic-form method eieio--method-primary mclass)) | ||
| 1735 | (eieio-generic-form method eieio--method-primary nil))) | ||
| 1736 | (when tlambdas | ||
| 1737 | (setq lambdas (cons tlambdas lambdas) | ||
| 1738 | keys (cons eieio--method-primary keys) | ||
| 1739 | primarymethodlist | ||
| 1740 | (eieiomt-method-list method eieio--method-primary mclass))) | ||
| 1741 | |||
| 1742 | ;; :before methods | ||
| 1743 | (setq tlambdas | ||
| 1744 | (if mclass | ||
| 1745 | (eieiomt-method-list method eieio--method-before mclass) | ||
| 1746 | (list (eieio-generic-form method eieio--method-before nil))) | ||
| 1747 | ;;(or (and mclass (eieio-generic-form method eieio--method-before mclass)) | ||
| 1748 | ;; (eieio-generic-form method eieio--method-before nil)) | ||
| 1749 | ) | ||
| 1750 | (setq lambdas (append tlambdas lambdas) | ||
| 1751 | keys (append (make-list (length tlambdas) eieio--method-before) keys)) | ||
| 1752 | ) | ||
| 1753 | |||
| 1754 | (if mclass | ||
| 1755 | ;; For the case of a class, | ||
| 1756 | ;; if there were no methods found, then there could be :static methods. | ||
| 1757 | (when (not lambdas) | ||
| 1758 | (setq tlambdas | ||
| 1759 | (eieio-generic-form method eieio--method-static mclass)) | ||
| 1760 | (setq lambdas (cons tlambdas lambdas) | ||
| 1761 | keys (cons eieio--method-static keys) | ||
| 1762 | primarymethodlist ;; Re-use even with bad name here | ||
| 1763 | (eieiomt-method-list method eieio--method-static mclass))) | ||
| 1764 | ;; For the case of no class (ie - mclass == nil) then there may | ||
| 1765 | ;; be a primary method. | ||
| 1766 | (setq tlambdas | ||
| 1767 | (eieio-generic-form method eieio--method-primary nil)) | ||
| 1768 | (when tlambdas | ||
| 1769 | (setq lambdas (cons tlambdas lambdas) | ||
| 1770 | keys (cons eieio--method-primary keys) | ||
| 1771 | primarymethodlist | ||
| 1772 | (eieiomt-method-list method eieio--method-primary nil))) | ||
| 1773 | ) | ||
| 1774 | |||
| 1775 | (run-hook-with-args 'eieio-pre-method-execution-functions | ||
| 1776 | primarymethodlist) | ||
| 1777 | |||
| 1778 | ;; Now loop through all occurrences forms which we must execute | ||
| 1779 | ;; (which are happily sorted now) and execute them all! | ||
| 1780 | (let ((rval nil) (lastval nil) (found nil)) | ||
| 1781 | (while lambdas | ||
| 1782 | (if (car lambdas) | ||
| 1783 | (eieio--with-scoped-class (cdr (car lambdas)) | ||
| 1784 | (let* ((eieio-generic-call-key (car keys)) | ||
| 1785 | (has-return-val | ||
| 1786 | (or (= eieio-generic-call-key eieio--method-primary) | ||
| 1787 | (= eieio-generic-call-key eieio--method-static))) | ||
| 1788 | (eieio-generic-call-next-method-list | ||
| 1789 | ;; Use the cdr, as the first element is the fcn | ||
| 1790 | ;; we are calling right now. | ||
| 1791 | (when has-return-val (cdr primarymethodlist))) | ||
| 1792 | ) | ||
| 1793 | (setq found t) | ||
| 1794 | ;;(setq rval (apply (car (car lambdas)) newargs)) | ||
| 1795 | (setq lastval (apply (car (car lambdas)) newargs)) | ||
| 1796 | (when has-return-val | ||
| 1797 | (setq rval lastval)) | ||
| 1798 | ))) | ||
| 1799 | (setq lambdas (cdr lambdas) | ||
| 1800 | keys (cdr keys))) | ||
| 1801 | (if (not found) | ||
| 1802 | (if (eieio-object-p (car args)) | ||
| 1803 | (setq rval (apply #'no-applicable-method (car args) method args)) | ||
| 1804 | (signal | ||
| 1805 | 'no-method-definition | ||
| 1806 | (list method args)))) | ||
| 1807 | rval))) | ||
| 1808 | |||
| 1809 | (defun eieio--generic-call-primary-only (method args) | ||
| 1810 | "Call METHOD with ARGS for methods with only :PRIMARY implementations. | ||
| 1811 | ARGS provides the context on which implementation to use. | ||
| 1812 | This should only be called from a generic function. | ||
| 1813 | |||
| 1814 | This method is like `eieio-generic-call', but only | ||
| 1815 | implementations in the :PRIMARY slot are queried. After many | ||
| 1816 | years of use, it appears that over 90% of methods in use | ||
| 1817 | have :PRIMARY implementations only. We can therefore optimize | ||
| 1818 | for this common case to improve performance." | ||
| 1819 | ;; We must expand our arguments first as they are always | ||
| 1820 | ;; passed in as quoted symbols | ||
| 1821 | (let ((newargs nil) (mclass nil) (lambdas nil) | ||
| 1822 | (eieio-generic-call-arglst args) | ||
| 1823 | (firstarg nil) | ||
| 1824 | (primarymethodlist nil) | ||
| 1825 | ) | ||
| 1826 | ;; get a copy | ||
| 1827 | (setq newargs args | ||
| 1828 | firstarg (car newargs)) | ||
| 1829 | |||
| 1830 | ;; Determine the class to use. | ||
| 1831 | (cond ((eieio-object-p firstarg) | ||
| 1832 | (setq mclass (eieio--object-class-name firstarg))) | ||
| 1833 | ((not firstarg) | ||
| 1834 | (error "Method %s called on nil" method)) | ||
| 1835 | (t | ||
| 1836 | (error "Primary-only method %s called on something not an object" method))) | ||
| 1837 | ;; Make sure the class is a valid class | ||
| 1838 | ;; mclass can be nil (meaning a generic for should be used. | ||
| 1839 | ;; mclass cannot have a value that is not a class, however. | ||
| 1840 | (when (null mclass) | ||
| 1841 | (error "Cannot dispatch method %S on class %S" method mclass) | ||
| 1842 | ) | ||
| 1843 | |||
| 1844 | ;; :primary methods | ||
| 1845 | (setq lambdas (eieio-generic-form method eieio--method-primary mclass)) | ||
| 1846 | (setq primarymethodlist ;; Re-use even with bad name here | ||
| 1847 | (eieiomt-method-list method eieio--method-primary mclass)) | ||
| 1848 | |||
| 1849 | ;; Now loop through all occurrences forms which we must execute | ||
| 1850 | ;; (which are happily sorted now) and execute them all! | ||
| 1851 | (eieio--with-scoped-class (cdr lambdas) | ||
| 1852 | (let* ((rval nil) (lastval nil) | ||
| 1853 | (eieio-generic-call-key eieio--method-primary) | ||
| 1854 | ;; Use the cdr, as the first element is the fcn | ||
| 1855 | ;; we are calling right now. | ||
| 1856 | (eieio-generic-call-next-method-list (cdr primarymethodlist)) | ||
| 1857 | ) | ||
| 1858 | |||
| 1859 | (if (or (not lambdas) (not (car lambdas))) | ||
| 1860 | |||
| 1861 | ;; No methods found for this impl... | ||
| 1862 | (if (eieio-object-p (car args)) | ||
| 1863 | (setq rval (apply #'no-applicable-method | ||
| 1864 | (car args) method args)) | ||
| 1865 | (signal | ||
| 1866 | 'no-method-definition | ||
| 1867 | (list method args))) | ||
| 1868 | |||
| 1869 | ;; Do the regular implementation here. | ||
| 1870 | |||
| 1871 | (run-hook-with-args 'eieio-pre-method-execution-functions | ||
| 1872 | lambdas) | ||
| 1873 | |||
| 1874 | (setq lastval (apply (car lambdas) newargs)) | ||
| 1875 | (setq rval lastval)) | ||
| 1876 | |||
| 1877 | rval)))) | ||
| 1878 | |||
| 1879 | (defun eieiomt-method-list (method key class) | ||
| 1880 | "Return an alist list of methods lambdas. | ||
| 1881 | METHOD is the method name. | ||
| 1882 | KEY represents either :before, or :after methods. | ||
| 1883 | CLASS is the starting class to search from in the method tree. | ||
| 1884 | If CLASS is nil, then an empty list of methods should be returned." | ||
| 1885 | ;; Note: eieiomt - the MT means MethodTree. See more comments below | ||
| 1886 | ;; for the rest of the eieiomt methods. | ||
| 1887 | |||
| 1888 | ;; Collect lambda expressions stored for the class and its parent | ||
| 1889 | ;; classes. | ||
| 1890 | (let (lambdas) | ||
| 1891 | (dolist (ancestor (eieio--class-precedence-list (eieio--class-v class))) | ||
| 1892 | ;; Lookup the form to use for the PRIMARY object for the next level | ||
| 1893 | (let ((tmpl (eieio-generic-form method key ancestor))) | ||
| 1894 | (when (and tmpl | ||
| 1895 | (or (not lambdas) | ||
| 1896 | ;; This prevents duplicates coming out of the | ||
| 1897 | ;; class method optimizer. Perhaps we should | ||
| 1898 | ;; just not optimize before/afters? | ||
| 1899 | (not (member tmpl lambdas)))) | ||
| 1900 | (push tmpl lambdas)))) | ||
| 1901 | |||
| 1902 | ;; Return collected lambda. For :after methods, return in current | ||
| 1903 | ;; order (most general class last); Otherwise, reverse order. | ||
| 1904 | (if (eq key eieio--method-after) | ||
| 1905 | lambdas | ||
| 1906 | (nreverse lambdas)))) | ||
| 1907 | |||
| 1908 | |||
| 1909 | ;;; | ||
| 1910 | ;; eieio-method-tree : eieiomt- | ||
| 1911 | ;; | ||
| 1912 | ;; Stored as eieio-method-tree in property list of a generic method | ||
| 1913 | ;; | ||
| 1914 | ;; (eieio-method-tree . [BEFORE PRIMARY AFTER | ||
| 1915 | ;; genericBEFORE genericPRIMARY genericAFTER]) | ||
| 1916 | ;; and | ||
| 1917 | ;; (eieio-method-hashtable . [BEFORE PRIMARY AFTER | ||
| 1918 | ;; genericBEFORE genericPRIMARY genericAFTER]) | ||
| 1919 | ;; where the association is a vector. | ||
| 1920 | ;; (aref 0 -- all static methods. | ||
| 1921 | ;; (aref 1 -- all methods classified as :before | ||
| 1922 | ;; (aref 2 -- all methods classified as :primary | ||
| 1923 | ;; (aref 3 -- all methods classified as :after | ||
| 1924 | ;; (aref 4 -- a generic classified as :before | ||
| 1925 | ;; (aref 5 -- a generic classified as :primary | ||
| 1926 | ;; (aref 6 -- a generic classified as :after | ||
| 1927 | ;; | ||
| 1928 | (defvar eieiomt--optimizing-hashtable nil | ||
| 1929 | "While mapping atoms, this contain the hashtable being optimized.") | ||
| 1930 | |||
| 1931 | (defun eieiomt-install (method-name) | ||
| 1932 | "Install the method tree, and hashtable onto METHOD-NAME. | ||
| 1933 | Do not do the work if they already exist." | ||
| 1934 | (unless (and (get method-name 'eieio-method-tree) | ||
| 1935 | (get method-name 'eieio-method-hashtable)) | ||
| 1936 | (put method-name 'eieio-method-tree | ||
| 1937 | (make-vector eieio--method-num-slots nil)) | ||
| 1938 | (let ((emto (put method-name 'eieio-method-hashtable | ||
| 1939 | (make-vector eieio--method-num-slots nil)))) | ||
| 1940 | (aset emto 0 (make-hash-table :test 'eq)) | ||
| 1941 | (aset emto 1 (make-hash-table :test 'eq)) | ||
| 1942 | (aset emto 2 (make-hash-table :test 'eq)) | ||
| 1943 | (aset emto 3 (make-hash-table :test 'eq))))) | ||
| 1944 | |||
| 1945 | (defun eieiomt-add (method-name method key class) | ||
| 1946 | "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS. | ||
| 1947 | METHOD-NAME is the name created by a call to `defgeneric'. | ||
| 1948 | METHOD are the forms for a given implementation. | ||
| 1949 | KEY is an integer (see comment in eieio.el near this function) which | ||
| 1950 | is associated with the :static :before :primary and :after tags. | ||
| 1951 | It also indicates if CLASS is defined or not. | ||
| 1952 | CLASS is the class this method is associated with." | ||
| 1953 | (if (or (> key eieio--method-num-slots) (< key 0)) | ||
| 1954 | (error "eieiomt-add: method key error!")) | ||
| 1955 | (let ((emtv (get method-name 'eieio-method-tree)) | ||
| 1956 | (emto (get method-name 'eieio-method-hashtable))) | ||
| 1957 | ;; Make sure the method tables are available. | ||
| 1958 | (unless (and emtv emto) | ||
| 1959 | (error "Programmer error: eieiomt-add")) | ||
| 1960 | ;; only add new cells on if it doesn't already exist! | ||
| 1961 | (if (assq class (aref emtv key)) | ||
| 1962 | (setcdr (assq class (aref emtv key)) method) | ||
| 1963 | (aset emtv key (cons (cons class method) (aref emtv key)))) | ||
| 1964 | ;; Add function definition into newly created symbol, and store | ||
| 1965 | ;; said symbol in the correct hashtable, otherwise use the | ||
| 1966 | ;; other array to keep this stuff. | ||
| 1967 | (if (< key eieio--method-num-lists) | ||
| 1968 | (puthash (eieio--class-v class) (list method) (aref emto key))) | ||
| 1969 | ;; Save the defmethod file location in a symbol property. | ||
| 1970 | (let ((fname (if load-in-progress | ||
| 1971 | load-file-name | ||
| 1972 | buffer-file-name))) | ||
| 1973 | (when fname | ||
| 1974 | (when (string-match "\\.elc\\'" fname) | ||
| 1975 | (setq fname (substring fname 0 (1- (length fname))))) | ||
| 1976 | (cl-pushnew (list class fname) (get method-name 'method-locations) | ||
| 1977 | :test 'equal))) | ||
| 1978 | ;; Now optimize the entire hashtable. | ||
| 1979 | (if (< key eieio--method-num-lists) | ||
| 1980 | (let ((eieiomt--optimizing-hashtable (aref emto key))) | ||
| 1981 | ;; @todo - Is this overkill? Should we just clear the symbol? | ||
| 1982 | (maphash #'eieiomt--sym-optimize eieiomt--optimizing-hashtable))) | ||
| 1983 | )) | ||
| 1984 | |||
| 1985 | (defun eieiomt-next (class) | ||
| 1986 | "Return the next parent class for CLASS. | ||
| 1987 | If CLASS is a superclass, return variable `eieio-default-superclass'. | ||
| 1988 | If CLASS is variable `eieio-default-superclass' then return nil. | ||
| 1989 | This is different from function `class-parent' as class parent returns | ||
| 1990 | nil for superclasses. This function performs no type checking!" | ||
| 1991 | ;; No type-checking because all calls are made from functions which | ||
| 1992 | ;; are safe and do checking for us. | ||
| 1993 | (or (eieio--class-parent (eieio--class-v class)) | ||
| 1994 | (if (eq class 'eieio-default-superclass) | ||
| 1995 | nil | ||
| 1996 | '(eieio-default-superclass)))) | ||
| 1997 | |||
| 1998 | (defun eieiomt--sym-optimize (class s) | ||
| 1999 | "Find the next class above S which has a function body for the optimizer." | ||
| 2000 | ;; Set the value to nil in case there is no nearest cell. | ||
| 2001 | (setcdr s nil) | ||
| 2002 | ;; Find the nearest cell that has a function body. If we find one, | ||
| 2003 | ;; we replace the nil from above. | ||
| 2004 | (catch 'done | ||
| 2005 | (dolist (ancestor | ||
| 2006 | (cl-rest (eieio--class-precedence-list class))) | ||
| 2007 | (let ((ov (gethash ancestor eieiomt--optimizing-hashtable))) | ||
| 2008 | (when (car ov) | ||
| 2009 | (setcdr s ancestor) ;; store ov as our next symbol | ||
| 2010 | (throw 'done ancestor)))))) | ||
| 2011 | |||
| 2012 | (defun eieio-generic-form (method key class) | ||
| 2013 | "Return the lambda form belonging to METHOD using KEY based upon CLASS. | ||
| 2014 | If CLASS is not a class then use `generic' instead. If class has | ||
| 2015 | no form, but has a parent class, then trace to that parent class. | ||
| 2016 | The first time a form is requested from a symbol, an optimized path | ||
| 2017 | is memorized for faster future use." | ||
| 2018 | (if (symbolp class) (setq class (eieio--class-v class))) | ||
| 2019 | (let ((emto (aref (get method 'eieio-method-hashtable) | ||
| 2020 | (if class key (eieio-specialized-key-to-generic-key key))))) | ||
| 2021 | (if (eieio--class-p class) | ||
| 2022 | ;; 1) find our symbol | ||
| 2023 | (let ((cs (gethash class emto))) | ||
| 2024 | (unless cs | ||
| 2025 | ;; 2) If there isn't one, then make one. | ||
| 2026 | ;; This can be slow since it only occurs once | ||
| 2027 | (puthash class (setq cs (list nil)) emto) | ||
| 2028 | ;; 2.1) Cache its nearest neighbor with a quick optimize | ||
| 2029 | ;; which should only occur once for this call ever | ||
| 2030 | (let ((eieiomt--optimizing-hashtable emto)) | ||
| 2031 | (eieiomt--sym-optimize class cs))) | ||
| 2032 | ;; 3) If it's bound return this one. | ||
| 2033 | (if (car cs) | ||
| 2034 | (cons (car cs) class) | ||
| 2035 | ;; 4) If it's not bound then this variable knows something | ||
| 2036 | (if (cdr cs) | ||
| 2037 | (progn | ||
| 2038 | ;; 4.1) This symbol holds the next class in its value | ||
| 2039 | (setq class (cdr cs) | ||
| 2040 | cs (gethash class emto)) | ||
| 2041 | ;; 4.2) The optimizer should always have chosen a | ||
| 2042 | ;; function-symbol | ||
| 2043 | ;;(if (car cs) | ||
| 2044 | (cons (car cs) class) | ||
| 2045 | ;;(error "EIEIO optimizer: erratic data loss!")) | ||
| 2046 | ) | ||
| 2047 | ;; There never will be a funcall... | ||
| 2048 | nil))) | ||
| 2049 | ;; for a generic call, what is a list, is the function body we want. | ||
| 2050 | (let ((emtl (aref (get method 'eieio-method-tree) | ||
| 2051 | (if class key (eieio-specialized-key-to-generic-key key))))) | ||
| 2052 | (if emtl | ||
| 2053 | ;; The car of EMTL is supposed to be a class, which in this | ||
| 2054 | ;; case is nil, so skip it. | ||
| 2055 | (cons (cdr (car emtl)) nil) | ||
| 2056 | nil))))) | ||
| 2057 | |||
| 2058 | |||
| 2059 | ;;; Here are some special types of errors | 1464 | ;;; Here are some special types of errors |
| 2060 | ;; | 1465 | ;; |
| 2061 | (define-error 'no-method-definition "No method definition") | ||
| 2062 | (define-error 'no-next-method "No next method") | ||
| 2063 | (define-error 'invalid-slot-name "Invalid slot name") | 1466 | (define-error 'invalid-slot-name "Invalid slot name") |
| 2064 | (define-error 'invalid-slot-type "Invalid slot type") | 1467 | (define-error 'invalid-slot-type "Invalid slot type") |
| 2065 | (define-error 'unbound-slot "Unbound slot") | 1468 | (define-error 'unbound-slot "Unbound slot") |
| 2066 | (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") | 1469 | (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") |
| 2067 | 1470 | ||
| 2068 | ;;; Obsolete backward compatibility functions. | ||
| 2069 | ;; Needed to run byte-code compiled with the EIEIO of Emacs-23. | ||
| 2070 | |||
| 2071 | (defun eieio-defmethod (method args) | ||
| 2072 | "Obsolete work part of an old version of the `defmethod' macro." | ||
| 2073 | (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) | ||
| 2074 | ;; find optional keys | ||
| 2075 | (setq key | ||
| 2076 | (cond ((memq (car args) '(:BEFORE :before)) | ||
| 2077 | (setq args (cdr args)) | ||
| 2078 | eieio--method-before) | ||
| 2079 | ((memq (car args) '(:AFTER :after)) | ||
| 2080 | (setq args (cdr args)) | ||
| 2081 | eieio--method-after) | ||
| 2082 | ((memq (car args) '(:STATIC :static)) | ||
| 2083 | (setq args (cdr args)) | ||
| 2084 | eieio--method-static) | ||
| 2085 | ((memq (car args) '(:PRIMARY :primary)) | ||
| 2086 | (setq args (cdr args)) | ||
| 2087 | eieio--method-primary) | ||
| 2088 | ;; Primary key. | ||
| 2089 | (t eieio--method-primary))) | ||
| 2090 | ;; Get body, and fix contents of args to be the arguments of the fn. | ||
| 2091 | (setq body (cdr args) | ||
| 2092 | args (car args)) | ||
| 2093 | (setq loopa args) | ||
| 2094 | ;; Create a fixed version of the arguments. | ||
| 2095 | (while loopa | ||
| 2096 | (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) | ||
| 2097 | argfix)) | ||
| 2098 | (setq loopa (cdr loopa))) | ||
| 2099 | ;; Make sure there is a generic. | ||
| 2100 | (eieio-defgeneric | ||
| 2101 | method | ||
| 2102 | (if (stringp (car body)) | ||
| 2103 | (car body) (format "Generically created method `%s'." method))) | ||
| 2104 | ;; create symbol for property to bind to. If the first arg is of | ||
| 2105 | ;; the form (varname vartype) and `vartype' is a class, then | ||
| 2106 | ;; that class will be the type symbol. If not, then it will fall | ||
| 2107 | ;; under the type `primary' which is a non-specific calling of the | ||
| 2108 | ;; function. | ||
| 2109 | (setq firstarg (car args)) | ||
| 2110 | (if (listp firstarg) | ||
| 2111 | (progn | ||
| 2112 | (setq argclass (nth 1 firstarg)) | ||
| 2113 | (if (not (class-p argclass)) | ||
| 2114 | (error "Unknown class type %s in method parameters" | ||
| 2115 | (nth 1 firstarg)))) | ||
| 2116 | ;; Generics are higher. | ||
| 2117 | (setq key (eieio-specialized-key-to-generic-key key))) | ||
| 2118 | ;; Put this lambda into the symbol so we can find it. | ||
| 2119 | (if (byte-code-function-p (car-safe body)) | ||
| 2120 | (eieiomt-add method (car-safe body) key argclass) | ||
| 2121 | (eieiomt-add method (append (list 'lambda (reverse argfix)) body) | ||
| 2122 | key argclass)) | ||
| 2123 | ) | ||
| 2124 | |||
| 2125 | (eieio--method-optimize-primary method) | ||
| 2126 | |||
| 2127 | method) | ||
| 2128 | (make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1") | ||
| 2129 | |||
| 2130 | (defun eieio-defgeneric (method doc-string) | ||
| 2131 | "Obsolete work part of an old version of the `defgeneric' macro." | ||
| 2132 | (if (and (fboundp method) (not (generic-p method)) | ||
| 2133 | (or (byte-code-function-p (symbol-function method)) | ||
| 2134 | (not (eq 'autoload (car (symbol-function method))))) | ||
| 2135 | ) | ||
| 2136 | (error "You cannot create a generic/method over an existing symbol: %s" | ||
| 2137 | method)) | ||
| 2138 | ;; Don't do this over and over. | ||
| 2139 | (unless (fboundp 'method) | ||
| 2140 | ;; This defun tells emacs where the first definition of this | ||
| 2141 | ;; method is defined. | ||
| 2142 | `(defun ,method nil) | ||
| 2143 | ;; Make sure the method tables are installed. | ||
| 2144 | (eieiomt-install method) | ||
| 2145 | ;; Apply the actual body of this function. | ||
| 2146 | (put method 'function-documentation doc-string) | ||
| 2147 | (fset method (eieio-defgeneric-form method)) | ||
| 2148 | ;; Return the method | ||
| 2149 | 'method)) | ||
| 2150 | (make-obsolete 'eieio-defgeneric nil "24.1") | ||
| 2151 | |||
| 2152 | (provide 'eieio-core) | 1471 | (provide 'eieio-core) |
| 2153 | 1472 | ||
| 2154 | ;;; eieio-core.el ends here | 1473 | ;;; eieio-core.el ends here |
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 69e72573deb..43d9a03932a 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*- | 1 | ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007-2014 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007-2015 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | 5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
| 6 | ;; Keywords: OO, lisp | 6 | ;; Keywords: OO, lisp |
| @@ -137,7 +137,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." | |||
| 137 | (let* ((eieio-pre-method-execution-functions | 137 | (let* ((eieio-pre-method-execution-functions |
| 138 | (lambda (l) (throw 'moose l) )) | 138 | (lambda (l) (throw 'moose l) )) |
| 139 | (data | 139 | (data |
| 140 | (catch 'moose (eieio-generic-call | 140 | (catch 'moose (eieio--generic-call |
| 141 | method (list class)))) | 141 | method (list class)))) |
| 142 | (_buf (data-debug-new-buffer "*Method Invocation*")) | 142 | (_buf (data-debug-new-buffer "*Method Invocation*")) |
| 143 | (data2 (mapcar (lambda (sym) | 143 | (data2 (mapcar (lambda (sym) |
diff --git a/lisp/emacs-lisp/eieio-generic.el b/lisp/emacs-lisp/eieio-generic.el new file mode 100644 index 00000000000..0e90074660e --- /dev/null +++ b/lisp/emacs-lisp/eieio-generic.el | |||
| @@ -0,0 +1,904 @@ | |||
| 1 | ;;; eieio-generic.el --- CLOS-style generics for EIEIO -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | ||
| 6 | ;; Keywords: OO, lisp | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | ;; | ||
| 25 | ;; The "core" part of EIEIO is the implementation for the object | ||
| 26 | ;; system (such as eieio-defclass, or eieio-defmethod) but not the | ||
| 27 | ;; base classes for the object system, which are defined in EIEIO. | ||
| 28 | ;; | ||
| 29 | ;; See the commentary for eieio.el for more about EIEIO itself. | ||
| 30 | |||
| 31 | ;;; Code: | ||
| 32 | |||
| 33 | (require 'eieio-core) | ||
| 34 | (declare-function child-of-class-p "eieio") | ||
| 35 | |||
| 36 | (defconst eieio--method-static 0 "Index into :static tag on a method.") | ||
| 37 | (defconst eieio--method-before 1 "Index into :before tag on a method.") | ||
| 38 | (defconst eieio--method-primary 2 "Index into :primary tag on a method.") | ||
| 39 | (defconst eieio--method-after 3 "Index into :after tag on a method.") | ||
| 40 | (defconst eieio--method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") | ||
| 41 | (defconst eieio--method-generic-before 4 "Index into generic :before tag on a method.") | ||
| 42 | (defconst eieio--method-generic-primary 5 "Index into generic :primary tag on a method.") | ||
| 43 | (defconst eieio--method-generic-after 6 "Index into generic :after tag on a method.") | ||
| 44 | (defconst eieio--method-num-slots 7 "Number of indexes into a method's vector.") | ||
| 45 | |||
| 46 | (defsubst eieio--specialized-key-to-generic-key (key) | ||
| 47 | "Convert a specialized KEY into a generic method key." | ||
| 48 | (cond ((eq key eieio--method-static) 0) ;; don't convert | ||
| 49 | ((< key eieio--method-num-lists) (+ key 3)) ;; The conversion | ||
| 50 | (t key) ;; already generic.. maybe. | ||
| 51 | )) | ||
| 52 | |||
| 53 | |||
| 54 | (defsubst generic-p (method) | ||
| 55 | "Return non-nil if symbol METHOD is a generic function. | ||
| 56 | Only methods have the symbol `eieio-method-hashtable' as a property | ||
| 57 | \(which contains a list of all bindings to that method type.)" | ||
| 58 | (and (fboundp method) (get method 'eieio-method-hashtable))) | ||
| 59 | |||
| 60 | (defun eieio--generic-primary-only-p (method) | ||
| 61 | "Return t if symbol METHOD is a generic function with only primary methods. | ||
| 62 | Only methods have the symbol `eieio-method-hashtable' as a property (which | ||
| 63 | contains a list of all bindings to that method type.) | ||
| 64 | Methods with only primary implementations are executed in an optimized way." | ||
| 65 | (and (generic-p method) | ||
| 66 | (let ((M (get method 'eieio-method-tree))) | ||
| 67 | (not (or (>= 0 (length (aref M eieio--method-primary))) | ||
| 68 | (aref M eieio--method-static) | ||
| 69 | (aref M eieio--method-before) | ||
| 70 | (aref M eieio--method-after) | ||
| 71 | (aref M eieio--method-generic-before) | ||
| 72 | (aref M eieio--method-generic-primary) | ||
| 73 | (aref M eieio--method-generic-after))) | ||
| 74 | ))) | ||
| 75 | |||
| 76 | (defun eieio--generic-primary-only-one-p (method) | ||
| 77 | "Return t if symbol METHOD is a generic function with only primary methods. | ||
| 78 | Only methods have the symbol `eieio-method-hashtable' as a property (which | ||
| 79 | contains a list of all bindings to that method type.) | ||
| 80 | Methods with only primary implementations are executed in an optimized way." | ||
| 81 | (and (generic-p method) | ||
| 82 | (let ((M (get method 'eieio-method-tree))) | ||
| 83 | (not (or (/= 1 (length (aref M eieio--method-primary))) | ||
| 84 | (aref M eieio--method-static) | ||
| 85 | (aref M eieio--method-before) | ||
| 86 | (aref M eieio--method-after) | ||
| 87 | (aref M eieio--method-generic-before) | ||
| 88 | (aref M eieio--method-generic-primary) | ||
| 89 | (aref M eieio--method-generic-after))) | ||
| 90 | ))) | ||
| 91 | |||
| 92 | (defun eieio--defgeneric-init-form (method doc-string) | ||
| 93 | "Form to use for the initial definition of a generic." | ||
| 94 | (while (and (fboundp method) (symbolp (symbol-function method))) | ||
| 95 | ;; Follow aliases, so methods applied to obsolete aliases still work. | ||
| 96 | (setq method (symbol-function method))) | ||
| 97 | |||
| 98 | (cond | ||
| 99 | ((or (not (fboundp method)) | ||
| 100 | (eq 'autoload (car-safe (symbol-function method)))) | ||
| 101 | ;; Make sure the method tables are installed. | ||
| 102 | (eieio--mt-install method) | ||
| 103 | ;; Construct the actual body of this function. | ||
| 104 | (put method 'function-documentation doc-string) | ||
| 105 | (eieio--defgeneric-form method)) | ||
| 106 | ((generic-p method) (symbol-function method)) ;Leave it as-is. | ||
| 107 | (t (error "You cannot create a generic/method over an existing symbol: %s" | ||
| 108 | method)))) | ||
| 109 | |||
| 110 | (defun eieio--defgeneric-form (method) | ||
| 111 | "The lambda form that would be used as the function defined on METHOD. | ||
| 112 | All methods should call the same EIEIO function for dispatch. | ||
| 113 | DOC-STRING is the documentation attached to METHOD." | ||
| 114 | (lambda (&rest local-args) | ||
| 115 | (eieio--generic-call method local-args))) | ||
| 116 | |||
| 117 | (defun eieio--defgeneric-form-primary-only (method) | ||
| 118 | "The lambda form that would be used as the function defined on METHOD. | ||
| 119 | All methods should call the same EIEIO function for dispatch. | ||
| 120 | DOC-STRING is the documentation attached to METHOD." | ||
| 121 | (lambda (&rest local-args) | ||
| 122 | (eieio--generic-call-primary-only method local-args))) | ||
| 123 | |||
| 124 | (defvar eieio--generic-call-arglst nil | ||
| 125 | "When using `call-next-method', provides a context for parameters.") | ||
| 126 | (defvar eieio--generic-call-key nil | ||
| 127 | "When using `call-next-method', provides a context for the current key. | ||
| 128 | Keys are a number representing :before, :primary, and :after methods.") | ||
| 129 | (defvar eieio--generic-call-next-method-list nil | ||
| 130 | "When executing a PRIMARY or STATIC method, track the 'next-method'. | ||
| 131 | During executions, the list is first generated, then as each next method | ||
| 132 | is called, the next method is popped off the stack.") | ||
| 133 | |||
| 134 | (defun eieio--defgeneric-form-primary-only-one (method class impl) | ||
| 135 | "The lambda form that would be used as the function defined on METHOD. | ||
| 136 | All methods should call the same EIEIO function for dispatch. | ||
| 137 | CLASS is the class symbol needed for private method access. | ||
| 138 | IMPL is the symbol holding the method implementation." | ||
| 139 | (lambda (&rest local-args) | ||
| 140 | ;; This is a cool cheat. Usually we need to look up in the | ||
| 141 | ;; method table to find out if there is a method or not. We can | ||
| 142 | ;; instead make that determination at load time when there is | ||
| 143 | ;; only one method. If the first arg is not a child of the class | ||
| 144 | ;; of that one implementation, then clearly, there is no method def. | ||
| 145 | (if (not (eieio-object-p (car local-args))) | ||
| 146 | ;; Not an object. Just signal. | ||
| 147 | (signal 'no-method-definition | ||
| 148 | (list method local-args)) | ||
| 149 | |||
| 150 | ;; We do have an object. Make sure it is the right type. | ||
| 151 | (if (not (child-of-class-p (eieio--object-class-object (car local-args)) | ||
| 152 | class)) | ||
| 153 | |||
| 154 | ;; If not the right kind of object, call no applicable | ||
| 155 | (apply #'no-applicable-method (car local-args) | ||
| 156 | method local-args) | ||
| 157 | |||
| 158 | ;; It is ok, do the call. | ||
| 159 | ;; Fill in inter-call variables then evaluate the method. | ||
| 160 | (let ((eieio--generic-call-next-method-list nil) | ||
| 161 | (eieio--generic-call-key eieio--method-primary) | ||
| 162 | (eieio--generic-call-arglst local-args) | ||
| 163 | ) | ||
| 164 | (eieio--with-scoped-class (eieio--class-v class) | ||
| 165 | (apply impl local-args))))))) | ||
| 166 | |||
| 167 | (defun eieio-unbind-method-implementations (method) | ||
| 168 | "Make the generic method METHOD have no implementations. | ||
| 169 | It will leave the original generic function in place, | ||
| 170 | but remove reference to all implementations of METHOD." | ||
| 171 | (put method 'eieio-method-tree nil) | ||
| 172 | (put method 'eieio-method-hashtable nil)) | ||
| 173 | |||
| 174 | (defun eieio--method-optimize-primary (method) | ||
| 175 | (when eieio-optimize-primary-methods-flag | ||
| 176 | ;; Optimizing step: | ||
| 177 | ;; | ||
| 178 | ;; If this method, after this setup, only has primary methods, then | ||
| 179 | ;; we can setup the generic that way. | ||
| 180 | (let ((doc-string (documentation method 'raw))) | ||
| 181 | (put method 'function-documentation doc-string) | ||
| 182 | ;; Use `defalias' so as to interact properly with nadvice.el. | ||
| 183 | (defalias method | ||
| 184 | (if (eieio--generic-primary-only-p method) | ||
| 185 | ;; If there is only one primary method, then we can go one more | ||
| 186 | ;; optimization step. | ||
| 187 | (if (eieio--generic-primary-only-one-p method) | ||
| 188 | (let* ((M (get method 'eieio-method-tree)) | ||
| 189 | (entry (car (aref M eieio--method-primary)))) | ||
| 190 | (eieio--defgeneric-form-primary-only-one | ||
| 191 | method (car entry) (cdr entry))) | ||
| 192 | (eieio--defgeneric-form-primary-only method)) | ||
| 193 | (eieio--defgeneric-form method)))))) | ||
| 194 | |||
| 195 | (defun eieio--defmethod (method kind argclass code) | ||
| 196 | "Work part of the `defmethod' macro defining METHOD with ARGS." | ||
| 197 | (let ((key | ||
| 198 | ;; Find optional keys. | ||
| 199 | (cond ((memq kind '(:BEFORE :before)) eieio--method-before) | ||
| 200 | ((memq kind '(:AFTER :after)) eieio--method-after) | ||
| 201 | ((memq kind '(:STATIC :static)) eieio--method-static) | ||
| 202 | ((memq kind '(:PRIMARY :primary nil)) eieio--method-primary) | ||
| 203 | ;; Primary key. | ||
| 204 | ;; (t eieio--method-primary) | ||
| 205 | (t (error "Unknown method kind %S" kind))))) | ||
| 206 | |||
| 207 | (while (and (fboundp method) (symbolp (symbol-function method))) | ||
| 208 | ;; Follow aliases, so methods applied to obsolete aliases still work. | ||
| 209 | (setq method (symbol-function method))) | ||
| 210 | |||
| 211 | ;; Make sure there is a generic (when called from defclass). | ||
| 212 | (eieio--defalias | ||
| 213 | method (eieio--defgeneric-init-form | ||
| 214 | method (or (documentation code) | ||
| 215 | (format "Generically created method `%s'." method)))) | ||
| 216 | ;; Create symbol for property to bind to. If the first arg is of | ||
| 217 | ;; the form (varname vartype) and `vartype' is a class, then | ||
| 218 | ;; that class will be the type symbol. If not, then it will fall | ||
| 219 | ;; under the type `primary' which is a non-specific calling of the | ||
| 220 | ;; function. | ||
| 221 | (if argclass | ||
| 222 | (if (not (class-p argclass)) ;FIXME: Accept cl-defstructs! | ||
| 223 | (error "Unknown class type %s in method parameters" | ||
| 224 | argclass)) | ||
| 225 | ;; Generics are higher. | ||
| 226 | (setq key (eieio--specialized-key-to-generic-key key))) | ||
| 227 | ;; Put this lambda into the symbol so we can find it. | ||
| 228 | (eieio--mt-add method code key argclass) | ||
| 229 | ) | ||
| 230 | |||
| 231 | (eieio--method-optimize-primary method) | ||
| 232 | |||
| 233 | method) | ||
| 234 | |||
| 235 | (define-obsolete-variable-alias 'eieio-pre-method-execution-hooks | ||
| 236 | 'eieio-pre-method-execution-functions "24.3") | ||
| 237 | (defvar eieio-pre-method-execution-functions nil | ||
| 238 | "Abnormal hook run just before an EIEIO method is executed. | ||
| 239 | The hook function must accept one argument, the list of forms | ||
| 240 | about to be executed.") | ||
| 241 | |||
| 242 | (defun eieio--generic-call (method args) | ||
| 243 | "Call METHOD with ARGS. | ||
| 244 | ARGS provides the context on which implementation to use. | ||
| 245 | This should only be called from a generic function." | ||
| 246 | ;; We must expand our arguments first as they are always | ||
| 247 | ;; passed in as quoted symbols | ||
| 248 | (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil) | ||
| 249 | (eieio--generic-call-arglst args) | ||
| 250 | (firstarg nil) | ||
| 251 | (primarymethodlist nil)) | ||
| 252 | ;; get a copy | ||
| 253 | (setq newargs args | ||
| 254 | firstarg (car newargs)) | ||
| 255 | ;; Is the class passed in autoloaded? | ||
| 256 | ;; Since class names are also constructors, they can be autoloaded | ||
| 257 | ;; via the autoload command. Check for this, and load them in. | ||
| 258 | ;; It is ok if it doesn't turn out to be a class. Probably want that | ||
| 259 | ;; function loaded anyway. | ||
| 260 | (if (and (symbolp firstarg) | ||
| 261 | (fboundp firstarg) | ||
| 262 | (autoloadp (symbol-function firstarg))) | ||
| 263 | (autoload-do-load (symbol-function firstarg))) | ||
| 264 | ;; Determine the class to use. | ||
| 265 | (cond ((eieio-object-p firstarg) | ||
| 266 | (setq mclass (eieio--object-class-name firstarg))) | ||
| 267 | ((class-p firstarg) | ||
| 268 | (setq mclass firstarg)) | ||
| 269 | ) | ||
| 270 | ;; Make sure the class is a valid class | ||
| 271 | ;; mclass can be nil (meaning a generic for should be used. | ||
| 272 | ;; mclass cannot have a value that is not a class, however. | ||
| 273 | (unless (or (null mclass) (class-p mclass)) | ||
| 274 | (error "Cannot dispatch method %S on class %S" | ||
| 275 | method mclass) | ||
| 276 | ) | ||
| 277 | ;; Now create a list in reverse order of all the calls we have | ||
| 278 | ;; make in order to successfully do this right. Rules: | ||
| 279 | ;; 1) Only call generics if scoped-class is not defined | ||
| 280 | ;; This prevents multiple calls in the case of recursion | ||
| 281 | ;; 2) Only call static if this is a static method. | ||
| 282 | ;; 3) Only call specifics if the definition allows for them. | ||
| 283 | ;; 4) Call in order based on :before, :primary, and :after | ||
| 284 | (when (eieio-object-p firstarg) | ||
| 285 | ;; Non-static calls do all this stuff. | ||
| 286 | |||
| 287 | ;; :after methods | ||
| 288 | (setq tlambdas | ||
| 289 | (if mclass | ||
| 290 | (eieio--mt-method-list method eieio--method-after mclass) | ||
| 291 | (list (eieio--generic-form method eieio--method-after nil))) | ||
| 292 | ;;(or (and mclass (eieio--generic-form method eieio--method-after mclass)) | ||
| 293 | ;; (eieio--generic-form method eieio--method-after nil)) | ||
| 294 | ) | ||
| 295 | (setq lambdas (append tlambdas lambdas) | ||
| 296 | keys (append (make-list (length tlambdas) eieio--method-after) keys)) | ||
| 297 | |||
| 298 | ;; :primary methods | ||
| 299 | (setq tlambdas | ||
| 300 | (or (and mclass (eieio--generic-form method eieio--method-primary mclass)) | ||
| 301 | (eieio--generic-form method eieio--method-primary nil))) | ||
| 302 | (when tlambdas | ||
| 303 | (setq lambdas (cons tlambdas lambdas) | ||
| 304 | keys (cons eieio--method-primary keys) | ||
| 305 | primarymethodlist | ||
| 306 | (eieio--mt-method-list method eieio--method-primary mclass))) | ||
| 307 | |||
| 308 | ;; :before methods | ||
| 309 | (setq tlambdas | ||
| 310 | (if mclass | ||
| 311 | (eieio--mt-method-list method eieio--method-before mclass) | ||
| 312 | (list (eieio--generic-form method eieio--method-before nil))) | ||
| 313 | ;;(or (and mclass (eieio--generic-form method eieio--method-before mclass)) | ||
| 314 | ;; (eieio--generic-form method eieio--method-before nil)) | ||
| 315 | ) | ||
| 316 | (setq lambdas (append tlambdas lambdas) | ||
| 317 | keys (append (make-list (length tlambdas) eieio--method-before) keys)) | ||
| 318 | ) | ||
| 319 | |||
| 320 | (if mclass | ||
| 321 | ;; For the case of a class, | ||
| 322 | ;; if there were no methods found, then there could be :static methods. | ||
| 323 | (when (not lambdas) | ||
| 324 | (setq tlambdas | ||
| 325 | (eieio--generic-form method eieio--method-static mclass)) | ||
| 326 | (setq lambdas (cons tlambdas lambdas) | ||
| 327 | keys (cons eieio--method-static keys) | ||
| 328 | primarymethodlist ;; Re-use even with bad name here | ||
| 329 | (eieio--mt-method-list method eieio--method-static mclass))) | ||
| 330 | ;; For the case of no class (ie - mclass == nil) then there may | ||
| 331 | ;; be a primary method. | ||
| 332 | (setq tlambdas | ||
| 333 | (eieio--generic-form method eieio--method-primary nil)) | ||
| 334 | (when tlambdas | ||
| 335 | (setq lambdas (cons tlambdas lambdas) | ||
| 336 | keys (cons eieio--method-primary keys) | ||
| 337 | primarymethodlist | ||
| 338 | (eieio--mt-method-list method eieio--method-primary nil))) | ||
| 339 | ) | ||
| 340 | |||
| 341 | (run-hook-with-args 'eieio-pre-method-execution-functions | ||
| 342 | primarymethodlist) | ||
| 343 | |||
| 344 | ;; Now loop through all occurrences forms which we must execute | ||
| 345 | ;; (which are happily sorted now) and execute them all! | ||
| 346 | (let ((rval nil) (lastval nil) (found nil)) | ||
| 347 | (while lambdas | ||
| 348 | (if (car lambdas) | ||
| 349 | (eieio--with-scoped-class (cdr (car lambdas)) | ||
| 350 | (let* ((eieio--generic-call-key (car keys)) | ||
| 351 | (has-return-val | ||
| 352 | (or (= eieio--generic-call-key eieio--method-primary) | ||
| 353 | (= eieio--generic-call-key eieio--method-static))) | ||
| 354 | (eieio--generic-call-next-method-list | ||
| 355 | ;; Use the cdr, as the first element is the fcn | ||
| 356 | ;; we are calling right now. | ||
| 357 | (when has-return-val (cdr primarymethodlist))) | ||
| 358 | ) | ||
| 359 | (setq found t) | ||
| 360 | ;;(setq rval (apply (car (car lambdas)) newargs)) | ||
| 361 | (setq lastval (apply (car (car lambdas)) newargs)) | ||
| 362 | (when has-return-val | ||
| 363 | (setq rval lastval)) | ||
| 364 | ))) | ||
| 365 | (setq lambdas (cdr lambdas) | ||
| 366 | keys (cdr keys))) | ||
| 367 | (if (not found) | ||
| 368 | (if (eieio-object-p (car args)) | ||
| 369 | (setq rval (apply #'no-applicable-method (car args) method args)) | ||
| 370 | (signal | ||
| 371 | 'no-method-definition | ||
| 372 | (list method args)))) | ||
| 373 | rval))) | ||
| 374 | |||
| 375 | (defun eieio--generic-call-primary-only (method args) | ||
| 376 | "Call METHOD with ARGS for methods with only :PRIMARY implementations. | ||
| 377 | ARGS provides the context on which implementation to use. | ||
| 378 | This should only be called from a generic function. | ||
| 379 | |||
| 380 | This method is like `eieio--generic-call', but only | ||
| 381 | implementations in the :PRIMARY slot are queried. After many | ||
| 382 | years of use, it appears that over 90% of methods in use | ||
| 383 | have :PRIMARY implementations only. We can therefore optimize | ||
| 384 | for this common case to improve performance." | ||
| 385 | ;; We must expand our arguments first as they are always | ||
| 386 | ;; passed in as quoted symbols | ||
| 387 | (let ((newargs nil) (mclass nil) (lambdas nil) | ||
| 388 | (eieio--generic-call-arglst args) | ||
| 389 | (firstarg nil) | ||
| 390 | (primarymethodlist nil) | ||
| 391 | ) | ||
| 392 | ;; get a copy | ||
| 393 | (setq newargs args | ||
| 394 | firstarg (car newargs)) | ||
| 395 | |||
| 396 | ;; Determine the class to use. | ||
| 397 | (cond ((eieio-object-p firstarg) | ||
| 398 | (setq mclass (eieio--object-class-name firstarg))) | ||
| 399 | ((not firstarg) | ||
| 400 | (error "Method %s called on nil" method)) | ||
| 401 | (t | ||
| 402 | (error "Primary-only method %s called on something not an object" method))) | ||
| 403 | ;; Make sure the class is a valid class | ||
| 404 | ;; mclass can be nil (meaning a generic for should be used. | ||
| 405 | ;; mclass cannot have a value that is not a class, however. | ||
| 406 | (when (null mclass) | ||
| 407 | (error "Cannot dispatch method %S on class %S" method mclass) | ||
| 408 | ) | ||
| 409 | |||
| 410 | ;; :primary methods | ||
| 411 | (setq lambdas (eieio--generic-form method eieio--method-primary mclass)) | ||
| 412 | (setq primarymethodlist ;; Re-use even with bad name here | ||
| 413 | (eieio--mt-method-list method eieio--method-primary mclass)) | ||
| 414 | |||
| 415 | ;; Now loop through all occurrences forms which we must execute | ||
| 416 | ;; (which are happily sorted now) and execute them all! | ||
| 417 | (eieio--with-scoped-class (cdr lambdas) | ||
| 418 | (let* ((rval nil) (lastval nil) | ||
| 419 | (eieio--generic-call-key eieio--method-primary) | ||
| 420 | ;; Use the cdr, as the first element is the fcn | ||
| 421 | ;; we are calling right now. | ||
| 422 | (eieio--generic-call-next-method-list (cdr primarymethodlist)) | ||
| 423 | ) | ||
| 424 | |||
| 425 | (if (or (not lambdas) (not (car lambdas))) | ||
| 426 | |||
| 427 | ;; No methods found for this impl... | ||
| 428 | (if (eieio-object-p (car args)) | ||
| 429 | (setq rval (apply #'no-applicable-method | ||
| 430 | (car args) method args)) | ||
| 431 | (signal | ||
| 432 | 'no-method-definition | ||
| 433 | (list method args))) | ||
| 434 | |||
| 435 | ;; Do the regular implementation here. | ||
| 436 | |||
| 437 | (run-hook-with-args 'eieio-pre-method-execution-functions | ||
| 438 | lambdas) | ||
| 439 | |||
| 440 | (setq lastval (apply (car lambdas) newargs)) | ||
| 441 | (setq rval lastval)) | ||
| 442 | |||
| 443 | rval)))) | ||
| 444 | |||
| 445 | (defun eieio--mt-method-list (method key class) | ||
| 446 | "Return an alist list of methods lambdas. | ||
| 447 | METHOD is the method name. | ||
| 448 | KEY represents either :before, or :after methods. | ||
| 449 | CLASS is the starting class to search from in the method tree. | ||
| 450 | If CLASS is nil, then an empty list of methods should be returned." | ||
| 451 | ;; Note: eieiomt - the MT means MethodTree. See more comments below | ||
| 452 | ;; for the rest of the eieiomt methods. | ||
| 453 | |||
| 454 | ;; Collect lambda expressions stored for the class and its parent | ||
| 455 | ;; classes. | ||
| 456 | (let (lambdas) | ||
| 457 | (dolist (ancestor (eieio--class-precedence-list (eieio--class-v class))) | ||
| 458 | ;; Lookup the form to use for the PRIMARY object for the next level | ||
| 459 | (let ((tmpl (eieio--generic-form method key ancestor))) | ||
| 460 | (when (and tmpl | ||
| 461 | (or (not lambdas) | ||
| 462 | ;; This prevents duplicates coming out of the | ||
| 463 | ;; class method optimizer. Perhaps we should | ||
| 464 | ;; just not optimize before/afters? | ||
| 465 | (not (member tmpl lambdas)))) | ||
| 466 | (push tmpl lambdas)))) | ||
| 467 | |||
| 468 | ;; Return collected lambda. For :after methods, return in current | ||
| 469 | ;; order (most general class last); Otherwise, reverse order. | ||
| 470 | (if (eq key eieio--method-after) | ||
| 471 | lambdas | ||
| 472 | (nreverse lambdas)))) | ||
| 473 | |||
| 474 | |||
| 475 | ;;; | ||
| 476 | ;; eieio-method-tree : eieio--mt- | ||
| 477 | ;; | ||
| 478 | ;; Stored as eieio-method-tree in property list of a generic method | ||
| 479 | ;; | ||
| 480 | ;; (eieio-method-tree . [BEFORE PRIMARY AFTER | ||
| 481 | ;; genericBEFORE genericPRIMARY genericAFTER]) | ||
| 482 | ;; and | ||
| 483 | ;; (eieio-method-hashtable . [BEFORE PRIMARY AFTER | ||
| 484 | ;; genericBEFORE genericPRIMARY genericAFTER]) | ||
| 485 | ;; where the association is a vector. | ||
| 486 | ;; (aref 0 -- all static methods. | ||
| 487 | ;; (aref 1 -- all methods classified as :before | ||
| 488 | ;; (aref 2 -- all methods classified as :primary | ||
| 489 | ;; (aref 3 -- all methods classified as :after | ||
| 490 | ;; (aref 4 -- a generic classified as :before | ||
| 491 | ;; (aref 5 -- a generic classified as :primary | ||
| 492 | ;; (aref 6 -- a generic classified as :after | ||
| 493 | ;; | ||
| 494 | (defvar eieio--mt--optimizing-hashtable nil | ||
| 495 | "While mapping atoms, this contain the hashtable being optimized.") | ||
| 496 | |||
| 497 | (defun eieio--mt-install (method-name) | ||
| 498 | "Install the method tree, and hashtable onto METHOD-NAME. | ||
| 499 | Do not do the work if they already exist." | ||
| 500 | (unless (and (get method-name 'eieio-method-tree) | ||
| 501 | (get method-name 'eieio-method-hashtable)) | ||
| 502 | (put method-name 'eieio-method-tree | ||
| 503 | (make-vector eieio--method-num-slots nil)) | ||
| 504 | (let ((emto (put method-name 'eieio-method-hashtable | ||
| 505 | (make-vector eieio--method-num-slots nil)))) | ||
| 506 | (aset emto 0 (make-hash-table :test 'eq)) | ||
| 507 | (aset emto 1 (make-hash-table :test 'eq)) | ||
| 508 | (aset emto 2 (make-hash-table :test 'eq)) | ||
| 509 | (aset emto 3 (make-hash-table :test 'eq))))) | ||
| 510 | |||
| 511 | (defun eieio--mt-add (method-name method key class) | ||
| 512 | "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS. | ||
| 513 | METHOD-NAME is the name created by a call to `defgeneric'. | ||
| 514 | METHOD are the forms for a given implementation. | ||
| 515 | KEY is an integer (see comment in eieio.el near this function) which | ||
| 516 | is associated with the :static :before :primary and :after tags. | ||
| 517 | It also indicates if CLASS is defined or not. | ||
| 518 | CLASS is the class this method is associated with." | ||
| 519 | (if (or (> key eieio--method-num-slots) (< key 0)) | ||
| 520 | (error "eieio--mt-add: method key error!")) | ||
| 521 | (let ((emtv (get method-name 'eieio-method-tree)) | ||
| 522 | (emto (get method-name 'eieio-method-hashtable))) | ||
| 523 | ;; Make sure the method tables are available. | ||
| 524 | (unless (and emtv emto) | ||
| 525 | (error "Programmer error: eieio--mt-add")) | ||
| 526 | ;; only add new cells on if it doesn't already exist! | ||
| 527 | (if (assq class (aref emtv key)) | ||
| 528 | (setcdr (assq class (aref emtv key)) method) | ||
| 529 | (aset emtv key (cons (cons class method) (aref emtv key)))) | ||
| 530 | ;; Add function definition into newly created symbol, and store | ||
| 531 | ;; said symbol in the correct hashtable, otherwise use the | ||
| 532 | ;; other array to keep this stuff. | ||
| 533 | (if (< key eieio--method-num-lists) | ||
| 534 | (puthash (eieio--class-v class) (list method) (aref emto key))) | ||
| 535 | ;; Save the defmethod file location in a symbol property. | ||
| 536 | (let ((fname (if load-in-progress | ||
| 537 | load-file-name | ||
| 538 | buffer-file-name))) | ||
| 539 | (when fname | ||
| 540 | (when (string-match "\\.elc\\'" fname) | ||
| 541 | (setq fname (substring fname 0 (1- (length fname))))) | ||
| 542 | (cl-pushnew (list class fname) (get method-name 'method-locations) | ||
| 543 | :test 'equal))) | ||
| 544 | ;; Now optimize the entire hashtable. | ||
| 545 | (if (< key eieio--method-num-lists) | ||
| 546 | (let ((eieio--mt--optimizing-hashtable (aref emto key))) | ||
| 547 | ;; @todo - Is this overkill? Should we just clear the symbol? | ||
| 548 | (maphash #'eieio--mt--sym-optimize eieio--mt--optimizing-hashtable))) | ||
| 549 | )) | ||
| 550 | |||
| 551 | (defun eieio--mt-next (class) | ||
| 552 | "Return the next parent class for CLASS. | ||
| 553 | If CLASS is a superclass, return variable `eieio-default-superclass'. | ||
| 554 | If CLASS is variable `eieio-default-superclass' then return nil. | ||
| 555 | This is different from function `class-parent' as class parent returns | ||
| 556 | nil for superclasses. This function performs no type checking!" | ||
| 557 | ;; No type-checking because all calls are made from functions which | ||
| 558 | ;; are safe and do checking for us. | ||
| 559 | (or (eieio--class-parent (eieio--class-v class)) | ||
| 560 | (if (eq class 'eieio-default-superclass) | ||
| 561 | nil | ||
| 562 | '(eieio-default-superclass)))) | ||
| 563 | |||
| 564 | (defun eieio--mt--sym-optimize (class s) | ||
| 565 | "Find the next class above S which has a function body for the optimizer." | ||
| 566 | ;; Set the value to nil in case there is no nearest cell. | ||
| 567 | (setcdr s nil) | ||
| 568 | ;; Find the nearest cell that has a function body. If we find one, | ||
| 569 | ;; we replace the nil from above. | ||
| 570 | (catch 'done | ||
| 571 | (dolist (ancestor | ||
| 572 | (cl-rest (eieio--class-precedence-list class))) | ||
| 573 | (let ((ov (gethash ancestor eieio--mt--optimizing-hashtable))) | ||
| 574 | (when (car ov) | ||
| 575 | (setcdr s ancestor) ;; store ov as our next symbol | ||
| 576 | (throw 'done ancestor)))))) | ||
| 577 | |||
| 578 | (defun eieio--generic-form (method key class) | ||
| 579 | "Return the lambda form belonging to METHOD using KEY based upon CLASS. | ||
| 580 | If CLASS is not a class then use `generic' instead. If class has | ||
| 581 | no form, but has a parent class, then trace to that parent class. | ||
| 582 | The first time a form is requested from a symbol, an optimized path | ||
| 583 | is memorized for faster future use." | ||
| 584 | (if (symbolp class) (setq class (eieio--class-v class))) | ||
| 585 | (let ((emto (aref (get method 'eieio-method-hashtable) | ||
| 586 | (if class key (eieio--specialized-key-to-generic-key key))))) | ||
| 587 | (if (eieio--class-p class) | ||
| 588 | ;; 1) find our symbol | ||
| 589 | (let ((cs (gethash class emto))) | ||
| 590 | (unless cs | ||
| 591 | ;; 2) If there isn't one, then make one. | ||
| 592 | ;; This can be slow since it only occurs once | ||
| 593 | (puthash class (setq cs (list nil)) emto) | ||
| 594 | ;; 2.1) Cache its nearest neighbor with a quick optimize | ||
| 595 | ;; which should only occur once for this call ever | ||
| 596 | (let ((eieio--mt--optimizing-hashtable emto)) | ||
| 597 | (eieio--mt--sym-optimize class cs))) | ||
| 598 | ;; 3) If it's bound return this one. | ||
| 599 | (if (car cs) | ||
| 600 | (cons (car cs) class) | ||
| 601 | ;; 4) If it's not bound then this variable knows something | ||
| 602 | (if (cdr cs) | ||
| 603 | (progn | ||
| 604 | ;; 4.1) This symbol holds the next class in its value | ||
| 605 | (setq class (cdr cs) | ||
| 606 | cs (gethash class emto)) | ||
| 607 | ;; 4.2) The optimizer should always have chosen a | ||
| 608 | ;; function-symbol | ||
| 609 | ;;(if (car cs) | ||
| 610 | (cons (car cs) class) | ||
| 611 | ;;(error "EIEIO optimizer: erratic data loss!")) | ||
| 612 | ) | ||
| 613 | ;; There never will be a funcall... | ||
| 614 | nil))) | ||
| 615 | ;; for a generic call, what is a list, is the function body we want. | ||
| 616 | (let ((emtl (aref (get method 'eieio-method-tree) | ||
| 617 | (if class key (eieio--specialized-key-to-generic-key key))))) | ||
| 618 | (if emtl | ||
| 619 | ;; The car of EMTL is supposed to be a class, which in this | ||
| 620 | ;; case is nil, so skip it. | ||
| 621 | (cons (cdr (car emtl)) nil) | ||
| 622 | nil))))) | ||
| 623 | |||
| 624 | |||
| 625 | (define-error 'no-method-definition "No method definition") | ||
| 626 | (define-error 'no-next-method "No next method") | ||
| 627 | |||
| 628 | ;;; CLOS methods and generics | ||
| 629 | ;; | ||
| 630 | (defmacro defgeneric (method _args &optional doc-string) | ||
| 631 | "Create a generic function METHOD. | ||
| 632 | DOC-STRING is the base documentation for this class. A generic | ||
| 633 | function has no body, as its purpose is to decide which method body | ||
| 634 | is appropriate to use. Uses `defmethod' to create methods, and calls | ||
| 635 | `defgeneric' for you. With this implementation the ARGS are | ||
| 636 | currently ignored. You can use `defgeneric' to apply specialized | ||
| 637 | top level documentation to a method." | ||
| 638 | (declare (doc-string 3)) | ||
| 639 | `(eieio--defalias ',method | ||
| 640 | (eieio--defgeneric-init-form ',method ,doc-string))) | ||
| 641 | |||
| 642 | (defmacro defmethod (method &rest args) | ||
| 643 | "Create a new METHOD through `defgeneric' with ARGS. | ||
| 644 | |||
| 645 | The optional second argument KEY is a specifier that | ||
| 646 | modifies how the method is called, including: | ||
| 647 | :before - Method will be called before the :primary | ||
| 648 | :primary - The default if not specified | ||
| 649 | :after - Method will be called after the :primary | ||
| 650 | :static - First arg could be an object or class | ||
| 651 | The next argument is the ARGLIST. The ARGLIST specifies the arguments | ||
| 652 | to the method as with `defun'. The first argument can have a type | ||
| 653 | specifier, such as: | ||
| 654 | ((VARNAME CLASS) ARG2 ...) | ||
| 655 | where VARNAME is the name of the local variable for the method being | ||
| 656 | created. The CLASS is a class symbol for a class made with `defclass'. | ||
| 657 | A DOCSTRING comes after the ARGLIST, and is optional. | ||
| 658 | All the rest of the args are the BODY of the method. A method will | ||
| 659 | return the value of the last form in the BODY. | ||
| 660 | |||
| 661 | Summary: | ||
| 662 | |||
| 663 | (defmethod mymethod [:before | :primary | :after | :static] | ||
| 664 | ((typearg class-name) arg2 &optional opt &rest rest) | ||
| 665 | \"doc-string\" | ||
| 666 | body)" | ||
| 667 | (declare (doc-string 3) | ||
| 668 | (debug | ||
| 669 | (&define ; this means we are defining something | ||
| 670 | [&or name ("setf" :name setf name)] | ||
| 671 | ;; ^^ This is the methods symbol | ||
| 672 | [ &optional symbolp ] ; this is key :before etc | ||
| 673 | list ; arguments | ||
| 674 | [ &optional stringp ] ; documentation string | ||
| 675 | def-body ; part to be debugged | ||
| 676 | ))) | ||
| 677 | (let* ((key (if (keywordp (car args)) (pop args))) | ||
| 678 | (params (car args)) | ||
| 679 | (arg1 (car params)) | ||
| 680 | (fargs (if (consp arg1) | ||
| 681 | (cons (car arg1) (cdr params)) | ||
| 682 | params)) | ||
| 683 | (class (if (consp arg1) (nth 1 arg1))) | ||
| 684 | (code `(lambda ,fargs ,@(cdr args)))) | ||
| 685 | `(progn | ||
| 686 | ;; Make sure there is a generic and the byte-compiler sees it. | ||
| 687 | (defgeneric ,method ,args | ||
| 688 | ,(or (documentation code) | ||
| 689 | (format "Generically created method `%s'." method))) | ||
| 690 | (eieio--defmethod ',method ',key ',class #',code)))) | ||
| 691 | |||
| 692 | |||
| 693 | |||
| 694 | ;;; | ||
| 695 | ;; Method Calling Functions | ||
| 696 | |||
| 697 | (defun next-method-p () | ||
| 698 | "Return non-nil if there is a next method. | ||
| 699 | Returns a list of lambda expressions which is the `next-method' | ||
| 700 | order." | ||
| 701 | eieio--generic-call-next-method-list) | ||
| 702 | |||
| 703 | (defun call-next-method (&rest replacement-args) | ||
| 704 | "Call the superclass method from a subclass method. | ||
| 705 | The superclass method is specified in the current method list, | ||
| 706 | and is called the next method. | ||
| 707 | |||
| 708 | If REPLACEMENT-ARGS is non-nil, then use them instead of | ||
| 709 | `eieio--generic-call-arglst'. The generic arg list are the | ||
| 710 | arguments passed in at the top level. | ||
| 711 | |||
| 712 | Use `next-method-p' to find out if there is a next method to call." | ||
| 713 | (if (not (eieio--scoped-class)) | ||
| 714 | (error "`call-next-method' not called within a class specific method")) | ||
| 715 | (if (and (/= eieio--generic-call-key eieio--method-primary) | ||
| 716 | (/= eieio--generic-call-key eieio--method-static)) | ||
| 717 | (error "Cannot `call-next-method' except in :primary or :static methods") | ||
| 718 | ) | ||
| 719 | (let ((newargs (or replacement-args eieio--generic-call-arglst)) | ||
| 720 | (next (car eieio--generic-call-next-method-list)) | ||
| 721 | ) | ||
| 722 | (if (not (and next (car next))) | ||
| 723 | (apply #'no-next-method newargs) | ||
| 724 | (let* ((eieio--generic-call-next-method-list | ||
| 725 | (cdr eieio--generic-call-next-method-list)) | ||
| 726 | (eieio--generic-call-arglst newargs) | ||
| 727 | (fcn (car next)) | ||
| 728 | ) | ||
| 729 | (eieio--with-scoped-class (cdr next) | ||
| 730 | (apply fcn newargs)) )))) | ||
| 731 | |||
| 732 | (defgeneric no-applicable-method (object method &rest args) | ||
| 733 | "Called if there are no implementations for OBJECT in METHOD.") | ||
| 734 | |||
| 735 | (defmethod no-applicable-method (object method &rest _args) | ||
| 736 | "Called if there are no implementations for OBJECT in METHOD. | ||
| 737 | OBJECT is the object which has no method implementation. | ||
| 738 | ARGS are the arguments that were passed to METHOD. | ||
| 739 | |||
| 740 | Implement this for a class to block this signal. The return | ||
| 741 | value becomes the return value of the original method call." | ||
| 742 | (signal 'no-method-definition (list method object))) | ||
| 743 | |||
| 744 | (defgeneric no-next-method (object &rest args) | ||
| 745 | "Called from `call-next-method' when no additional methods are available.") | ||
| 746 | |||
| 747 | (defmethod no-next-method (object &rest args) | ||
| 748 | "Called from `call-next-method' when no additional methods are available. | ||
| 749 | OBJECT is othe object being called on `call-next-method'. | ||
| 750 | ARGS are the arguments it is called by. | ||
| 751 | This method signals `no-next-method' by default. Override this | ||
| 752 | method to not throw an error, and its return value becomes the | ||
| 753 | return value of `call-next-method'." | ||
| 754 | (signal 'no-next-method (list object args))) | ||
| 755 | |||
| 756 | (add-hook 'help-fns-describe-function-functions 'eieio--help-generic) | ||
| 757 | (defun eieio--help-generic (generic) | ||
| 758 | "Describe GENERIC if it is a generic function." | ||
| 759 | (when (and (symbolp generic) (generic-p generic)) | ||
| 760 | (save-excursion | ||
| 761 | (goto-char (point-min)) | ||
| 762 | (when (re-search-forward " in `.+'.$" nil t) | ||
| 763 | (replace-match "."))) | ||
| 764 | (save-excursion | ||
| 765 | (insert "\n\nThis is a generic function" | ||
| 766 | (cond | ||
| 767 | ((and (eieio--generic-primary-only-p generic) | ||
| 768 | (eieio--generic-primary-only-one-p generic)) | ||
| 769 | " with only one primary method") | ||
| 770 | ((eieio--generic-primary-only-p generic) | ||
| 771 | " with only primary methods") | ||
| 772 | (t "")) | ||
| 773 | ".\n\n") | ||
| 774 | (insert (propertize "Implementations:\n\n" 'face 'bold)) | ||
| 775 | (let ((i 4) | ||
| 776 | (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] )) | ||
| 777 | ;; Loop over fanciful generics | ||
| 778 | (while (< i 7) | ||
| 779 | (let ((gm (aref (get generic 'eieio-method-tree) i))) | ||
| 780 | (when gm | ||
| 781 | (insert "Generic " | ||
| 782 | (aref prefix (- i 3)) | ||
| 783 | "\n" | ||
| 784 | (or (nth 2 gm) "Undocumented") | ||
| 785 | "\n\n"))) | ||
| 786 | (setq i (1+ i))) | ||
| 787 | (setq i 0) | ||
| 788 | ;; Loop over defined class-specific methods | ||
| 789 | (while (< i 4) | ||
| 790 | (let* ((gm (reverse (aref (get generic 'eieio-method-tree) i))) | ||
| 791 | cname location) | ||
| 792 | (while gm | ||
| 793 | (setq cname (caar gm)) | ||
| 794 | (insert "`") | ||
| 795 | (help-insert-xref-button (symbol-name cname) | ||
| 796 | 'help-variable cname) | ||
| 797 | (insert "' " (aref prefix i) " ") | ||
| 798 | ;; argument list | ||
| 799 | (let* ((func (cdr (car gm))) | ||
| 800 | (arglst (help-function-arglist func))) | ||
| 801 | (prin1 arglst (current-buffer))) | ||
| 802 | (insert "\n" | ||
| 803 | (or (documentation (cdr (car gm))) | ||
| 804 | "Undocumented")) | ||
| 805 | ;; Print file location if available | ||
| 806 | (when (and (setq location (get generic 'method-locations)) | ||
| 807 | (setq location (assoc cname location))) | ||
| 808 | (setq location (cadr location)) | ||
| 809 | (insert "\n\nDefined in `") | ||
| 810 | (help-insert-xref-button | ||
| 811 | (file-name-nondirectory location) | ||
| 812 | 'eieio-method-def cname generic location) | ||
| 813 | (insert "'\n")) | ||
| 814 | (setq gm (cdr gm)) | ||
| 815 | (insert "\n"))) | ||
| 816 | (setq i (1+ i))))))) | ||
| 817 | |||
| 818 | ;;; Obsolete backward compatibility functions. | ||
| 819 | ;; Needed to run byte-code compiled with the EIEIO of Emacs-23. | ||
| 820 | |||
| 821 | (defun eieio-defmethod (method args) | ||
| 822 | "Obsolete work part of an old version of the `defmethod' macro." | ||
| 823 | (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) | ||
| 824 | ;; find optional keys | ||
| 825 | (setq key | ||
| 826 | (cond ((memq (car args) '(:BEFORE :before)) | ||
| 827 | (setq args (cdr args)) | ||
| 828 | eieio--method-before) | ||
| 829 | ((memq (car args) '(:AFTER :after)) | ||
| 830 | (setq args (cdr args)) | ||
| 831 | eieio--method-after) | ||
| 832 | ((memq (car args) '(:STATIC :static)) | ||
| 833 | (setq args (cdr args)) | ||
| 834 | eieio--method-static) | ||
| 835 | ((memq (car args) '(:PRIMARY :primary)) | ||
| 836 | (setq args (cdr args)) | ||
| 837 | eieio--method-primary) | ||
| 838 | ;; Primary key. | ||
| 839 | (t eieio--method-primary))) | ||
| 840 | ;; Get body, and fix contents of args to be the arguments of the fn. | ||
| 841 | (setq body (cdr args) | ||
| 842 | args (car args)) | ||
| 843 | (setq loopa args) | ||
| 844 | ;; Create a fixed version of the arguments. | ||
| 845 | (while loopa | ||
| 846 | (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) | ||
| 847 | argfix)) | ||
| 848 | (setq loopa (cdr loopa))) | ||
| 849 | ;; Make sure there is a generic. | ||
| 850 | (eieio-defgeneric | ||
| 851 | method | ||
| 852 | (if (stringp (car body)) | ||
| 853 | (car body) (format "Generically created method `%s'." method))) | ||
| 854 | ;; create symbol for property to bind to. If the first arg is of | ||
| 855 | ;; the form (varname vartype) and `vartype' is a class, then | ||
| 856 | ;; that class will be the type symbol. If not, then it will fall | ||
| 857 | ;; under the type `primary' which is a non-specific calling of the | ||
| 858 | ;; function. | ||
| 859 | (setq firstarg (car args)) | ||
| 860 | (if (listp firstarg) | ||
| 861 | (progn | ||
| 862 | (setq argclass (nth 1 firstarg)) | ||
| 863 | (if (not (class-p argclass)) | ||
| 864 | (error "Unknown class type %s in method parameters" | ||
| 865 | (nth 1 firstarg)))) | ||
| 866 | ;; Generics are higher. | ||
| 867 | (setq key (eieio--specialized-key-to-generic-key key))) | ||
| 868 | ;; Put this lambda into the symbol so we can find it. | ||
| 869 | (if (byte-code-function-p (car-safe body)) | ||
| 870 | (eieio--mt-add method (car-safe body) key argclass) | ||
| 871 | (eieio--mt-add method (append (list 'lambda (reverse argfix)) body) | ||
| 872 | key argclass)) | ||
| 873 | ) | ||
| 874 | |||
| 875 | (eieio--method-optimize-primary method) | ||
| 876 | |||
| 877 | method) | ||
| 878 | (make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1") | ||
| 879 | |||
| 880 | (defun eieio-defgeneric (method doc-string) | ||
| 881 | "Obsolete work part of an old version of the `defgeneric' macro." | ||
| 882 | (if (and (fboundp method) (not (generic-p method)) | ||
| 883 | (or (byte-code-function-p (symbol-function method)) | ||
| 884 | (not (eq 'autoload (car (symbol-function method))))) | ||
| 885 | ) | ||
| 886 | (error "You cannot create a generic/method over an existing symbol: %s" | ||
| 887 | method)) | ||
| 888 | ;; Don't do this over and over. | ||
| 889 | (unless (fboundp 'method) | ||
| 890 | ;; This defun tells emacs where the first definition of this | ||
| 891 | ;; method is defined. | ||
| 892 | `(defun ,method nil) | ||
| 893 | ;; Make sure the method tables are installed. | ||
| 894 | (eieio--mt-install method) | ||
| 895 | ;; Apply the actual body of this function. | ||
| 896 | (put method 'function-documentation doc-string) | ||
| 897 | (fset method (eieio--defgeneric-form method)) | ||
| 898 | ;; Return the method | ||
| 899 | 'method)) | ||
| 900 | (make-obsolete 'eieio-defgeneric nil "24.1") | ||
| 901 | |||
| 902 | (provide 'eieio-generic) | ||
| 903 | |||
| 904 | ;;; eieio-generic.el ends here | ||
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 4896a4cdead..60bbd503adf 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) | 1 | ;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996, 1998-2003, 2005, 2008-2014 Free Software | 3 | ;; Copyright (C) 1996, 1998-2003, 2005, 2008-2015 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | 6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
| @@ -311,69 +311,6 @@ are not abstract." | |||
| 311 | (eieio-help-class ctr)) | 311 | (eieio-help-class ctr)) |
| 312 | )))) | 312 | )))) |
| 313 | 313 | ||
| 314 | |||
| 315 | ;;;###autoload | ||
| 316 | (defun eieio-help-generic (generic) | ||
| 317 | "Describe GENERIC if it is a generic function." | ||
| 318 | (when (and (symbolp generic) (generic-p generic)) | ||
| 319 | (save-excursion | ||
| 320 | (goto-char (point-min)) | ||
| 321 | (when (re-search-forward " in `.+'.$" nil t) | ||
| 322 | (replace-match "."))) | ||
| 323 | (save-excursion | ||
| 324 | (insert "\n\nThis is a generic function" | ||
| 325 | (cond | ||
| 326 | ((and (generic-primary-only-p generic) | ||
| 327 | (generic-primary-only-one-p generic)) | ||
| 328 | " with only one primary method") | ||
| 329 | ((generic-primary-only-p generic) | ||
| 330 | " with only primary methods") | ||
| 331 | (t "")) | ||
| 332 | ".\n\n") | ||
| 333 | (insert (propertize "Implementations:\n\n" 'face 'bold)) | ||
| 334 | (let ((i 4) | ||
| 335 | (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] )) | ||
| 336 | ;; Loop over fanciful generics | ||
| 337 | (while (< i 7) | ||
| 338 | (let ((gm (aref (get generic 'eieio-method-tree) i))) | ||
| 339 | (when gm | ||
| 340 | (insert "Generic " | ||
| 341 | (aref prefix (- i 3)) | ||
| 342 | "\n" | ||
| 343 | (or (nth 2 gm) "Undocumented") | ||
| 344 | "\n\n"))) | ||
| 345 | (setq i (1+ i))) | ||
| 346 | (setq i 0) | ||
| 347 | ;; Loop over defined class-specific methods | ||
| 348 | (while (< i 4) | ||
| 349 | (let* ((gm (reverse (aref (get generic 'eieio-method-tree) i))) | ||
| 350 | cname location) | ||
| 351 | (while gm | ||
| 352 | (setq cname (caar gm)) | ||
| 353 | (insert "`") | ||
| 354 | (help-insert-xref-button (symbol-name cname) | ||
| 355 | 'help-variable cname) | ||
| 356 | (insert "' " (aref prefix i) " ") | ||
| 357 | ;; argument list | ||
| 358 | (let* ((func (cdr (car gm))) | ||
| 359 | (arglst (help-function-arglist func))) | ||
| 360 | (prin1 arglst (current-buffer))) | ||
| 361 | (insert "\n" | ||
| 362 | (or (documentation (cdr (car gm))) | ||
| 363 | "Undocumented")) | ||
| 364 | ;; Print file location if available | ||
| 365 | (when (and (setq location (get generic 'method-locations)) | ||
| 366 | (setq location (assoc cname location))) | ||
| 367 | (setq location (cadr location)) | ||
| 368 | (insert "\n\nDefined in `") | ||
| 369 | (help-insert-xref-button | ||
| 370 | (file-name-nondirectory location) | ||
| 371 | 'eieio-method-def cname generic location) | ||
| 372 | (insert "'\n")) | ||
| 373 | (setq gm (cdr gm)) | ||
| 374 | (insert "\n"))) | ||
| 375 | (setq i (1+ i))))))) | ||
| 376 | |||
| 377 | (defun eieio-all-generic-functions (&optional class) | 314 | (defun eieio-all-generic-functions (&optional class) |
| 378 | "Return a list of all generic functions. | 315 | "Return a list of all generic functions. |
| 379 | Optional CLASS argument returns only those functions that contain | 316 | Optional CLASS argument returns only those functions that contain |
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index fdeba5e55f0..bf51986b133 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el | |||
| @@ -53,6 +53,7 @@ | |||
| 53 | (message eieio-version)) | 53 | (message eieio-version)) |
| 54 | 54 | ||
| 55 | (require 'eieio-core) | 55 | (require 'eieio-core) |
| 56 | (require 'eieio-generic) | ||
| 56 | 57 | ||
| 57 | 58 | ||
| 58 | ;;; Defining a new class | 59 | ;;; Defining a new class |
| @@ -147,70 +148,6 @@ a string." | |||
| 147 | (apply (class-constructor class) initargs)) | 148 | (apply (class-constructor class) initargs)) |
| 148 | 149 | ||
| 149 | 150 | ||
| 150 | ;;; CLOS methods and generics | ||
| 151 | ;; | ||
| 152 | (defmacro defgeneric (method _args &optional doc-string) | ||
| 153 | "Create a generic function METHOD. | ||
| 154 | DOC-STRING is the base documentation for this class. A generic | ||
| 155 | function has no body, as its purpose is to decide which method body | ||
| 156 | is appropriate to use. Uses `defmethod' to create methods, and calls | ||
| 157 | `defgeneric' for you. With this implementation the ARGS are | ||
| 158 | currently ignored. You can use `defgeneric' to apply specialized | ||
| 159 | top level documentation to a method." | ||
| 160 | (declare (doc-string 3)) | ||
| 161 | `(eieio--defalias ',method | ||
| 162 | (eieio--defgeneric-init-form ',method ,doc-string))) | ||
| 163 | |||
| 164 | (defmacro defmethod (method &rest args) | ||
| 165 | "Create a new METHOD through `defgeneric' with ARGS. | ||
| 166 | |||
| 167 | The optional second argument KEY is a specifier that | ||
| 168 | modifies how the method is called, including: | ||
| 169 | :before - Method will be called before the :primary | ||
| 170 | :primary - The default if not specified | ||
| 171 | :after - Method will be called after the :primary | ||
| 172 | :static - First arg could be an object or class | ||
| 173 | The next argument is the ARGLIST. The ARGLIST specifies the arguments | ||
| 174 | to the method as with `defun'. The first argument can have a type | ||
| 175 | specifier, such as: | ||
| 176 | ((VARNAME CLASS) ARG2 ...) | ||
| 177 | where VARNAME is the name of the local variable for the method being | ||
| 178 | created. The CLASS is a class symbol for a class made with `defclass'. | ||
| 179 | A DOCSTRING comes after the ARGLIST, and is optional. | ||
| 180 | All the rest of the args are the BODY of the method. A method will | ||
| 181 | return the value of the last form in the BODY. | ||
| 182 | |||
| 183 | Summary: | ||
| 184 | |||
| 185 | (defmethod mymethod [:before | :primary | :after | :static] | ||
| 186 | ((typearg class-name) arg2 &optional opt &rest rest) | ||
| 187 | \"doc-string\" | ||
| 188 | body)" | ||
| 189 | (declare (doc-string 3) | ||
| 190 | (debug | ||
| 191 | (&define ; this means we are defining something | ||
| 192 | [&or name ("setf" :name setf name)] | ||
| 193 | ;; ^^ This is the methods symbol | ||
| 194 | [ &optional symbolp ] ; this is key :before etc | ||
| 195 | list ; arguments | ||
| 196 | [ &optional stringp ] ; documentation string | ||
| 197 | def-body ; part to be debugged | ||
| 198 | ))) | ||
| 199 | (let* ((key (if (keywordp (car args)) (pop args))) | ||
| 200 | (params (car args)) | ||
| 201 | (arg1 (car params)) | ||
| 202 | (fargs (if (consp arg1) | ||
| 203 | (cons (car arg1) (cdr params)) | ||
| 204 | params)) | ||
| 205 | (class (if (consp arg1) (nth 1 arg1))) | ||
| 206 | (code `(lambda ,fargs ,@(cdr args)))) | ||
| 207 | `(progn | ||
| 208 | ;; Make sure there is a generic and the byte-compiler sees it. | ||
| 209 | (defgeneric ,method ,args | ||
| 210 | ,(or (documentation code) | ||
| 211 | (format "Generically created method `%s'." method))) | ||
| 212 | (eieio--defmethod ',method ',key ',class #',code)))) | ||
| 213 | |||
| 214 | ;;; Get/Set slots in an object. | 151 | ;;; Get/Set slots in an object. |
| 215 | ;; | 152 | ;; |
| 216 | (defmacro oref (obj slot) | 153 | (defmacro oref (obj slot) |
| @@ -519,44 +456,6 @@ If SLOT is unbound, do nothing." | |||
| 519 | nil | 456 | nil |
| 520 | (eieio-oset object slot (delete item (eieio-oref object slot))))) | 457 | (eieio-oset object slot (delete item (eieio-oref object slot))))) |
| 521 | 458 | ||
| 522 | ;;; | ||
| 523 | ;; Method Calling Functions | ||
| 524 | |||
| 525 | (defun next-method-p () | ||
| 526 | "Return non-nil if there is a next method. | ||
| 527 | Returns a list of lambda expressions which is the `next-method' | ||
| 528 | order." | ||
| 529 | eieio-generic-call-next-method-list) | ||
| 530 | |||
| 531 | (defun call-next-method (&rest replacement-args) | ||
| 532 | "Call the superclass method from a subclass method. | ||
| 533 | The superclass method is specified in the current method list, | ||
| 534 | and is called the next method. | ||
| 535 | |||
| 536 | If REPLACEMENT-ARGS is non-nil, then use them instead of | ||
| 537 | `eieio-generic-call-arglst'. The generic arg list are the | ||
| 538 | arguments passed in at the top level. | ||
| 539 | |||
| 540 | Use `next-method-p' to find out if there is a next method to call." | ||
| 541 | (if (not (eieio--scoped-class)) | ||
| 542 | (error "`call-next-method' not called within a class specific method")) | ||
| 543 | (if (and (/= eieio-generic-call-key eieio--method-primary) | ||
| 544 | (/= eieio-generic-call-key eieio--method-static)) | ||
| 545 | (error "Cannot `call-next-method' except in :primary or :static methods") | ||
| 546 | ) | ||
| 547 | (let ((newargs (or replacement-args eieio-generic-call-arglst)) | ||
| 548 | (next (car eieio-generic-call-next-method-list)) | ||
| 549 | ) | ||
| 550 | (if (not (and next (car next))) | ||
| 551 | (apply #'no-next-method newargs) | ||
| 552 | (let* ((eieio-generic-call-next-method-list | ||
| 553 | (cdr eieio-generic-call-next-method-list)) | ||
| 554 | (eieio-generic-call-arglst newargs) | ||
| 555 | (fcn (car next)) | ||
| 556 | ) | ||
| 557 | (eieio--with-scoped-class (cdr next) | ||
| 558 | (apply fcn newargs)) )))) | ||
| 559 | |||
| 560 | ;;; Here are some CLOS items that need the CL package | 459 | ;;; Here are some CLOS items that need the CL package |
| 561 | ;; | 460 | ;; |
| 562 | 461 | ||
| @@ -686,34 +585,6 @@ EIEIO can only dispatch on the first argument, so the first two are swapped." | |||
| 686 | (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object) | 585 | (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object) |
| 687 | slot-name fn))) | 586 | slot-name fn))) |
| 688 | 587 | ||
| 689 | (defgeneric no-applicable-method (object method &rest args) | ||
| 690 | "Called if there are no implementations for OBJECT in METHOD.") | ||
| 691 | |||
| 692 | (defmethod no-applicable-method ((object eieio-default-superclass) | ||
| 693 | method &rest _args) | ||
| 694 | "Called if there are no implementations for OBJECT in METHOD. | ||
| 695 | OBJECT is the object which has no method implementation. | ||
| 696 | ARGS are the arguments that were passed to METHOD. | ||
| 697 | |||
| 698 | Implement this for a class to block this signal. The return | ||
| 699 | value becomes the return value of the original method call." | ||
| 700 | (signal 'no-method-definition (list method (eieio-object-name object))) | ||
| 701 | ) | ||
| 702 | |||
| 703 | (defgeneric no-next-method (object &rest args) | ||
| 704 | "Called from `call-next-method' when no additional methods are available.") | ||
| 705 | |||
| 706 | (defmethod no-next-method ((object eieio-default-superclass) | ||
| 707 | &rest args) | ||
| 708 | "Called from `call-next-method' when no additional methods are available. | ||
| 709 | OBJECT is othe object being called on `call-next-method'. | ||
| 710 | ARGS are the arguments it is called by. | ||
| 711 | This method signals `no-next-method' by default. Override this | ||
| 712 | method to not throw an error, and its return value becomes the | ||
| 713 | return value of `call-next-method'." | ||
| 714 | (signal 'no-next-method (list (eieio-object-name object) args)) | ||
| 715 | ) | ||
| 716 | |||
| 717 | (defgeneric clone (obj &rest params) | 588 | (defgeneric clone (obj &rest params) |
| 718 | "Make a copy of OBJ, and then supply PARAMS. | 589 | "Make a copy of OBJ, and then supply PARAMS. |
| 719 | PARAMS is a parameter list of the same form used by `initialize-instance'. | 590 | PARAMS is a parameter list of the same form used by `initialize-instance'. |
| @@ -865,7 +736,6 @@ of `eq'." | |||
| 865 | (error "EIEIO: `change-class' is unimplemented")) | 736 | (error "EIEIO: `change-class' is unimplemented")) |
| 866 | 737 | ||
| 867 | ;; Hook ourselves into help system for describing classes and methods. | 738 | ;; Hook ourselves into help system for describing classes and methods. |
| 868 | (add-hook 'help-fns-describe-function-functions 'eieio-help-generic) | ||
| 869 | (add-hook 'help-fns-describe-function-functions 'eieio-help-constructor) | 739 | (add-hook 'help-fns-describe-function-functions 'eieio-help-constructor) |
| 870 | 740 | ||
| 871 | ;;; Interfacing with edebug | 741 | ;;; Interfacing with edebug |
| @@ -903,7 +773,7 @@ Optional argument GROUP is the sub-group of slots to display. | |||
| 903 | 773 | ||
| 904 | ;;;*** | 774 | ;;;*** |
| 905 | 775 | ||
| 906 | ;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6377e022e85d377b399f44c98b4eab4a") | 776 | ;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "7267115a161243e1e6ea75f2d25c8ebc") |
| 907 | ;;; Generated autoloads from eieio-opt.el | 777 | ;;; Generated autoloads from eieio-opt.el |
| 908 | 778 | ||
| 909 | (autoload 'eieio-browse "eieio-opt" "\ | 779 | (autoload 'eieio-browse "eieio-opt" "\ |
| @@ -924,11 +794,6 @@ Describe CTR if it is a class constructor. | |||
| 924 | 794 | ||
| 925 | \(fn CTR)" nil nil) | 795 | \(fn CTR)" nil nil) |
| 926 | 796 | ||
| 927 | (autoload 'eieio-help-generic "eieio-opt" "\ | ||
| 928 | Describe GENERIC if it is a generic function. | ||
| 929 | |||
| 930 | \(fn GENERIC)" nil nil) | ||
| 931 | |||
| 932 | ;;;*** | 797 | ;;;*** |
| 933 | 798 | ||
| 934 | ;;; End of automatically extracted autoloads. | 799 | ;;; End of automatically extracted autoloads. |
diff --git a/test/ChangeLog b/test/ChangeLog index bb480280970..ca10ddaca68 100644 --- a/test/ChangeLog +++ b/test/ChangeLog | |||
| @@ -1,3 +1,11 @@ | |||
| 1 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use | ||
| 4 | <foo>-child-p. | ||
| 5 | |||
| 6 | * automated/eieio-test-methodinvoke.el (eieio-test-method-store): | ||
| 7 | Update reference to eieio--generic-call-key. | ||
| 8 | |||
| 1 | 2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> | 9 | 2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 10 | ||
| 3 | * automated/eieio-tests.el: Use cl-lib. Don't use <class> as a variable. | 11 | * automated/eieio-tests.el: Use cl-lib. Don't use <class> as a variable. |
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el index 7790c13327f..99e115a5b92 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/automated/eieio-test-methodinvoke.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; eieio-testsinvoke.el -- eieio tests for method invocation | 1 | ;;; eieio-testsinvoke.el -- eieio tests for method invocation |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2005, 2008, 2010, 2013-2014 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2005, 2008, 2010, 2013-2015 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | 5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
| 6 | 6 | ||
| @@ -60,7 +60,7 @@ | |||
| 60 | (defun eieio-test-method-store () | 60 | (defun eieio-test-method-store () |
| 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 | ;; FIXME: Don't depend on `eieio--scoped-class'! | 64 | ;; FIXME: Don't depend on `eieio--scoped-class'! |
| 65 | (c (list keysym (eieio--class-symbol (eieio--scoped-class))))) | 65 | (c (list keysym (eieio--class-symbol (eieio--scoped-class))))) |
| 66 | (push c eieio-test-method-order-list))) | 66 | (push c eieio-test-method-order-list))) |
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el index 13f4a5728ed..ac8aeb56a8a 100644 --- a/test/automated/eieio-tests.el +++ b/test/automated/eieio-tests.el | |||
| @@ -542,10 +542,10 @@ METHOD is the method that was attempting to be called." | |||
| 542 | (should (same-class-p eitest-a 'class-a)) | 542 | (should (same-class-p eitest-a 'class-a)) |
| 543 | (should (class-a-p eitest-a)) | 543 | (should (class-a-p eitest-a)) |
| 544 | (should (not (class-a-p eitest-ab))) | 544 | (should (not (class-a-p eitest-ab))) |
| 545 | (should (class-a-child-p eitest-a)) | 545 | (should (cl-typep eitest-a 'class-a)) |
| 546 | (should (class-a-child-p eitest-ab)) | 546 | (should (cl-typep eitest-ab 'class-a)) |
| 547 | (should (not (class-a-p "foo"))) | 547 | (should (not (class-a-p "foo"))) |
| 548 | (should (not (class-a-child-p "foo")))) | 548 | (should (not (cl-typep "foo" 'class-a)))) |
| 549 | 549 | ||
| 550 | (ert-deftest eieio-test-24-object-predicates () | 550 | (ert-deftest eieio-test-24-object-predicates () |
| 551 | (let ((listooa (list (class-ab) (class-a))) | 551 | (let ((listooa (list (class-ab) (class-a))) |