geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

add heatmap tp-palette

Browse Source
This commit is contained in:
Kinneyzhang 2026-01-08 15:48:34 +08:00
parent 5d75ff434c
commit a1ce94c0dd
2 changed files with 75 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
tp-palette.el
View File

@ -193,8 +193,72 @@
: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 ()
(eq (frame-parameter nil 'background-mode) 'dark))
(defun tp-theme-light-p ()
(eq (frame-parameter nil 'background-mode) 'light))
(defun tp-parse-color (color)
"e.g.1 (tp-parse-color \"red\")
e.g.2 (tp-parse-color '(\"red\" . \"green\"))
e.g.3 (tp-parse-color '(:light \"red\" :dark \"green\"))"
(cond ((stringp color) color)
((and (consp color)
(stringp (car color))
(stringp (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 (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 palette SYMBOL.
SYMBOL should be a symbol bound to a palette plist.

54
tp.el
View File

@ -4745,61 +4745,29 @@ Returns the modified object (string) or nil for buffer operations."
(read-only-mode 1))
(switch-to-buffer buffer)))
(defun tp-theme-dark-p ()
(eq (frame-parameter nil 'background-mode) 'dark))
(defun tp-theme-light-p ()
(eq (frame-parameter nil 'background-mode) 'light))
(defun tp-parse-color (color)
"e.g.1 (tp-parse-color \"red\")
e.g.2 (tp-parse-color '(\"red\" . \"green\"))
e.g.3 (tp-parse-color '(:light \"red\" :dark \"green\"))"
(cond ((stringp color) color)
((and (consp color)
(stringp (car color))
(stringp (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 (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))))
;;; Built-in text properties
(require 'tp-palette)
(define-tp tp-palette (palette)
(let* ((pure-palette (tp-palette-pure palette))
(fg-color (or (tp-palette-fg-color pure-palette)
(face-attribute 'default :foreground)))
(bg-color (or (tp-palette-bg-color pure-palette)
(face-attribute 'default :background)))
(border-color (or (tp-palette-border-color pure-palette)
(face-attribute 'default :foreground))))
(fg-color (tp-palette-fg-color pure-palette))
(bg-color (tp-palette-bg-color pure-palette))
(border-color (tp-palette-border-color pure-palette)))
(pcase palette
((pred tp-palette-p)
`(face ( :foreground ,fg-color
:background ,bg-color
:box (:color ,border-color))))
`(face (,@(when fg-color (list :foreground fg-color))
,@(when bg-color (list :background bg-color))
,@(when border-color (list :box (list :color border-color))))))
((pred tp-palette-fg-p)
`(face (:foreground ,fg-color)))
`(face (,@(when fg-color (list :foreground fg-color)))))
((pred tp-palette-bg-p)
`(face (:background ,bg-color)))
`(face (,@(when bg-color (list :background bg-color)))))
((pred tp-palette-fbg-p)
`(face (:foreground ,fg-color :background ,bg-color)))
`(face (,@(when fg-color (list :foreground fg-color))
,@(when bg-color (list :background bg-color)))))
((pred tp-palette-border-p)
`(face (:box (:color ,border-color))))
`(face (,@(when border-color (list :box (list :color border-color))))))
(_ (error "Invalid palette: %S" palette)))))
(defun tp-suffix-symbol (symbol string)