summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/misc/eieio.texi88
-rw-r--r--lisp/auth-source.el4
-rw-r--r--lisp/cedet/ede/base.el46
-rw-r--r--lisp/cedet/ede/config.el2
-rw-r--r--lisp/cedet/ede/generic.el2
-rw-r--r--lisp/cedet/ede/proj-obj.el4
-rw-r--r--lisp/cedet/ede/proj.el12
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el4
-rw-r--r--lisp/cedet/semantic/db-el.el4
-rw-r--r--lisp/cedet/semantic/db-javascript.el4
-rw-r--r--lisp/cedet/semantic/db.el4
-rw-r--r--lisp/cedet/semantic/ede-grammar.el12
-rw-r--r--lisp/cedet/srecode/compile.el7
-rw-r--r--lisp/cedet/srecode/insert.el17
-rw-r--r--lisp/emacs-lisp/chart.el2
-rw-r--r--lisp/emacs-lisp/eieio-base.el2
-rw-r--r--lisp/emacs-lisp/eieio-core.el127
-rw-r--r--lisp/emacs-lisp/eieio-custom.el2
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el10
-rw-r--r--lisp/emacs-lisp/eieio.el57
-rw-r--r--lisp/transient.el8
21 files changed, 231 insertions, 187 deletions
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index 4952e909902..63b42827311 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -115,10 +115,10 @@ Each class can have methods, which are defined like this:
(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
@@ -693,16 +693,43 @@ for each slot. For example:
@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
@@ -737,35 +764,6 @@ changed, this can be arranged by simply executing this bit of code:
@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.
@@ -807,7 +805,7 @@ Where each @var{var} is the local variable given to the associated
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
@@ -981,8 +979,8 @@ the @code{subclass} specializer with @code{cl-defmethod}:
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
@@ -1238,12 +1236,6 @@ of CLOS.
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
@@ -1656,8 +1648,8 @@ Method invoked when an attempt to access a slot in @var{object} fails.
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}.
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 2516b4b9fae..9ca28ebb0a9 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -121,12 +121,12 @@ let-binding."
: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.")))
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 3fcc023e0c6..103a37045cc 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -47,7 +47,7 @@
;; 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
@@ -91,16 +91,16 @@ This is used to match target objects with the compilers they can use, and
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)
)
@@ -236,7 +236,7 @@ also be of a form used by TRAMP for use with scp, or rcp.")
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"
@@ -258,25 +258,25 @@ and target specific elements such as build variables.")
: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)
)
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el
index bc1810aa84f..98a0419e8bf 100644
--- a/lisp/cedet/ede/config.el
+++ b/lisp/cedet/ede/config.el
@@ -96,7 +96,7 @@ and also want to save some extra level of configuration.")
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
diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el
index b3b59b5dc35..4537f59ac9d 100644
--- a/lisp/cedet/ede/generic.el
+++ b/lisp/cedet/ede/generic.el
@@ -137,7 +137,7 @@ subclasses of this base target will override the default value.")
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
diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el
index 2ae62f4b38e..1b96376d3eb 100644
--- a/lisp/cedet/ede/proj-obj.el
+++ b/lisp/cedet/ede/proj-obj.el
@@ -34,8 +34,8 @@
;;; 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
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 6ff763016ef..c8c34d092f1 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -220,7 +220,7 @@ This enables the creation of your target type."
((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)
@@ -240,7 +240,7 @@ in targets.")
: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
@@ -269,10 +269,10 @@ These files can contain additional rules, variables, and customizations.")
: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
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index 682a4ccac48..8bc3b810a65 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -79,7 +79,7 @@ be searched."
;;; 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
@@ -95,7 +95,7 @@ This table is composited from the ebrowse *Globals* section.")
(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.")
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 78339c375fb..41e48b0bc30 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -40,7 +40,7 @@
;;; 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.")
@@ -63,7 +63,7 @@ It does not need refreshing."
(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.")
diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el
index cad561e7967..bf3d6122954 100644
--- a/lisp/cedet/semantic/db-javascript.el
+++ b/lisp/cedet/semantic/db-javascript.el
@@ -80,7 +80,7 @@ See bottom of this file for instructions on managing this list.")
;;; 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.")
@@ -88,7 +88,7 @@ See bottom of this file for instructions on managing this list.")
(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.")
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 8f9eceea554..38e2b34b0db 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -321,12 +321,12 @@ Adds the number of tags in this file to the object print name."
'(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.")
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index 6bb83526f6c..19d4184fa45 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -38,13 +38,13 @@
(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"))
)
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 36df1da9e33..15107ef1e43 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -110,7 +110,12 @@ stack is broken."
: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)
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index ab0503c8d36..f20842b1d8a 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -89,6 +89,8 @@ DICT-ENTRIES are additional dictionary values to add."
;; 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,
@@ -134,13 +136,13 @@ has set everything up already."
)
(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)))
@@ -733,6 +735,7 @@ DEPTH.")
"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
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 5afc6d3bde3..0494497feaf 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -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)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 641882c9026..ec7c899bddc 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -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)))
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 34b4575182e..8f1e38b613b 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -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)
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 8257f7a4bae..d7d078b2d94 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -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"
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index c25ea8acee9..3f2a6537ab8 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -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)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 31b6b0945bb..1c8c372aaef 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -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))
diff --git a/lisp/transient.el b/lisp/transient.el
index 93a643c78e6..6153b502f7a 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -932,7 +932,7 @@ example, sets a variable use `transient-define-infix' instead.
(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
@@ -1003,7 +1003,7 @@ example, sets a variable use `transient-define-infix' instead.
(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)))
@@ -3583,9 +3583,9 @@ we stop there."
;;;; `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))
View Lorry Controller Status