diff options
| -rw-r--r-- | modules/face-diagnostic.el | 60 | ||||
| -rw-r--r-- | tests/test-face-diagnostic.el | 25 | ||||
| -rw-r--r-- | tests/test-init-module-headers.el | 1 |
3 files changed, 65 insertions, 21 deletions
diff --git a/modules/face-diagnostic.el b/modules/face-diagnostic.el index 6b1b547f1..a2bfe2483 100644 --- a/modules/face-diagnostic.el +++ b/modules/face-diagnostic.el @@ -298,6 +298,18 @@ mutation." ;; ------------------------------- Rendering ----------------------------------- +(defun cj/--face-diag-face-button (face) + "Render FACE as a button that runs `describe-face' on it. +A real, named face becomes a `buttonize'd string (RET or mouse opens its +`describe-face' help); anything else -- an anonymous (:attr val ...) spec or a +symbol that is not a face -- is returned as a plain string so the report still +reads cleanly." + (let ((label (format "%s" face))) + (if (and (symbolp face) (facep face)) + (buttonize label (lambda (f) (describe-face f)) face + (format "describe-face: %s" face)) + label))) + (defun cj/--face-diag-render-banner (classification) "Return a one-line banner for an out-of-scope CLASSIFICATION, or \"\"." (pcase classification @@ -320,8 +332,9 @@ mutation." (or (plist-get char :script) "none")))) (defun cj/--face-diag-render-faces (faces) - "Render a list of FACES (symbols or specs) comma-separated, or \"(none)\"." - (if faces (mapconcat (lambda (f) (format "%s" f)) faces ", ") "(none)")) + "Render a list of FACES (symbols or specs) comma-separated, or \"(none)\". +Real faces render as `describe-face' buttons (see `cj/--face-diag-face-button')." + (if faces (mapconcat #'cj/--face-diag-face-button faces ", ") "(none)")) (defun cj/--face-diag-render-stack (stack) "Render the STACK plist (faces by source) as a block." @@ -329,18 +342,21 @@ mutation." "Face stack (highest priority first):\n" (format " text properties: %s\n" (cj/--face-diag-render-faces (plist-get stack :text-property))) - (format " overlays: %s\n" - (let ((ov (plist-get stack :overlays))) - (if ov - (mapconcat (lambda (e) - (format "%s (priority %s)" - (plist-get e :face) - (or (plist-get e :priority) "nil"))) - ov ", ") - "(none)"))) - (format " active remaps: %s\n" - (let ((rm (plist-get stack :remaps))) - (if rm (mapconcat (lambda (e) (format "%s" (car e))) rm ", ") "(none)"))) + " overlays: " + (let ((ov (plist-get stack :overlays))) + (if ov + (mapconcat (lambda (e) + (concat (cj/--face-diag-face-button (plist-get e :face)) + (format " (priority %s)" + (or (plist-get e :priority) "nil")))) + ov ", ") + "(none)")) + "\n" + " active remaps: " + (let ((rm (plist-get stack :remaps))) + (if rm (mapconcat (lambda (e) (cj/--face-diag-face-button (car e))) rm ", ") + "(none)")) + "\n" " default: default\n\n")) (defun cj/--face-diag-render-attributes (attrs) @@ -372,13 +388,15 @@ mutation." (if prov (mapconcat (lambda (p) - (format (concat " %s\n themes: %s\n config: %s\n" - " inherits: %s\n unspecified (-> default): %s") - (plist-get p :face) - (or (plist-get p :themes) "(none)") - (or (plist-get p :config) "(none)") - (or (plist-get p :inherit-chain) "(none)") - (or (plist-get p :unspecified) "(none)"))) + (concat + " " + (cj/--face-diag-face-button (plist-get p :face)) + (format (concat "\n themes: %s\n config: %s\n" + " inherits: %s\n unspecified (-> default): %s") + (or (plist-get p :themes) "(none)") + (or (plist-get p :config) "(none)") + (or (plist-get p :inherit-chain) "(none)") + (or (plist-get p :unspecified) "(none)")))) prov "\n") " (no named faces)") "\n")) diff --git a/tests/test-face-diagnostic.el b/tests/test-face-diagnostic.el index 241425fc5..32595b464 100644 --- a/tests/test-face-diagnostic.el +++ b/tests/test-face-diagnostic.el @@ -286,6 +286,31 @@ (should (string-match-p "Real font" report)) (should (string-match-p "Provenance" report))))) +(ert-deftest test-face-diag-face-button-real-face-is-button () + "Normal: a real face renders as a `describe-face' button carrying the face. +Visible label is unchanged; the button data is the face so RET/mouse opens it." + (let ((s (cj/--face-diag-face-button 'bold))) + (should (equal (substring-no-properties s) "bold")) + (should (get-text-property 0 'button s)) + (should (eq (get-text-property 0 'button-data s) 'bold)))) + +(ert-deftest test-face-diag-face-button-non-face-is-plain () + "Boundary: a symbol that is not a face stays plain text, no button." + (let ((s (cj/--face-diag-face-button 'cj-not-a-real-face-xyz))) + (should (equal s "cj-not-a-real-face-xyz")) + (should-not (get-text-property 0 'button s)))) + +(ert-deftest test-face-diag-face-button-anonymous-spec-is-plain () + "Error: an anonymous (:attr val ...) spec is not a face, so no button." + (let ((s (cj/--face-diag-face-button '(:foreground "red")))) + (should-not (get-text-property 0 'button s)))) + +(ert-deftest test-face-diag-render-faces-buttonizes-real-face () + "Normal: a real face in the stack render carries a button property." + (let ((s (cj/--face-diag-render-faces '(bold)))) + (should (string-match-p "bold" s)) + (should (get-text-property 0 'button s)))) + (ert-deftest test-face-diag-render-banner-out-of-scope () "Boundary: a terminal classification renders a banner naming the ANSI source." (should (string-match-p "terminal" (cj/--face-diag-render-banner 'terminal-ansi))) diff --git a/tests/test-init-module-headers.el b/tests/test-init-module-headers.el index 4b6ac05c4..478819b89 100644 --- a/tests/test-init-module-headers.el +++ b/tests/test-init-module-headers.el @@ -105,6 +105,7 @@ "erc-config" "eshell-config" "eww-config" + "face-diagnostic" "flyspell-and-abbrev" "games-config" "gloss-config" |