diff options
| -rw-r--r-- | docs/specs/face-font-diagnostic-popup-spec-implemented.org (renamed from docs/specs/face-font-diagnostic-popup-spec.org) | 4 | ||||
| -rw-r--r-- | init.el | 1 | ||||
| -rw-r--r-- | modules/face-diagnostic.el | 160 | ||||
| -rw-r--r-- | tests/test-face-diagnostic.el | 51 | ||||
| -rw-r--r-- | todo.org | 11 |
5 files changed, 219 insertions, 8 deletions
diff --git a/docs/specs/face-font-diagnostic-popup-spec.org b/docs/specs/face-font-diagnostic-popup-spec-implemented.org index e5ad4380e..3e8fadcd8 100644 --- a/docs/specs/face-font-diagnostic-popup-spec.org +++ b/docs/specs/face-font-diagnostic-popup-spec-implemented.org @@ -1,6 +1,6 @@ :PROPERTIES: :ID: 98f065cf-8bd5-46a0-ac24-da94d66855ad -:STATUS: not-started +:STATUS: implemented :END: #+TITLE: Face and Font Diagnostic Popup — Spec #+AUTHOR: Craig Jennings @@ -9,7 +9,7 @@ * Metadata -| Status | not-started | +| Status | implemented | |----------+---------------------------------------------------| | Owner | Craig Jennings | |----------+---------------------------------------------------| @@ -81,6 +81,7 @@ (require 'ai-term) ;; in-Emacs Claude launcher (vertical-split ghostel) (require 'help-utils) ;; search: arch-wiki, devdoc, tldr, wikipedia (require 'help-config) ;; info, man, help config +(require 'face-diagnostic) ;; describe face/font at point (cj/describe-face-at-point) (require 'tramp-config) ;; remote shell connections ;; ---------------------- Added Features And Integrations ---------------------- diff --git a/modules/face-diagnostic.el b/modules/face-diagnostic.el index 22f80cd98..83c81d92c 100644 --- a/modules/face-diagnostic.el +++ b/modules/face-diagnostic.el @@ -5,13 +5,18 @@ ;; ;; Layer: 4 (Added features). ;; Category: O (optional command). -;; Load shape: command-loaded (no startup side effects; pure defuns). +;; Load shape: eager. +;; Eager reason: none; a diagnostic command, a command-loaded deferral candidate. +;; Top-level side effects: defines cj/face-diagnostic-mode and the +;; cj/describe-face-at-point command; binds no global key. +;; Runtime requires: seq. +;; Direct test load: yes (the pure core is tested by requiring this module). ;; ;; A read-only diagnostic for "why does the character at point paint this way?" ;; It separates the face stack by source (text properties, overlays, active ;; remaps, the default) and -- in later phases -- the merged attributes, the ;; real font versus the declared family, and per-face theme/config/inherit -;; provenance. See docs/specs/face-font-diagnostic-popup-spec.org. +;; provenance. See docs/specs/face-font-diagnostic-popup-spec-implemented.org. ;; ;; This file is Phase 1: the pure read model. `cj/--face-diagnosis-at' returns ;; a plist with the buffer classification, the character context, and the face @@ -291,5 +296,156 @@ mutation." :font (cj/--face-diag-real-font pos buffer) :provenance (cj/--face-diag-provenance pos buffer))) +;; ------------------------------- Rendering ----------------------------------- + +(defun cj/--face-diag-render-banner (classification) + "Return a one-line banner for an out-of-scope CLASSIFICATION, or \"\"." + (pcase classification + ('terminal-ansi + "NOTE: terminal buffer -- colors come from the ANSI palette, not the theme.\n\n") + ('document-shr + "NOTE: document buffer -- colors come from the rendered document, not the theme.\n\n") + ('image-no-text + "NOTE: image/no-text buffer -- little face information applies here.\n\n") + (_ ""))) + +(defun cj/--face-diag-render-char (char) + "Render the CHAR context plist as a line, or a no-character notice." + (if (null char) + "Character: none at point.\n\n" + (format "Character: %S (U+%04X %s, script: %s)\n\n" + (plist-get char :char) + (plist-get char :codepoint) + (or (plist-get char :name) "no name") + (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)")) + +(defun cj/--face-diag-render-stack (stack) + "Render the STACK plist (faces by source) as a block." + (concat + "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)"))) + " default: default\n\n")) + +(defun cj/--face-diag-render-attributes (attrs) + "Render the merged ATTRS plist as a block." + (concat + "Effective attributes (computed):\n" + (mapconcat (lambda (attr) (format " %s: %s" attr (plist-get attrs attr))) + cj/--face-diag-attributes "\n") + "\n\n")) + +(defun cj/--face-diag-render-font (font attrs) + "Render the real FONT plist beside the merged ATTRS declared :family." + (let ((real (plist-get font :font)) + (declared (plist-get attrs :family)) + (real-family (plist-get font :family))) + (concat + (format "Real font: %s\n" real) + (format "Declared family: %s\n" declared) + (if (and (stringp real-family) (stringp declared) + (not (string-equal-ignore-case real-family declared))) + (format " (substituted: real family %s differs from declared %s)\n\n" + real-family declared) + "\n")))) + +(defun cj/--face-diag-render-provenance (prov) + "Render the per-face PROV list as a block." + (concat + "Provenance:\n" + (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)"))) + prov "\n") + " (no named faces)") + "\n")) + +(defun cj/--face-diag-render (diag) + "Render the face-diagnosis DIAG plist into a report string." + (concat + (cj/--face-diag-render-banner (plist-get diag :classification)) + (cj/--face-diag-render-char (plist-get diag :char)) + (cj/--face-diag-render-stack (plist-get diag :stack)) + (cj/--face-diag-render-attributes (plist-get diag :attributes)) + (cj/--face-diag-render-font (plist-get diag :font) (plist-get diag :attributes)) + (cj/--face-diag-render-provenance (plist-get diag :provenance)))) + +;; ------------------------------- Region mode --------------------------------- + +(defun cj/--face-diag-run-starts (beg end) + "Return the positions in [BEG, END) where the `face' property run begins." + (let ((pos beg) (starts (list beg))) + (while (and (setq pos (next-single-property-change pos 'face nil end)) + (< pos end)) + (push pos starts)) + (nreverse starts))) + +(defun cj/--face-diag-render-region (beg end) + "Render a diagnosis for each distinct face-run in [BEG, END), capped at 20." + (let* ((starts (cj/--face-diag-run-starts beg end)) + (cap 20) + (shown (seq-take starts cap))) + (concat + (mapconcat (lambda (pos) + (concat (format "=== position %d ===\n" pos) + (cj/--face-diag-render (cj/--face-diagnosis-at pos)))) + shown "\n") + (when (> (length starts) cap) + (format "\n... %d more face-runs not shown (cap %d).\n" + (- (length starts) cap) cap))))) + +;; ------------------------------- Command ------------------------------------- + +(define-derived-mode cj/face-diagnostic-mode special-mode "Face-Diag" + "Major mode for the read-only face/font diagnosis report.") + +(defun cj/--face-diag-display (report) + "Show REPORT in the read-only *Face Diagnosis* buffer; return the buffer." + (let ((buf (get-buffer-create "*Face Diagnosis*"))) + (with-current-buffer buf + (cj/face-diagnostic-mode) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert report) + (goto-char (point-min)))) + (display-buffer buf) + buf)) + +(defun cj/describe-face-at-point () + "Pop up a read-only diagnosis of the face and font at point. +With an active region, diagnose each distinct face-run in the region. The +report separates the face stack by source, shows the computed merged +attributes, the real font versus the declared family, and per-face +theme/config/inherit provenance. Read-only; never mutates buffer or frame. +See docs/specs/face-font-diagnostic-popup-spec-implemented.org." + (interactive) + (cj/--face-diag-display + (if (use-region-p) + (cj/--face-diag-render-region (region-beginning) (region-end)) + (cj/--face-diag-render (cj/--face-diagnosis-at (point)))))) + (provide 'face-diagnostic) ;;; face-diagnostic.el ends here diff --git a/tests/test-face-diagnostic.el b/tests/test-face-diagnostic.el index 874893fb6..f75d5b679 100644 --- a/tests/test-face-diagnostic.el +++ b/tests/test-face-diagnostic.el @@ -271,5 +271,56 @@ (let ((prov (plist-get (cj/--face-diagnosis-at (point-min)) :provenance))) (should (cl-some (lambda (p) (eq (plist-get p :face) 'bold)) prov))))) +;;; cj/--face-diag-render + +(ert-deftest test-face-diag-render-has-all-groups () + "Normal: the rendered report names every group and the stack's face." + (with-temp-buffer + (fundamental-mode) + (insert (propertize "A" 'face 'bold)) + (let ((report (cj/--face-diag-render (cj/--face-diagnosis-at (point-min))))) + (should (string-match-p "Character:" report)) + (should (string-match-p "Face stack" report)) + (should (string-match-p "bold" report)) + (should (string-match-p "Effective attributes" report)) + (should (string-match-p "Real font" report)) + (should (string-match-p "Provenance" report))))) + +(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))) + (should (equal (cj/--face-diag-render-banner 'theme-faced) ""))) + +(ert-deftest test-face-diag-render-no-char () + "Boundary: a nil char group renders the no-character notice." + (should (string-match-p "none at point" (cj/--face-diag-render-char nil)))) + +(ert-deftest test-face-diag-render-region-covers-runs () + "Normal: region rendering emits a position header per distinct face-run." + (with-temp-buffer + (insert (propertize "aa" 'face 'bold)) + (insert (propertize "bb" 'face 'italic)) + (let ((report (cj/--face-diag-render-region (point-min) (point-max)))) + (should (string-match-p "=== position 1 ===" report)) + (should (string-match-p "=== position 3 ===" report))))) + +;;; cj/describe-face-at-point (smoke) + +(ert-deftest test-face-diag-command-creates-buffer () + "Normal: the command renders into the read-only *Face Diagnosis* buffer." + (with-temp-buffer + (insert (propertize "A" 'face 'bold)) + (goto-char (point-min)) + (cj/describe-face-at-point) + (let ((buf (get-buffer "*Face Diagnosis*"))) + (unwind-protect + (progn + (should buf) + (with-current-buffer buf + (should (eq major-mode 'cj/face-diagnostic-mode)) + (should buffer-read-only) + (should (string-match-p "Face stack" (buffer-string))))) + (when (buffer-live-p buf) (kill-buffer buf)))))) + (provide 'test-face-diagnostic) ;;; test-face-diagnostic.el ends here @@ -44,16 +44,19 @@ Tags are additive. For example, a small wrong-behavior fix can be =:bug:quick:=, and a feature that requires internal restructuring can be =:feature:refactor:=. * Emacs Open Work -** PROJECT [#A] Face and font diagnostic popup at point :feature: -Read-only popup diagnosing why text at point paints as it does (face stack by source, merged attributes, real font vs declared family, theme/config/inherit provenance). Spec: [[id:98f065cf-8bd5-46a0-ac24-da94d66855ad][face-font-diagnostic-popup-spec.org]]. Building in modules/face-diagnostic.el: pure core cj/--face-diagnosis-at returns the report plist; cj/describe-face-at-point renders it into a read-only help buffer. From the roam inbox — "do this one first." +** DONE [#A] Face and font diagnostic popup at point :feature: +CLOSED: [2026-06-15 Mon] +Read-only popup diagnosing why text at point paints as it does (face stack by source, merged attributes, real font vs declared family, theme/config/inherit provenance). Spec: [[id:98f065cf-8bd5-46a0-ac24-da94d66855ad][face-font-diagnostic-popup-spec-implemented.org]]. Building in modules/face-diagnostic.el: pure core cj/--face-diagnosis-at returns the report plist; cj/describe-face-at-point renders it into a read-only help buffer. From the roam inbox — "do this one first." *** 2026-06-15 Mon @ 12:19:41 -0500 Phase 1 — core read model + buffer classifier landed modules/face-diagnostic.el: cj/--face-diagnosis-at returns groups 0-2 (buffer classification, character context, face stack by source) via small pure helpers. 17 ERT tests (tests/test-face-diagnostic.el), byte-compile clean. Not yet wired into init.el; the interactive command and keybinding land in Phase 4. *** 2026-06-15 Mon @ 12:26:52 -0500 Phase 2 — merged attributes + real font landed cj/--face-diag-merged-attributes folds the ordered, remap-expanded spec stack ("computed"); cj/--face-diag-real-font reports font-at or "unavailable" under batch. Settles spec decision #7 (hand-fold, tested on overlay-over-text-prop, default-remap, and face-symbol fixtures). 23 ERT tests total, byte-compile clean. *** 2026-06-15 Mon @ 12:30:30 -0500 Phase 3 — provenance trace landed cj/--face-diag-provenance returns per-face provenance: themes from theme-face, config from saved/customized-face, the :inherit chain, and the attributes still unspecified that fall to the default. Version-sensitive internals sit behind small tolerant accessors. 30 ERT tests total, byte-compile clean. -*** TODO Phase 4 — render + popup wiring -cj/describe-face-at-point, the read-only mode with face buttons, region-scan mode, and placement/dismissal via the unified-popup rules. Settle the command name and keybinding here. Render function tested on a captured plist; live smoke test. +*** 2026-06-15 Mon @ 12:37:16 -0500 Phase 4 — render + popup wiring landed +cj/describe-face-at-point renders the diagnosis into the read-only *Face Diagnosis* buffer (cj/face-diagnostic-mode), with region-scan mode and an out-of-scope banner; required in init.el; live-verified in the daemon (it already surfaces the auto-dim remaps). Command name settled as cj/describe-face-at-point. Deferred to follow-up: clickable face-name buttons (plain text for now) and the module-header allowlist entry; the keybinding is Craig's to pick. +** TODO [#C] face-diagnostic: face-name buttons + header allowlist :feature: +Two v1 follow-ups on the shipped face/font diagnostic: render the face names in the report as buttons that call describe-face (the spec's "For the user" buttons; v1 shows them as plain text), and add face-diagnostic to the module-header allowlist in tests/test-init-module-headers.el now that it's required in init.el. Spec: [[id:98f065cf-8bd5-46a0-ac24-da94d66855ad][face-font-diagnostic-popup-spec-implemented.org]]. ** TODO [#D] Face diagnostic popup — theme-studio bridge (vNext) :feature: vNext for the face/font diagnostic tool: interactivity — "send this face to theme-studio", jump-to-theme-spec, any write path. Deferred per [[id:98f065cf-8bd5-46a0-ac24-da94d66855ad][the spec]]'s scope tiers. ** TODO [#C] Gold text in auto-dimmed buffers :bug: |