bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Mauro Aranda]

The :type for image-auto-resize looks like this:

:type '(choice (const :tag "No resizing" nil)
                (const :tag "Fit to window" fit-window)
                (other :tag "Scale down to fit window" t)
                (number :tag "Scale factor" 1))

The `other' choice should come last.  Otherwise Custom thinks that
that's the selected option, even when the value of image-auto-resize is
a number.

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Mauro Aranda]

[-- Attachment #1: Type: text/plain, Size: 39 bytes --]

tags 65852 patch
quit


Patch attached.

[-- Attachment #2: 0001-Fix-image-auto-resize-type-Bug-65852.patch --]
[-- Type: text/x-patch, Size: 997 bytes --]

From 540b06c10b2e880d6c7c8ddc3b006f24ef843889 Mon Sep 17 00:00:00 2001
From: Mauro Aranda <maurooaranda@gmail.com>
Date: Sun, 10 Sep 2023 10:45:04 -0300
Subject: [PATCH] Fix image-auto-resize :type (Bug#65852)

* lisp/image-mode.el (image-auto-resize): Arrange for 'other' to be
the last choice.
---
 lisp/image-mode.el | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index dce35ff72da..ecc7d73dd9e 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -69,8 +69,8 @@ image-auto-resize
 Resizing will always preserve the aspect ratio of the image."
   :type '(choice (const :tag "No resizing" nil)
                  (const :tag "Fit to window" fit-window)
-                 (other :tag "Scale down to fit window" t)
-                 (number :tag "Scale factor" 1))
+                 (number :tag "Scale factor" 1)
+                 (other :tag "Scale down to fit window" t))
   :version "29.1"
   :group 'image)
 
-- 
2.34.1

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Stefan Kangas]

Mauro Aranda <maurooaranda@gmail.com> writes:

> The :type for image-auto-resize looks like this:
>
> :type '(choice (const :tag "No resizing" nil)
>                 (const :tag "Fit to window" fit-window)
>                 (other :tag "Scale down to fit window" t)
>                 (number :tag "Scale factor" 1))
>
> The `other' choice should come last.  Otherwise Custom thinks that
> that's the selected option, even when the value of image-auto-resize is
> a number.

ENOPATCH

Thanks for working on this.  Is it possible to detect issues like these
statically?

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Mauro Aranda]

On 10/9/23 10:49, Stefan Kangas wrote:
 > Mauro Aranda <maurooaranda@gmail.com> writes:
 >
 >> The :type for image-auto-resize looks like this:
 >>
 >> :type '(choice (const :tag "No resizing" nil)
 >>                 (const :tag "Fit to window" fit-window)
 >>                 (other :tag "Scale down to fit window" t)
 >>                 (number :tag "Scale factor" 1))
 >>
 >> The `other' choice should come last.  Otherwise Custom thinks that
 >> that's the selected option, even when the value of image-auto-resize is
 >> a number.
 >
 > ENOPATCH

I was waiting to get a bug number assigned, so I could add it in the
commit message.  I don't know if there's any other way to do it.

 > Thanks for working on this.  Is it possible to detect issues like these
 > statically?

I worked on something like that for elint.el, based on the wishlist on
Bug#2591: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=2591

But I know it might be better to make it so that the byte-compiler
warns, so I never posted it.

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Stefan Kangas]

Mauro Aranda <maurooaranda@gmail.com> writes:

> I was waiting to get a bug number assigned, so I could add it in the
> commit message.  I don't know if there's any other way to do it.

That's the only way to do it, as far as I know.  Thanks for doing that,
because it does save us time when installing patches.

I guess it was me that was a bit quick here.

> I worked on something like that for elint.el, based on the wishlist on
> Bug#2591: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=2591
>
> But I know it might be better to make it so that the byte-compiler
> warns, so I never posted it.

I'm not sure if elint.el is used all that much, but I might be wrong.

Mattias, do you think it would make sense to add some warnings for
defcustom types to the byte-compiler?  If so, I guess we'd want to limit
ourselves to flagging obvious errors.

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Mauro Aranda]

[-- Attachment #1: Type: text/plain, Size: 573 bytes --]

On 10/9/23 11:24, Stefan Kangas wrote:
 >> I worked on something like that for elint.el, based on the wishlist on
 >> Bug#2591: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=2591
 >>
 >> But I know it might be better to make it so that the byte-compiler
 >> warns, so I never posted it.
 >
 > I'm not sure if elint.el is used all that much, but I might be wrong.

A shame, if you ask me.  It helped me find two more options with this
problem: font-lock-verbose and message-openpgp-header.  I attach an
updated patch, but let me know if you prefer a separate bug report.


[-- Attachment #2: 0001-Fix-order-of-other-choice-in-defcustom-type.patch --]
[-- Type: text/x-patch, Size: 2445 bytes --]

From b2d5fcecec57b6c2c7f26fdc2b070c14c7eac112 Mon Sep 17 00:00:00 2001
From: Mauro Aranda <maurooaranda@gmail.com>
Date: Sun, 10 Sep 2023 10:45:04 -0300
Subject: [PATCH] Fix order of `other' choice in defcustom :type

