[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master bcebc83 1/9: * lisp/emacs-lisp/eieio*.el: Use hasht
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master bcebc83 1/9: * lisp/emacs-lisp/eieio*.el: Use hashtables rather than obarrays |
|
Date: |
Thu, 08 Jan 2015 21:04:26 +0000 |
branch: master
commit bcebc831bb9c1fd82b4693e6a091a4cf591dc3ec
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* 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 $.
---
lisp/ChangeLog | 48 +++-
lisp/emacs-lisp/eieio-base.el | 10 +-
lisp/emacs-lisp/eieio-core.el | 498 +++++++++++++----------------
lisp/emacs-lisp/eieio-custom.el | 24 +-
lisp/emacs-lisp/eieio-datadebug.el | 4 +-
lisp/emacs-lisp/eieio-opt.el | 88 +++---
lisp/emacs-lisp/eieio.el | 17 +-
test/ChangeLog | 22 +-
test/automated/eieio-test-methodinvoke.el | 45 ++--
9 files changed, 369 insertions(+), 387 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d8bb1c8..c2f4584 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,45 @@
2014-12-22 Stefan Monnier <address@hidden>
+ * emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is
+ `eieio-default-superclass'.
+
+ * emacs-lisp/eieio-datadebug.el: Use lexical-binding.
+
+ * emacs-lisp/eieio-custom.el: Use lexical-binding.
+ (eieio-object-value-to-abstract): Simplify.
+
+ * 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.
+
+ * 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.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p):
+ Prefer \' to $.
+
+2014-12-22 Stefan Monnier <address@hidden>
+
* completion.el: Use post-self-insert-hook (bug#19400).
(completion-separator-self-insert-command)
(completion-separator-self-insert-autofilling): Remove.
@@ -95,8 +135,8 @@
* electric.el (Electric-pop-up-window):
* help.el (resize-temp-buffer-window): Call fit-window-to-buffer
with `preserve-size' t.
- * minibuffer.el (minibuffer-completion-help): Use
- `resize-temp-buffer-window' instead of `fit-window-to-buffer'
+ * minibuffer.el (minibuffer-completion-help):
+ Use `resize-temp-buffer-window' instead of `fit-window-to-buffer'
(Bug#19355). Preserve size of completions window.
* register.el (register-preview): Preserve size of register
preview window.
@@ -106,8 +146,8 @@
`window-preserve-size'.
(window-min-pixel-size, window--preservable-size)
(window-preserve-size, window-preserved-size)
- (window--preserve-size, window--min-size-ignore-p): New
- functions.
+ (window--preserve-size, window--min-size-ignore-p):
+ New functions.
(window-min-size, window-min-delta, window--resizable)
(window--resize-this-window, split-window-below)
(split-window-right): Amend doc-string.
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index a1c2cb5..4b8ccae 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."
)
(defun eieio-persistent-slot-type-is-class-p (type)
- "Return the class refered to in TYPE.
+ "Return the class referred to in TYPE.
If no class is referenced there, then return nil."
(cond ((class-p type)
;; If the type is a class, then return it.
type)
-
- ((and (symbolp type) (string-match "-child$" (symbol-name type))
+ ;; FIXME: foo-child should not be a valid type!
+ ((and (symbolp type) (string-match "-child\\'" (symbol-name type))
(class-p (intern-soft (substring (symbol-name type) 0
(match-beginning 0)))))
;; If it is the predicate ending with -child, then return
@@ -389,8 +389,8 @@ If no class is referenced there, then return nil."
;; class is the same as if we used -child, so no further work needed.
(intern-soft (substring (symbol-name type) 0
(match-beginning 0))))
-
- ((and (symbolp type) (string-match "-list$" (symbol-name type))
+ ;; FIXME: foo-list should not be a valid type!
+ ((and (symbolp type) (string-match "-list\\'" (symbol-name type))
(class-p (intern-soft (substring (symbol-name type) 0
(match-beginning 0)))))
;; 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 2897ce9..9ee6520 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -132,10 +132,10 @@ default setting for optimization purposes.")
(defconst ,(intern (format "eieio--%s-num-slots" prefix)) ,index))))
(eieio--define-field-accessors class
- (-unused-0 ;;FIXME: not sure, but at least there was no accessor!
+ (-unused-0 ;;Constant slot, set to `defclass'.
(symbol "symbol (self-referencing)")
parent children
- (symbol-obarray "obarray permitting fast access to variable position
indexes")
+ (symbol-hashtable "hashtable permitting fast access to variable position
indexes")
;; @todo
;; the word "public" here is leftovers from the very first version.
;; Get rid of it!
@@ -166,9 +166,9 @@ from the default.")
Stored outright without modifications or stripping.")))
(eieio--define-field-accessors object
- (-unused-0 ;;FIXME: not sure, but at least there was no accessor!
+ (-unused-0 ;;Constant slot, set to `object'.
(class "class struct defining OBJ")
- name))
+ name)) ;FIXME: Get rid of this field!
;; FIXME: The constants below should have an `eieio-' prefix added!!
@@ -239,41 +239,41 @@ CLASS is a symbol."
(defsubst generic-p (method)
"Return non-nil if symbol METHOD is a generic function.
-Only methods have the symbol `eieio-method-obarray' as a property
+Only methods have the symbol `eieio-method-hashtable' as a property
\(which contains a list of all bindings to that method type.)"
- (and (fboundp method) (get method 'eieio-method-obarray)))
+ (and (fboundp method) (get method 'eieio-method-hashtable)))
(defun generic-primary-only-p (method)
"Return t if symbol METHOD is a generic function with only primary methods.
-Only methods have the symbol `eieio-method-obarray' as a property (which
+Only methods have the symbol `eieio-method-hashtable' as a property (which
contains a list of all bindings to that method type.)
Methods with only primary implementations are executed in an optimized way."
(and (generic-p method)
(let ((M (get method 'eieio-method-tree)))
- (and (< 0 (length (aref M method-primary)))
- (not (aref M method-static))
- (not (aref M method-before))
- (not (aref M method-after))
- (not (aref M method-generic-before))
- (not (aref M method-generic-primary))
- (not (aref M method-generic-after))))
- ))
+ (not (or (>= 0 (length (aref M method-primary)))
+ (aref M method-static)
+ (aref M method-before)
+ (aref M method-after)
+ (aref M method-generic-before)
+ (aref M method-generic-primary)
+ (aref M method-generic-after)))
+ )))
(defun generic-primary-only-one-p (method)
"Return t if symbol METHOD is a generic function with only primary methods.
-Only methods have the symbol `eieio-method-obarray' as a property (which
+Only methods have the symbol `eieio-method-hashtable' as a property (which
contains a list of all bindings to that method type.)
Methods with only primary implementations are executed in an optimized way."
(and (generic-p method)
(let ((M (get method 'eieio-method-tree)))
- (and (= 1 (length (aref M method-primary)))
- (not (aref M method-static))
- (not (aref M method-before))
- (not (aref M method-after))
- (not (aref M method-generic-before))
- (not (aref M method-generic-primary))
- (not (aref M method-generic-after))))
- ))
+ (not (or (/= 1 (length (aref M method-primary)))
+ (aref M method-static)
+ (aref M method-before)
+ (aref M method-after)
+ (aref M method-generic-before)
+ (aref M method-generic-primary)
+ (aref M method-generic-after)))
+ )))
(defmacro class-option-assoc (list option)
"Return from LIST the found OPTION, or nil if it doesn't exist."
@@ -308,7 +308,7 @@ Abstract classes cannot be instantiated."
;;;
;; Class Creation
-(defvar eieio-defclass-autoload-map (make-vector 7 nil)
+(defvar eieio-defclass-autoload-map (make-hash-table)
"Symbol map of superclasses we find in autoloads.")
;; We autoload this because it's used in `make-autoload'.
@@ -348,25 +348,14 @@ It creates an autoload function for CNAME's constructor."
;; map needs to be cleared!
- ;; Does our parent exist?
- (if (not (class-p SC))
+ ;; Save the child in the parent.
+ (cl-pushnew cname (if (class-p SC)
+ (eieio--class-children (class-v SC))
+ ;; Parent doesn't exist yet.
+ (gethash SC eieio-defclass-autoload-map)))
- ;; Create a symbol for this parent, and then store this
- ;; parent on that symbol.
- (let ((sym (intern (symbol-name SC) eieio-defclass-autoload-map)))
- (if (not (boundp sym))
- (set sym (list cname))
- (add-to-list sym cname))
- )
-
- ;; We have a parent, save the child in there.
- (when (not (member cname (eieio--class-children (class-v SC))))
- (setf (eieio--class-children (class-v SC))
- (cons cname (eieio--class-children (class-v SC))))))
-
- ;; save parent in child
- (setf (eieio--class-parent newc) (cons SC (eieio--class-parent newc)))
- )
+ ;; Save parent in child.
+ (push SC (eieio--class-parent newc)))
;; turn this into a usable self-pointing symbol
(set cname cname)
@@ -390,8 +379,7 @@ It creates an autoload function for CNAME's constructor."
(defsubst eieio-class-un-autoload (cname)
"If class CNAME is in an autoload state, load its file."
- (when (eq (car-safe (symbol-function cname)) 'autoload)
- (load-library (car (cdr (symbol-function cname))))))
+ (autoload-do-load (symbol-function cname))) ; cname
(cl-deftype list-of (elem-type)
`(and list
@@ -430,16 +418,13 @@ See `defclass' for more information."
;; byte compiling an EIEIO file.
(if oldc
(setf (eieio--class-children newc) (eieio--class-children oldc))
- ;; If the old class did not exist, but did exist in the autoload map,
then adopt those children.
- ;; This is like the above, but deals with autoloads nicely.
- (let ((sym (intern-soft (symbol-name cname)
eieio-defclass-autoload-map)))
- (when sym
- (condition-case nil
- (setf (eieio--class-children newc) (symbol-value sym))
- (error nil))
- (unintern (symbol-name cname) eieio-defclass-autoload-map)
- ))
- )
+ ;; If the old class did not exist, but did exist in the autoload map,
+ ;; then adopt those children. This is like the above, but deals with
+ ;; autoloads nicely.
+ (let ((children (gethash cname eieio-defclass-autoload-map)))
+ (when children
+ (setf (eieio--class-children newc) children)
+ (remhash cname eieio-defclass-autoload-map))))
(cond ((and (stringp (car options-and-doc))
(/= 1 (% (length options-and-doc) 2)))
@@ -456,39 +441,35 @@ See `defclass' for more information."
(if pname
(progn
- (while pname
- (if (and (car pname) (symbolp (car pname)))
- (if (not (class-p (car pname)))
+ (dolist (p pname)
+ (if (and p (symbolp p))
+ (if (not (class-p p))
;; bad class
- (error "Given parent class %s is not a class" (car pname))
+ (error "Given parent class %S is not a class" p)
;; good parent class...
;; save new child in parent
- (when (not (member cname (eieio--class-children (class-v (car
pname)))))
- (setf (eieio--class-children (class-v (car pname)))
- (cons cname (eieio--class-children (class-v (car
pname))))))
+ (cl-pushnew cname (eieio--class-children (class-v p)))
;; Get custom groups, and store them into our local copy.
(mapc (lambda (g) (cl-pushnew g groups :test #'equal))
- (class-option (car pname) :custom-groups))
+ (class-option p :custom-groups))
;; save parent in child
- (setf (eieio--class-parent newc) (cons (car pname)
(eieio--class-parent newc))))
- (error "Invalid parent class %s" pname))
- (setq pname (cdr pname)))
+ (push p (eieio--class-parent newc)))
+ (error "Invalid parent class %S" p)))
;; Reverse the list of our parents so that they are prioritized in
;; the same order as specified in the code.
- (setf (eieio--class-parent newc) (nreverse (eieio--class-parent
newc))) )
+ (cl-callf nreverse (eieio--class-parent newc)))
;; If there is nothing to loop over, then inherit from the
;; default superclass.
(unless (eq cname 'eieio-default-superclass)
;; adopt the default parent here, but clear it later...
(setq clearparent t)
;; save new child in parent
- (if (not (member cname (eieio--class-children (class-v
'eieio-default-superclass))))
- (setf (eieio--class-children (class-v 'eieio-default-superclass))
- (cons cname (eieio--class-children (class-v
'eieio-default-superclass)))))
+ (cl-pushnew cname (eieio--class-children
+ (class-v 'eieio-default-superclass)))
;; save parent in child
- (setf (eieio--class-parent newc) (list eieio-default-superclass))))
+ (setf (eieio--class-parent newc) '(eieio-default-superclass))))
- ;; turn this into a usable self-pointing symbol
+ ;; turn this into a usable self-pointing symbol; FIXME: Why?
(set cname cname)
;; These two tests must be created right away so we can have self-
@@ -514,28 +495,11 @@ See `defclass' for more information."
(fset csym
`(lambda (obj)
,(format
- "Test OBJ to see if it an object is a child of type %s"
- cname)
+ "Test OBJ to see if it an object is a child of type %s"
+ cname)
(and (eieio-object-p obj)
(object-of-class-p obj ,cname))))
- ;; Create a handy list of the class test too
- (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
- (fset csym
- `(lambda (obj)
- ,(format
- "Test OBJ to see if it a list of objects which are a child of
type %s"
- cname)
- (when (listp obj)
- (let ((ans t)) ;; nil is valid
- ;; Loop over all the elements of the input list, test
- ;; each to make sure it is a child of the desired object
class.
- (while (and obj ans)
- (setq ans (and (eieio-object-p (car obj))
- (object-of-class-p (car obj) ,cname)))
- (setq obj (cdr obj)))
- ans)))))
-
;; When using typep, (typep OBJ 'myclass) returns t for objects which
;; are subclasses of myclass. For our predicates, however, it is
;; important for EIEIO to be backwards compatible, where
@@ -544,9 +508,24 @@ See `defclass' for more information."
;; test, so we can let typep have the CLOS documented behavior
;; while keeping our above predicate clean.
- ;; FIXME: It would be cleaner to use `cl-deftype' here.
- (put cname 'cl-deftype-handler
- (list 'lambda () `(list 'satisfies (quote ,csym)))))
+ (put cname 'cl-deftype-satisfies csym))
+
+ ;; Create a handy list of the class test too
+ (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
+ (fset csym
+ `(lambda (obj)
+ ,(format
+ "Test OBJ to see if it a list of objects which are a child of
type %s"
+ cname)
+ (when (listp obj)
+ (let ((ans t)) ;; nil is valid
+ ;; Loop over all the elements of the input list, test
+ ;; each to make sure it is a child of the desired object
class.
+ (while (and obj ans)
+ (setq ans (and (eieio-object-p (car obj))
+ (object-of-class-p (car obj) ,cname)))
+ (setq obj (cdr obj)))
+ ans)))))
;; Before adding new slots, let's add all the methods and classes
;; in from the parent class.
@@ -693,52 +672,41 @@ See `defclass' for more information."
;; Now that everything has been loaded up, all our lists are backwards!
;; Fix that up now.
- (setf (eieio--class-public-a newc) (nreverse (eieio--class-public-a newc)))
- (setf (eieio--class-public-d newc) (nreverse (eieio--class-public-d newc)))
- (setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc
newc)))
- (setf (eieio--class-public-type newc)
- (apply #'vector (nreverse (eieio--class-public-type newc))))
- (setf (eieio--class-public-custom newc) (nreverse
(eieio--class-public-custom newc)))
- (setf (eieio--class-public-custom-label newc) (nreverse
(eieio--class-public-custom-label newc)))
- (setf (eieio--class-public-custom-group newc) (nreverse
(eieio--class-public-custom-group newc)))
- (setf (eieio--class-public-printer newc) (nreverse
(eieio--class-public-printer newc)))
- (setf (eieio--class-protection newc) (nreverse (eieio--class-protection
newc)))
- (setf (eieio--class-initarg-tuples newc) (nreverse
(eieio--class-initarg-tuples newc)))
+ (cl-callf nreverse (eieio--class-public-a newc))
+ (cl-callf nreverse (eieio--class-public-d newc))
+ (cl-callf nreverse (eieio--class-public-doc newc))
+ (cl-callf (lambda (types) (apply #'vector (nreverse types)))
+ (eieio--class-public-type newc))
+ (cl-callf nreverse (eieio--class-public-custom newc))
+ (cl-callf nreverse (eieio--class-public-custom-label newc))
+ (cl-callf nreverse (eieio--class-public-custom-group newc))
+ (cl-callf nreverse (eieio--class-public-printer newc))
+ (cl-callf nreverse (eieio--class-protection newc))
+ (cl-callf nreverse (eieio--class-initarg-tuples newc))
;; The storage for class-class-allocation-type needs to be turned into
;; a vector now.
- (setf (eieio--class-class-allocation-type newc)
- (apply #'vector (eieio--class-class-allocation-type newc)))
+ (cl-callf (lambda (cat) (apply #'vector cat))
+ (eieio--class-class-allocation-type newc))
;; Also, take class allocated values, and vectorize them for speed.
- (setf (eieio--class-class-allocation-values newc)
- (apply #'vector (eieio--class-class-allocation-values newc)))
-
- ;; Attach slot symbols into an obarray, and store the index of
- ;; this slot as the variable slot in this new symbol. We need to
- ;; know about primes, because obarrays are best set in vectors of
- ;; prime number length, and we also need to make our vector small
- ;; to save space, and also optimal for the number of items we have.
+ (cl-callf (lambda (cavs) (apply #'vector cavs))
+ (eieio--class-class-allocation-values newc))
+
+ ;; Attach slot symbols into a hashtable, and store the index of
+ ;; this slot as the value this table.
(let* ((cnt 0)
(pubsyms (eieio--class-public-a newc))
(prots (eieio--class-protection newc))
- (l (length pubsyms))
- (vl (let ((primes '( 3 5 7 11 13 17 19 23 29 31 37 41 43 47
- 53 59 61 67 71 73 79 83 89 97 101 )))
- (while (and primes (< (car primes) l))
- (setq primes (cdr primes)))
- (car primes)))
- (oa (make-vector vl 0))
- (newsym))
+ (oa (make-hash-table :test #'eq)))
(while pubsyms
- (setq newsym (intern (symbol-name (car pubsyms)) oa))
- (set newsym cnt)
- (setq cnt (1+ cnt))
- (if (car prots) (put newsym 'protection (car prots)))
+ (let ((newsym (list cnt)))
+ (setf (gethash (car pubsyms) oa) newsym)
+ (setq cnt (1+ cnt))
+ (if (car prots) (setcdr newsym (car prots))))
(setq pubsyms (cdr pubsyms)
prots (cdr prots)))
- (setf (eieio--class-symbol-obarray newc) oa)
- )
+ (setf (eieio--class-symbol-hashtable newc) oa))
;; Create the constructor function
(if (class-option-assoc options :abstract)
@@ -787,7 +755,8 @@ See `defclass' for more information."
(if clearparent (setf (eieio--class-parent newc) nil))
;; Create the cached default object.
- (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) 3)
+ (let ((cache (make-vector (+ (length (eieio--class-public-a newc))
+ (eval-when-compile eieio--object-num-slots))
nil)))
(aset cache 0 'object)
(setf (eieio--object-class cache) cname)
@@ -1123,108 +1092,99 @@ the new child class."
;; Make sure the method tables are installed.
(eieiomt-install method)
;; Construct the actual body of this function.
- (eieio-defgeneric-form method doc-string))
+ (put method 'function-documentation doc-string)
+ (eieio-defgeneric-form method))
((generic-p method) (symbol-function method)) ;Leave it as-is.
(t (error "You cannot create a generic/method over an existing symbol: %s"
method))))
-(defun eieio-defgeneric-form (method doc-string)
+(defun eieio-defgeneric-form (method)
"The lambda form that would be used as the function defined on METHOD.
All methods should call the same EIEIO function for dispatch.
DOC-STRING is the documentation attached to METHOD."
- `(lambda (&rest local-args)
- ,doc-string
- (eieio-generic-call (quote ,method) local-args)))
+ (lambda (&rest local-args)
+ (eieio-generic-call method local-args)))
(defsubst eieio-defgeneric-reset-generic-form (method)
"Setup METHOD to call the generic form."
- (let ((doc-string (documentation method)))
- (fset method (eieio-defgeneric-form method doc-string))))
+ (let ((doc-string (documentation method 'raw)))
+ (put method 'function-documentation doc-string)
+ (fset method (eieio-defgeneric-form method))))
-(defun eieio-defgeneric-form-primary-only (method doc-string)
+(defun eieio-defgeneric-form-primary-only (method)
"The lambda form that would be used as the function defined on METHOD.
All methods should call the same EIEIO function for dispatch.
DOC-STRING is the documentation attached to METHOD."
- `(lambda (&rest local-args)
- ,doc-string
- (eieio-generic-call-primary-only (quote ,method) local-args)))
+ (lambda (&rest local-args)
+ (eieio-generic-call-primary-only method local-args)))
(defsubst eieio-defgeneric-reset-generic-form-primary-only (method)
"Setup METHOD to call the generic form."
- (let ((doc-string (documentation method)))
- (fset method (eieio-defgeneric-form-primary-only method doc-string))))
+ (let ((doc-string (documentation method 'raw)))
+ (put method 'function-documentation doc-string)
+ (fset method (eieio-defgeneric-form-primary-only method))))
(declare-function no-applicable-method "eieio" (object method &rest args))
-(defun eieio-defgeneric-form-primary-only-one (method doc-string
- class
- impl
- )
+(defvar eieio-generic-call-arglst nil
+ "When using `call-next-method', provides a context for parameters.")
+(defvar eieio-generic-call-key nil
+ "When using `call-next-method', provides a context for the current key.
+Keys are a number representing :before, :primary, and :after methods.")
+(defvar eieio-generic-call-next-method-list nil
+ "When executing a PRIMARY or STATIC method, track the 'next-method'.
+During executions, the list is first generated, then as each next method
+is called, the next method is popped off the stack.")
+
+(defun eieio-defgeneric-form-primary-only-one (method class impl)
"The lambda form that would be used as the function defined on METHOD.
All methods should call the same EIEIO function for dispatch.
-DOC-STRING is the documentation attached to METHOD.
CLASS is the class symbol needed for private method access.
IMPL is the symbol holding the method implementation."
- ;; NOTE: I tried out byte compiling this little fcn. Turns out it
- ;; is faster to execute this for not byte-compiled. ie, install this,
- ;; then measure calls going through here. I wonder why.
- (require 'bytecomp)
- (let ((byte-compile-warnings nil))
- (byte-compile
- `(lambda (&rest local-args)
- ,doc-string
- ;; This is a cool cheat. Usually we need to look up in the
- ;; method table to find out if there is a method or not. We can
- ;; instead make that determination at load time when there is
- ;; only one method. If the first arg is not a child of the class
- ;; of that one implementation, then clearly, there is no method def.
- (if (not (eieio-object-p (car local-args)))
- ;; Not an object. Just signal.
- (signal 'no-method-definition
- (list ',method local-args))
-
- ;; We do have an object. Make sure it is the right type.
- (if ,(if (eq class eieio-default-superclass)
- nil ; default superclass means just an obj. Already asked.
- `(not (child-of-class-p (eieio--object-class (car local-args))
- ',class)))
-
- ;; If not the right kind of object, call no applicable
- (apply #'no-applicable-method (car local-args)
- ',method local-args)
-
- ;; It is ok, do the call.
- ;; Fill in inter-call variables then evaluate the method.
- (let ((eieio-generic-call-next-method-list nil)
- (eieio-generic-call-key method-primary)
- (eieio-generic-call-methodname ',method)
- (eieio-generic-call-arglst local-args)
- )
- (eieio--with-scoped-class ',class
- ,(if (< emacs-major-version 24)
- `(apply ,(list 'quote impl) local-args)
- `(apply #',impl local-args)))
- ;(,impl local-args)
- )))))))
+ (lambda (&rest local-args)
+ ;; This is a cool cheat. Usually we need to look up in the
+ ;; method table to find out if there is a method or not. We can
+ ;; instead make that determination at load time when there is
+ ;; only one method. If the first arg is not a child of the class
+ ;; of that one implementation, then clearly, there is no method def.
+ (if (not (eieio-object-p (car local-args)))
+ ;; Not an object. Just signal.
+ (signal 'no-method-definition
+ (list method local-args))
+
+ ;; We do have an object. Make sure it is the right type.
+ (if (not (child-of-class-p (eieio--object-class (car local-args))
+ class))
+
+ ;; If not the right kind of object, call no applicable
+ (apply #'no-applicable-method (car local-args)
+ method local-args)
+
+ ;; It is ok, do the call.
+ ;; Fill in inter-call variables then evaluate the method.
+ (let ((eieio-generic-call-next-method-list nil)
+ (eieio-generic-call-key method-primary)
+ (eieio-generic-call-arglst local-args)
+ )
+ (eieio--with-scoped-class class
+ (apply impl local-args)))))))
(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
"Setup METHOD to call the generic form."
- (let* ((doc-string (documentation method))
+ (let* ((doc-string (documentation method 'raw))
(M (get method 'eieio-method-tree))
(entry (car (aref M method-primary)))
)
+ (put method 'function-documentation doc-string)
(fset method (eieio-defgeneric-form-primary-only-one
- method doc-string
- (car entry)
- (cdr entry)
- ))))
+ method (car entry) (cdr entry)))))
(defun eieio-unbind-method-implementations (method)
"Make the generic method METHOD have no implementations.
It will leave the original generic function in place,
but remove reference to all implementations of METHOD."
(put method 'eieio-method-tree nil)
- (put method 'eieio-method-obarray nil))
+ (put method 'eieio-method-hashtable nil))
(defun eieio--defmethod (method kind argclass code)
"Work part of the `defmethod' macro defining METHOD with ARGS."
@@ -1248,7 +1208,7 @@ but remove reference to all implementations of METHOD."
;; under the type `primary' which is a non-specific calling of the
;; function.
(if argclass
- (if (not (class-p argclass))
+ (if (not (class-p argclass)) ;FIXME: Accept cl-defstructs!
(error "Unknown class type %s in method parameters"
argclass))
;; Generics are higher.
@@ -1440,8 +1400,7 @@ so that we can protect private slots."
(if (not par)
t
(while (and par ret)
- (if (intern-soft (symbol-name slot)
- (eieio--class-symbol-obarray (class-v (car par))))
+ (if (gethash slot (eieio--class-symbol-hashtable (class-v (car par))))
(setq ret nil))
(setq par (cdr par)))
ret)))
@@ -1455,20 +1414,19 @@ scoped class.
If SLOT is the value created with :initarg instead,
reverse-lookup that name, and recurse with the associated slot value."
;; Removed checks to outside this call
- (let* ((fsym (intern-soft (symbol-name slot)
- (eieio--class-symbol-obarray (class-v class))))
- (fsi (if (symbolp fsym) (symbol-value fsym) nil)))
+ (let* ((fsym (gethash slot (eieio--class-symbol-hashtable (class-v class))))
+ (fsi (car fsym)))
(if (integerp fsi)
(cond
- ((not (get fsym 'protection))
+ ((not (cdr fsym))
(+ 3 fsi))
- ((and (eq (get fsym 'protection) 'protected)
+ ((and (eq (cdr fsym) 'protected)
(eieio--scoped-class)
(or (child-of-class-p class (eieio--scoped-class))
(and (eieio-object-p obj)
(child-of-class-p class (eieio--object-class obj)))))
(+ 3 fsi))
- ((and (eq (get fsym 'protection) 'private)
+ ((and (eq (cdr fsym) 'private)
(or (and (eieio--scoped-class)
(eieio-slot-originating-class-p (eieio--scoped-class)
slot))
eieio-initializing-object))
@@ -1651,17 +1609,6 @@ method invocation orders of the involved classes."
;;; CLOS generics internal function handling
;;
-(defvar eieio-generic-call-methodname nil
- "When using `call-next-method', provides a context on how to do it.")
-(defvar eieio-generic-call-arglst nil
- "When using `call-next-method', provides a context for parameters.")
-(defvar eieio-generic-call-key nil
- "When using `call-next-method', provides a context for the current key.
-Keys are a number representing :before, :primary, and :after methods.")
-(defvar eieio-generic-call-next-method-list nil
- "When executing a PRIMARY or STATIC method, track the 'next-method'.
-During executions, the list is first generated, then as each next method
-is called, the next method is popped off the stack.")
(define-obsolete-variable-alias 'eieio-pre-method-execution-hooks
'eieio-pre-method-execution-functions "24.3")
@@ -1677,7 +1624,6 @@ This should only be called from a generic function."
;; We must expand our arguments first as they are always
;; passed in as quoted symbols
(let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil)
- (eieio-generic-call-methodname method)
(eieio-generic-call-arglst args)
(firstarg nil)
(primarymethodlist nil))
@@ -1818,7 +1764,6 @@ for this common case to improve performance."
;; We must expand our arguments first as they are always
;; passed in as quoted symbols
(let ((newargs nil) (mclass nil) (lambdas nil)
- (eieio-generic-call-methodname method)
(eieio-generic-call-arglst args)
(firstarg nil)
(primarymethodlist nil)
@@ -1918,7 +1863,7 @@ If CLASS is nil, then an empty list of methods should be
returned."
;; (eieio-method-tree . [BEFORE PRIMARY AFTER
;; genericBEFORE genericPRIMARY genericAFTER])
;; and
-;; (eieio-method-obarray . [BEFORE PRIMARY AFTER
+;; (eieio-method-hashtable . [BEFORE PRIMARY AFTER
;; genericBEFORE genericPRIMARY genericAFTER])
;; where the association is a vector.
;; (aref 0 -- all static methods.
@@ -1929,25 +1874,22 @@ If CLASS is nil, then an empty list of methods should
be returned."
;; (aref 5 -- a generic classified as :primary
;; (aref 6 -- a generic classified as :after
;;
-(defvar eieiomt-optimizing-obarray nil
- "While mapping atoms, this contain the obarray being optimized.")
+(defvar eieiomt--optimizing-hashtable nil
+ "While mapping atoms, this contain the hashtable being optimized.")
(defun eieiomt-install (method-name)
- "Install the method tree, and obarray onto METHOD-NAME.
+ "Install the method tree, and hashtable onto METHOD-NAME.
Do not do the work if they already exist."
- (let ((emtv (get method-name 'eieio-method-tree))
- (emto (get method-name 'eieio-method-obarray)))
- (if (or (not emtv) (not emto))
- (progn
- (setq emtv (put method-name 'eieio-method-tree
- (make-vector method-num-slots nil))
- emto (put method-name 'eieio-method-obarray
- (make-vector method-num-slots nil)))
- (aset emto 0 (make-vector 11 0))
- (aset emto 1 (make-vector 11 0))
- (aset emto 2 (make-vector 41 0))
- (aset emto 3 (make-vector 11 0))
- ))))
+ (unless (and (get method-name 'eieio-method-tree)
+ (get method-name 'eieio-method-hashtable))
+ (put method-name 'eieio-method-tree
+ (make-vector method-num-slots nil))
+ (let ((emto (put method-name 'eieio-method-hashtable
+ (make-vector method-num-slots nil))))
+ (aset emto 0 (make-hash-table :test 'eq))
+ (aset emto 1 (make-hash-table :test 'eq))
+ (aset emto 2 (make-hash-table :test 'eq))
+ (aset emto 3 (make-hash-table :test 'eq)))))
(defun eieiomt-add (method-name method key class)
"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."
(if (or (> key method-num-slots) (< key 0))
(error "eieiomt-add: method key error!"))
(let ((emtv (get method-name 'eieio-method-tree))
- (emto (get method-name 'eieio-method-obarray)))
+ (emto (get method-name 'eieio-method-hashtable)))
;; Make sure the method tables are available.
- (if (or (not emtv) (not emto))
- (error "Programmer error: eieiomt-add"))
+ (unless (and emtv emto)
+ (error "Programmer error: eieiomt-add"))
;; only add new cells on if it doesn't already exist!
(if (assq class (aref emtv key))
(setcdr (assq class (aref emtv key)) method)
(aset emtv key (cons (cons class method) (aref emtv key))))
;; Add function definition into newly created symbol, and store
- ;; said symbol in the correct obarray, otherwise use the
- ;; other array to keep this stuff
+ ;; said symbol in the correct hashtable, otherwise use the
+ ;; other array to keep this stuff.
(if (< key method-num-lists)
- (let ((nsym (intern (symbol-name class) (aref emto key))))
- (fset nsym method)))
+ (puthash class (list method) (aref emto key)))
;; Save the defmethod file location in a symbol property.
(let ((fname (if load-in-progress
load-file-name
- buffer-file-name))
- loc)
+ buffer-file-name)))
(when fname
- (when (string-match "\\.elc$" fname)
+ (when (string-match "\\.elc\\'" fname)
(setq fname (substring fname 0 (1- (length fname)))))
- (setq loc (get method-name 'method-locations))
- (cl-pushnew (list class fname) loc :test 'equal)
- (put method-name 'method-locations loc)))
- ;; Now optimize the entire obarray
+ (cl-pushnew (list class fname) (get method-name 'method-locations)
+ :test 'equal)))
+ ;; Now optimize the entire hashtable.
(if (< key method-num-lists)
- (let ((eieiomt-optimizing-obarray (aref emto key)))
+ (let ((eieiomt--optimizing-hashtable (aref emto key)))
;; @todo - Is this overkill? Should we just clear the symbol?
- (mapatoms 'eieiomt-sym-optimize eieiomt-optimizing-obarray)))
+ (maphash #'eieiomt--sym-optimize eieiomt--optimizing-hashtable)))
))
(defun eieiomt-next (class)
@@ -2005,21 +1944,19 @@ nil for superclasses. This function performs no type
checking!"
nil
'(eieio-default-superclass))))
-(defun eieiomt-sym-optimize (s)
+(defun eieiomt--sym-optimize (class s)
"Find the next class above S which has a function body for the optimizer."
;; Set the value to nil in case there is no nearest cell.
- (set s nil)
+ (setcdr s nil)
;; Find the nearest cell that has a function body. If we find one,
;; we replace the nil from above.
- (let ((external-symbol (intern-soft (symbol-name s))))
- (catch 'done
- (dolist (ancestor
- (cl-rest (eieio-class-precedence-list external-symbol)))
- (let ((ov (intern-soft (symbol-name ancestor)
- eieiomt-optimizing-obarray)))
- (when (fboundp ov)
- (set s ov) ;; store ov as our next symbol
- (throw 'done ancestor)))))))
+ (catch 'done
+ (dolist (ancestor
+ (cl-rest (eieio-class-precedence-list class)))
+ (let ((ov (gethash ancestor eieiomt--optimizing-hashtable)))
+ (when (car ov)
+ (setcdr s ancestor) ;; store ov as our next symbol
+ (throw 'done ancestor))))))
(defun eieio-generic-form (method key class)
"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
no form, but has a parent class, then trace to that parent class.
The first time a form is requested from a symbol, an optimized path
is memorized for faster future use."
- (let ((emto (aref (get method 'eieio-method-obarray)
+ (let ((emto (aref (get method 'eieio-method-hashtable)
(if class key (eieio-specialized-key-to-generic-key key)))))
(if (class-p class)
;; 1) find our symbol
- (let ((cs (intern-soft (symbol-name class) emto)))
- (if (not cs)
- ;; 2) If there isn't one, then make one.
- ;; This can be slow since it only occurs once
- (progn
- (setq cs (intern (symbol-name class) emto))
- ;; 2.1) Cache its nearest neighbor with a quick optimize
- ;; which should only occur once for this call ever
- (let ((eieiomt-optimizing-obarray emto))
- (eieiomt-sym-optimize cs))))
+ (let ((cs (gethash class emto)))
+ (unless cs
+ ;; 2) If there isn't one, then make one.
+ ;; This can be slow since it only occurs once
+ (puthash class (setq cs (list nil)) emto)
+ ;; 2.1) Cache its nearest neighbor with a quick optimize
+ ;; which should only occur once for this call ever
+ (let ((eieiomt--optimizing-hashtable emto))
+ (eieiomt--sym-optimize class cs)))
;; 3) If it's bound return this one.
- (if (fboundp cs)
- (cons cs (eieio--class-symbol (class-v class)))
+ (if (car cs)
+ ;; FIXME: Why (eieio--class-symbol (class-v class))?
+ (cons (car cs) class)
;; 4) If it's not bound then this variable knows something
- (if (symbol-value cs)
+ (if (cdr cs)
(progn
;; 4.1) This symbol holds the next class in its value
- (setq class (symbol-value cs)
- cs (intern-soft (symbol-name class) emto))
+ (setq class (cdr cs)
+ cs (gethash class emto))
;; 4.2) The optimizer should always have chosen a
;; function-symbol
- ;;(if (fboundp cs)
- (cons cs (eieio--class-symbol (class-v (intern (symbol-name
class)))))
+ ;;(if (car cs)
+ (cons (car cs) class)
;;(error "EIEIO optimizer: erratic data loss!"))
)
;; There never will be a funcall...
@@ -2166,7 +2103,8 @@ is memorized for faster future use."
;; Make sure the method tables are installed.
(eieiomt-install method)
;; Apply the actual body of this function.
- (fset method (eieio-defgeneric-form method doc-string))
+ (put method 'function-documentation doc-string)
+ (fset method (eieio-defgeneric-form method))
;; Return the method
'method))
(make-obsolete 'eieio-defgeneric nil "24.1")
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index df153ee..2c9603c 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -1,4 +1,4 @@
-;;; eieio-custom.el -- eieio object customization
+;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*-
;; Copyright (C) 1999-2001, 2005, 2007-2014 Free Software Foundation,
;; Inc.
@@ -136,7 +136,7 @@ Updates occur regardless of the current customization
group.")
))
(widget-value-set vc (widget-value vc))))
-(defun eieio-custom-toggle-parent (widget &rest ignore)
+(defun eieio-custom-toggle-parent (widget &rest _)
"Toggle visibility of parent of WIDGET.
Optional argument IGNORE is an extraneous parameter."
(eieio-custom-toggle-hide (widget-get widget :parent)))
@@ -154,7 +154,7 @@ Optional argument IGNORE is an extraneous parameter."
:clone-object-children nil
)
-(defun eieio-object-match (widget value)
+(defun eieio-object-match (_widget _value)
"Match info for WIDGET against VALUE."
;; Write me
t)
@@ -216,7 +216,7 @@ Optional argument IGNORE is an extraneous parameter."
(widget-insert "*" (capitalize (symbol-name master-group)) "*")
(widget-create 'push-button
:thing (cons obj (car groups))
- :notify (lambda (widget &rest stuff)
+ :notify (lambda (widget &rest _)
(eieio-customize-object
(car (widget-get widget :thing))
(cdr (widget-get widget :thing))))
@@ -389,14 +389,14 @@ These groups are specified with the `:group' slot flag."
"Insert an Apply and Reset button into the object editor.
Argument OBJ is the object being customized."
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(widget-apply eieio-wo :value-get)
(eieio-done-customizing eieio-co)
(bury-buffer))
"Accept")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
;; I think the act of getting it sets
;; its value through the get function.
(message "Applying Changes...")
@@ -406,13 +406,13 @@ Argument OBJ is the object being customized."
"Apply")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(message "Resetting")
(eieio-customize-object eieio-co eieio-cog))
"Reset")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(bury-buffer))
"Cancel"))
@@ -431,13 +431,11 @@ Must return the created widget."
:clone-object-children t
)
-(defun eieio-object-value-to-abstract (widget value)
+(defun eieio-object-value-to-abstract (_widget value)
"For WIDGET, convert VALUE to an abstract /safe/ representation."
- (if (eieio-object-p value) value
- (if (null value) value
- nil)))
+ (if (eieio-object-p value) value))
-(defun eieio-object-abstract-to-value (widget value)
+(defun eieio-object-abstract-to-value (_widget value)
"For WIDGET, convert VALUE from an abstract /safe/ representation."
value)
diff --git a/lisp/emacs-lisp/eieio-datadebug.el
b/lisp/emacs-lisp/eieio-datadebug.el
index ae29c3f..55d4d5d 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -1,4 +1,4 @@
-;;; eieio-datadebug.el --- EIEIO extensions to the data debugger.
+;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*-
lexical-binding:t -*-
;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
@@ -137,7 +137,7 @@ PREBUTTONTEXT is some text between PREFIX and the object
button."
(data
(catch 'moose (eieio-generic-call
method (list class))))
- (buf (data-debug-new-buffer "*Method Invocation*"))
+ (_buf (data-debug-new-buffer "*Method Invocation*"))
(data2 (mapcar (lambda (sym)
(symbol-function (car sym)))
data)))
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 6f1d01c..86a17a1 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -218,11 +218,10 @@ Outputs to the current buffer."
(defun eieio-build-class-list (class)
"Return a list of all classes that inherit from CLASS."
(if (class-p class)
- (apply #'append
- (mapcar
- (lambda (c)
- (append (list c) (eieio-build-class-list c)))
- (eieio-class-children-fast class)))
+ (cl-mapcan
+ (lambda (c)
+ (append (list c) (eieio-build-class-list c)))
+ (eieio-class-children-fast class))
(list class)))
(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."
(sublst (eieio--class-children (class-v cc))))
(unless (assoc (symbol-name cc) buildlist)
(when (or (not instantiable-only) (not (class-abstract-p cc)))
+ ;; FIXME: Completion tables don't need alists, and ede/generic.el needs
+ ;; the symbols rather than their names.
(setq buildlist (cons (cons (symbol-name cc) 1) buildlist))))
- (while sublst
+ (dolist (elem sublst)
(setq buildlist (eieio-build-class-alist
- (car sublst) instantiable-only buildlist))
- (setq sublst (cdr sublst)))
+ elem instantiable-only buildlist)))
buildlist))
(defvar eieio-read-class nil
@@ -378,51 +378,47 @@ are not abstract."
"Return a list of all generic functions.
Optional CLASS argument returns only those functions that contain
methods for CLASS."
- (let ((l nil) tree (cn (if class (symbol-name class) nil)))
+ (let ((l nil))
(mapatoms
(lambda (symbol)
- (setq tree (get symbol 'eieio-method-obarray))
- (if tree
- (progn
- ;; A symbol might be interned for that class in one of
- ;; these three slots in the method-obarray.
- (if (or (not class)
- (fboundp (intern-soft cn (aref tree 0)))
- (fboundp (intern-soft cn (aref tree 1)))
- (fboundp (intern-soft cn (aref tree 2))))
- (setq l (cons symbol l)))))))
+ (let ((tree (get symbol 'eieio-method-hashtable)))
+ (when tree
+ ;; A symbol might be interned for that class in one of
+ ;; these three slots in the method-obarray.
+ (if (or (not class)
+ (car (gethash class (aref tree 0)))
+ (car (gethash class (aref tree 1)))
+ (car (gethash class (aref tree 2))))
+ (setq l (cons symbol l)))))))
l))
(defun eieio-method-documentation (generic class)
"Return a list of the specific documentation of GENERIC for CLASS.
If there is not an explicit method for CLASS in GENERIC, or if that
function has no documentation, then return nil."
- (let ((tree (get generic 'eieio-method-obarray))
- (cn (symbol-name class))
- before primary after)
- (if (not tree)
- nil
+ (let ((tree (get generic 'eieio-method-hashtable)))
+ (when tree
;; A symbol might be interned for that class in one of
- ;; these three slots in the method-obarray.
- (setq before (intern-soft cn (aref tree 0))
- primary (intern-soft cn (aref tree 1))
- after (intern-soft cn (aref tree 2)))
- (if (not (or (fboundp before)
- (fboundp primary)
- (fboundp after)))
- nil
- (list (if (fboundp before)
- (cons (help-function-arglist before)
- (documentation before))
- nil)
- (if (fboundp primary)
- (cons (help-function-arglist primary)
- (documentation primary))
- nil)
- (if (fboundp after)
- (cons (help-function-arglist after)
- (documentation after))
- nil))))))
+ ;; these three slots in the method-hashtable.
+ ;; FIXME: Where do these 0/1/2 come from? Isn't 0 for :static,
+ ;; 1 for before, and 2 for primary (and 3 for after)?
+ (let ((before (car (gethash class (aref tree 0))))
+ (primary (car (gethash class (aref tree 1))))
+ (after (car (gethash class (aref tree 2)))))
+ (if (not (or before primary after))
+ nil
+ (list (if before
+ (cons (help-function-arglist before)
+ (documentation before))
+ nil)
+ (if primary
+ (cons (help-function-arglist primary)
+ (documentation primary))
+ nil)
+ (if after
+ (cons (help-function-arglist after)
+ (documentation after))
+ nil)))))))
(defvar eieio-read-generic nil
"History of the `eieio-read-generic' prompt.")
@@ -627,7 +623,7 @@ Optional argument HISTORYVAR is the variable to use as
history."
()
"Menu part in easymenu format used in speedbar while in `eieio' mode.")
-(defun eieio-class-speedbar (dir-or-object depth)
+(defun eieio-class-speedbar (_dir-or-object _depth)
"Create buttons in speedbar that represents the current project.
DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the
current expansion depth."
@@ -676,7 +672,7 @@ Argument INDENT is the depth of indentation."
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
-(defun eieio-describe-class-sb (text token indent)
+(defun eieio-describe-class-sb (_text token _indent)
"Describe the class TEXT in TOKEN.
INDENT is the current indentation level."
(dframe-with-attached-buffer
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index c8330d5..93688ba 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."
"Return non-nil if CHILD class is a subclass of CLASS."
(eieio--check-type class-p class)
(eieio--check-type class-p child)
- (let ((p nil))
- (while (and child (not (eq child class)))
- (setq p (append p (eieio--class-parent (class-v child)))
- child (car p)
- p (cdr p)))
- (if child t)))
+ ;; `eieio-default-superclass' is never mentioned in eieio--class-parent,
+ ;; so we have to special case it here.
+ (or (eq class 'eieio-default-superclass)
+ (let ((p nil))
+ (while (and child (not (eq child class)))
+ (setq p (append p (eieio--class-parent (class-v child)))
+ child (car p)
+ p (cdr p)))
+ (if child t))))
(defun object-slots (obj)
"Return list of slots available in OBJ."
@@ -906,7 +909,7 @@ Optional argument GROUP is the sub-group of slots to
display.
;;;***
-;;;### (autoloads nil "eieio-opt" "eieio-opt.el"
"889c0a935dddf758dbb65488470ffa06")
+;;;### (autoloads nil "eieio-opt" "eieio-opt.el"
"e50a67ebd0c6258c615e4bf16714e81f")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
diff --git a/test/ChangeLog b/test/ChangeLog
index 7d23b3e..bcc619a 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,11 @@
+2014-12-22 Stefan Monnier <address@hidden>
+
+ * 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.
+
2014-12-19 Artur Malabarba <address@hidden>
* automated/let-alist.el: require `cl-lib'
@@ -27,8 +35,8 @@
(vc-test--create-repo-function): Rename from
`vc-test--create-repo-if-not-supported'. Adapt all callees.
(vc-test--create-repo): Check also for revision-granularity.
- (vc-test--unregister-function): Additional argument FILE. Adapt
- all callees.
+ (vc-test--unregister-function): Additional argument FILE.
+ Adapt all callees.
(vc-test--working-revision): New defun.
(vc-test-*-working-revision): New tests.
@@ -65,7 +73,7 @@
2014-11-21 Ulf Jasper <address@hidden>
* automated/libxml-tests.el
- (libxml-tests--data-comments-preserved): Renamed from
+ (libxml-tests--data-comments-preserved): Rename from
'libxml-tests--data'.
(libxml-tests--data-comments-discarded): New.
(libxml-tests): Check whether 'libxml-parse-xml-region' is
@@ -92,8 +100,8 @@
2014-11-17 Ulf Jasper <address@hidden>
- * automated/icalendar-tests.el (icalendar-tests--test-export): New
- optional parameter `alarms'.
+ * automated/icalendar-tests.el (icalendar-tests--test-export):
+ New optional parameter `alarms'.
(icalendar-export-alarms): New test for exporting icalendar
alarms.
(icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil.
@@ -107,8 +115,8 @@
2014-11-16 Ulf Jasper <address@hidden>
- * automated/icalendar-tests.el (icalendar--parse-vtimezone): Add
- testcase where offsets of standard time and daylight saving time
+ * automated/icalendar-tests.el (icalendar--parse-vtimezone):
+ Add testcase where offsets of standard time and daylight saving time
are equal.
(icalendar-real-world): Fix error in test case. Expected result
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 0b0dd5d..20b47a7 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -61,9 +61,8 @@
"Store current invocation class symbol in the invocation order list."
(let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ]
(or eieio-generic-call-key 0)))
- (c (list eieio-generic-call-methodname keysym (eieio--scoped-class))))
- (setq eieio-test-method-order-list
- (cons c eieio-test-method-order-list))))
+ (c (list keysym (eieio--scoped-class))))
+ (push c eieio-test-method-order-list)))
(defun eieio-test-match (rightanswer)
"Do a test match."
@@ -120,17 +119,17 @@
(ert-deftest eieio-test-method-order-list-3 ()
(let ((eieio-test-method-order-list nil)
(ans '(
- (eitest-F :BEFORE eitest-B)
- (eitest-F :BEFORE eitest-B-base1)
- (eitest-F :BEFORE eitest-B-base2)
+ (:BEFORE eitest-B)
+ (:BEFORE eitest-B-base1)
+ (:BEFORE eitest-B-base2)
- (eitest-F :PRIMARY eitest-B)
- (eitest-F :PRIMARY eitest-B-base1)
- (eitest-F :PRIMARY eitest-B-base2)
+ (:PRIMARY eitest-B)
+ (:PRIMARY eitest-B-base1)
+ (:PRIMARY eitest-B-base2)
- (eitest-F :AFTER eitest-B-base2)
- (eitest-F :AFTER eitest-B-base1)
- (eitest-F :AFTER eitest-B)
+ (:AFTER eitest-B-base2)
+ (:AFTER eitest-B-base1)
+ (:AFTER eitest-B)
)))
(eitest-F (eitest-B nil))
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -193,9 +192,9 @@
(ert-deftest eieio-test-method-order-list-6 ()
(let ((eieio-test-method-order-list nil)
(ans '(
- (constructor :STATIC C)
- (constructor :STATIC C-base1)
- (constructor :STATIC C-base2)
+ (:STATIC C)
+ (:STATIC C-base1)
+ (:STATIC C-base2)
)))
(C nil)
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -238,10 +237,10 @@
(ert-deftest eieio-test-method-order-list-7 ()
(let ((eieio-test-method-order-list nil)
(ans '(
- (eitest-F :PRIMARY D)
- (eitest-F :PRIMARY D-base1)
- ;; (eitest-F :PRIMARY D-base2)
- (eitest-F :PRIMARY D-base0)
+ (:PRIMARY D)
+ (:PRIMARY D-base1)
+ ;; (:PRIMARY D-base2)
+ (:PRIMARY D-base0)
)))
(eitest-F (D nil))
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -277,10 +276,10 @@
(ert-deftest eieio-test-method-order-list-8 ()
(let ((eieio-test-method-order-list nil)
(ans '(
- (eitest-F :PRIMARY E)
- (eitest-F :PRIMARY E-base1)
- (eitest-F :PRIMARY E-base2)
- (eitest-F :PRIMARY E-base0)
+ (:PRIMARY E)
+ (:PRIMARY E-base1)
+ (:PRIMARY E-base2)
+ (:PRIMARY E-base0)
)))
(eitest-F (E nil))
(setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
- [Emacs-diffs] master updated (5fbd17e -> a749f1c), Stefan Monnier, 2015/01/08
- [Emacs-diffs] master 232823a 4/9: lisp/emacs-lisp/eieio*.el: Reduce object header to 1 slot, Stefan Monnier, 2015/01/08
- [Emacs-diffs] master d4a12e7 2/9: * lisp/emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v., Stefan Monnier, 2015/01/08
- [Emacs-diffs] master ee93d7a 3/9: * lisp/emacs-lisp/eieio*.el: Remove "name" field of objects, Stefan Monnier, 2015/01/08
- [Emacs-diffs] master bcebc83 1/9: * lisp/emacs-lisp/eieio*.el: Use hashtables rather than obarrays,
Stefan Monnier <=
- [Emacs-diffs] master 6a67b20 8/9: * lisp/emacs-lisp/eieio*.el: Move the function defs to defclass., Stefan Monnier, 2015/01/08
- [Emacs-diffs] master cb4db86 5/9: * lisp/emacs-lisp/eieio*.el: Use class objects in `parent' field., Stefan Monnier, 2015/01/08
- [Emacs-diffs] master 1599688 6/9: lisp/emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var., Stefan Monnier, 2015/01/08
- [Emacs-diffs] master 5418156 7/9: * emacs-lisp/eieio-generic.el: New file., Stefan Monnier, 2015/01/08
- [Emacs-diffs] master a749f1c 9/9: Shrink EIEIO object header. Move generics to eieio-generic.el., Stefan Monnier, 2015/01/08