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

Refactor tp-define-layer to define-tp/define-tps format with updated tests and documentation

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2026-01-04 10:23:47 +00:00
parent f7df396a15
commit fdaa2b0c54
3 changed files with 398 additions and 480 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

455
README_CN.md
View File

@ -53,11 +53,10 @@
- [tp-search](#tp-search---搜索所有匹配) - [tp-search](#tp-search---搜索所有匹配)
- [tp-search-map](#tp-search-map---对匹配文本应用函数) - [tp-search-map](#tp-search-map---对匹配文本应用函数)
- [属性层系统](#属性层系统) - [属性层系统](#属性层系统)
- [自定义文本属性与文本属性层](#自定义文本属性与文本属性层)
- [属性层概念](#属性层概念) - [属性层概念](#属性层概念)
- [属性层定义](#属性层定义) - [属性层定义](#属性层定义)
- [tp-define-layer](#tp-define-layer---定义单个属性层) - [define-tp / define-tps](#define-tp--define-tps---定义自定义文本属性)
- [tp-define-layer-group](#tp-define-layer-group---定义属性层组)
- [define-tp / define-tp-group](#define-tp--define-tp-group---便捷宏)
- [tp-layer-props / tp-group-props](#tp-layer-props--tp-group-props) - [tp-layer-props / tp-group-props](#tp-layer-props--tp-group-props)
- [tp-undefine-layer / tp-undefine-group](#tp-undefine-layer--tp-undefine-group) - [tp-undefine-layer / tp-undefine-group](#tp-undefine-layer--tp-undefine-group)
- [tp-layer-reset](#tp-layer-reset) - [tp-layer-reset](#tp-layer-reset)
@ -210,7 +209,7 @@
**这是 tp.el 最具创新性的功能**，原生 Emacs 完全不支持。属性层系统允许在同一文本区域上堆叠多组属性： **这是 tp.el 最具创新性的功能**，原生 Emacs 完全不支持。属性层系统允许在同一文本区域上堆叠多组属性：
- ✅ **属性层栈概念**：多个属性层像栈一样堆叠，只有顶层可见，下层被保留 - ✅ **属性层栈概念**：多个属性层像栈一样堆叠，只有顶层可见，下层被保留
- ✅ **属性层定义与复用**：通过 `tp-define-layer` 定义可复用的属性层和属性层组 - ✅ **属性层定义与复用**：通过 `define-tp` 定义可复用的自定义文本属性和属性层
- ✅ **丰富的属性层操作**： - ✅ **丰富的属性层操作**：
- 放置：`tp-put-layer`（指定位置）、`tp-push-layer`（顶部） - 放置：`tp-put-layer`（指定位置）、`tp-push-layer`（顶部）
- 删除：`tp-delete-layer`（按名称/索引）、`tp-pop-layer`（顶层） - 删除：`tp-delete-layer`（按名称/索引）、`tp-pop-layer`（顶层）
@ -220,8 +219,8 @@
```elisp ```elisp
;; 属性层使用示例 ;; 属性层使用示例
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(tp-define-layer 'error '(face (:foreground "red"))) (define-tp error () '(face (:foreground "red")))
;; 堆叠多个属性层 ;; 堆叠多个属性层
(tp-push-layer 1 10 'highlight) (tp-push-layer 1 10 'highlight)
@ -264,8 +263,9 @@
;; 定义一个带响应式属性的层 ;; 定义一个带响应式属性的层
(defvar my-color "red") ;; 响应式变量 (defvar my-color "red") ;; 响应式变量
(tp-define-layer 'my-highlight ;; 使用 define-tp 定义自定义文本属性（推荐方式）
:props '(face (:foreground $my-color))) (define-tp my-highlight ()
'(face (:foreground $my-color)))
;; 应用该层 ;; 应用该层
(tp-push-layer 1 10 'my-highlight) (tp-push-layer 1 10 'my-highlight)
@ -273,7 +273,9 @@
;; 之后只需改变变量 - 文本自动更新！ ;; 之后只需改变变量 - 文本自动更新！
(setq my-color "blue") ;; 所有 my-highlight 层的文本自动变成蓝色！ (setq my-color "blue") ;; 所有 my-highlight 层的文本自动变成蓝色！
;; 高级示例：使用 :data、:compute 和 :watch ;; 高级响应式示例（使用内部函数 tp-define-layer）：
;; 对于需要 :data、:compute、:watch 等高级特性的场景，
;; 可以使用内部函数 tp-define-layer
(tp-define-layer 'full-name-layer (tp-define-layer 'full-name-layer
:props '(help-echo $full-name face (:foreground $name-color)) :props '(help-echo $full-name face (:foreground $name-color))
:data '((first-name . "John") (last-name . "Doe")) ;; 带初始值 :data '((first-name . "John") (last-name . "Doe")) ;; 带初始值
@ -361,10 +363,8 @@ tp.el 所有函数按类别组织的完整概览：
#### 属性层定义函数 #### 属性层定义函数
| 函数 | 描述 | | 函数 | 描述 |
|------|------| |------|------|
| [`tp-define-layer`](#tp-define-layer---定义单个属性层) | 定义单个属性层，支持响应式特性（:props、:data、:watch、:compute） | | [`define-tp`](#define-tp--define-tps---定义自定义文本属性) | 定义自定义文本属性（层），支持参数化 |
| [`tp-define-layer-group`](#tp-define-layer-group---定义属性层组) | 定义属性层组，支持响应式特性 | | [`define-tps`](#define-tp--define-tps---定义自定义文本属性) | 定义自定义文本属性组（层组），支持参数化 |
| [`define-tp`](#define-tp--define-tp-group---便捷宏) | 定义属性层的便捷宏（支持参数化属性层） |
| [`define-tp-group`](#define-tp--define-tp-group---便捷宏) | 定义属性层组的便捷宏 |
| [`tp-layer-props`](#tp-layer-props--tp-group-props) | 获取属性层的属性 | | [`tp-layer-props`](#tp-layer-props--tp-group-props) | 获取属性层的属性 |
| [`tp-group-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) | 移除属性层定义 | | [`tp-undefine-layer`](#tp-undefine-layer--tp-undefine-group) | 移除属性层定义 |
@ -444,7 +444,7 @@ tp.el 所有函数按类别组织的完整概览：
(tp-set STRING LAYER-NAME) (tp-set STRING LAYER-NAME)
``` ```
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
**示例：** **示例：**
@ -517,7 +517,7 @@ LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-def
(tp-reset STRING PROPERTY VALUE ...) (tp-reset STRING PROPERTY VALUE ...)
``` ```
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
**示例：** **示例：**
@ -555,7 +555,7 @@ LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-def
(tp-add STRING PROPERTY VALUE ...) (tp-add STRING PROPERTY VALUE ...)
``` ```
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
**示例：** **示例：**
@ -861,7 +861,7 @@ LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-def
在所有字符串模式匹配处设置属性。 在所有字符串模式匹配处设置属性。
PATTERN 可以是字符串（单个模式）或字符串列表（多个模式）。 PATTERN 可以是字符串（单个模式）或字符串列表（多个模式）。
PLIST 是属性列表，如 `'(face bold help-echo "tip")`。 PLIST 是属性列表，如 `'(face bold help-echo "tip")`。
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。 OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
**示例：** **示例：**
@ -903,7 +903,7 @@ OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
重置（完全替换）匹配处的所有属性。 重置（完全替换）匹配处的所有属性。
PATTERN 可以是字符串或字符串列表（多个模式）。 PATTERN 可以是字符串或字符串列表（多个模式）。
PLIST 是属性列表，如 `'(face bold help-echo "tip")`。 PLIST 是属性列表，如 `'(face bold help-echo "tip")`。
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。 OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
```elisp ```elisp
@ -944,7 +944,7 @@ OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
在匹配处添加/合并属性，支持深度合并。 在匹配处添加/合并属性，支持深度合并。
PATTERN 可以是字符串或字符串列表（多个模式）。 PATTERN 可以是字符串或字符串列表（多个模式）。
PLIST 是属性列表，如 `'(face bold help-echo "tip")`。 PLIST 是属性列表，如 `'(face bold help-echo "tip")`。
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。 OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
```elisp ```elisp
@ -990,7 +990,7 @@ OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
在所有正则表达式匹配处设置属性。 在所有正则表达式匹配处设置属性。
PATTERN 可以是字符串（单个正则）或字符串列表（多个正则）。 PATTERN 可以是字符串（单个正则）或字符串列表（多个正则）。
PLIST 是属性列表，如 `'(face bold help-echo "tip")`。 PLIST 是属性列表，如 `'(face bold help-echo "tip")`。
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。 OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
**示例：** **示例：**
@ -1027,7 +1027,7 @@ OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
重置（完全替换）正则匹配处的所有属性。 重置（完全替换）正则匹配处的所有属性。
PATTERN 可以是字符串或字符串列表（多个正则）。 PATTERN 可以是字符串或字符串列表（多个正则）。
PLIST 是属性列表，如 `'(face bold help-echo "tip")`。 PLIST 是属性列表，如 `'(face bold help-echo "tip")`。
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。 OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
```elisp ```elisp
@ -1069,7 +1069,7 @@ OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
在正则匹配处添加/合并属性，支持深度合并。 在正则匹配处添加/合并属性，支持深度合并。
PATTERN 可以是字符串或字符串列表（多个正则）。 PATTERN 可以是字符串或字符串列表（多个正则）。
PLIST 是属性列表，如 `'(face bold help-echo "tip")`。 PLIST 是属性列表，如 `'(face bold help-echo "tip")`。
LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-define-layer-group` 定义的层组名称。 LAYER-NAME 可以是通过 `define-tp` 定义的自定义文本属性名称或通过 `define-tps` 定义的属性组名称。
OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。 OBJECT 是缓冲区或字符串；nil 表示当前缓冲区。
```elisp ```elisp
@ -1339,6 +1339,40 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
属性层系统是 tp.el 的创新功能，允许在同一文本区域堆叠多组属性。只有顶层属性可见，但下层属性会被保留，并可通过轮转或固定操作使其显现。 属性层系统是 tp.el 的创新功能，允许在同一文本区域堆叠多组属性。只有顶层属性可见，但下层属性会被保留，并可通过轮转或固定操作使其显现。
### 自定义文本属性与文本属性层
tp.el 统一了"自定义文本属性"和"文本属性层"两个概念：
#### 概念辨析
1. **自定义文本属性**：使用 `define-tp` 定义的文本属性，当使用 `tp-set`/`tp-reset`/`tp-add` 设置时，被认为是普通文本属性，可以和 Emacs 内置的文本属性（如 `face`、`display` 等）混合使用。
2. **文本属性层**：同样使用 `define-tp` 定义，但当使用 `tp-put-layer`/`tp-push-layer` 设置时，会引入层相关的属性（如 `tp-name`、`tp-layers`），支持层的堆叠和操作。
3. **自定义文本属性组**：使用 `define-tps` 定义多个相关的文本属性，它们可以单独使用，也可以作为一组使用。
#### 定义与使用
```elisp
;; 定义自定义文本属性（层）
(define-tp tp-highlight ()
'(face (:background "yellow")))
;; 作为普通文本属性使用（不引入 tp-name 等层属性）
(tp-set 1 10 '(tp-highlight t))
;; 结果: 只有 face 属性，没有 tp-name
;; 作为文本属性层使用（引入层相关属性）
(tp-push-layer 1 10 'tp-highlight)
;; 结果: 同时有 face 和 tp-name 属性，支持层操作
```
#### 何时使用哪种方式
- **`tp-set`/`tp-reset`/`tp-add`**：当你只需要设置文本属性，不需要层堆叠功能时使用。适合简单的属性设置场景。
- **`tp-push-layer`/`tp-put-layer`**：当你需要在同一文本区域堆叠多组属性，并进行轮换、删除等层操作时使用。
### 属性层概念 ### 属性层概念
┌─────────────────────────────┐ ┌─────────────────────────────┐
@ -1351,136 +1385,113 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
### 属性层定义 ### 属性层定义
#### `tp-define-layer` - 定义单个属性层 #### `define-tp` / `define-tps` - 定义自定义文本属性
定义单个文本属性层。支持多种格式： ##### `define-tp` - 定义单个自定义文本属性（层）
**格式一 - 直接定义文本属性（不支持响应式特性）：** 定义自定义文本属性，名称无需单引号引用。支持两种格式：
**格式一 - 无参数（空参数列表）：**
```elisp ```elisp
(tp-define-layer 'layer-name (define-tp tp-bold ()
'(face (:background "cyan") line-prefix ">>")) '(face bold))
;; 用法:
(tp-set "emacs" 'tp-bold t)
(tp-set 0 5 '(tp-bold t) "emacs")
``` ```
**格式二 - 使用 :props、:data、:watch 和/或 :compute（Vue 3 风格响应式）：** **格式二 - 有参数（带单个参数）：**
```elisp ```elisp
(tp-define-layer 'layer-name (define-tp tp-space (pixel)
;; props: $前缀的符号是响应式变量；如果未绑定会自动定义 `(display (space :width (,pixel))))
:props '(face (:foreground $my-color) help-echo $full-name)
;; data: 不在 props 中使用的额外响应式变量；可以包含初始值 ;; 用法:
:data '((first-name . "John") (last-name . "Doe")) (tp-set "emacs" 'tp-space 2)
;; compute: (变量名 函数) 列表 - 计算响应式变量的值 (tp-set 0 5 '(tp-space 2) "emacs")
:compute '((full-name (lambda () (concat first-name " " last-name))))
;; watch: (变量名 回调函数) 列表 - 变量变化时的副作用
:watch '((my-color (lambda (new old layer)
(message "颜色从 %s 改为 %s" old new)))))
``` ```
**响应式变量：** ##### `define-tps` - 定义自定义文本属性组（层组）
如果 `:props` 中的任何符号以 `$` 开头，它将被视为响应式变量。`:data` 中的变量也是响应式的。所有响应式变量如果尚未绑定会自动定义为全局变量。 定义多个相关的自定义文本属性，名称无需单引号引用。属性组中定义的文本属性可以单独使用，也可以使用组名称来设置多层。
- **:data** - 变量符号列表（或 `(符号 . 初始值)` cons cell），用于不在 `:props` 中直接使用的额外响应式状态。 **格式一 - 无参数（空参数列表）：**
- **:compute** - `(变量符号 计算函数)` 对的列表。计算函数会被求值以获得变量值，可以引用其他响应式变量。
- **:watch** - `(变量符号 回调函数)` 对的列表。当变量改变时回调函数会被调用，接收 `(新值 旧值 层名)`。
**注意：** 使用 `:watch`、`:compute` 或 `:data` 时，必须使用 `:props` 显式指定文本属性。 ```elisp
(define-tps tp-moon-phases ()
'(display "🌑")
'(display "🌕"))
如果同名的层已存在，新定义将覆盖旧定义。 ;; 用法:
(tp-set 1 6 'tp-moon-phases)
```
**格式二 - 有参数（带单个参数）：**
```elisp
(define-tps tp-themed-status (color)
`(("success" . (face (:foreground ,color))))
'("warning" . (face (:foreground "orange"))))
;; 用法:
;; 层组可以使用参数创建相关的层
```
**支持的层定义格式：**
每个元素可以是以下格式之一：
1. **匿名层**（命名为 NAME-0, NAME-1 等）:
```elisp
'(face (:background "yellow"))
```
2. **使用 cons-cell 命名层**（命名为 NAME-suffix）:
```elisp
'("highlight" . (face (:background "yellow")))
```
3. **使用 :props 关键字命名层**:
```elisp
'("highlight" :props (face (:background "yellow")))
```
4. **带响应式特性的命名层**（:props、:data、:watch、:compute）:
```elisp
'("reactive" :props (face (:foreground $my-color))
:data ((my-color . "red"))
:watch ((my-color (lambda (new old layer) (message "Changed!")))))
```
**示例：** **示例：**
```elisp ```elisp
;; 使用格式一（直接 plist）定义单个属性层 ;; 定义无参数的自定义文本属性
(progn (define-tp tp-highlight ()
(setq tp-layer-alist nil) ; 重置以确保干净的示例 '(face (:background "yellow")))
(tp-define-layer 'highlight
'(face (:background "yellow" :foreground "black")))
(tp-layer-props 'highlight))
;; => (face (:background "yellow" :foreground "black") tp-name highlight)
;; 定义响应式属性层 ;; 定义有参数的自定义文本属性
(progn (define-tp tp-color (color)
(tp-layer-reset) `(face (:foreground ,color)))
(defvar theme-color "blue")
(tp-define-layer 'themed-layer
:props '(face (:foreground $theme-color)))
;; 应用该层
(with-temp-buffer
(insert "Hello World")
(tp-push-layer 1 10 'themed-layer)
;; 之后改变变量 - 文本自动更新！
(setq theme-color "red")
(tp-at 1 'face)))
;; => (:foreground "red")
;; 重新定义已存在的属性层（覆盖旧定义） ;; 定义属性组
(progn (define-tps tp-status ()
(tp-define-layer 'test-layer '(face bold)) '("success" . (face (:foreground "green")))
(tp-define-layer 'test-layer '(face italic)) ; 覆盖 '("warning" . (face (:foreground "orange")))
(tp-layer-props 'test-layer)) '("error" . (face (:foreground "red"))))
;; => (face italic tp-name test-layer)
;; 使用自定义文本属性
(tp-set "Hello" 'tp-highlight t) ; 无参数
(tp-set "Hello" 'tp-color "blue") ; 有参数
(tp-set 1 6 'tp-status) ; 使用层组
;; 作为层使用（支持堆叠操作）
(tp-push-layer 1 10 'tp-highlight)
``` ```
--- ---
#### `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-下弦月
```
**格式四 - 使用 :props、:data、:watch 和/或 :compute 的命名层（Vue 3 风格响应式）：**
```elisp
(tp-define-layer-group 'reactive-group
'("reactive" :props (face (:foreground $my-color) help-echo $full-name)
:data ((first-name . "John") (last-name . "Doe"))
:compute ((full-name (lambda () (concat first-name " " last-name))))
:watch ((my-color (lambda (new old layer) (message "改变了！"))))))
;; 创建层: reactive-group-reactive，具有完整的响应式支持
```
你也可以在层组中引用已定义的层：
```elisp
(tp-define-layer 'existing-layer '(face bold))
(tp-define-layer-group 'my-group
'existing-layer ; 引用已存在的属性层
'(face (:background "red") line-prefix ">>") ; 匿名属性层
'("named" . (face italic))) ; 命名属性层
```
如果同名的层组已存在，新定义将覆盖旧定义。
定义中的第一个属性层是顶层（默认可见）。 定义中的第一个属性层是顶层（默认可见）。
**示例：** **示例：**
@ -1490,13 +1501,14 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
(progn (progn
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'highlight (define-tp highlight ()
'(face (:background "yellow" :foreground "black"))) '(face (:background "yellow" :foreground "black")))
(tp-define-layer 'error (define-tp error ()
'(face (:background "red" :foreground "white"))) '(face (:background "red" :foreground "white")))
(tp-define-layer 'info (define-tp info ()
'(face (:background "blue" :foreground "white"))) '(face (:background "blue" :foreground "white")))
(tp-define-layer-group 'status-colors 'highlight 'error 'info) (define-tps status-colors ()
'highlight 'error 'info)
(length (tp-group-props 'status-colors))) (length (tp-group-props 'status-colors)))
;; => 3 ;; => 3
@ -1504,7 +1516,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
(progn (progn
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer-group 'moon-phases (define-tps moon-phases ()
'("new" . (display "🌑")) '("new" . (display "🌑"))
'("waxing-crescent" . (display "🌒")) '("waxing-crescent" . (display "🌒"))
'("first-quarter" . (display "🌓")) '("first-quarter" . (display "🌓"))
@ -1515,66 +1527,6 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
--- ---
#### `define-tp` / `define-tp-group` - 便捷宏
`define-tp` 和 `define-tp-group` 是便捷宏，为 `tp-define-layer` 和 `tp-define-layer-group` 提供更简洁的语法。
**`define-tp` - 定义单个属性层**
支持两种格式：
**格式一 - 无参数（空参数列表）：**
```elisp
(define-tp tp-bold ()
'(face bold))
```
**格式二 - 有参数（带单个参数）：**
```elisp
(define-tp tp-space (pixel)
`(display (space :width (,pixel))))
```
**`tp-set` 用法：**
对于无参数属性层，使用 `t` 作为值：
```elisp
;; 整个字符串
(tp-set "emacs" 'tp-bold t)
;; => #("emacs" 0 5 (tp-name tp-bold face bold))
;; 区域（使用类似 plist 的格式）
(tp-set 0 5 '(tp-bold t) "emacs")
;; => #("emacs" 0 5 (tp-name tp-bold face bold))
```
对于有参数属性层，传递参数值：
```elisp
;; 整个字符串
(tp-set "emacs" 'tp-space 2)
;; => #("emacs" 0 5 (tp-name tp-space display (space :width (2))))
;; 区域（使用类似 plist 的格式）
(tp-set 0 5 '(tp-space 2) "emacs")
;; => #("emacs" 0 5 (tp-name tp-space display (space :width (2))))
```
**`define-tp-group` - 定义属性层组**
包装 `tp-define-layer-group` 的便捷宏：
```elisp
(define-tp-group tp-moon-phases
'(display "🌑")
'(display "🌕"))
```
---
#### `tp-layer-props` / `tp-group-props` #### `tp-layer-props` / `tp-group-props`
```elisp ```elisp
@ -1590,7 +1542,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 获取属性层属性 ;; 获取属性层属性
(progn (progn
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(tp-define-layer 'my-layer '(face bold help-echo "tip")) (define-tp my-layer ()
'(face bold help-echo "tip"))
(tp-layer-props 'my-layer)) (tp-layer-props 'my-layer))
;; => (face bold help-echo "tip" tp-name my-layer) ;; => (face bold help-echo "tip" tp-name my-layer)
@ -1598,9 +1551,12 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
(progn (progn
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 ()
(tp-define-layer 'layer2 '(face italic)) '(face bold))
(tp-define-layer-group 'my-group 'layer1 'layer2) (define-tp layer2 ()
'(face italic))
(define-tps my-group ()
'layer1 'layer2)
(length (tp-group-props 'my-group))) (length (tp-group-props 'my-group)))
;; => 2 ;; => 2
``` ```
@ -1622,7 +1578,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 取消定义属性层 ;; 取消定义属性层
(progn (progn
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(tp-define-layer 'temp-layer '(face bold)) (define-tp temp-layer ()
'(face bold))
(tp-undefine-layer 'temp-layer) (tp-undefine-layer 'temp-layer)
(tp-layer-props 'temp-layer)) (tp-layer-props 'temp-layer))
;; => nil ;; => nil
@ -1652,7 +1609,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
```elisp ```elisp
(progn (progn
(tp-define-layer 'test-layer '(face bold)) (define-tp test-layer () '(face bold))
(tp-layer-reset) (tp-layer-reset)
(list tp-layer-alist tp-layer-groups)) (list tp-layer-alist tp-layer-groups))
;; => (nil nil) ;; => (nil nil)
@ -1711,8 +1668,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将 base 属性层放在顶部 ;; 将 base 属性层放在顶部
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put-layer 1 10 'base 0) (tp-put-layer 1 10 'base 0)
@ -1722,8 +1679,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将 highlight 放在索引 1（顶部下面） ;; 将 highlight 放在索引 1（顶部下面）
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put-layer 1 10 'base 0) (tp-put-layer 1 10 'base 0)
@ -1734,7 +1691,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将属性层放在底部 ;; 将属性层放在底部
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(tp-define-layer 'info '(face (:foreground "blue"))) (tp-define-layer 'info '(face (:foreground "blue")))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
@ -1764,8 +1721,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 首先推入 base 属性层 ;; 首先推入 base 属性层
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'base) (tp-push-layer 1 10 'base)
@ -1775,8 +1732,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将 highlight 推到顶部（现在可见） ;; 将 highlight 推到顶部（现在可见）
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'base) (tp-push-layer 1 10 'base)
@ -1807,8 +1764,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 按名称删除 ;; 按名称删除
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'base) (tp-push-layer 1 10 'base)
@ -1820,8 +1777,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 删除顶层（idx=0） ;; 删除顶层（idx=0）
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -1833,8 +1790,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 删除底层 ;; 删除底层
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -1863,8 +1820,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
```elisp ```elisp
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -1903,9 +1860,9 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将索引 2 的层移动到索引 0（顶部） ;; 将索引 2 的层移动到索引 0（顶部）
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -1919,8 +1876,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 按名称移动层到底部 ;; 按名称移动层到底部
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -1933,8 +1890,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 在字符串上移动 ;; 在字符串上移动
(let ((str (copy-sequence "Hello"))) (let ((str (copy-sequence "Hello")))
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer str 'layer1) (tp-push-layer str 'layer1)
(tp-push-layer str 'layer2) (tp-push-layer str 'layer2)
;; layer2 在顶部 ;; layer2 在顶部
@ -1963,9 +1920,9 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将 layer1 上移 2 个位置（到顶部） ;; 将 layer1 上移 2 个位置（到顶部）
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -1979,8 +1936,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将索引 0 的属性层下移 1 个位置 ;; 将索引 0 的属性层下移 1 个位置
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -2011,8 +1968,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 堆栈: highlight (顶) -> base (底) ;; 堆栈: highlight (顶) -> base (底)
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'base) (tp-push-layer 1 10 'base)
@ -2044,8 +2001,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将 'base 设为顶层 ;; 将 'base 设为顶层
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'base) (tp-push-layer 1 10 'base)
@ -2076,8 +2033,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 交换 layer1 和 layer2 ;; 交换 layer1 和 layer2
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -2111,7 +2068,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将 layer1 和 layer2 合并为 merged-layer ;; 将 layer1 和 layer2 合并为 merged-layer
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(help-echo "tip")) (tp-define-layer 'layer2 '(help-echo "tip"))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
@ -2124,7 +2081,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 按索引合并 ;; 按索引合并
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(help-echo "tip")) (tp-define-layer 'layer2 '(help-echo "tip"))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
@ -2155,7 +2112,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 将所有属性层扁平化为 'flat-layer ;; 将所有属性层扁平化为 'flat-layer
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(help-echo "tip")) (tp-define-layer 'layer2 '(help-echo "tip"))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
@ -2168,7 +2125,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
;; 使用 nil 名称扁平化（无名属性层） ;; 使用 nil 名称扁平化（无名属性层）
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -2194,8 +2151,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
```elisp ```elisp
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(tp-define-layer 'base '(face default)) (define-tp base () '(face default))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'base) (tp-push-layer 1 10 'base)
@ -2219,8 +2176,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
```elisp ```elisp
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -2244,7 +2201,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
```elisp ```elisp
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -2268,8 +2225,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
```elisp ```elisp
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(with-temp-buffer (with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-push-layer 1 10 'layer1) (tp-push-layer 1 10 'layer1)
@ -2336,8 +2293,8 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
```elisp ```elisp
(let ((str (copy-sequence "Hello World"))) (let ((str (copy-sequence "Hello World")))
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer 0 5 'layer1 str) (tp-push-layer 0 5 'layer1 str)
(tp-push-layer 0 5 'layer2 str) (tp-push-layer 0 5 'layer2 str)
;; 向所有层添加下划线 ;; 向所有层添加下划线
@ -2416,7 +2373,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
```elisp ```elisp
(progn (progn
(tp-layer-reset) (tp-layer-reset)
(tp-define-layer 'highlight '(face (:background "yellow"))) (define-tp highlight () '(face (:background "yellow")))
(with-temp-buffer (with-temp-buffer
(insert "Hello World Test") (insert "Hello World Test")
(tp-push-layer 1 6 'highlight) (tp-push-layer 1 6 'highlight)

335
tp-tests.el
View File

@ -217,45 +217,14 @@
(should (>= (length intervals) 2))))) (should (>= (length intervals) 2)))))
;;; ============================================================ ;;; ============================================================
;;; Layer Definition Tests ;;; Layer Definition Tests (using define-tp)
;;; ============================================================ ;;; ============================================================
(ert-deftest tp-test-define-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
(tp-define-layer 'test-layer '(face bold))
(tp-define-layer 'test-layer '(face italic))
(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 () (ert-deftest tp-test-layer-props ()
"Test tp-layer-props returns properties, and tp-name when requested." "Test tp-layer-props returns properties, and tp-name when requested."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(tp-define-layer 'my-layer '(face bold)) (define-tp my-layer ()
'(face bold))
;; Without tp-name (default for direct property setting) ;; Without tp-name (default for direct property setting)
(let ((props (tp-layer-props 'my-layer))) (let ((props (tp-layer-props 'my-layer)))
(should (eq (plist-get props 'face) 'bold)) (should (eq (plist-get props 'face) 'bold))
@ -273,85 +242,26 @@
(ert-deftest tp-test-layer-undefine () (ert-deftest tp-test-layer-undefine ()
"Test tp-undefine-layer removes layer definition." "Test tp-undefine-layer removes layer definition."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(tp-define-layer 'test-layer '(face bold)) (define-tp test-layer ()
'(face bold))
(should (assoc 'test-layer tp-layer-alist)) (should (assoc 'test-layer tp-layer-alist))
(tp-undefine-layer 'test-layer) (tp-undefine-layer 'test-layer)
(should-not (assoc 'test-layer tp-layer-alist)))) (should-not (assoc 'test-layer tp-layer-alist))))
;;; ============================================================ ;;; ============================================================
;;; Layer Group Tests (using tp-define-layer-group) ;;; Layer Group Tests (using define-tps)
;;; ============================================================ ;;; ============================================================
(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-group 'my-group
'layer1
'(face italic)
'(face underline))
(should (assoc 'my-group tp-layer-groups))
;; 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))
;; 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 () (ert-deftest tp-test-group-props ()
"Test tp-group-props returns all layer properties." "Test tp-group-props returns all layer properties."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 ()
(tp-define-layer 'layer2 '(face italic)) '(face bold))
(tp-define-layer-group 'my-group 'layer1 'layer2) (define-tp layer2 ()
'(face italic))
(define-tps my-group ()
'layer1
'layer2)
(let ((props-list (tp-group-props 'my-group))) (let ((props-list (tp-group-props 'my-group)))
(should (= (length props-list) 2)) (should (= (length props-list) 2))
;; Check that both layers are present ;; Check that both layers are present
@ -362,28 +272,24 @@
(ert-deftest tp-test-group-undefine () (ert-deftest tp-test-group-undefine ()
"Test tp-undefine-group removes group definition." "Test tp-undefine-group removes group definition."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 ()
(tp-define-layer-group 'my-group 'layer1) '(face bold))
(define-tps my-group ()
'layer1)
(should (assoc 'my-group tp-layer-groups)) (should (assoc 'my-group tp-layer-groups))
(tp-undefine-group 'my-group) (tp-undefine-group 'my-group)
(should-not (assoc 'my-group tp-layer-groups)))) (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 () (ert-deftest tp-test-layer-reset ()
"Test tp-layer-reset clears all definitions." "Test tp-layer-reset clears all definitions."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 ()
(tp-define-layer 'layer2 '(face italic)) '(face bold))
(tp-define-layer-group 'group1 'layer1 'layer2) (define-tp layer2 ()
'(face italic))
(define-tps group1 ()
'layer1
'layer2)
(should tp-layer-alist) (should tp-layer-alist)
(should tp-layer-groups) (should tp-layer-groups)
(tp-layer-reset) (tp-layer-reset)
@ -398,7 +304,7 @@
"Test tp-push-layer adds layer to stack." "Test tp-push-layer adds layer to stack."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(should (eq (tp-at 1 'face) 'bold)) (should (eq (tp-at 1 'face) 'bold))
(should (eq (tp-at 1 'tp-name) 'layer1)))) (should (eq (tp-at 1 'tp-name) 'layer1))))
@ -407,8 +313,8 @@
"Test pushing multiple layers." "Test pushing multiple layers."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; layer2 should be on top (visible) ;; layer2 should be on top (visible)
@ -421,8 +327,8 @@
"Test tp-delete-layer removes layer from stack." "Test tp-delete-layer removes layer from stack."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; Delete top layer ;; Delete top layer
@ -435,9 +341,9 @@
"Test deleting layer from middle of stack." "Test deleting layer from middle of stack."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -452,8 +358,8 @@
"Test tp-pop-layer removes top layer." "Test tp-pop-layer removes top layer."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; Pop top layer ;; Pop top layer
@ -465,9 +371,9 @@
"Test tp-rotate-layer cycles layers." "Test tp-rotate-layer cycles layers."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -487,9 +393,9 @@
"Test tp-pin-layer brings layer to top." "Test tp-pin-layer brings layer to top."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -501,9 +407,9 @@
"Test tp-raise-layer moves layer up." "Test tp-raise-layer moves layer up."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -516,8 +422,8 @@
"Test tp-switch-layer swaps two layers." "Test tp-switch-layer swaps two layers."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; layer2 is on top ;; layer2 is on top
@ -531,9 +437,9 @@
"Test tp-move-layer moves layer by index." "Test tp-move-layer moves layer by index."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -548,9 +454,9 @@
"Test tp-move-layer moves layer by name." "Test tp-move-layer moves layer by name."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -565,9 +471,9 @@
"Test tp-move-layer with negative indices." "Test tp-move-layer with negative indices."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -583,8 +489,8 @@
(let ((str (copy-sequence "Hello"))) (let ((str (copy-sequence "Hello")))
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer str 'layer1) (tp-push-layer str 'layer1)
(tp-push-layer str 'layer2) (tp-push-layer str 'layer2)
;; layer2 is on top ;; layer2 is on top
@ -598,9 +504,9 @@
"Test tp-put-layer inserts layer at specified index." "Test tp-put-layer inserts layer at specified index."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; Insert layer3 at index 1 (between layer2 and layer1) ;; Insert layer3 at index 1 (between layer2 and layer1)
@ -614,8 +520,8 @@
"Test tp-merge-layers merges specified layers." "Test tp-merge-layers merges specified layers."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(help-echo "test")) (define-tp layer2 () '(help-echo "test"))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; Merge layer1 and layer2 into merged-layer ;; Merge layer1 and layer2 into merged-layer
@ -629,8 +535,8 @@
"Test tp-flatten-layers flattens all layers." "Test tp-flatten-layers flattens all layers."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(help-echo "test")) (define-tp layer2 () '(help-echo "test"))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; Flatten all layers into flat-layer ;; Flatten all layers into flat-layer
@ -647,9 +553,9 @@
"Test tp-layer-list returns all layer names." "Test tp-layer-list returns all layer names."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -663,8 +569,8 @@
"Test tp-layer-count returns correct count." "Test tp-layer-count returns correct count."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(should (= (tp-layer-count 1 6) 1)) (should (= (tp-layer-count 1 6) 1))
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
@ -674,7 +580,7 @@
"Test tp-layer-exists-p correctly detects layers." "Test tp-layer-exists-p correctly detects layers."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(should (tp-layer-exists-p 1 6 'layer1)) (should (tp-layer-exists-p 1 6 'layer1))
(should-not (tp-layer-exists-p 1 6 'layer2)))) (should-not (tp-layer-exists-p 1 6 'layer2))))
@ -683,8 +589,8 @@
"Test tp-layer-top returns top layer name." "Test tp-layer-top returns top layer name."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(should (eq (tp-layer-top 1 6) 'layer1)) (should (eq (tp-layer-top 1 6) 'layer1))
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
@ -1678,9 +1584,9 @@ Returns list of (START END VALUE) intervals."
"Test tp-add-to-layers adds properties to specified layers in buffer." "Test tp-add-to-layers adds properties to specified layers in buffer."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -1699,9 +1605,9 @@ Returns list of (START END VALUE) intervals."
"Test tp-add-to-layers with layer indices." "Test tp-add-to-layers with layer indices."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -1722,8 +1628,8 @@ Returns list of (START END VALUE) intervals."
(let ((str (copy-sequence "Hello"))) (let ((str (copy-sequence "Hello")))
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer str 'layer1) (tp-push-layer str 'layer1)
(tp-push-layer str 'layer2) (tp-push-layer str 'layer2)
;; Add help-echo to layer1 ;; Add help-echo to layer1
@ -1738,7 +1644,7 @@ Returns list of (START END VALUE) intervals."
"Test tp-add-to-layers deeply merges properties." "Test tp-add-to-layers deeply merges properties."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face (:foreground "red"))) (define-tp layer1 () '(face (:foreground "red")))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
;; Add background to layer1 - should merge with existing face ;; Add background to layer1 - should merge with existing face
(tp-add-to-layers '(layer1) 1 6 '(face (:background "blue"))) (tp-add-to-layers '(layer1) 1 6 '(face (:background "blue")))
@ -1750,9 +1656,9 @@ Returns list of (START END VALUE) intervals."
"Test tp-add-to-all-layers adds properties to all layers in buffer." "Test tp-add-to-all-layers adds properties to all layers in buffer."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-define-layer 'layer3 '(face underline)) (define-tp layer3 () '(face underline))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(tp-push-layer 1 6 'layer3) (tp-push-layer 1 6 'layer3)
@ -1773,8 +1679,8 @@ Returns list of (START END VALUE) intervals."
(let ((str (copy-sequence "Hello"))) (let ((str (copy-sequence "Hello")))
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer str 'layer1) (tp-push-layer str 'layer1)
(tp-push-layer str 'layer2) (tp-push-layer str 'layer2)
;; Add help-echo to all layers ;; Add help-echo to all layers
@ -1789,8 +1695,8 @@ Returns list of (START END VALUE) intervals."
"Test tp-add-to-all-layers deeply merges properties." "Test tp-add-to-all-layers deeply merges properties."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face (:foreground "red"))) (define-tp layer1 () '(face (:foreground "red")))
(tp-define-layer 'layer2 '(face (:foreground "blue"))) (define-tp layer2 () '(face (:foreground "blue")))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; Add background to all layers ;; Add background to all layers
@ -1809,8 +1715,8 @@ Returns list of (START END VALUE) intervals."
"Test tp-add-to-layers with negative index (-1 means bottom)." "Test tp-add-to-layers with negative index (-1 means bottom)."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-define-layer 'layer2 '(face italic)) (define-tp layer2 () '(face italic))
(tp-push-layer 1 6 'layer1) (tp-push-layer 1 6 'layer1)
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
;; Stack is: layer2 (0), layer1 (1) ;; Stack is: layer2 (0), layer1 (1)
@ -1827,7 +1733,7 @@ Returns list of (START END VALUE) intervals."
(let ((str (copy-sequence "Hello"))) (let ((str (copy-sequence "Hello")))
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-push-layer str 'layer1) (tp-push-layer str 'layer1)
(let ((result (tp-add-to-layers '(layer1) str 'help-echo "test"))) (let ((result (tp-add-to-layers '(layer1) str 'help-echo "test")))
(should (stringp result)) (should (stringp result))
@ -1838,7 +1744,7 @@ Returns list of (START END VALUE) intervals."
(let ((str (copy-sequence "Hello"))) (let ((str (copy-sequence "Hello")))
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'layer1 '(face bold)) (define-tp layer1 () '(face bold))
(tp-push-layer str 'layer1) (tp-push-layer str 'layer1)
(let ((result (tp-add-to-all-layers str 'help-echo "test"))) (let ((result (tp-add-to-all-layers str 'help-echo "test")))
(should (stringp result)) (should (stringp result))
@ -1905,7 +1811,7 @@ Returns list of (START END VALUE) intervals."
(makunbound 'tp-test-my-bg))) (makunbound 'tp-test-my-bg)))
(ert-deftest tp-test-define-layer-with-reactive () (ert-deftest tp-test-define-layer-with-reactive ()
"Test tp-define-layer with reactive variables." "Test define-tp with reactive variables."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-var-color "red" "Test color variable.") (defvar tp-test-var-color "red" "Test color variable.")
(unwind-protect (unwind-protect
@ -1993,7 +1899,7 @@ Returns list of (START END VALUE) intervals."
(makunbound 'tp-test-reset2-color)))) (makunbound 'tp-test-reset2-color))))
(ert-deftest tp-test-define-layer-group-with-reactive () (ert-deftest tp-test-define-layer-group-with-reactive ()
"Test tp-define-layer-group with reactive variables." "Test define-tps with reactive variables."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-group-color nil "Test variable for layer group.") (defvar tp-test-group-color nil "Test variable for layer group.")
(setq tp-test-group-color "red") (setq tp-test-group-color "red")
@ -2041,11 +1947,11 @@ Returns list of (START END VALUE) intervals."
;;; ============================================================ ;;; ============================================================
(ert-deftest tp-test-set-with-layer-name () (ert-deftest tp-test-set-with-layer-name ()
"Test tp-set accepts a layer name defined by tp-define-layer. "Test tp-set accepts a layer name defined by define-tp.
When using tp-set (direct property setting), tp-name is NOT added." When using tp-set (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-define-layer 'my-style '(face bold help-echo "tip")) (define-tp my-style () '(face bold help-echo "tip"))
;; Use layer name instead of plist ;; Use layer name instead of plist
(tp-set 1 6 'my-style) (tp-set 1 6 'my-style)
(should (eq (tp-at 1 'face) 'bold)) (should (eq (tp-at 1 'face) 'bold))
@ -2059,7 +1965,7 @@ When using tp-set (direct property setting), tp-name is NOT added."
(let ((str (copy-sequence "Hello World"))) (let ((str (copy-sequence "Hello World")))
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'my-style '(face italic)) (define-tp my-style () '(face italic))
(tp-set 0 5 'my-style str) (tp-set 0 5 'my-style str)
(should (eq (get-text-property 0 'face str) 'italic)) (should (eq (get-text-property 0 'face str) 'italic))
;; tp-name should NOT be set for direct property setting ;; tp-name should NOT be set for direct property setting
@ -2080,12 +1986,12 @@ incorrectly generate an anonymous tp-name instead of using the layer name."
(should (equal (plist-get (get-text-property 0 'face str) :background) "blue"))))) (should (equal (plist-get (get-text-property 0 'face str) :background) "blue")))))
(ert-deftest tp-test-reset-with-layer-name () (ert-deftest tp-test-reset-with-layer-name ()
"Test tp-reset accepts a layer name defined by tp-define-layer. "Test tp-reset accepts a layer name defined by define-tp.
When using tp-reset (direct property setting), tp-name is NOT added." When using tp-reset (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-set 1 6 '(mouse-face highlight)) (tp-set 1 6 '(mouse-face highlight))
(tp-define-layer 'my-style '(face underline)) (define-tp my-style () '(face underline))
;; Use layer name - should completely replace ;; Use layer name - should completely replace
(tp-reset 1 6 'my-style) (tp-reset 1 6 'my-style)
(should (eq (tp-at 1 'face) 'underline)) (should (eq (tp-at 1 'face) 'underline))
@ -2094,12 +2000,12 @@ When using tp-reset (direct property setting), tp-name is NOT added."
(should-not (tp-at 1 'tp-name)))) (should-not (tp-at 1 'tp-name))))
(ert-deftest tp-test-add-with-layer-name () (ert-deftest tp-test-add-with-layer-name ()
"Test tp-add accepts a layer name defined by tp-define-layer. "Test tp-add accepts a layer name defined by define-tp.
When using tp-add (direct property setting), tp-name is NOT added." When using tp-add (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-set 1 6 '(help-echo "existing")) (tp-set 1 6 '(help-echo "existing"))
(tp-define-layer 'my-style '(face bold)) (define-tp my-style () '(face bold))
;; Use layer name - should preserve existing properties ;; Use layer name - should preserve existing properties
(tp-add 1 6 'my-style) (tp-add 1 6 'my-style)
(should (eq (tp-at 1 'face) 'bold)) (should (eq (tp-at 1 'face) 'bold))
@ -2112,7 +2018,7 @@ When using tp-add (direct property setting), tp-name is NOT added."
When using tp-match-set (direct property setting), tp-name is NOT added." When using tp-match-set (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World Hello") (insert "Hello World Hello")
(tp-define-layer 'match-style '(face bold help-echo "matched")) (define-tp match-style () '(face bold help-echo "matched"))
(tp-match-set "Hello" 'match-style) (tp-match-set "Hello" 'match-style)
(should (eq (tp-at 1 'face) 'bold)) (should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "matched")) (should (equal (tp-at 1 'help-echo) "matched"))
@ -2126,7 +2032,7 @@ When using tp-match-set (direct property setting), tp-name is NOT added."
(let ((str (copy-sequence "Hello World Hello"))) (let ((str (copy-sequence "Hello World Hello")))
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'match-style '(face italic)) (define-tp match-style () '(face italic))
(tp-match-set "Hello" 'match-style str) (tp-match-set "Hello" 'match-style str)
(should (eq (get-text-property 0 'face str) 'italic)) (should (eq (get-text-property 0 'face str) 'italic))
(should (eq (get-text-property 12 'face str) 'italic)) (should (eq (get-text-property 12 'face str) 'italic))
@ -2138,7 +2044,7 @@ When using tp-match-set (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World Hello") (insert "Hello World Hello")
(tp-set 1 6 '(mouse-face highlight)) (tp-set 1 6 '(mouse-face highlight))
(tp-define-layer 'match-style '(face bold)) (define-tp match-style () '(face bold))
(tp-match-reset "Hello" 'match-style) (tp-match-reset "Hello" 'match-style)
(should (eq (tp-at 1 'face) 'bold)) (should (eq (tp-at 1 'face) 'bold))
(should (null (tp-at 1 'mouse-face))))) (should (null (tp-at 1 'mouse-face)))))
@ -2148,7 +2054,7 @@ When using tp-match-set (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World Hello") (insert "Hello World Hello")
(tp-set 1 6 '(help-echo "original")) (tp-set 1 6 '(help-echo "original"))
(tp-define-layer 'match-style '(face bold)) (define-tp match-style () '(face bold))
(tp-match-add "Hello" 'match-style) (tp-match-add "Hello" 'match-style)
(should (eq (tp-at 1 'face) 'bold)) (should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "original")))) (should (equal (tp-at 1 'help-echo) "original"))))
@ -2157,7 +2063,7 @@ When using tp-match-set (direct property setting), tp-name is NOT added."
"Test tp-regexp-set accepts a layer name." "Test tp-regexp-set accepts a layer name."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "abc 123 def 456") (insert "abc 123 def 456")
(tp-define-layer 'number-style '(face bold help-echo "number")) (define-tp number-style () '(face bold help-echo "number"))
(tp-regexp-set "[0-9]+" 'number-style) (tp-regexp-set "[0-9]+" 'number-style)
(should (eq (tp-at 5 'face) 'bold)) (should (eq (tp-at 5 'face) 'bold))
(should (equal (tp-at 5 'help-echo) "number")) (should (equal (tp-at 5 'help-echo) "number"))
@ -2168,7 +2074,7 @@ When using tp-match-set (direct property setting), tp-name is NOT added."
(let ((str (copy-sequence "abc 123 def 456"))) (let ((str (copy-sequence "abc 123 def 456")))
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(tp-define-layer 'number-style '(face italic)) (define-tp number-style () '(face italic))
(tp-regexp-set "[0-9]+" 'number-style str) (tp-regexp-set "[0-9]+" 'number-style str)
(should (eq (get-text-property 4 'face str) 'italic)) (should (eq (get-text-property 4 'face str) 'italic))
(should (eq (get-text-property 12 'face str) 'italic)))) (should (eq (get-text-property 12 'face str) 'italic))))
@ -2178,7 +2084,7 @@ When using tp-match-set (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "abc 123 def 456") (insert "abc 123 def 456")
(tp-set 5 8 '(mouse-face highlight)) (tp-set 5 8 '(mouse-face highlight))
(tp-define-layer 'number-style '(face bold)) (define-tp number-style () '(face bold))
(tp-regexp-reset "[0-9]+" 'number-style) (tp-regexp-reset "[0-9]+" 'number-style)
(should (eq (tp-at 5 'face) 'bold)) (should (eq (tp-at 5 'face) 'bold))
(should (null (tp-at 5 'mouse-face))))) (should (null (tp-at 5 'mouse-face)))))
@ -2189,7 +2095,7 @@ When using tp-regexp-add (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "abc 123 def 456") (insert "abc 123 def 456")
(tp-set 5 8 '(help-echo "original")) (tp-set 5 8 '(help-echo "original"))
(tp-define-layer 'number-style '(face bold)) (define-tp number-style () '(face bold))
(tp-regexp-add "[0-9]+" 'number-style) (tp-regexp-add "[0-9]+" 'number-style)
(should (eq (tp-at 5 'face) 'bold)) (should (eq (tp-at 5 'face) 'bold))
(should (equal (tp-at 5 'help-echo) "original")) (should (equal (tp-at 5 'help-echo) "original"))
@ -2197,11 +2103,11 @@ When using tp-regexp-add (direct property setting), tp-name is NOT added."
(should-not (tp-at 5 'tp-name)))) (should-not (tp-at 5 'tp-name))))
(ert-deftest tp-test-set-with-group-name () (ert-deftest tp-test-set-with-group-name ()
"Test tp-set accepts a group name defined by define-tp-group. "Test tp-set accepts a group name defined by define-tps.
When using tp-set (direct property setting), tp-name is NOT added." When using tp-set (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-define-layer-group 'my-group (define-tps my-group ()
'("style" . (face bold help-echo "grouped"))) '("style" . (face bold help-echo "grouped")))
;; Use group name ;; Use group name
(tp-set 1 6 'my-group) (tp-set 1 6 'my-group)
@ -2216,7 +2122,7 @@ When using tp-set (direct property setting), tp-name and tp-layers are NOT added
Only the first layer's properties are applied." Only the first layer's properties are applied."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-define-layer-group 'my-group (define-tps my-group ()
'("first" . (face bold)) '("first" . (face bold))
'("second" . (face italic))) '("second" . (face italic)))
;; Use group name - only first layer is applied (no layer stacking for direct setting) ;; Use group name - only first layer is applied (no layer stacking for direct setting)
@ -2233,7 +2139,7 @@ Only the first layer's properties are applied."
When using tp-match-set (direct property setting), tp-name is NOT added." When using tp-match-set (direct property setting), tp-name is NOT added."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World Hello") (insert "Hello World Hello")
(tp-define-layer-group 'my-group (define-tps my-group ()
'("style" . (face italic))) '("style" . (face italic)))
(tp-match-set "Hello" 'my-group) (tp-match-set "Hello" 'my-group)
(should (eq (tp-at 1 'face) 'italic)) (should (eq (tp-at 1 'face) 'italic))
@ -2250,7 +2156,8 @@ When using tp-match-set (direct property setting), tp-name is NOT added."
"Test tp-set with layer containing complex nested properties." "Test tp-set with layer containing complex nested properties."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-define-layer 'complex-layer '(face (:foreground "red" :underline (:style wave)) (define-tp complex-layer ()
'(face (:foreground "red" :underline (:style wave))
help-echo "complex")) help-echo "complex"))
(tp-set 1 6 'complex-layer) (tp-set 1 6 'complex-layer)
(let ((face (tp-at 1 'face))) (let ((face (tp-at 1 'face)))
@ -2303,7 +2210,7 @@ preserving the native text property behavior."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
;; First set with a layer name - this does NOT set tp-name ;; First set with a layer name - this does NOT set tp-name
(tp-define-layer 'my-existing-layer '(face bold)) (define-tp my-existing-layer () '(face bold))
(tp-set 1 6 'my-existing-layer) (tp-set 1 6 'my-existing-layer)
(should-not (tp-at 1 'tp-name)) ; no tp-name for direct setting (should-not (tp-at 1 'tp-name)) ; no tp-name for direct setting
;; Now set with anonymous plist that has explicit tp-name ;; Now set with anonymous plist that has explicit tp-name
@ -2360,7 +2267,7 @@ preserving the native text property behavior."
;;; ============================================================ ;;; ============================================================
(ert-deftest tp-test-define-layer-with-watch () (ert-deftest tp-test-define-layer-with-watch ()
"Test tp-define-layer with :watch for side effects." "Test reactive layers with :watch for side effects."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-watch-var nil "Test variable for watch.") (defvar tp-test-watch-var nil "Test variable for watch.")
(defvar tp-test-watch-log nil "Log of watch callback invocations.") (defvar tp-test-watch-log nil "Log of watch callback invocations.")
@ -2393,7 +2300,7 @@ preserving the native text property behavior."
(makunbound 'tp-test-watch-log)))) (makunbound 'tp-test-watch-log))))
(ert-deftest tp-test-define-layer-with-data () (ert-deftest tp-test-define-layer-with-data ()
"Test tp-define-layer with :data for additional reactive variables." "Test reactive layers with :data for additional reactive variables."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(unwind-protect (unwind-protect
(progn (progn
@ -2411,7 +2318,7 @@ preserving the native text property behavior."
(makunbound 'tp-test-data-extra)))) (makunbound 'tp-test-data-extra))))
(ert-deftest tp-test-define-layer-with-compute () (ert-deftest tp-test-define-layer-with-compute ()
"Test tp-define-layer with :compute for computed reactive variables." "Test reactive layers with :compute for computed reactive variables."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(unwind-protect (unwind-protect
(progn (progn
@ -2439,7 +2346,7 @@ preserving the native text property behavior."
(makunbound 'tp-test-full-name)))) (makunbound 'tp-test-full-name))))
(ert-deftest tp-test-define-layer-with-data-and-compute () (ert-deftest tp-test-define-layer-with-data-and-compute ()
"Test tp-define-layer with :data and :compute together." "Test reactive layers with :data and :compute together."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(unwind-protect (unwind-protect
(progn (progn
@ -2516,7 +2423,7 @@ preserving the native text property behavior."
(makunbound 'tp-test-undef-full)))) (makunbound 'tp-test-undef-full))))
(ert-deftest tp-test-define-layer-group-with-watch () (ert-deftest tp-test-define-layer-group-with-watch ()
"Test tp-define-layer-group with :watch (format-4)." "Test define-tps with :watch (format-4)."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(defvar tp-test-group-watch-var nil "Test variable for group watch.") (defvar tp-test-group-watch-var nil "Test variable for group watch.")
(defvar tp-test-group-watch-log nil "Log of watch callback invocations.") (defvar tp-test-group-watch-log nil "Log of watch callback invocations.")
@ -2545,7 +2452,7 @@ preserving the native text property behavior."
(makunbound 'tp-test-group-watch-log)))) (makunbound 'tp-test-group-watch-log))))
(ert-deftest tp-test-define-layer-group-with-compute () (ert-deftest tp-test-define-layer-group-with-compute ()
"Test tp-define-layer-group with :compute (format-4)." "Test define-tps with :compute (format-4)."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(unwind-protect (unwind-protect
(progn (progn

80
tp.el
View File

@ -2680,13 +2680,53 @@ and the group itself is stored in `tp-layer-groups'."
(tp--set-group-layers name layer-names) (tp--set-group-layers name layer-names)
(assoc name tp-layer-groups))) (assoc name tp-layer-groups)))
(defmacro define-tp-group (name &rest elements) (defun tp--define-layer-group-internal (name arglist elements)
"Define a layer group named NAME containing multiple layers. "Internal function for define-tps with ARGLIST and ELEMENTS.
NAME is the group name symbol.
ARGLIST is nil for non-parameterized groups, or a list with one symbol.
ELEMENTS is the list of layer definitions."
(if arglist
;; Parameterized group - store for later evaluation
(let ((entry (list arglist elements)))
(if (assoc name tp-layer-groups)
(setf (cdr (assoc name tp-layer-groups)) entry)
(push (cons name entry) tp-layer-groups))
(assoc name tp-layer-groups))
;; Non-parameterized - define immediately using tp-define-layer-group
(apply #'tp-define-layer-group name elements)))
This macro provides a convenient syntax for `tp-define-layer-group'. (defun tp--define-layer-group-unified (name arglist body-form)
All layer definitions should use quoted list format. "Define a parameterized layer group NAME with ARGLIST and BODY-FORM.
Stores the group in `tp-layer-groups' with format: (GROUP-NAME ARGLIST BODY-FORM)."
(let ((entry (list arglist body-form)))
(if (assoc name tp-layer-groups)
(setf (cdr (assoc name tp-layer-groups)) entry)
(push (cons name entry) tp-layer-groups)))
(assoc name tp-layer-groups))
Supported formats for each element in ELEMENTS: (defmacro define-tps (name arglist &rest body)
"Define a text property group named NAME.
This macro defines a group of text properties (layers) that can be used together.
It follows the same format as `define-tp' for consistency.
ARGLIST must be either:
- An empty list () for non-parameterized groups
- A list containing exactly one symbol for parameterized groups
BODY contains the layer definitions, which should be quoted lists.
Format 1 - Non-parameterized (empty arglist):
(define-tps my-moon-phases ()
\\='(display \"🌑\")
\\='(display \"🌕\"))
Format 2 - Parameterized (with argument):
(define-tps my-status (color)
\\=`((face (:foreground ,color)))
\\='(face (:weight bold)))
Supported formats for each element in BODY:
Format 1 - Existing layer reference: Format 1 - Existing layer reference:
\\='existing-layer-name \\='existing-layer-name
@ -2705,15 +2745,29 @@ Format 5 - Named layer with :props, :data, :watch, and/or :compute:
:data ((my-color . \"red\")) :data ((my-color . \"red\"))
:watch ((my-color (lambda (new old layer) (message \"Changed!\"))))) :watch ((my-color (lambda (new old layer) (message \"Changed!\")))))
Example: Note: NAME cannot be a built-in Emacs text property name like `face',
(define-tp-group my-group `display', `invisible', etc. See `tp--builtin-text-properties' for the
\\='existing-layer complete list of reserved names."
\\='(face bold)
\\='(\"named\" . (face italic)))
See `tp-define-layer-group' for full documentation."
(declare (indent defun)) (declare (indent defun))
`(tp-define-layer-group ',name ,@elements)) (unless (listp arglist)
(error "define-tps ARGLIST must be a list"))
;; Check for built-in text property name conflict
(when (tp--builtin-text-property-p name)
(error "define-tps: '%s' is a built-in Emacs text property name and cannot be used as a group name" name))
(cond
;; Non-parameterized: empty arglist
((null arglist)
`(tp--define-layer-group-internal ',name nil (list ,@body)))
;; Parameterized: single argument
((and (= (length arglist) 1)
(symbolp (car arglist)))
`(tp--define-layer-group-unified ',name ',arglist '(list ,@body)))
(t
(error "define-tps ARGLIST must be empty or contain exactly one symbol"))))
;; For backward compatibility, keep define-tp-group as an alias
(defalias 'define-tp-group 'define-tps
"Alias for `define-tps' for backward compatibility.")
(defun tp--set-layer-props (layer-name properties) (defun tp--set-layer-props (layer-name properties)
"Set PROPERTIES for layer LAYER-NAME in `tp-layer-alist'. "Set PROPERTIES for layer LAYER-NAME in `tp-layer-alist'.