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

improve code

Browse Source
This commit is contained in:
Kinneyzhang 2026-01-07 02:20:38 +08:00
parent 676d41aba6
commit 4dff70cd59
2 changed files with 24 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
tp-palette.el
View File

@ -265,28 +265,5 @@ Returns nil if SYMBOL is unbound or doesn't contain :border."
(intern (string-trim-right (symbol-name symbol) "-border"))) (intern (string-trim-right (symbol-name symbol) "-border")))
(_ (error "Invalid format of tp-palette: %S" symbol)))) (_ (error "Invalid format of tp-palette: %S" symbol))))
(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))))
(pcase palette
((pred tp-palette-p)
`(face ( :foreground ,fg-color
:background ,bg-color
:box (:color ,border-color))))
((pred tp-palette-fg-p)
`(face (:foreground ,fg-color)))
((pred tp-palette-bg-p)
`(face (:background ,bg-color)))
((pred tp-palette-fbg-p)
`(face (:foreground ,fg-color :background ,bg-color)))
((pred tp-palette-border-p)
`(face (:box (:color ,border-color))))
(_ (error "Invalid palette: %S" palette)))))
(provide 'tp-palette) (provide 'tp-palette)
;;; tp-palette.el ends here ;;; tp-palette.el ends here

25
tp.el
View File

@ -4799,9 +4799,32 @@ e.g.3 (tp-parse-color '(:light \"red\" :dark \"green\"))"
((null color) nil) ((null color) nil)
(t (error "Invalid format of color %S" color)))) (t (error "Invalid format of color %S" color))))
;;; Built-in text properties
(require 'tp-palette) (require 'tp-palette)
;;; Built-in text properties (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))))
(pcase palette
((pred tp-palette-p)
`(face ( :foreground ,fg-color
:background ,bg-color
:box (:color ,border-color))))
((pred tp-palette-fg-p)
`(face (:foreground ,fg-color)))
((pred tp-palette-bg-p)
`(face (:background ,bg-color)))
((pred tp-palette-fbg-p)
`(face (:foreground ,fg-color :background ,bg-color)))
((pred tp-palette-border-p)
`(face (:box (:color ,border-color))))
(_ (error "Invalid palette: %S" palette)))))
(defun tp-suffix-symbol (symbol string) (defun tp-suffix-symbol (symbol string)
(intern (concat (symbol-name symbol) string))) (intern (concat (symbol-name symbol) string)))