This commit is contained in:
Kinneyzhang 2025-10-16 12:56:13 +08:00
parent 48e9eb9c01
commit d4efd44aa0

65
tp.el
View File

@ -37,41 +37,18 @@
(push (cons ',name layer-names) tp-layer-groups)) (push (cons ',name layer-names) tp-layer-groups))
(assoc ',name tp-layer-groups))) (assoc ',name tp-layer-groups)))
;; ;; FIXME: (defun tp-layer-properties (layer-name)
;; (defun tp-layer-properties (layer-or-group-or-properties) (when-let ((plist (cdr (assoc layer-name tp-layer-alist))))
;; "如果 name 已在 `tp-layer-define' 中定义,忽略 properties; (append plist (list 'tp-name name))))
;; 否则使用 properties 作为新的层的属性"
;; (if-let ((plist (cdr (assoc name tp-layer-alist))))
;; (append plist (list 'tp-name name))
;; (append properties (list 'tp-name name))))
(defun tp-layer-properties (name &optional properties) (defun tp-layer-group-properties (group-name)
"如果 name 已在 `tp-layer-define' 中定义,忽略 properties;
否则使用 properties 作为新的层的属性"
(if-let ((plist (cdr (assoc name tp-layer-alist))))
(append plist (list 'tp-name name))
(append properties (list 'tp-name name))))
(defun tp-layer-group-properties (name)
"返回使用 `tp-layer-group-define' 定义的 layer 的属性" "返回使用 `tp-layer-group-define' 定义的 layer 的属性"
(when-let ((layers (cdr (assoc name tp-layer-groups)))) (when-let ((layers (cdr (assoc group-name tp-layer-groups))))
(mapcar (lambda (layer) (mapcar (lambda (layer)
(tp-layer-properties layer)) (tp-layer-properties layer))
layers))) layers)))
;;; tp layer (defun tp-intervals (start end &optional object)
(defun tp--layer-top-props (properties)
"获取最上面的属性层,也就是实际要渲染的层"
(if-let ((idx (-elem-index 'tp-layers properties)))
(-remove-at-indices (list idx (1+ idx)) properties)
properties))
(defun tp--layer-below-props (properties)
"获取最上层以下的属性层列表"
(plist-get properties 'tp-layers))
(defun tp-all (start end &optional object)
"获取 OBJECT 的 start 到 end 范围内文本的所有 text properties。 "获取 OBJECT 的 start 到 end 范围内文本的所有 text properties。
OBJECT 可以为 buffer stringnil 默认为当前 buffer OBJECT 可以为 buffer stringnil 默认为当前 buffer
point 0 开始" point 0 开始"
@ -98,20 +75,24 @@ function 的四个参数分别为:区间开始位置,区间结束位置,顶
(let* ((interval-start (nth 0 tp)) ;; start from 0 (let* ((interval-start (nth 0 tp)) ;; start from 0
(interval-end (nth 1 tp)) (interval-end (nth 1 tp))
(interval-props (nth 2 tp)) (interval-props (nth 2 tp))
(top-props (tp--layer-top-props interval-props)) (top-props
(below-props-lst (tp--layer-below-props interval-props))) (if-let ((idx (-elem-index 'tp-layers properties)))
(-remove-at-indices (list idx (1+ idx)) properties)
interval-props))
(below-props-lst (plist-get interval-props 'tp-layers)))
(funcall function (funcall function
interval-start interval-end interval-start interval-end
top-props below-props-lst))) top-props below-props-lst)))
(tp-all start end object)))) (tp-intervals start end object))))
(defun tp-region-layer-props (start end name &optional object) (defun tp-region-layer-props (start end layer-name &optional object)
"返回 object 的 start 和 end 之间文本属性层为 name 的属性列表" "返回 object 的 start 和 end 之间文本属性层为 name 的属性列表"
(tp-intervals-map (tp-intervals-map
(lambda (i-start i-end top belows) (lambda (i-start i-end top belows)
(when-let ((props (seq-find (when-let ((props (seq-find
(lambda (props) (lambda (props)
(equal name (plist-get props 'tp-name))) (equal layer-name
(plist-get props 'tp-name)))
(append (list top) belows)))) (append (list top) belows))))
(list (+ start i-start) (+ start i-end) props))) (list (+ start i-start) (+ start i-end) props)))
start end object)) start end object))
@ -131,18 +112,20 @@ function 的四个参数分别为:区间开始位置,区间结束位置,顶
start end object)) start end object))
object) object)
;; (if (tp-empty-p object)
;; (set-text-properties
;; start end (append properties (list 'tp-name name))
;; object)
;; )
;;;###autoload ;;;###autoload
(defun tp-layer-push (start end name &optional properties object) (defun tp-layer-push (start end name &optional object)
"设置 properties 为最上面的 prop 层name 是 layer 的名字; "设置 properties 为最上面的 prop 层name 是 layer 的名字;
如果 properties nil `tp-layer-define' 定义的名称为 name layer 设置" 如果 properties nil `tp-layer-define' 定义的名称为 name layer 设置"
(declare (indent defun)) (declare (indent defun))
(when (tp-region-layer-props name start end object) (when (tp-region-layer-props name start end object)
(error "Already exist layer named %S" name)) (error "Already exist layer named %S" name))
(if (tp-empty-p object) (let ((props (tp-layer-properties name)))
(set-text-properties
start end (append properties (list 'tp-name name))
object)
(let ((props (tp-layer-properties name properties)))
(tp-intervals-map (tp-intervals-map
(lambda (i-start i-end top belows) (lambda (i-start i-end top belows)
(set-text-properties (set-text-properties
@ -150,7 +133,7 @@ function 的四个参数分别为:区间开始位置,区间结束位置,顶
(append props (append props
(list 'tp-layers (append (list top) belows))) (list 'tp-layers (append (list top) belows)))
object)) object))
start end object))) start end object))
object) object)
(defun tp-layer-delete (start end name &optional object) (defun tp-layer-delete (start end name &optional object)