master 7e9e10d9842: (custom-declare-variable): Check values previously set via setopt

branch: master
commit 7e9e10d98422b7bd38861792489c284f2b101159
Author: Stefan Monnier <[email protected]>
Commit: Stefan Monnier <[email protected]>

    (custom-declare-variable): Check values previously set via setopt
    
    Rename `custom-check-value` to  `custom-check-values` and make it hold
    a list of values whose type-check is pending.  Check it in
    `custom-declare-variable` rather than `custom-initialize-reset` to fix
    bug#81372.
    
    * lisp/custom.el (custom-initialize-reset): Don't type check previous
    setopt values.
    (custom-declare-variable): Do it here instead.  Change warning message
    to clarify that the erroneous value was provided in some earlier setopt call.
    
    * lisp/cus-edit.el (setop--set): Push to the `custom-check-values` only if
    we can't do the type check yet, to avoid duplicate warnings (and memory
    leaks).
    (setopt--set-local): Fix indentation and add FIXMEs.
---
 lisp/cus-edit.el | 42 ++++++++++++++++++++++++------------------
 lisp/custom.el   | 26 ++++++++++++--------------
 2 files changed, 36 insertions(+), 32 deletions(-)

diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 18e649987f2..3dd6fedc69f 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1098,10 +1098,12 @@ even if it doesn't match the type.)
 (defun setopt--set (variable value)
   (custom-load-symbol variable)
   ;; Check that the type is correct.
-  (when-let* ((type (get variable 'custom-type)))
-    (unless (widget-apply (widget-convert type) :match value)
-      (warn "Value does not match %S's type `%S': %S" variable type value)))
-  (put variable 'custom-check-value (list value))
+  (let* ((type (get variable 'custom-type)))
+    (if (not (or type (get variable 'standard-value)))
+        ;; `custom-declare-variable' has not run yet.  Postpone the check.
+        (push value (get variable 'custom-check-values))
+      (unless (widget-apply (widget-convert type) :match value)
+        (warn "Value does not match %S's type `%S': %S" variable type value))))
   (funcall (or (get variable 'custom-set) #'set-default) variable value))
 
 ;;;###autoload
@@ -1157,24 +1159,28 @@ Consult `setopt-local-type-mismatch'."
   (let ((accept t))
     ;; Check that the type is correct.
     (when-let* ((type (get variable 'custom-type)))
+      ;; FIXME: If the var hasn't been initialized yet, `type' is nil and we
+      ;; skip the type check altogether.  Use `custom-check-values'?
       (unless (widget-apply (widget-convert type) :match value)
         (let ((msg (format-message
                     "Value does not match %S's type `%S': %S"
                     variable type value)))
-        (cond
-         ;; Fall through and try anyway.
-         ((eq setopt-local-type-mismatch 'accept))
-         ;; Silently discard the mismatched value.
-         ((eq setopt-local-type-mismatch 'discard)
-          (setq accept nil))
-         ;; Prompt to accept or discard the value.
-         (setopt-local-type-mismatch
-          (setq accept (eq ?a (car
-                               (read-multiple-choice msg
-                                '((?a "accept" "Accept")
-                                  (?d "discard" "Discard")))))))
-         (t
-          (warn msg))))))
+          ;; FIXME: It's weird to do this `setopt-local-type-mismatch`
+          ;; control  for `setopt-local' and not for `setopt'.
+          (cond
+           ;; Fall through and try anyway.
+           ((eq setopt-local-type-mismatch 'accept))
+           ;; Silently discard the mismatched value.
+           ((eq setopt-local-type-mismatch 'discard)
+            (setq accept nil))
+           ;; Prompt to accept or discard the value.
+           (setopt-local-type-mismatch
+            (setq accept (eq ?a (car (read-multiple-choice
+                                      msg
+                                      '((?a "accept" "Accept")
+                                        (?d "discard" "Discard")))))))
+           (t
+            (warn msg))))))
     (when accept
       (condition-case _
           (funcall (or (get variable 'custom-set)
diff --git a/lisp/custom.el b/lisp/custom.el
index 6779ca38134..e7abbe356ed 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -91,20 +91,6 @@ The value is either the symbol's current value
  (as obtained using the `:get' function), if any,
 or the value in the symbol's `saved-value' property if any,
 or (last of all) the value of EXP."
-  ;; If this value has been set with `setopt' (for instance in
-  ;; ~/.emacs), we didn't necessarily know the type of the user option
-  ;; then.  So check now, and issue a warning if it's wrong.
-  (let ((value (get symbol 'custom-check-value)))
-    (when value
-      (let ((type (get symbol 'custom-type)))
-        (when (and type
-                   (boundp symbol)
-                   (eq (car value) (symbol-value symbol))
-                   ;; Check that the type is correct.
-                   (not (widget-apply (widget-convert type)
-                                      :match (car value))))
-          (warn "Value `%S' for `%s' does not match type %s"
-                value symbol type)))))
   (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
            symbol
            (condition-case nil
@@ -245,6 +231,18 @@ set to nil, as the value is no longer rogue."
     ;; as set the special-variable-p flag.
     (internal--define-uninitialized-variable symbol doc)
     (put symbol 'custom-requests requests)
+    ;; If this value has been set with `setopt' (for instance in
+    ;; ~/.emacs), we didn't necessarily know the type of the user option
+    ;; then.  So check now, and issue a warning if it's wrong.
+    (dolist (value (prog1 (nreverse (get symbol 'custom-check-values))
+                     (put symbol 'custom-check-values nil)))
+      (let ((type (get symbol 'custom-type)))
+        (when (and type
+                   ;; Check that the type is correct.
+                   (not (widget-apply (widget-convert type)
+                                      :match (car value))))
+          (warn "Value previously set by setopt did not match %S's type %S:\n%S"
+                symbol type value))))
     ;; Do the actual initialization.
     (unless custom-dont-initialize
       (funcall initialize symbol default)