From: Stefan Monnier Date: Mon, 22 Dec 2014 20:46:16 +0000 (-0500) Subject: * lisp/emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v. X-Git-Tag: emacs-25.0.90~2605^2~18^2~6 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d4a12e7a9a46bbff2f9c4d59ecc284621634a2e8;p=emacs.git * lisp/emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v. (method-*): Add a "eieio--" prefix to those constants. * lisp/emacs-lisp/eieio-speedbar.el: Use lexical-binding. * lisp/emacs-lisp/eieio.el: Move edebug specs to the corresponding macro. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c2f45845306..739d442c55b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2014-12-22 Stefan Monnier + + * emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v. + (method-*): Add a "eieio--" prefix to those constants. + + * emacs-lisp/eieio.el: Move edebug specs to the corresponding macro. + + * emacs-lisp/eieio-speedbar.el: Use lexical-binding. + 2014-12-22 Stefan Monnier * emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 4b8ccaef88d..f2020dfa74d 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -309,7 +309,7 @@ Second, any text properties will be stripped from strings." (type nil) (classtype nil)) (setq slot-idx (- slot-idx 3)) - (setq type (aref (eieio--class-public-type (class-v class)) + (setq type (aref (eieio--class-public-type (eieio--class-v class)) slot-idx)) (setq classtype (eieio-persistent-slot-type-is-class-p diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 9ee6520c5ec..1e8d17d2652 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -171,21 +171,20 @@ Stored outright without modifications or stripping."))) name)) ;FIXME: Get rid of this field! ;; FIXME: The constants below should have an `eieio-' prefix added!! - -(defconst method-static 0 "Index into :static tag on a method.") -(defconst method-before 1 "Index into :before tag on a method.") -(defconst method-primary 2 "Index into :primary tag on a method.") -(defconst method-after 3 "Index into :after tag on a method.") -(defconst method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") -(defconst method-generic-before 4 "Index into generic :before tag on a method.") -(defconst method-generic-primary 5 "Index into generic :primary tag on a method.") -(defconst method-generic-after 6 "Index into generic :after tag on a method.") -(defconst method-num-slots 7 "Number of indexes into a method's vector.") +(defconst eieio--method-static 0 "Index into :static tag on a method.") +(defconst eieio--method-before 1 "Index into :before tag on a method.") +(defconst eieio--method-primary 2 "Index into :primary tag on a method.") +(defconst eieio--method-after 3 "Index into :after tag on a method.") +(defconst eieio--method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") +(defconst eieio--method-generic-before 4 "Index into generic :before tag on a method.") +(defconst eieio--method-generic-primary 5 "Index into generic :primary tag on a method.") +(defconst eieio--method-generic-after 6 "Index into generic :after tag on a method.") +(defconst eieio--method-num-slots 7 "Number of indexes into a method's vector.") (defsubst eieio-specialized-key-to-generic-key (key) "Convert a specialized KEY into a generic method key." - (cond ((eq key method-static) 0) ;; don't convert - ((< key method-num-lists) (+ key 3)) ;; The conversion + (cond ((eq key eieio--method-static) 0) ;; don't convert + ((< key eieio--method-num-lists) (+ key 3)) ;; The conversion (t key) ;; already generic.. maybe. )) @@ -201,8 +200,9 @@ Stored outright without modifications or stripping."))) (t `(,type ,obj)))) (signal 'wrong-type-argument (list ',type ,obj)))) -(defmacro class-v (class) +(defmacro eieio--class-v (class) "Internal: Return the class vector from the CLASS symbol." + (declare (debug t)) ;; No check: If eieio gets this far, it has probably been checked already. `(get ,class 'eieio-class-definition)) @@ -212,7 +212,7 @@ CLASS is a symbol." ;; this new method is faster since it doesn't waste time checking lots of ;; things. (condition-case nil - (eq (aref (class-v class) 0) 'defclass) + (eq (aref (eieio--class-v class) 0) 'defclass) (error nil))) (defun eieio-class-name (class) "Return a Lisp like symbol name for CLASS." @@ -224,10 +224,10 @@ CLASS is a symbol." (defmacro eieio-class-parents-fast (class) "Return parent classes to CLASS with no check." - `(eieio--class-parent (class-v ,class))) + `(eieio--class-parent (eieio--class-v ,class))) (defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." - `(eieio--class-children (class-v ,class))) + `(eieio--class-children (eieio--class-v ,class))) (defmacro same-class-fast-p (obj class) "Return t if OBJ is of class-type CLASS with no error checking." @@ -235,7 +235,8 @@ CLASS is a symbol." (defmacro class-constructor (class) "Return the symbol representing the constructor of CLASS." - `(eieio--class-symbol (class-v ,class))) + (declare (debug t)) + `(eieio--class-symbol (eieio--class-v ,class))) (defsubst generic-p (method) "Return non-nil if symbol METHOD is a generic function. @@ -250,13 +251,13 @@ 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))) - (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))) + (not (or (>= 0 (length (aref M eieio--method-primary))) + (aref M eieio--method-static) + (aref M eieio--method-before) + (aref M eieio--method-after) + (aref M eieio--method-generic-before) + (aref M eieio--method-generic-primary) + (aref M eieio--method-generic-after))) ))) (defun generic-primary-only-one-p (method) @@ -266,13 +267,13 @@ 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))) - (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))) + (not (or (/= 1 (length (aref M eieio--method-primary))) + (aref M eieio--method-static) + (aref M eieio--method-before) + (aref M eieio--method-after) + (aref M eieio--method-generic-before) + (aref M eieio--method-generic-primary) + (aref M eieio--method-generic-after))) ))) (defmacro class-option-assoc (list option) @@ -282,7 +283,7 @@ Methods with only primary implementations are executed in an optimized way." (defmacro class-option (class option) "Return the value stored for CLASS' OPTION. Return nil if that option doesn't exist." - `(class-option-assoc (eieio--class-options (class-v ,class)) ',option)) + `(class-option-assoc (eieio--class-options (eieio--class-v ,class)) ',option)) (defsubst eieio-object-p (obj) "Return non-nil if OBJ is an EIEIO object." @@ -322,7 +323,7 @@ SUPERCLASSES as children. It creates an autoload function for CNAME's constructor." ;; Assume we've already debugged inputs. - (let* ((oldc (when (class-p cname) (class-v cname))) + (let* ((oldc (when (class-p cname) (eieio--class-v cname))) (newc (make-vector eieio--class-num-slots nil)) ) (if oldc @@ -350,7 +351,7 @@ It creates an autoload function for CNAME's constructor." ;; Save the child in the parent. (cl-pushnew cname (if (class-p SC) - (eieio--class-children (class-v SC)) + (eieio--class-children (eieio--class-v SC)) ;; Parent doesn't exist yet. (gethash SC eieio-defclass-autoload-map))) @@ -364,7 +365,7 @@ It creates an autoload function for CNAME's constructor." ;; do this first so that we can call defmethod for the accessor. ;; The vector will be updated by the following while loop and will not ;; need to be stored a second time. - (put cname 'eieio-class-definition newc) + (setf (eieio--class-v cname) newc) ;; Clear the parent (if clear-parent (setf (eieio--class-parent newc) nil)) @@ -403,7 +404,7 @@ See `defclass' for more information." (let* ((pname superclasses) (newc (make-vector eieio--class-num-slots nil)) - (oldc (when (class-p cname) (class-v cname))) + (oldc (when (class-p cname) (eieio--class-v cname))) (groups nil) ;; list of groups id'd from slots (options nil) (clearparent nil)) @@ -448,7 +449,7 @@ See `defclass' for more information." (error "Given parent class %S is not a class" p) ;; good parent class... ;; save new child in parent - (cl-pushnew cname (eieio--class-children (class-v p))) + (cl-pushnew cname (eieio--class-children (eieio--class-v p))) ;; Get custom groups, and store them into our local copy. (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) (class-option p :custom-groups)) @@ -465,7 +466,7 @@ See `defclass' for more information." (setq clearparent t) ;; save new child in parent (cl-pushnew cname (eieio--class-children - (class-v 'eieio-default-superclass))) + (eieio--class-v 'eieio-default-superclass))) ;; save parent in child (setf (eieio--class-parent newc) '(eieio-default-superclass)))) @@ -535,7 +536,7 @@ See `defclass' for more information." ;; do this first so that we can call defmethod for the accessor. ;; The vector will be updated by the following while loop and will not ;; need to be stored a second time. - (put cname 'eieio-class-definition newc) + (setf (eieio--class-v cname) newc) ;; Query each slot in the declaration list and mangle into the ;; class structure I have defined. @@ -1019,7 +1020,7 @@ the new child class." ':allow-nil-initform))) (while ps ;; First, duplicate all the slots of the parent. - (let ((pcv (class-v (car ps)))) + (let ((pcv (eieio--class-v (car ps)))) (let ((pa (eieio--class-public-a pcv)) (pd (eieio--class-public-d pcv)) (pdoc (eieio--class-public-doc pcv)) @@ -1163,7 +1164,7 @@ IMPL is the symbol holding the method implementation." ;; 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-key eieio--method-primary) (eieio-generic-call-arglst local-args) ) (eieio--with-scoped-class class @@ -1173,7 +1174,7 @@ IMPL is the symbol holding the method implementation." "Setup METHOD to call the generic form." (let* ((doc-string (documentation method 'raw)) (M (get method 'eieio-method-tree)) - (entry (car (aref M method-primary))) + (entry (car (aref M eieio--method-primary))) ) (put method 'function-documentation doc-string) (fset method (eieio-defgeneric-form-primary-only-one @@ -1190,12 +1191,12 @@ but remove reference to all implementations of METHOD." "Work part of the `defmethod' macro defining METHOD with ARGS." (let ((key ;; Find optional keys. - (cond ((memq kind '(:BEFORE :before)) method-before) - ((memq kind '(:AFTER :after)) method-after) - ((memq kind '(:STATIC :static)) method-static) - ((memq kind '(:PRIMARY :primary nil)) method-primary) + (cond ((memq kind '(:BEFORE :before)) eieio--method-before) + ((memq kind '(:AFTER :after)) eieio--method-after) + ((memq kind '(:STATIC :static)) eieio--method-static) + ((memq kind '(:PRIMARY :primary nil)) eieio--method-primary) ;; Primary key. - ;; (t method-primary) + ;; (t eieio--method-primary) (t (error "Unknown method kind %S" kind))))) ;; Make sure there is a generic (when called from defclass). (eieio--defalias @@ -1253,7 +1254,7 @@ an error." nil ;; Trim off object IDX junk added in for the object index. (setq slot-idx (- slot-idx 3)) - (let ((st (aref (eieio--class-public-type (class-v class)) slot-idx))) + (let ((st (aref (eieio--class-public-type (eieio--class-v class)) slot-idx))) (if (not (eieio-perform-slot-validation st value)) (signal 'invalid-slot-type (list class slot st value)))))) @@ -1264,7 +1265,7 @@ SLOT is the slot that is being checked, and is only used when throwing an error." (if eieio-skip-typecheck nil - (let ((st (aref (eieio--class-class-allocation-type (class-v class)) + (let ((st (aref (eieio--class-class-allocation-type (eieio--class-v class)) slot-idx))) (if (not (eieio-perform-slot-validation st value)) (signal 'invalid-slot-type (list class slot st value)))))) @@ -1293,7 +1294,7 @@ Argument FN is the function calling this verifier." ;; Let's check that info out. (if (setq c (eieio-class-slot-name-index class slot)) ;; Oref that slot. - (aref (eieio--class-class-allocation-values (class-v class)) c) + (aref (eieio--class-class-allocation-values (eieio--class-v class)) c) ;; The slot-missing method is a cool way of allowing an object author ;; to intercept missing slot definitions. Since it is also the LAST ;; thing called in this fn, its return value would be retrieved. @@ -1317,13 +1318,13 @@ Fills in OBJ's SLOT with its default value." (if (setq c (eieio-class-slot-name-index cl slot)) ;; Oref that slot. - (aref (eieio--class-class-allocation-values (class-v cl)) + (aref (eieio--class-class-allocation-values (eieio--class-v cl)) c) (slot-missing obj slot 'oref-default) ;;(signal 'invalid-slot-name (list (class-name cl) slot)) ) (eieio-barf-if-slot-unbound - (let ((val (nth (- c 3) (eieio--class-public-d (class-v cl))))) + (let ((val (nth (- c 3) (eieio--class-public-d (eieio--class-v cl))))) (eieio-default-eval-maybe val)) obj cl 'oref-default)))) @@ -1353,7 +1354,7 @@ Fills in OBJ's SLOT with VALUE." ;; Oset that slot. (progn (eieio-validate-class-slot-value (eieio--object-class obj) c value slot) - (aset (eieio--class-class-allocation-values (class-v (eieio--object-class obj))) + (aset (eieio--class-class-allocation-values (eieio--class-v (eieio--object-class obj))) c value)) ;; See oref for comment on `slot-missing' (slot-missing obj slot 'oset value) @@ -1376,15 +1377,15 @@ Fills in the default value in CLASS' in SLOT with VALUE." (progn ;; Oref that slot. (eieio-validate-class-slot-value class c value slot) - (aset (eieio--class-class-allocation-values (class-v class)) c + (aset (eieio--class-class-allocation-values (eieio--class-v class)) c value)) (signal 'invalid-slot-name (list (eieio-class-name class) slot))) (eieio-validate-slot-value class c value slot) ;; Set this into the storage for defaults. - (setcar (nthcdr (- c 3) (eieio--class-public-d (class-v class))) + (setcar (nthcdr (- c 3) (eieio--class-public-d (eieio--class-v class))) value) ;; Take the value, and put it into our cache object. - (eieio-oset (eieio--class-default-object-cache (class-v class)) + (eieio-oset (eieio--class-default-object-cache (eieio--class-v class)) slot value) )))) @@ -1400,7 +1401,7 @@ so that we can protect private slots." (if (not par) t (while (and par ret) - (if (gethash slot (eieio--class-symbol-hashtable (class-v (car par)))) + (if (gethash slot (eieio--class-symbol-hashtable (eieio--class-v (car par)))) (setq ret nil)) (setq par (cdr par))) ret))) @@ -1414,7 +1415,7 @@ 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 (gethash slot (eieio--class-symbol-hashtable (class-v class)))) + (let* ((fsym (gethash slot (eieio--class-symbol-hashtable (eieio--class-v class)))) (fsi (car fsym))) (if (integerp fsi) (cond @@ -1442,7 +1443,7 @@ call. If SLOT is the value created with :initarg instead, reverse-lookup that name, and recurse with the associated slot value." ;; This will happen less often, and with fewer slots. Do this the ;; storage cheap way. - (let* ((a (eieio--class-class-allocation-a (class-v class))) + (let* ((a (eieio--class-class-allocation-a (eieio--class-v class))) (l1 (length a)) (af (memq slot a)) (l2 (length af))) @@ -1461,7 +1462,7 @@ reset. If SET-ALL is nil, the slots are only reset if the default is not nil." (eieio--with-scoped-class (eieio--object-class obj) (let ((eieio-initializing-object t) - (pub (eieio--class-public-a (class-v (eieio--object-class obj))))) + (pub (eieio--class-public-a (eieio--class-v (eieio--object-class obj))))) (while pub (let ((df (eieio-oref-default obj (car pub)))) (if (or df set-all) @@ -1472,7 +1473,7 @@ not nil." "For CLASS, convert INITARG to the actual attribute name. If there is no translation, pass it in directly (so we can cheat if need be... May remove that later...)" - (let ((tuple (assoc initarg (eieio--class-initarg-tuples (class-v class))))) + (let ((tuple (assoc initarg (eieio--class-initarg-tuples (eieio--class-v class))))) (if tuple (cdr tuple) nil))) @@ -1480,7 +1481,7 @@ need be... May remove that later...)" (defun eieio-attribute-to-initarg (class attribute) "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag. This is usually a symbol that starts with `:'." - (let ((tuple (rassoc attribute (eieio--class-initarg-tuples (class-v class))))) + (let ((tuple (rassoc attribute (eieio--class-initarg-tuples (eieio--class-v class))))) (if tuple (car tuple) nil))) @@ -1666,34 +1667,34 @@ This should only be called from a generic function." ;; :after methods (setq tlambdas (if mclass - (eieiomt-method-list method method-after mclass) - (list (eieio-generic-form method method-after nil))) - ;;(or (and mclass (eieio-generic-form method method-after mclass)) - ;; (eieio-generic-form method method-after nil)) + (eieiomt-method-list method eieio--method-after mclass) + (list (eieio-generic-form method eieio--method-after nil))) + ;;(or (and mclass (eieio-generic-form method eieio--method-after mclass)) + ;; (eieio-generic-form method eieio--method-after nil)) ) (setq lambdas (append tlambdas lambdas) - keys (append (make-list (length tlambdas) method-after) keys)) + keys (append (make-list (length tlambdas) eieio--method-after) keys)) ;; :primary methods (setq tlambdas - (or (and mclass (eieio-generic-form method method-primary mclass)) - (eieio-generic-form method method-primary nil))) + (or (and mclass (eieio-generic-form method eieio--method-primary mclass)) + (eieio-generic-form method eieio--method-primary nil))) (when tlambdas (setq lambdas (cons tlambdas lambdas) - keys (cons method-primary keys) + keys (cons eieio--method-primary keys) primarymethodlist - (eieiomt-method-list method method-primary mclass))) + (eieiomt-method-list method eieio--method-primary mclass))) ;; :before methods (setq tlambdas (if mclass - (eieiomt-method-list method method-before mclass) - (list (eieio-generic-form method method-before nil))) - ;;(or (and mclass (eieio-generic-form method method-before mclass)) - ;; (eieio-generic-form method method-before nil)) + (eieiomt-method-list method eieio--method-before mclass) + (list (eieio-generic-form method eieio--method-before nil))) + ;;(or (and mclass (eieio-generic-form method eieio--method-before mclass)) + ;; (eieio-generic-form method eieio--method-before nil)) ) (setq lambdas (append tlambdas lambdas) - keys (append (make-list (length tlambdas) method-before) keys)) + keys (append (make-list (length tlambdas) eieio--method-before) keys)) ) (if mclass @@ -1701,20 +1702,20 @@ This should only be called from a generic function." ;; if there were no methods found, then there could be :static methods. (when (not lambdas) (setq tlambdas - (eieio-generic-form method method-static mclass)) + (eieio-generic-form method eieio--method-static mclass)) (setq lambdas (cons tlambdas lambdas) - keys (cons method-static keys) + keys (cons eieio--method-static keys) primarymethodlist ;; Re-use even with bad name here - (eieiomt-method-list method method-static mclass))) + (eieiomt-method-list method eieio--method-static mclass))) ;; For the case of no class (ie - mclass == nil) then there may ;; be a primary method. (setq tlambdas - (eieio-generic-form method method-primary nil)) + (eieio-generic-form method eieio--method-primary nil)) (when tlambdas (setq lambdas (cons tlambdas lambdas) - keys (cons method-primary keys) + keys (cons eieio--method-primary keys) primarymethodlist - (eieiomt-method-list method method-primary nil))) + (eieiomt-method-list method eieio--method-primary nil))) ) (run-hook-with-args 'eieio-pre-method-execution-functions @@ -1728,8 +1729,8 @@ This should only be called from a generic function." (eieio--with-scoped-class (cdr (car lambdas)) (let* ((eieio-generic-call-key (car keys)) (has-return-val - (or (= eieio-generic-call-key method-primary) - (= eieio-generic-call-key method-static))) + (or (= eieio-generic-call-key eieio--method-primary) + (= eieio-generic-call-key eieio--method-static))) (eieio-generic-call-next-method-list ;; Use the cdr, as the first element is the fcn ;; we are calling right now. @@ -1791,15 +1792,15 @@ for this common case to improve performance." ) ;; :primary methods - (setq lambdas (eieio-generic-form method method-primary mclass)) + (setq lambdas (eieio-generic-form method eieio--method-primary mclass)) (setq primarymethodlist ;; Re-use even with bad name here - (eieiomt-method-list method method-primary mclass)) + (eieiomt-method-list method eieio--method-primary mclass)) ;; Now loop through all occurrences forms which we must execute ;; (which are happily sorted now) and execute them all! (eieio--with-scoped-class (cdr lambdas) (let* ((rval nil) (lastval nil) - (eieio-generic-call-key method-primary) + (eieio-generic-call-key eieio--method-primary) ;; Use the cdr, as the first element is the fcn ;; we are calling right now. (eieio-generic-call-next-method-list (cdr primarymethodlist)) @@ -1850,7 +1851,7 @@ If CLASS is nil, then an empty list of methods should be returned." ;; Return collected lambda. For :after methods, return in current ;; order (most general class last); Otherwise, reverse order. - (if (eq key method-after) + (if (eq key eieio--method-after) lambdas (nreverse lambdas)))) @@ -1883,9 +1884,9 @@ Do not do the work if they already exist." (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)) + (make-vector eieio--method-num-slots nil)) (let ((emto (put method-name 'eieio-method-hashtable - (make-vector method-num-slots nil)))) + (make-vector eieio--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)) @@ -1899,7 +1900,7 @@ KEY is an integer (see comment in eieio.el near this function) which is associated with the :static :before :primary and :after tags. It also indicates if CLASS is defined or not. CLASS is the class this method is associated with." - (if (or (> key method-num-slots) (< key 0)) + (if (or (> key eieio--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-hashtable))) @@ -1913,7 +1914,7 @@ CLASS is the class this method is associated with." ;; Add function definition into newly created symbol, and store ;; said symbol in the correct hashtable, otherwise use the ;; other array to keep this stuff. - (if (< key method-num-lists) + (if (< key eieio--method-num-lists) (puthash class (list method) (aref emto key))) ;; Save the defmethod file location in a symbol property. (let ((fname (if load-in-progress @@ -1925,7 +1926,7 @@ CLASS is the class this method is associated with." (cl-pushnew (list class fname) (get method-name 'method-locations) :test 'equal))) ;; Now optimize the entire hashtable. - (if (< key method-num-lists) + (if (< key eieio--method-num-lists) (let ((eieiomt--optimizing-hashtable (aref emto key))) ;; @todo - Is this overkill? Should we just clear the symbol? (maphash #'eieiomt--sym-optimize eieiomt--optimizing-hashtable))) @@ -1979,7 +1980,6 @@ is memorized for faster future use." (eieiomt--sym-optimize class cs))) ;; 3) If it's bound return this one. (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 (cdr cs) @@ -1991,10 +1991,10 @@ is memorized for faster future use." ;; function-symbol ;;(if (car cs) (cons (car cs) class) - ;;(error "EIEIO optimizer: erratic data loss!")) + ;;(error "EIEIO optimizer: erratic data loss!")) ) - ;; There never will be a funcall... - nil))) + ;; There never will be a funcall... + nil))) ;; for a generic call, what is a list, is the function body we want. (let ((emtl (aref (get method 'eieio-method-tree) (if class key (eieio-specialized-key-to-generic-key key))))) @@ -2024,18 +2024,18 @@ is memorized for faster future use." (setq key (cond ((memq (car args) '(:BEFORE :before)) (setq args (cdr args)) - method-before) + eieio--method-before) ((memq (car args) '(:AFTER :after)) (setq args (cdr args)) - method-after) + eieio--method-after) ((memq (car args) '(:STATIC :static)) (setq args (cdr args)) - method-static) + eieio--method-static) ((memq (car args) '(:PRIMARY :primary)) (setq args (cdr args)) - method-primary) + eieio--method-primary) ;; Primary key. - (t method-primary))) + (t eieio--method-primary))) ;; Get body, and fix contents of args to be the arguments of the fn. (setq body (cdr args) args (car args)) diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 2c9603c38c1..189337bd5f9 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -193,7 +193,7 @@ Optional argument IGNORE is an extraneous parameter." (let* ((chil nil) (obj (widget-get widget :value)) (master-group (widget-get widget :eieio-group)) - (cv (class-v (eieio--object-class obj))) + (cv (eieio--class-v (eieio--object-class obj))) (slots (eieio--class-public-a cv)) (flabel (eieio--class-public-custom-label cv)) (fgroup (eieio--class-public-custom-group cv)) @@ -288,7 +288,7 @@ Optional argument IGNORE is an extraneous parameter." "Get the value of WIDGET." (let* ((obj (widget-get widget :value)) (master-group eieio-cog) - (cv (class-v (eieio--object-class obj))) + (cv (eieio--class-v (eieio--object-class obj))) (fgroup (eieio--class-public-custom-group cv)) (wids (widget-get widget :children)) (name (if (widget-get widget :eieio-show-name) @@ -296,7 +296,7 @@ Optional argument IGNORE is an extraneous parameter." nil)) (chil (if (widget-get widget :eieio-show-name) (nthcdr 1 wids) wids)) - (cv (class-v (eieio--object-class obj))) + (cv (eieio--class-v (eieio--object-class obj))) (slots (eieio--class-public-a cv)) (fcust (eieio--class-public-custom cv))) ;; If there are any prefix widgets, clear them. @@ -321,7 +321,7 @@ Optional argument IGNORE is an extraneous parameter." ;; This is the same object we had before. obj)) -(defmethod eieio-done-customizing ((obj eieio-default-superclass)) +(defmethod eieio-done-customizing ((_obj eieio-default-superclass)) "When applying change to a widget, call this method. This method is called by the default widget-edit commands. User made commands should also call this method when applying changes. @@ -385,7 +385,7 @@ These groups are specified with the `:group' slot flag." (make-local-variable 'eieio-cog) (setq eieio-cog g))) -(defmethod eieio-custom-object-apply-reset ((obj eieio-default-superclass)) +(defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass)) "Insert an Apply and Reset button into the object editor. Argument OBJ is the object being customized." (widget-create 'push-button diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 55d4d5dcea9..d18501b414c 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -87,7 +87,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." prefix "Name: ") (let* ((cl (eieio-object-class obj)) - (cv (class-v cl))) + (cv (eieio--class-v cl))) (data-debug-insert-thing (class-constructor cl) prefix "Class: ") diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 86a17a17b7a..1987385de0b 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -60,7 +60,7 @@ Argument PREFIX is the character prefix to use. Argument CH-PREFIX is another character prefix to display." (eieio--check-type class-p this-root) (let ((myname (symbol-name this-root)) - (chl (eieio--class-children (class-v this-root))) + (chl (eieio--class-children (eieio--class-v this-root))) (fprefix (concat ch-prefix " +--")) (mprefix (concat ch-prefix " | ")) (lprefix (concat ch-prefix " "))) @@ -149,7 +149,7 @@ If CLASS is actually an object, then also display current values of that object. (defun eieio-help-class-slots (class) "Print help description for the slots in CLASS. Outputs to the current buffer." - (let* ((cv (class-v class)) + (let* ((cv (eieio--class-v class)) (docs (eieio--class-public-doc cv)) (names (eieio--class-public-a cv)) (deflt (eieio--class-public-d cv)) @@ -231,7 +231,7 @@ If INSTANTIABLE-ONLY is non nil, only allow names of classes which are not abstract, otherwise allow all classes. Optional argument BUILDLIST is more list to attach and is used internally." (let* ((cc (or class eieio-default-superclass)) - (sublst (eieio--class-children (class-v cc)))) + (sublst (eieio--class-children (eieio--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 @@ -637,7 +637,7 @@ current expansion depth." (defun eieio-class-button (class depth) "Draw a speedbar button at the current point for CLASS at DEPTH." (eieio--check-type class-p class) - (let ((subclasses (eieio--class-children (class-v class)))) + (let ((subclasses (eieio--class-children (eieio--class-v class)))) (if subclasses (speedbar-make-tag-line 'angle ?+ 'eieio-sb-expand @@ -662,7 +662,7 @@ Argument INDENT is the depth of indentation." (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) - (let ((subclasses (eieio--class-children (class-v class)))) + (let ((subclasses (eieio--class-children (eieio--class-v class)))) (while subclasses (eieio-class-button (car subclasses) (1+ indent)) (setq subclasses (cdr subclasses))))))) diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index 85b9cc64a7d..1d031c3e7cc 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el @@ -1,4 +1,4 @@ -;;; eieio-speedbar.el -- Classes for managing speedbar displays. +;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*- ;; Copyright (C) 1999-2002, 2005, 2007-2014 Free Software Foundation, ;; Inc. @@ -200,7 +200,7 @@ that path." "Return a string describing OBJECT." (eieio-object-name-string object)) -(defmethod eieio-speedbar-derive-line-path (object) +(defmethod eieio-speedbar-derive-line-path (_object) "Return the path which OBJECT has something to do with." nil) @@ -321,7 +321,7 @@ Argument DEPTH is the depth at which the tag line is inserted." (if exp (eieio-speedbar-expand object (1+ depth)))))) -(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth) +(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth) "Base method for creating tag lines for non-object children." (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s" (eieio-object-name object))) @@ -340,7 +340,7 @@ OBJECT." ;;; Speedbar specific function callbacks. ;; -(defun eieio-speedbar-object-click (text token indent) +(defun eieio-speedbar-object-click (_text token _indent) "Handle a user click on TEXT representing object TOKEN. The object is at indentation level INDENT." (eieio-speedbar-handle-click token)) @@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at." ;;; Methods to the eieio-speedbar-* classes which need to be overridden. ;; -(defmethod eieio-speedbar-object-children ((object eieio-speedbar)) +(defmethod eieio-speedbar-object-children ((_object eieio-speedbar)) "Return a list of children to be displayed in speedbar. If the return value is a list of OBJECTs, then those objects are queried for details. If the return list is made of strings, diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 93688ba4e3a..f4e1d246011 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -191,7 +191,16 @@ Summary: ((typearg class-name) arg2 &optional opt &rest rest) \"doc-string\" body)" - (declare (doc-string 3)) + (declare (doc-string 3) + (debug + (&define ; this means we are defining something + [&or name ("setf" :name setf name)] + ;; ^^ This is the methods symbol + [ &optional symbolp ] ; this is key :before etc + list ; arguments + [ &optional stringp ] ; documentation string + def-body ; part to be debugged + ))) (let* ((key (if (keywordp (car args)) (pop args))) (params (car args)) (arg1 (car params)) @@ -213,6 +222,7 @@ Summary: "Retrieve the value stored in OBJ in the slot named by SLOT. Slot is the name of the slot when created by `defclass' or the label created by the :initarg tag." + (declare (debug (form symbolp))) `(eieio-oref ,obj (quote ,slot))) (defalias 'slot-value 'eieio-oref) @@ -223,6 +233,7 @@ created by the :initarg tag." The default value is the value installed in a class with the :initform tag. SLOT can be the slot name, or the tag specified by the :initarg tag in the `defclass' call." + (declare (debug (form symbolp))) `(eieio-oref-default ,obj (quote ,slot))) ;;; Handy CLOS macros @@ -246,7 +257,7 @@ SPEC-LIST is of a form similar to `let'. For example: Where each VAR is the local variable given to the associated SLOT. A slot specified without a variable name is given a variable name of the same name as the slot." - (declare (indent 2)) + (declare (indent 2) (debug (sexp sexp def-body))) (require 'cl-lib) ;; Transform the spec-list into a cl-symbol-macrolet spec-list. (let ((mappings (mapcar (lambda (entry) @@ -348,7 +359,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." (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))) + (setq p (append p (eieio--class-parent (eieio--class-v child))) child (car p) p (cdr p))) (if child t)))) @@ -356,11 +367,11 @@ The CLOS function `class-direct-subclasses' is aliased to this function." (defun object-slots (obj) "Return list of slots available in OBJ." (eieio--check-type eieio-object-p obj) - (eieio--class-public-a (class-v (eieio--object-class obj)))) + (eieio--class-public-a (eieio--class-v (eieio--object-class obj)))) (defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." (eieio--check-type class-p class) - (let ((ia (eieio--class-initarg-tuples (class-v class))) + (let ((ia (eieio--class-initarg-tuples (eieio--class-v class))) (f nil)) (while (and ia (not f)) (if (eq (cdr (car ia)) slot) @@ -374,6 +385,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." "Set the value in OBJ for slot SLOT to VALUE. SLOT is the slot name as specified in `defclass' or the tag created with in the :initarg slot. VALUE can be any Lisp object." + (declare (debug (form symbolp form))) `(eieio-oset ,obj (quote ,slot) ,value)) (defmacro oset-default (class slot value) @@ -381,6 +393,7 @@ with in the :initarg slot. VALUE can be any Lisp object." The default value is usually set with the :initform tag during class creation. This allows users to change the default behavior of classes after they are created." + (declare (debug (form symbolp form))) `(eieio-oset-default ,class (quote ,slot) ,value)) ;;; CLOS queries into classes and slots @@ -405,7 +418,7 @@ OBJECT can be an instance or a class." (defun slot-exists-p (object-or-class slot) "Return non-nil if OBJECT-OR-CLASS has SLOT." - (let ((cv (class-v (cond ((eieio-object-p object-or-class) + (let ((cv (eieio--class-v (cond ((eieio-object-p object-or-class) (eieio-object-class object-or-class)) ((class-p object-or-class) object-or-class)) @@ -421,7 +434,7 @@ If ERRORP is non-nil, `wrong-argument-type' is signaled." (if (not (class-p symbol)) (if errorp (signal 'wrong-type-argument (list 'class-p symbol)) nil) - (class-v symbol))) + (eieio--class-v symbol))) ;;; Slightly more complex utility functions for objects ;; @@ -520,8 +533,8 @@ arguments passed in at the top level. Use `next-method-p' to find out if there is a next method to call." (if (not (eieio--scoped-class)) (error "`call-next-method' not called within a class specific method")) - (if (and (/= eieio-generic-call-key method-primary) - (/= eieio-generic-call-key method-static)) + (if (and (/= eieio-generic-call-key eieio--method-primary) + (/= eieio-generic-call-key eieio--method-static)) (error "Cannot `call-next-method' except in :primary or :static methods") ) (let ((newargs (or replacement-args eieio-generic-call-arglst)) @@ -572,7 +585,7 @@ SLOTS are the initialization slots used by `shared-initialize'. This static method is called when an object is constructed. It allocates the vector used to represent an EIEIO object, and then calls `shared-initialize' on that object." - (let* ((new-object (copy-sequence (eieio--class-default-object-cache (class-v class))))) + (let* ((new-object (copy-sequence (eieio--class-default-object-cache (eieio--class-v class))))) ;; Update the name for the newly created object. (setf (eieio--object-name new-object) newname) ;; Call the initialize method on the new object with the slots @@ -612,7 +625,7 @@ not taken, then new objects of your class will not have their values dynamically set from SLOTS." ;; First, see if any of our defaults are `lambda', and ;; re-evaluate them and apply the value to our slots. - (let* ((this-class (class-v (eieio--object-class this))) + (let* ((this-class (eieio--class-v (eieio--object-class this))) (slot (eieio--class-public-a this-class)) (defaults (eieio--class-public-d this-class))) (while slot @@ -767,7 +780,7 @@ this object." (princ comment) (princ "\n")) (let* ((cl (eieio-object-class this)) - (cv (class-v cl))) + (cv (eieio--class-v cl))) ;; Now output readable lisp to recreate this object ;; It should look like this: ;; ( ... ) @@ -870,35 +883,13 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to ")")) (t (funcall print-function object noescape)))) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec defmethod - (&define ; this means we are defining something - [&or name ("setf" :name setf name)] - ;; ^^ This is the methods symbol - [ &optional symbolp ] ; this is key :before etc - list ; arguments - [ &optional stringp ] ; documentation string - def-body ; part to be debugged - )) - ;; The rest of the macros - (def-edebug-spec oref (form quote)) - (def-edebug-spec oref-default (form quote)) - (def-edebug-spec oset (form quote form)) - (def-edebug-spec oset-default (form quote form)) - (def-edebug-spec class-v form) - (def-edebug-spec class-p form) - (def-edebug-spec eieio-object-p form) - (def-edebug-spec class-constructor form) - (def-edebug-spec generic-p form) - (def-edebug-spec with-slots (list list def-body)) - (advice-add 'edebug-prin1-to-string - :around #'eieio-edebug-prin1-to-string))) +(advice-add 'edebug-prin1-to-string + :around #'eieio-edebug-prin1-to-string) ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "ab711689b2bae8a7d8c4b1e99c892306") +;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "6413249ec10091eb7094238637b40e2c") ;;; Generated autoloads from eieio-custom.el (autoload 'customize-object "eieio-custom" "\ @@ -909,7 +900,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;*** -;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "e50a67ebd0c6258c615e4bf16714e81f") +;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6f114a48de40212413d2776eedc3ec14") ;;; Generated autoloads from eieio-opt.el (autoload 'eieio-browse "eieio-opt" "\ diff --git a/test/automated/eieio-test-persist.el b/test/automated/eieio-test-persist.el index 6869c7e4b3b..d6f53cd9db2 100644 --- a/test/automated/eieio-test-persist.el +++ b/test/automated/eieio-test-persist.el @@ -40,7 +40,7 @@ (let* ((file (oref original :file)) (class (eieio-object-class original)) (fromdisk (eieio-persistent-read file class)) - (cv (class-v class)) + (cv (eieio--class-v class)) (slot-names (eieio--class-public-a cv)) (slot-deflt (eieio--class-public-d cv)) ) diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el index 9a8886231d1..87151f6a0da 100644 --- a/test/automated/eieio-tests.el +++ b/test/automated/eieio-tests.el @@ -794,7 +794,7 @@ Subclasses to override slot attributes.") (should (eq (oref-default slotattr-class-ok initform) 'no-init))) (ert-deftest eieio-test-32-slot-attribute-override-2 () - (let* ((cv (class-v 'slotattr-ok)) + (let* ((cv (eieio--class-v 'slotattr-ok)) (docs (eieio--class-public-doc cv)) (names (eieio--class-public-a cv)) (cust (eieio--class-public-custom cv))