feat(org): themeable agenda header-row faces via org-faces-config

Each TODO keyword and priority cookie gets its own named face instead of sharing org's built-in org-todo / org-done / org-priority. org-faces-config.el defines org-faces-<keyword> and org-faces-priority-a..d (plus -dim variants for auto-dim), each with a real default color, and wires them through org-todo-keyword-faces and org-priority-faces once org loads. The file is org-faces-config, not org-faces, because org ships its own org-faces feature that the bare name would shadow.

This re-introduces the per-keyword/priority coloring that was stripped earlier, now as a named, theme-agnostic layer a theme can override. The design and the four resolved decisions are in docs/design/org-faces-spec.org; a theme-studio "org-faces" app and the auto-dim repoint follow in later phases.

2 files changed, 169 insertions, 0 deletions

diff --git a/tests/test-org-config-table-header.el b/tests/test-org-config-table-header.el
new file mode 100644
index 000000000..38e73b483
--- /dev/null
+++ b/tests/test-org-config-table-header.el
@@ -0,0 +1,115 @@
+;;; test-org-config-table-header.el --- In-buffer org table header fontify -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Org has no in-buffer header-row face -- the whole table uses `org-table'.
+;; cj/--org-table-header-row-p, cj/--org-table-first-hline-position, and the
+;; font-lock matcher cj/--org-fontify-table-header-matcher (org-config.el) add
+;; one: they identify a table's header rows (the non-hline rows above its first
+;; hline) so font-lock can prepend `org-table-header' there.  These exercise the
+;; detection logic directly against fixture tables, matching the tag-alignment
+;; test's pure-logic style.
+
+;;; Code:
+
+(require 'ert)
+(require 'org)
+(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
+(require 'org-config)
+
+(defmacro test-org-th--in (content &rest body)
+  "Run BODY in a temp org buffer holding CONTENT, hooks suppressed."
+  (declare (indent 1))
+  `(let ((org-mode-hook nil))
+     (with-temp-buffer
+       (insert ,content)
+       (org-mode)
+       (goto-char (point-min))
+       ,@body)))
+
+(defun test-org-th--goto (substring)
+  "Move point to the beginning of the line containing SUBSTRING."
+  (goto-char (point-min))
+  (search-forward substring)
+  (beginning-of-line))
+
+;; ----- cj/--org-table-header-row-p -----
+
+(ert-deftest test-org-table-header-row-p-header-above-hline ()
+  "Normal: a non-hline row above the first hline is a header row."
+  (test-org-th--in "| Name | Age |\n|------+-----|\n| Bob | 3 |\n"
+    (test-org-th--goto "Name")
+    (should (cj/--org-table-header-row-p))))
+
+(ert-deftest test-org-table-header-row-p-body-row-not-header ()
+  "Normal: a row below the first hline is not a header row."
+  (test-org-th--in "| Name | Age |\n|------+-----|\n| Bob | 3 |\n"
+    (test-org-th--goto "Bob")
+    (should-not (cj/--org-table-header-row-p))))
+
+(ert-deftest test-org-table-header-row-p-hline-not-header ()
+  "Boundary: the hline itself is not a header row."
+  (test-org-th--in "| Name | Age |\n|------+-----|\n| Bob | 3 |\n"
+    (test-org-th--goto "----")
+    (should-not (cj/--org-table-header-row-p))))
+
+(ert-deftest test-org-table-header-row-p-no-hline-no-header ()
+  "Boundary: a table with no hline has no header rows."
+  (test-org-th--in "| A | B |\n| x | y |\n"
+    (test-org-th--goto "A |")
+    (should-not (cj/--org-table-header-row-p))))
+
+(ert-deftest test-org-table-header-row-p-multi-row-header ()
+  "Boundary: every non-hline row above the first hline is a header row."
+  (test-org-th--in "| A | B |\n| C | D |\n|---+---|\n| x | y |\n"
+    (test-org-th--goto "A |")
+    (should (cj/--org-table-header-row-p))
+    (test-org-th--goto "C |")
+    (should (cj/--org-table-header-row-p))))
+
+(ert-deftest test-org-table-header-row-p-key-value-first-row-only ()
+  "Boundary: hline-after-every-row table -- only the first row is header."
+  (test-org-th--in "| Status | draft |\n|--------+-------|\n| Owner | cj |\n|--------+-------|\n"
+    (test-org-th--goto "Status")
+    (should (cj/--org-table-header-row-p))
+    (test-org-th--goto "Owner")
+    (should-not (cj/--org-table-header-row-p))))
+
+(ert-deftest test-org-table-header-row-p-non-table-line ()
+  "Error: a line that is not in a table is never a header row."
+  (test-org-th--in "Just some prose.\n"
+    (test-org-th--goto "prose")
+    (should-not (cj/--org-table-header-row-p))))
+
+;; ----- cj/--org-table-first-hline-position -----
+
+(ert-deftest test-org-table-first-hline-position-found ()
+  "Normal: returns the bol of the first hline in the table."
+  (test-org-th--in "| Name | Age |\n|------+-----|\n| Bob | 3 |\n"
+    (test-org-th--goto "Name")
+    (let ((expected (save-excursion (goto-char (point-min))
+                                    (forward-line 1)
+                                    (line-beginning-position))))
+      (should (equal (cj/--org-table-first-hline-position) expected)))))
+
+(ert-deftest test-org-table-first-hline-position-none ()
+  "Boundary: a table with no hline returns nil."
+  (test-org-th--in "| A | B |\n| x | y |\n"
+    (test-org-th--goto "A |")
+    (should-not (cj/--org-table-first-hline-position))))
+
+;; ----- cj/--org-fontify-table-header-matcher -----
+
+(ert-deftest test-org-fontify-table-header-matcher-matches-header-only ()
+  "Normal: the matcher sets match data to the header row, then stops."
+  (test-org-th--in "| Name | Age |\n|------+-----|\n| Bob | 3 |\n"
+    (should (cj/--org-fontify-table-header-matcher (point-max)))
+    (should (equal (match-string 0) "| Name | Age |"))
+    (should-not (cj/--org-fontify-table-header-matcher (point-max)))))
+
+(ert-deftest test-org-fontify-table-header-matcher-no-header ()
+  "Boundary: a table with no hline yields no matches."
+  (test-org-th--in "| A | B |\n| x | y |\n"
+    (should-not (cj/--org-fontify-table-header-matcher (point-max)))))
+
+(provide 'test-org-config-table-header)
+;;; test-org-config-table-header.el ends here
diff --git a/tests/test-org-faces-config.el b/tests/test-org-faces-config.el
new file mode 100644
index 000000000..8e7da3309
--- /dev/null
+++ b/tests/test-org-faces-config.el
@@ -0,0 +1,54 @@
+;;; test-org-faces-config.el --- Tests for org-faces-config -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Verifies the custom agenda header-row faces exist and that the keyword and
+;; priority maps wire each keyword / priority to its org-faces-* face.  org is
+;; required first so the `with-eval-after-load' wiring in org-faces-config fires
+;; on load.
+
+;;; Code:
+
+(require 'ert)
+(require 'org)
+(require 'org-faces-config)
+
+(ert-deftest test-org-faces-config-base-faces-exist ()
+  "Normal: every base keyword and priority face is defined."
+  (dolist (f '(org-faces-todo org-faces-project org-faces-doing org-faces-waiting
+               org-faces-verify org-faces-stalled org-faces-delegated org-faces-failed
+               org-faces-done org-faces-cancelled
+               org-faces-priority-a org-faces-priority-b org-faces-priority-c org-faces-priority-d))
+    (should (facep f))))
+
+(ert-deftest test-org-faces-config-dim-faces-exist ()
+  "Normal: every dim variant is defined (auto-dim remaps onto these)."
+  (dolist (f '(org-faces-todo-dim org-faces-project-dim org-faces-doing-dim org-faces-waiting-dim
+               org-faces-verify-dim org-faces-stalled-dim org-faces-delegated-dim org-faces-failed-dim
+               org-faces-done-dim org-faces-cancelled-dim
+               org-faces-priority-a-dim org-faces-priority-b-dim org-faces-priority-c-dim org-faces-priority-d-dim))
+    (should (facep f))))
+
+(ert-deftest test-org-faces-config-keyword-map ()
+  "Normal: representative keywords map to their org-faces-* face."
+  (should (eq (cdr (assoc "TODO" org-todo-keyword-faces)) 'org-faces-todo))
+  (should (eq (cdr (assoc "VERIFY" org-todo-keyword-faces)) 'org-faces-verify))
+  (should (eq (cdr (assoc "CANCELLED" org-todo-keyword-faces)) 'org-faces-cancelled))
+  (should (eq (cdr (assoc "DELEGATED" org-todo-keyword-faces)) 'org-faces-delegated)))
+
+(ert-deftest test-org-faces-config-keyword-coverage ()
+  "Boundary: all ten keywords are mapped, each to a real face."
+  (dolist (kw '("TODO" "PROJECT" "DOING" "WAITING" "VERIFY" "STALLED"
+                "DELEGATED" "FAILED" "DONE" "CANCELLED"))
+    (let ((face (cdr (assoc kw org-todo-keyword-faces))))
+      (should face)
+      (should (facep face)))))
+
+(ert-deftest test-org-faces-config-priority-map ()
+  "Normal: each priority A-D maps to its org-faces-priority-* face."
+  (should (eq (cdr (assq ?A org-priority-faces)) 'org-faces-priority-a))
+  (should (eq (cdr (assq ?B org-priority-faces)) 'org-faces-priority-b))
+  (should (eq (cdr (assq ?C org-priority-faces)) 'org-faces-priority-c))
+  (should (eq (cdr (assq ?D org-priority-faces)) 'org-faces-priority-d)))
+
+(provide 'test-org-faces-config)
+;;; test-org-faces-config.el ends here