From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Mattias =?UTF-8?Q?Engdeg=C3=A5rd?= Newsgroups: gmane.emacs.bugs Subject: bug#65852: 30.0.50; image-auto-resize :type has choices in wrong order Date: Tue, 12 Sep 2023 16:42:41 +0200 Message-ID: <8490D7BE-4204-4FC3-B583-D4D0674FB075@gmail.com> References: <081b5bd0-9652-cb7b-3c59-b07cab5e104d@gmail.com> <6fe31ce5-4be7-7f79-e310-52e04d869467@gmail.com> <865AB7EF-D175-4A6B-BD64-6C0EE0338D13@gmail.com> Mime-Version: 1.0 (Mac OS X Mail 14.0 \(3654.120.0.1.15\)) Content-Type: multipart/mixed; boundary="Apple-Mail=_B32AA598-69E8-4E4F-ACCB-FFA003CFAC07" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="15608"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 65852@debbugs.gnu.org, Mauro Aranda To: Stefan Kangas Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Sep 12 16:43:20 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qg4bo-0003tM-3H for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 12 Sep 2023 16:43:20 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qg4bW-0003p2-S3; Tue, 12 Sep 2023 10:43:02 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qg4bR-0003bP-Qw for bug-gnu-emacs@gnu.org; Tue, 12 Sep 2023 10:43:01 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qg4bR-0005mc-IV for bug-gnu-emacs@gnu.org; Tue, 12 Sep 2023 10:42:57 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qg4bV-0007sg-U6 for bug-gnu-emacs@gnu.org; Tue, 12 Sep 2023 10:43:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Mattias =?UTF-8?Q?Engdeg=C3=A5rd?= Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 12 Sep 2023 14:43:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 65852 X-GNU-PR-Package: emacs Original-Received: via spool by 65852-submit@debbugs.gnu.org id=B65852.169452977930285 (code B ref 65852); Tue, 12 Sep 2023 14:43:01 +0000 Original-Received: (at 65852) by debbugs.gnu.org; 12 Sep 2023 14:42:59 +0000 Original-Received: from localhost ([127.0.0.1]:59763 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qg4bT-0007sP-DI for submit@debbugs.gnu.org; Tue, 12 Sep 2023 10:42:59 -0400 Original-Received: from mail-lf1-x133.google.com ([2a00:1450:4864:20::133]:46123) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qg4bO-0007s5-Bb for 65852@debbugs.gnu.org; Tue, 12 Sep 2023 10:42:57 -0400 Original-Received: by mail-lf1-x133.google.com with SMTP id 2adb3069b0e04-5007c8308c3so9552755e87.0 for <65852@debbugs.gnu.org>; Tue, 12 Sep 2023 07:42:49 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20221208; t=1694529763; x=1695134563; darn=debbugs.gnu.org; h=references:to:cc:in-reply-to:date:subject:mime-version:message-id :from:sender:from:to:cc:subject:date:message-id:reply-to; bh=aJb+0TgTRPcZFLSMYFRCth9ZcKWUMDDGX5FnxyuxnhM=; b=obAVI/84mUgqnbLP6Z9kO/Feb8WzmD4zQMqCrqN88YyDAO1GgsY2CXThTlTQzkM6st 2+hXoWOR+okjN40B/PTh56WlNiVkoHB4ejb5C9P5FcFgC4FAX7tWjvRD6LTqCKjRYTXP lxX6rXb8ULj7GP5dnr3oY2zeBjJLHR1AWzF/lqxVSpJxpyhgRn5O9wU32BmNTbQLe0bz hGbjA8uFTA1QBT+yiDZE9tXwWq/hh4hH/d6pXshLNWZK/k4cB4NRQTA14c9zaut4eqAc 1Pc4w3zdkZ18E50ppAeAUHQHiBbs6sbtiRRHQLcAIWR59oQYFIsmPu01yN+ona5Hhp38 RhGw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1694529763; x=1695134563; h=references:to:cc:in-reply-to:date:subject:mime-version:message-id :from:sender:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=aJb+0TgTRPcZFLSMYFRCth9ZcKWUMDDGX5FnxyuxnhM=; b=tdhGrVnm+yJm+pQOgV2KybxA/Vk8lvjsY6DrZm7ysApaxCTstzj58aJ/w2qX+h+tqQ mcTp0kNBWHGZMkXSUrXpHDfG8NGZY13w8Bj/jBsydZJzAmlVWQc6rFk05yReZAtyNv8c OEIZmKnEDvidGBy2J//scFvBQYjqCptUh6nCr7ziBWy5UMJ81iGn5hvKNnVnBL6SCKLn 4uI6c+ZBaV1q7f+tMCEBKo/vy2BSVE2sCB/VNmDIazYrMyKrhWacDiW1IBPuH0yWm1aG qTt0178SLujoM8ncpX4yk6BqF9boLUr640dc5HXhfqzOQWOSSWeGflZMEv/VIaz42TOi VR/A== X-Gm-Message-State: AOJu0YyZq0l59bnnvgEGfAIp3etcmVvAxE3u+KCzMOkbKTGmTzIKhT9t +vrTaKgh/ImE/dDI6tqHCmQ= X-Google-Smtp-Source: AGHT+IEg24PhXF1AZMcNU5MNfyXl/LVg10mrGtXL3isNhJXK1cC20LK5lIy40hYYPmN3XdlnUOV5ww== X-Received: by 2002:a05:6512:10ce:b0:500:c2d7:3ab4 with SMTP id k14-20020a05651210ce00b00500c2d73ab4mr11888390lfg.8.1694529763266; Tue, 12 Sep 2023 07:42:43 -0700 (PDT) Original-Received: from smtpclient.apple (c188-150-165-235.bredband.tele2.se. [188.150.165.235]) by smtp.gmail.com with ESMTPSA id v15-20020ac2560f000000b005008cd93961sm1754467lfd.192.2023.09.12.07.42.42 (version=TLS1_2 cipher=ECDHE-ECDSA-AES128-GCM-SHA256 bits=128/128); Tue, 12 Sep 2023 07:42:42 -0700 (PDT) In-Reply-To: <865AB7EF-D175-4A6B-BD64-6C0EE0338D13@gmail.com> X-Mailer: Apple Mail (2.3654.120.0.1.15) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:270187 Archived-At: --Apple-Mail=_B32AA598-69E8-4E4F-ACCB-FFA003CFAC07 Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=us-ascii 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. --Apple-Mail=_B32AA598-69E8-4E4F-ACCB-FFA003CFAC07 Content-Disposition: attachment; filename=more-defcustom-warnings.diff Content-Type: application/octet-stream; x-unix-mode=0644; name="more-defcustom-warnings.diff" Content-Transfer-Encoding: 7bit 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) --Apple-Mail=_B32AA598-69E8-4E4F-ACCB-FFA003CFAC07--