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.
(cl-defmethod call-person ((pers person) &optional scriptname)
"Dial the phone for the person PERS.
Execute the program SCRIPTNAME to dial the phone."
- (message "Dialing the phone for %s" (oref pers name))
+ (message "Dialing the phone for %s" (slot-value pers 'name))
(shell-command (concat (or scriptname "dialphone.sh")
" "
- (oref pers phone))))
+ (slot-value pers 'phone))))
@end example
@noindent
@node Accessing Slots
@chapter Accessing Slots
-There are several ways to access slot values in an object. The naming
-and argument-order conventions are similar to those used for
-referencing vectors (@pxref{Vectors,,,elisp,GNU Emacs Lisp Reference
-Manual}).
+There are several ways to access slot values in an object.
+The following accessors are defined by CLOS to reference or modify
+slot values, and use the previously mentioned set/ref routines.
+
+@defun slot-value object slot
+@anchor{slot-value}
+This function retrieves the value of @var{slot} from @var{object}.
+
+This is a generalized variable that can be used with @code{setf} to
+modify the value stored in @var{slot}. @xref{Generalized
+Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
+@end defun
+
+@defun set-slot-value object slot value
+@anchor{set-slot-value}
+This function sets the value of @var{slot} from @var{object}.
+
+This is not a CLOS function, but is the obsolete setter for
+@code{slot-value} used by the @code{setf} macro. It is therefore
+recommended to use @w{@code{(setf (slot-value @var{object} @var{slot})
+@var{value})}} instead.
+@end defun
+
+@defun slot-makeunbound object slot
+This function unbinds @var{slot} in @var{object}. Referencing an
+unbound slot can signal an error.
+@end defun
+
+The following accessors follow a naming and argument-order conventions
+are similar to those used for referencing vectors
+(@pxref{Vectors,,,elisp,GNU Emacs Lisp Reference Manual}).
@defmac oref obj slot
@anchor{oref}
This macro retrieves the value stored in @var{obj} in the named
-@var{slot}. Slot names are determined by @code{defclass} which
-creates the slot.
+@var{slot}. Unlike @code{slot-value}, the symbol for @var{slot} must
+not be quoted.
This is a generalized variable that can be used with @code{setf} to
modify the value stored in @var{slot}. @xref{Generalized
@end example
@end defmac
-The following accessors are defined by CLOS to reference or modify
-slot values, and use the previously mentioned set/ref routines.
-
-@defun slot-value object slot
-@anchor{slot-value}
-This function retrieves the value of @var{slot} from @var{object}.
-Unlike @code{oref}, the symbol for @var{slot} must be quoted.
-
-This is a generalized variable that can be used with @code{setf} to
-modify the value stored in @var{slot}. @xref{Generalized
-Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
-@end defun
-
-@defun set-slot-value object slot value
-@anchor{set-slot-value}
-This function sets the value of @var{slot} from @var{object}. Unlike
-@code{oset}, the symbol for @var{slot} must be quoted.
-
-This is not a CLOS function, but is the obsolete setter for
-@code{slot-value} used by the @code{setf} macro. It is therefore
-recommended to use @w{@code{(setf (slot-value @var{object} @var{slot})
-@var{value})}} instead.
-@end defun
-
-@defun slot-makeunbound object slot
-This function unbinds @var{slot} in @var{object}. Referencing an
-unbound slot can signal an error.
-@end defun
-
@defun object-add-to-list object slot item &optional append
@anchor{object-add-to-list}
In OBJECT's @var{slot}, add @var{item} to the list of elements.
variable name of the same name as the slot.
@example
-(defclass myclass () (x :initform 1))
+(defclass myclass () ((x :initform 1)))
(setq mc (make-instance 'myclass))
(with-slots (x) mc x) => 1
(with-slots ((something x)) mc something) => 1
new))
@end example
-The first argument of a static method will be a class rather than an
-object. Use the functions @code{oref-default} or @code{oset-default} which
+The argument of a static method will be a class rather than an object.
+Use the functions @code{oref-default} or @code{oset-default} which
will work on a class.
A class's @code{make-instance} method is defined as a static
Return the list of public slots for @var{obj}.
@end defun
-@defun class-slot-initarg class slot
-For the given @var{class} return an :initarg associated with
-@var{slot}. Not all slots have initargs, so the return value can be
-@code{nil}.
-@end defun
-
@node Base Classes
@chapter Base Classes
that was requested, and optional @var{new-value} is the value that was desired
to be set.
-This method is called from @code{oref}, @code{oset}, and other functions which
-directly reference slots in EIEIO objects.
+This method is called from @code{slot-value}, @code{set-slot-value},
+and other functions which directly reference slots in EIEIO objects.
The default method signals an error of type @code{invalid-slot-name}.
@xref{Signals}.
:initform nil
:documentation "Internal backend data.")
(create-function :initarg :create-function
- :initform ignore
+ :initform #'ignore
:type function
:custom function
:documentation "The create function.")
(search-function :initarg :search-function
- :initform ignore
+ :initform #'ignore
:type function
:custom function
:documentation "The search function.")))
;; and features of those files.
(defclass ede-target (eieio-speedbar-directory-button eieio-named)
- ((buttonface :initform speedbar-file-face) ;override for superclass
+ ((buttonface :initform 'speedbar-file-face) ;override for superclass
(name :initarg :name
:type string
:custom string
which files this object is interested in."
:accessor ede-object-sourcecode)
(keybindings :allocation :class
- :initform (("D" . ede-debug-target))
+ :initform '(("D" . ede-debug-target))
:documentation
"Keybindings specialized to this type of target."
:accessor ede-object-keybindings)
(menu :allocation :class
- :initform ( [ "Debug target" ede-debug-target
- (ede-buffer-belongs-to-target-p) ]
- [ "Run target" ede-run-target
- (ede-buffer-belongs-to-target-p) ]
- )
+ :initform '( [ "Debug target" ede-debug-target
+ (ede-buffer-belongs-to-target-p) ]
+ [ "Run target" ede-run-target
+ (ede-buffer-belongs-to-target-p) ]
+ )
:documentation "Menu specialized to this type of target."
:accessor ede-object-menu)
)
This FTP site should be in Emacs form as needed by `ange-ftp'.
If this slot is nil, then use `ftp-site' instead.")
(configurations :initarg :configurations
- :initform ("debug" "release")
+ :initform '("debug" "release")
:type list
:custom (repeat string)
:label "Configuration Options"
:group (settings)
:documentation "Project local variables")
(keybindings :allocation :class
- :initform (("D" . ede-debug-target)
- ("R" . ede-run-target))
+ :initform '(("D" . ede-debug-target)
+ ("R" . ede-run-target))
:documentation "Keybindings specialized to this type of target."
:accessor ede-object-keybindings)
(menu :allocation :class
:initform
- (
- [ "Update Version" ede-update-version ede-object ]
- [ "Version Control Status" ede-vc-project-directory ede-object ]
- [ "Edit Project Homepage" ede-edit-web-page
- (and ede-object (oref (ede-toplevel) web-site-file)) ]
- [ "Browse Project URL" ede-web-browse-home
- (and ede-object
- (not (string= "" (oref (ede-toplevel) web-site-url)))) ]
- "--"
- [ "Rescan Project Files" ede-rescan-toplevel t ]
- [ "Edit Projectfile" ede-edit-file-target
- (ede-buffer-belongs-to-project-p) ]
- )
+ '(
+ [ "Update Version" ede-update-version ede-object ]
+ [ "Version Control Status" ede-vc-project-directory ede-object ]
+ [ "Edit Project Homepage" ede-edit-web-page
+ (and ede-object (oref (ede-toplevel) web-site-file)) ]
+ [ "Browse Project URL" ede-web-browse-home
+ (and ede-object
+ (not (string= "" (oref (ede-toplevel) web-site-url)))) ]
+ "--"
+ [ "Rescan Project Files" ede-rescan-toplevel t ]
+ [ "Edit Projectfile" ede-edit-file-target
+ (ede-buffer-belongs-to-project-p) ]
+ )
:documentation "Menu specialized to this type of target."
:accessor ede-object-menu)
)
This filename excludes the directory name and is used to
initialize the :file slot of the persistent baseclass.")
(config-class
- :initform ede-extra-config
+ :initform 'ede-extra-config
:allocation :class
:type class
:documentation
ede-project-with-config-program
ede-project-with-config-c
ede-project-with-config-java)
- ((config-class :initform ede-generic-config)
+ ((config-class :initform 'ede-generic-config)
(config-file-basename :initform "EDEConfig.el")
(buildfile :initform ""
:type string
;;; Code:
(defclass ede-proj-target-makefile-objectcode (ede-proj-target-makefile)
(;; Give this a new default
- (configuration-variables :initform ("debug" . (("CFLAGS" . "-g")
- ("LDFLAGS" . "-g"))))
+ (configuration-variables :initform '("debug" . (("CFLAGS" . "-g")
+ ("LDFLAGS" . "-g"))))
;; @TODO - add an include path.
(availablecompilers :initform '(ede-gcc-compiler
ede-g++-compiler
((extension :initform ".ede")
(file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit")
(makefile-type :initarg :makefile-type
- :initform Makefile
+ :initform 'Makefile
:type symbol
:custom (choice (const Makefile)
;(const Makefile.in)
:documentation "Variables to set in this Makefile.")
(configuration-variables
:initarg :configuration-variables
- :initform ("debug" (("DEBUG" . "1")))
+ :initform '("debug" (("DEBUG" . "1")))
:type list
:custom (repeat (cons (string :tag "Configuration")
(repeat
:documentation
"Non-nil to do implement automatic dependencies in the Makefile.")
(menu :initform
- (
- [ "Regenerate Makefiles" ede-proj-regenerate t ]
- [ "Upload Distribution" ede-upload-distribution t ]
- )
+ '(
+ [ "Regenerate Makefiles" ede-proj-regenerate t ]
+ [ "Upload Distribution" ede-upload-distribution t ]
+ )
)
(metasubproject
:initarg :metasubproject
;;; SEMANTIC Database related Code
;;; Classes:
(defclass semanticdb-table-ebrowse (semanticdb-table)
- ((major-mode :initform c++-mode)
+ ((major-mode :initform #'c++-mode)
(ebrowse-tree :initform nil
:initarg :ebrowse-tree
:documentation
(defclass semanticdb-project-database-ebrowse
(semanticdb-project-database)
- ((new-table-class :initform semanticdb-table-ebrowse
+ ((new-table-class :initform 'semanticdb-table-ebrowse
:type class
:documentation
"New tables created for this database are of this class.")
;;; Classes:
(defclass semanticdb-table-emacs-lisp (semanticdb-abstract-table)
- ((major-mode :initform emacs-lisp-mode)
+ ((major-mode :initform #'emacs-lisp-mode)
)
"A table for returning search results from Emacs.")
(defclass semanticdb-project-database-emacs-lisp
(semanticdb-project-database eieio-singleton)
- ((new-table-class :initform semanticdb-table-emacs-lisp
+ ((new-table-class :initform 'semanticdb-table-emacs-lisp
:type class
:documentation
"New tables created for this database are of this class.")
;;; Classes:
(defclass semanticdb-table-javascript (semanticdb-search-results-table)
- ((major-mode :initform javascript-mode)
+ ((major-mode :initform #'javascript-mode)
)
"A table for returning search results from javascript.")
(semanticdb-project-database
eieio-singleton ;this db is for js globals, so singleton is appropriate
)
- ((new-table-class :initform semanticdb-table-javascript
+ ((new-table-class :initform 'semanticdb-table-javascript
:type class
:documentation
"New tables created for this database are of this class.")
'(list-of semanticdb-abstract-table))
(defclass semanticdb-project-database (eieio-instance-tracker)
- ((tracking-symbol :initform semanticdb-database-list)
+ ((tracking-symbol :initform 'semanticdb-database-list)
(reference-directory :type string
:documentation "Directory this database refers to.
When a cache directory is specified, then this refers to the directory
this database contains symbols for.")
- (new-table-class :initform semanticdb-table
+ (new-table-class :initform 'semanticdb-table
:type class
:documentation
"New tables created for this database are of this class.")
(keybindings :initform nil)
(phony :initform t)
(sourcetype :initform
- (semantic-ede-source-grammar-wisent
- semantic-ede-source-grammar-bovine
- ))
+ '(semantic-ede-source-grammar-wisent
+ semantic-ede-source-grammar-bovine
+ ))
(availablecompilers :initform
- (semantic-ede-grammar-compiler-wisent
- semantic-ede-grammar-compiler-bovine
- ))
+ '(semantic-ede-grammar-compiler-wisent
+ semantic-ede-grammar-compiler-bovine
+ ))
(aux-packages :initform '("semantic" "cedet-compat"))
(pre-load-packages :initform '("cedet-compat" "semantic/grammar" "semantic/bovine/grammar" "semantic/wisent/grammar"))
)
:type (or null string)
:documentation
"If there is a colon in the inserter's name, it represents
-additional static argument data."))
+additional static argument data.")
+ (key :initform nil :allocation :class
+ :documentation
+ "The character code used to identify inserters of this style.
+All children of this class should specify `key' slot with appropriate
+:initform value."))
"This represents an item to be inserted via a template macro.
Plain text strings are not handled via this baseclass."
:abstract t)
;; for this insertion step.
))
+(eieio-declare-slots (point :allocation :class))
+
(defun srecode-insert-fcn (template dictionary &optional stream skipresolver)
"Insert TEMPLATE using DICTIONARY into STREAM.
Optional SKIPRESOLVER means to avoid refreshing the tag list,
)
(srecode-insert-method template dictionary))
;; Handle specialization of the POINT inserter.
- (when (and (bufferp standard-output)
- (slot-boundp 'srecode-template-inserter-point 'point)
- )
- (set-buffer standard-output)
- (setq end-mark (point-marker))
- (goto-char (oref-default 'srecode-template-inserter-point point)))
- (oset-default 'srecode-template-inserter-point point eieio-unbound)
+ (when (bufferp standard-output)
+ (let ((point (oref-default 'srecode-template-inserter-point point)))
+ (when point
+ (set-buffer standard-output)
+ (setq end-mark (point-marker))
+ (goto-char point))))
+ (oset-default 'srecode-template-inserter-point point nil)
;; Return the end-mark.
(or end-mark (point)))
"The character code used to identify inserters of this style.")
(point :type (or null marker)
:allocation :class
+ :initform nil
:documentation
"Record the value of (point) in this class slot.
It is the responsibility of the inserter algorithm to clear this
(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)
;; 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)))
- 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.
(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.
(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))
(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
(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
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))))
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)
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))
(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
(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)
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))
(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.
;; 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'.
(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)
(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)
(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)
: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"
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.
: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)
(let ((testsym1 (intern (concat (symbol-name name) "-p")))
(testsym2 (intern (format "%s--eieio-childp" name)))
+ (warnings '())
(accessors ()))
;; Collect the accessors we need to define.
;; 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))
(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
))
`(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.
;;; 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)))
(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
;;
((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."
(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))
(if (eq k :class)
(setq class pop)
(setq args (plist-put args k pop)))))
- (vector (or level (oref-default 'transient-child level))
+ (vector (or level 1)
(or class
(if (vectorp car)
'transient-columns
(unless (plist-get args :key)
(when-let ((shortarg (plist-get args :shortarg)))
(setq args (plist-put args :key shortarg))))
- (list (or level (oref-default 'transient-child level))
+ (list (or level 1)
(or class 'transient-suffix)
args)))
;;;; `transient-lisp-variable'
(defclass transient-lisp-variable (transient-variable)
- ((reader :initform transient-lisp-variable--reader)
+ ((reader :initform #'transient-lisp-variable--reader)
(always-read :initform t)
- (set-value :initarg :set-value :initform set))
+ (set-value :initarg :set-value :initform #'set))
"[Experimental] Class used for Lisp variables.")
(cl-defmethod transient-init-value ((obj transient-lisp-variable))
projects / emacs.git / commitdiff