Expose the palette primaries and finish the builtin docstrings
API-CONC-01: tp-palette-color (SYMBOL KEY) is now the public generic accessor - a documented wrapper over the existing private getter - and tp-palette-has-p (SYMBOL &optional KIND) the consolidated predicate: nil KIND tests registration, :fg/:bg/:border test that the palette's definition contains the key. All ten existing query functions stay as compatible conveniences, now each carrying a docstring that says which question it answers (the suffix predicates test NAME-fg style variant names, not palette contents) and cross-referencing the primaries. DOC-STR-02: tp-palette-show (interactive, autoloaded) finally has a docstring describing the gallery it renders. tp-suffix-symbol - a generic two-line intern helper with no tp semantics - is renamed to tp--suffix-symbol; the old name survives as a compatibility define-obsolete-function-alias (0.3.0) and tp-palette-show now calls the private name, leaving the alias without in-tree callers. tp-theme-dark-p / tp-theme-light-p get their missing docstrings. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Kinneyzhang
parent
8c28361640
commit
698dc54b1c
@ -234,6 +234,51 @@ tp-builtins restores the shipped layer definitions."
|
||||
(should-not (tp-parse-color nil))
|
||||
(should-error (tp-parse-color 42)))
|
||||
|
||||
;;; API-CONC-01: the two palette primaries
|
||||
|
||||
(ert-deftest tp-builtins-test-palette-color-generic-accessor ()
|
||||
"tp-palette-color is the theme-resolving generic accessor."
|
||||
(tp-builtins-test--with-background-mode 'light
|
||||
(should (equal (tp-palette-color 'info :fg) "#0969da"))
|
||||
(should (equal (tp-palette-color 'info :fg)
|
||||
(tp-palette-fg-color 'info)))
|
||||
(should (equal (tp-palette-color 'info :bg)
|
||||
(tp-palette-bg-color 'info)))
|
||||
(should (equal (tp-palette-color 'info :border)
|
||||
(tp-palette-border-color 'info)))
|
||||
(should-not (tp-palette-color 'no-such-palette :fg))
|
||||
;; heatmap-g0 defines only :fg.
|
||||
(should-not (tp-palette-color 'heatmap-g0 :bg)))
|
||||
(tp-builtins-test--with-background-mode 'dark
|
||||
(should (equal (tp-palette-color 'info :fg) "#58a6ff"))))
|
||||
|
||||
(ert-deftest tp-builtins-test-palette-has-p ()
|
||||
"tp-palette-has-p tests palette registration and per-key presence."
|
||||
(should (tp-palette-has-p 'info))
|
||||
(should (tp-palette-has-p 'info :fg))
|
||||
(should (tp-palette-has-p 'info :bg))
|
||||
(should (tp-palette-has-p 'info :border))
|
||||
(should (tp-palette-has-p 'heatmap-g0 :fg))
|
||||
(should-not (tp-palette-has-p 'heatmap-g0 :bg))
|
||||
(should-not (tp-palette-has-p 'heatmap-g0 :border))
|
||||
(should-not (tp-palette-has-p 'no-such-palette))
|
||||
(should-not (tp-palette-has-p 'no-such-palette :fg))
|
||||
;; Unlike the suffix predicates, has-p takes the palette name
|
||||
;; itself, not a NAME-fg variant symbol.
|
||||
(should-not (tp-palette-has-p 'info-fg))
|
||||
(should (tp-palette-fg-p 'info-fg)))
|
||||
|
||||
;;; DOC-STR-02: tp-suffix-symbol privatized behind an obsolete alias
|
||||
|
||||
(ert-deftest tp-builtins-test-suffix-symbol-obsolete-alias ()
|
||||
"tp-suffix-symbol keeps working as an obsolete compatibility alias."
|
||||
(should (eq (tp--suffix-symbol 'info "-fg") 'info-fg))
|
||||
(should (eq (with-suppressed-warnings ((obsolete tp-suffix-symbol))
|
||||
(tp-suffix-symbol 'info "-fg"))
|
||||
'info-fg))
|
||||
(should (eq (car (get 'tp-suffix-symbol 'byte-obsolete-info))
|
||||
'tp--suffix-symbol)))
|
||||
|
||||
;;; API-NAME-02: prefix-conforming tp-define-palette alias
|
||||
|
||||
(ert-deftest tp-builtins-test-define-palette-alias ()
|
||||
|
||||
@ -90,11 +90,25 @@ its window."
|
||||
`(face (,@(when border-color (list :box (list :color border-color))))))
|
||||
(_ (error "Invalid palette: %S" palette)))))
|
||||
|
||||
(defun tp-suffix-symbol (symbol string)
|
||||
(defun tp--suffix-symbol (symbol string)
|
||||
"Intern the symbol named by SYMBOL's name with STRING appended.
|
||||
For example (tp--suffix-symbol \\='info \"-fg\") returns `info-fg'.
|
||||
A generic helper with no tp semantics of its own, used by
|
||||
`tp-palette-show' to build the suffixed palette variant names."
|
||||
(intern (concat (symbol-name symbol) string)))
|
||||
|
||||
(define-obsolete-function-alias 'tp-suffix-symbol
|
||||
'tp--suffix-symbol "0.3.0")
|
||||
|
||||
;;;###autoload
|
||||
(defun tp-palette-show ()
|
||||
"Display a gallery of every palette registered in `tp-palette-alist'.
|
||||
Shows the read-only buffer *tp-palette-gallery* listing, for each
|
||||
palette NAME, the symbols the `tp-palette' layer accepts: NAME itself
|
||||
\(foreground, background and border together) plus the NAME-fg,
|
||||
NAME-bg, NAME-fbg and NAME-border variants, each label rendered in
|
||||
the colors it selects for the current theme. Press \\`q' to quit
|
||||
the gallery window."
|
||||
(interactive)
|
||||
(let ((alist (seq-reverse tp-palette-alist)))
|
||||
(tp-switch-to-buffer "*tp-palette-gallery*"
|
||||
@ -109,19 +123,19 @@ its window."
|
||||
" "
|
||||
(tp-set (concat name "-fg")
|
||||
'tp-palette
|
||||
(tp-suffix-symbol symbol "-fg"))
|
||||
(tp--suffix-symbol symbol "-fg"))
|
||||
" "
|
||||
(tp-set (concat name "-bg")
|
||||
'tp-palette
|
||||
(tp-suffix-symbol symbol "-bg"))
|
||||
(tp--suffix-symbol symbol "-bg"))
|
||||
" "
|
||||
(tp-set (concat name "-fbg")
|
||||
'tp-palette
|
||||
(tp-suffix-symbol symbol "-fbg"))
|
||||
(tp--suffix-symbol symbol "-fbg"))
|
||||
" "
|
||||
(tp-set (concat name "-border")
|
||||
'tp-palette
|
||||
(tp-suffix-symbol symbol "-border")))))
|
||||
(tp--suffix-symbol symbol "-border")))))
|
||||
alist "\n")))))
|
||||
|
||||
(define-tp tp-fg (color)
|
||||
|
||||
@ -254,9 +254,11 @@ documentation of NAME and PLIST.")
|
||||
;;; Utilities
|
||||
|
||||
(defun tp-theme-dark-p ()
|
||||
"Return non-nil when the current frame's background mode is dark."
|
||||
(eq (frame-parameter nil 'background-mode) 'dark))
|
||||
|
||||
(defun tp-theme-light-p ()
|
||||
"Return non-nil when the current frame's background mode is light."
|
||||
(eq (frame-parameter nil 'background-mode) 'light))
|
||||
|
||||
(defun tp-parse-color (color)
|
||||
@ -293,11 +295,49 @@ back to the light color."
|
||||
"Get color value for KEY from the palette named SYMBOL.
|
||||
SYMBOL is looked up in `tp-palette-alist'. KEY should be one of
|
||||
:fg, :bg, or :border. Return nil if SYMBOL names no registered
|
||||
palette or its definition doesn't contain KEY."
|
||||
palette or its definition doesn't contain KEY.
|
||||
The public entry point delegating here is `tp-palette-color'."
|
||||
(let ((plist (alist-get symbol tp-palette-alist)))
|
||||
(when (tp-palette--plistp plist)
|
||||
(tp-parse-color (plist-get plist key)))))
|
||||
|
||||
(defun tp-palette-color (symbol key)
|
||||
"Return the KEY color of the palette named SYMBOL, theme-resolved.
|
||||
SYMBOL is looked up in `tp-palette-alist'; KEY is one of :fg, :bg or
|
||||
:border. The stored color spec is resolved for the current theme by
|
||||
`tp-parse-color', so a (LIGHT . DARK) cons yields the side matching
|
||||
the frame's background mode. Returns nil when SYMBOL names no
|
||||
registered palette, its definition has no KEY entry, or the entry
|
||||
resolves to no color for the current theme.
|
||||
|
||||
This is the generic palette accessor; `tp-palette-fg-color',
|
||||
`tp-palette-bg-color' and `tp-palette-border-color' are per-key
|
||||
conveniences equivalent to calling it with a fixed KEY. See also
|
||||
`tp-palette-has-p' to test for a palette or key without resolving a
|
||||
color."
|
||||
(tp-palette--get-color symbol key))
|
||||
|
||||
(defun tp-palette-has-p (symbol &optional kind)
|
||||
"Return non-nil when SYMBOL names a palette that defines KIND.
|
||||
With nil KIND, test only that SYMBOL names a palette registered in
|
||||
`tp-palette-alist' (like `tp-palette-p'). Otherwise KIND is one of
|
||||
:fg, :bg or :border, and the palette's definition must contain that
|
||||
key. A defined key may still resolve to no color for the current
|
||||
theme (for example a (LIGHT . nil) cons in dark mode); use
|
||||
`tp-palette-color' when the resolved color itself matters.
|
||||
|
||||
Note that the suffix predicates `tp-palette-fg-p', `tp-palette-bg-p',
|
||||
`tp-palette-fbg-p' and `tp-palette-border-p' answer a different
|
||||
question: whether SYMBOL is a suffixed variant name like `info-fg'
|
||||
naming a registered palette (the `tp-palette' layer's convention).
|
||||
This predicate takes the palette name itself."
|
||||
(let ((entry (assoc symbol tp-palette-alist)))
|
||||
(cond ((null entry) nil)
|
||||
((null kind) t)
|
||||
(t (and (tp-palette--plistp (cdr entry))
|
||||
(plist-member (cdr entry) kind)
|
||||
t)))))
|
||||
|
||||
(defun tp-palette-fg-color (symbol)
|
||||
"Get the foreground color from palette SYMBOL.
|
||||
SYMBOL should be a symbol bound to a palette plist with a :fg key.
|
||||
@ -317,33 +357,52 @@ Returns nil if SYMBOL is unbound or doesn't contain :border."
|
||||
(tp-palette--get-color symbol :border))
|
||||
|
||||
(defun tp-palette-p (symbol)
|
||||
"Return non-nil when SYMBOL names a registered palette.
|
||||
The value is SYMBOL's entry in `tp-palette-alist'. See also the
|
||||
generalized `tp-palette-has-p'."
|
||||
(assoc symbol tp-palette-alist))
|
||||
|
||||
(defun tp-palette-fg-p (symbol)
|
||||
"Return non-nil when SYMBOL is a NAME-fg variant of a palette NAME.
|
||||
Tests the suffixed naming convention of the `tp-palette' layer, not
|
||||
the palette contents; see `tp-palette-has-p' for the latter."
|
||||
(save-match-data
|
||||
(let ((str (symbol-name symbol)))
|
||||
(and (string-match "\\(.+\\)-fg$" str)
|
||||
(tp-palette-p (intern (match-string 1 str)))))))
|
||||
|
||||
(defun tp-palette-bg-p (symbol)
|
||||
"Return non-nil when SYMBOL is a NAME-bg variant of a palette NAME.
|
||||
Tests the suffixed naming convention of the `tp-palette' layer, not
|
||||
the palette contents; see `tp-palette-has-p' for the latter."
|
||||
(save-match-data
|
||||
(let ((str (symbol-name symbol)))
|
||||
(and (string-match "\\(.+\\)-bg$" str)
|
||||
(tp-palette-p (intern (match-string 1 str)))))))
|
||||
|
||||
(defun tp-palette-fbg-p (symbol)
|
||||
"Return non-nil when SYMBOL is a NAME-fbg variant of a palette NAME.
|
||||
Tests the suffixed naming convention of the `tp-palette' layer (fg
|
||||
plus bg), not the palette contents."
|
||||
(save-match-data
|
||||
(let ((str (symbol-name symbol)))
|
||||
(and (string-match "\\(.+\\)-fbg$" str)
|
||||
(tp-palette-p (intern (match-string 1 str)))))))
|
||||
|
||||
(defun tp-palette-border-p (symbol)
|
||||
"Return non-nil when SYMBOL is a NAME-border variant of a palette NAME.
|
||||
Tests the suffixed naming convention of the `tp-palette' layer, not
|
||||
the palette contents; see `tp-palette-has-p' for the latter."
|
||||
(save-match-data
|
||||
(let ((str (symbol-name symbol)))
|
||||
(and (string-match "\\(.+\\)-border$" str)
|
||||
(tp-palette-p (intern (match-string 1 str)))))))
|
||||
|
||||
(defun tp-palette-pure (symbol)
|
||||
"Return the palette name behind SYMBOL, stripping variant suffixes.
|
||||
SYMBOL may be a registered palette name or one of its -fg/-bg/-fbg/
|
||||
-border variants (see the `tp-palette' layer); signal an error for
|
||||
anything else."
|
||||
(pcase symbol
|
||||
((pred tp-palette-p) symbol)
|
||||
((pred tp-palette-fg-p)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user