From 7dbdc89541d6c46268785d55f227472b0dbf3d30 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Mon, 13 Oct 2025 20:58:11 +0800 Subject: [PATCH] update --- readme.md | 29 +++++++++++++++----- tp-tests.el | 21 ++++++++------- tp.el | 78 ++++++++++++++++++++++++----------------------------- 3 files changed, 69 insertions(+), 59 deletions(-) diff --git a/readme.md b/readme.md index 5f0fc19..00539b2 100644 --- a/readme.md +++ b/readme.md @@ -1,11 +1,26 @@ +最上面的层会被渲染到 buffer 中。 + ### text properties layer -- tp-layer-set (name start end &optional object) -- tp-layer-push (name start end properties &optional object) -- tp-layer-delete (name start end &optional object) -- tp-layer-rotate (start end &optional object) -- tp-layer-pin (name start end &optional object) -- tp-layer-define (name properties) -- tp-layer-group-define (name &rest layers) +- `tp-layer-set (name start end &optional object)` +将 object 在 start 到 end 范围内的文本当前展示的文本属性层命名为 name。 + +- `tp-layer-push (name start end properties &optional object)` +给 object 在 start 到 end 范围内的文本设置 properties 并 push 到最上层。 + +- `tp-layer-delete (name start end &optional object)` +删除 object 在 start 到 end 范围内的文本名称为 name 的层。 + +- `tp-layer-rotate (start end &optional object)` +循环移动 object 在 start 到 end 范围内的文本的属性层。即每次将最上面的层移到最下面，交替使用每个层的文本属性。 + +- `tp-layer-pin (name start end &optional object)` +将 object 在 start 到 end 范围内的文本的名称为 name 的层移到最上面。 + +- `tp-layer-define (name properties)` +定义 properties 为名称为 name 的文本属性层。如果已经存在，则会使用 properties 覆其属性定义。 + +- `tp-layer-group-define (name &rest layers)` + ### text properties propertize - tp-propertize (string properties &optional layer) diff --git a/tp-tests.el b/tp-tests.el index 34b78e0..acad0fd 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -3,19 +3,22 @@ ;; tp-layer-alist ;; tp-layer-groups -(tp-layer-define 'test1 +(tp-layer-define test1 '(face link :foreground "orange")) -(tp-layer-define 'test2 +(tp-layer-define test2 '(face link :foreground "cyan")) -(tp-layer-group-define 'test-group - '(test1 display "this is top layer" - face (:background "red" :foreground "#000")) - '(test2 display "this is middle layer" - face (:background "green" :foreground "#000")) - '(test3 display "this is bottom layer" - face (:background "cyan" :foreground "#000"))) +(tp-layer-group-define test-group + test1 '( display "this is top layer" + face (:background "red" :foreground "#000")) + test2 '( display "this is middle layer" + face (:background "green" :foreground "#000")) + test3 '( display "this is bottom layer" + face (:background "cyan" :foreground "#000"))) + +(setq tp-layer-alist nil) +(setq tp-layer-groups nil) (tp-layer-propertize "emacs" 'test1) (tp-layer-group-propertize "emacs" 'test-group) diff --git a/tp.el b/tp.el index 1c7c1aa..48f7e69 100644 --- a/tp.el +++ b/tp.el @@ -4,6 +4,40 @@ (require 'dash) +;;; tp layer define + +(defvar tp-layer-alist nil + "Alist 的每个元素是单个 layer") + +(defvar tp-layer-groups nil + "group 的每个元素是 layer 组，组中存储的是多个 layer") + +(defmacro tp-layer-define (name properties) + "定义一个名称为 name 的文本属性层，数据存放在 tp-layer-alist 中" + (declare (indent defun)) + `(progn + (if (assoc ',name tp-layer-alist) + (setf (cdr (assoc ',name tp-layer-alist)) ,properties) + (push (cons ',name ,properties) tp-layer-alist)) + (assoc ',name tp-layer-alist))) + +(defmacro tp-layer-group-define (name &rest layers) + "每个属性层在 tp-layer-alist 中，属性组指在 tp-layer-groups 中存储属性层的名称 +层级关系与layers定义顺序一致。最上面的定义表示顶层，渲染时会显示出来。" + (declare (indent defun)) + `(let ((layer-names + (nreverse + (-map (lambda (lst) + (let ((layer-name (car lst))) + (eval `(tp-layer-define ,layer-name ,(cadr lst))) + layer-name)) + (-partition 2 ',layers))))) + (if (assoc ',name tp-layer-groups) + (setf (cdr (assoc ',name tp-layer-groups)) layer-names) + (push (cons ',name layer-names) tp-layer-groups)) + (assoc ',name tp-layer-groups))) + + ;;; tp layer (defun tp-top-layer-props (properties) @@ -61,17 +95,6 @@ function 的四个参数分别为:区间开始位置，区间结束位置，顶 (list (+ start i-start) (+ start i-end) props))) start end object)) -;; (defun tp-layers-names (start end &optional object) -;; "返回当前所有 layers 的名称" -;; (seq-uniq -;; (apply 'append -;; (tp-intervals-map -;; (lambda (i-start i-end top belows) -;; (remove nil (mapcar (lambda (props) -;; (plist-get props 'tp-name)) -;; (append (list top) belows)))) -;; start end object)))) - (defun tp-layer-set (name start end &optional object) "将 object 的 start 和 end 之间的文本当前的属性层命名为 name" (if (tp-empty-p object) @@ -87,10 +110,8 @@ function 的四个参数分别为:区间开始位置，区间结束位置，顶 start end object)) object) -(defun tp-layer-push (name start end properties &optional object) +(defun tp-layer-push (start end name &optional properties object) "设置 properties 为最上面的 prop 层，name 是 layer 的名字" - ;; 当前顶层放到 tp-layers 开头，properties 设置为当前顶层。 - ;; FIXME: 需要检查 name 是否已经存在，存在则报错 (declare (indent defun)) (when (tp-layer-props name start end object) (error "Already exist layer named %S" name)) @@ -177,35 +198,6 @@ function 的四个参数分别为:区间开始位置，区间结束位置，顶 ;;; propertize string -(defvar tp-layer-alist nil - "Alist 的每个元素是单个 layer") - -(defvar tp-layer-groups nil - "group 的每个元素是 layer 组，组中存储的是多个 layer") - -(defun tp-layer-define (name properties) - "定义一个名称为 name 的文本属性层，数据存放在 tp-layer-alist 中" - (declare (indent defun)) - (if (assoc name tp-layer-alist) - (setf (cdr (assoc name tp-layer-alist)) properties) - (push (cons name properties) tp-layer-alist)) - (assoc name tp-layer-alist)) - -(defun tp-layer-group-define (name &rest layers) - "每个属性层在 tp-layer-alist 中，属性组指在 tp-layer-groups 中存储属性层的名称 -层级关系与layers定义顺序一致。最上面的定义表示顶层，渲染时会显示出来。" - (declare (indent defun)) - (let ((layer-names - (nreverse - (mapcar (lambda (layer) - (let ((layer-name (car layer))) - (tp-layer-define layer-name (cdr layer)) - layer-name)) - layers)))) - (if (assoc name tp-layer-groups) - (setf (cdr (assoc name tp-layer-groups)) layer-names) - (push (cons name layer-names) tp-layer-groups)))) - (defun tp-propertize (string properties &optional layer) (declare (indent defun)) (let ((layer (or layer (org-id-uuid))))