mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-01 01:41:01 -08:00
Code Issues Projects Releases Wiki Activity

EIEIO: Promote the CLOS behavior over the EIEIO-specific behavior

Browse source 
Change docs to advertize `slot-value` rather than `oref`.
Change the implementation of `:initform` to better match the CLOS semantics,
while preserving the EIEIO semantics, but warn when encountering cases
where the two diverge.
Demote the mostly unused special semantics of `oref-default`
on non-class allocated slots.

* doc/misc/eieio.texi (Quick Start): Use `slot-value`.
(Accessing Slots): Move `slot-value` before `oref`.
Fix paren-typo in example (reported by pillule <pillule@riseup.net>).
(Introspection): Remove mention of `class-slot-initarg`.

* lisp/transient.el (transient--parse-group, transient--parse-suffix):
Don't use `oref-default` to get the default value.
(transient-lisp-variable): Init forms are evaluated.

* lisp/emacs-lisp/eieio.el (defclass): Warn about inapplicable
`:initarg` and about uses of init forms that are ambiguous.
(oref): Don't advertize the deprecated use of initargs as slot names.
(oref-default): Don't advertize the deprecated case where it returns the
initform's value.
(initialize-instance): Use `macroexp-const-p`.
* lisp/emacs-lisp/eieio-core.el (eieio--unbound): Rename from
`eieio-unbound`.
(eieio--unbound-form): New var.
(eieio--slot-override): Use it.
(eieio-defclass-internal): Use it.  Change `init` so it should always
be evaluated.
(eieio--known-class-slot-names): New var.
(eieio--eval-default-p): Rename from `eieio-eval-default-p`.
(eieio--perform-slot-validation-for-default): Use `macroexp-const-p` to
decide whether to skip the test.
(eieio--add-new-slot): Register slot in `eieio--known-class-slot-names`
when applicable.
(eieio-oref-default, eieio-oset-default): Add warning for unknown slots
and slots not known to be allocated to the class.
(eieio-default-eval-maybe): Delete function.  Use just `eval` instead.
(eieio-declare-slots): Allow slots to specify their allocation class.

* lisp/cedet/srecode/insert.el (point): Declare the slot instead of
moving the class definition before the slot's first use.
(srecode-template-inserter-point, srecode-insert-fcn):
Use nil instead of unbound for the `point` slot.

* lisp/cedet/srecode/compile.el (srecode-template-inserter):
Declare the `key` slot that all children should have.

* lisp/emacs-lisp/eieio-speedbar.el (eieio-speedbar)
(eieio-speedbar-directory-button, eieio-speedbar-file-button):
* lisp/emacs-lisp/eieio-custom.el (eieio-widget-test-class):
* lisp/emacs-lisp/chart.el (chart-bar):
* lisp/cedet/semantic/ede-grammar.el (semantic-ede-proj-target-grammar):
* lisp/cedet/semantic/db.el (semanticdb-project-database):
* lisp/cedet/semantic/db-javascript.el (semanticdb-table-javascript)
(semanticdb-project-database-javascript):
* lisp/cedet/semantic/db-el.el (semanticdb-table-emacs-lisp)
(semanticdb-project-database-emacs-lisp):
* lisp/cedet/semantic/db-ebrowse.el (semanticdb-table-ebrowse)
(semanticdb-project-database-ebrowse):
* lisp/cedet/ede/proj.el (ede-proj-project):
* lisp/cedet/ede/proj-obj.el (ede-proj-target-makefile-objectcode):
* lisp/cedet/ede/generic.el (ede-generic-project):
* lisp/cedet/ede/config.el (ede-project-with-config):
* lisp/cedet/ede/base.el (ede-target, ede-project):
* lisp/auth-source.el (auth-source-backend): Init forms are evaluated,
so quote them accordingly.
This commit is contained in:
Stefan Monnier 2021-06-12 16:22:03 -04:00
parent 0afab352e0
commit 4c6554413d
21 changed files with 231 additions and 187 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lisp/emacs-lisp/chart.el
View file

