Separate tp-define-layer and tp-define-layer-group macros
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot]
parent
fd732679a3
commit
b6f3f87925
116
README.md
116
README.md
@ -206,7 +206,8 @@ A complete overview of all tp.el functions organized by category:
|
||||
#### Property Layer Definition Functions
|
||||
| Function | Description |
|
||||
|----------|-------------|
|
||||
| [`tp-define-layer`](#tp-define-layer---define-layers) | Define a layer or layer group |
|
||||
| [`tp-define-layer`](#tp-define-layer---define-single-layer) | Define a single layer |
|
||||
| [`tp-define-layer-group`](#tp-define-layer-group---define-layer-group) | Define a group of layers |
|
||||
| [`tp-layer-props`](#tp-layer-props--tp-group-props) | Get properties for a layer |
|
||||
| [`tp-group-props`](#tp-layer-props--tp-group-props) | Get properties for all layers in a group |
|
||||
| [`tp-undefine-layer`](#tp-undefine-layer--tp-undefine-group) | Remove layer definition |
|
||||
@ -1078,32 +1079,30 @@ The **property layer system** is tp.el's innovative feature that allows stacking
|
||||
|
||||
### Property Layer Definition
|
||||
|
||||
#### `tp-define-layer` - Define Layer(s)
|
||||
#### `tp-define-layer` - Define Single Layer
|
||||
|
||||
Define a single layer or a group of multiple layers.
|
||||
Define a single text property layer. Supports two formats:
|
||||
|
||||
**Single Layer:**
|
||||
**Format 1 - Direct plist:**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer layer-name
|
||||
(face (:background "cyan") line-prefix ">>"))
|
||||
```
|
||||
|
||||
**Multiple Layers (Layer Group):**
|
||||
**Format 2 - With :props keyword (for future extensibility):**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer my-group
|
||||
layer-1 ; Reference existing layer
|
||||
(face (:background "red") line-prefix ">>") ; Anonymous layer
|
||||
(face (:background "green" :weight bold))) ; Another anonymous layer
|
||||
(tp-define-layer layer-name
|
||||
:props (face (:background "cyan") line-prefix ">>"))
|
||||
```
|
||||
|
||||
The first layer in the definition is the top layer (visible by default).
|
||||
If a layer with the same name already exists, it will be overwritten with the new definition.
|
||||
|
||||
**Examples:**
|
||||
|
||||
```elisp
|
||||
;; Define individual layers
|
||||
;; Define individual layers using Format 1 (direct plist)
|
||||
(progn
|
||||
(setq tp-layer-alist nil) ; Reset for clean example
|
||||
(tp-define-layer highlight
|
||||
@ -1111,27 +1110,102 @@ The first layer in the definition is the top layer (visible by default).
|
||||
(tp-layer-props 'highlight))
|
||||
;; => (face (:background "yellow" :foreground "black") tp-name highlight)
|
||||
|
||||
;; Define a layer using Format 2 (:props keyword)
|
||||
(progn
|
||||
(tp-define-layer error
|
||||
(face (:background "red" :foreground "white")
|
||||
help-echo "Error!"))
|
||||
:props (face (:background "red" :foreground "white")
|
||||
help-echo "Error!"))
|
||||
(tp-layer-props 'error))
|
||||
;; => (face (:background "red" :foreground "white") help-echo "Error!" tp-name error)
|
||||
|
||||
;; Redefine an existing layer (overwrites the old definition)
|
||||
(progn
|
||||
(tp-define-layer test-layer (face bold))
|
||||
(tp-define-layer test-layer (face italic)) ; Overwrites
|
||||
(tp-layer-props 'test-layer))
|
||||
;; => (face italic tp-name test-layer)
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
#### `tp-define-layer-group` - Define Layer Group
|
||||
|
||||
Define a group of multiple layers. Supports three formats for each element:
|
||||
|
||||
**Format 1 - Anonymous layers (named as GROUP-NAME-0, GROUP-NAME-1, etc.):**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer-group tp-test-moons
|
||||
(display "🌑" face (:height 1.0))
|
||||
(display "🌘" face (:height 1.5))
|
||||
(display "🌗" face (:height 2.0)))
|
||||
;; Creates layers: tp-test-moons-0, tp-test-moons-1, tp-test-moons-2
|
||||
```
|
||||
|
||||
**Format 2 - Named layers with cons-cell (named as GROUP-NAME-suffix):**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer-group tp-test-moons
|
||||
("新月" . (display "🌑" face (:height 1.0)))
|
||||
("残月" . (display "🌘" face (:height 1.5)))
|
||||
("下弦月" . (display "🌗" face (:height 2.0))))
|
||||
;; Creates layers: tp-test-moons-新月, tp-test-moons-残月, tp-test-moons-下弦月
|
||||
```
|
||||
|
||||
**Format 3 - Named layers with :props keyword (named as GROUP-NAME-suffix):**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer-group tp-test-moons
|
||||
("新月" :props (display "🌑" face (:height 1.0)))
|
||||
("残月" :props (display "🌘" face (:height 1.5)))
|
||||
("下弦月" :props (display "🌗" face (:height 2.0))))
|
||||
;; Creates layers: tp-test-moons-新月, tp-test-moons-残月, tp-test-moons-下弦月
|
||||
```
|
||||
|
||||
You can also reference already-defined layers in a group:
|
||||
|
||||
```elisp
|
||||
(tp-define-layer existing-layer (face bold))
|
||||
(tp-define-layer-group my-group
|
||||
existing-layer ; Reference existing layer
|
||||
(face (:background "red") line-prefix ">>") ; Anonymous layer
|
||||
("named" . (face italic))) ; Named layer
|
||||
```
|
||||
|
||||
If a layer group with the same name already exists, it will be overwritten.
|
||||
The first layer in the definition is the top layer (visible by default).
|
||||
|
||||
**Examples:**
|
||||
|
||||
```elisp
|
||||
;; Define status layers, then group them
|
||||
(progn
|
||||
(setq tp-layer-alist nil)
|
||||
(setq tp-layer-groups nil)
|
||||
(tp-define-layer highlight
|
||||
(face (:background "yellow" :foreground "black")))
|
||||
(tp-define-layer error
|
||||
(face (:background "red" :foreground "white")))
|
||||
(tp-define-layer info
|
||||
(face (:background "blue" :foreground "white")))
|
||||
(tp-layer-props 'info))
|
||||
;; => (face (:background "blue" :foreground "white") tp-name info)
|
||||
|
||||
;; Define a layer group
|
||||
(progn
|
||||
(tp-define-layer status-colors
|
||||
(tp-define-layer-group status-colors
|
||||
highlight
|
||||
error
|
||||
info)
|
||||
(length (tp-group-props 'status-colors)))
|
||||
;; => 3
|
||||
|
||||
;; Define a layer group with named layers
|
||||
(progn
|
||||
(setq tp-layer-alist nil)
|
||||
(setq tp-layer-groups nil)
|
||||
(tp-define-layer-group moon-phases
|
||||
("new" . (display "🌑"))
|
||||
("waxing-crescent" . (display "🌒"))
|
||||
("first-quarter" . (display "🌓"))
|
||||
("full" . (display "🌕")))
|
||||
(tp-layer-props 'moon-phases-full))
|
||||
;; => (display "🌕" tp-name moon-phases-full)
|
||||
```
|
||||
|
||||
---
|
||||
@ -1161,7 +1235,7 @@ Get properties for a layer or all layers in a group.
|
||||
(setq tp-layer-groups nil)
|
||||
(tp-define-layer layer1 (face bold))
|
||||
(tp-define-layer layer2 (face italic))
|
||||
(tp-define-layer my-group layer1 layer2)
|
||||
(tp-define-layer-group my-group layer1 layer2)
|
||||
(length (tp-group-props 'my-group)))
|
||||
;; => 2
|
||||
```
|
||||
@ -1988,7 +2062,7 @@ Return t if OBJECT has no text properties.
|
||||
(tp-define-layer status-todo (face (:foreground "gray")))
|
||||
(tp-define-layer status-progress (face (:foreground "yellow")))
|
||||
(tp-define-layer status-done (face (:foreground "green")))
|
||||
(tp-define-layer task-status status-todo status-progress status-done)
|
||||
(tp-define-layer-group task-status status-todo status-progress status-done)
|
||||
;; Check group is defined
|
||||
(length (tp-group-props 'task-status)))
|
||||
;; => 3
|
||||
|
||||
116
README_CN.md
116
README_CN.md
@ -205,7 +205,8 @@ tp.el 所有函数按类别组织的完整概览：
|
||||
#### 属性层定义函数
|
||||
| 函数 | 描述 |
|
||||
|------|------|
|
||||
| [`tp-define-layer`](#tp-define-layer---定义属性层) | 定义属性层或属性层组 |
|
||||
| [`tp-define-layer`](#tp-define-layer---定义单个属性层) | 定义单个属性层 |
|
||||
| [`tp-define-layer-group`](#tp-define-layer-group---定义属性层组) | 定义属性层组 |
|
||||
| [`tp-layer-props`](#tp-layer-props--tp-group-props) | 获取属性层的属性 |
|
||||
| [`tp-group-props`](#tp-layer-props--tp-group-props) | 获取属性层组中所有属性层的属性 |
|
||||
| [`tp-undefine-layer`](#tp-undefine-layer--tp-undefine-group) | 移除属性层定义 |
|
||||
@ -1075,32 +1076,30 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
|
||||
|
||||
### 属性层定义
|
||||
|
||||
#### `tp-define-layer` - 定义属性层
|
||||
#### `tp-define-layer` - 定义单个属性层
|
||||
|
||||
定义单个属性层或多个属性层组。
|
||||
定义单个文本属性层。支持两种格式：
|
||||
|
||||
**单个属性层：**
|
||||
**格式一 - 直接定义文本属性：**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer layer-name
|
||||
(face (:background "cyan") line-prefix ">>"))
|
||||
```
|
||||
|
||||
**多个属性层（属性层组）：**
|
||||
**格式二 - 使用 :props 关键字（为后续扩展预留）：**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer my-group
|
||||
layer-1 ; 引用已存在的属性层
|
||||
(face (:background "red") line-prefix ">>") ; 匿名属性层
|
||||
(face (:background "green" :weight bold))) ; 另一个匿名属性层
|
||||
(tp-define-layer layer-name
|
||||
:props (face (:background "cyan") line-prefix ">>"))
|
||||
```
|
||||
|
||||
定义中的第一个属性层是顶层（默认可见）。
|
||||
如果同名的层已存在，新定义将覆盖旧定义。
|
||||
|
||||
**示例：**
|
||||
|
||||
```elisp
|
||||
;; 定义单个属性层
|
||||
;; 使用格式一（直接 plist）定义单个属性层
|
||||
(progn
|
||||
(setq tp-layer-alist nil) ; 重置以确保干净的示例
|
||||
(tp-define-layer highlight
|
||||
@ -1108,27 +1107,102 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
|
||||
(tp-layer-props 'highlight))
|
||||
;; => (face (:background "yellow" :foreground "black") tp-name highlight)
|
||||
|
||||
;; 使用格式二（:props 关键字）定义属性层
|
||||
(progn
|
||||
(tp-define-layer error
|
||||
(face (:background "red" :foreground "white")
|
||||
help-echo "错误!"))
|
||||
:props (face (:background "red" :foreground "white")
|
||||
help-echo "错误!"))
|
||||
(tp-layer-props 'error))
|
||||
;; => (face (:background "red" :foreground "white") help-echo "错误!" tp-name error)
|
||||
|
||||
;; 重新定义已存在的属性层（覆盖旧定义）
|
||||
(progn
|
||||
(tp-define-layer test-layer (face bold))
|
||||
(tp-define-layer test-layer (face italic)) ; 覆盖
|
||||
(tp-layer-props 'test-layer))
|
||||
;; => (face italic tp-name test-layer)
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
#### `tp-define-layer-group` - 定义属性层组
|
||||
|
||||
定义包含多个属性层的层组。每个元素支持三种格式：
|
||||
|
||||
**格式一 - 匿名层（命名为 GROUP-NAME-0, GROUP-NAME-1 等）：**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer-group tp-test-moons
|
||||
(display "🌑" face (:height 1.0))
|
||||
(display "🌘" face (:height 1.5))
|
||||
(display "🌗" face (:height 2.0)))
|
||||
;; 创建层: tp-test-moons-0, tp-test-moons-1, tp-test-moons-2
|
||||
```
|
||||
|
||||
**格式二 - 使用 cons-cell 命名层（命名为 GROUP-NAME-suffix）：**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer-group tp-test-moons
|
||||
("新月" . (display "🌑" face (:height 1.0)))
|
||||
("残月" . (display "🌘" face (:height 1.5)))
|
||||
("下弦月" . (display "🌗" face (:height 2.0))))
|
||||
;; 创建层: tp-test-moons-新月, tp-test-moons-残月, tp-test-moons-下弦月
|
||||
```
|
||||
|
||||
**格式三 - 使用 :props 关键字命名层（命名为 GROUP-NAME-suffix）：**
|
||||
|
||||
```elisp
|
||||
(tp-define-layer-group tp-test-moons
|
||||
("新月" :props (display "🌑" face (:height 1.0)))
|
||||
("残月" :props (display "🌘" face (:height 1.5)))
|
||||
("下弦月" :props (display "🌗" face (:height 2.0))))
|
||||
;; 创建层: tp-test-moons-新月, tp-test-moons-残月, tp-test-moons-下弦月
|
||||
```
|
||||
|
||||
你也可以在层组中引用已定义的层：
|
||||
|
||||
```elisp
|
||||
(tp-define-layer existing-layer (face bold))
|
||||
(tp-define-layer-group my-group
|
||||
existing-layer ; 引用已存在的属性层
|
||||
(face (:background "red") line-prefix ">>") ; 匿名属性层
|
||||
("named" . (face italic))) ; 命名属性层
|
||||
```
|
||||
|
||||
如果同名的层组已存在，新定义将覆盖旧定义。
|
||||
定义中的第一个属性层是顶层（默认可见）。
|
||||
|
||||
**示例：**
|
||||
|
||||
```elisp
|
||||
;; 先定义状态层，然后将它们组合成层组
|
||||
(progn
|
||||
(setq tp-layer-alist nil)
|
||||
(setq tp-layer-groups nil)
|
||||
(tp-define-layer highlight
|
||||
(face (:background "yellow" :foreground "black")))
|
||||
(tp-define-layer error
|
||||
(face (:background "red" :foreground "white")))
|
||||
(tp-define-layer info
|
||||
(face (:background "blue" :foreground "white")))
|
||||
(tp-layer-props 'info))
|
||||
;; => (face (:background "blue" :foreground "white") tp-name info)
|
||||
|
||||
;; 定义属性层组
|
||||
(progn
|
||||
(tp-define-layer status-colors
|
||||
(tp-define-layer-group status-colors
|
||||
highlight
|
||||
error
|
||||
info)
|
||||
(length (tp-group-props 'status-colors)))
|
||||
;; => 3
|
||||
|
||||
;; 使用命名层定义层组
|
||||
(progn
|
||||
(setq tp-layer-alist nil)
|
||||
(setq tp-layer-groups nil)
|
||||
(tp-define-layer-group moon-phases
|
||||
("new" . (display "🌑"))
|
||||
("waxing-crescent" . (display "🌒"))
|
||||
("first-quarter" . (display "🌓"))
|
||||
("full" . (display "🌕")))
|
||||
(tp-layer-props 'moon-phases-full))
|
||||
;; => (display "🌕" tp-name moon-phases-full)
|
||||
```
|
||||
|
||||
---
|
||||
@ -1158,7 +1232,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
|
||||
(setq tp-layer-groups nil)
|
||||
(tp-define-layer layer1 (face bold))
|
||||
(tp-define-layer layer2 (face italic))
|
||||
(tp-define-layer my-group layer1 layer2)
|
||||
(tp-define-layer-group my-group layer1 layer2)
|
||||
(length (tp-group-props 'my-group)))
|
||||
;; => 2
|
||||
```
|
||||
@ -1985,7 +2059,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
|
||||
(tp-define-layer status-todo (face (:foreground "gray")))
|
||||
(tp-define-layer status-progress (face (:foreground "yellow")))
|
||||
(tp-define-layer status-done (face (:foreground "green")))
|
||||
(tp-define-layer task-status status-todo status-progress status-done)
|
||||
(tp-define-layer-group task-status status-todo status-progress status-done)
|
||||
;; 检查组是否已定义
|
||||
(length (tp-group-props 'task-status)))
|
||||
;; => 3
|
||||
|
||||
94
tp-tests.el
94
tp-tests.el
@ -220,13 +220,21 @@
|
||||
;;; ============================================================
|
||||
|
||||
(ert-deftest tp-test-define-layer ()
|
||||
"Test tp-define-layer creates a layer."
|
||||
"Test tp-define-layer creates a layer (Format 1 - direct plist)."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer test-layer (face bold help-echo "test"))
|
||||
(should (assoc 'test-layer tp-layer-alist))
|
||||
(should (equal (cdr (assoc 'test-layer tp-layer-alist))
|
||||
'(face bold help-echo "test")))))
|
||||
|
||||
(ert-deftest tp-test-define-layer-with-props ()
|
||||
"Test tp-define-layer with :props keyword (Format 2)."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer test-layer :props (face italic help-echo "props"))
|
||||
(should (assoc 'test-layer tp-layer-alist))
|
||||
(should (equal (cdr (assoc 'test-layer tp-layer-alist))
|
||||
'(face italic help-echo "props")))))
|
||||
|
||||
(ert-deftest tp-test-define-layer-updates-existing ()
|
||||
"Test tp-define-layer updates existing layer."
|
||||
(tp-test-with-temp-buffer
|
||||
@ -235,6 +243,14 @@
|
||||
(should (equal (cdr (assoc 'test-layer tp-layer-alist))
|
||||
'(face italic)))))
|
||||
|
||||
(ert-deftest tp-test-define-layer-updates-existing-with-props ()
|
||||
"Test tp-define-layer with :props updates existing layer."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer test-layer (face bold))
|
||||
(tp-define-layer test-layer :props (face underline))
|
||||
(should (equal (cdr (assoc 'test-layer tp-layer-alist))
|
||||
'(face underline)))))
|
||||
|
||||
(ert-deftest tp-test-layer-props ()
|
||||
"Test tp-layer-props returns properties with tp-name."
|
||||
(tp-test-with-temp-buffer
|
||||
@ -257,14 +273,14 @@
|
||||
(should-not (assoc 'test-layer tp-layer-alist))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Layer Group Tests (using tp-define-layer with multiple layers)
|
||||
;;; Layer Group Tests (using tp-define-layer-group)
|
||||
;;; ============================================================
|
||||
|
||||
(ert-deftest tp-test-define-layer-multiple ()
|
||||
"Test tp-define-layer creates a layer group with multiple layers."
|
||||
(ert-deftest tp-test-define-layer-group-anonymous ()
|
||||
"Test tp-define-layer-group creates a layer group with anonymous layers."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer layer1 (face bold))
|
||||
(tp-define-layer my-group
|
||||
(tp-define-layer-group my-group
|
||||
layer1
|
||||
(face italic)
|
||||
(face underline))
|
||||
@ -272,14 +288,64 @@
|
||||
;; Check all layers are present in the group
|
||||
(let ((layers (cdr (assoc 'my-group tp-layer-groups))))
|
||||
(should (= (length layers) 3))
|
||||
(should (memq 'layer1 layers)))))
|
||||
(should (memq 'layer1 layers))
|
||||
;; Anonymous layers should be named my-group-0 and my-group-1
|
||||
(should (memq 'my-group-0 layers))
|
||||
(should (memq 'my-group-1 layers)))))
|
||||
|
||||
(ert-deftest tp-test-define-layer-group-named-cons ()
|
||||
"Test tp-define-layer-group with named cons-cell format."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer-group my-group
|
||||
("first" . (face bold))
|
||||
("second" . (face italic)))
|
||||
(should (assoc 'my-group tp-layer-groups))
|
||||
(let ((layers (cdr (assoc 'my-group tp-layer-groups))))
|
||||
(should (= (length layers) 2))
|
||||
(should (memq 'my-group-first layers))
|
||||
(should (memq 'my-group-second layers)))
|
||||
;; Check that layers are properly defined
|
||||
(should (equal (cdr (assoc 'my-group-first tp-layer-alist)) '(face bold)))
|
||||
(should (equal (cdr (assoc 'my-group-second tp-layer-alist)) '(face italic)))))
|
||||
|
||||
(ert-deftest tp-test-define-layer-group-named-props ()
|
||||
"Test tp-define-layer-group with :props format."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer-group my-group
|
||||
("first" :props (face bold))
|
||||
("second" :props (face italic)))
|
||||
(should (assoc 'my-group tp-layer-groups))
|
||||
(let ((layers (cdr (assoc 'my-group tp-layer-groups))))
|
||||
(should (= (length layers) 2))
|
||||
(should (memq 'my-group-first layers))
|
||||
(should (memq 'my-group-second layers)))
|
||||
;; Check that layers are properly defined
|
||||
(should (equal (cdr (assoc 'my-group-first tp-layer-alist)) '(face bold)))
|
||||
(should (equal (cdr (assoc 'my-group-second tp-layer-alist)) '(face italic)))))
|
||||
|
||||
(ert-deftest tp-test-define-layer-group-mixed ()
|
||||
"Test tp-define-layer-group with mixed formats."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer existing-layer (face underline))
|
||||
(tp-define-layer-group my-group
|
||||
existing-layer
|
||||
(face bold)
|
||||
("named" . (face italic))
|
||||
("with-props" :props (face strike-through)))
|
||||
(should (assoc 'my-group tp-layer-groups))
|
||||
(let ((layers (cdr (assoc 'my-group tp-layer-groups))))
|
||||
(should (= (length layers) 4))
|
||||
(should (memq 'existing-layer layers))
|
||||
(should (memq 'my-group-0 layers))
|
||||
(should (memq 'my-group-named layers))
|
||||
(should (memq 'my-group-with-props layers)))))
|
||||
|
||||
(ert-deftest tp-test-group-props ()
|
||||
"Test tp-group-props returns all layer properties."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer layer1 (face bold))
|
||||
(tp-define-layer layer2 (face italic))
|
||||
(tp-define-layer my-group layer1 layer2)
|
||||
(tp-define-layer-group my-group layer1 layer2)
|
||||
(let ((props-list (tp-group-props 'my-group)))
|
||||
(should (= (length props-list) 2))
|
||||
;; Check that both layers are present
|
||||
@ -291,17 +357,27 @@
|
||||
"Test tp-undefine-group removes group definition."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer layer1 (face bold))
|
||||
(tp-define-layer my-group layer1)
|
||||
(tp-define-layer-group my-group layer1)
|
||||
(should (assoc 'my-group tp-layer-groups))
|
||||
(tp-undefine-group 'my-group)
|
||||
(should-not (assoc 'my-group tp-layer-groups))))
|
||||
|
||||
(ert-deftest tp-test-layer-group-updates-existing ()
|
||||
"Test tp-define-layer-group updates existing group."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer layer1 (face bold))
|
||||
(tp-define-layer layer2 (face italic))
|
||||
(tp-define-layer-group my-group layer1)
|
||||
(should (= (length (cdr (assoc 'my-group tp-layer-groups))) 1))
|
||||
(tp-define-layer-group my-group layer1 layer2)
|
||||
(should (= (length (cdr (assoc 'my-group tp-layer-groups))) 2))))
|
||||
|
||||
(ert-deftest tp-test-layer-reset ()
|
||||
"Test tp-layer-reset clears all definitions."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-define-layer layer1 (face bold))
|
||||
(tp-define-layer layer2 (face italic))
|
||||
(tp-define-layer group1 layer1 layer2)
|
||||
(tp-define-layer-group group1 layer1 layer2)
|
||||
(should tp-layer-alist)
|
||||
(should tp-layer-groups)
|
||||
(tp-layer-reset)
|
||||
|
||||
188
tp.el
188
tp.el
@ -1511,71 +1511,139 @@ Returns a plist of all properties in the region or string."
|
||||
|
||||
;;; Layer Definition Functions
|
||||
|
||||
(defmacro tp-define-layer (name &rest layers)
|
||||
"Define a text property layer or layer group named NAME.
|
||||
(defmacro tp-define-layer (name &rest args)
|
||||
"Define a single text property layer named NAME.
|
||||
|
||||
Single layer:
|
||||
(tp-define-layer layer-1 \\='(face (:background \"cyan\") line-prefix \">>\"))
|
||||
This macro supports two formats:
|
||||
|
||||
Multiple layers (first defined layer is the top layer):
|
||||
(tp-define-layer layers-2
|
||||
\\='layer-1
|
||||
\\='(face (:background \"red\") line-prefix \">>\")
|
||||
\\='(face (:background \"green\" :weight bold) line-prefix \"::\"))
|
||||
Format 1 - Direct plist:
|
||||
(tp-define-layer layer-name
|
||||
(display \"🌑\" face (:height 1.0)))
|
||||
|
||||
LAYERS can be:
|
||||
- A single plist for a single layer definition
|
||||
- Multiple items where each can be:
|
||||
- A symbol referencing another defined layer
|
||||
- A plist defining an anonymous sub-layer
|
||||
Format 2 - With :props keyword (for future extensibility):
|
||||
(tp-define-layer layer-name
|
||||
:props (display \"🌑\" face (:height 1.0)))
|
||||
|
||||
For multiple layers, they are stored as a group in `tp-layer-groups'.
|
||||
The first layer in the definition is the top layer."
|
||||
If a layer with the same NAME already exists, it will be overwritten
|
||||
with the new definition.
|
||||
|
||||
The layer is stored in `tp-layer-alist'."
|
||||
(declare (indent defun))
|
||||
;; Determine if this is a single layer (one plist argument) or multiple layers
|
||||
(let ((first-layer (car layers)))
|
||||
(let ((is-single-layer
|
||||
(and (= (length layers) 1)
|
||||
first-layer
|
||||
(listp first-layer)
|
||||
;; A plist has an even number of elements (key-value pairs)
|
||||
(cl-evenp (length first-layer))
|
||||
;; The first element is a property name (symbol, not nil)
|
||||
(symbolp (car first-layer)))))
|
||||
(if is-single-layer
|
||||
;; Single layer: (tp-define-layer name '(plist...))
|
||||
(let ((properties first-layer))
|
||||
`(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)))
|
||||
;; Multiple layers: (tp-define-layer name 'layer1 '(plist1) '(plist2) ...)
|
||||
(let ((layer-names nil)
|
||||
(idx 0)
|
||||
(layer-defs nil))
|
||||
(dolist (layer layers)
|
||||
(cond
|
||||
;; Reference to existing layer
|
||||
((symbolp layer)
|
||||
(push layer layer-names))
|
||||
;; Plist layer - create with auto-generated name
|
||||
((listp layer)
|
||||
(let ((sub-name (intern (format "%s-layer-%d" name idx))))
|
||||
(push `(if (assoc ',sub-name tp-layer-alist)
|
||||
(setf (cdr (assoc ',sub-name tp-layer-alist)) ',layer)
|
||||
(push (cons ',sub-name ',layer) tp-layer-alist))
|
||||
layer-defs)
|
||||
(push sub-name layer-names)
|
||||
(cl-incf idx)))))
|
||||
(setq layer-names (nreverse layer-names))
|
||||
(setq layer-defs (nreverse layer-defs))
|
||||
`(progn
|
||||
,@layer-defs
|
||||
(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)))))))
|
||||
(let ((properties
|
||||
(cond
|
||||
;; Format 2: :props (plist)
|
||||
((and (eq (car args) :props)
|
||||
(cadr args))
|
||||
(cadr args))
|
||||
;; Format 1: (plist)
|
||||
((and (= (length args) 1)
|
||||
(listp (car args)))
|
||||
(car args))
|
||||
(t (error "Invalid tp-define-layer format for %s" name)))))
|
||||
`(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))))
|
||||
|
||||
(defun tp--parse-layer-group-element (group-name element idx)
|
||||
"Parse a layer group element and return (layer-name . properties).
|
||||
GROUP-NAME is the name of the layer group.
|
||||
ELEMENT is the element to parse (can be anonymous plist, cons-cell, or :props form).
|
||||
IDX is the index for anonymous elements.
|
||||
|
||||
Returns a cons cell (LAYER-NAME . PROPERTIES) or a symbol if ELEMENT
|
||||
references an already-defined layer."
|
||||
(cond
|
||||
;; Case: already defined layer (symbol)
|
||||
((symbolp element)
|
||||
element)
|
||||
;; Case: Format 3 - ("name" :props (plist...))
|
||||
((and (listp element)
|
||||
(stringp (car element))
|
||||
(eq (cadr element) :props)
|
||||
(caddr element))
|
||||
(let* ((layer-suffix (car element))
|
||||
(layer-name (intern (format "%s-%s" group-name layer-suffix)))
|
||||
(props (caddr element)))
|
||||
(cons layer-name props)))
|
||||
;; Case: Format 2 - ("name" . (plist...)) - cons cell
|
||||
((and (consp element)
|
||||
(stringp (car element))
|
||||
(listp (cdr element)))
|
||||
(let* ((layer-suffix (car element))
|
||||
(layer-name (intern (format "%s-%s" group-name layer-suffix)))
|
||||
(props (cdr element)))
|
||||
(cons layer-name props)))
|
||||
;; Case: Format 1 - (plist...) - anonymous, use index
|
||||
((and (listp element)
|
||||
(not (stringp (car element))))
|
||||
(let ((layer-name (intern (format "%s-%d" group-name idx))))
|
||||
(cons layer-name element)))
|
||||
(t (error "Invalid layer group element: %S" element))))
|
||||
|
||||
(defmacro tp-define-layer-group (name &rest elements)
|
||||
"Define a layer group named NAME containing multiple layers.
|
||||
|
||||
This macro supports three formats for each element:
|
||||
|
||||
Format 1 - Anonymous layers (named as NAME-0, NAME-1, etc.):
|
||||
(tp-define-layer-group group-name
|
||||
(display \"🌑\" face (:height 1.0))
|
||||
(display \"🌘\" face (:height 1.5))
|
||||
(display \"🌗\" face (:height 2.0)))
|
||||
|
||||
Format 2 - Named layers with cons-cell (named as NAME-suffix):
|
||||
(tp-define-layer-group group-name
|
||||
(\"新月\" . (display \"🌑\" face (:height 1.0)))
|
||||
(\"残月\" . (display \"🌘\" face (:height 1.5)))
|
||||
(\"下弦月\" . (display \"🌗\" face (:height 2.0))))
|
||||
|
||||
Format 3 - Named layers with :props keyword (named as NAME-suffix):
|
||||
(tp-define-layer-group group-name
|
||||
(\"新月\" :props (display \"🌑\" face (:height 1.0)))
|
||||
(\"残月\" :props (display \"🌘\" face (:height 1.5)))
|
||||
(\"下弦月\" :props (display \"🌗\" face (:height 2.0))))
|
||||
|
||||
You can also reference already-defined layers by their symbol name:
|
||||
(tp-define-layer-group group-name
|
||||
existing-layer-1
|
||||
existing-layer-2
|
||||
(display \"🌗\" face (:height 2.0)))
|
||||
|
||||
If a layer group with the same NAME already exists, it will be overwritten.
|
||||
Individual layers created by the group are stored in `tp-layer-alist',
|
||||
and the group itself is stored in `tp-layer-groups'."
|
||||
(declare (indent defun))
|
||||
(let ((layer-names nil)
|
||||
(layer-defs nil)
|
||||
(idx 0))
|
||||
(dolist (element elements)
|
||||
(let ((parsed (tp--parse-layer-group-element name element idx)))
|
||||
(cond
|
||||
;; Reference to existing layer (symbol)
|
||||
((symbolp parsed)
|
||||
(push parsed layer-names))
|
||||
;; New layer definition (cons cell of name . props)
|
||||
((consp parsed)
|
||||
(let ((layer-name (car parsed))
|
||||
(props (cdr parsed)))
|
||||
(push `(if (assoc ',layer-name tp-layer-alist)
|
||||
(setf (cdr (assoc ',layer-name tp-layer-alist)) ',props)
|
||||
(push (cons ',layer-name ',props) tp-layer-alist))
|
||||
layer-defs)
|
||||
(push layer-name layer-names)
|
||||
;; Only increment idx for anonymous (Format 1) elements
|
||||
(unless (and (listp element) (stringp (car element)))
|
||||
(cl-incf idx)))))))
|
||||
(setq layer-names (nreverse layer-names))
|
||||
(setq layer-defs (nreverse layer-defs))
|
||||
`(progn
|
||||
,@layer-defs
|
||||
(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))))
|
||||
|
||||
(defun tp-layer-props (layer-name)
|
||||
"Return properties for layer LAYER-NAME from `tp-layer-alist'.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user