summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/eieio-core.el103
-rw-r--r--lisp/emacs-lisp/eieio-generic.el88
-rw-r--r--lisp/emacs-lisp/eieio.el17
3 files changed, 74 insertions, 134 deletions
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index e526a41e871..0747d97960c 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -62,9 +62,6 @@ default setting for optimization purposes.")
(defvar eieio-optimize-primary-methods-flag t
"Non-nil means to optimize the method dispatch on primary methods.")
-(defvar eieio-initializing-object nil
- "Set to non-nil while initializing an object.")
-
(defvar eieio-backward-compatibility t
"If nil, drop support for some behaviors of older versions of EIEIO.
Currently under control of this var:
@@ -82,29 +79,6 @@ Currently under control of this var:
;; while it is being built itself.
(defvar eieio-default-superclass nil)
-;;;
-;; Class currently in scope.
-;;
-;; When invoking methods, the running method needs to know which class
-;; is currently in scope. Generally this is the class of the method
-;; being called, but 'call-next-method' needs to query this state,
-;; and change it to be then next super class up.
-;;
-;; Thus, the scoped class is a stack that needs to be managed.
-
-(defvar eieio--scoped-class-stack nil
- "A stack of the classes currently in scope during method invocation.")
-
-(defun eieio--scoped-class ()
- "Return the class object currently in scope, or nil."
- (car-safe eieio--scoped-class-stack))
-
-(defmacro eieio--with-scoped-class (class &rest forms)
- "Set CLASS as the currently scoped class while executing FORMS."
- (declare (indent 1))
- `(let ((eieio--scoped-class-stack (cons ,class eieio--scoped-class-stack)))
- ,@forms))
-
(progn
;; Arrange for field access not to bother checking if the access is indeed
;; made to an eieio--class object.
@@ -1029,27 +1003,26 @@ Fills in the default value in CLASS' in SLOT with VALUE."
(setq class (eieio--class-object class))
(eieio--check-type eieio--class-p class)
(eieio--check-type symbolp slot)
- (eieio--with-scoped-class class
- (let* ((c (eieio--slot-name-index class nil slot)))
- (if (not c)
- ;; It might be missing because it is a :class allocated slot.
- ;; Let's check that info out.
- (if (setq c (eieio--class-slot-name-index class slot))
- (progn
- ;; Oref that slot.
- (eieio--validate-class-slot-value class c value slot)
- (aset (eieio--class-class-allocation-values class) c
- value))
- (signal 'invalid-slot-name (list (eieio--class-symbol class) slot)))
- (eieio--validate-slot-value class c value slot)
- ;; Set this into the storage for defaults.
- (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
- (eieio--class-public-d class))
- value)
- ;; Take the value, and put it into our cache object.
- (eieio-oset (eieio--class-default-object-cache class)
- slot value)
- ))))
+ (let* ((c (eieio--slot-name-index class nil slot)))
+ (if (not c)
+ ;; It might be missing because it is a :class allocated slot.
+ ;; Let's check that info out.
+ (if (setq c (eieio--class-slot-name-index class slot))
+ (progn
+ ;; Oref that slot.
+ (eieio--validate-class-slot-value class c value slot)
+ (aset (eieio--class-class-allocation-values class) c
+ value))
+ (signal 'invalid-slot-name (list (eieio--class-symbol class) slot)))
+ (eieio--validate-slot-value class c value slot)
+ ;; Set this into the storage for defaults.
+ (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
+ (eieio--class-public-d class))
+ value)
+ ;; Take the value, and put it into our cache object.
+ (eieio-oset (eieio--class-default-object-cache class)
+ slot value)
+ )))
;;; EIEIO internal search functions
@@ -1080,27 +1053,7 @@ reverse-lookup that name, and recurse with the associated slot value."
(let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
(fsi (car fsym)))
(if (integerp fsi)
- (cond
- ((not (cdr fsym))
- (+ (eval-when-compile eieio--object-num-slots) fsi))
- ((and (eq (cdr fsym) 'protected)
- (eieio--scoped-class)
- (or (child-of-class-p class (eieio--scoped-class))
- (and (eieio-object-p obj)
- ;; AFAICT, for all callers, if `obj' is not a class,
- ;; then its class is `class'.
- ;;(child-of-class-p class (eieio--object-class-object obj))
- (progn
- (cl-assert (eq class (eieio--object-class-object obj)))
- t))))
- (+ (eval-when-compile eieio--object-num-slots) fsi))
- ((and (eq (cdr fsym) 'private)
- (or (and (eieio--scoped-class)
- (eieio--slot-originating-class-p
- (eieio--scoped-class) slot))
- eieio-initializing-object))
- (+ (eval-when-compile eieio--object-num-slots) fsi))
- (t nil))
+ (+ (eval-when-compile eieio--object-num-slots) fsi)
(let ((fn (eieio--initarg-to-attribute class slot)))
(if fn (eieio--slot-name-index class obj fn) nil)))))
@@ -1128,14 +1081,12 @@ reverse-lookup that name, and recurse with the associated slot value."
If SET-ALL is non-nil, then when a default is nil, that value is
reset. If SET-ALL is nil, the slots are only reset if the default is
not nil."
- (eieio--with-scoped-class (eieio--object-class-object obj)
- (let ((eieio-initializing-object t)
- (pub (eieio--class-public-a (eieio--object-class-object obj))))
- (while pub
- (let ((df (eieio-oref-default obj (car pub))))
- (if (or df set-all)
- (eieio-oset obj (car pub) df)))
- (setq pub (cdr pub))))))
+ (let ((pub (eieio--class-public-a (eieio--object-class-object obj))))
+ (while pub
+ (let ((df (eieio-oref-default obj (car pub))))
+ (if (or df set-all)
+ (eieio-oset obj (car pub) df)))
+ (setq pub (cdr pub)))))
(defun eieio--initarg-to-attribute (class initarg)
"For CLASS, convert INITARG to the actual attribute name.
diff --git a/lisp/emacs-lisp/eieio-generic.el b/lisp/emacs-lisp/eieio-generic.el
index 4045c038033..27a58493905 100644
--- a/lisp/emacs-lisp/eieio-generic.el
+++ b/lisp/emacs-lisp/eieio-generic.el
@@ -174,8 +174,7 @@ IMPL is the symbol holding the method implementation."
(eieio--generic-call-key eieio--method-primary)
(eieio--generic-call-arglst local-args)
)
- (eieio--with-scoped-class (eieio--class-v class)
- (apply impl local-args)))))))
+ (apply impl local-args))))))
(defun eieio-unbind-method-implementations (method)
"Make the generic method METHOD have no implementations.
@@ -287,11 +286,9 @@ This should only be called from a generic function."
)
;; Now create a list in reverse order of all the calls we have
;; make in order to successfully do this right. Rules:
- ;; 1) Only call generics if scoped-class is not defined
- ;; This prevents multiple calls in the case of recursion
- ;; 2) Only call static if this is a static method.
- ;; 3) Only call specifics if the definition allows for them.
- ;; 4) Call in order based on :before, :primary, and :after
+ ;; 1) Only call static if this is a static method.
+ ;; 2) Only call specifics if the definition allows for them.
+ ;; 3) Call in order based on :before, :primary, and :after
(when (eieio-object-p firstarg)
;; Non-static calls do all this stuff.
@@ -357,22 +354,21 @@ This should only be called from a generic function."
(let ((rval nil) (lastval nil) (found nil))
(while lambdas
(if (car lambdas)
- (eieio--with-scoped-class (cdr (car lambdas))
- (let* ((eieio--generic-call-key (car keys))
- (has-return-val
- (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.
- (when has-return-val (cdr primarymethodlist)))
- )
- (setq found t)
- ;;(setq rval (apply (car (car lambdas)) newargs))
- (setq lastval (apply (car (car lambdas)) newargs))
- (when has-return-val
- (setq rval lastval))
- )))
+ (let* ((eieio--generic-call-key (car keys))
+ (has-return-val
+ (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.
+ (when has-return-val (cdr primarymethodlist)))
+ )
+ (setq found t)
+ ;;(setq rval (apply (car (car lambdas)) newargs))
+ (setq lastval (apply (car (car lambdas)) newargs))
+ (when has-return-val
+ (setq rval lastval))
+ ))
(setq lambdas (cdr lambdas)
keys (cdr keys)))
(if (not found)
@@ -425,33 +421,32 @@ for this common case to improve performance."
;; 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 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))
- )
+ (let* ((rval nil) (lastval nil)
+ (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))
+ )
- (if (or (not lambdas) (not (car lambdas)))
+ (if (or (not lambdas) (not (car lambdas)))
- ;; No methods found for this impl...
- (if (eieio-object-p (car args))
- (setq rval (apply #'no-applicable-method
- (car args) method args))
- (signal
- 'no-method-definition
- (list method args)))
+ ;; No methods found for this impl...
+ (if (eieio-object-p (car args))
+ (setq rval (apply #'no-applicable-method
+ (car args) method args))
+ (signal
+ 'no-method-definition
+ (list method args)))
- ;; Do the regular implementation here.
+ ;; Do the regular implementation here.
- (run-hook-with-args 'eieio-pre-method-execution-functions
- lambdas)
+ (run-hook-with-args 'eieio-pre-method-execution-functions
+ lambdas)
- (setq lastval (apply (car lambdas) newargs))
- (setq rval lastval))
+ (setq lastval (apply (car lambdas) newargs))
+ (setq rval lastval))
- rval))))
+ rval)))
(defun eieio--mt-method-list (method key class)
"Return an alist list of methods lambdas.
@@ -721,8 +716,6 @@ If REPLACEMENT-ARGS is non-nil, then use them instead of
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 eieio--method-primary)
(/= eieio--generic-call-key eieio--method-static))
(error "Cannot `call-next-method' except in :primary or :static methods")
@@ -737,8 +730,7 @@ Use `next-method-p' to find out if there is a next method to call."
(eieio--generic-call-arglst newargs)
(fcn (car next))
)
- (eieio--with-scoped-class (cdr next)
- (apply fcn newargs)) ))))
+ (apply fcn newargs)) )))
(defgeneric no-applicable-method (object method &rest args)
"Called if there are no implementations for OBJECT in METHOD.")
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 419a78be469..392316ccd75 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -76,8 +76,6 @@ being the slots residing in that class definition. Supported tags are:
- A string documenting use of this slot.
The following are extensions on CLOS:
- :protection - Specify protection for this slot.
- Defaults to `:public'. Also use `:protected', or `:private'.
:custom - When customizing an object, the custom :type. Public only.
:label - A text string label used for a slot when customizing.
:group - Name of a customization group this slot belongs in.
@@ -672,14 +670,13 @@ Called from the constructor routine.")
(defmethod shared-initialize ((obj eieio-default-superclass) slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine."
- (eieio--with-scoped-class (eieio--object-class-object obj)
- (while slots
- (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj)
- (car slots))))
- (if (not rn)
- (slot-missing obj (car slots) 'oset (car (cdr slots)))
- (eieio-oset obj rn (car (cdr slots)))))
- (setq slots (cdr (cdr slots))))))
+ (while slots
+ (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj)
+ (car slots))))
+ (if (not rn)
+ (slot-missing obj (car slots) 'oset (car (cdr slots)))
+ (eieio-oset obj rn (car (cdr slots)))))
+ (setq slots (cdr (cdr slots)))))
(defgeneric initialize-instance (this &optional slots)
"Construct the new object THIS based on SLOTS.")
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-03 09:26:39 +0000