@ -203,7 +203,7 @@ Make sure the width/height is correct."
(defclass chart-bar (chart)
((direction :initarg :direction
:initform vertical))
:initform 'vertical))
"Subclass for bar charts (vertical or horizontal).")
(cl-defmethod chart-draw ((c chart) &optional buff)

2
lisp/emacs-lisp/eieio-base.el
View file

@ -156,7 +156,7 @@ only one object ever exists."
;; NOTE TO SELF: In next version, make `slot-boundp' support classes
;; with class allocated slots or default values.
(let ((old (oref-default class singleton)))
(if (eq old eieio-unbound)
(if (eq old eieio--unbound)
(oset-default class singleton (cl-call-next-method))
old)))

127
lisp/emacs-lisp/eieio-core.el
View file

@ -71,11 +71,10 @@ Currently under control of this var:
- Define <class>-child-p and <class>-list-p predicates.
- Allow object names in constructors.")
(defconst eieio-unbound
(if (and (boundp 'eieio-unbound) (symbolp eieio-unbound))
eieio-unbound
(make-symbol "unbound"))
(define-obsolete-variable-alias 'eieio-unbound 'eieio--unbound "28.1")
(defvar eieio--unbound (make-symbol "eieio--unbound")
"Uninterned symbol representing an unbound slot in an object.")
(defvar eieio--unbound-form (macroexp-quote eieio--unbound))
;; This is a bootstrap for eieio-default-superclass so it has a value
;; while it is being built itself.
@ -264,6 +263,7 @@ use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
(object-of-class-p obj class))))
(defvar eieio--known-slot-names nil)
(defvar eieio--known-class-slot-names nil)
(defun eieio-defclass-internal (cname superclasses slots options)
"Define CNAME as a new subclass of SUPERCLASSES.
@ -381,7 +381,7 @@ See `defclass' for more information."
(pcase-dolist (`(,name . ,slot) slots)
(let* ((init (or (plist-get slot :initform)
(if (member :initform slot) nil
eieio-unbound)))
eieio--unbound-form)))
(initarg (plist-get slot :initarg))
(docstr (plist-get slot :documentation))
(prot (plist-get slot :protection))
@ -395,6 +395,14 @@ See `defclass' for more information."
(skip-nil (eieio--class-option-assoc options :allow-nil-initform))
)
(unless (or (macroexp-const-p init)
(eieio--eval-default-p init))
;; FIXME: We duplicate this test here and in `defclass' because
;; if we move this part to `defclass' we may break some existing
;; code (because the `fboundp' test in `eieio--eval-default-p'
;; returns a different result at compile time).
(setq init (macroexp-quote init)))
;; Clean up the meaning of protection.
(setq prot
(pcase prot
@ -457,8 +465,9 @@ See `defclass' for more information."
(n (length slots))
(v (make-vector n nil)))
(dotimes (i n)
(setf (aref v i) (eieio-default-eval-maybe
(cl--slot-descriptor-initform (aref slots i)))))
(setf (aref v i) (eval
(cl--slot-descriptor-initform (aref slots i))
t)))
(setf (eieio--class-class-allocation-values newc) v))
;; Attach slot symbols into a hash table, and store the index of
@ -513,7 +522,7 @@ See `defclass' for more information."
cname
))
(defsubst eieio-eval-default-p (val)
(defun eieio--eval-default-p (val)
"Whether the default value VAL should be evaluated for use."
(and (consp val) (symbolp (car val)) (fboundp (car val))))
@ -522,10 +531,10 @@ See `defclass' for more information."
If SKIPNIL is non-nil, then if default value is nil return t instead."
(let ((value (cl--slot-descriptor-initform slot))
(spec (cl--slot-descriptor-type slot)))
(if (not (or (eieio-eval-default-p value) ;FIXME: Why?
(if (not (or (not (macroexp-const-p value))
eieio-skip-typecheck
(and skipnil (null value))
(eieio--perform-slot-validation spec value)))
(eieio--perform-slot-validation spec (eval value t))))
(signal 'invalid-slot-type (list (cl--slot-descriptor-name slot) spec value)))))
(defun eieio--slot-override (old new skipnil)
@ -546,7 +555,7 @@ If SKIPNIL is non-nil, then if default value is nil return t instead."
type tp a))
(setf (cl--slot-descriptor-type new) tp))
;; If we have a repeat, only update the initarg...
(unless (eq d eieio-unbound)
(unless (eq d eieio--unbound-form)
(eieio--perform-slot-validation-for-default new skipnil)
(setf (cl--slot-descriptor-initform old) d))
@ -604,6 +613,8 @@ if default value is nil."
(cold (car (cl-member a (eieio--class-class-slots newc)
:key #'cl--slot-descriptor-name))))
(cl-pushnew a eieio--known-slot-names)
(when (eq alloc :class)
(cl-pushnew a eieio--known-class-slot-names))
(condition-case nil
(if (sequencep d) (setq d (copy-sequence d)))
;; This copy can fail on a cons cell with a non-cons in the cdr. Let's
@ -679,7 +690,7 @@ the new child class."
(defun eieio--perform-slot-validation (spec value)
"Return non-nil if SPEC does not match VALUE."
(or (eq spec t) ; t always passes
(eq value eieio-unbound) ; unbound always passes
(eq value eieio--unbound) ; unbound always passes
(cl-typep value spec)))
(defun eieio--validate-slot-value (class slot-idx value slot)
@ -715,7 +726,7 @@ an error."
INSTANCE is the object being referenced. SLOTNAME is the offending
slot. If the slot is ok, return VALUE.
Argument FN is the function calling this verifier."
(if (and (eq value eieio-unbound) (not eieio-skip-typecheck))
(if (and (eq value eieio--unbound) (not eieio-skip-typecheck))
(slot-unbound instance (eieio--object-class instance) slotname fn)
value))
@ -755,15 +766,29 @@ Argument FN is the function calling this verifier."
(eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
(defun eieio-oref-default (obj slot)
(defun eieio-oref-default (class slot)
"Do the work for the macro `oref-default' with similar parameters.
Fills in OBJ's SLOT with its default value."
(declare (gv-setter eieio-oset-default))
(cl-check-type obj (or eieio-object class))
Fills in CLASS's SLOT with its default value."
(declare (gv-setter eieio-oset-default)
(compiler-macro
(lambda (exp)
(ignore class)
(pcase slot
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name) exp 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
exp 'compile-only))
(_ exp)))))
(cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
(let* ((cl (cond ((symbolp obj) (cl--find-class obj))
((eieio-object-p obj) (eieio--object-class obj))
(t obj)))
(let* ((cl (cond ((symbolp class) (cl--find-class class))
((eieio-object-p class) (eieio--object-class class))
(t class)))
(c (eieio--slot-name-index cl slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
@ -773,27 +798,13 @@ Fills in OBJ's SLOT with its default value."
;; Oref that slot.
(aref (eieio--class-class-allocation-values cl)
c)
(slot-missing obj slot 'oref-default))
(slot-missing class slot 'oref-default))
(eieio-barf-if-slot-unbound
(let ((val (cl--slot-descriptor-initform
(aref (eieio--class-slots cl)
(- c (eval-when-compile eieio--object-num-slots))))))
(eieio-default-eval-maybe val))
obj (eieio--class-name cl) 'oref-default))))
(defun eieio-default-eval-maybe (val)
"Check VAL, and return what `oref-default' would provide."
;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate
;; variables as well? Why not just always call `eval'?
(cond
;; Is it a function call? If so, evaluate it.
((eieio-eval-default-p val)
(eval val t))
;;;; check for quoted things, and unquote them
;;((and (consp val) (eq (car val) 'quote))
;; (car (cdr val)))
;; return it verbatim
(t val)))
(eval val t))
class (eieio--class-name cl) 'oref-default))))
(defun eieio-oset (obj slot value)
"Do the work for the macro `oset'.
@ -820,6 +831,20 @@ Fills in OBJ's SLOT with VALUE."
(defun eieio-oset-default (class slot value)
"Do the work for the macro `oset-default'.
Fills in the default value in CLASS' in SLOT with VALUE."
(declare (compiler-macro
(lambda (exp)
(ignore class value)
(pcase slot
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name) exp 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
exp 'compile-only))
(_ exp)))))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
(cl-check-type slot symbol)
@ -836,22 +861,18 @@ Fills in the default value in CLASS' in SLOT with VALUE."
(signal 'invalid-slot-name (list (eieio--class-name class) slot)))
;; `oset-default' on an instance-allocated slot is allowed by EIEIO but
;; not by CLOS and is mildly inconsistent with the :initform thingy, so
;; it'd be nice to get of it. This said, it is/was used at one place by
;; gnus/registry.el, so it might be used elsewhere as well, so let's
;; keep it for now.
;; it'd be nice to get rid of it.
;; This said, it is/was used at one place by gnus/registry.el, so it
;; might be used elsewhere as well, so let's keep it for now.
;; FIXME: Generate a compile-time warning for it!
;; (error "Can't `oset-default' an instance-allocated slot: %S of %S"
;; slot class)
(eieio--validate-slot-value class c value slot)
;; Set this into the storage for defaults.
(if (eieio-eval-default-p value)
(error "Can't set default to a sexp that gets evaluated again"))
(setf (cl--slot-descriptor-initform
;; FIXME: Apparently we set it both in `slots' and in
;; `object-cache', which seems redundant.
(aref (eieio--class-slots class)
(- c (eval-when-compile eieio--object-num-slots))))
value)
(macroexp-quote value))
;; Take the value, and put it into our cache object.
(eieio-oset (eieio--class-default-object-cache class)
slot value)
@ -1093,8 +1114,20 @@ These match if the argument is the name of a subclass of CLASS."
(defmacro eieio-declare-slots (&rest slots)
"Declare that SLOTS are known eieio object slot names."
`(eval-when-compile
(setq eieio--known-slot-names (append ',slots eieio--known-slot-names))))
(let ((slotnames (mapcar (lambda (s) (if (consp s) (car s) s)) slots))
(classslots (delq nil
(mapcar (lambda (s)
(when (and (consp s)
(eq :class (plist-get (cdr s)
:allocation)))
(car s)))
slots))))
`(eval-when-compile
,@(when classslots
(mapcar (lambda (s) `(add-to-list 'eieio--known-class-slot-names ',s))
classslots))
,@(mapcar (lambda (s) `(add-to-list 'eieio--known-slot-names ',s))
slotnames))))
(provide 'eieio-core)

2
lisp/emacs-lisp/eieio-custom.el
View file

@ -46,7 +46,7 @@
:documentation "A string for testing custom.
This is the next line of documentation.")
(listostuff :initarg :listostuff
:initform ("1" "2" "3")
:initform '("1" "2" "3")
:type list
:custom (repeat (string :tag "Stuff"))
:label "List of Strings"

10
lisp/emacs-lisp/eieio-speedbar.el
View file

@ -248,7 +248,7 @@ and take the appropriate action."
Possible values are those symbols supported by the `exp-button-type' argument
to `speedbar-make-tag-line'."
:allocation :class)
(buttonface :initform speedbar-tag-face
(buttonface :initform 'speedbar-tag-face
:type (or symbol face)
:documentation
"The face used on the textual part of the button for this class.
@ -265,15 +265,15 @@ Add one of the child classes to this class to the parent list of a class."
:abstract t)
(defclass eieio-speedbar-directory-button (eieio-speedbar)
((buttontype :initform angle)
(buttonface :initform speedbar-directory-face))
((buttontype :initform 'angle)
(buttonface :initform 'speedbar-directory-face))
"Class providing support for objects which behave like a directory."
:method-invocation-order :depth-first
:abstract t)
(defclass eieio-speedbar-file-button (eieio-speedbar)
((buttontype :initform bracket)
(buttonface :initform speedbar-file-face))
((buttontype :initform 'bracket)
(buttonface :initform 'speedbar-file-face))
"Class providing support for objects which behave like a file."
:method-invocation-order :depth-first
:abstract t)

57
lisp/emacs-lisp/eieio.el
View file

@ -131,6 +131,7 @@ and reference them using the function `class-option'."
(let ((testsym1 (intern (concat (symbol-name name) "-p")))
(testsym2 (intern (format "%s--eieio-childp" name)))
(warnings '())
(accessors ()))
;; Collect the accessors we need to define.
@ -145,6 +146,8 @@ and reference them using the function `class-option'."
;; Update eieio--known-slot-names already in case we compile code which
;; uses this before the class is loaded.
(cl-pushnew sname eieio--known-slot-names)
(when (eq alloc :class)
(cl-pushnew sname eieio--known-class-slot-names))
(if eieio-error-unsupported-class-tags
(let ((tmp soptions))
@ -176,8 +179,22 @@ and reference them using the function `class-option'."
(signal 'invalid-slot-type (list :label label)))
;; Is there an initarg, but allocation of class?
(if (and initarg (eq alloc :class))
(message "Class allocated slots do not need :initarg"))
(when (and initarg (eq alloc :class))
(push (format "Meaningless :initarg for class allocated slot '%S'"
sname)
warnings))
(let ((init (plist-get soptions :initform)))
(unless (or (macroexp-const-p init)
(eieio--eval-default-p init))
;; FIXME: Historically, EIEIO used a heuristic to try and guess
;; whether the initform is a form to be evaluated or just
;; a constant. We use `eieio--eval-default-p' to see what the
;; heuristic says and if it disagrees with normal evaluation
;; then tweak the initform to make it fit and emit
;; a warning accordingly.
(push (format "Ambiguous initform needs quoting: %S" init)
warnings)))
;; Anyone can have an accessor function. This creates a function
;; of the specified name, and also performs a `defsetf' if applicable
@ -223,6 +240,8 @@ This method is obsolete."
))
`(progn
,@(mapcar (lambda (w) (macroexp-warn-and-return w `(progn ',w) 'compile-only))
warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
;; pointers to itself.
@ -282,9 +301,7 @@ This method is obsolete."
;;; Get/Set slots in an object.
;;
(defmacro oref (obj slot)
"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."
"Retrieve the value stored in OBJ in the slot named by SLOT."
(declare (debug (form symbolp)))
`(eieio-oref ,obj (quote ,slot)))
@ -292,13 +309,11 @@ created by the :initarg tag."
(defalias 'set-slot-value #'eieio-oset)
(make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
(defmacro oref-default (obj slot)
"Get the default value of OBJ (maybe a class) for SLOT.
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."
(defmacro oref-default (class slot)
"Get the value of class allocated slot SLOT.
CLASS can also be an object, in which case we use the object's class."
(declare (debug (form symbolp)))
`(eieio-oref-default ,obj (quote ,slot)))
`(eieio-oref-default ,class (quote ,slot)))
;;; Handy CLOS macros
;;
@ -538,11 +553,11 @@ OBJECT can be an instance or a class."
((eieio-object-p object) (eieio-oref object slot))
((symbolp object) (eieio-oref-default object slot))
(t (signal 'wrong-type-argument (list 'eieio-object-p object))))
eieio-unbound))))
eieio--unbound))))
(defun slot-makeunbound (object slot)
"In OBJECT, make SLOT unbound."
(eieio-oset object slot eieio-unbound))
(eieio-oset object slot eieio--unbound))
(defun slot-exists-p (object-or-class slot)
"Return non-nil if OBJECT-OR-CLASS has SLOT."
@ -740,18 +755,14 @@ dynamically set from SLOTS."
(slots (eieio--class-slots this-class)))
(dotimes (i (length slots))
;; For each slot, see if we need to evaluate it.
;;
;; Paul Landes said in an email:
;; > CL evaluates it if it can, and otherwise, leaves it as
;; > the quoted thing as you already have. This is by the
;; > Sonya E. Keene book and other things I've look at on the
;; > web.
(let* ((slot (aref slots i))
(initform (cl--slot-descriptor-initform slot))
(dflt (eieio-default-eval-maybe initform)))
(when (not (eq dflt initform))
(initform (cl--slot-descriptor-initform slot)))
;; Those slots whose initform is constant already have the right
;; value set in the default-object.
(unless (macroexp-const-p initform)
;; FIXME: We should be able to just do (aset this (+ i <cst>) dflt)!
(eieio-oset this (cl--slot-descriptor-name slot) dflt)))))
(eieio-oset this (cl--slot-descriptor-name slot)
(eval initform t))))))
;; Shared initialize will parse our slots for us.
(shared-initialize this slots))