From 81e51c2ad9d563e3ab22a35e11b909d9a581663c Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 27 Sep 2024 11:48:14 +0200 Subject: [PATCH] Warn about bad face specs in `defface` at compile time * lisp/emacs-lisp/bytecomp.el (byte-compile--custom-declare-face): Byte-compile `defface` forms, or the byte-compile handler won't be called. (bytecomp--check-cus-face-spec): New. (bytecomp--custom-declare): Call it. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-defface-spec): New tests. (cherry picked from commit bba14a27678317eee68e87a343e7314b3949f6c7) --- lisp/emacs-lisp/bytecomp.el | 59 +++++++++++++++++++++++++- test/lisp/emacs-lisp/bytecomp-tests.el | 26 ++++++++++++ 2 files changed, 84 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f34e65feaa4..4cb6518c8e9 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2721,7 +2721,7 @@ Call from the source buffer." (let ((newdocs (byte-compile--docstring docs kind name))) (unless (eq docs newdocs) (setq form (byte-compile--list-with-n form 3 newdocs))))) - form)) + (byte-compile-keep-pending form))) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) @@ -5369,6 +5369,56 @@ FORM is used to provide location, `bytecomp--cus-function' and (bytecomp--cus-warn type "`%s' is not a valid type" type)) ))) +(defun bytecomp--check-cus-face-spec (spec) + "Check for mistakes in a `defface' SPEC argument." + (when (consp spec) + (dolist (sp spec) + (let ((display (car-safe sp)) + (atts (cdr-safe sp))) + (cond ((listp display) + (dolist (condition display) + (unless (memq (car-safe condition) + '(type class background min-colors supports)) + (bytecomp--cus-warn + (list sp spec) + "Bad face display condition `%S'" (car condition))))) + ((not (memq display '(t default))) + (bytecomp--cus-warn + (list sp spec) "Bad face display `%S'" display))) + (when (and (consp atts) (null (cdr atts))) + (setq atts (car atts))) ; old (DISPLAY ATTS) syntax + (while atts + (let ((attr (car atts)) + (val (cadr atts))) + (cond + ((not (keywordp attr)) + (bytecomp--cus-warn + (list atts sp spec) + "Non-keyword in face attribute list: `%S'" attr)) + ((null (cdr atts)) + (bytecomp--cus-warn + (list atts sp spec) "Missing face attribute `%s' value" attr)) + ((memq attr '( :inherit :extend + :family :foundry :width :height :weight :slant + :foreground :distant-foreground :background + :underline :overline :strike-through :box + :inverse-video :stipple :font + ;; FIXME: obsolete keywords, warn about them too? + ;; `:reverse-video' is very rare. + :bold ; :bold t = :weight bold + :italic ; :italic t = :slant italic + :reverse-video ; alias for :inverse-video + )) + (when (eq (car-safe val) 'quote) + (bytecomp--cus-warn + (list val atts sp spec) + "Value for face attribute `%s' should not be quoted" attr))) + (t + (bytecomp--cus-warn + (list atts sp spec) + "`%s' is not a valid face attribute keyword" attr)))) + (setq atts (cddr atts))))))) + ;; Unified handler for multiple functions with similar arguments: ;; (NAME SOMETHING DOC KEYWORD-ARGS...) (byte-defop-compiler-1 define-widget bytecomp--custom-declare) @@ -5402,6 +5452,13 @@ FORM is used to provide location, `bytecomp--cus-function' and (eq (car-safe type-arg) 'quote)) (bytecomp--check-cus-type (cadr type-arg))))))) + (when (eq fun 'custom-declare-face) + (let ((face-arg (nth 2 form))) + (when (and (eq (car-safe face-arg) 'quote) + (consp (cdr face-arg)) + (null (cddr face-arg))) + (bytecomp--check-cus-face-spec (nth 1 face-arg))))) + ;; Check :group (when (cond ((memq fun '(custom-declare-variable custom-declare-face)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index e3ce87cc9af..cce6b1221fc 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1985,6 +1985,32 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (dc 'integerp)) )) +(ert-deftest bytecomp-test-defface-spec () + (cl-flet ((df (spec) `(defface mytest ',spec "doc" :group 'test))) + (bytecomp--with-warning-test + (rx "Bad face display condition `max-colors'") + (df '((((class color grayscale) (max-colors 75) (background light)) + :foreground "cyan")))) + (bytecomp--with-warning-test + (rx "Bad face display `defualt'") + (df '((defualt :foreground "cyan")))) + (bytecomp--with-warning-test + (rx "`:inverse' is not a valid face attribute keyword") + (df '((t :background "blue" :inverse t)))) + (bytecomp--with-warning-test + (rx "`:inverse' is not a valid face attribute keyword") + (df '((t (:background "blue" :inverse t))))) ; old attr list syntax + (bytecomp--with-warning-test + (rx "Value for face attribute `:inherit' should not be quoted") + (df '((t :inherit 'other)))) + (bytecomp--with-warning-test + (rx "Missing face attribute `:extend' value") + (df '((t :foundry "abc" :extend)))) + (bytecomp--with-warning-test + (rx "Non-keyword in face attribute list: `\"green\"'") + (df '((t :foreground "white" "green")))) + )) + (ert-deftest bytecomp-function-attributes () ;; Check that `byte-compile' keeps the declarations, interactive spec and ;; doc string of the function (bug#55830). -- 2.39.2