* lisp/font-lock.el (font-lock-verbose)
* lisp/image-mode.el (image-auto-resize)
* lisp/gnus/message.el (message-openpgp-header): Arrange for 'other'
to be the last choice.  (Bug#65852)
---
 lisp/font-lock.el    | 4 ++--
 lisp/gnus/message.el | 6 +++---
 lisp/image-mode.el   | 4 ++--
 3 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index f8815c1698a..3df63f82fa1 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -299,8 +299,8 @@ font-lock-verbose
   "If non-nil, means show status messages for buffer fontification.
 If a number, only buffers greater than this size have fontification messages."
   :type '(choice (const :tag "never" nil)
-		 (other :tag "always" t)
-		 (integer :tag "size"))
+		 (integer :tag "size")
+                 (other :tag "always" t))
   :group 'font-lock
   :version "24.1")
 \f
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index fe27927be7e..b8ea529d51c 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2840,11 +2840,11 @@ message-openpgp-header
 			(const :tag "No ID" nil))
 		(choice (string :tag "Key")
 			(const :tag "No Key" nil))
-		(choice (other :tag "None" nil)
-			(const :tag "Unprotected" "unprotected")
+                (choice (const :tag "Unprotected" "unprotected")
 			(const :tag "Sign" "sign")
 			(const :tag "Encrypt" "encrypt")
-			(const :tag "Sign and Encrypt" "signencrypt"))))
+                        (const :tag "Sign and Encrypt" "signencrypt")
+                        (other :tag "None" nil))))
   :version "28.1")
 
 (defun message-add-openpgp-header ()
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index dce35ff72da..ecc7d73dd9e 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -69,8 +69,8 @@ image-auto-resize
 Resizing will always preserve the aspect ratio of the image."
   :type '(choice (const :tag "No resizing" nil)
                  (const :tag "Fit to window" fit-window)
-                 (other :tag "Scale down to fit window" t)
-                 (number :tag "Scale factor" 1))
+                 (number :tag "Scale factor" 1)
+                 (other :tag "Scale down to fit window" t))
   :version "29.1"
   :group 'image)
 
-- 
2.34.1

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Stefan Kangas]

Mauro Aranda <maurooaranda@gmail.com> writes:

> On 10/9/23 11:24, Stefan Kangas wrote:
>  >> I worked on something like that for elint.el, based on the wishlist on
>  >> Bug#2591: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=2591
>  >>
>  >> But I know it might be better to make it so that the byte-compiler
>  >> warns, so I never posted it.
>  >
>  > I'm not sure if elint.el is used all that much, but I might be wrong.
>
> A shame, if you ask me.  It helped me find two more options with this
> problem: font-lock-verbose and message-openpgp-header.  I attach an
> updated patch, but let me know if you prefer a separate bug report.

Thanks, pushed to master.

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Mattias Engdegård]

10 sep. 2023 kl. 16.24 skrev Stefan Kangas <stefankangas@gmail.com>:

> Mattias, do you think it would make sense to add some warnings for
> defcustom types to the byte-compiler?  If so, I guess we'd want to limit
> ourselves to flagging obvious errors.

This appears to be about checking the specified type itself. Another frequently made mistake is having an initial value that does not match the type.

Both of these cases should indeed ideally be caught at compile time but the design of `defcustom` makes it impossible in general. In fact it's probably not even possible to type-check the initial value at load time.

