bug#81372: 30.2; make setopt warn on type mismatch in more cases
Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <[email protected]>
| Newsgroups | gmane.emacs.bugs |
|---|---|
| Message-ID | <[email protected]> |
> I think the patch below will at least get rid of the double-warning. > It doesn't fix the OP's problem nor does it fix the fact that the > warning's text will be different depending on whether we end up > performing the test in `setopt--set` or `custom-initialize-reset`. I've come around to agreeing that it's OK if the message is not the same. 🙂 Here's my current suggestion. It includes FIXME comments in `setopt--set-local` about which I'd like to have Stephane's opinion, tho this shouldn't stop us from moving with the `setopt--set` part. === Stefan
custom.patch
(text/x-diff, 5.6 KB)
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.
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 @@ setopt
(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 @@ setopt--set-local
(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 8417dab2fe3..4d6021ea923 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -91,20 +91,6 @@ custom-initialize-reset
(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 @@ custom-declare-variable
;; 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)