diff options
| author | Stefan Monnier | 2014-12-22 15:46:16 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2014-12-22 15:46:16 -0500 |
| commit | d4a12e7a9a46bbff2f9c4d59ecc284621634a2e8 (patch) | |
| tree | f1e00bb4723a4f3c81f3d252e3224f237038c713 | |
| parent | bcebc831bb9c1fd82b4693e6a091a4cf591dc3ec (diff) | |
| download | emacs-d4a12e7a9a46bbff2f9c4d59ecc284621634a2e8.tar.gz emacs-d4a12e7a9a46bbff2f9c4d59ecc284621634a2e8.zip | |
* 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.
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-base.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 204 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-custom.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-datadebug.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-opt.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-speedbar.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 67 | ||||
| -rw-r--r-- | test/automated/eieio-test-persist.el | 2 | ||||
| -rw-r--r-- | test/automated/eieio-tests.el | 2 |
10 files changed, 159 insertions, 159 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c2f45845306..739d442c55b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,14 @@ | |||
| 1 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v. | ||
| 4 | (method-*): Add a "eieio--" prefix to those constants. | ||
| 5 | |||
| 6 | * emacs-lisp/eieio.el: Move edebug specs to the corresponding macro. | ||
| 7 | |||
| 8 | * emacs-lisp/eieio-speedbar.el: Use lexical-binding. | ||
| 9 | |||
| 10 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 11 | |||
| 3 | * emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is | 12 | * emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is |
| 4 | `eieio-default-superclass'. | 13 | `eieio-default-superclass'. |
| 5 | 14 | ||
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." | |||
| 309 | (type nil) | 309 | (type nil) |
| 310 | (classtype nil)) | 310 | (classtype nil)) |
| 311 | (setq slot-idx (- slot-idx 3)) | 311 | (setq slot-idx (- slot-idx 3)) |
| 312 | (setq type (aref (eieio--class-public-type (class-v class)) | 312 | (setq type (aref (eieio--class-public-type (eieio--class-v class)) |
| 313 | slot-idx)) | 313 | slot-idx)) |
| 314 | 314 | ||
| 315 | (setq classtype (eieio-persistent-slot-type-is-class-p | 315 | (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."))) | |||
| 171 | name)) ;FIXME: Get rid of this field! | 171 | name)) ;FIXME: Get rid of this field! |
| 172 | 172 | ||
| 173 | ;; FIXME: The constants below should have an `eieio-' prefix added!! | 173 | ;; FIXME: The constants below should have an `eieio-' prefix added!! |
| 174 | 174 | (defconst eieio--method-static 0 "Index into :static tag on a method.") | |
| 175 | (defconst method-static 0 "Index into :static tag on a method.") | 175 | (defconst eieio--method-before 1 "Index into :before tag on a method.") |
| 176 | (defconst method-before 1 "Index into :before tag on a method.") | 176 | (defconst eieio--method-primary 2 "Index into :primary tag on a method.") |
| 177 | (defconst method-primary 2 "Index into :primary tag on a method.") | 177 | (defconst eieio--method-after 3 "Index into :after tag on a method.") |
| 178 | (defconst method-after 3 "Index into :after tag on a method.") | 178 | (defconst eieio--method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") |
| 179 | (defconst method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") | 179 | (defconst eieio--method-generic-before 4 "Index into generic :before tag on a method.") |
| 180 | (defconst method-generic-before 4 "Index into generic :before tag on a method.") | 180 | (defconst eieio--method-generic-primary 5 "Index into generic :primary tag on a method.") |
| 181 | (defconst method-generic-primary 5 "Index into generic :primary tag on a method.") | 181 | (defconst eieio--method-generic-after 6 "Index into generic :after tag on a method.") |
| 182 | (defconst method-generic-after 6 "Index into generic :after tag on a method.") | 182 | (defconst eieio--method-num-slots 7 "Number of indexes into a method's vector.") |
| 183 | (defconst method-num-slots 7 "Number of indexes into a method's vector.") | ||
| 184 | 183 | ||
| 185 | (defsubst eieio-specialized-key-to-generic-key (key) | 184 | (defsubst eieio-specialized-key-to-generic-key (key) |
| 186 | "Convert a specialized KEY into a generic method key." | 185 | "Convert a specialized KEY into a generic method key." |
| 187 | (cond ((eq key method-static) 0) ;; don't convert | 186 | (cond ((eq key eieio--method-static) 0) ;; don't convert |
| 188 | ((< key method-num-lists) (+ key 3)) ;; The conversion | 187 | ((< key eieio--method-num-lists) (+ key 3)) ;; The conversion |
| 189 | (t key) ;; already generic.. maybe. | 188 | (t key) ;; already generic.. maybe. |
| 190 | )) | 189 | )) |
| 191 | 190 | ||
| @@ -201,8 +200,9 @@ Stored outright without modifications or stripping."))) | |||
| 201 | (t `(,type ,obj)))) | 200 | (t `(,type ,obj)))) |
| 202 | (signal 'wrong-type-argument (list ',type ,obj)))) | 201 | (signal 'wrong-type-argument (list ',type ,obj)))) |
| 203 | 202 | ||
| 204 | (defmacro class-v (class) | 203 | (defmacro eieio--class-v (class) |
| 205 | "Internal: Return the class vector from the CLASS symbol." | 204 | "Internal: Return the class vector from the CLASS symbol." |
| 205 | (declare (debug t)) | ||
| 206 | ;; No check: If eieio gets this far, it has probably been checked already. | 206 | ;; No check: If eieio gets this far, it has probably been checked already. |
| 207 | `(get ,class 'eieio-class-definition)) | 207 | `(get ,class 'eieio-class-definition)) |
| 208 | 208 | ||
| @@ -212,7 +212,7 @@ CLASS is a symbol." | |||
| 212 | ;; this new method is faster since it doesn't waste time checking lots of | 212 | ;; this new method is faster since it doesn't waste time checking lots of |
| 213 | ;; things. | 213 | ;; things. |
| 214 | (condition-case nil | 214 | (condition-case nil |
| 215 | (eq (aref (class-v class) 0) 'defclass) | 215 | (eq (aref (eieio--class-v class) 0) 'defclass) |
| 216 | (error nil))) | 216 | (error nil))) |
| 217 | 217 | ||
| 218 | (defun eieio-class-name (class) "Return a Lisp like symbol name for CLASS." | 218 | (defun eieio-class-name (class) "Return a Lisp like symbol name for CLASS." |
| @@ -224,10 +224,10 @@ CLASS is a symbol." | |||
| 224 | 224 | ||
| 225 | (defmacro eieio-class-parents-fast (class) | 225 | (defmacro eieio-class-parents-fast (class) |
| 226 | "Return parent classes to CLASS with no check." | 226 | "Return parent classes to CLASS with no check." |
| 227 | `(eieio--class-parent (class-v ,class))) | 227 | `(eieio--class-parent (eieio--class-v ,class))) |
| 228 | 228 | ||
| 229 | (defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." | 229 | (defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." |
| 230 | `(eieio--class-children (class-v ,class))) | 230 | `(eieio--class-children (eieio--class-v ,class))) |
| 231 | 231 | ||
| 232 | (defmacro same-class-fast-p (obj class) | 232 | (defmacro same-class-fast-p (obj class) |
| 233 | "Return t if OBJ is of class-type CLASS with no error checking." | 233 | "Return t if OBJ is of class-type CLASS with no error checking." |
| @@ -235,7 +235,8 @@ CLASS is a symbol." | |||
| 235 | 235 | ||
| 236 | (defmacro class-constructor (class) | 236 | (defmacro class-constructor (class) |
| 237 | "Return the symbol representing the constructor of CLASS." | 237 | "Return the symbol representing the constructor of CLASS." |
| 238 | `(eieio--class-symbol (class-v ,class))) | 238 | (declare (debug t)) |
| 239 | `(eieio--class-symbol (eieio--class-v ,class))) | ||
| 239 | 240 | ||
| 240 | (defsubst generic-p (method) | 241 | (defsubst generic-p (method) |
| 241 | "Return non-nil if symbol METHOD is a generic function. | 242 | "Return non-nil if symbol METHOD is a generic function. |
| @@ -250,13 +251,13 @@ contains a list of all bindings to that method type.) | |||
| 250 | Methods with only primary implementations are executed in an optimized way." | 251 | Methods with only primary implementations are executed in an optimized way." |
| 251 | (and (generic-p method) | 252 | (and (generic-p method) |
| 252 | (let ((M (get method 'eieio-method-tree))) | 253 | (let ((M (get method 'eieio-method-tree))) |
| 253 | (not (or (>= 0 (length (aref M method-primary))) | 254 | (not (or (>= 0 (length (aref M eieio--method-primary))) |
| 254 | (aref M method-static) | 255 | (aref M eieio--method-static) |
| 255 | (aref M method-before) | 256 | (aref M eieio--method-before) |
| 256 | (aref M method-after) | 257 | (aref M eieio--method-after) |
| 257 | (aref M method-generic-before) | 258 | (aref M eieio--method-generic-before) |
| 258 | (aref M method-generic-primary) | 259 | (aref M eieio--method-generic-primary) |
| 259 | (aref M method-generic-after))) | 260 | (aref M eieio--method-generic-after))) |
| 260 | ))) | 261 | ))) |
| 261 | 262 | ||
| 262 | (defun generic-primary-only-one-p (method) | 263 | (defun generic-primary-only-one-p (method) |
| @@ -266,13 +267,13 @@ contains a list of all bindings to that method type.) | |||
| 266 | Methods with only primary implementations are executed in an optimized way." | 267 | Methods with only primary implementations are executed in an optimized way." |
| 267 | (and (generic-p method) | 268 | (and (generic-p method) |
| 268 | (let ((M (get method 'eieio-method-tree))) | 269 | (let ((M (get method 'eieio-method-tree))) |
| 269 | (not (or (/= 1 (length (aref M method-primary))) | 270 | (not (or (/= 1 (length (aref M eieio--method-primary))) |
| 270 | (aref M method-static) | 271 | (aref M eieio--method-static) |
| 271 | (aref M method-before) | 272 | (aref M eieio--method-before) |
| 272 | (aref M method-after) | 273 | (aref M eieio--method-after) |
| 273 | (aref M method-generic-before) | 274 | (aref M eieio--method-generic-before) |
| 274 | (aref M method-generic-primary) | 275 | (aref M eieio--method-generic-primary) |
| 275 | (aref M method-generic-after))) | 276 | (aref M eieio--method-generic-after))) |
| 276 | ))) | 277 | ))) |
| 277 | 278 | ||
| 278 | (defmacro class-option-assoc (list option) | 279 | (defmacro class-option-assoc (list option) |
| @@ -282,7 +283,7 @@ Methods with only primary implementations are executed in an optimized way." | |||
| 282 | (defmacro class-option (class option) | 283 | (defmacro class-option (class option) |
| 283 | "Return the value stored for CLASS' OPTION. | 284 | "Return the value stored for CLASS' OPTION. |
| 284 | Return nil if that option doesn't exist." | 285 | Return nil if that option doesn't exist." |
| 285 | `(class-option-assoc (eieio--class-options (class-v ,class)) ',option)) | 286 | `(class-option-assoc (eieio--class-options (eieio--class-v ,class)) ',option)) |
| 286 | 287 | ||
| 287 | (defsubst eieio-object-p (obj) | 288 | (defsubst eieio-object-p (obj) |
| 288 | "Return non-nil if OBJ is an EIEIO object." | 289 | "Return non-nil if OBJ is an EIEIO object." |
| @@ -322,7 +323,7 @@ SUPERCLASSES as children. | |||
| 322 | It creates an autoload function for CNAME's constructor." | 323 | It creates an autoload function for CNAME's constructor." |
| 323 | ;; Assume we've already debugged inputs. | 324 | ;; Assume we've already debugged inputs. |
| 324 | 325 | ||
| 325 | (let* ((oldc (when (class-p cname) (class-v cname))) | 326 | (let* ((oldc (when (class-p cname) (eieio--class-v cname))) |
| 326 | (newc (make-vector eieio--class-num-slots nil)) | 327 | (newc (make-vector eieio--class-num-slots nil)) |
| 327 | ) | 328 | ) |
| 328 | (if oldc | 329 | (if oldc |
| @@ -350,7 +351,7 @@ It creates an autoload function for CNAME's constructor." | |||
| 350 | 351 | ||
| 351 | ;; Save the child in the parent. | 352 | ;; Save the child in the parent. |
| 352 | (cl-pushnew cname (if (class-p SC) | 353 | (cl-pushnew cname (if (class-p SC) |
| 353 | (eieio--class-children (class-v SC)) | 354 | (eieio--class-children (eieio--class-v SC)) |
| 354 | ;; Parent doesn't exist yet. | 355 | ;; Parent doesn't exist yet. |
| 355 | (gethash SC eieio-defclass-autoload-map))) | 356 | (gethash SC eieio-defclass-autoload-map))) |
| 356 | 357 | ||
| @@ -364,7 +365,7 @@ It creates an autoload function for CNAME's constructor." | |||
| 364 | ;; do this first so that we can call defmethod for the accessor. | 365 | ;; do this first so that we can call defmethod for the accessor. |
| 365 | ;; The vector will be updated by the following while loop and will not | 366 | ;; The vector will be updated by the following while loop and will not |
| 366 | ;; need to be stored a second time. | 367 | ;; need to be stored a second time. |
| 367 | (put cname 'eieio-class-definition newc) | 368 | (setf (eieio--class-v cname) newc) |
| 368 | 369 | ||
| 369 | ;; Clear the parent | 370 | ;; Clear the parent |
| 370 | (if clear-parent (setf (eieio--class-parent newc) nil)) | 371 | (if clear-parent (setf (eieio--class-parent newc) nil)) |
| @@ -403,7 +404,7 @@ See `defclass' for more information." | |||
| 403 | 404 | ||
| 404 | (let* ((pname superclasses) | 405 | (let* ((pname superclasses) |
| 405 | (newc (make-vector eieio--class-num-slots nil)) | 406 | (newc (make-vector eieio--class-num-slots nil)) |
| 406 | (oldc (when (class-p cname) (class-v cname))) | 407 | (oldc (when (class-p cname) (eieio--class-v cname))) |
| 407 | (groups nil) ;; list of groups id'd from slots | 408 | (groups nil) ;; list of groups id'd from slots |
| 408 | (options nil) | 409 | (options nil) |
| 409 | (clearparent nil)) | 410 | (clearparent nil)) |
| @@ -448,7 +449,7 @@ See `defclass' for more information." | |||
| 448 | (error "Given parent class %S is not a class" p) | 449 | (error "Given parent class %S is not a class" p) |
| 449 | ;; good parent class... | 450 | ;; good parent class... |
| 450 | ;; save new child in parent | 451 | ;; save new child in parent |
| 451 | (cl-pushnew cname (eieio--class-children (class-v p))) | 452 | (cl-pushnew cname (eieio--class-children (eieio--class-v p))) |
| 452 | ;; Get custom groups, and store them into our local copy. | 453 | ;; Get custom groups, and store them into our local copy. |
| 453 | (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) | 454 | (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) |
| 454 | (class-option p :custom-groups)) | 455 | (class-option p :custom-groups)) |
| @@ -465,7 +466,7 @@ See `defclass' for more information." | |||
| 465 | (setq clearparent t) | 466 | (setq clearparent t) |
| 466 | ;; save new child in parent | 467 | ;; save new child in parent |
| 467 | (cl-pushnew cname (eieio--class-children | 468 | (cl-pushnew cname (eieio--class-children |
| 468 | (class-v 'eieio-default-superclass))) | 469 | (eieio--class-v 'eieio-default-superclass))) |
| 469 | ;; save parent in child | 470 | ;; save parent in child |
| 470 | (setf (eieio--class-parent newc) '(eieio-default-superclass)))) | 471 | (setf (eieio--class-parent newc) '(eieio-default-superclass)))) |
| 471 | 472 | ||
| @@ -535,7 +536,7 @@ See `defclass' for more information." | |||
| 535 | ;; do this first so that we can call defmethod for the accessor. | 536 | ;; do this first so that we can call defmethod for the accessor. |
| 536 | ;; The vector will be updated by the following while loop and will not | 537 | ;; The vector will be updated by the following while loop and will not |
| 537 | ;; need to be stored a second time. | 538 | ;; need to be stored a second time. |
| 538 | (put cname 'eieio-class-definition newc) | 539 | (setf (eieio--class-v cname) newc) |
| 539 | 540 | ||
| 540 | ;; Query each slot in the declaration list and mangle into the | 541 | ;; Query each slot in the declaration list and mangle into the |
| 541 | ;; class structure I have defined. | 542 | ;; class structure I have defined. |
| @@ -1019,7 +1020,7 @@ the new child class." | |||
| 1019 | ':allow-nil-initform))) | 1020 | ':allow-nil-initform))) |
| 1020 | (while ps | 1021 | (while ps |
| 1021 | ;; First, duplicate all the slots of the parent. | 1022 | ;; First, duplicate all the slots of the parent. |
| 1022 | (let ((pcv (class-v (car ps)))) | 1023 | (let ((pcv (eieio--class-v (car ps)))) |
| 1023 | (let ((pa (eieio--class-public-a pcv)) | 1024 | (let ((pa (eieio--class-public-a pcv)) |
| 1024 | (pd (eieio--class-public-d pcv)) | 1025 | (pd (eieio--class-public-d pcv)) |
| 1025 | (pdoc (eieio--class-public-doc pcv)) | 1026 | (pdoc (eieio--class-public-doc pcv)) |
| @@ -1163,7 +1164,7 @@ IMPL is the symbol holding the method implementation." | |||
| 1163 | ;; It is ok, do the call. | 1164 | ;; It is ok, do the call. |
| 1164 | ;; Fill in inter-call variables then evaluate the method. | 1165 | ;; Fill in inter-call variables then evaluate the method. |
| 1165 | (let ((eieio-generic-call-next-method-list nil) | 1166 | (let ((eieio-generic-call-next-method-list nil) |
| 1166 | (eieio-generic-call-key method-primary) | 1167 | (eieio-generic-call-key eieio--method-primary) |
| 1167 | (eieio-generic-call-arglst local-args) | 1168 | (eieio-generic-call-arglst local-args) |
| 1168 | ) | 1169 | ) |
| 1169 | (eieio--with-scoped-class class | 1170 | (eieio--with-scoped-class class |
| @@ -1173,7 +1174,7 @@ IMPL is the symbol holding the method implementation." | |||
| 1173 | "Setup METHOD to call the generic form." | 1174 | "Setup METHOD to call the generic form." |
| 1174 | (let* ((doc-string (documentation method 'raw)) | 1175 | (let* ((doc-string (documentation method 'raw)) |
| 1175 | (M (get method 'eieio-method-tree)) | 1176 | (M (get method 'eieio-method-tree)) |
| 1176 | (entry (car (aref M method-primary))) | 1177 | (entry (car (aref M eieio--method-primary))) |
| 1177 | ) | 1178 | ) |
| 1178 | (put method 'function-documentation doc-string) | 1179 | (put method 'function-documentation doc-string) |
| 1179 | (fset method (eieio-defgeneric-form-primary-only-one | 1180 | (fset method (eieio-defgeneric-form-primary-only-one |
| @@ -1190,12 +1191,12 @@ but remove reference to all implementations of METHOD." | |||
| 1190 | "Work part of the `defmethod' macro defining METHOD with ARGS." | 1191 | "Work part of the `defmethod' macro defining METHOD with ARGS." |
| 1191 | (let ((key | 1192 | (let ((key |
| 1192 | ;; Find optional keys. | 1193 | ;; Find optional keys. |
| 1193 | (cond ((memq kind '(:BEFORE :before)) method-before) | 1194 | (cond ((memq kind '(:BEFORE :before)) eieio--method-before) |
| 1194 | ((memq kind '(:AFTER :after)) method-after) | 1195 | ((memq kind '(:AFTER :after)) eieio--method-after) |
| 1195 | ((memq kind '(:STATIC :static)) method-static) | 1196 | ((memq kind '(:STATIC :static)) eieio--method-static) |
| 1196 | ((memq kind '(:PRIMARY :primary nil)) method-primary) | 1197 | ((memq kind '(:PRIMARY :primary nil)) eieio--method-primary) |
| 1197 | ;; Primary key. | 1198 | ;; Primary key. |
| 1198 | ;; (t method-primary) | 1199 | ;; (t eieio--method-primary) |
| 1199 | (t (error "Unknown method kind %S" kind))))) | 1200 | (t (error "Unknown method kind %S" kind))))) |
| 1200 | ;; Make sure there is a generic (when called from defclass). | 1201 | ;; Make sure there is a generic (when called from defclass). |
| 1201 | (eieio--defalias | 1202 | (eieio--defalias |
| @@ -1253,7 +1254,7 @@ an error." | |||
| 1253 | nil | 1254 | nil |
| 1254 | ;; Trim off object IDX junk added in for the object index. | 1255 | ;; Trim off object IDX junk added in for the object index. |
| 1255 | (setq slot-idx (- slot-idx 3)) | 1256 | (setq slot-idx (- slot-idx 3)) |
| 1256 | (let ((st (aref (eieio--class-public-type (class-v class)) slot-idx))) | 1257 | (let ((st (aref (eieio--class-public-type (eieio--class-v class)) slot-idx))) |
| 1257 | (if (not (eieio-perform-slot-validation st value)) | 1258 | (if (not (eieio-perform-slot-validation st value)) |
| 1258 | (signal 'invalid-slot-type (list class slot st value)))))) | 1259 | (signal 'invalid-slot-type (list class slot st value)))))) |
| 1259 | 1260 | ||
| @@ -1264,7 +1265,7 @@ SLOT is the slot that is being checked, and is only used when throwing | |||
| 1264 | an error." | 1265 | an error." |
| 1265 | (if eieio-skip-typecheck | 1266 | (if eieio-skip-typecheck |
| 1266 | nil | 1267 | nil |
| 1267 | (let ((st (aref (eieio--class-class-allocation-type (class-v class)) | 1268 | (let ((st (aref (eieio--class-class-allocation-type (eieio--class-v class)) |
| 1268 | slot-idx))) | 1269 | slot-idx))) |
| 1269 | (if (not (eieio-perform-slot-validation st value)) | 1270 | (if (not (eieio-perform-slot-validation st value)) |
| 1270 | (signal 'invalid-slot-type (list class slot st value)))))) | 1271 | (signal 'invalid-slot-type (list class slot st value)))))) |
| @@ -1293,7 +1294,7 @@ Argument FN is the function calling this verifier." | |||
| 1293 | ;; Let's check that info out. | 1294 | ;; Let's check that info out. |
| 1294 | (if (setq c (eieio-class-slot-name-index class slot)) | 1295 | (if (setq c (eieio-class-slot-name-index class slot)) |
| 1295 | ;; Oref that slot. | 1296 | ;; Oref that slot. |
| 1296 | (aref (eieio--class-class-allocation-values (class-v class)) c) | 1297 | (aref (eieio--class-class-allocation-values (eieio--class-v class)) c) |
| 1297 | ;; The slot-missing method is a cool way of allowing an object author | 1298 | ;; The slot-missing method is a cool way of allowing an object author |
| 1298 | ;; to intercept missing slot definitions. Since it is also the LAST | 1299 | ;; to intercept missing slot definitions. Since it is also the LAST |
| 1299 | ;; thing called in this fn, its return value would be retrieved. | 1300 | ;; thing called in this fn, its return value would be retrieved. |
| @@ -1317,13 +1318,13 @@ Fills in OBJ's SLOT with its default value." | |||
| 1317 | (if (setq c | 1318 | (if (setq c |
| 1318 | (eieio-class-slot-name-index cl slot)) | 1319 | (eieio-class-slot-name-index cl slot)) |
| 1319 | ;; Oref that slot. | 1320 | ;; Oref that slot. |
| 1320 | (aref (eieio--class-class-allocation-values (class-v cl)) | 1321 | (aref (eieio--class-class-allocation-values (eieio--class-v cl)) |
| 1321 | c) | 1322 | c) |
| 1322 | (slot-missing obj slot 'oref-default) | 1323 | (slot-missing obj slot 'oref-default) |
| 1323 | ;;(signal 'invalid-slot-name (list (class-name cl) slot)) | 1324 | ;;(signal 'invalid-slot-name (list (class-name cl) slot)) |
| 1324 | ) | 1325 | ) |
| 1325 | (eieio-barf-if-slot-unbound | 1326 | (eieio-barf-if-slot-unbound |
| 1326 | (let ((val (nth (- c 3) (eieio--class-public-d (class-v cl))))) | 1327 | (let ((val (nth (- c 3) (eieio--class-public-d (eieio--class-v cl))))) |
| 1327 | (eieio-default-eval-maybe val)) | 1328 | (eieio-default-eval-maybe val)) |
| 1328 | obj cl 'oref-default)))) | 1329 | obj cl 'oref-default)))) |
| 1329 | 1330 | ||
| @@ -1353,7 +1354,7 @@ Fills in OBJ's SLOT with VALUE." | |||
| 1353 | ;; Oset that slot. | 1354 | ;; Oset that slot. |
| 1354 | (progn | 1355 | (progn |
| 1355 | (eieio-validate-class-slot-value (eieio--object-class obj) c value slot) | 1356 | (eieio-validate-class-slot-value (eieio--object-class obj) c value slot) |
| 1356 | (aset (eieio--class-class-allocation-values (class-v (eieio--object-class obj))) | 1357 | (aset (eieio--class-class-allocation-values (eieio--class-v (eieio--object-class obj))) |
| 1357 | c value)) | 1358 | c value)) |
| 1358 | ;; See oref for comment on `slot-missing' | 1359 | ;; See oref for comment on `slot-missing' |
| 1359 | (slot-missing obj slot 'oset value) | 1360 | (slot-missing obj slot 'oset value) |
| @@ -1376,15 +1377,15 @@ Fills in the default value in CLASS' in SLOT with VALUE." | |||
| 1376 | (progn | 1377 | (progn |
| 1377 | ;; Oref that slot. | 1378 | ;; Oref that slot. |
| 1378 | (eieio-validate-class-slot-value class c value slot) | 1379 | (eieio-validate-class-slot-value class c value slot) |
| 1379 | (aset (eieio--class-class-allocation-values (class-v class)) c | 1380 | (aset (eieio--class-class-allocation-values (eieio--class-v class)) c |
| 1380 | value)) | 1381 | value)) |
| 1381 | (signal 'invalid-slot-name (list (eieio-class-name class) slot))) | 1382 | (signal 'invalid-slot-name (list (eieio-class-name class) slot))) |
| 1382 | (eieio-validate-slot-value class c value slot) | 1383 | (eieio-validate-slot-value class c value slot) |
| 1383 | ;; Set this into the storage for defaults. | 1384 | ;; Set this into the storage for defaults. |
| 1384 | (setcar (nthcdr (- c 3) (eieio--class-public-d (class-v class))) | 1385 | (setcar (nthcdr (- c 3) (eieio--class-public-d (eieio--class-v class))) |
| 1385 | value) | 1386 | value) |
| 1386 | ;; Take the value, and put it into our cache object. | 1387 | ;; Take the value, and put it into our cache object. |
| 1387 | (eieio-oset (eieio--class-default-object-cache (class-v class)) | 1388 | (eieio-oset (eieio--class-default-object-cache (eieio--class-v class)) |
| 1388 | slot value) | 1389 | slot value) |
| 1389 | )))) | 1390 | )))) |
| 1390 | 1391 | ||
| @@ -1400,7 +1401,7 @@ so that we can protect private slots." | |||
| 1400 | (if (not par) | 1401 | (if (not par) |
| 1401 | t | 1402 | t |
| 1402 | (while (and par ret) | 1403 | (while (and par ret) |
| 1403 | (if (gethash slot (eieio--class-symbol-hashtable (class-v (car par)))) | 1404 | (if (gethash slot (eieio--class-symbol-hashtable (eieio--class-v (car par)))) |
| 1404 | (setq ret nil)) | 1405 | (setq ret nil)) |
| 1405 | (setq par (cdr par))) | 1406 | (setq par (cdr par))) |
| 1406 | ret))) | 1407 | ret))) |
| @@ -1414,7 +1415,7 @@ scoped class. | |||
| 1414 | If SLOT is the value created with :initarg instead, | 1415 | If SLOT is the value created with :initarg instead, |
| 1415 | reverse-lookup that name, and recurse with the associated slot value." | 1416 | reverse-lookup that name, and recurse with the associated slot value." |
| 1416 | ;; Removed checks to outside this call | 1417 | ;; Removed checks to outside this call |
| 1417 | (let* ((fsym (gethash slot (eieio--class-symbol-hashtable (class-v class)))) | 1418 | (let* ((fsym (gethash slot (eieio--class-symbol-hashtable (eieio--class-v class)))) |
| 1418 | (fsi (car fsym))) | 1419 | (fsi (car fsym))) |
| 1419 | (if (integerp fsi) | 1420 | (if (integerp fsi) |
| 1420 | (cond | 1421 | (cond |
| @@ -1442,7 +1443,7 @@ call. If SLOT is the value created with :initarg instead, | |||
| 1442 | reverse-lookup that name, and recurse with the associated slot value." | 1443 | reverse-lookup that name, and recurse with the associated slot value." |
| 1443 | ;; This will happen less often, and with fewer slots. Do this the | 1444 | ;; This will happen less often, and with fewer slots. Do this the |
| 1444 | ;; storage cheap way. | 1445 | ;; storage cheap way. |
| 1445 | (let* ((a (eieio--class-class-allocation-a (class-v class))) | 1446 | (let* ((a (eieio--class-class-allocation-a (eieio--class-v class))) |
| 1446 | (l1 (length a)) | 1447 | (l1 (length a)) |
| 1447 | (af (memq slot a)) | 1448 | (af (memq slot a)) |
| 1448 | (l2 (length af))) | 1449 | (l2 (length af))) |
| @@ -1461,7 +1462,7 @@ reset. If SET-ALL is nil, the slots are only reset if the default is | |||
| 1461 | not nil." | 1462 | not nil." |
| 1462 | (eieio--with-scoped-class (eieio--object-class obj) | 1463 | (eieio--with-scoped-class (eieio--object-class obj) |
| 1463 | (let ((eieio-initializing-object t) | 1464 | (let ((eieio-initializing-object t) |
| 1464 | (pub (eieio--class-public-a (class-v (eieio--object-class obj))))) | 1465 | (pub (eieio--class-public-a (eieio--class-v (eieio--object-class obj))))) |
| 1465 | (while pub | 1466 | (while pub |
| 1466 | (let ((df (eieio-oref-default obj (car pub)))) | 1467 | (let ((df (eieio-oref-default obj (car pub)))) |
| 1467 | (if (or df set-all) | 1468 | (if (or df set-all) |
| @@ -1472,7 +1473,7 @@ not nil." | |||
| 1472 | "For CLASS, convert INITARG to the actual attribute name. | 1473 | "For CLASS, convert INITARG to the actual attribute name. |
| 1473 | If there is no translation, pass it in directly (so we can cheat if | 1474 | If there is no translation, pass it in directly (so we can cheat if |
| 1474 | need be... May remove that later...)" | 1475 | need be... May remove that later...)" |
| 1475 | (let ((tuple (assoc initarg (eieio--class-initarg-tuples (class-v class))))) | 1476 | (let ((tuple (assoc initarg (eieio--class-initarg-tuples (eieio--class-v class))))) |
| 1476 | (if tuple | 1477 | (if tuple |
| 1477 | (cdr tuple) | 1478 | (cdr tuple) |
| 1478 | nil))) | 1479 | nil))) |
| @@ -1480,7 +1481,7 @@ need be... May remove that later...)" | |||
| 1480 | (defun eieio-attribute-to-initarg (class attribute) | 1481 | (defun eieio-attribute-to-initarg (class attribute) |
| 1481 | "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag. | 1482 | "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag. |
| 1482 | This is usually a symbol that starts with `:'." | 1483 | This is usually a symbol that starts with `:'." |
| 1483 | (let ((tuple (rassoc attribute (eieio--class-initarg-tuples (class-v class))))) | 1484 | (let ((tuple (rassoc attribute (eieio--class-initarg-tuples (eieio--class-v class))))) |
| 1484 | (if tuple | 1485 | (if tuple |
| 1485 | (car tuple) | 1486 | (car tuple) |
| 1486 | nil))) | 1487 | nil))) |
| @@ -1666,34 +1667,34 @@ This should only be called from a generic function." | |||
| 1666 | ;; :after methods | 1667 | ;; :after methods |
| 1667 | (setq tlambdas | 1668 | (setq tlambdas |
| 1668 | (if mclass | 1669 | (if mclass |
| 1669 | (eieiomt-method-list method method-after mclass) | 1670 | (eieiomt-method-list method eieio--method-after mclass) |
| 1670 | (list (eieio-generic-form method method-after nil))) | 1671 | (list (eieio-generic-form method eieio--method-after nil))) |
| 1671 | ;;(or (and mclass (eieio-generic-form method method-after mclass)) | 1672 | ;;(or (and mclass (eieio-generic-form method eieio--method-after mclass)) |
| 1672 | ;; (eieio-generic-form method method-after nil)) | 1673 | ;; (eieio-generic-form method eieio--method-after nil)) |
| 1673 | ) | 1674 | ) |
| 1674 | (setq lambdas (append tlambdas lambdas) | 1675 | (setq lambdas (append tlambdas lambdas) |
| 1675 | keys (append (make-list (length tlambdas) method-after) keys)) | 1676 | keys (append (make-list (length tlambdas) eieio--method-after) keys)) |
| 1676 | 1677 | ||
| 1677 | ;; :primary methods | 1678 | ;; :primary methods |
| 1678 | (setq tlambdas | 1679 | (setq tlambdas |
| 1679 | (or (and mclass (eieio-generic-form method method-primary mclass)) | 1680 | (or (and mclass (eieio-generic-form method eieio--method-primary mclass)) |
| 1680 | (eieio-generic-form method method-primary nil))) | 1681 | (eieio-generic-form method eieio--method-primary nil))) |
| 1681 | (when tlambdas | 1682 | (when tlambdas |
| 1682 | (setq lambdas (cons tlambdas lambdas) | 1683 | (setq lambdas (cons tlambdas lambdas) |
| 1683 | keys (cons method-primary keys) | 1684 | keys (cons eieio--method-primary keys) |
| 1684 | primarymethodlist | 1685 | primarymethodlist |
| 1685 | (eieiomt-method-list method method-primary mclass))) | 1686 | (eieiomt-method-list method eieio--method-primary mclass))) |
| 1686 | 1687 | ||
| 1687 | ;; :before methods | 1688 | ;; :before methods |
| 1688 | (setq tlambdas | 1689 | (setq tlambdas |
| 1689 | (if mclass | 1690 | (if mclass |
| 1690 | (eieiomt-method-list method method-before mclass) | 1691 | (eieiomt-method-list method eieio--method-before mclass) |
| 1691 | (list (eieio-generic-form method method-before nil))) | 1692 | (list (eieio-generic-form method eieio--method-before nil))) |
| 1692 | ;;(or (and mclass (eieio-generic-form method method-before mclass)) | 1693 | ;;(or (and mclass (eieio-generic-form method eieio--method-before mclass)) |
| 1693 | ;; (eieio-generic-form method method-before nil)) | 1694 | ;; (eieio-generic-form method eieio--method-before nil)) |
| 1694 | ) | 1695 | ) |
| 1695 | (setq lambdas (append tlambdas lambdas) | 1696 | (setq lambdas (append tlambdas lambdas) |
| 1696 | keys (append (make-list (length tlambdas) method-before) keys)) | 1697 | keys (append (make-list (length tlambdas) eieio--method-before) keys)) |
| 1697 | ) | 1698 | ) |
| 1698 | 1699 | ||
| 1699 | (if mclass | 1700 | (if mclass |
| @@ -1701,20 +1702,20 @@ This should only be called from a generic function." | |||
| 1701 | ;; if there were no methods found, then there could be :static methods. | 1702 | ;; if there were no methods found, then there could be :static methods. |
| 1702 | (when (not lambdas) | 1703 | (when (not lambdas) |
| 1703 | (setq tlambdas | 1704 | (setq tlambdas |
| 1704 | (eieio-generic-form method method-static mclass)) | 1705 | (eieio-generic-form method eieio--method-static mclass)) |
| 1705 | (setq lambdas (cons tlambdas lambdas) | 1706 | (setq lambdas (cons tlambdas lambdas) |
| 1706 | keys (cons method-static keys) | 1707 | keys (cons eieio--method-static keys) |
| 1707 | primarymethodlist ;; Re-use even with bad name here | 1708 | primarymethodlist ;; Re-use even with bad name here |
| 1708 | (eieiomt-method-list method method-static mclass))) | 1709 | (eieiomt-method-list method eieio--method-static mclass))) |
| 1709 | ;; For the case of no class (ie - mclass == nil) then there may | 1710 | ;; For the case of no class (ie - mclass == nil) then there may |
| 1710 | ;; be a primary method. | 1711 | ;; be a primary method. |
| 1711 | (setq tlambdas | 1712 | (setq tlambdas |
| 1712 | (eieio-generic-form method method-primary nil)) | 1713 | (eieio-generic-form method eieio--method-primary nil)) |
| 1713 | (when tlambdas | 1714 | (when tlambdas |
| 1714 | (setq lambdas (cons tlambdas lambdas) | 1715 | (setq lambdas (cons tlambdas lambdas) |
| 1715 | keys (cons method-primary keys) | 1716 | keys (cons eieio--method-primary keys) |
| 1716 | primarymethodlist | 1717 | primarymethodlist |
| 1717 | (eieiomt-method-list method method-primary nil))) | 1718 | (eieiomt-method-list method eieio--method-primary nil))) |
| 1718 | ) | 1719 | ) |
| 1719 | 1720 | ||
| 1720 | (run-hook-with-args 'eieio-pre-method-execution-functions | 1721 | (run-hook-with-args 'eieio-pre-method-execution-functions |
| @@ -1728,8 +1729,8 @@ This should only be called from a generic function." | |||
| 1728 | (eieio--with-scoped-class (cdr (car lambdas)) | 1729 | (eieio--with-scoped-class (cdr (car lambdas)) |
| 1729 | (let* ((eieio-generic-call-key (car keys)) | 1730 | (let* ((eieio-generic-call-key (car keys)) |
| 1730 | (has-return-val | 1731 | (has-return-val |
| 1731 | (or (= eieio-generic-call-key method-primary) | 1732 | (or (= eieio-generic-call-key eieio--method-primary) |
| 1732 | (= eieio-generic-call-key method-static))) | 1733 | (= eieio-generic-call-key eieio--method-static))) |
| 1733 | (eieio-generic-call-next-method-list | 1734 | (eieio-generic-call-next-method-list |
| 1734 | ;; Use the cdr, as the first element is the fcn | 1735 | ;; Use the cdr, as the first element is the fcn |
| 1735 | ;; we are calling right now. | 1736 | ;; we are calling right now. |
| @@ -1791,15 +1792,15 @@ for this common case to improve performance." | |||
| 1791 | ) | 1792 | ) |
| 1792 | 1793 | ||
| 1793 | ;; :primary methods | 1794 | ;; :primary methods |
| 1794 | (setq lambdas (eieio-generic-form method method-primary mclass)) | 1795 | (setq lambdas (eieio-generic-form method eieio--method-primary mclass)) |
| 1795 | (setq primarymethodlist ;; Re-use even with bad name here | 1796 | (setq primarymethodlist ;; Re-use even with bad name here |
| 1796 | (eieiomt-method-list method method-primary mclass)) | 1797 | (eieiomt-method-list method eieio--method-primary mclass)) |
| 1797 | 1798 | ||
| 1798 | ;; Now loop through all occurrences forms which we must execute | 1799 | ;; Now loop through all occurrences forms which we must execute |
| 1799 | ;; (which are happily sorted now) and execute them all! | 1800 | ;; (which are happily sorted now) and execute them all! |
| 1800 | (eieio--with-scoped-class (cdr lambdas) | 1801 | (eieio--with-scoped-class (cdr lambdas) |
| 1801 | (let* ((rval nil) (lastval nil) | 1802 | (let* ((rval nil) (lastval nil) |
| 1802 | (eieio-generic-call-key method-primary) | 1803 | (eieio-generic-call-key eieio--method-primary) |
| 1803 | ;; Use the cdr, as the first element is the fcn | 1804 | ;; Use the cdr, as the first element is the fcn |
| 1804 | ;; we are calling right now. | 1805 | ;; we are calling right now. |
| 1805 | (eieio-generic-call-next-method-list (cdr primarymethodlist)) | 1806 | (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." | |||
| 1850 | 1851 | ||
| 1851 | ;; Return collected lambda. For :after methods, return in current | 1852 | ;; Return collected lambda. For :after methods, return in current |
| 1852 | ;; order (most general class last); Otherwise, reverse order. | 1853 | ;; order (most general class last); Otherwise, reverse order. |
| 1853 | (if (eq key method-after) | 1854 | (if (eq key eieio--method-after) |
| 1854 | lambdas | 1855 | lambdas |
| 1855 | (nreverse lambdas)))) | 1856 | (nreverse lambdas)))) |
| 1856 | 1857 | ||
| @@ -1883,9 +1884,9 @@ Do not do the work if they already exist." | |||
| 1883 | (unless (and (get method-name 'eieio-method-tree) | 1884 | (unless (and (get method-name 'eieio-method-tree) |
| 1884 | (get method-name 'eieio-method-hashtable)) | 1885 | (get method-name 'eieio-method-hashtable)) |
| 1885 | (put method-name 'eieio-method-tree | 1886 | (put method-name 'eieio-method-tree |
| 1886 | (make-vector method-num-slots nil)) | 1887 | (make-vector eieio--method-num-slots nil)) |
| 1887 | (let ((emto (put method-name 'eieio-method-hashtable | 1888 | (let ((emto (put method-name 'eieio-method-hashtable |
| 1888 | (make-vector method-num-slots nil)))) | 1889 | (make-vector eieio--method-num-slots nil)))) |
| 1889 | (aset emto 0 (make-hash-table :test 'eq)) | 1890 | (aset emto 0 (make-hash-table :test 'eq)) |
| 1890 | (aset emto 1 (make-hash-table :test 'eq)) | 1891 | (aset emto 1 (make-hash-table :test 'eq)) |
| 1891 | (aset emto 2 (make-hash-table :test 'eq)) | 1892 | (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 | |||
| 1899 | is associated with the :static :before :primary and :after tags. | 1900 | is associated with the :static :before :primary and :after tags. |
| 1900 | It also indicates if CLASS is defined or not. | 1901 | It also indicates if CLASS is defined or not. |
| 1901 | CLASS is the class this method is associated with." | 1902 | CLASS is the class this method is associated with." |
| 1902 | (if (or (> key method-num-slots) (< key 0)) | 1903 | (if (or (> key eieio--method-num-slots) (< key 0)) |
| 1903 | (error "eieiomt-add: method key error!")) | 1904 | (error "eieiomt-add: method key error!")) |
| 1904 | (let ((emtv (get method-name 'eieio-method-tree)) | 1905 | (let ((emtv (get method-name 'eieio-method-tree)) |
| 1905 | (emto (get method-name 'eieio-method-hashtable))) | 1906 | (emto (get method-name 'eieio-method-hashtable))) |
| @@ -1913,7 +1914,7 @@ CLASS is the class this method is associated with." | |||
| 1913 | ;; Add function definition into newly created symbol, and store | 1914 | ;; Add function definition into newly created symbol, and store |
| 1914 | ;; said symbol in the correct hashtable, otherwise use the | 1915 | ;; said symbol in the correct hashtable, otherwise use the |
| 1915 | ;; other array to keep this stuff. | 1916 | ;; other array to keep this stuff. |
| 1916 | (if (< key method-num-lists) | 1917 | (if (< key eieio--method-num-lists) |
| 1917 | (puthash class (list method) (aref emto key))) | 1918 | (puthash class (list method) (aref emto key))) |
| 1918 | ;; Save the defmethod file location in a symbol property. | 1919 | ;; Save the defmethod file location in a symbol property. |
| 1919 | (let ((fname (if load-in-progress | 1920 | (let ((fname (if load-in-progress |
| @@ -1925,7 +1926,7 @@ CLASS is the class this method is associated with." | |||
| 1925 | (cl-pushnew (list class fname) (get method-name 'method-locations) | 1926 | (cl-pushnew (list class fname) (get method-name 'method-locations) |
| 1926 | :test 'equal))) | 1927 | :test 'equal))) |
| 1927 | ;; Now optimize the entire hashtable. | 1928 | ;; Now optimize the entire hashtable. |
| 1928 | (if (< key method-num-lists) | 1929 | (if (< key eieio--method-num-lists) |
| 1929 | (let ((eieiomt--optimizing-hashtable (aref emto key))) | 1930 | (let ((eieiomt--optimizing-hashtable (aref emto key))) |
| 1930 | ;; @todo - Is this overkill? Should we just clear the symbol? | 1931 | ;; @todo - Is this overkill? Should we just clear the symbol? |
| 1931 | (maphash #'eieiomt--sym-optimize eieiomt--optimizing-hashtable))) | 1932 | (maphash #'eieiomt--sym-optimize eieiomt--optimizing-hashtable))) |
| @@ -1979,7 +1980,6 @@ is memorized for faster future use." | |||
| 1979 | (eieiomt--sym-optimize class cs))) | 1980 | (eieiomt--sym-optimize class cs))) |
| 1980 | ;; 3) If it's bound return this one. | 1981 | ;; 3) If it's bound return this one. |
| 1981 | (if (car cs) | 1982 | (if (car cs) |
| 1982 | ;; FIXME: Why (eieio--class-symbol (class-v class))? | ||
| 1983 | (cons (car cs) class) | 1983 | (cons (car cs) class) |
| 1984 | ;; 4) If it's not bound then this variable knows something | 1984 | ;; 4) If it's not bound then this variable knows something |
| 1985 | (if (cdr cs) | 1985 | (if (cdr cs) |
| @@ -1991,10 +1991,10 @@ is memorized for faster future use." | |||
| 1991 | ;; function-symbol | 1991 | ;; function-symbol |
| 1992 | ;;(if (car cs) | 1992 | ;;(if (car cs) |
| 1993 | (cons (car cs) class) | 1993 | (cons (car cs) class) |
| 1994 | ;;(error "EIEIO optimizer: erratic data loss!")) | 1994 | ;;(error "EIEIO optimizer: erratic data loss!")) |
| 1995 | ) | 1995 | ) |
| 1996 | ;; There never will be a funcall... | 1996 | ;; There never will be a funcall... |
| 1997 | nil))) | 1997 | nil))) |
| 1998 | ;; for a generic call, what is a list, is the function body we want. | 1998 | ;; for a generic call, what is a list, is the function body we want. |
| 1999 | (let ((emtl (aref (get method 'eieio-method-tree) | 1999 | (let ((emtl (aref (get method 'eieio-method-tree) |
| 2000 | (if class key (eieio-specialized-key-to-generic-key key))))) | 2000 | (if class key (eieio-specialized-key-to-generic-key key))))) |
| @@ -2024,18 +2024,18 @@ is memorized for faster future use." | |||
| 2024 | (setq key | 2024 | (setq key |
| 2025 | (cond ((memq (car args) '(:BEFORE :before)) | 2025 | (cond ((memq (car args) '(:BEFORE :before)) |
| 2026 | (setq args (cdr args)) | 2026 | (setq args (cdr args)) |
| 2027 | method-before) | 2027 | eieio--method-before) |
| 2028 | ((memq (car args) '(:AFTER :after)) | 2028 | ((memq (car args) '(:AFTER :after)) |
| 2029 | (setq args (cdr args)) | 2029 | (setq args (cdr args)) |
| 2030 | method-after) | 2030 | eieio--method-after) |
| 2031 | ((memq (car args) '(:STATIC :static)) | 2031 | ((memq (car args) '(:STATIC :static)) |
| 2032 | (setq args (cdr args)) | 2032 | (setq args (cdr args)) |
| 2033 | method-static) | 2033 | eieio--method-static) |
| 2034 | ((memq (car args) '(:PRIMARY :primary)) | 2034 | ((memq (car args) '(:PRIMARY :primary)) |
| 2035 | (setq args (cdr args)) | 2035 | (setq args (cdr args)) |
| 2036 | method-primary) | 2036 | eieio--method-primary) |
| 2037 | ;; Primary key. | 2037 | ;; Primary key. |
| 2038 | (t method-primary))) | 2038 | (t eieio--method-primary))) |
| 2039 | ;; Get body, and fix contents of args to be the arguments of the fn. | 2039 | ;; Get body, and fix contents of args to be the arguments of the fn. |
| 2040 | (setq body (cdr args) | 2040 | (setq body (cdr args) |
| 2041 | args (car args)) | 2041 | 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." | |||
| 193 | (let* ((chil nil) | 193 | (let* ((chil nil) |
| 194 | (obj (widget-get widget :value)) | 194 | (obj (widget-get widget :value)) |
| 195 | (master-group (widget-get widget :eieio-group)) | 195 | (master-group (widget-get widget :eieio-group)) |
| 196 | (cv (class-v (eieio--object-class obj))) | 196 | (cv (eieio--class-v (eieio--object-class obj))) |
| 197 | (slots (eieio--class-public-a cv)) | 197 | (slots (eieio--class-public-a cv)) |
| 198 | (flabel (eieio--class-public-custom-label cv)) | 198 | (flabel (eieio--class-public-custom-label cv)) |
| 199 | (fgroup (eieio--class-public-custom-group cv)) | 199 | (fgroup (eieio--class-public-custom-group cv)) |
| @@ -288,7 +288,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 288 | "Get the value of WIDGET." | 288 | "Get the value of WIDGET." |
| 289 | (let* ((obj (widget-get widget :value)) | 289 | (let* ((obj (widget-get widget :value)) |
| 290 | (master-group eieio-cog) | 290 | (master-group eieio-cog) |
| 291 | (cv (class-v (eieio--object-class obj))) | 291 | (cv (eieio--class-v (eieio--object-class obj))) |
| 292 | (fgroup (eieio--class-public-custom-group cv)) | 292 | (fgroup (eieio--class-public-custom-group cv)) |
| 293 | (wids (widget-get widget :children)) | 293 | (wids (widget-get widget :children)) |
| 294 | (name (if (widget-get widget :eieio-show-name) | 294 | (name (if (widget-get widget :eieio-show-name) |
| @@ -296,7 +296,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 296 | nil)) | 296 | nil)) |
| 297 | (chil (if (widget-get widget :eieio-show-name) | 297 | (chil (if (widget-get widget :eieio-show-name) |
| 298 | (nthcdr 1 wids) wids)) | 298 | (nthcdr 1 wids) wids)) |
| 299 | (cv (class-v (eieio--object-class obj))) | 299 | (cv (eieio--class-v (eieio--object-class obj))) |
| 300 | (slots (eieio--class-public-a cv)) | 300 | (slots (eieio--class-public-a cv)) |
| 301 | (fcust (eieio--class-public-custom cv))) | 301 | (fcust (eieio--class-public-custom cv))) |
| 302 | ;; If there are any prefix widgets, clear them. | 302 | ;; If there are any prefix widgets, clear them. |
| @@ -321,7 +321,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 321 | ;; This is the same object we had before. | 321 | ;; This is the same object we had before. |
| 322 | obj)) | 322 | obj)) |
| 323 | 323 | ||
| 324 | (defmethod eieio-done-customizing ((obj eieio-default-superclass)) | 324 | (defmethod eieio-done-customizing ((_obj eieio-default-superclass)) |
| 325 | "When applying change to a widget, call this method. | 325 | "When applying change to a widget, call this method. |
| 326 | This method is called by the default widget-edit commands. | 326 | This method is called by the default widget-edit commands. |
| 327 | User made commands should also call this method when applying changes. | 327 | User made commands should also call this method when applying changes. |
| @@ -385,7 +385,7 @@ These groups are specified with the `:group' slot flag." | |||
| 385 | (make-local-variable 'eieio-cog) | 385 | (make-local-variable 'eieio-cog) |
| 386 | (setq eieio-cog g))) | 386 | (setq eieio-cog g))) |
| 387 | 387 | ||
| 388 | (defmethod eieio-custom-object-apply-reset ((obj eieio-default-superclass)) | 388 | (defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass)) |
| 389 | "Insert an Apply and Reset button into the object editor. | 389 | "Insert an Apply and Reset button into the object editor. |
| 390 | Argument OBJ is the object being customized." | 390 | Argument OBJ is the object being customized." |
| 391 | (widget-create 'push-button | 391 | (widget-create 'push-button |
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." | |||
| 87 | prefix | 87 | prefix |
| 88 | "Name: ") | 88 | "Name: ") |
| 89 | (let* ((cl (eieio-object-class obj)) | 89 | (let* ((cl (eieio-object-class obj)) |
| 90 | (cv (class-v cl))) | 90 | (cv (eieio--class-v cl))) |
| 91 | (data-debug-insert-thing (class-constructor cl) | 91 | (data-debug-insert-thing (class-constructor cl) |
| 92 | prefix | 92 | prefix |
| 93 | "Class: ") | 93 | "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. | |||
| 60 | Argument CH-PREFIX is another character prefix to display." | 60 | Argument CH-PREFIX is another character prefix to display." |
| 61 | (eieio--check-type class-p this-root) | 61 | (eieio--check-type class-p this-root) |
| 62 | (let ((myname (symbol-name this-root)) | 62 | (let ((myname (symbol-name this-root)) |
| 63 | (chl (eieio--class-children (class-v this-root))) | 63 | (chl (eieio--class-children (eieio--class-v this-root))) |
| 64 | (fprefix (concat ch-prefix " +--")) | 64 | (fprefix (concat ch-prefix " +--")) |
| 65 | (mprefix (concat ch-prefix " | ")) | 65 | (mprefix (concat ch-prefix " | ")) |
| 66 | (lprefix (concat ch-prefix " "))) | 66 | (lprefix (concat ch-prefix " "))) |
| @@ -149,7 +149,7 @@ If CLASS is actually an object, then also display current values of that object. | |||
| 149 | (defun eieio-help-class-slots (class) | 149 | (defun eieio-help-class-slots (class) |
| 150 | "Print help description for the slots in CLASS. | 150 | "Print help description for the slots in CLASS. |
| 151 | Outputs to the current buffer." | 151 | Outputs to the current buffer." |
| 152 | (let* ((cv (class-v class)) | 152 | (let* ((cv (eieio--class-v class)) |
| 153 | (docs (eieio--class-public-doc cv)) | 153 | (docs (eieio--class-public-doc cv)) |
| 154 | (names (eieio--class-public-a cv)) | 154 | (names (eieio--class-public-a cv)) |
| 155 | (deflt (eieio--class-public-d cv)) | 155 | (deflt (eieio--class-public-d cv)) |
| @@ -231,7 +231,7 @@ If INSTANTIABLE-ONLY is non nil, only allow names of classes which | |||
| 231 | are not abstract, otherwise allow all classes. | 231 | are not abstract, otherwise allow all classes. |
| 232 | Optional argument BUILDLIST is more list to attach and is used internally." | 232 | Optional argument BUILDLIST is more list to attach and is used internally." |
| 233 | (let* ((cc (or class eieio-default-superclass)) | 233 | (let* ((cc (or class eieio-default-superclass)) |
| 234 | (sublst (eieio--class-children (class-v cc)))) | 234 | (sublst (eieio--class-children (eieio--class-v cc)))) |
| 235 | (unless (assoc (symbol-name cc) buildlist) | 235 | (unless (assoc (symbol-name cc) buildlist) |
| 236 | (when (or (not instantiable-only) (not (class-abstract-p cc))) | 236 | (when (or (not instantiable-only) (not (class-abstract-p cc))) |
| 237 | ;; FIXME: Completion tables don't need alists, and ede/generic.el needs | 237 | ;; FIXME: Completion tables don't need alists, and ede/generic.el needs |
| @@ -637,7 +637,7 @@ current expansion depth." | |||
| 637 | (defun eieio-class-button (class depth) | 637 | (defun eieio-class-button (class depth) |
| 638 | "Draw a speedbar button at the current point for CLASS at DEPTH." | 638 | "Draw a speedbar button at the current point for CLASS at DEPTH." |
| 639 | (eieio--check-type class-p class) | 639 | (eieio--check-type class-p class) |
| 640 | (let ((subclasses (eieio--class-children (class-v class)))) | 640 | (let ((subclasses (eieio--class-children (eieio--class-v class)))) |
| 641 | (if subclasses | 641 | (if subclasses |
| 642 | (speedbar-make-tag-line 'angle ?+ | 642 | (speedbar-make-tag-line 'angle ?+ |
| 643 | 'eieio-sb-expand | 643 | 'eieio-sb-expand |
| @@ -662,7 +662,7 @@ Argument INDENT is the depth of indentation." | |||
| 662 | (speedbar-with-writable | 662 | (speedbar-with-writable |
| 663 | (save-excursion | 663 | (save-excursion |
| 664 | (end-of-line) (forward-char 1) | 664 | (end-of-line) (forward-char 1) |
| 665 | (let ((subclasses (eieio--class-children (class-v class)))) | 665 | (let ((subclasses (eieio--class-children (eieio--class-v class)))) |
| 666 | (while subclasses | 666 | (while subclasses |
| 667 | (eieio-class-button (car subclasses) (1+ indent)) | 667 | (eieio-class-button (car subclasses) (1+ indent)) |
| 668 | (setq subclasses (cdr subclasses))))))) | 668 | (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 @@ | |||
| 1 | ;;; eieio-speedbar.el -- Classes for managing speedbar displays. | 1 | ;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999-2002, 2005, 2007-2014 Free Software Foundation, | 3 | ;; Copyright (C) 1999-2002, 2005, 2007-2014 Free Software Foundation, |
| 4 | ;; Inc. | 4 | ;; Inc. |
| @@ -200,7 +200,7 @@ that path." | |||
| 200 | "Return a string describing OBJECT." | 200 | "Return a string describing OBJECT." |
| 201 | (eieio-object-name-string object)) | 201 | (eieio-object-name-string object)) |
| 202 | 202 | ||
| 203 | (defmethod eieio-speedbar-derive-line-path (object) | 203 | (defmethod eieio-speedbar-derive-line-path (_object) |
| 204 | "Return the path which OBJECT has something to do with." | 204 | "Return the path which OBJECT has something to do with." |
| 205 | nil) | 205 | nil) |
| 206 | 206 | ||
| @@ -321,7 +321,7 @@ Argument DEPTH is the depth at which the tag line is inserted." | |||
| 321 | (if exp | 321 | (if exp |
| 322 | (eieio-speedbar-expand object (1+ depth)))))) | 322 | (eieio-speedbar-expand object (1+ depth)))))) |
| 323 | 323 | ||
| 324 | (defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth) | 324 | (defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth) |
| 325 | "Base method for creating tag lines for non-object children." | 325 | "Base method for creating tag lines for non-object children." |
| 326 | (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s" | 326 | (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s" |
| 327 | (eieio-object-name object))) | 327 | (eieio-object-name object))) |
| @@ -340,7 +340,7 @@ OBJECT." | |||
| 340 | 340 | ||
| 341 | ;;; Speedbar specific function callbacks. | 341 | ;;; Speedbar specific function callbacks. |
| 342 | ;; | 342 | ;; |
| 343 | (defun eieio-speedbar-object-click (text token indent) | 343 | (defun eieio-speedbar-object-click (_text token _indent) |
| 344 | "Handle a user click on TEXT representing object TOKEN. | 344 | "Handle a user click on TEXT representing object TOKEN. |
| 345 | The object is at indentation level INDENT." | 345 | The object is at indentation level INDENT." |
| 346 | (eieio-speedbar-handle-click token)) | 346 | (eieio-speedbar-handle-click token)) |
| @@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at." | |||
| 412 | 412 | ||
| 413 | ;;; Methods to the eieio-speedbar-* classes which need to be overridden. | 413 | ;;; Methods to the eieio-speedbar-* classes which need to be overridden. |
| 414 | ;; | 414 | ;; |
| 415 | (defmethod eieio-speedbar-object-children ((object eieio-speedbar)) | 415 | (defmethod eieio-speedbar-object-children ((_object eieio-speedbar)) |
| 416 | "Return a list of children to be displayed in speedbar. | 416 | "Return a list of children to be displayed in speedbar. |
| 417 | If the return value is a list of OBJECTs, then those objects are | 417 | If the return value is a list of OBJECTs, then those objects are |
| 418 | queried for details. If the return list is made of strings, | 418 | 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: | |||
| 191 | ((typearg class-name) arg2 &optional opt &rest rest) | 191 | ((typearg class-name) arg2 &optional opt &rest rest) |
| 192 | \"doc-string\" | 192 | \"doc-string\" |
| 193 | body)" | 193 | body)" |
| 194 | (declare (doc-string 3)) | 194 | (declare (doc-string 3) |
| 195 | (debug | ||
| 196 | (&define ; this means we are defining something | ||
| 197 | [&or name ("setf" :name setf name)] | ||
| 198 | ;; ^^ This is the methods symbol | ||
| 199 | [ &optional symbolp ] ; this is key :before etc | ||
| 200 | list ; arguments | ||
| 201 | [ &optional stringp ] ; documentation string | ||
| 202 | def-body ; part to be debugged | ||
| 203 | ))) | ||
| 195 | (let* ((key (if (keywordp (car args)) (pop args))) | 204 | (let* ((key (if (keywordp (car args)) (pop args))) |
| 196 | (params (car args)) | 205 | (params (car args)) |
| 197 | (arg1 (car params)) | 206 | (arg1 (car params)) |
| @@ -213,6 +222,7 @@ Summary: | |||
| 213 | "Retrieve the value stored in OBJ in the slot named by SLOT. | 222 | "Retrieve the value stored in OBJ in the slot named by SLOT. |
| 214 | Slot is the name of the slot when created by `defclass' or the label | 223 | Slot is the name of the slot when created by `defclass' or the label |
| 215 | created by the :initarg tag." | 224 | created by the :initarg tag." |
| 225 | (declare (debug (form symbolp))) | ||
| 216 | `(eieio-oref ,obj (quote ,slot))) | 226 | `(eieio-oref ,obj (quote ,slot))) |
| 217 | 227 | ||
| 218 | (defalias 'slot-value 'eieio-oref) | 228 | (defalias 'slot-value 'eieio-oref) |
| @@ -223,6 +233,7 @@ created by the :initarg tag." | |||
| 223 | The default value is the value installed in a class with the :initform | 233 | The default value is the value installed in a class with the :initform |
| 224 | tag. SLOT can be the slot name, or the tag specified by the :initarg | 234 | tag. SLOT can be the slot name, or the tag specified by the :initarg |
| 225 | tag in the `defclass' call." | 235 | tag in the `defclass' call." |
| 236 | (declare (debug (form symbolp))) | ||
| 226 | `(eieio-oref-default ,obj (quote ,slot))) | 237 | `(eieio-oref-default ,obj (quote ,slot))) |
| 227 | 238 | ||
| 228 | ;;; Handy CLOS macros | 239 | ;;; Handy CLOS macros |
| @@ -246,7 +257,7 @@ SPEC-LIST is of a form similar to `let'. For example: | |||
| 246 | Where each VAR is the local variable given to the associated | 257 | Where each VAR is the local variable given to the associated |
| 247 | SLOT. A slot specified without a variable name is given a | 258 | SLOT. A slot specified without a variable name is given a |
| 248 | variable name of the same name as the slot." | 259 | variable name of the same name as the slot." |
| 249 | (declare (indent 2)) | 260 | (declare (indent 2) (debug (sexp sexp def-body))) |
| 250 | (require 'cl-lib) | 261 | (require 'cl-lib) |
| 251 | ;; Transform the spec-list into a cl-symbol-macrolet spec-list. | 262 | ;; Transform the spec-list into a cl-symbol-macrolet spec-list. |
| 252 | (let ((mappings (mapcar (lambda (entry) | 263 | (let ((mappings (mapcar (lambda (entry) |
| @@ -348,7 +359,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." | |||
| 348 | (or (eq class 'eieio-default-superclass) | 359 | (or (eq class 'eieio-default-superclass) |
| 349 | (let ((p nil)) | 360 | (let ((p nil)) |
| 350 | (while (and child (not (eq child class))) | 361 | (while (and child (not (eq child class))) |
| 351 | (setq p (append p (eieio--class-parent (class-v child))) | 362 | (setq p (append p (eieio--class-parent (eieio--class-v child))) |
| 352 | child (car p) | 363 | child (car p) |
| 353 | p (cdr p))) | 364 | p (cdr p))) |
| 354 | (if child t)))) | 365 | (if child t)))) |
| @@ -356,11 +367,11 @@ The CLOS function `class-direct-subclasses' is aliased to this function." | |||
| 356 | (defun object-slots (obj) | 367 | (defun object-slots (obj) |
| 357 | "Return list of slots available in OBJ." | 368 | "Return list of slots available in OBJ." |
| 358 | (eieio--check-type eieio-object-p obj) | 369 | (eieio--check-type eieio-object-p obj) |
| 359 | (eieio--class-public-a (class-v (eieio--object-class obj)))) | 370 | (eieio--class-public-a (eieio--class-v (eieio--object-class obj)))) |
| 360 | 371 | ||
| 361 | (defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." | 372 | (defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." |
| 362 | (eieio--check-type class-p class) | 373 | (eieio--check-type class-p class) |
| 363 | (let ((ia (eieio--class-initarg-tuples (class-v class))) | 374 | (let ((ia (eieio--class-initarg-tuples (eieio--class-v class))) |
| 364 | (f nil)) | 375 | (f nil)) |
| 365 | (while (and ia (not f)) | 376 | (while (and ia (not f)) |
| 366 | (if (eq (cdr (car ia)) slot) | 377 | (if (eq (cdr (car ia)) slot) |
| @@ -374,6 +385,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." | |||
| 374 | "Set the value in OBJ for slot SLOT to VALUE. | 385 | "Set the value in OBJ for slot SLOT to VALUE. |
| 375 | SLOT is the slot name as specified in `defclass' or the tag created | 386 | SLOT is the slot name as specified in `defclass' or the tag created |
| 376 | with in the :initarg slot. VALUE can be any Lisp object." | 387 | with in the :initarg slot. VALUE can be any Lisp object." |
| 388 | (declare (debug (form symbolp form))) | ||
| 377 | `(eieio-oset ,obj (quote ,slot) ,value)) | 389 | `(eieio-oset ,obj (quote ,slot) ,value)) |
| 378 | 390 | ||
| 379 | (defmacro oset-default (class slot value) | 391 | (defmacro oset-default (class slot value) |
| @@ -381,6 +393,7 @@ with in the :initarg slot. VALUE can be any Lisp object." | |||
| 381 | The default value is usually set with the :initform tag during class | 393 | The default value is usually set with the :initform tag during class |
| 382 | creation. This allows users to change the default behavior of classes | 394 | creation. This allows users to change the default behavior of classes |
| 383 | after they are created." | 395 | after they are created." |
| 396 | (declare (debug (form symbolp form))) | ||
| 384 | `(eieio-oset-default ,class (quote ,slot) ,value)) | 397 | `(eieio-oset-default ,class (quote ,slot) ,value)) |
| 385 | 398 | ||
| 386 | ;;; CLOS queries into classes and slots | 399 | ;;; CLOS queries into classes and slots |
| @@ -405,7 +418,7 @@ OBJECT can be an instance or a class." | |||
| 405 | 418 | ||
| 406 | (defun slot-exists-p (object-or-class slot) | 419 | (defun slot-exists-p (object-or-class slot) |
| 407 | "Return non-nil if OBJECT-OR-CLASS has SLOT." | 420 | "Return non-nil if OBJECT-OR-CLASS has SLOT." |
| 408 | (let ((cv (class-v (cond ((eieio-object-p object-or-class) | 421 | (let ((cv (eieio--class-v (cond ((eieio-object-p object-or-class) |
| 409 | (eieio-object-class object-or-class)) | 422 | (eieio-object-class object-or-class)) |
| 410 | ((class-p object-or-class) | 423 | ((class-p object-or-class) |
| 411 | object-or-class)) | 424 | object-or-class)) |
| @@ -421,7 +434,7 @@ If ERRORP is non-nil, `wrong-argument-type' is signaled." | |||
| 421 | (if (not (class-p symbol)) | 434 | (if (not (class-p symbol)) |
| 422 | (if errorp (signal 'wrong-type-argument (list 'class-p symbol)) | 435 | (if errorp (signal 'wrong-type-argument (list 'class-p symbol)) |
| 423 | nil) | 436 | nil) |
| 424 | (class-v symbol))) | 437 | (eieio--class-v symbol))) |
| 425 | 438 | ||
| 426 | ;;; Slightly more complex utility functions for objects | 439 | ;;; Slightly more complex utility functions for objects |
| 427 | ;; | 440 | ;; |
| @@ -520,8 +533,8 @@ arguments passed in at the top level. | |||
| 520 | Use `next-method-p' to find out if there is a next method to call." | 533 | Use `next-method-p' to find out if there is a next method to call." |
| 521 | (if (not (eieio--scoped-class)) | 534 | (if (not (eieio--scoped-class)) |
| 522 | (error "`call-next-method' not called within a class specific method")) | 535 | (error "`call-next-method' not called within a class specific method")) |
| 523 | (if (and (/= eieio-generic-call-key method-primary) | 536 | (if (and (/= eieio-generic-call-key eieio--method-primary) |
| 524 | (/= eieio-generic-call-key method-static)) | 537 | (/= eieio-generic-call-key eieio--method-static)) |
| 525 | (error "Cannot `call-next-method' except in :primary or :static methods") | 538 | (error "Cannot `call-next-method' except in :primary or :static methods") |
| 526 | ) | 539 | ) |
| 527 | (let ((newargs (or replacement-args eieio-generic-call-arglst)) | 540 | (let ((newargs (or replacement-args eieio-generic-call-arglst)) |
| @@ -572,7 +585,7 @@ SLOTS are the initialization slots used by `shared-initialize'. | |||
| 572 | This static method is called when an object is constructed. | 585 | This static method is called when an object is constructed. |
| 573 | It allocates the vector used to represent an EIEIO object, and then | 586 | It allocates the vector used to represent an EIEIO object, and then |
| 574 | calls `shared-initialize' on that object." | 587 | calls `shared-initialize' on that object." |
| 575 | (let* ((new-object (copy-sequence (eieio--class-default-object-cache (class-v class))))) | 588 | (let* ((new-object (copy-sequence (eieio--class-default-object-cache (eieio--class-v class))))) |
| 576 | ;; Update the name for the newly created object. | 589 | ;; Update the name for the newly created object. |
| 577 | (setf (eieio--object-name new-object) newname) | 590 | (setf (eieio--object-name new-object) newname) |
| 578 | ;; Call the initialize method on the new object with the slots | 591 | ;; 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 | |||
| 612 | dynamically set from SLOTS." | 625 | dynamically set from SLOTS." |
| 613 | ;; First, see if any of our defaults are `lambda', and | 626 | ;; First, see if any of our defaults are `lambda', and |
| 614 | ;; re-evaluate them and apply the value to our slots. | 627 | ;; re-evaluate them and apply the value to our slots. |
| 615 | (let* ((this-class (class-v (eieio--object-class this))) | 628 | (let* ((this-class (eieio--class-v (eieio--object-class this))) |
| 616 | (slot (eieio--class-public-a this-class)) | 629 | (slot (eieio--class-public-a this-class)) |
| 617 | (defaults (eieio--class-public-d this-class))) | 630 | (defaults (eieio--class-public-d this-class))) |
| 618 | (while slot | 631 | (while slot |
| @@ -767,7 +780,7 @@ this object." | |||
| 767 | (princ comment) | 780 | (princ comment) |
| 768 | (princ "\n")) | 781 | (princ "\n")) |
| 769 | (let* ((cl (eieio-object-class this)) | 782 | (let* ((cl (eieio-object-class this)) |
| 770 | (cv (class-v cl))) | 783 | (cv (eieio--class-v cl))) |
| 771 | ;; Now output readable lisp to recreate this object | 784 | ;; Now output readable lisp to recreate this object |
| 772 | ;; It should look like this: | 785 | ;; It should look like this: |
| 773 | ;; (<constructor> <name> <slot> <slot> ... ) | 786 | ;; (<constructor> <name> <slot> <slot> ... ) |
| @@ -870,35 +883,13 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to | |||
| 870 | ")")) | 883 | ")")) |
| 871 | (t (funcall print-function object noescape)))) | 884 | (t (funcall print-function object noescape)))) |
| 872 | 885 | ||
| 873 | (add-hook 'edebug-setup-hook | 886 | (advice-add 'edebug-prin1-to-string |
| 874 | (lambda () | 887 | :around #'eieio-edebug-prin1-to-string) |
| 875 | (def-edebug-spec defmethod | ||
| 876 | (&define ; this means we are defining something | ||
| 877 | [&or name ("setf" :name setf name)] | ||
| 878 | ;; ^^ This is the methods symbol | ||
| 879 | [ &optional symbolp ] ; this is key :before etc | ||
| 880 | list ; arguments | ||
| 881 | [ &optional stringp ] ; documentation string | ||
| 882 | def-body ; part to be debugged | ||
| 883 | )) | ||
| 884 | ;; The rest of the macros | ||
| 885 | (def-edebug-spec oref (form quote)) | ||
| 886 | (def-edebug-spec oref-default (form quote)) | ||
| 887 | (def-edebug-spec oset (form quote form)) | ||
| 888 | (def-edebug-spec oset-default (form quote form)) | ||
| 889 | (def-edebug-spec class-v form) | ||
| 890 | (def-edebug-spec class-p form) | ||
| 891 | (def-edebug-spec eieio-object-p form) | ||
| 892 | (def-edebug-spec class-constructor form) | ||
| 893 | (def-edebug-spec generic-p form) | ||
| 894 | (def-edebug-spec with-slots (list list def-body)) | ||
| 895 | (advice-add 'edebug-prin1-to-string | ||
| 896 | :around #'eieio-edebug-prin1-to-string))) | ||
| 897 | 888 | ||
| 898 | 889 | ||
| 899 | ;;; Start of automatically extracted autoloads. | 890 | ;;; Start of automatically extracted autoloads. |
| 900 | 891 | ||
| 901 | ;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "ab711689b2bae8a7d8c4b1e99c892306") | 892 | ;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "6413249ec10091eb7094238637b40e2c") |
| 902 | ;;; Generated autoloads from eieio-custom.el | 893 | ;;; Generated autoloads from eieio-custom.el |
| 903 | 894 | ||
| 904 | (autoload 'customize-object "eieio-custom" "\ | 895 | (autoload 'customize-object "eieio-custom" "\ |
| @@ -909,7 +900,7 @@ Optional argument GROUP is the sub-group of slots to display. | |||
| 909 | 900 | ||
| 910 | ;;;*** | 901 | ;;;*** |
| 911 | 902 | ||
| 912 | ;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "e50a67ebd0c6258c615e4bf16714e81f") | 903 | ;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6f114a48de40212413d2776eedc3ec14") |
| 913 | ;;; Generated autoloads from eieio-opt.el | 904 | ;;; Generated autoloads from eieio-opt.el |
| 914 | 905 | ||
| 915 | (autoload 'eieio-browse "eieio-opt" "\ | 906 | (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 @@ | |||
| 40 | (let* ((file (oref original :file)) | 40 | (let* ((file (oref original :file)) |
| 41 | (class (eieio-object-class original)) | 41 | (class (eieio-object-class original)) |
| 42 | (fromdisk (eieio-persistent-read file class)) | 42 | (fromdisk (eieio-persistent-read file class)) |
| 43 | (cv (class-v class)) | 43 | (cv (eieio--class-v class)) |
| 44 | (slot-names (eieio--class-public-a cv)) | 44 | (slot-names (eieio--class-public-a cv)) |
| 45 | (slot-deflt (eieio--class-public-d cv)) | 45 | (slot-deflt (eieio--class-public-d cv)) |
| 46 | ) | 46 | ) |
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.") | |||
| 794 | (should (eq (oref-default slotattr-class-ok initform) 'no-init))) | 794 | (should (eq (oref-default slotattr-class-ok initform) 'no-init))) |
| 795 | 795 | ||
| 796 | (ert-deftest eieio-test-32-slot-attribute-override-2 () | 796 | (ert-deftest eieio-test-32-slot-attribute-override-2 () |
| 797 | (let* ((cv (class-v 'slotattr-ok)) | 797 | (let* ((cv (eieio--class-v 'slotattr-ok)) |
| 798 | (docs (eieio--class-public-doc cv)) | 798 | (docs (eieio--class-public-doc cv)) |
| 799 | (names (eieio--class-public-a cv)) | 799 | (names (eieio--class-public-a cv)) |
| 800 | (cust (eieio--class-public-custom cv)) | 800 | (cust (eieio--class-public-custom cv)) |