From 89cf0b6e6784fed075dd88bc7f7616107afd844d Mon Sep 17 00:00:00 2001 From: antlers Date: Tue, 12 Dec 2023 23:02:01 +0000 Subject: [PATCH 1/2] Allow leading doc-strings when (re-)defining faces via :custom-face Requires such doc-strings to be typed as literal strings at compile-time -- no `(concat [...])' forms. --- README.md | 8 ++++++++ use-package-core.el | 35 +++++++++++++++++++++++++---------- use-package-tests.el | 18 ++++++++++++++++++ use-package.texi | 8 ++++++++ 4 files changed, 59 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index bfd34cd..b6fc400 100644 --- a/README.md +++ b/README.md @@ -499,6 +499,14 @@ The `:custom-face` keyword allows customization of package custom faces. (example-1-face ((t (:foreground "LightPink")))) (example-2-face ((t (:foreground "LightGreen"))) face-defspec-spec)) +(use-package org + :custom-face + (favorite-keywords-face + "Face for my favorite keywords \o/" + ((t (:background "LightBlue")))) + (org-special-keyword + ((t (:inherit favorite-keywords-face))))) + (use-package zenburn-theme :preface (setq my/zenburn-colors-alist diff --git a/use-package-core.el b/use-package-core.el index bb523f6..f1701b4 100644 --- a/use-package-core.el +++ b/use-package-core.el @@ -1506,24 +1506,39 @@ no keyword implies `:all'." (defun use-package-normalize/:custom-face (name-symbol _keyword arg) "Normalize use-package custom-face keyword." (let ((error-msg - (format "%s wants a ( [spec-type]) or list of these" + (format "%s wants a ( [] [spec-type]) or list of these" name-symbol))) (unless (listp arg) (use-package-error error-msg)) (cl-dolist (def arg arg) - (unless (listp def) - (use-package-error error-msg)) - (let ((face (nth 0 def)) - (spec (nth 1 def))) - (when (or (not face) - (not spec) - (> (length def) 3)) - (use-package-error error-msg)))))) + (pcase def + ;; With doc-string + (`(,(and (pred symbolp) face) + ,(and (pred stringp) doc) + ,(and (pred (not null)) spec) + . ,spec-type) + (when (> (length spec-type) 1) + (use-package-error error-msg))) + ;; Without doc-string + (`(,(and (pred symbolp) face) + ,(and (pred (not null)) spec) + . ,spec-type) + (when (> (length spec-type) 1) + (use-package-error error-msg))) + (t (use-package-error error-msg)))))) (defun use-package-handler/:custom-face (name _keyword args rest state) "Generate use-package custom-face keyword code." (use-package-concat - (mapcar #'(lambda (def) `(apply #'face-spec-set (backquote ,def))) args) + (mapcar #'(lambda (def) + (if (stringp (nth 1 def)) + `(progn + (apply #'face-spec-set + (backquote ,(cons (car def) (cddr def)))) + (set-face-doc-string (quote ,(car def)) + ,(nth 1 def))) + `(apply #'face-spec-set (backquote ,def)))) + args) (use-package-process-keywords name rest state))) ;;;; :init diff --git a/use-package-tests.el b/use-package-tests.el index c5fc9fb..1eb0b28 100644 --- a/use-package-tests.el +++ b/use-package-tests.el @@ -1176,6 +1176,24 @@ (apply #'face-spec-set (backquote (foo ((t (:background "#e4edfc"))) face-defspec-spec))) (require 'foo nil nil)))) +(ert-deftest use-package-test/:custom-face-4 () + (match-expansion + (use-package org + :custom-face + (favorite-keywords-face + "Face for my favorite keywords \o/" + ((t (:background "LightBlue")))) + (org-special-keyword + ((t (:inherit favorite-keywords-face))))) + `(progn + (progn + (apply #'face-spec-set + (backquote (favorite-keywords-face ((t (:background "LightBlue")))))) + (set-face-doc-string 'favorite-keywords-face "Face for my favorite keywords o/")) + (apply #'face-spec-set + (backquote (org-special-keyword ((t (:inherit favorite-keywords-face)))))) + (require 'org nil nil)))) + (ert-deftest use-package-test/:init-1 () (match-expansion (use-package foo :init (init)) diff --git a/use-package.texi b/use-package.texi index b1d7b10..882cebd 100644 --- a/use-package.texi +++ b/use-package.texi @@ -1236,6 +1236,14 @@ faces. (example-1-face ((t (:foreground "LightPink")))) (example-2-face ((t (:foreground "LightGreen"))) face-defspec-spec)) +(use-package org + :custom-face + (favorite-keywords-face + "Face for my favorite keywords \o/" + ((t (:background "LightBlue")))) + (org-special-keyword + ((t (:inherit favorite-keywords-face))))) + (use-package zenburn-theme :preface (setq my/zenburn-colors-alist From 07e6b2341018766da77aee43bce80fc1d02c0a30 Mon Sep 17 00:00:00 2001 From: antlers Date: Tue, 12 Dec 2023 23:35:29 +0000 Subject: [PATCH 2/2] Type-check `spec-type` too, while we're at it * use-package-core.el(use-package-normalize/:custom-face): Type-check `spec-type` at compile time. Fun fact: `(symbolp '()) ; => t`! --- use-package-core.el | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/use-package-core.el b/use-package-core.el index f1701b4..f0c75f8 100644 --- a/use-package-core.el +++ b/use-package-core.el @@ -1510,22 +1510,25 @@ no keyword implies `:all'." name-symbol))) (unless (listp arg) (use-package-error error-msg)) - (cl-dolist (def arg arg) - (pcase def - ;; With doc-string - (`(,(and (pred symbolp) face) - ,(and (pred stringp) doc) - ,(and (pred (not null)) spec) - . ,spec-type) - (when (> (length spec-type) 1) - (use-package-error error-msg))) - ;; Without doc-string - (`(,(and (pred symbolp) face) - ,(and (pred (not null)) spec) - . ,spec-type) - (when (> (length spec-type) 1) - (use-package-error error-msg))) - (t (use-package-error error-msg)))))) + (cl-flet ((check-spec-type (spec-type) + (when (or (> (length spec-type) 1) + (and (car spec-type) + (not (symbolp (car spec-type))))) + (use-package-error error-msg)))) + (cl-dolist (def arg arg) + (pcase def + ;; With doc-string + (`(,(and (pred symbolp) face) + ,(and (pred stringp) doc) + ,(and (pred (not null)) spec) + . ,spec-type) + (check-spec-type spec-type)) + ;; Without doc-string + (`(,(and (pred symbolp) face) + ,(and (pred (not null)) spec) + . ,spec-type) + (check-spec-type spec-type)) + (t (use-package-error error-msg))))))) (defun use-package-handler/:custom-face (name _keyword args rest state) "Generate use-package custom-face keyword code."