From a350ae058caedcb7be7d332564817954e3624e60 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 26 Feb 2021 20:24:52 -0500 Subject: * lisp/emacs-lisp/cconv.el: Improve line-nb info of unused var warnings Instead of warning about unused vars during the analysis phase of closure conversion, do it in the actual closure conversion by annotating the code with "unused" warnings, so that the warnings get emitted later by the bytecomp phase, like all other warnings, at which point the line-number info is a bit less imprecise. Take advantage of this change to wrap the expressions of unused let-bound vars inside (ignore ...) so the byte-compiler can better optimize them away. Finally, promote `macroexp--warn-and-return` to "official" status by removing its "--" marker. (cconv-captured+mutated, cconv-lambda-candidates): Remove vars. (cconv-var-classification): New var to replace them. (cconv-warnings-only): Delete function. (cconv--warn-unused-msg, cconv--var-classification): New functions. (cconv--convert-funcbody): Add warnings for unused args. (cconv-convert): Add warnings for unused vars in `let` and `condition-case`. (cconv--analyze-use): Don't emit an "unused var" warning any more, but instead remember the fact in `cconv-var-classification`. * lisp/emacs-lisp/bytecomp.el (byte-compile-force-lexical-warnings): Remove variable. (byte-compile-preprocess): Remove corresponding case. * lisp/emacs-lisp/pcase.el (pcase--if): Don't throw away `test` effects. (\`): * lisp/emacs-lisp/cl-macs.el (cl--do-arglist): Use `car-safe` instead of `car`, so it can more easily be removed by the optimizer if the result is not used. * lisp/emacs-lisp/macroexp.el (macroexp--warn-wrap): New function. (macroexp-warn-and-return): Rename from `macroexp--warn-and-return`. --- lisp/emacs-lisp/eieio-core.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/eieio-core.el') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index a8361c0d4b4..e7727fd3fc9 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -729,7 +729,7 @@ Argument FN is the function calling this verifier." (pcase slot ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-slot-names)))) - (macroexp--warn-and-return + (macroexp-warn-and-return (format-message "Unknown slot `%S'" name) exp 'compile-only)) (_ exp)))) (gv-setter eieio-oset)) -- cgit v1.2.3 From 86daa721bb287652a70162c8dcdf8d9d37013ac7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Apr 2021 23:28:04 -0400 Subject: * lisp/emacs-lisp/eieio-core.el (list-of): Don't quote lambda --- lisp/emacs-lisp/eieio-core.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp/eieio-core.el') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index e7727fd3fc9..2923dffd951 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -169,7 +169,7 @@ Return nil if that option doesn't exist." (and (recordp obj) (eieio--class-p (eieio--object-class obj)))) -(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1") +(define-obsolete-function-alias 'object-p #'eieio-object-p "25.1") (defun class-abstract-p (class) "Return non-nil if CLASS is abstract. @@ -242,9 +242,9 @@ use \\='%s or turn off `eieio-backward-compatibility' instead" cname) (cl-deftype list-of (elem-type) `(and list - (satisfies (lambda (list) - (cl-every (lambda (elem) (cl-typep elem ',elem-type)) - list))))) + (satisfies ,(lambda (list) + (cl-every (lambda (elem) (cl-typep elem elem-type)) + list))))) (defun eieio-make-class-predicate (class) @@ -787,7 +787,7 @@ Fills in OBJ's SLOT with its default value." (cond ;; Is it a function call? If so, evaluate it. ((eieio-eval-default-p val) - (eval val)) + (eval val t)) ;;;; check for quoted things, and unquote them ;;((and (consp val) (eq (car val) 'quote)) ;; (car (cdr val))) @@ -1029,7 +1029,7 @@ method invocation orders of the involved classes." (eieio--class-precedence-c3 class)))))) (define-obsolete-function-alias - 'class-precedence-list 'eieio--class-precedence-list "24.4") + 'class-precedence-list #'eieio--class-precedence-list "24.4") ;;; Here are some special types of errors -- cgit v1.2.3 From 2c47eaa18a4a3f7eb53ed826d8c5d018ac843586 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 18 May 2021 17:13:37 -0400 Subject: * lisp/emacs-lisp/eieio-core.el (eieio-defclass-internal): Use a closure --- lisp/emacs-lisp/eieio-core.el | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) (limited to 'lisp/emacs-lisp/eieio-core.el') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 2923dffd951..34b4575182e 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -347,19 +347,20 @@ See `defclass' for more information." (when eieio-backward-compatibility (let ((csym (intern (concat (symbol-name cname) "-list-p")))) (defalias csym - `(lambda (obj) - ,(format - "Test OBJ to see if it a list of objects which are a child of type %s" - cname) - (when (listp obj) - (let ((ans t)) ;; nil is valid - ;; Loop over all the elements of the input list, test - ;; each to make sure it is a child of the desired object class. - (while (and obj ans) - (setq ans (and (eieio-object-p (car obj)) - (object-of-class-p (car obj) ,cname))) - (setq obj (cdr obj))) - ans)))) + (lambda (obj) + (:documentation + (format + "Test OBJ to see if it a list of objects which are a child of type %s" + cname)) + (when (listp obj) + (let ((ans t)) ;; nil is valid + ;; Loop over all the elements of the input list, test + ;; each to make sure it is a child of the desired object class. + (while (and obj ans) + (setq ans (and (eieio-object-p (car obj)) + (object-of-class-p (car obj) 'cname))) + (setq obj (cdr obj))) + ans)))) (make-obsolete csym (format "use (cl-typep ... \\='(list-of %s)) instead" cname) -- cgit v1.2.3 From 4c6554413d318069239ba83f4f42fa2452801d30 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Jun 2021 16:22:03 -0400 Subject: EIEIO: Promote the CLOS behavior over the EIEIO-specific behavior 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 ). (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. --- doc/misc/eieio.texi | 88 +++++++++++------------- lisp/auth-source.el | 4 +- lisp/cedet/ede/base.el | 46 ++++++------- lisp/cedet/ede/config.el | 2 +- lisp/cedet/ede/generic.el | 2 +- lisp/cedet/ede/proj-obj.el | 4 +- lisp/cedet/ede/proj.el | 12 ++-- lisp/cedet/semantic/db-ebrowse.el | 4 +- lisp/cedet/semantic/db-el.el | 4 +- lisp/cedet/semantic/db-javascript.el | 4 +- lisp/cedet/semantic/db.el | 4 +- lisp/cedet/semantic/ede-grammar.el | 12 ++-- lisp/cedet/srecode/compile.el | 7 +- lisp/cedet/srecode/insert.el | 17 +++-- lisp/emacs-lisp/chart.el | 2 +- lisp/emacs-lisp/eieio-base.el | 2 +- lisp/emacs-lisp/eieio-core.el | 127 ++++++++++++++++++++++------------- lisp/emacs-lisp/eieio-custom.el | 2 +- lisp/emacs-lisp/eieio-speedbar.el | 10 +-- lisp/emacs-lisp/eieio.el | 57 +++++++++------- lisp/transient.el | 8 +-- 21 files changed, 231 insertions(+), 187 deletions(-) (limited to 'lisp/emacs-lisp/eieio-core.el') 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 -child-p and -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 ) 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)) -- cgit v1.2.3 From 52187012f1772bc9ccbe3376991bb35732a76501 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 21 Jul 2021 11:11:50 -0400 Subject: * lisp/emacs-lisp/macroexp.el (macroexp-warn-and-return): Add arg `category` Use it to obey `byte-compile-warnings`. (macroexp--warn-wrap): Add arg `category`. (macroexp-macroexpand, macroexp--expand-all): Use it. * lisp/emacs-lisp/cconv.el (cconv--convert-funcbody, cconv-convert): Mark the warnings as `lexical`. * lisp/emacs-lisp/eieio-core.el (eieio-oref, eieio-oref-default) (eieio-oset-default): * lisp/emacs-lisp/eieio.el (defclass): Adjust to new calling convention. --- lisp/emacs-lisp/cconv.el | 15 ++++++++------- lisp/emacs-lisp/eieio-core.el | 13 ++++++++----- lisp/emacs-lisp/eieio.el | 5 +++-- lisp/emacs-lisp/macroexp.el | 27 +++++++++++++++------------ 4 files changed, 34 insertions(+), 26 deletions(-) (limited to 'lisp/emacs-lisp/eieio-core.el') diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index f1579cda8bd..ea0b09805ea 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -259,8 +259,7 @@ Returns a form where all lambdas don't have any free variables." (not (intern-soft var)) (eq ?_ (aref (symbol-name var) 0)) ;; As a special exception, ignore "ignore". - (eq var 'ignored) - (not (byte-compile-warning-enabled-p 'unbound var))) + (eq var 'ignored)) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) (format "Unused lexical %s `%S'%s" varkind var @@ -287,7 +286,7 @@ of converted forms." (let (and (pred stringp) msg) (cconv--warn-unused-msg arg "argument"))) (if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed? - (push (lambda (body) (macroexp--warn-wrap msg body)) wrappers)) + (push (lambda (body) (macroexp--warn-wrap msg body 'lexical)) wrappers)) (_ (if (assq arg env) (push `(,arg . nil) env))))) (setq funcbody (mapcar (lambda (form) @@ -408,7 +407,7 @@ places where they originally did not directly appear." `(ignore ,(cconv-convert value env extend))) (msg (cconv--warn-unused-msg var "variable"))) (if (null msg) newval - (macroexp--warn-wrap msg newval)))) + (macroexp--warn-wrap msg newval 'lexical)))) ;; Normal default case. (_ @@ -507,7 +506,7 @@ places where they originally did not directly appear." (newprotform (cconv-convert protected-form env extend))) `(condition-case ,var ,(if msg - (macroexp--warn-wrap msg newprotform) + (macroexp--warn-wrap msg newprotform 'lexical) newprotform) ,@(mapcar (lambda (handler) @@ -599,14 +598,16 @@ FORM is the parent form that binds this var." (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) ,_ ,_ ,_ ,_) ;; FIXME: Convert this warning to use `macroexp--warn-wrap' - ;; so as to give better position information. + ;; so as to give better position information and obey + ;; `byte-compile-warnings'. (byte-compile-warn "%s `%S' not left unused" varkind var)) ((and (let (or 'let* 'let) (car form)) `((,var) ;; (or `(,var nil) : Too many false positives: bug#47080 t nil ,_ ,_)) ;; FIXME: Convert this warning to use `macroexp--warn-wrap' - ;; so as to give better position information. + ;; so as to give better position information and obey + ;; `byte-compile-warnings'. (unless (not (intern-soft var)) (byte-compile-warn "Variable `%S' left uninitialized" var)))) (pcase vardata diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 8f1e38b613b..b11ed3333f0 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -742,7 +742,8 @@ Argument FN is the function calling this verifier." ((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)) + (format-message "Unknown slot `%S'" name) + exp nil 'compile-only)) (_ exp)))) (gv-setter eieio-oset)) (cl-check-type slot symbol) @@ -777,12 +778,13 @@ Fills in CLASS's SLOT with its default value." ((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)) + (format-message "Unknown slot `%S'" name) + exp nil '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 nil 'compile-only)) (_ exp))))) (cl-check-type class (or eieio-object class)) (cl-check-type slot symbol) @@ -838,12 +840,13 @@ Fills in the default value in CLASS' in SLOT with VALUE." ((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)) + (format-message "Unknown slot `%S'" name) + exp nil '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 nil 'compile-only)) (_ exp))))) (setq class (eieio--class-object class)) (cl-check-type class eieio--class) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index b31ea42a99b..c16d8e110ec 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -241,7 +241,8 @@ This method is obsolete." )) `(progn - ,@(mapcar (lambda (w) (macroexp-warn-and-return w `(progn ',w) 'compile-only)) + ,@(mapcar (lambda (w) + (macroexp-warn-and-return w `(progn ',w) nil '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 @@ -742,7 +743,7 @@ Called from the constructor routine." (cl-defmethod initialize-instance ((this eieio-default-superclass) &optional args) - "Construct the new object THIS based on SLOTS. + "Construct the new object THIS based on ARGS. ARGS is a property list where odd numbered elements are tags, and even numbered elements are the values to store in the tagged slot. If you overload the `initialize-instance', there you will need to diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index f4bab9c3456..48311f56de2 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -135,15 +135,22 @@ Other uses risk returning non-nil value that point to the wrong file." (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key)) -(defun macroexp--warn-wrap (msg form) - (let ((when-compiled (lambda () (byte-compile-warn "%s" msg)))) +(defun macroexp--warn-wrap (msg form category) + (let ((when-compiled (lambda () + (when (byte-compile-warning-enabled-p category) + (byte-compile-warn "%s" msg))))) `(progn (macroexp--funcall-if-compiled ',when-compiled) ,form))) (define-obsolete-function-alias 'macroexp--warn-and-return #'macroexp-warn-and-return "28.1") -(defun macroexp-warn-and-return (msg form &optional compile-only) +(defun macroexp-warn-and-return (msg form &optional category compile-only) + "Return code equivalent to FORM by labeled with warning MSG. +CATEGORY is the category of the warning, like the categories that +can appear in `byte-compile-warnings'. +COMPILE-ONLY if non-nil indicates that no warning should be emitted if +the code is executed without being compiled first." (cond ((null msg) form) ((macroexp-compiling-p) @@ -153,7 +160,7 @@ Other uses risk returning non-nil value that point to the wrong file." ;; macroexpand-all gets right back to macroexpanding `form'. form (puthash form form macroexp--warned) - (macroexp--warn-wrap msg form))) + (macroexp--warn-wrap msg form category))) (t (unless compile-only (message "%sWarning: %s" @@ -205,9 +212,7 @@ Other uses risk returning non-nil value that point to the wrong file." (if (and (not (eq form new-form)) ;It was a macro call. (car-safe form) (symbolp (car form)) - (get (car form) 'byte-obsolete-info) - (or (not (fboundp 'byte-compile-warning-enabled-p)) - (byte-compile-warning-enabled-p 'obsolete (car form)))) + (get (car form) 'byte-obsolete-info)) (let* ((fun (car form)) (obsolete (get fun 'byte-obsolete-info))) (macroexp-warn-and-return @@ -215,7 +220,7 @@ Other uses risk returning non-nil value that point to the wrong file." fun obsolete (if (symbolp (symbol-function fun)) "alias" "macro")) - new-form)) + new-form 'obsolete)) new-form))) (defun macroexp--unfold-lambda (form &optional name) @@ -325,10 +330,8 @@ Assumes the caller has bound `macroexpand-all-environment'." (if (null body) (macroexp-unprogn (macroexp-warn-and-return - (and (or (not (fboundp 'byte-compile-warning-enabled-p)) - (byte-compile-warning-enabled-p t)) - (format "Empty %s body" fun)) - nil t)) + (format "Empty %s body" fun) + nil nil 'compile-only)) (macroexp--all-forms body)) (cdr form)) form)) -- cgit v1.2.3