However we can check when the type and value are given as compile-time constants, and we could postpone some of the linting to load time if it wasn't possible earlier.

This is just macro work; I don't see any reason why the byte-compiler itself should need to be involved directly.

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Mattias Engdegård]

[-- Attachment #1: Type: text/plain, Size: 880 bytes --]

I now see that we have an existing defcustom check that runs very late in the compilation.
Although I prefer this kind of check to be carried out during macro-expansion, doing so has the disadvantage that actual values aren't always available. On the other hand, defcustom arguments are usually constants.

Anyway, I went overboard and wrote a sizeable expansion to the current set of warnings and now also checks :type args in define-widget (see attached patch). Try it out and tell me what you think. Maybe the regexp check is too ad-hocky.

Another warning that I rather like but may give too many false positives is that of `const` and `other` types without an actual value which is then assumed to be nil. This seems to be an undocumented 'feature' but it doesn't help readability; it's often unclear whether `nil` was intended or just a result of a forgotten value.


[-- Attachment #2: more-defcustom-warnings.diff --]
[-- Type: application/octet-stream, Size: 11797 bytes --]

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 7feaf118b86..85962b7c38c 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1618,57 +1618,6 @@ byte-compile-format-warn
 (dolist (elt '(format message format-message error))
   (put elt 'byte-compile-format-like t))
 
-(defun byte-compile--defcustom-type-quoted (type)
-  "Whether defcustom TYPE contains an accidentally quoted value."
-  ;; Detect mistakes such as (const 'abc).
-  ;; We don't actually follow the syntax for defcustom types, but this
-  ;; should be good enough.
-  (and (consp type)
-       (proper-list-p type)
-       (if (memq (car type) '(const other))
-           (assq 'quote type)
-         (let ((elts (cdr type)))
-           (while (and elts (not (byte-compile--defcustom-type-quoted
-                                  (car elts))))
-             (setq elts (cdr elts)))
-           elts))))
-
-;; Warn if a custom definition fails to specify :group, or :type.
-(defun byte-compile-nogroup-warn (form)
-  (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
-	(name (cadr form)))
-    (when (eq (car-safe name) 'quote)
-      (when (eq (car form) 'custom-declare-variable)
-        (let ((type (plist-get keyword-args :type)))
-	  (cond
-           ((not type)
-	    (byte-compile-warn-x (cadr name)
-	                         "defcustom for `%s' fails to specify type"
-                                 (cadr name)))
-           ((byte-compile--defcustom-type-quoted type)
-	    (byte-compile-warn-x
-             (cadr name)
-	     "defcustom for `%s' may have accidentally quoted value in type `%s'"
-             (cadr name) type)))))
-      (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
-	       byte-compile-current-group)
-	  ;; The group will be provided implicitly.
-	  nil
-	(or (and (eq (car form) 'custom-declare-group)
-		 (equal name ''emacs))
-	    (plist-get keyword-args :group)
-	    (byte-compile-warn-x (cadr name)
-	     "%s for `%s' fails to specify containing group"
-	     (cdr (assq (car form)
-			'((custom-declare-group . defgroup)
-			  (custom-declare-face . defface)
-			  (custom-declare-variable . defcustom))))
-	     (cadr name)))
-	;; Update the current group, if needed.
-	(if (and byte-compile-current-file ;Only when compiling a whole file.
-		 (eq (car form) 'custom-declare-group))
-	    (setq byte-compile-current-group (cadr name)))))))
-
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
 (defun byte-compile-arglist-warn (name arglist macrop)
@@ -3695,10 +3644,6 @@ byte-compile-form
 (defun byte-compile-normal-call (form)
   (when (and (symbolp (car form))
              (byte-compile-warning-enabled-p 'callargs (car form)))
-    (if (memq (car form)
-              '(custom-declare-group custom-declare-variable
-                                     custom-declare-face))
-        (byte-compile-nogroup-warn form))
     (byte-compile-callargs-warn form))
   (if byte-compile-generate-call-tree
       (byte-compile-annotate-call-tree form))
@@ -5269,6 +5214,193 @@ byte-compile-make-local-variable
   (pcase form (`(,_ ',var) (byte-compile--declare-var var)))
   (byte-compile-normal-call form))
 
+;; Warn about mistakes in `defcustom', `defface', `defgroup', `define-widget'
+
+(defvar bytecomp--cus-function)
+(defvar bytecomp--cus-name)
+
+(defun bytecomp--cus-warn (form format &rest args)
+  (let* ((actual-fun (or (cdr (assq bytecomp--cus-function
+                                    '((custom-declare-group    . defgroup)
+			              (custom-declare-face     . defface)
+			              (custom-declare-variable . defcustom))))
+                         bytecomp--cus-function))
+         (prefix (format "in %s%s: "
+                         actual-fun
+                         (if bytecomp--cus-name
+                             (format " for `%s'" bytecomp--cus-name)
+                           ""))))
+    (apply #'byte-compile-warn-x form (concat prefix format) args)))
+
+(defun bytecomp--check-cus-type (type)
+  (let ((invalid-types
+         '(
+           ;; Lisp type predicates, often confused with customisation types:
+           functionp numberp integerp fixnump natnump floatp booleanp
+           characterp listp stringp consp vectorp symbolp keywordp
+           hash-table-p facep
+           ;; other mistakes occasionally seen (oh yes):
+           or and nil t
+           interger intger lits bool boolen constant filename
+           kbd any list-of auto
+           ;; from botched backquoting
+           \, \,@ \`
+           )))
+    (cond
+     ((consp type)
+      (let* ((head (car type))
+             (tail (cdr type)))
+        (while (and (keywordp (car tail)) (cdr tail))
+          (setq tail (cddr tail)))
+        (cond
+         ((plist-member (cdr type) :convert-widget) nil)
+         ((let ((tl tail))
+            (and (not (keywordp (car tail)))
+                 (progn
+                   (while (and tl (not (keywordp (car tl))))
+                     (setq tl (cdr tl)))
+                   (and tl
+                        (progn
+                          (bytecomp--cus-warn
+                           tl "misplaced %s keyword in `%s' type" (car tl) head)
+                          t))))))
+         ((memq head '(choice radio))
+          (unless tail
+            (bytecomp--cus-warn type "`%s' without any types inside" head))
+          (let ((clauses tail)
+                (constants nil))
+            (while clauses
+              (let* ((ty (car clauses))
+                     (ty-head (car-safe ty)))
+                (when (and (eq ty-head 'other) (cdr clauses))
+                  (bytecomp--cus-warn ty "`other' not last in `%s'" head))
+                (when (memq ty-head '(const other))
+                  (let ((ty-tail (cdr ty))
+                        (val nil))
+                    (while (and (keywordp (car ty-tail)) (cdr ty-tail))
+                      (when (eq (car ty-tail) :value)
+                        (setq val (cadr ty-tail)))
+                      (setq ty-tail (cddr ty-tail)))
+                    (when ty-tail
+                      (setq val (car ty-tail)))
+                    (when (member val constants)
+                      (bytecomp--cus-warn
+                       ty "duplicated value in `%s': `%S'" head val))
+                    (push val constants)))
+                (bytecomp--check-cus-type ty))
+              (setq clauses (cdr clauses)))))
+         ((eq head 'string)
+          (let ((tag (plist-get (cdr type) :tag)))
+            (when (and (stringp tag)
+                       (let ((case-fold-search t))
+                         (string-match-p (rx (or "regex" "regular expression"))
+                                         tag)))
+              (bytecomp--cus-warn
+               type "`string' with :tag %S should use type `regexp'?" tag))))
+         ((eq head 'cons)
+          (unless (= (length tail) 2)
+            (bytecomp--cus-warn
+             type "`cons' requires 2 type specs, found %d" (length tail)))
+          (dolist (ty tail)
+            (bytecomp--check-cus-type ty)))
+         ((memq head '(list group vector set repeat))
+          (unless tail
+            (bytecomp--cus-warn type "`%s' without type specs" head))
+          (dolist (ty tail)
+            (bytecomp--check-cus-type ty)))
+         ((memq head '(alist plist))
+          (let ((key-tag (memq :key-type (cdr type)))
+                (value-tag (memq :value-type (cdr type))))
+            (when key-tag
+              (bytecomp--check-cus-type (cadr key-tag)))
+            (when value-tag
+              (bytecomp--check-cus-type (cadr value-tag)))))
+         ((memq head '(const other))
+          (let* ((value-tag (memq :value (cdr type)))
+                 (n (length tail))
+                 (val (car tail)))
+            (cond
+             ((or (> n 1) (and value-tag tail))
+              (bytecomp--cus-warn type "`%s' with too many values" head))
+             (value-tag
+              (setq val (cadr value-tag)))
+             ((and nil  ; currently disabled
+                   ;; This is a useful check but it results in perhaps
+                   ;; a bit too many complaints. Keep it?
+                   (null tail))
+              (bytecomp--cus-warn
+               type "`%s' without value is implicitly nil" head)
+              )
+             )
+            (when (memq (car-safe val) '(quote function))
+              (bytecomp--cus-warn type "`%s' with quoted value: %S" head val))))
+         ((eq head 'quote)
+          (bytecomp--cus-warn type "accidentally quoted type: %s" (cadr type)))
+         ((memq head invalid-types)
+          (bytecomp--cus-warn type "`%s' is not a valid type" head))
+         ((or (not (symbolp head)) (keywordp head))
+          (bytecomp--cus-warn type "irregular type `%S'" head))
+         )))
+     ((or (not (symbolp type)) (keywordp type))
+      (bytecomp--cus-warn type "irregular type `%S'" type))
+     ((memq type '( list cons group vector choice radio const other
+                    function-item variable-item set repeat restricted-sexp))
+      (bytecomp--cus-warn type "`%s' without arguments" type))
+     ((memq type invalid-types)
+      (bytecomp--cus-warn type "`%s' is not a valid type" type))
+     )))
+
+;; Uniform handler for multiple functions with similar arguments:
+;; (NAME SOMETHING DOC KEYWORD-ARGS...)
+(byte-defop-compiler-1 define-widget           bytecomp--custom-declare)
+(byte-defop-compiler-1 custom-declare-group    bytecomp--custom-declare)
+(byte-defop-compiler-1 custom-declare-face     bytecomp--custom-declare)
+(byte-defop-compiler-1 custom-declare-variable bytecomp--custom-declare)
+(defun bytecomp--custom-declare (form)
+  (when (>= (length form) 4)
+    (let* ((name-arg (nth 1 form))
+           (name (and (eq (car-safe name-arg) 'quote)
+                      (symbolp (nth 1 name-arg))
+                      (nth 1 name-arg)))
+           (keyword-args (nthcdr 4 form))
+           (fun (car form))
+           (bytecomp--cus-function fun)
+           (bytecomp--cus-name name))
+
+      ;; Check :type
+      (when (memq fun '(custom-declare-variable define-widget))
+        (let ((type-tag (memq :type keyword-args)))
+          (if (null type-tag)
+              ;; :type only mandatory for `defcustom'
+              (when (eq fun 'custom-declare-variable)
+                (bytecomp--cus-warn form "missing :type keyword parameter"))
+            (let ((dup-type (memq :type (cdr type-tag))))
+              (when dup-type
+                (bytecomp--cus-warn
+                 dup-type "duplicated :type keyword argument")))
+            (let ((type-arg (cadr type-tag)))
+              (when (or (null type-arg)
+                        (eq (car-safe type-arg) 'quote))
+                (bytecomp--check-cus-type (cadr type-arg)))))))
+
+      ;; Check :group
+      (when (cond
+             ((memq fun '(custom-declare-variable custom-declare-face))
+              (not byte-compile-current-group))
+             ((eq fun 'custom-declare-group)
+              (not (eq name 'emacs))))
+        (unless (plist-get keyword-args :group)
+          (bytecomp--cus-warn form "fails to specify containing group")))
+
+      ;; Update current group
+      (when (and name
+                 byte-compile-current-file  ; only when compiling a whole file
+		 (eq fun 'custom-declare-group))
+	(setq byte-compile-current-group name))))
+
+  (byte-compile-normal-call form))
+
+
 (put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop)
 (put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop)
 (defun byte-compile-define-symbol-prop (form)

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Mattias Engdegård]

A slightly restrained version of the above patch is now on master. Please let me know if anything needs changing.

bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order

[Mauro Aranda]

On 17/9/23 12:20, Mattias Engdegård wrote:
 > A slightly restrained version of the above patch is now on
 > master. Please let me know if anything needs changing.

Thanks!

I think https://debbugs.gnu.org/cgi/bugreport.cgi?bug=2591 can be closed.