972b6d4e4c
Add canonical query semantics, managed metadata and transactions, overlay-aware lookup, reproducible benchmarks, and synchronized API documentation.
460 lines
16 KiB
EmacsLisp
460 lines
16 KiB
EmacsLisp
;;; tp-palette.el --- Color palette definitions for tp.el -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2024
|
|
|
|
;;; Commentary:
|
|
|
|
;; This file provides color palette definitions for tp.el.
|
|
;; Colors are designed to work well in both light and dark themes.
|
|
;; Each palette entry has the format:
|
|
;; (:fg (LIGHT-FG . DARK-FG) :bg (LIGHT-BG . DARK-BG) :border (LIGHT-BORDER . DARK-BORDER))
|
|
;;
|
|
;; Color scheme inspired by:
|
|
;; - GitHub Primer Design System
|
|
;; - Tailwind CSS Color Palette
|
|
;; - Material Design Color System
|
|
;; - One Dark / One Light themes
|
|
|
|
;;; Code:
|
|
|
|
(require 'subr-x) ; string-trim-right
|
|
|
|
(defalias 'tp-palette--plistp
|
|
(if (fboundp 'plistp)
|
|
#'plistp
|
|
(lambda (object)
|
|
(let ((len (proper-list-p object)))
|
|
(and len (zerop (% len 2)) t))))
|
|
"Return non-nil if OBJECT is a property list.
|
|
Compatibility shim: `plistp' was only added in Emacs 29.1, while
|
|
the library supports Emacs 28.1.")
|
|
|
|
(defvar tp-palette-alist nil
|
|
"Alist of (NAME . PLIST) palette definitions.
|
|
This is the single source of truth for palette lookups.")
|
|
|
|
(defvar tp-theme-generation 0
|
|
"Monotonic generation incremented after theme enable/disable events.")
|
|
|
|
(defvar tp-theme-last-hook-source nil
|
|
"Most recent theme lifecycle function observed by tp.")
|
|
|
|
(defvar tp-theme-last-refresh-mode nil
|
|
"Refresh strategy used for the most recent theme lifecycle event.")
|
|
|
|
(defvar tp-theme-last-refreshed-ranges nil
|
|
"Managed ranges considered by the most recent theme refresh.")
|
|
|
|
(defvar tp-theme-last-refresh-errors nil
|
|
"Structured failures from the most recent theme refresh.")
|
|
|
|
(defvar tp-theme-change-hook nil
|
|
"Hook run after a theme lifecycle event.
|
|
Each function receives the source symbol, either `enable-theme' or
|
|
`disable-theme'. The palette module owns event detection only;
|
|
managed renderers may subscribe without creating a reverse dependency.")
|
|
|
|
(defun tp--palette-note-theme-change (source)
|
|
"Record theme lifecycle SOURCE and notify `tp-theme-change-hook'."
|
|
(setq tp-theme-generation (1+ tp-theme-generation)
|
|
tp-theme-last-hook-source source)
|
|
(run-hook-with-args 'tp-theme-change-hook source))
|
|
|
|
(defun tp--palette-after-enable-theme (&rest _)
|
|
"Record an `enable-theme' lifecycle event."
|
|
(tp--palette-note-theme-change 'enable-theme))
|
|
|
|
(defun tp--palette-after-disable-theme (&rest _)
|
|
"Record a `disable-theme' lifecycle event."
|
|
(tp--palette-note-theme-change 'disable-theme))
|
|
|
|
(unless (advice-member-p #'tp--palette-after-enable-theme 'enable-theme)
|
|
(advice-add 'enable-theme :after #'tp--palette-after-enable-theme))
|
|
(unless (advice-member-p #'tp--palette-after-disable-theme 'disable-theme)
|
|
(advice-add 'disable-theme :after #'tp--palette-after-disable-theme))
|
|
|
|
(defmacro define-tp-palette (name &rest plist)
|
|
"Register a color palette named NAME, defined by PLIST.
|
|
PLIST maps the keys :fg, :bg and :border to colors in any format
|
|
accepted by `tp-parse-color' (usually a (LIGHT . DARK) cons).
|
|
The palette is stored in `tp-palette-alist'; re-evaluating a
|
|
definition updates the stored palette in place."
|
|
(declare (indent defun))
|
|
`(setf (alist-get ',name tp-palette-alist) '(,@plist)))
|
|
|
|
(defalias 'tp-define-palette 'define-tp-palette
|
|
"Register a color palette named NAME; alias of `define-tp-palette'.
|
|
This is the package-prefix-conforming name for the palette
|
|
definition macro, so it is discoverable via the tp- prefix;
|
|
`define-tp-palette' is the historical name and both are permanent -
|
|
neither will be removed. See `define-tp-palette' for the full
|
|
documentation of NAME and PLIST.")
|
|
(function-put 'tp-define-palette 'lisp-indent-function 'defun)
|
|
|
|
(define-tp-palette button-primary
|
|
:fg ("#ffffff" . "#ffffff") :bg ("#007bff" . "#007bff"))
|
|
|
|
(define-tp-palette button-secondary
|
|
:fg ("#ffffff" . "#ffffff") :bg ("#6c757d" . "#6c757d"))
|
|
|
|
(define-tp-palette button-info
|
|
:fg ("#ffffff" . "#ffffff") :bg ("#17a2b8" . "#17a2b8"))
|
|
|
|
(define-tp-palette button-success
|
|
:fg ("#ffffff" . "#ffffff") :bg ("#28a745" . "#28a745"))
|
|
|
|
(define-tp-palette button-warning
|
|
:fg ("#000000" . "#000000") :bg ("#ffc107" . "#ffc107"))
|
|
|
|
(define-tp-palette button-danger
|
|
:fg ("#ffffff" . "#ffffff") :bg ("#dc3545" . "#dc3545"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-tp-palette heading-1
|
|
:fg ("#0969da" . "#58a6ff") :bg ("#f0f7ff" . "#1a2634")
|
|
:border ("#54aeff" . "#388bfd"))
|
|
|
|
(define-tp-palette heading-2
|
|
:fg ("#8250df" . "#a371f7") :bg ("#fbefff" . "#271d36")
|
|
:border ("#c297ff" . "#6e40c9"))
|
|
|
|
(define-tp-palette heading-3
|
|
:fg ("#1a7f37" . "#3fb950") :bg ("#f0fff4" . "#1a2e1f")
|
|
:border ("#4ac26b" . "#238636"))
|
|
|
|
(define-tp-palette heading-4
|
|
:fg ("#953800" . "#ffa657") :bg ("#fff8f0" . "#2e2318")
|
|
:border ("#ffb86c" . "#9e6a03"))
|
|
|
|
(define-tp-palette heading-5
|
|
:fg ("#bf3989" . "#db61a2") :bg ("#fff0f7" . "#2e1f28")
|
|
:border ("#f28cb1" . "#8b3d63"))
|
|
|
|
(define-tp-palette heading-6
|
|
:fg ("#0598bc" . "#39c5cf") :bg ("#f0faff" . "#1a2e33")
|
|
:border ("#56d4dd" . "#2d7d85"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-tp-palette gray-50
|
|
:fg ("#24292f" . "#fafafa") :bg ("#fafafa" . "#171717")
|
|
:border ("#e5e5e5" . "#262626"))
|
|
|
|
(define-tp-palette gray-100
|
|
:fg ("#24292f" . "#f5f5f5") :bg ("#f5f5f5" . "#1c1c1c")
|
|
:border ("#e5e5e5" . "#262626"))
|
|
|
|
(define-tp-palette gray-200
|
|
:fg ("#24292f" . "#e5e5e5") :bg ("#e5e5e5" . "#262626")
|
|
:border ("#d4d4d4" . "#404040"))
|
|
|
|
(define-tp-palette gray-300
|
|
:fg ("#24292f" . "#d4d4d4") :bg ("#d4d4d4" . "#404040")
|
|
:border ("#a3a3a3" . "#525252"))
|
|
|
|
(define-tp-palette gray-400
|
|
:fg ("#24292f" . "#a3a3a3") :bg ("#a3a3a3" . "#525252")
|
|
:border ("#737373" . "#737373"))
|
|
|
|
(define-tp-palette gray-500
|
|
:fg ("#ffffff" . "#737373") :bg ("#737373" . "#737373")
|
|
:border ("#525252" . "#a3a3a3"))
|
|
|
|
(define-tp-palette gray-600
|
|
:fg ("#ffffff" . "#525252") :bg ("#525252" . "#a3a3a3")
|
|
:border ("#404040" . "#d4d4d4"))
|
|
|
|
(define-tp-palette gray-700
|
|
:fg ("#ffffff" . "#404040") :bg ("#404040" . "#d4d4d4")
|
|
:border ("#262626" . "#e5e5e5"))
|
|
|
|
(define-tp-palette gray-800
|
|
:fg ("#ffffff" . "#262626") :bg ("#262626" . "#e5e5e5")
|
|
:border ("#171717" . "#f5f5f5"))
|
|
|
|
(define-tp-palette gray-900
|
|
:fg ("#ffffff" . "#171717") :bg ("#171717" . "#f5f5f5")
|
|
:border ("#0a0a0a" . "#fafafa"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-tp-palette todo
|
|
:fg ("#ffffff" . "#ffffff") :bg ("#cf222e" . "#da3633")
|
|
:border ("#a40e26" . "#f85149"))
|
|
|
|
(define-tp-palette done
|
|
:fg ("#ffffff" . "#ffffff") :bg ("#1a7f37" . "#238636")
|
|
:border ("#116329" . "#2ea043"))
|
|
|
|
(define-tp-palette code
|
|
:fg ("#0550ae" . "#79c0ff") :bg ("#f6f8fa" . "#161b22")
|
|
:border ("#d0d7de" . "#30363d"))
|
|
|
|
(define-tp-palette block
|
|
:fg ("#24292f" . "#c9d1d9") :bg ("#f6f8fa" . "#161b22")
|
|
:border ("#d0d7de" . "#30363d"))
|
|
|
|
(define-tp-palette quote
|
|
:fg ("#57606a" . "#8b949e") :bg ("#f6f8fa" . "#161b22")
|
|
:border ("#d0d7de" . "#30363d"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-tp-palette success
|
|
:fg ("#1a7f37" . "#3fb950") :bg ("#dafbe1" . "#1b4721")
|
|
:border ("#4ac26b" . "#238636"))
|
|
|
|
(define-tp-palette warning
|
|
:fg ("#9a6700" . "#d29922") :bg ("#fff8c5" . "#3d2e00")
|
|
:border ("#d4a72c" . "#9e6a03"))
|
|
|
|
(define-tp-palette error
|
|
:fg ("#cf222e" . "#f85149") :bg ("#ffebe9" . "#542426")
|
|
:border ("#ff8182" . "#f85149"))
|
|
|
|
(define-tp-palette info
|
|
:fg ("#0969da" . "#58a6ff") :bg ("#ddf4ff" . "#1f3d5c")
|
|
:border ("#54aeff" . "#388bfd"))
|
|
|
|
(define-tp-palette neutral
|
|
:fg ("#57606a" . "#8b949e") :bg ("#f6f8fa" . "#21262d")
|
|
:border ("#d0d7de" . "#30363d"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-tp-palette rainbow-1
|
|
:fg ("#e45649" . "#e06c75") :border ("#e45649" . "#e06c75"))
|
|
|
|
(define-tp-palette rainbow-2
|
|
:fg ("#986801" . "#d19a66") :border ("#986801" . "#d19a66"))
|
|
|
|
(define-tp-palette rainbow-3
|
|
:fg ("#c18401" . "#e5c07b") :border ("#c18401" . "#e5c07b"))
|
|
|
|
(define-tp-palette rainbow-4
|
|
:fg ("#50a14f" . "#98c379") :border ("#50a14f" . "#98c379"))
|
|
|
|
(define-tp-palette rainbow-5
|
|
:fg ("#0184bc" . "#56b6c2") :border ("#0184bc" . "#56b6c2"))
|
|
|
|
(define-tp-palette rainbow-6
|
|
:fg ("#4078f2" . "#61afef") :border ("#4078f2" . "#61afef"))
|
|
|
|
(define-tp-palette rainbow-7
|
|
:fg ("#a626a4" . "#c678dd") :border ("#a626a4" . "#c678dd"))
|
|
|
|
(define-tp-palette rainbow-8
|
|
:fg ("#bf3989" . "#db61a2") :border ("#bf3989" . "#db61a2"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-tp-palette mark
|
|
:fg ("#9a6700" . "#f0c239") :bg ("#fff8c5" . "#533d00")
|
|
:border ("#d4a72c" . "#9e6a03"))
|
|
|
|
(define-tp-palette tag
|
|
:fg ("#57606a" . "#8b949e") :bg ("#f6f8fa" . "#21262d")
|
|
:border ("#d0d7de" . "#888"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; github 经典绿色主题
|
|
(define-tp-palette heatmap-g0
|
|
:fg ("#ebedf0" . "#161b22"))
|
|
|
|
(define-tp-palette heatmap-g1
|
|
:fg ("#9be9a8" . "#0e4429"))
|
|
|
|
(define-tp-palette heatmap-g2
|
|
:fg ("#40c463" . "#006d32"))
|
|
|
|
(define-tp-palette heatmap-g3
|
|
:fg ("#30a14e" . "#26a641"))
|
|
|
|
(define-tp-palette heatmap-g4
|
|
:fg ("#216e39" . "#39d353"))
|
|
|
|
;; github 万圣节主题
|
|
(define-tp-palette heatmap-h0
|
|
:fg ("#ebedf0" . "#161b22"))
|
|
|
|
(define-tp-palette heatmap-h1
|
|
:fg ("#ffee4a" . "#631c03"))
|
|
|
|
(define-tp-palette heatmap-h2
|
|
:fg ("#ffc501" . "#bd561d"))
|
|
|
|
(define-tp-palette heatmap-h3
|
|
:fg ("#fe9600" . "#fa7a18"))
|
|
|
|
(define-tp-palette heatmap-h4
|
|
:fg ("#03001c" . "#fddf68"))
|
|
|
|
;;; 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)
|
|
"Resolve COLOR to a color string for the current theme.
|
|
COLOR may be:
|
|
- a color string, returned as is: \"red\"
|
|
- a (LIGHT . DARK) cons: (\"red\" . \"green\"); either side may be
|
|
nil, meaning no color for that mode
|
|
- a (:light LIGHT :dark DARK) plist: (:light \"red\" :dark \"green\")
|
|
Return nil when COLOR is nil, or when the side selected by the
|
|
current theme is nil. When the theme cannot be determined, fall
|
|
back to the light color."
|
|
(cond ((stringp color) color)
|
|
((and (consp color)
|
|
(or (stringp (car color)) (null (car color)))
|
|
(or (stringp (cdr color)) (null (cdr color))))
|
|
(cond
|
|
((tp-theme-light-p) (car color))
|
|
((tp-theme-dark-p) (cdr color))
|
|
;; Default to light color when background-mode is unknown
|
|
(t (car color))))
|
|
((and (tp-palette--plistp color)
|
|
(or (plist-member color :light)
|
|
(plist-member color :dark)))
|
|
(cond
|
|
((tp-theme-light-p) (plist-get color :light))
|
|
((tp-theme-dark-p) (plist-get color :dark))
|
|
;; Default to light color when background-mode is unknown
|
|
(t (plist-get color :light))))
|
|
((null color) nil)
|
|
(t (error "Invalid format of color %S" color))))
|
|
|
|
(defun tp-palette--get-color (symbol key)
|
|
"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.
|
|
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.
|
|
Returns nil if SYMBOL is unbound or doesn't contain :fg."
|
|
(tp-palette--get-color symbol :fg))
|
|
|
|
(defun tp-palette-bg-color (symbol)
|
|
"Get the background color from palette SYMBOL.
|
|
SYMBOL should be a symbol bound to a palette plist with a :bg key.
|
|
Returns nil if SYMBOL is unbound or doesn't contain :bg."
|
|
(tp-palette--get-color symbol :bg))
|
|
|
|
(defun tp-palette-border-color (symbol)
|
|
"Get the border color from palette SYMBOL.
|
|
SYMBOL should be a symbol bound to a palette plist with a :border key.
|
|
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)
|
|
(intern (string-trim-right (symbol-name symbol) "-fg")))
|
|
((pred tp-palette-bg-p)
|
|
(intern (string-trim-right (symbol-name symbol) "-bg")))
|
|
((pred tp-palette-fbg-p)
|
|
(intern (string-trim-right (symbol-name symbol) "-fbg")))
|
|
((pred tp-palette-border-p)
|
|
(intern (string-trim-right (symbol-name symbol) "-border")))
|
|
(_ (error "Invalid format of tp-palette: %S" symbol))))
|
|
|
|
(provide 'tp-palette)
|
|
;;; tp-palette.el ends here
|