aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-12-22 15:13:02 -0500
committerStefan Monnier2014-12-22 15:13:02 -0500
commitbcebc831bb9c1fd82b4693e6a091a4cf591dc3ec (patch)
tree1fe8d3bf282f4cc676396aec6f4b02424a8b01f0
parentb11d8924b565bd96939537b10a70bb3c26532bed (diff)
downloademacs-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/ChangeLog48
-rw-r--r--lisp/emacs-lisp/eieio-base.el10
-rw-r--r--lisp/emacs-lisp/eieio-core.el498
-rw-r--r--lisp/emacs-lisp/eieio-custom.el24
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el4
-rw-r--r--lisp/emacs-lisp/eieio-opt.el88
-rw-r--r--lisp/emacs-lisp/eieio.el17
-rw-r--r--test/ChangeLog22
-rw-r--r--test/automated/eieio-test-methodinvoke.el45
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 @@
12014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> 12014-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
412014-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.
379If no class is referenced there, then return nil." 379If 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.")
166Stored outright without modifications or stripping."))) 166Stored 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.
242Only methods have the symbol `eieio-method-obarray' as a property 242Only 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.
248Only methods have the symbol `eieio-method-obarray' as a property (which 248Only methods have the symbol `eieio-method-hashtable' as a property (which
249contains a list of all bindings to that method type.) 249contains a list of all bindings to that method type.)
250Methods with only primary implementations are executed in an optimized way." 250Methods 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.
264Only methods have the symbol `eieio-method-obarray' as a property (which 264Only methods have the symbol `eieio-method-hashtable' as a property (which
265contains a list of all bindings to that method type.) 265contains a list of all bindings to that method type.)
266Methods with only primary implementations are executed in an optimized way." 266Methods 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.
1133All methods should call the same EIEIO function for dispatch. 1103All methods should call the same EIEIO function for dispatch.
1134DOC-STRING is the documentation attached to METHOD." 1104DOC-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.
1146All methods should call the same EIEIO function for dispatch. 1116All methods should call the same EIEIO function for dispatch.
1147DOC-STRING is the documentation attached to METHOD." 1117DOC-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.
1133Keys 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'.
1136During executions, the list is first generated, then as each next method
1137is 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.
1164All methods should call the same EIEIO function for dispatch. 1141All methods should call the same EIEIO function for dispatch.
1165DOC-STRING is the documentation attached to METHOD.
1166CLASS is the class symbol needed for private method access. 1142CLASS is the class symbol needed for private method access.
1167IMPL is the symbol holding the method implementation." 1143IMPL 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.
1224It will leave the original generic function in place, 1184It will leave the original generic function in place,
1225but remove reference to all implementations of METHOD." 1185but 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.
1455If SLOT is the value created with :initarg instead, 1414If SLOT is the value created with :initarg instead,
1456reverse-lookup that name, and recurse with the associated slot value." 1415reverse-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.
1660Keys 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'.
1663During executions, the list is first generated, then as each next method
1664is 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.
1937Do not do the work if they already exist." 1882Do 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
2027no form, but has a parent class, then trace to that parent class. 1964no form, but has a parent class, then trace to that parent class.
2028The first time a form is requested from a symbol, an optimized path 1965The first time a form is requested from a symbol, an optimized path
2029is memorized for faster future use." 1966is 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.
141Optional argument IGNORE is an extraneous parameter." 141Optional 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.
390Argument OBJ is the object being customized." 390Argument 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.
379Optional CLASS argument returns only those functions that contain 379Optional CLASS argument returns only those functions that contain
380methods for CLASS." 380methods 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.
398If there is not an explicit method for CLASS in GENERIC, or if that 397If there is not an explicit method for CLASS in GENERIC, or if that
399function has no documentation, then return nil." 398function 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.
632DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the 628DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the
633current expansion depth." 629current 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.
681INDENT is the current indentation level." 677INDENT 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 @@
12014-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
12014-12-19 Artur Malabarba <bruce.connor.am@gmail.com> 92014-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 @@
652014-11-21 Ulf Jasper <ulf.jasper@web.de> 732014-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
932014-11-17 Ulf Jasper <ulf.jasper@web.de> 1012014-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
1082014-11-16 Ulf Jasper <ulf.jasper@web.de> 1162014-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))