diff options
| author | Stefan Monnier | 2014-12-22 15:13:02 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2014-12-22 15:13:02 -0500 |
| commit | bcebc831bb9c1fd82b4693e6a091a4cf591dc3ec (patch) | |
| tree | 1fe8d3bf282f4cc676396aec6f4b02424a8b01f0 | |
| parent | b11d8924b565bd96939537b10a70bb3c26532bed (diff) | |
| download | emacs-bcebc831bb9c1fd82b4693e6a091a4cf591dc3ec.tar.gz emacs-bcebc831bb9c1fd82b4693e6a091a4cf591dc3ec.zip | |
* lisp/emacs-lisp/eieio*.el: Use hashtables rather than obarrays
* lisp/emacs-lisp/eieio-core.el (class): Rename field symbol-obarray to
symbol-hashtable. It contains a hashtable instead of an obarray.
(generic-p): Use symbol property `eieio-method-hashtable' instead of
`eieio-method-obarray'.
(generic-primary-only-p, generic-primary-only-one-p):
Slight optimization.
(eieio-defclass-autoload-map): Use a hashtable instead of an obarray.
(eieio-defclass-autoload, eieio-defclass): Adjust/simplify accordingly.
(eieio-class-un-autoload): Use autoload-do-load.
(eieio-defclass): Use dolist, cl-pushnew, cl-callf.
Use new cl-deftype-satisfies. Adjust to use of hashtables.
Don't hardcode the value of eieio--object-num-slots.
(eieio-defgeneric-form-primary-only-one): Remove `doc-string' arg.
Use a closure rather than a backquoted lambda.
(eieio--defmethod): Adjust call accordingly. Set doc-string via the
function-documentation property.
(eieio-slot-originating-class-p, eieio-slot-name-index)
(eieiomt--optimizing-hashtable, eieiomt-install, eieiomt-add)
(eieio-generic-form): Adjust to use of hashtables.
(eieiomt--sym-optimize): Rename from eieiomt-sym-optimize; take
additional class argument.
(eieio-generic-call-methodname): Remove, unused.
* lisp/emacs-lisp/eieio-custom.el: Use lexical-binding.
(eieio-object-value-to-abstract): Simplify.
* lisp/emacs-lisp/eieio-datadebug.el: Use lexical-binding.
* lisp/emacs-lisp/eieio-opt.el (eieio-build-class-list): Use cl-mapcan.
(eieio-build-class-alist): Use dolist.
(eieio-all-generic-functions): Adjust to use of hashtables.
* lisp/emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is
`eieio-default-superclass'.
* test/automated/eieio-test-methodinvoke.el (eieio-test-method-store):
Remove use of eieio-generic-call-methodname.
(eieio-test-method-order-list-3, eieio-test-method-order-list-6)
(eieio-test-method-order-list-7, eieio-test-method-order-list-8):
Adjust the expected result accordingly.
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p):
Prefer \' to $.
| -rw-r--r-- | lisp/ChangeLog | 48 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-base.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 498 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-custom.el | 24 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-datadebug.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-opt.el | 88 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 17 | ||||
| -rw-r--r-- | test/ChangeLog | 22 | ||||
| -rw-r--r-- | test/automated/eieio-test-methodinvoke.el | 45 |
9 files changed, 369 insertions, 387 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d8bb1c89f1f..c2f45845306 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,45 @@ | |||
| 1 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is | ||
| 4 | `eieio-default-superclass'. | ||
| 5 | |||
| 6 | * emacs-lisp/eieio-datadebug.el: Use lexical-binding. | ||
| 7 | |||
| 8 | * emacs-lisp/eieio-custom.el: Use lexical-binding. | ||
| 9 | (eieio-object-value-to-abstract): Simplify. | ||
| 10 | |||
| 11 | * emacs-lisp/eieio-opt.el (eieio-build-class-list): Use cl-mapcan. | ||
| 12 | (eieio-build-class-alist): Use dolist. | ||
| 13 | (eieio-all-generic-functions): Adjust to use of hashtables. | ||
| 14 | |||
| 15 | * emacs-lisp/eieio-core.el (class): Rename field symbol-obarray to | ||
| 16 | symbol-hashtable. It contains a hashtable instead of an obarray. | ||
| 17 | (generic-p): Use symbol property `eieio-method-hashtable' instead of | ||
| 18 | `eieio-method-obarray'. | ||
| 19 | (generic-primary-only-p, generic-primary-only-one-p): | ||
| 20 | Slight optimization. | ||
| 21 | (eieio-defclass-autoload-map): Use a hashtable instead of an obarray. | ||
| 22 | (eieio-defclass-autoload, eieio-defclass): Adjust/simplify accordingly. | ||
| 23 | (eieio-class-un-autoload): Use autoload-do-load. | ||
| 24 | (eieio-defclass): Use dolist, cl-pushnew, cl-callf. | ||
| 25 | Use new cl-deftype-satisfies. Adjust to use of hashtables. | ||
| 26 | Don't hardcode the value of eieio--object-num-slots. | ||
| 27 | (eieio-defgeneric-form-primary-only-one): Remove `doc-string' arg. | ||
| 28 | Use a closure rather than a backquoted lambda. | ||
| 29 | (eieio--defmethod): Adjust call accordingly. Set doc-string via the | ||
| 30 | function-documentation property. | ||
| 31 | (eieio-slot-originating-class-p, eieio-slot-name-index) | ||
| 32 | (eieiomt--optimizing-hashtable, eieiomt-install, eieiomt-add) | ||
| 33 | (eieio-generic-form): Adjust to use of hashtables. | ||
| 34 | (eieiomt--sym-optimize): Rename from eieiomt-sym-optimize; take | ||
| 35 | additional class argument. | ||
| 36 | (eieio-generic-call-methodname): Remove, unused. | ||
| 37 | |||
| 38 | * emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p): | ||
| 39 | Prefer \' to $. | ||
| 40 | |||
| 41 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 42 | |||
| 3 | * completion.el: Use post-self-insert-hook (bug#19400). | 43 | * completion.el: Use post-self-insert-hook (bug#19400). |
| 4 | (completion-separator-self-insert-command) | 44 | (completion-separator-self-insert-command) |
| 5 | (completion-separator-self-insert-autofilling): Remove. | 45 | (completion-separator-self-insert-autofilling): Remove. |
| @@ -95,8 +135,8 @@ | |||
| 95 | * electric.el (Electric-pop-up-window): | 135 | * electric.el (Electric-pop-up-window): |
| 96 | * help.el (resize-temp-buffer-window): Call fit-window-to-buffer | 136 | * help.el (resize-temp-buffer-window): Call fit-window-to-buffer |
| 97 | with `preserve-size' t. | 137 | with `preserve-size' t. |
| 98 | * minibuffer.el (minibuffer-completion-help): Use | 138 | * minibuffer.el (minibuffer-completion-help): |
| 99 | `resize-temp-buffer-window' instead of `fit-window-to-buffer' | 139 | Use `resize-temp-buffer-window' instead of `fit-window-to-buffer' |
| 100 | (Bug#19355). Preserve size of completions window. | 140 | (Bug#19355). Preserve size of completions window. |
| 101 | * register.el (register-preview): Preserve size of register | 141 | * register.el (register-preview): Preserve size of register |
| 102 | preview window. | 142 | preview window. |
| @@ -106,8 +146,8 @@ | |||
| 106 | `window-preserve-size'. | 146 | `window-preserve-size'. |
| 107 | (window-min-pixel-size, window--preservable-size) | 147 | (window-min-pixel-size, window--preservable-size) |
| 108 | (window-preserve-size, window-preserved-size) | 148 | (window-preserve-size, window-preserved-size) |
| 109 | (window--preserve-size, window--min-size-ignore-p): New | 149 | (window--preserve-size, window--min-size-ignore-p): |
| 110 | functions. | 150 | New functions. |
| 111 | (window-min-size, window-min-delta, window--resizable) | 151 | (window-min-size, window-min-delta, window--resizable) |
| 112 | (window--resize-this-window, split-window-below) | 152 | (window--resize-this-window, split-window-below) |
| 113 | (split-window-right): Amend doc-string. | 153 | (split-window-right): Amend doc-string. |
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index a1c2cb54a9e..4b8ccaef88d 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el | |||
| @@ -375,13 +375,13 @@ Second, any text properties will be stripped from strings." | |||
| 375 | ) | 375 | ) |
| 376 | 376 | ||
| 377 | (defun eieio-persistent-slot-type-is-class-p (type) | 377 | (defun eieio-persistent-slot-type-is-class-p (type) |
| 378 | "Return the class refered to in TYPE. | 378 | "Return the class referred to in TYPE. |
| 379 | If no class is referenced there, then return nil." | 379 | If no class is referenced there, then return nil." |
| 380 | (cond ((class-p type) | 380 | (cond ((class-p type) |
| 381 | ;; If the type is a class, then return it. | 381 | ;; If the type is a class, then return it. |
| 382 | type) | 382 | type) |
| 383 | 383 | ;; FIXME: foo-child should not be a valid type! | |
| 384 | ((and (symbolp type) (string-match "-child$" (symbol-name type)) | 384 | ((and (symbolp type) (string-match "-child\\'" (symbol-name type)) |
| 385 | (class-p (intern-soft (substring (symbol-name type) 0 | 385 | (class-p (intern-soft (substring (symbol-name type) 0 |
| 386 | (match-beginning 0))))) | 386 | (match-beginning 0))))) |
| 387 | ;; If it is the predicate ending with -child, then return | 387 | ;; If it is the predicate ending with -child, then return |
| @@ -389,8 +389,8 @@ If no class is referenced there, then return nil." | |||
| 389 | ;; class is the same as if we used -child, so no further work needed. | 389 | ;; class is the same as if we used -child, so no further work needed. |
| 390 | (intern-soft (substring (symbol-name type) 0 | 390 | (intern-soft (substring (symbol-name type) 0 |
| 391 | (match-beginning 0)))) | 391 | (match-beginning 0)))) |
| 392 | 392 | ;; FIXME: foo-list should not be a valid type! | |
| 393 | ((and (symbolp type) (string-match "-list$" (symbol-name type)) | 393 | ((and (symbolp type) (string-match "-list\\'" (symbol-name type)) |
| 394 | (class-p (intern-soft (substring (symbol-name type) 0 | 394 | (class-p (intern-soft (substring (symbol-name type) 0 |
| 395 | (match-beginning 0))))) | 395 | (match-beginning 0))))) |
| 396 | ;; If it is the predicate ending with -list, then return | 396 | ;; If it is the predicate ending with -list, then return |
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 2897ce9042a..9ee6520c5ec 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -132,10 +132,10 @@ default setting for optimization purposes.") | |||
| 132 | (defconst ,(intern (format "eieio--%s-num-slots" prefix)) ,index)))) | 132 | (defconst ,(intern (format "eieio--%s-num-slots" prefix)) ,index)))) |
| 133 | 133 | ||
| 134 | (eieio--define-field-accessors class | 134 | (eieio--define-field-accessors class |
| 135 | (-unused-0 ;;FIXME: not sure, but at least there was no accessor! | 135 | (-unused-0 ;;Constant slot, set to `defclass'. |
| 136 | (symbol "symbol (self-referencing)") | 136 | (symbol "symbol (self-referencing)") |
| 137 | parent children | 137 | parent children |
| 138 | (symbol-obarray "obarray permitting fast access to variable position indexes") | 138 | (symbol-hashtable "hashtable permitting fast access to variable position indexes") |
| 139 | ;; @todo | 139 | ;; @todo |
| 140 | ;; the word "public" here is leftovers from the very first version. | 140 | ;; the word "public" here is leftovers from the very first version. |
| 141 | ;; Get rid of it! | 141 | ;; Get rid of it! |
| @@ -166,9 +166,9 @@ from the default.") | |||
| 166 | Stored outright without modifications or stripping."))) | 166 | Stored outright without modifications or stripping."))) |
| 167 | 167 | ||
| 168 | (eieio--define-field-accessors object | 168 | (eieio--define-field-accessors object |
| 169 | (-unused-0 ;;FIXME: not sure, but at least there was no accessor! | 169 | (-unused-0 ;;Constant slot, set to `object'. |
| 170 | (class "class struct defining OBJ") | 170 | (class "class struct defining OBJ") |
| 171 | name)) | 171 | name)) ;FIXME: Get rid of this field! |
| 172 | 172 | ||
| 173 | ;; FIXME: The constants below should have an `eieio-' prefix added!! | 173 | ;; FIXME: The constants below should have an `eieio-' prefix added!! |
| 174 | 174 | ||
| @@ -239,41 +239,41 @@ CLASS is a symbol." | |||
| 239 | 239 | ||
| 240 | (defsubst generic-p (method) | 240 | (defsubst generic-p (method) |
| 241 | "Return non-nil if symbol METHOD is a generic function. | 241 | "Return non-nil if symbol METHOD is a generic function. |
| 242 | Only methods have the symbol `eieio-method-obarray' as a property | 242 | Only methods have the symbol `eieio-method-hashtable' as a property |
| 243 | \(which contains a list of all bindings to that method type.)" | 243 | \(which contains a list of all bindings to that method type.)" |
| 244 | (and (fboundp method) (get method 'eieio-method-obarray))) | 244 | (and (fboundp method) (get method 'eieio-method-hashtable))) |
| 245 | 245 | ||
| 246 | (defun generic-primary-only-p (method) | 246 | (defun generic-primary-only-p (method) |
| 247 | "Return t if symbol METHOD is a generic function with only primary methods. | 247 | "Return t if symbol METHOD is a generic function with only primary methods. |
| 248 | Only methods have the symbol `eieio-method-obarray' as a property (which | 248 | Only methods have the symbol `eieio-method-hashtable' as a property (which |
| 249 | contains a list of all bindings to that method type.) | 249 | contains a list of all bindings to that method type.) |
| 250 | Methods with only primary implementations are executed in an optimized way." | 250 | Methods with only primary implementations are executed in an optimized way." |
| 251 | (and (generic-p method) | 251 | (and (generic-p method) |
| 252 | (let ((M (get method 'eieio-method-tree))) | 252 | (let ((M (get method 'eieio-method-tree))) |
| 253 | (and (< 0 (length (aref M method-primary))) | 253 | (not (or (>= 0 (length (aref M method-primary))) |
| 254 | (not (aref M method-static)) | 254 | (aref M method-static) |
| 255 | (not (aref M method-before)) | 255 | (aref M method-before) |
| 256 | (not (aref M method-after)) | 256 | (aref M method-after) |
| 257 | (not (aref M method-generic-before)) | 257 | (aref M method-generic-before) |
| 258 | (not (aref M method-generic-primary)) | 258 | (aref M method-generic-primary) |
| 259 | (not (aref M method-generic-after)))) | 259 | (aref M method-generic-after))) |
| 260 | )) | 260 | ))) |
| 261 | 261 | ||
| 262 | (defun generic-primary-only-one-p (method) | 262 | (defun generic-primary-only-one-p (method) |
| 263 | "Return t if symbol METHOD is a generic function with only primary methods. | 263 | "Return t if symbol METHOD is a generic function with only primary methods. |
| 264 | Only methods have the symbol `eieio-method-obarray' as a property (which | 264 | Only methods have the symbol `eieio-method-hashtable' as a property (which |
| 265 | contains a list of all bindings to that method type.) | 265 | contains a list of all bindings to that method type.) |
| 266 | Methods with only primary implementations are executed in an optimized way." | 266 | Methods with only primary implementations are executed in an optimized way." |
| 267 | (and (generic-p method) | 267 | (and (generic-p method) |
| 268 | (let ((M (get method 'eieio-method-tree))) | 268 | (let ((M (get method 'eieio-method-tree))) |
| 269 | (and (= 1 (length (aref M method-primary))) | 269 | (not (or (/= 1 (length (aref M method-primary))) |
| 270 | (not (aref M method-static)) | 270 | (aref M method-static) |
| 271 | (not (aref M method-before)) | 271 | (aref M method-before) |
| 272 | (not (aref M method-after)) | 272 | (aref M method-after) |
| 273 | (not (aref M method-generic-before)) | 273 | (aref M method-generic-before) |
| 274 | (not (aref M method-generic-primary)) | 274 | (aref M method-generic-primary) |
| 275 | (not (aref M method-generic-after)))) | 275 | (aref M method-generic-after))) |
| 276 | )) | 276 | ))) |
| 277 | 277 | ||
| 278 | (defmacro class-option-assoc (list option) | 278 | (defmacro class-option-assoc (list option) |
| 279 | "Return from LIST the found OPTION, or nil if it doesn't exist." | 279 | "Return from LIST the found OPTION, or nil if it doesn't exist." |
| @@ -308,7 +308,7 @@ Abstract classes cannot be instantiated." | |||
| 308 | ;;; | 308 | ;;; |
| 309 | ;; Class Creation | 309 | ;; Class Creation |
| 310 | 310 | ||
| 311 | (defvar eieio-defclass-autoload-map (make-vector 7 nil) | 311 | (defvar eieio-defclass-autoload-map (make-hash-table) |
| 312 | "Symbol map of superclasses we find in autoloads.") | 312 | "Symbol map of superclasses we find in autoloads.") |
| 313 | 313 | ||
| 314 | ;; We autoload this because it's used in `make-autoload'. | 314 | ;; We autoload this because it's used in `make-autoload'. |
| @@ -348,25 +348,14 @@ It creates an autoload function for CNAME's constructor." | |||
| 348 | ;; map needs to be cleared! | 348 | ;; map needs to be cleared! |
| 349 | 349 | ||
| 350 | 350 | ||
| 351 | ;; Does our parent exist? | 351 | ;; Save the child in the parent. |
| 352 | (if (not (class-p SC)) | 352 | (cl-pushnew cname (if (class-p SC) |
| 353 | (eieio--class-children (class-v SC)) | ||
| 354 | ;; Parent doesn't exist yet. | ||
| 355 | (gethash SC eieio-defclass-autoload-map))) | ||
| 353 | 356 | ||
| 354 | ;; Create a symbol for this parent, and then store this | 357 | ;; Save parent in child. |
| 355 | ;; parent on that symbol. | 358 | (push SC (eieio--class-parent newc))) |
| 356 | (let ((sym (intern (symbol-name SC) eieio-defclass-autoload-map))) | ||
| 357 | (if (not (boundp sym)) | ||
| 358 | (set sym (list cname)) | ||
| 359 | (add-to-list sym cname)) | ||
| 360 | ) | ||
| 361 | |||
| 362 | ;; We have a parent, save the child in there. | ||
| 363 | (when (not (member cname (eieio--class-children (class-v SC)))) | ||
| 364 | (setf (eieio--class-children (class-v SC)) | ||
| 365 | (cons cname (eieio--class-children (class-v SC)))))) | ||
| 366 | |||
| 367 | ;; save parent in child | ||
| 368 | (setf (eieio--class-parent newc) (cons SC (eieio--class-parent newc))) | ||
| 369 | ) | ||
| 370 | 359 | ||
| 371 | ;; turn this into a usable self-pointing symbol | 360 | ;; turn this into a usable self-pointing symbol |
| 372 | (set cname cname) | 361 | (set cname cname) |
| @@ -390,8 +379,7 @@ It creates an autoload function for CNAME's constructor." | |||
| 390 | 379 | ||
| 391 | (defsubst eieio-class-un-autoload (cname) | 380 | (defsubst eieio-class-un-autoload (cname) |
| 392 | "If class CNAME is in an autoload state, load its file." | 381 | "If class CNAME is in an autoload state, load its file." |
| 393 | (when (eq (car-safe (symbol-function cname)) 'autoload) | 382 | (autoload-do-load (symbol-function cname))) ; cname |
| 394 | (load-library (car (cdr (symbol-function cname)))))) | ||
| 395 | 383 | ||
| 396 | (cl-deftype list-of (elem-type) | 384 | (cl-deftype list-of (elem-type) |
| 397 | `(and list | 385 | `(and list |
| @@ -430,16 +418,13 @@ See `defclass' for more information." | |||
| 430 | ;; byte compiling an EIEIO file. | 418 | ;; byte compiling an EIEIO file. |
| 431 | (if oldc | 419 | (if oldc |
| 432 | (setf (eieio--class-children newc) (eieio--class-children oldc)) | 420 | (setf (eieio--class-children newc) (eieio--class-children oldc)) |
| 433 | ;; If the old class did not exist, but did exist in the autoload map, then adopt those children. | 421 | ;; If the old class did not exist, but did exist in the autoload map, |
| 434 | ;; This is like the above, but deals with autoloads nicely. | 422 | ;; then adopt those children. This is like the above, but deals with |
| 435 | (let ((sym (intern-soft (symbol-name cname) eieio-defclass-autoload-map))) | 423 | ;; autoloads nicely. |
| 436 | (when sym | 424 | (let ((children (gethash cname eieio-defclass-autoload-map))) |
| 437 | (condition-case nil | 425 | (when children |
| 438 | (setf (eieio--class-children newc) (symbol-value sym)) | 426 | (setf (eieio--class-children newc) children) |
| 439 | (error nil)) | 427 | (remhash cname eieio-defclass-autoload-map)))) |
| 440 | (unintern (symbol-name cname) eieio-defclass-autoload-map) | ||
| 441 | )) | ||
| 442 | ) | ||
| 443 | 428 | ||
| 444 | (cond ((and (stringp (car options-and-doc)) | 429 | (cond ((and (stringp (car options-and-doc)) |
| 445 | (/= 1 (% (length options-and-doc) 2))) | 430 | (/= 1 (% (length options-and-doc) 2))) |
| @@ -456,39 +441,35 @@ See `defclass' for more information." | |||
| 456 | 441 | ||
| 457 | (if pname | 442 | (if pname |
| 458 | (progn | 443 | (progn |
| 459 | (while pname | 444 | (dolist (p pname) |
| 460 | (if (and (car pname) (symbolp (car pname))) | 445 | (if (and p (symbolp p)) |
| 461 | (if (not (class-p (car pname))) | 446 | (if (not (class-p p)) |
| 462 | ;; bad class | 447 | ;; bad class |
| 463 | (error "Given parent class %s is not a class" (car pname)) | 448 | (error "Given parent class %S is not a class" p) |
| 464 | ;; good parent class... | 449 | ;; good parent class... |
| 465 | ;; save new child in parent | 450 | ;; save new child in parent |
| 466 | (when (not (member cname (eieio--class-children (class-v (car pname))))) | 451 | (cl-pushnew cname (eieio--class-children (class-v p))) |
| 467 | (setf (eieio--class-children (class-v (car pname))) | ||
| 468 | (cons cname (eieio--class-children (class-v (car pname)))))) | ||
| 469 | ;; Get custom groups, and store them into our local copy. | 452 | ;; Get custom groups, and store them into our local copy. |
| 470 | (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) | 453 | (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) |
| 471 | (class-option (car pname) :custom-groups)) | 454 | (class-option p :custom-groups)) |
| 472 | ;; save parent in child | 455 | ;; save parent in child |
| 473 | (setf (eieio--class-parent newc) (cons (car pname) (eieio--class-parent newc)))) | 456 | (push p (eieio--class-parent newc))) |
| 474 | (error "Invalid parent class %s" pname)) | 457 | (error "Invalid parent class %S" p))) |
| 475 | (setq pname (cdr pname))) | ||
| 476 | ;; Reverse the list of our parents so that they are prioritized in | 458 | ;; Reverse the list of our parents so that they are prioritized in |
| 477 | ;; the same order as specified in the code. | 459 | ;; the same order as specified in the code. |
| 478 | (setf (eieio--class-parent newc) (nreverse (eieio--class-parent newc))) ) | 460 | (cl-callf nreverse (eieio--class-parent newc))) |
| 479 | ;; If there is nothing to loop over, then inherit from the | 461 | ;; If there is nothing to loop over, then inherit from the |
| 480 | ;; default superclass. | 462 | ;; default superclass. |
| 481 | (unless (eq cname 'eieio-default-superclass) | 463 | (unless (eq cname 'eieio-default-superclass) |
| 482 | ;; adopt the default parent here, but clear it later... | 464 | ;; adopt the default parent here, but clear it later... |
| 483 | (setq clearparent t) | 465 | (setq clearparent t) |
| 484 | ;; save new child in parent | 466 | ;; save new child in parent |
| 485 | (if (not (member cname (eieio--class-children (class-v 'eieio-default-superclass)))) | 467 | (cl-pushnew cname (eieio--class-children |
| 486 | (setf (eieio--class-children (class-v 'eieio-default-superclass)) | 468 | (class-v 'eieio-default-superclass))) |
| 487 | (cons cname (eieio--class-children (class-v 'eieio-default-superclass))))) | ||
| 488 | ;; save parent in child | 469 | ;; save parent in child |
| 489 | (setf (eieio--class-parent newc) (list eieio-default-superclass)))) | 470 | (setf (eieio--class-parent newc) '(eieio-default-superclass)))) |
| 490 | 471 | ||
| 491 | ;; turn this into a usable self-pointing symbol | 472 | ;; turn this into a usable self-pointing symbol; FIXME: Why? |
| 492 | (set cname cname) | 473 | (set cname cname) |
| 493 | 474 | ||
| 494 | ;; These two tests must be created right away so we can have self- | 475 | ;; These two tests must be created right away so we can have self- |
| @@ -514,28 +495,11 @@ See `defclass' for more information." | |||
| 514 | (fset csym | 495 | (fset csym |
| 515 | `(lambda (obj) | 496 | `(lambda (obj) |
| 516 | ,(format | 497 | ,(format |
| 517 | "Test OBJ to see if it an object is a child of type %s" | 498 | "Test OBJ to see if it an object is a child of type %s" |
| 518 | cname) | 499 | cname) |
| 519 | (and (eieio-object-p obj) | 500 | (and (eieio-object-p obj) |
| 520 | (object-of-class-p obj ,cname)))) | 501 | (object-of-class-p obj ,cname)))) |
| 521 | 502 | ||
| 522 | ;; Create a handy list of the class test too | ||
| 523 | (let ((csym (intern (concat (symbol-name cname) "-list-p")))) | ||
| 524 | (fset csym | ||
| 525 | `(lambda (obj) | ||
| 526 | ,(format | ||
| 527 | "Test OBJ to see if it a list of objects which are a child of type %s" | ||
| 528 | cname) | ||
| 529 | (when (listp obj) | ||
| 530 | (let ((ans t)) ;; nil is valid | ||
| 531 | ;; Loop over all the elements of the input list, test | ||
| 532 | ;; each to make sure it is a child of the desired object class. | ||
| 533 | (while (and obj ans) | ||
| 534 | (setq ans (and (eieio-object-p (car obj)) | ||
| 535 | (object-of-class-p (car obj) ,cname))) | ||
| 536 | (setq obj (cdr obj))) | ||
| 537 | ans))))) | ||
| 538 | |||
| 539 | ;; When using typep, (typep OBJ 'myclass) returns t for objects which | 503 | ;; When using typep, (typep OBJ 'myclass) returns t for objects which |
| 540 | ;; are subclasses of myclass. For our predicates, however, it is | 504 | ;; are subclasses of myclass. For our predicates, however, it is |
| 541 | ;; important for EIEIO to be backwards compatible, where | 505 | ;; important for EIEIO to be backwards compatible, where |
| @@ -544,9 +508,24 @@ See `defclass' for more information." | |||
| 544 | ;; test, so we can let typep have the CLOS documented behavior | 508 | ;; test, so we can let typep have the CLOS documented behavior |
| 545 | ;; while keeping our above predicate clean. | 509 | ;; while keeping our above predicate clean. |
| 546 | 510 | ||
| 547 | ;; FIXME: It would be cleaner to use `cl-deftype' here. | 511 | (put cname 'cl-deftype-satisfies csym)) |
| 548 | (put cname 'cl-deftype-handler | 512 | |
| 549 | (list 'lambda () `(list 'satisfies (quote ,csym))))) | 513 | ;; Create a handy list of the class test too |
| 514 | (let ((csym (intern (concat (symbol-name cname) "-list-p")))) | ||
| 515 | (fset csym | ||
| 516 | `(lambda (obj) | ||
| 517 | ,(format | ||
| 518 | "Test OBJ to see if it a list of objects which are a child of type %s" | ||
| 519 | cname) | ||
| 520 | (when (listp obj) | ||
| 521 | (let ((ans t)) ;; nil is valid | ||
| 522 | ;; Loop over all the elements of the input list, test | ||
| 523 | ;; each to make sure it is a child of the desired object class. | ||
| 524 | (while (and obj ans) | ||
| 525 | (setq ans (and (eieio-object-p (car obj)) | ||
| 526 | (object-of-class-p (car obj) ,cname))) | ||
| 527 | (setq obj (cdr obj))) | ||
| 528 | ans))))) | ||
| 550 | 529 | ||
| 551 | ;; Before adding new slots, let's add all the methods and classes | 530 | ;; Before adding new slots, let's add all the methods and classes |
| 552 | ;; in from the parent class. | 531 | ;; in from the parent class. |
| @@ -693,52 +672,41 @@ See `defclass' for more information." | |||
| 693 | 672 | ||
| 694 | ;; Now that everything has been loaded up, all our lists are backwards! | 673 | ;; Now that everything has been loaded up, all our lists are backwards! |
| 695 | ;; Fix that up now. | 674 | ;; Fix that up now. |
| 696 | (setf (eieio--class-public-a newc) (nreverse (eieio--class-public-a newc))) | 675 | (cl-callf nreverse (eieio--class-public-a newc)) |
| 697 | (setf (eieio--class-public-d newc) (nreverse (eieio--class-public-d newc))) | 676 | (cl-callf nreverse (eieio--class-public-d newc)) |
| 698 | (setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc newc))) | 677 | (cl-callf nreverse (eieio--class-public-doc newc)) |
| 699 | (setf (eieio--class-public-type newc) | 678 | (cl-callf (lambda (types) (apply #'vector (nreverse types))) |
| 700 | (apply #'vector (nreverse (eieio--class-public-type newc)))) | 679 | (eieio--class-public-type newc)) |
| 701 | (setf (eieio--class-public-custom newc) (nreverse (eieio--class-public-custom newc))) | 680 | (cl-callf nreverse (eieio--class-public-custom newc)) |
| 702 | (setf (eieio--class-public-custom-label newc) (nreverse (eieio--class-public-custom-label newc))) | 681 | (cl-callf nreverse (eieio--class-public-custom-label newc)) |
| 703 | (setf (eieio--class-public-custom-group newc) (nreverse (eieio--class-public-custom-group newc))) | 682 | (cl-callf nreverse (eieio--class-public-custom-group newc)) |
| 704 | (setf (eieio--class-public-printer newc) (nreverse (eieio--class-public-printer newc))) | 683 | (cl-callf nreverse (eieio--class-public-printer newc)) |
| 705 | (setf (eieio--class-protection newc) (nreverse (eieio--class-protection newc))) | 684 | (cl-callf nreverse (eieio--class-protection newc)) |
| 706 | (setf (eieio--class-initarg-tuples newc) (nreverse (eieio--class-initarg-tuples newc))) | 685 | (cl-callf nreverse (eieio--class-initarg-tuples newc)) |
| 707 | 686 | ||
| 708 | ;; The storage for class-class-allocation-type needs to be turned into | 687 | ;; The storage for class-class-allocation-type needs to be turned into |
| 709 | ;; a vector now. | 688 | ;; a vector now. |
| 710 | (setf (eieio--class-class-allocation-type newc) | 689 | (cl-callf (lambda (cat) (apply #'vector cat)) |
| 711 | (apply #'vector (eieio--class-class-allocation-type newc))) | 690 | (eieio--class-class-allocation-type newc)) |
| 712 | 691 | ||
| 713 | ;; Also, take class allocated values, and vectorize them for speed. | 692 | ;; Also, take class allocated values, and vectorize them for speed. |
| 714 | (setf (eieio--class-class-allocation-values newc) | 693 | (cl-callf (lambda (cavs) (apply #'vector cavs)) |
| 715 | (apply #'vector (eieio--class-class-allocation-values newc))) | 694 | (eieio--class-class-allocation-values newc)) |
| 716 | 695 | ||
| 717 | ;; Attach slot symbols into an obarray, and store the index of | 696 | ;; Attach slot symbols into a hashtable, and store the index of |
| 718 | ;; this slot as the variable slot in this new symbol. We need to | 697 | ;; this slot as the value this table. |
| 719 | ;; know about primes, because obarrays are best set in vectors of | ||
| 720 | ;; prime number length, and we also need to make our vector small | ||
| 721 | ;; to save space, and also optimal for the number of items we have. | ||
| 722 | (let* ((cnt 0) | 698 | (let* ((cnt 0) |
| 723 | (pubsyms (eieio--class-public-a newc)) | 699 | (pubsyms (eieio--class-public-a newc)) |
| 724 | (prots (eieio--class-protection newc)) | 700 | (prots (eieio--class-protection newc)) |
| 725 | (l (length pubsyms)) | 701 | (oa (make-hash-table :test #'eq))) |
| 726 | (vl (let ((primes '( 3 5 7 11 13 17 19 23 29 31 37 41 43 47 | ||
| 727 | 53 59 61 67 71 73 79 83 89 97 101 ))) | ||
| 728 | (while (and primes (< (car primes) l)) | ||
| 729 | (setq primes (cdr primes))) | ||
| 730 | (car primes))) | ||
| 731 | (oa (make-vector vl 0)) | ||
| 732 | (newsym)) | ||
| 733 | (while pubsyms | 702 | (while pubsyms |
| 734 | (setq newsym (intern (symbol-name (car pubsyms)) oa)) | 703 | (let ((newsym (list cnt))) |
| 735 | (set newsym cnt) | 704 | (setf (gethash (car pubsyms) oa) newsym) |
| 736 | (setq cnt (1+ cnt)) | 705 | (setq cnt (1+ cnt)) |
| 737 | (if (car prots) (put newsym 'protection (car prots))) | 706 | (if (car prots) (setcdr newsym (car prots)))) |
| 738 | (setq pubsyms (cdr pubsyms) | 707 | (setq pubsyms (cdr pubsyms) |
| 739 | prots (cdr prots))) | 708 | prots (cdr prots))) |
| 740 | (setf (eieio--class-symbol-obarray newc) oa) | 709 | (setf (eieio--class-symbol-hashtable newc) oa)) |
| 741 | ) | ||
| 742 | 710 | ||
| 743 | ;; Create the constructor function | 711 | ;; Create the constructor function |
| 744 | (if (class-option-assoc options :abstract) | 712 | (if (class-option-assoc options :abstract) |
| @@ -787,7 +755,8 @@ See `defclass' for more information." | |||
| 787 | (if clearparent (setf (eieio--class-parent newc) nil)) | 755 | (if clearparent (setf (eieio--class-parent newc) nil)) |
| 788 | 756 | ||
| 789 | ;; Create the cached default object. | 757 | ;; Create the cached default object. |
| 790 | (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) 3) | 758 | (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) |
| 759 | (eval-when-compile eieio--object-num-slots)) | ||
| 791 | nil))) | 760 | nil))) |
| 792 | (aset cache 0 'object) | 761 | (aset cache 0 'object) |
| 793 | (setf (eieio--object-class cache) cname) | 762 | (setf (eieio--object-class cache) cname) |
| @@ -1123,108 +1092,99 @@ the new child class." | |||
| 1123 | ;; Make sure the method tables are installed. | 1092 | ;; Make sure the method tables are installed. |
| 1124 | (eieiomt-install method) | 1093 | (eieiomt-install method) |
| 1125 | ;; Construct the actual body of this function. | 1094 | ;; Construct the actual body of this function. |
| 1126 | (eieio-defgeneric-form method doc-string)) | 1095 | (put method 'function-documentation doc-string) |
| 1096 | (eieio-defgeneric-form method)) | ||
| 1127 | ((generic-p method) (symbol-function method)) ;Leave it as-is. | 1097 | ((generic-p method) (symbol-function method)) ;Leave it as-is. |
| 1128 | (t (error "You cannot create a generic/method over an existing symbol: %s" | 1098 | (t (error "You cannot create a generic/method over an existing symbol: %s" |
| 1129 | method)))) | 1099 | method)))) |
| 1130 | 1100 | ||
| 1131 | (defun eieio-defgeneric-form (method doc-string) | 1101 | (defun eieio-defgeneric-form (method) |
| 1132 | "The lambda form that would be used as the function defined on METHOD. | 1102 | "The lambda form that would be used as the function defined on METHOD. |
| 1133 | All methods should call the same EIEIO function for dispatch. | 1103 | All methods should call the same EIEIO function for dispatch. |
| 1134 | DOC-STRING is the documentation attached to METHOD." | 1104 | DOC-STRING is the documentation attached to METHOD." |
| 1135 | `(lambda (&rest local-args) | 1105 | (lambda (&rest local-args) |
| 1136 | ,doc-string | 1106 | (eieio-generic-call method local-args))) |
| 1137 | (eieio-generic-call (quote ,method) local-args))) | ||
| 1138 | 1107 | ||
| 1139 | (defsubst eieio-defgeneric-reset-generic-form (method) | 1108 | (defsubst eieio-defgeneric-reset-generic-form (method) |
| 1140 | "Setup METHOD to call the generic form." | 1109 | "Setup METHOD to call the generic form." |
| 1141 | (let ((doc-string (documentation method))) | 1110 | (let ((doc-string (documentation method 'raw))) |
| 1142 | (fset method (eieio-defgeneric-form method doc-string)))) | 1111 | (put method 'function-documentation doc-string) |
| 1112 | (fset method (eieio-defgeneric-form method)))) | ||
| 1143 | 1113 | ||
| 1144 | (defun eieio-defgeneric-form-primary-only (method doc-string) | 1114 | (defun eieio-defgeneric-form-primary-only (method) |
| 1145 | "The lambda form that would be used as the function defined on METHOD. | 1115 | "The lambda form that would be used as the function defined on METHOD. |
| 1146 | All methods should call the same EIEIO function for dispatch. | 1116 | All methods should call the same EIEIO function for dispatch. |
| 1147 | DOC-STRING is the documentation attached to METHOD." | 1117 | DOC-STRING is the documentation attached to METHOD." |
| 1148 | `(lambda (&rest local-args) | 1118 | (lambda (&rest local-args) |
| 1149 | ,doc-string | 1119 | (eieio-generic-call-primary-only method local-args))) |
| 1150 | (eieio-generic-call-primary-only (quote ,method) local-args))) | ||
| 1151 | 1120 | ||
| 1152 | (defsubst eieio-defgeneric-reset-generic-form-primary-only (method) | 1121 | (defsubst eieio-defgeneric-reset-generic-form-primary-only (method) |
| 1153 | "Setup METHOD to call the generic form." | 1122 | "Setup METHOD to call the generic form." |
| 1154 | (let ((doc-string (documentation method))) | 1123 | (let ((doc-string (documentation method 'raw))) |
| 1155 | (fset method (eieio-defgeneric-form-primary-only method doc-string)))) | 1124 | (put method 'function-documentation doc-string) |
| 1125 | (fset method (eieio-defgeneric-form-primary-only method)))) | ||
| 1156 | 1126 | ||
| 1157 | (declare-function no-applicable-method "eieio" (object method &rest args)) | 1127 | (declare-function no-applicable-method "eieio" (object method &rest args)) |
| 1158 | 1128 | ||
| 1159 | (defun eieio-defgeneric-form-primary-only-one (method doc-string | 1129 | (defvar eieio-generic-call-arglst nil |
| 1160 | class | 1130 | "When using `call-next-method', provides a context for parameters.") |
| 1161 | impl | 1131 | (defvar eieio-generic-call-key nil |
| 1162 | ) | 1132 | "When using `call-next-method', provides a context for the current key. |
| 1133 | Keys are a number representing :before, :primary, and :after methods.") | ||
| 1134 | (defvar eieio-generic-call-next-method-list nil | ||
| 1135 | "When executing a PRIMARY or STATIC method, track the 'next-method'. | ||
| 1136 | During executions, the list is first generated, then as each next method | ||
| 1137 | is called, the next method is popped off the stack.") | ||
| 1138 | |||
| 1139 | (defun eieio-defgeneric-form-primary-only-one (method class impl) | ||
| 1163 | "The lambda form that would be used as the function defined on METHOD. | 1140 | "The lambda form that would be used as the function defined on METHOD. |
| 1164 | All methods should call the same EIEIO function for dispatch. | 1141 | All methods should call the same EIEIO function for dispatch. |
| 1165 | DOC-STRING is the documentation attached to METHOD. | ||
| 1166 | CLASS is the class symbol needed for private method access. | 1142 | CLASS is the class symbol needed for private method access. |
| 1167 | IMPL is the symbol holding the method implementation." | 1143 | IMPL is the symbol holding the method implementation." |
| 1168 | ;; NOTE: I tried out byte compiling this little fcn. Turns out it | 1144 | (lambda (&rest local-args) |
| 1169 | ;; is faster to execute this for not byte-compiled. ie, install this, | 1145 | ;; This is a cool cheat. Usually we need to look up in the |
| 1170 | ;; then measure calls going through here. I wonder why. | 1146 | ;; method table to find out if there is a method or not. We can |
| 1171 | (require 'bytecomp) | 1147 | ;; instead make that determination at load time when there is |
| 1172 | (let ((byte-compile-warnings nil)) | 1148 | ;; only one method. If the first arg is not a child of the class |
| 1173 | (byte-compile | 1149 | ;; of that one implementation, then clearly, there is no method def. |
| 1174 | `(lambda (&rest local-args) | 1150 | (if (not (eieio-object-p (car local-args))) |
| 1175 | ,doc-string | 1151 | ;; Not an object. Just signal. |
| 1176 | ;; This is a cool cheat. Usually we need to look up in the | 1152 | (signal 'no-method-definition |
| 1177 | ;; method table to find out if there is a method or not. We can | 1153 | (list method local-args)) |
| 1178 | ;; instead make that determination at load time when there is | 1154 | |
| 1179 | ;; only one method. If the first arg is not a child of the class | 1155 | ;; We do have an object. Make sure it is the right type. |
| 1180 | ;; of that one implementation, then clearly, there is no method def. | 1156 | (if (not (child-of-class-p (eieio--object-class (car local-args)) |
| 1181 | (if (not (eieio-object-p (car local-args))) | 1157 | class)) |
| 1182 | ;; Not an object. Just signal. | 1158 | |
| 1183 | (signal 'no-method-definition | 1159 | ;; If not the right kind of object, call no applicable |
| 1184 | (list ',method local-args)) | 1160 | (apply #'no-applicable-method (car local-args) |
| 1185 | 1161 | method local-args) | |
| 1186 | ;; We do have an object. Make sure it is the right type. | 1162 | |
| 1187 | (if ,(if (eq class eieio-default-superclass) | 1163 | ;; It is ok, do the call. |
| 1188 | nil ; default superclass means just an obj. Already asked. | 1164 | ;; Fill in inter-call variables then evaluate the method. |
| 1189 | `(not (child-of-class-p (eieio--object-class (car local-args)) | 1165 | (let ((eieio-generic-call-next-method-list nil) |
| 1190 | ',class))) | 1166 | (eieio-generic-call-key method-primary) |
| 1191 | 1167 | (eieio-generic-call-arglst local-args) | |
| 1192 | ;; If not the right kind of object, call no applicable | 1168 | ) |
| 1193 | (apply #'no-applicable-method (car local-args) | 1169 | (eieio--with-scoped-class class |
| 1194 | ',method local-args) | 1170 | (apply impl local-args))))))) |
| 1195 | |||
| 1196 | ;; It is ok, do the call. | ||
| 1197 | ;; Fill in inter-call variables then evaluate the method. | ||
| 1198 | (let ((eieio-generic-call-next-method-list nil) | ||
| 1199 | (eieio-generic-call-key method-primary) | ||
| 1200 | (eieio-generic-call-methodname ',method) | ||
| 1201 | (eieio-generic-call-arglst local-args) | ||
| 1202 | ) | ||
| 1203 | (eieio--with-scoped-class ',class | ||
| 1204 | ,(if (< emacs-major-version 24) | ||
| 1205 | `(apply ,(list 'quote impl) local-args) | ||
| 1206 | `(apply #',impl local-args))) | ||
| 1207 | ;(,impl local-args) | ||
| 1208 | ))))))) | ||
| 1209 | 1171 | ||
| 1210 | (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) | 1172 | (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) |
| 1211 | "Setup METHOD to call the generic form." | 1173 | "Setup METHOD to call the generic form." |
| 1212 | (let* ((doc-string (documentation method)) | 1174 | (let* ((doc-string (documentation method 'raw)) |
| 1213 | (M (get method 'eieio-method-tree)) | 1175 | (M (get method 'eieio-method-tree)) |
| 1214 | (entry (car (aref M method-primary))) | 1176 | (entry (car (aref M method-primary))) |
| 1215 | ) | 1177 | ) |
| 1178 | (put method 'function-documentation doc-string) | ||
| 1216 | (fset method (eieio-defgeneric-form-primary-only-one | 1179 | (fset method (eieio-defgeneric-form-primary-only-one |
| 1217 | method doc-string | 1180 | method (car entry) (cdr entry))))) |
| 1218 | (car entry) | ||
| 1219 | (cdr entry) | ||
| 1220 | )))) | ||
| 1221 | 1181 | ||
| 1222 | (defun eieio-unbind-method-implementations (method) | 1182 | (defun eieio-unbind-method-implementations (method) |
| 1223 | "Make the generic method METHOD have no implementations. | 1183 | "Make the generic method METHOD have no implementations. |
| 1224 | It will leave the original generic function in place, | 1184 | It will leave the original generic function in place, |
| 1225 | but remove reference to all implementations of METHOD." | 1185 | but remove reference to all implementations of METHOD." |
| 1226 | (put method 'eieio-method-tree nil) | 1186 | (put method 'eieio-method-tree nil) |
| 1227 | (put method 'eieio-method-obarray nil)) | 1187 | (put method 'eieio-method-hashtable nil)) |
| 1228 | 1188 | ||
| 1229 | (defun eieio--defmethod (method kind argclass code) | 1189 | (defun eieio--defmethod (method kind argclass code) |
| 1230 | "Work part of the `defmethod' macro defining METHOD with ARGS." | 1190 | "Work part of the `defmethod' macro defining METHOD with ARGS." |
| @@ -1248,7 +1208,7 @@ but remove reference to all implementations of METHOD." | |||
| 1248 | ;; under the type `primary' which is a non-specific calling of the | 1208 | ;; under the type `primary' which is a non-specific calling of the |
| 1249 | ;; function. | 1209 | ;; function. |
| 1250 | (if argclass | 1210 | (if argclass |
| 1251 | (if (not (class-p argclass)) | 1211 | (if (not (class-p argclass)) ;FIXME: Accept cl-defstructs! |
| 1252 | (error "Unknown class type %s in method parameters" | 1212 | (error "Unknown class type %s in method parameters" |
| 1253 | argclass)) | 1213 | argclass)) |
| 1254 | ;; Generics are higher. | 1214 | ;; Generics are higher. |
| @@ -1440,8 +1400,7 @@ so that we can protect private slots." | |||
| 1440 | (if (not par) | 1400 | (if (not par) |
| 1441 | t | 1401 | t |
| 1442 | (while (and par ret) | 1402 | (while (and par ret) |
| 1443 | (if (intern-soft (symbol-name slot) | 1403 | (if (gethash slot (eieio--class-symbol-hashtable (class-v (car par)))) |
| 1444 | (eieio--class-symbol-obarray (class-v (car par)))) | ||
| 1445 | (setq ret nil)) | 1404 | (setq ret nil)) |
| 1446 | (setq par (cdr par))) | 1405 | (setq par (cdr par))) |
| 1447 | ret))) | 1406 | ret))) |
| @@ -1455,20 +1414,19 @@ scoped class. | |||
| 1455 | If SLOT is the value created with :initarg instead, | 1414 | If SLOT is the value created with :initarg instead, |
| 1456 | reverse-lookup that name, and recurse with the associated slot value." | 1415 | reverse-lookup that name, and recurse with the associated slot value." |
| 1457 | ;; Removed checks to outside this call | 1416 | ;; Removed checks to outside this call |
| 1458 | (let* ((fsym (intern-soft (symbol-name slot) | 1417 | (let* ((fsym (gethash slot (eieio--class-symbol-hashtable (class-v class)))) |
| 1459 | (eieio--class-symbol-obarray (class-v class)))) | 1418 | (fsi (car fsym))) |
| 1460 | (fsi (if (symbolp fsym) (symbol-value fsym) nil))) | ||
| 1461 | (if (integerp fsi) | 1419 | (if (integerp fsi) |
| 1462 | (cond | 1420 | (cond |
| 1463 | ((not (get fsym 'protection)) | 1421 | ((not (cdr fsym)) |
| 1464 | (+ 3 fsi)) | 1422 | (+ 3 fsi)) |
| 1465 | ((and (eq (get fsym 'protection) 'protected) | 1423 | ((and (eq (cdr fsym) 'protected) |
| 1466 | (eieio--scoped-class) | 1424 | (eieio--scoped-class) |
| 1467 | (or (child-of-class-p class (eieio--scoped-class)) | 1425 | (or (child-of-class-p class (eieio--scoped-class)) |
| 1468 | (and (eieio-object-p obj) | 1426 | (and (eieio-object-p obj) |
| 1469 | (child-of-class-p class (eieio--object-class obj))))) | 1427 | (child-of-class-p class (eieio--object-class obj))))) |
| 1470 | (+ 3 fsi)) | 1428 | (+ 3 fsi)) |
| 1471 | ((and (eq (get fsym 'protection) 'private) | 1429 | ((and (eq (cdr fsym) 'private) |
| 1472 | (or (and (eieio--scoped-class) | 1430 | (or (and (eieio--scoped-class) |
| 1473 | (eieio-slot-originating-class-p (eieio--scoped-class) slot)) | 1431 | (eieio-slot-originating-class-p (eieio--scoped-class) slot)) |
| 1474 | eieio-initializing-object)) | 1432 | eieio-initializing-object)) |
| @@ -1651,17 +1609,6 @@ method invocation orders of the involved classes." | |||
| 1651 | 1609 | ||
| 1652 | ;;; CLOS generics internal function handling | 1610 | ;;; CLOS generics internal function handling |
| 1653 | ;; | 1611 | ;; |
| 1654 | (defvar eieio-generic-call-methodname nil | ||
| 1655 | "When using `call-next-method', provides a context on how to do it.") | ||
| 1656 | (defvar eieio-generic-call-arglst nil | ||
| 1657 | "When using `call-next-method', provides a context for parameters.") | ||
| 1658 | (defvar eieio-generic-call-key nil | ||
| 1659 | "When using `call-next-method', provides a context for the current key. | ||
| 1660 | Keys are a number representing :before, :primary, and :after methods.") | ||
| 1661 | (defvar eieio-generic-call-next-method-list nil | ||
| 1662 | "When executing a PRIMARY or STATIC method, track the 'next-method'. | ||
| 1663 | During executions, the list is first generated, then as each next method | ||
| 1664 | is called, the next method is popped off the stack.") | ||
| 1665 | 1612 | ||
| 1666 | (define-obsolete-variable-alias 'eieio-pre-method-execution-hooks | 1613 | (define-obsolete-variable-alias 'eieio-pre-method-execution-hooks |
| 1667 | 'eieio-pre-method-execution-functions "24.3") | 1614 | 'eieio-pre-method-execution-functions "24.3") |
| @@ -1677,7 +1624,6 @@ This should only be called from a generic function." | |||
| 1677 | ;; We must expand our arguments first as they are always | 1624 | ;; We must expand our arguments first as they are always |
| 1678 | ;; passed in as quoted symbols | 1625 | ;; passed in as quoted symbols |
| 1679 | (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil) | 1626 | (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil) |
| 1680 | (eieio-generic-call-methodname method) | ||
| 1681 | (eieio-generic-call-arglst args) | 1627 | (eieio-generic-call-arglst args) |
| 1682 | (firstarg nil) | 1628 | (firstarg nil) |
| 1683 | (primarymethodlist nil)) | 1629 | (primarymethodlist nil)) |
| @@ -1818,7 +1764,6 @@ for this common case to improve performance." | |||
| 1818 | ;; We must expand our arguments first as they are always | 1764 | ;; We must expand our arguments first as they are always |
| 1819 | ;; passed in as quoted symbols | 1765 | ;; passed in as quoted symbols |
| 1820 | (let ((newargs nil) (mclass nil) (lambdas nil) | 1766 | (let ((newargs nil) (mclass nil) (lambdas nil) |
| 1821 | (eieio-generic-call-methodname method) | ||
| 1822 | (eieio-generic-call-arglst args) | 1767 | (eieio-generic-call-arglst args) |
| 1823 | (firstarg nil) | 1768 | (firstarg nil) |
| 1824 | (primarymethodlist nil) | 1769 | (primarymethodlist nil) |
| @@ -1918,7 +1863,7 @@ If CLASS is nil, then an empty list of methods should be returned." | |||
| 1918 | ;; (eieio-method-tree . [BEFORE PRIMARY AFTER | 1863 | ;; (eieio-method-tree . [BEFORE PRIMARY AFTER |
| 1919 | ;; genericBEFORE genericPRIMARY genericAFTER]) | 1864 | ;; genericBEFORE genericPRIMARY genericAFTER]) |
| 1920 | ;; and | 1865 | ;; and |
| 1921 | ;; (eieio-method-obarray . [BEFORE PRIMARY AFTER | 1866 | ;; (eieio-method-hashtable . [BEFORE PRIMARY AFTER |
| 1922 | ;; genericBEFORE genericPRIMARY genericAFTER]) | 1867 | ;; genericBEFORE genericPRIMARY genericAFTER]) |
| 1923 | ;; where the association is a vector. | 1868 | ;; where the association is a vector. |
| 1924 | ;; (aref 0 -- all static methods. | 1869 | ;; (aref 0 -- all static methods. |
| @@ -1929,25 +1874,22 @@ If CLASS is nil, then an empty list of methods should be returned." | |||
| 1929 | ;; (aref 5 -- a generic classified as :primary | 1874 | ;; (aref 5 -- a generic classified as :primary |
| 1930 | ;; (aref 6 -- a generic classified as :after | 1875 | ;; (aref 6 -- a generic classified as :after |
| 1931 | ;; | 1876 | ;; |
| 1932 | (defvar eieiomt-optimizing-obarray nil | 1877 | (defvar eieiomt--optimizing-hashtable nil |
| 1933 | "While mapping atoms, this contain the obarray being optimized.") | 1878 | "While mapping atoms, this contain the hashtable being optimized.") |
| 1934 | 1879 | ||
| 1935 | (defun eieiomt-install (method-name) | 1880 | (defun eieiomt-install (method-name) |
| 1936 | "Install the method tree, and obarray onto METHOD-NAME. | 1881 | "Install the method tree, and hashtable onto METHOD-NAME. |
| 1937 | Do not do the work if they already exist." | 1882 | Do not do the work if they already exist." |
| 1938 | (let ((emtv (get method-name 'eieio-method-tree)) | 1883 | (unless (and (get method-name 'eieio-method-tree) |
| 1939 | (emto (get method-name 'eieio-method-obarray))) | 1884 | (get method-name 'eieio-method-hashtable)) |
| 1940 | (if (or (not emtv) (not emto)) | 1885 | (put method-name 'eieio-method-tree |
| 1941 | (progn | 1886 | (make-vector method-num-slots nil)) |
| 1942 | (setq emtv (put method-name 'eieio-method-tree | 1887 | (let ((emto (put method-name 'eieio-method-hashtable |
| 1943 | (make-vector method-num-slots nil)) | 1888 | (make-vector method-num-slots nil)))) |
| 1944 | emto (put method-name 'eieio-method-obarray | 1889 | (aset emto 0 (make-hash-table :test 'eq)) |
| 1945 | (make-vector method-num-slots nil))) | 1890 | (aset emto 1 (make-hash-table :test 'eq)) |
| 1946 | (aset emto 0 (make-vector 11 0)) | 1891 | (aset emto 2 (make-hash-table :test 'eq)) |
| 1947 | (aset emto 1 (make-vector 11 0)) | 1892 | (aset emto 3 (make-hash-table :test 'eq))))) |
| 1948 | (aset emto 2 (make-vector 41 0)) | ||
| 1949 | (aset emto 3 (make-vector 11 0)) | ||
| 1950 | )))) | ||
| 1951 | 1893 | ||
| 1952 | (defun eieiomt-add (method-name method key class) | 1894 | (defun eieiomt-add (method-name method key class) |
| 1953 | "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS. | 1895 | "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS. |
| @@ -1960,36 +1902,33 @@ CLASS is the class this method is associated with." | |||
| 1960 | (if (or (> key method-num-slots) (< key 0)) | 1902 | (if (or (> key method-num-slots) (< key 0)) |
| 1961 | (error "eieiomt-add: method key error!")) | 1903 | (error "eieiomt-add: method key error!")) |
| 1962 | (let ((emtv (get method-name 'eieio-method-tree)) | 1904 | (let ((emtv (get method-name 'eieio-method-tree)) |
| 1963 | (emto (get method-name 'eieio-method-obarray))) | 1905 | (emto (get method-name 'eieio-method-hashtable))) |
| 1964 | ;; Make sure the method tables are available. | 1906 | ;; Make sure the method tables are available. |
| 1965 | (if (or (not emtv) (not emto)) | 1907 | (unless (and emtv emto) |
| 1966 | (error "Programmer error: eieiomt-add")) | 1908 | (error "Programmer error: eieiomt-add")) |
| 1967 | ;; only add new cells on if it doesn't already exist! | 1909 | ;; only add new cells on if it doesn't already exist! |
| 1968 | (if (assq class (aref emtv key)) | 1910 | (if (assq class (aref emtv key)) |
| 1969 | (setcdr (assq class (aref emtv key)) method) | 1911 | (setcdr (assq class (aref emtv key)) method) |
| 1970 | (aset emtv key (cons (cons class method) (aref emtv key)))) | 1912 | (aset emtv key (cons (cons class method) (aref emtv key)))) |
| 1971 | ;; Add function definition into newly created symbol, and store | 1913 | ;; Add function definition into newly created symbol, and store |
| 1972 | ;; said symbol in the correct obarray, otherwise use the | 1914 | ;; said symbol in the correct hashtable, otherwise use the |
| 1973 | ;; other array to keep this stuff | 1915 | ;; other array to keep this stuff. |
| 1974 | (if (< key method-num-lists) | 1916 | (if (< key method-num-lists) |
| 1975 | (let ((nsym (intern (symbol-name class) (aref emto key)))) | 1917 | (puthash class (list method) (aref emto key))) |
| 1976 | (fset nsym method))) | ||
| 1977 | ;; Save the defmethod file location in a symbol property. | 1918 | ;; Save the defmethod file location in a symbol property. |
| 1978 | (let ((fname (if load-in-progress | 1919 | (let ((fname (if load-in-progress |
| 1979 | load-file-name | 1920 | load-file-name |
| 1980 | buffer-file-name)) | 1921 | buffer-file-name))) |
| 1981 | loc) | ||
| 1982 | (when fname | 1922 | (when fname |
| 1983 | (when (string-match "\\.elc$" fname) | 1923 | (when (string-match "\\.elc\\'" fname) |
| 1984 | (setq fname (substring fname 0 (1- (length fname))))) | 1924 | (setq fname (substring fname 0 (1- (length fname))))) |
| 1985 | (setq loc (get method-name 'method-locations)) | 1925 | (cl-pushnew (list class fname) (get method-name 'method-locations) |
| 1986 | (cl-pushnew (list class fname) loc :test 'equal) | 1926 | :test 'equal))) |
| 1987 | (put method-name 'method-locations loc))) | 1927 | ;; Now optimize the entire hashtable. |
| 1988 | ;; Now optimize the entire obarray | ||
| 1989 | (if (< key method-num-lists) | 1928 | (if (< key method-num-lists) |
| 1990 | (let ((eieiomt-optimizing-obarray (aref emto key))) | 1929 | (let ((eieiomt--optimizing-hashtable (aref emto key))) |
| 1991 | ;; @todo - Is this overkill? Should we just clear the symbol? | 1930 | ;; @todo - Is this overkill? Should we just clear the symbol? |
| 1992 | (mapatoms 'eieiomt-sym-optimize eieiomt-optimizing-obarray))) | 1931 | (maphash #'eieiomt--sym-optimize eieiomt--optimizing-hashtable))) |
| 1993 | )) | 1932 | )) |
| 1994 | 1933 | ||
| 1995 | (defun eieiomt-next (class) | 1934 | (defun eieiomt-next (class) |
| @@ -2005,21 +1944,19 @@ nil for superclasses. This function performs no type checking!" | |||
| 2005 | nil | 1944 | nil |
| 2006 | '(eieio-default-superclass)))) | 1945 | '(eieio-default-superclass)))) |
| 2007 | 1946 | ||
| 2008 | (defun eieiomt-sym-optimize (s) | 1947 | (defun eieiomt--sym-optimize (class s) |
| 2009 | "Find the next class above S which has a function body for the optimizer." | 1948 | "Find the next class above S which has a function body for the optimizer." |
| 2010 | ;; Set the value to nil in case there is no nearest cell. | 1949 | ;; Set the value to nil in case there is no nearest cell. |
| 2011 | (set s nil) | 1950 | (setcdr s nil) |
| 2012 | ;; Find the nearest cell that has a function body. If we find one, | 1951 | ;; Find the nearest cell that has a function body. If we find one, |
| 2013 | ;; we replace the nil from above. | 1952 | ;; we replace the nil from above. |
| 2014 | (let ((external-symbol (intern-soft (symbol-name s)))) | 1953 | (catch 'done |
| 2015 | (catch 'done | 1954 | (dolist (ancestor |
| 2016 | (dolist (ancestor | 1955 | (cl-rest (eieio-class-precedence-list class))) |
| 2017 | (cl-rest (eieio-class-precedence-list external-symbol))) | 1956 | (let ((ov (gethash ancestor eieiomt--optimizing-hashtable))) |
| 2018 | (let ((ov (intern-soft (symbol-name ancestor) | 1957 | (when (car ov) |
| 2019 | eieiomt-optimizing-obarray))) | 1958 | (setcdr s ancestor) ;; store ov as our next symbol |
| 2020 | (when (fboundp ov) | 1959 | (throw 'done ancestor)))))) |
| 2021 | (set s ov) ;; store ov as our next symbol | ||
| 2022 | (throw 'done ancestor))))))) | ||
| 2023 | 1960 | ||
| 2024 | (defun eieio-generic-form (method key class) | 1961 | (defun eieio-generic-form (method key class) |
| 2025 | "Return the lambda form belonging to METHOD using KEY based upon CLASS. | 1962 | "Return the lambda form belonging to METHOD using KEY based upon CLASS. |
| @@ -2027,33 +1964,33 @@ If CLASS is not a class then use `generic' instead. If class has | |||
| 2027 | no form, but has a parent class, then trace to that parent class. | 1964 | no form, but has a parent class, then trace to that parent class. |
| 2028 | The first time a form is requested from a symbol, an optimized path | 1965 | The first time a form is requested from a symbol, an optimized path |
| 2029 | is memorized for faster future use." | 1966 | is memorized for faster future use." |
| 2030 | (let ((emto (aref (get method 'eieio-method-obarray) | 1967 | (let ((emto (aref (get method 'eieio-method-hashtable) |
| 2031 | (if class key (eieio-specialized-key-to-generic-key key))))) | 1968 | (if class key (eieio-specialized-key-to-generic-key key))))) |
| 2032 | (if (class-p class) | 1969 | (if (class-p class) |
| 2033 | ;; 1) find our symbol | 1970 | ;; 1) find our symbol |
| 2034 | (let ((cs (intern-soft (symbol-name class) emto))) | 1971 | (let ((cs (gethash class emto))) |
| 2035 | (if (not cs) | 1972 | (unless cs |
| 2036 | ;; 2) If there isn't one, then make one. | 1973 | ;; 2) If there isn't one, then make one. |
| 2037 | ;; This can be slow since it only occurs once | 1974 | ;; This can be slow since it only occurs once |
| 2038 | (progn | 1975 | (puthash class (setq cs (list nil)) emto) |
| 2039 | (setq cs (intern (symbol-name class) emto)) | 1976 | ;; 2.1) Cache its nearest neighbor with a quick optimize |
| 2040 | ;; 2.1) Cache its nearest neighbor with a quick optimize | 1977 | ;; which should only occur once for this call ever |
| 2041 | ;; which should only occur once for this call ever | 1978 | (let ((eieiomt--optimizing-hashtable emto)) |
| 2042 | (let ((eieiomt-optimizing-obarray emto)) | 1979 | (eieiomt--sym-optimize class cs))) |
| 2043 | (eieiomt-sym-optimize cs)))) | ||
| 2044 | ;; 3) If it's bound return this one. | 1980 | ;; 3) If it's bound return this one. |
| 2045 | (if (fboundp cs) | 1981 | (if (car cs) |
| 2046 | (cons cs (eieio--class-symbol (class-v class))) | 1982 | ;; FIXME: Why (eieio--class-symbol (class-v class))? |
| 1983 | (cons (car cs) class) | ||
| 2047 | ;; 4) If it's not bound then this variable knows something | 1984 | ;; 4) If it's not bound then this variable knows something |
| 2048 | (if (symbol-value cs) | 1985 | (if (cdr cs) |
| 2049 | (progn | 1986 | (progn |
| 2050 | ;; 4.1) This symbol holds the next class in its value | 1987 | ;; 4.1) This symbol holds the next class in its value |
| 2051 | (setq class (symbol-value cs) | 1988 | (setq class (cdr cs) |
| 2052 | cs (intern-soft (symbol-name class) emto)) | 1989 | cs (gethash class emto)) |
| 2053 | ;; 4.2) The optimizer should always have chosen a | 1990 | ;; 4.2) The optimizer should always have chosen a |
| 2054 | ;; function-symbol | 1991 | ;; function-symbol |
| 2055 | ;;(if (fboundp cs) | 1992 | ;;(if (car cs) |
| 2056 | (cons cs (eieio--class-symbol (class-v (intern (symbol-name class))))) | 1993 | (cons (car cs) class) |
| 2057 | ;;(error "EIEIO optimizer: erratic data loss!")) | 1994 | ;;(error "EIEIO optimizer: erratic data loss!")) |
| 2058 | ) | 1995 | ) |
| 2059 | ;; There never will be a funcall... | 1996 | ;; There never will be a funcall... |
| @@ -2166,7 +2103,8 @@ is memorized for faster future use." | |||
| 2166 | ;; Make sure the method tables are installed. | 2103 | ;; Make sure the method tables are installed. |
| 2167 | (eieiomt-install method) | 2104 | (eieiomt-install method) |
| 2168 | ;; Apply the actual body of this function. | 2105 | ;; Apply the actual body of this function. |
| 2169 | (fset method (eieio-defgeneric-form method doc-string)) | 2106 | (put method 'function-documentation doc-string) |
| 2107 | (fset method (eieio-defgeneric-form method)) | ||
| 2170 | ;; Return the method | 2108 | ;; Return the method |
| 2171 | 'method)) | 2109 | 'method)) |
| 2172 | (make-obsolete 'eieio-defgeneric nil "24.1") | 2110 | (make-obsolete 'eieio-defgeneric nil "24.1") |
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index df153eefd0e..2c9603c38c1 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; eieio-custom.el -- eieio object customization | 1 | ;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999-2001, 2005, 2007-2014 Free Software Foundation, | 3 | ;; Copyright (C) 1999-2001, 2005, 2007-2014 Free Software Foundation, |
| 4 | ;; Inc. | 4 | ;; Inc. |
| @@ -136,7 +136,7 @@ Updates occur regardless of the current customization group.") | |||
| 136 | )) | 136 | )) |
| 137 | (widget-value-set vc (widget-value vc)))) | 137 | (widget-value-set vc (widget-value vc)))) |
| 138 | 138 | ||
| 139 | (defun eieio-custom-toggle-parent (widget &rest ignore) | 139 | (defun eieio-custom-toggle-parent (widget &rest _) |
| 140 | "Toggle visibility of parent of WIDGET. | 140 | "Toggle visibility of parent of WIDGET. |
| 141 | Optional argument IGNORE is an extraneous parameter." | 141 | Optional argument IGNORE is an extraneous parameter." |
| 142 | (eieio-custom-toggle-hide (widget-get widget :parent))) | 142 | (eieio-custom-toggle-hide (widget-get widget :parent))) |
| @@ -154,7 +154,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 154 | :clone-object-children nil | 154 | :clone-object-children nil |
| 155 | ) | 155 | ) |
| 156 | 156 | ||
| 157 | (defun eieio-object-match (widget value) | 157 | (defun eieio-object-match (_widget _value) |
| 158 | "Match info for WIDGET against VALUE." | 158 | "Match info for WIDGET against VALUE." |
| 159 | ;; Write me | 159 | ;; Write me |
| 160 | t) | 160 | t) |
| @@ -216,7 +216,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 216 | (widget-insert "*" (capitalize (symbol-name master-group)) "*") | 216 | (widget-insert "*" (capitalize (symbol-name master-group)) "*") |
| 217 | (widget-create 'push-button | 217 | (widget-create 'push-button |
| 218 | :thing (cons obj (car groups)) | 218 | :thing (cons obj (car groups)) |
| 219 | :notify (lambda (widget &rest stuff) | 219 | :notify (lambda (widget &rest _) |
| 220 | (eieio-customize-object | 220 | (eieio-customize-object |
| 221 | (car (widget-get widget :thing)) | 221 | (car (widget-get widget :thing)) |
| 222 | (cdr (widget-get widget :thing)))) | 222 | (cdr (widget-get widget :thing)))) |
| @@ -389,14 +389,14 @@ These groups are specified with the `:group' slot flag." | |||
| 389 | "Insert an Apply and Reset button into the object editor. | 389 | "Insert an Apply and Reset button into the object editor. |
| 390 | Argument OBJ is the object being customized." | 390 | Argument OBJ is the object being customized." |
| 391 | (widget-create 'push-button | 391 | (widget-create 'push-button |
| 392 | :notify (lambda (&rest ignore) | 392 | :notify (lambda (&rest _) |
| 393 | (widget-apply eieio-wo :value-get) | 393 | (widget-apply eieio-wo :value-get) |
| 394 | (eieio-done-customizing eieio-co) | 394 | (eieio-done-customizing eieio-co) |
| 395 | (bury-buffer)) | 395 | (bury-buffer)) |
| 396 | "Accept") | 396 | "Accept") |
| 397 | (widget-insert " ") | 397 | (widget-insert " ") |
| 398 | (widget-create 'push-button | 398 | (widget-create 'push-button |
| 399 | :notify (lambda (&rest ignore) | 399 | :notify (lambda (&rest _) |
| 400 | ;; I think the act of getting it sets | 400 | ;; I think the act of getting it sets |
| 401 | ;; its value through the get function. | 401 | ;; its value through the get function. |
| 402 | (message "Applying Changes...") | 402 | (message "Applying Changes...") |
| @@ -406,13 +406,13 @@ Argument OBJ is the object being customized." | |||
| 406 | "Apply") | 406 | "Apply") |
| 407 | (widget-insert " ") | 407 | (widget-insert " ") |
| 408 | (widget-create 'push-button | 408 | (widget-create 'push-button |
| 409 | :notify (lambda (&rest ignore) | 409 | :notify (lambda (&rest _) |
| 410 | (message "Resetting") | 410 | (message "Resetting") |
| 411 | (eieio-customize-object eieio-co eieio-cog)) | 411 | (eieio-customize-object eieio-co eieio-cog)) |
| 412 | "Reset") | 412 | "Reset") |
| 413 | (widget-insert " ") | 413 | (widget-insert " ") |
| 414 | (widget-create 'push-button | 414 | (widget-create 'push-button |
| 415 | :notify (lambda (&rest ignore) | 415 | :notify (lambda (&rest _) |
| 416 | (bury-buffer)) | 416 | (bury-buffer)) |
| 417 | "Cancel")) | 417 | "Cancel")) |
| 418 | 418 | ||
| @@ -431,13 +431,11 @@ Must return the created widget." | |||
| 431 | :clone-object-children t | 431 | :clone-object-children t |
| 432 | ) | 432 | ) |
| 433 | 433 | ||
| 434 | (defun eieio-object-value-to-abstract (widget value) | 434 | (defun eieio-object-value-to-abstract (_widget value) |
| 435 | "For WIDGET, convert VALUE to an abstract /safe/ representation." | 435 | "For WIDGET, convert VALUE to an abstract /safe/ representation." |
| 436 | (if (eieio-object-p value) value | 436 | (if (eieio-object-p value) value)) |
| 437 | (if (null value) value | ||
| 438 | nil))) | ||
| 439 | 437 | ||
| 440 | (defun eieio-object-abstract-to-value (widget value) | 438 | (defun eieio-object-abstract-to-value (_widget value) |
| 441 | "For WIDGET, convert VALUE from an abstract /safe/ representation." | 439 | "For WIDGET, convert VALUE from an abstract /safe/ representation." |
| 442 | value) | 440 | value) |
| 443 | 441 | ||
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index ae29c3fbe90..55d4d5dcea9 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. | 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-2014 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -137,7 +137,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." | |||
| 137 | (data | 137 | (data |
| 138 | (catch 'moose (eieio-generic-call | 138 | (catch 'moose (eieio-generic-call |
| 139 | method (list class)))) | 139 | method (list class)))) |
| 140 | (buf (data-debug-new-buffer "*Method Invocation*")) | 140 | (_buf (data-debug-new-buffer "*Method Invocation*")) |
| 141 | (data2 (mapcar (lambda (sym) | 141 | (data2 (mapcar (lambda (sym) |
| 142 | (symbol-function (car sym))) | 142 | (symbol-function (car sym))) |
| 143 | data))) | 143 | data))) |
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 6f1d01c211f..86a17a17b7a 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el | |||
| @@ -218,11 +218,10 @@ Outputs to the current buffer." | |||
| 218 | (defun eieio-build-class-list (class) | 218 | (defun eieio-build-class-list (class) |
| 219 | "Return a list of all classes that inherit from CLASS." | 219 | "Return a list of all classes that inherit from CLASS." |
| 220 | (if (class-p class) | 220 | (if (class-p class) |
| 221 | (apply #'append | 221 | (cl-mapcan |
| 222 | (mapcar | 222 | (lambda (c) |
| 223 | (lambda (c) | 223 | (append (list c) (eieio-build-class-list c))) |
| 224 | (append (list c) (eieio-build-class-list c))) | 224 | (eieio-class-children-fast class)) |
| 225 | (eieio-class-children-fast class))) | ||
| 226 | (list class))) | 225 | (list class))) |
| 227 | 226 | ||
| 228 | (defun eieio-build-class-alist (&optional class instantiable-only buildlist) | 227 | (defun eieio-build-class-alist (&optional class instantiable-only buildlist) |
| @@ -235,11 +234,12 @@ Optional argument BUILDLIST is more list to attach and is used internally." | |||
| 235 | (sublst (eieio--class-children (class-v cc)))) | 234 | (sublst (eieio--class-children (class-v cc)))) |
| 236 | (unless (assoc (symbol-name cc) buildlist) | 235 | (unless (assoc (symbol-name cc) buildlist) |
| 237 | (when (or (not instantiable-only) (not (class-abstract-p cc))) | 236 | (when (or (not instantiable-only) (not (class-abstract-p cc))) |
| 237 | ;; FIXME: Completion tables don't need alists, and ede/generic.el needs | ||
| 238 | ;; the symbols rather than their names. | ||
| 238 | (setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))) | 239 | (setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))) |
| 239 | (while sublst | 240 | (dolist (elem sublst) |
| 240 | (setq buildlist (eieio-build-class-alist | 241 | (setq buildlist (eieio-build-class-alist |
| 241 | (car sublst) instantiable-only buildlist)) | 242 | elem instantiable-only buildlist))) |
| 242 | (setq sublst (cdr sublst))) | ||
| 243 | buildlist)) | 243 | buildlist)) |
| 244 | 244 | ||
| 245 | (defvar eieio-read-class nil | 245 | (defvar eieio-read-class nil |
| @@ -378,51 +378,47 @@ are not abstract." | |||
| 378 | "Return a list of all generic functions. | 378 | "Return a list of all generic functions. |
| 379 | Optional CLASS argument returns only those functions that contain | 379 | Optional CLASS argument returns only those functions that contain |
| 380 | methods for CLASS." | 380 | methods for CLASS." |
| 381 | (let ((l nil) tree (cn (if class (symbol-name class) nil))) | 381 | (let ((l nil)) |
| 382 | (mapatoms | 382 | (mapatoms |
| 383 | (lambda (symbol) | 383 | (lambda (symbol) |
| 384 | (setq tree (get symbol 'eieio-method-obarray)) | 384 | (let ((tree (get symbol 'eieio-method-hashtable))) |
| 385 | (if tree | 385 | (when tree |
| 386 | (progn | 386 | ;; A symbol might be interned for that class in one of |
| 387 | ;; A symbol might be interned for that class in one of | 387 | ;; these three slots in the method-obarray. |
| 388 | ;; these three slots in the method-obarray. | 388 | (if (or (not class) |
| 389 | (if (or (not class) | 389 | (car (gethash class (aref tree 0))) |
| 390 | (fboundp (intern-soft cn (aref tree 0))) | 390 | (car (gethash class (aref tree 1))) |
| 391 | (fboundp (intern-soft cn (aref tree 1))) | 391 | (car (gethash class (aref tree 2)))) |
| 392 | (fboundp (intern-soft cn (aref tree 2)))) | 392 | (setq l (cons symbol l))))))) |
| 393 | (setq l (cons symbol l))))))) | ||
| 394 | l)) | 393 | l)) |
| 395 | 394 | ||
| 396 | (defun eieio-method-documentation (generic class) | 395 | (defun eieio-method-documentation (generic class) |
| 397 | "Return a list of the specific documentation of GENERIC for CLASS. | 396 | "Return a list of the specific documentation of GENERIC for CLASS. |
| 398 | If there is not an explicit method for CLASS in GENERIC, or if that | 397 | If there is not an explicit method for CLASS in GENERIC, or if that |
| 399 | function has no documentation, then return nil." | 398 | function has no documentation, then return nil." |
| 400 | (let ((tree (get generic 'eieio-method-obarray)) | 399 | (let ((tree (get generic 'eieio-method-hashtable))) |
| 401 | (cn (symbol-name class)) | 400 | (when tree |
| 402 | before primary after) | ||
| 403 | (if (not tree) | ||
| 404 | nil | ||
| 405 | ;; A symbol might be interned for that class in one of | 401 | ;; A symbol might be interned for that class in one of |
| 406 | ;; these three slots in the method-obarray. | 402 | ;; these three slots in the method-hashtable. |
| 407 | (setq before (intern-soft cn (aref tree 0)) | 403 | ;; FIXME: Where do these 0/1/2 come from? Isn't 0 for :static, |
| 408 | primary (intern-soft cn (aref tree 1)) | 404 | ;; 1 for before, and 2 for primary (and 3 for after)? |
| 409 | after (intern-soft cn (aref tree 2))) | 405 | (let ((before (car (gethash class (aref tree 0)))) |
| 410 | (if (not (or (fboundp before) | 406 | (primary (car (gethash class (aref tree 1)))) |
| 411 | (fboundp primary) | 407 | (after (car (gethash class (aref tree 2))))) |
| 412 | (fboundp after))) | 408 | (if (not (or before primary after)) |
| 413 | nil | 409 | nil |
| 414 | (list (if (fboundp before) | 410 | (list (if before |
| 415 | (cons (help-function-arglist before) | 411 | (cons (help-function-arglist before) |
| 416 | (documentation before)) | 412 | (documentation before)) |
| 417 | nil) | 413 | nil) |
| 418 | (if (fboundp primary) | 414 | (if primary |
| 419 | (cons (help-function-arglist primary) | 415 | (cons (help-function-arglist primary) |
| 420 | (documentation primary)) | 416 | (documentation primary)) |
| 421 | nil) | 417 | nil) |
| 422 | (if (fboundp after) | 418 | (if after |
| 423 | (cons (help-function-arglist after) | 419 | (cons (help-function-arglist after) |
| 424 | (documentation after)) | 420 | (documentation after)) |
| 425 | nil)))))) | 421 | nil))))))) |
| 426 | 422 | ||
| 427 | (defvar eieio-read-generic nil | 423 | (defvar eieio-read-generic nil |
| 428 | "History of the `eieio-read-generic' prompt.") | 424 | "History of the `eieio-read-generic' prompt.") |
| @@ -627,7 +623,7 @@ Optional argument HISTORYVAR is the variable to use as history." | |||
| 627 | () | 623 | () |
| 628 | "Menu part in easymenu format used in speedbar while in `eieio' mode.") | 624 | "Menu part in easymenu format used in speedbar while in `eieio' mode.") |
| 629 | 625 | ||
| 630 | (defun eieio-class-speedbar (dir-or-object depth) | 626 | (defun eieio-class-speedbar (_dir-or-object _depth) |
| 631 | "Create buttons in speedbar that represents the current project. | 627 | "Create buttons in speedbar that represents the current project. |
| 632 | DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the | 628 | DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the |
| 633 | current expansion depth." | 629 | current expansion depth." |
| @@ -676,7 +672,7 @@ Argument INDENT is the depth of indentation." | |||
| 676 | (t (error "Ooops... not sure what to do"))) | 672 | (t (error "Ooops... not sure what to do"))) |
| 677 | (speedbar-center-buffer-smartly)) | 673 | (speedbar-center-buffer-smartly)) |
| 678 | 674 | ||
| 679 | (defun eieio-describe-class-sb (text token indent) | 675 | (defun eieio-describe-class-sb (_text token _indent) |
| 680 | "Describe the class TEXT in TOKEN. | 676 | "Describe the class TEXT in TOKEN. |
| 681 | INDENT is the current indentation level." | 677 | INDENT is the current indentation level." |
| 682 | (dframe-with-attached-buffer | 678 | (dframe-with-attached-buffer |
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index c8330d5b695..93688ba4e3a 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el | |||
| @@ -343,12 +343,15 @@ The CLOS function `class-direct-subclasses' is aliased to this function." | |||
| 343 | "Return non-nil if CHILD class is a subclass of CLASS." | 343 | "Return non-nil if CHILD class is a subclass of CLASS." |
| 344 | (eieio--check-type class-p class) | 344 | (eieio--check-type class-p class) |
| 345 | (eieio--check-type class-p child) | 345 | (eieio--check-type class-p child) |
| 346 | (let ((p nil)) | 346 | ;; `eieio-default-superclass' is never mentioned in eieio--class-parent, |
| 347 | (while (and child (not (eq child class))) | 347 | ;; so we have to special case it here. |
| 348 | (setq p (append p (eieio--class-parent (class-v child))) | 348 | (or (eq class 'eieio-default-superclass) |
| 349 | child (car p) | 349 | (let ((p nil)) |
| 350 | p (cdr p))) | 350 | (while (and child (not (eq child class))) |
| 351 | (if child t))) | 351 | (setq p (append p (eieio--class-parent (class-v child))) |
| 352 | child (car p) | ||
| 353 | p (cdr p))) | ||
| 354 | (if child t)))) | ||
| 352 | 355 | ||
| 353 | (defun object-slots (obj) | 356 | (defun object-slots (obj) |
| 354 | "Return list of slots available in OBJ." | 357 | "Return list of slots available in OBJ." |
| @@ -906,7 +909,7 @@ Optional argument GROUP is the sub-group of slots to display. | |||
| 906 | 909 | ||
| 907 | ;;;*** | 910 | ;;;*** |
| 908 | 911 | ||
| 909 | ;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "889c0a935dddf758dbb65488470ffa06") | 912 | ;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "e50a67ebd0c6258c615e4bf16714e81f") |
| 910 | ;;; Generated autoloads from eieio-opt.el | 913 | ;;; Generated autoloads from eieio-opt.el |
| 911 | 914 | ||
| 912 | (autoload 'eieio-browse "eieio-opt" "\ | 915 | (autoload 'eieio-browse "eieio-opt" "\ |
diff --git a/test/ChangeLog b/test/ChangeLog index 7d23b3efe1c..bcc619a7f97 100644 --- a/test/ChangeLog +++ b/test/ChangeLog | |||
| @@ -1,3 +1,11 @@ | |||
| 1 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * automated/eieio-test-methodinvoke.el (eieio-test-method-store): | ||
| 4 | Remove use of eieio-generic-call-methodname. | ||
| 5 | (eieio-test-method-order-list-3, eieio-test-method-order-list-6) | ||
| 6 | (eieio-test-method-order-list-7, eieio-test-method-order-list-8): | ||
| 7 | Adjust the expected result accordingly. | ||
| 8 | |||
| 1 | 2014-12-19 Artur Malabarba <bruce.connor.am@gmail.com> | 9 | 2014-12-19 Artur Malabarba <bruce.connor.am@gmail.com> |
| 2 | 10 | ||
| 3 | * automated/let-alist.el: require `cl-lib' | 11 | * automated/let-alist.el: require `cl-lib' |
| @@ -27,8 +35,8 @@ | |||
| 27 | (vc-test--create-repo-function): Rename from | 35 | (vc-test--create-repo-function): Rename from |
| 28 | `vc-test--create-repo-if-not-supported'. Adapt all callees. | 36 | `vc-test--create-repo-if-not-supported'. Adapt all callees. |
| 29 | (vc-test--create-repo): Check also for revision-granularity. | 37 | (vc-test--create-repo): Check also for revision-granularity. |
| 30 | (vc-test--unregister-function): Additional argument FILE. Adapt | 38 | (vc-test--unregister-function): Additional argument FILE. |
| 31 | all callees. | 39 | Adapt all callees. |
| 32 | (vc-test--working-revision): New defun. | 40 | (vc-test--working-revision): New defun. |
| 33 | (vc-test-*-working-revision): New tests. | 41 | (vc-test-*-working-revision): New tests. |
| 34 | 42 | ||
| @@ -65,7 +73,7 @@ | |||
| 65 | 2014-11-21 Ulf Jasper <ulf.jasper@web.de> | 73 | 2014-11-21 Ulf Jasper <ulf.jasper@web.de> |
| 66 | 74 | ||
| 67 | * automated/libxml-tests.el | 75 | * automated/libxml-tests.el |
| 68 | (libxml-tests--data-comments-preserved): Renamed from | 76 | (libxml-tests--data-comments-preserved): Rename from |
| 69 | 'libxml-tests--data'. | 77 | 'libxml-tests--data'. |
| 70 | (libxml-tests--data-comments-discarded): New. | 78 | (libxml-tests--data-comments-discarded): New. |
| 71 | (libxml-tests): Check whether 'libxml-parse-xml-region' is | 79 | (libxml-tests): Check whether 'libxml-parse-xml-region' is |
| @@ -92,8 +100,8 @@ | |||
| 92 | 100 | ||
| 93 | 2014-11-17 Ulf Jasper <ulf.jasper@web.de> | 101 | 2014-11-17 Ulf Jasper <ulf.jasper@web.de> |
| 94 | 102 | ||
| 95 | * automated/icalendar-tests.el (icalendar-tests--test-export): New | 103 | * automated/icalendar-tests.el (icalendar-tests--test-export): |
| 96 | optional parameter `alarms'. | 104 | New optional parameter `alarms'. |
| 97 | (icalendar-export-alarms): New test for exporting icalendar | 105 | (icalendar-export-alarms): New test for exporting icalendar |
| 98 | alarms. | 106 | alarms. |
| 99 | (icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil. | 107 | (icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil. |
| @@ -107,8 +115,8 @@ | |||
| 107 | 115 | ||
| 108 | 2014-11-16 Ulf Jasper <ulf.jasper@web.de> | 116 | 2014-11-16 Ulf Jasper <ulf.jasper@web.de> |
| 109 | 117 | ||
| 110 | * automated/icalendar-tests.el (icalendar--parse-vtimezone): Add | 118 | * automated/icalendar-tests.el (icalendar--parse-vtimezone): |
| 111 | testcase where offsets of standard time and daylight saving time | 119 | Add testcase where offsets of standard time and daylight saving time |
| 112 | are equal. | 120 | are equal. |
| 113 | (icalendar-real-world): Fix error in test case. Expected result | 121 | (icalendar-real-world): Fix error in test case. Expected result |
| 114 | was wrong when offsets of standard time and daylight saving time | 122 | was wrong when offsets of standard time and daylight saving time |
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el index 0b0dd5d2465..20b47a771d8 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/automated/eieio-test-methodinvoke.el | |||
| @@ -61,9 +61,8 @@ | |||
| 61 | "Store current invocation class symbol in the invocation order list." | 61 | "Store current invocation class symbol in the invocation order list." |
| 62 | (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ] | 62 | (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ] |
| 63 | (or eieio-generic-call-key 0))) | 63 | (or eieio-generic-call-key 0))) |
| 64 | (c (list eieio-generic-call-methodname keysym (eieio--scoped-class)))) | 64 | (c (list keysym (eieio--scoped-class)))) |
| 65 | (setq eieio-test-method-order-list | 65 | (push c eieio-test-method-order-list))) |
| 66 | (cons c eieio-test-method-order-list)))) | ||
| 67 | 66 | ||
| 68 | (defun eieio-test-match (rightanswer) | 67 | (defun eieio-test-match (rightanswer) |
| 69 | "Do a test match." | 68 | "Do a test match." |
| @@ -120,17 +119,17 @@ | |||
| 120 | (ert-deftest eieio-test-method-order-list-3 () | 119 | (ert-deftest eieio-test-method-order-list-3 () |
| 121 | (let ((eieio-test-method-order-list nil) | 120 | (let ((eieio-test-method-order-list nil) |
| 122 | (ans '( | 121 | (ans '( |
| 123 | (eitest-F :BEFORE eitest-B) | 122 | (:BEFORE eitest-B) |
| 124 | (eitest-F :BEFORE eitest-B-base1) | 123 | (:BEFORE eitest-B-base1) |
| 125 | (eitest-F :BEFORE eitest-B-base2) | 124 | (:BEFORE eitest-B-base2) |
| 126 | 125 | ||
| 127 | (eitest-F :PRIMARY eitest-B) | 126 | (:PRIMARY eitest-B) |
| 128 | (eitest-F :PRIMARY eitest-B-base1) | 127 | (:PRIMARY eitest-B-base1) |
| 129 | (eitest-F :PRIMARY eitest-B-base2) | 128 | (:PRIMARY eitest-B-base2) |
| 130 | 129 | ||
| 131 | (eitest-F :AFTER eitest-B-base2) | 130 | (:AFTER eitest-B-base2) |
| 132 | (eitest-F :AFTER eitest-B-base1) | 131 | (:AFTER eitest-B-base1) |
| 133 | (eitest-F :AFTER eitest-B) | 132 | (:AFTER eitest-B) |
| 134 | ))) | 133 | ))) |
| 135 | (eitest-F (eitest-B nil)) | 134 | (eitest-F (eitest-B nil)) |
| 136 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) | 135 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) |
| @@ -193,9 +192,9 @@ | |||
| 193 | (ert-deftest eieio-test-method-order-list-6 () | 192 | (ert-deftest eieio-test-method-order-list-6 () |
| 194 | (let ((eieio-test-method-order-list nil) | 193 | (let ((eieio-test-method-order-list nil) |
| 195 | (ans '( | 194 | (ans '( |
| 196 | (constructor :STATIC C) | 195 | (:STATIC C) |
| 197 | (constructor :STATIC C-base1) | 196 | (:STATIC C-base1) |
| 198 | (constructor :STATIC C-base2) | 197 | (:STATIC C-base2) |
| 199 | ))) | 198 | ))) |
| 200 | (C nil) | 199 | (C nil) |
| 201 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) | 200 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) |
| @@ -238,10 +237,10 @@ | |||
| 238 | (ert-deftest eieio-test-method-order-list-7 () | 237 | (ert-deftest eieio-test-method-order-list-7 () |
| 239 | (let ((eieio-test-method-order-list nil) | 238 | (let ((eieio-test-method-order-list nil) |
| 240 | (ans '( | 239 | (ans '( |
| 241 | (eitest-F :PRIMARY D) | 240 | (:PRIMARY D) |
| 242 | (eitest-F :PRIMARY D-base1) | 241 | (:PRIMARY D-base1) |
| 243 | ;; (eitest-F :PRIMARY D-base2) | 242 | ;; (:PRIMARY D-base2) |
| 244 | (eitest-F :PRIMARY D-base0) | 243 | (:PRIMARY D-base0) |
| 245 | ))) | 244 | ))) |
| 246 | (eitest-F (D nil)) | 245 | (eitest-F (D nil)) |
| 247 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) | 246 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) |
| @@ -277,10 +276,10 @@ | |||
| 277 | (ert-deftest eieio-test-method-order-list-8 () | 276 | (ert-deftest eieio-test-method-order-list-8 () |
| 278 | (let ((eieio-test-method-order-list nil) | 277 | (let ((eieio-test-method-order-list nil) |
| 279 | (ans '( | 278 | (ans '( |
| 280 | (eitest-F :PRIMARY E) | 279 | (:PRIMARY E) |
| 281 | (eitest-F :PRIMARY E-base1) | 280 | (:PRIMARY E-base1) |
| 282 | (eitest-F :PRIMARY E-base2) | 281 | (:PRIMARY E-base2) |
| 283 | (eitest-F :PRIMARY E-base0) | 282 | (:PRIMARY E-base0) |
| 284 | ))) | 283 | ))) |
| 285 | (eitest-F (E nil)) | 284 | (eitest-F (E nil)) |
| 286 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) | 285 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) |