diff --git a/tp.el b/tp.el index 5722751..6657629 100644 --- a/tp.el +++ b/tp.el @@ -37,41 +37,18 @@ (push (cons ',name layer-names) tp-layer-groups)) (assoc ',name tp-layer-groups))) -;; ;; FIXME: -;; (defun tp-layer-properties (layer-or-group-or-properties) -;; "如果 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-properties (layer-name) + (when-let ((plist (cdr (assoc layer-name tp-layer-alist)))) + (append plist (list 'tp-name name)))) -(defun tp-layer-properties (name &optional properties) - "如果 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) +(defun tp-layer-group-properties (group-name) "返回使用 `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) (tp-layer-properties layer)) layers))) -;;; tp layer - -(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) +(defun tp-intervals (start end &optional object) "获取 OBJECT 的 start 到 end 范围内文本的所有 text properties。 OBJECT 可以为 buffer 或 string,nil 默认为当前 buffer。 point 从 0 开始。" @@ -98,20 +75,24 @@ function 的四个参数分别为:区间开始位置,区间结束位置,顶 (let* ((interval-start (nth 0 tp)) ;; start from 0 (interval-end (nth 1 tp)) (interval-props (nth 2 tp)) - (top-props (tp--layer-top-props interval-props)) - (below-props-lst (tp--layer-below-props interval-props))) + (top-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 interval-start interval-end 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 的属性列表" (tp-intervals-map (lambda (i-start i-end top belows) (when-let ((props (seq-find (lambda (props) - (equal name (plist-get props 'tp-name))) + (equal layer-name + (plist-get props 'tp-name))) (append (list top) belows)))) (list (+ start i-start) (+ start i-end) props))) start end object)) @@ -131,26 +112,28 @@ function 的四个参数分别为:区间开始位置,区间结束位置,顶 start end object)) object) +;; (if (tp-empty-p object) +;; (set-text-properties +;; start end (append properties (list 'tp-name name)) +;; object) +;; ) + ;;;###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 是 nil,则 `tp-layer-define' 定义的名称为 name 的 layer 设置。" (declare (indent defun)) (when (tp-region-layer-props name start end object) (error "Already exist layer named %S" name)) - (if (tp-empty-p object) - (set-text-properties - start end (append properties (list 'tp-name name)) - object) - (let ((props (tp-layer-properties name properties))) - (tp-intervals-map - (lambda (i-start i-end top belows) - (set-text-properties - (+ start i-start) (+ start i-end) - (append props - (list 'tp-layers (append (list top) belows))) - object)) - start end object))) + (let ((props (tp-layer-properties name))) + (tp-intervals-map + (lambda (i-start i-end top belows) + (set-text-properties + (+ start i-start) (+ start i-end) + (append props + (list 'tp-layers (append (list top) belows))) + object)) + start end object)) object) (defun tp-layer-delete (start end name &optional object)