update
This commit is contained in:
Kinneyzhang
parent
0d35358e05
commit
db5864141a
1
.gitignore
vendored
1
.gitignore
vendored
@ -1,5 +1,6 @@
|
||||
# Dependencies
|
||||
dash.el
|
||||
postmortem
|
||||
|
||||
# Emacs compiled files
|
||||
*.elc
|
||||
|
||||
24
README.md
24
README.md
@ -6,6 +6,10 @@ TP does not depend on Ebox or ECSS. It does not implement CSS selectors, stylesh
|
||||
|
||||
Chinese documentation: [README_CN.md](README_CN.md).
|
||||
|
||||
Complete public API reference: [API-REFERENCE.md](docs/API-REFERENCE.md) (中文).
|
||||
It is the symbol-level usage index for the current TP 1.0 implementation; this
|
||||
README remains the conceptual quick start.
|
||||
|
||||
## Requirements
|
||||
|
||||
- Emacs 28.1 or newer.
|
||||
@ -124,7 +128,7 @@ A retained producer receives a prepare context, ensures stable objects before pr
|
||||
(tp-surface-report surface))
|
||||
```
|
||||
|
||||
Plan fields are `key`, `kind`, `text`, `props`, `children`, `tags`, and `capability`. Plans contain no markers, buffer positions, patch operations, producer closures, or client continuations. Constructors defensively copy caller-owned strings and property data.
|
||||
Plan fields are `key`, `kind`, `text`, `props`, `children`, `tags`, and `capability`. Plans contain no markers, buffer positions, patch operations, producer closures, or client continuations. Normal constructors defensively copy caller-owned strings and property data; candidate-local producers may use the explicit `-owned` plan/result constructors when they transfer every nested value and stop exposing it. An owned result must be created for the active prepare context and is consumed once.
|
||||
|
||||
Stable identity is surface-local. `tp-object-ensure` reconciles by parent, sibling key, and kind; `tp-object-resolve` returns a live opaque handle by key path. `tp-surface-update-scoped` authorizes a full candidate update against one or more retained objects and rejects output changes outside their current mount ranges unless the caller explicitly selects root fallback.
|
||||
|
||||
@ -158,14 +162,22 @@ Observers run only after a successful commit. Their failures are recorded and do
|
||||
|
||||
| Family | Main public APIs |
|
||||
| --- | --- |
|
||||
| Core inspection and debug | `tp-debug-*`, `tp-intervals`, `tp-intervals-map`, `tp-plist`, `tp-text-snapshot`, `tp-empty-p` |
|
||||
| Property policy and declarations | `tp-define-property-policy`, `tp-register-text-property`, `tp-text-declarations`, `tp-computed`, `tp-resolve-value`, `tp-merge-declarations`, `tp-define-style`, `tp-style-declarations` |
|
||||
| Signals and bindings | `tp-signal-create`, `tp-signal-read`, `tp-signal-peek`, `tp-signal-set`, `tp-bind`, `tp-binding-read`, `tp-with-transaction`, `tp-reactive-counters` |
|
||||
| Objects and plans | `tp-object-ensure`, `tp-object-retain`, `tp-object-attach-fragment`, `tp-object-resolve`, `tp-object-mounts`, `tp-surface-plan-create`, `tp-surface-result-create` |
|
||||
| Host ranges | `tp-range-anchor-create`, `tp-object-attach-range`, `tp-range-rebase` |
|
||||
| Surfaces | `tp-surface-materialize-string`, `tp-surface-mount`, `tp-surface-update`, `tp-surface-update-scoped`, `tp-surface-unmount`, `tp-surface-at-point`, `tp-surface-report`, `tp-surface-inspect` |
|
||||
| Static recipes | `define-tp`/`tp-define-layer`, `define-tps`/`define-tp-group`/`tp-define-group`, layer/group queries, undefine/reset/describe |
|
||||
| Signals and bindings | signal create/read/peek/set/dispose, binding install/read/dispose, `tp-variable-signal`, `tp-with-transaction`, `tp-transaction-participate`, counters/reset |
|
||||
| Objects and plans | plan/result constructors, `tp-object-ensure`, retain/reuse, fragment/content-range attachment, resolve, mounted/mounts |
|
||||
| Host ranges | `tp-range-anchor-create`, `tp-range-anchor-live-p`, `tp-object-attach-range`, `tp-range-rebase` |
|
||||
| Surfaces | mount/update/scoped update, materialize, live/revision/client-state, at-point, report/report-summary/inspect, unmount |
|
||||
| Direct façade | `tp-propertize`, `tp-apply`, `tp-watch`, `tp-set`, `tp-reset`, `tp-add`, `tp-remove`, `tp-clear`, `tp-get`, `tp-at`, `tp-member` |
|
||||
| Search and navigation | `tp-match-*`, `tp-regexp-*`, `tp-search`, `tp-search-map`, `tp-forward*`, `tp-backward*` |
|
||||
| Native query and mutation | `tp-lookup`, `tp-property-change`, `tp-property-any`, `tp-property-not-all`, `tp-with-mutation-policy` |
|
||||
| Palette and display helpers | palette definition/lookups, built-in recipes, `tp-palette-show`, `tp-pop-to-buffer`, `tp-switch-to-buffer`, `tp-display-buffer-mode` |
|
||||
|
||||
See [API semantics](docs/API-SEMANTICS.md) for ownership, lifecycle, error, and return contracts, and [architecture](docs/ARCHITECTURE.md) for module boundaries and transaction flow.
|
||||
See the [complete API reference](docs/API-REFERENCE.md) for signatures, return
|
||||
shapes, examples, and the full module index. See [API semantics](docs/API-SEMANTICS.md)
|
||||
for ownership, lifecycle, error, and return contracts, and [architecture](docs/ARCHITECTURE.md)
|
||||
for module boundaries and transaction flow.
|
||||
|
||||
## TP 1.0 migration
|
||||
|
||||
|
||||
26
README_CN.md
26
README_CN.md
@ -6,6 +6,9 @@ TP 不依赖 Ebox 或 ECSS，也不实现 CSS selector、stylesheet、specificit
|
||||
|
||||
英文文档：[README.md](README.md)。
|
||||
|
||||
完整公共 API 参考：[API-REFERENCE.md](docs/API-REFERENCE.md)。本文负责概念
|
||||
和快速开始；API 参考按当前 TP 1.0 源码列出入口、参数语义、返回值和用法。
|
||||
|
||||
## 运行要求
|
||||
|
||||
- Emacs 28.1 或更高版本。
|
||||
@ -124,7 +127,7 @@ retained producer 接收 prepare context，在生成输出前取得稳定 object
|
||||
(tp-surface-report surface))
|
||||
```
|
||||
|
||||
plan 字段只有 `key`、`kind`、`text`、`props`、`children`、`tags` 和 `capability`，不包含 marker、buffer position、patch operation、producer closure 或 client continuation。constructor 会防御性复制调用者持有的 string 和 property data。
|
||||
plan 字段只有 `key`、`kind`、`text`、`props`、`children`、`tags` 和 `capability`，不包含 marker、buffer position、patch operation、producer closure 或 client continuation。普通 constructor 会防御性复制调用者持有的 string 和 property data；candidate-local producer 只有在转移所有嵌套值且不再暴露它们时，才能使用显式的 `-owned` plan/result constructor。Owned result 必须绑定当前 active prepare context，并且只消费一次。
|
||||
|
||||
稳定身份只在一个 surface 内有效。`tp-object-ensure` 按 parent、sibling key 和 kind reconcile；`tp-object-resolve` 按 key path 返回 live opaque handle。`tp-surface-update-scoped` 接收完整 candidate，但只授权一个或多个 retained object 当前 mount 范围内的输出变化；除非调用者显式选择 root fallback，否则越界变化会直接失败。
|
||||
|
||||
@ -158,14 +161,21 @@ observer 只在成功提交之后运行，observer failure 只记录，不回滚
|
||||
|
||||
| 家族 | 主要公共 API |
|
||||
| --- | --- |
|
||||
| Property policy 与 declaration | `tp-define-property-policy`, `tp-register-text-property`, `tp-text-declarations`, `tp-computed`, `tp-resolve-value`, `tp-merge-declarations`, `tp-define-style`, `tp-style-declarations` |
|
||||
| Signal 与 binding | `tp-signal-create`, `tp-signal-read`, `tp-signal-peek`, `tp-signal-set`, `tp-bind`, `tp-binding-read`, `tp-with-transaction`, `tp-reactive-counters` |
|
||||
| Object 与 plan | `tp-object-ensure`, `tp-object-retain`, `tp-object-attach-fragment`, `tp-object-resolve`, `tp-object-mounts`, `tp-surface-plan-create`, `tp-surface-result-create` |
|
||||
| Host range | `tp-range-anchor-create`, `tp-object-attach-range`, `tp-range-rebase` |
|
||||
| Surface | `tp-surface-materialize-string`, `tp-surface-mount`, `tp-surface-update`, `tp-surface-update-scoped`, `tp-surface-unmount`, `tp-surface-at-point`, `tp-surface-report`, `tp-surface-inspect` |
|
||||
| Direct façade | `tp-propertize`, `tp-apply`, `tp-watch`, `tp-set`, `tp-reset`, `tp-add`, `tp-remove`, `tp-clear`, `tp-get`, `tp-at`, `tp-member` |
|
||||
| Core inspection 与 debug | `tp-debug-*`、`tp-intervals`、`tp-intervals-map`、`tp-plist`、`tp-text-snapshot`、`tp-empty-p` |
|
||||
| Property policy 与 declaration | `tp-define-property-policy`、`tp-register-text-property`、`tp-text-declarations`、`tp-computed`、`tp-resolve-value`、`tp-merge-declarations`、`tp-define-style`、`tp-style-declarations` |
|
||||
| 静态 recipe | `define-tp`/`tp-define-layer`、`define-tps`/`define-tp-group`/`tp-define-group`、layer/group 查询、undefine/reset/describe |
|
||||
| Signal 与 binding | signal create/read/peek/set/dispose、binding install/read/dispose、`tp-variable-signal`、`tp-with-transaction`、`tp-transaction-participate`、counter/reset |
|
||||
| Object 与 plan | plan/result constructor、`tp-object-ensure`、retain/reuse、fragment/content-range attach、resolve、mounted/mounts |
|
||||
| Host range | `tp-range-anchor-create`、`tp-range-anchor-live-p`、`tp-object-attach-range`、`tp-range-rebase` |
|
||||
| Surface | mount/update/scoped update、materialize、live/revision/client-state、at-point、report/report-summary/inspect、unmount |
|
||||
| Direct façade | `tp-propertize`、`tp-apply`、`tp-watch`、`tp-set`、`tp-reset`、`tp-add`、`tp-remove`、`tp-clear`、`tp-get`、`tp-at`、`tp-member` |
|
||||
| Search 与 navigation | `tp-match-*`、`tp-regexp-*`、`tp-search`、`tp-search-map`、`tp-forward*`、`tp-backward*` |
|
||||
| Native query 与 mutation | `tp-lookup`、`tp-property-change`、`tp-property-any`、`tp-property-not-all`、`tp-with-mutation-policy` |
|
||||
| Palette 与 display helper | palette definition/lookup、built-in recipe、`tp-palette-show`、`tp-pop-to-buffer`、`tp-switch-to-buffer`、`tp-display-buffer-mode` |
|
||||
|
||||
ownership、生命周期、错误和返回值合同见 [API semantics](docs/API-SEMANTICS.md)，模块边界和完整事务流程见 [architecture](docs/ARCHITECTURE.md)。
|
||||
完整签名、返回值、示例和模块索引见 [API 参考](docs/API-REFERENCE.md)；
|
||||
ownership、生命周期、错误和返回值合同见 [API semantics](docs/API-SEMANTICS.md)，
|
||||
模块边界和完整事务流程见 [architecture](docs/ARCHITECTURE.md)。
|
||||
|
||||
## TP 1.0 迁移
|
||||
|
||||
|
||||
597
docs/API-REFERENCE.md
Normal file
597
docs/API-REFERENCE.md
Normal file
@ -0,0 +1,597 @@
|
||||
# TP 1.0 公共 API 与用法参考
|
||||
|
||||
本文是 TP 当前实现的完整公共入口索引。它以 tp.el 加载的模块为准；带
|
||||
tp-- 前缀的函数、变量和结构体是内部实现，不属于本文的稳定 API。
|
||||
|
||||
- 快速开始与能力边界：[README](../README.md)、[中文 README](../README_CN.md)
|
||||
- 语义合同：[API-SEMANTICS.md](API-SEMANTICS.md)
|
||||
- 当前架构：[ARCHITECTURE.md](ARCHITECTURE.md)
|
||||
- 可运行示例：[examples/](../examples/)
|
||||
|
||||
## 1. 运行边界
|
||||
|
||||
TP 只负责 Emacs text properties、响应式 signal/binding、retained object、
|
||||
marker-backed mount、diff、事务和 Buffer publication。它不实现 CSS selector、
|
||||
stylesheet、specificity、cascade、Box、Flex、Grid、测量或布局，也不依赖
|
||||
Ebox/ECSS。
|
||||
|
||||
所有坐标都遵循 Emacs 原生对象的坐标规则：
|
||||
|
||||
- string 使用从 0 开始的 [start, end)；
|
||||
- buffer 使用从 1 开始的 [start, end)；
|
||||
- tp-surface-plan 中的 content leaf range 是相对于该 leaf 文本的
|
||||
0-based offset，不是 Buffer position。
|
||||
|
||||
普通函数值、callback、keymap command 和 list 都是 literal data。只有显式的
|
||||
tp-computed source 会被执行。显式存在且值为 nil 与属性不存在始终不同。
|
||||
|
||||
## 2. 先选入口
|
||||
|
||||
| 目标 | 入口 | 是否建立 live state |
|
||||
| --- | --- | --- |
|
||||
| 创建带属性的 string | tp-propertize | 否 |
|
||||
| 一次性改已有范围 | tp-apply、tp-set、tp-reset、tp-add、tp-remove、tp-clear | 否 |
|
||||
| 查询属性和区间 | tp-get、tp-at、tp-member、tp-lookup | 否 |
|
||||
| 按文字或属性搜索 | tp-match-*、tp-regexp-*、tp-search*、tp-forward/backward | 否 |
|
||||
| 让已有 host text 响应变化 | tp-watch | 是，properties |
|
||||
| 管理 TP 自己拥有的文字 | tp-surface-mount / tp-surface-update | 是，content |
|
||||
| 检查或卸载 publication | tp-surface-inspect / tp-surface-report / tp-surface-unmount | 是 |
|
||||
| 定义可复用声明 | define-tp、define-tps | 只建立 recipe，不建立 live state |
|
||||
| 定义主题颜色 | define-tp-palette | 只更新 palette registry |
|
||||
|
||||
安装只需要把仓库加入 load-path：
|
||||
|
||||
~~~elisp
|
||||
(add-to-list 'load-path "/path/to/tp")
|
||||
(require 'tp)
|
||||
~~~
|
||||
|
||||
tp.el 会加载所有运行时模块。单独加载模块只适合包开发或测试。
|
||||
|
||||
## 3. 一次性文本属性操作
|
||||
|
||||
### 3.1 创建和应用
|
||||
|
||||
~~~elisp
|
||||
(tp-propertize
|
||||
"Hello"
|
||||
'(face bold help-echo "greeting" keymap nil))
|
||||
|
||||
(with-current-buffer (get-buffer-create "*tp-demo*")
|
||||
(erase-buffer)
|
||||
(insert "abcdef")
|
||||
(tp-apply (current-buffer) 2 5 '(face italic)))
|
||||
~~~
|
||||
|
||||
tp-propertize 返回原 string 的副本；tp-apply 保留范围内未出现在
|
||||
declarations 中的其他属性，并返回 (START . END)。
|
||||
|
||||
declarations 可以是原生 property plist、define-tp recipe、recipe call，
|
||||
或包含 recipe key 的 plist。tp-apply 和下面的直接操作不会创建 object、
|
||||
binding、marker、subscription 或 surface。
|
||||
|
||||
### 3.2 set/reset/add/remove/clear
|
||||
|
||||
对完整 string 的形式会返回新 string；对 Buffer 范围的形式会原地修改，并
|
||||
返回 (START . END)（tp-remove 和 tp-clear 的 Buffer 形式返回 nil）。
|
||||
|
||||
~~~elisp
|
||||
;; string：property/value 形式，原 string 不变
|
||||
(tp-set "item" 'face 'bold)
|
||||
(tp-reset "item" 'face 'italic)
|
||||
(tp-add "item" 'face 'underline)
|
||||
(tp-remove (tp-set "item" 'face 'bold) 'face)
|
||||
|
||||
;; buffer 或 string 范围：一个 direct property plist，可选 OBJECT
|
||||
(tp-set start end '(face bold help-echo "tip") buffer)
|
||||
(tp-reset start end '(face italic) buffer)
|
||||
(tp-add start end '(face (:weight bold)) buffer)
|
||||
(tp-remove start end 'help-echo buffer)
|
||||
(tp-clear start end buffer)
|
||||
~~~
|
||||
|
||||
- tp-set 替换所指定的顶层属性；
|
||||
- tp-reset 用 declarations 完全替换范围内所有属性；
|
||||
- tp-add 合并属性；face、font-lock-face、mouse-face 支持 contribution
|
||||
合成和嵌套 plist 合并；
|
||||
- tp-remove 支持移除顶层属性，也支持 (property sub-key) 或
|
||||
(property sub-key nested-key...)；
|
||||
- tp-clear 移除范围内全部 text properties。
|
||||
|
||||
## 4. 声明、property policy 和 recipe
|
||||
|
||||
### 4.1 Property policy
|
||||
|
||||
~~~elisp
|
||||
(tp-define-property-policy
|
||||
'text/my-property
|
||||
:normalizer #'identity
|
||||
:validator (lambda (_value) t)
|
||||
:equality #'equal
|
||||
:merge (lambda (_old new) new)
|
||||
:projector #'identity)
|
||||
|
||||
(tp-property-policy 'text/my-property)
|
||||
(tp-register-text-property 'help-echo)
|
||||
(tp-text-property-id 'help-echo)
|
||||
(tp-text-declarations '(face bold help-echo "tip"))
|
||||
~~~
|
||||
|
||||
tp-define-property-policy 的 id 必须是包含 / 的 canonical symbol。可选策略
|
||||
为 :normalizer、:validator、:equality、:merge、:projector。注册是原子的；
|
||||
无效策略不会替换旧定义。
|
||||
|
||||
- tp-register-text-property 为原生 Emacs property 安装默认 policy；
|
||||
- tp-text-property-id 把原生 property 映射为 text/PROPERTY；
|
||||
- tp-text-declarations 把原生 plist 转成 canonical declarations；
|
||||
- tp-merge-declarations 按参数顺序合并 direct declaration groups，后者
|
||||
覆盖前者，并保留显式 nil；
|
||||
- tp-computed 把一个函数标记为唯一允许执行的 value source；
|
||||
- tp-resolve-value 解析 literal 或显式 computed value；
|
||||
- tp-define-style、tp-style-declarations、tp-undefine-style 管理已归一化的
|
||||
命名 direct style。
|
||||
|
||||
### 4.2 静态 recipe
|
||||
|
||||
~~~elisp
|
||||
(define-tp link-style (color)
|
||||
(list 'face (list :foreground color :weight 'bold)
|
||||
'mouse-face 'highlight))
|
||||
|
||||
(define-tps status-group ()
|
||||
link-style
|
||||
'(help-echo "status"))
|
||||
|
||||
(tp-set 1 5 '(link-style "#58a6ff") buffer)
|
||||
(tp-layer-props-with-arg 'link-style "#58a6ff")
|
||||
(tp-group-props 'status-group)
|
||||
~~~
|
||||
|
||||
入口及别名：
|
||||
|
||||
- define-tp（别名 tp-define-layer）定义一个返回原生 property plist 的 recipe；
|
||||
- define-tps（别名 define-tp-group、tp-define-group）定义由多个 recipe、
|
||||
recipe call、原生 plist 或命名元素组成的 declaration group；
|
||||
- tp-layer-parameterized-p、tp-layer-arglist、tp-layer-props、
|
||||
tp-layer-props-with-args、tp-layer-props-with-arg 查询或展开 layer；
|
||||
- tp-group-parameterized-p、tp-group-props、tp-group-props-with-args、
|
||||
tp-group-props-with-arg 查询或展开 group；
|
||||
- tp-undefine-layer、tp-undefine-group、tp-layer-reset 删除 recipe；
|
||||
- tp-describe-layer 返回 recipe 的声明式诊断数据。
|
||||
|
||||
recipe 是 definition-time convenience，不是 mounted layer，也不会向文本
|
||||
写入 identity、provenance、tp-name 或 tp-layers。旧的 $variable reactive
|
||||
syntax 会被拒绝。
|
||||
|
||||
tp-layer-alist 和 tp-layer-groups 是 recipe registry；通常通过上面的 query、
|
||||
undefine 和 reset API 访问，不要直接修改 registry。
|
||||
|
||||
## 5. Reactive signal 和 binding
|
||||
|
||||
### 5.1 Signal
|
||||
|
||||
~~~elisp
|
||||
(let ((online (tp-signal-create nil)))
|
||||
(tp-signal-read online) ; 在 binding/producer 中收集依赖
|
||||
(tp-signal-peek online) ; 读取但不收集依赖
|
||||
(tp-signal-set online t)
|
||||
(tp-signal-subscriber-count online)
|
||||
(tp-signal-live-p online)
|
||||
(tp-signal-dispose online))
|
||||
~~~
|
||||
|
||||
tp-signal-create 的关键字选项：
|
||||
|
||||
- :equality，默认 equal；相等写入是 no-op；
|
||||
- :scope，默认 global，也可以是一个 live buffer。Buffer kill 会释放该范围
|
||||
内 signal。
|
||||
|
||||
tp-signal-read 只在当前 computation 中登记 dependency；tp-signal-peek 不会
|
||||
登记。disposed signal 的读取会报错。
|
||||
|
||||
### 5.2 Binding
|
||||
|
||||
~~~elisp
|
||||
(let* ((source (tp-signal-create 0))
|
||||
(owner (list 'owner))
|
||||
(binding
|
||||
(tp-bind owner 'value
|
||||
(lambda () (tp-signal-read source))
|
||||
:lifecycle 'delete)))
|
||||
(tp-binding-read binding)
|
||||
(tp-binding-live-p binding)
|
||||
(tp-binding-dependency-count binding)
|
||||
(tp-binding-subscriber-count binding)
|
||||
(tp-binding-owner-bindings owner)
|
||||
(tp-binding-dispose binding)
|
||||
(tp-signal-dispose source))
|
||||
~~~
|
||||
|
||||
tp-bind 按 OWNER + KEY 幂等安装 computation。KEY 应使用调用者自己的命名空间；
|
||||
:equality 默认 equal；:lifecycle 为 delete 或 retain。binding 依赖集合按每次
|
||||
实际读取重建，因此条件分支会自动断开不再使用的 source。tp-binding-read
|
||||
会在需要时计算并把 binding-to-binding 依赖登记到当前 computation。
|
||||
|
||||
tp-binding-dispose-owner 释放 owner 的全部 binding，返回释放数量；
|
||||
tp-binding-dispose 释放单个 binding。
|
||||
|
||||
### 5.3 Transaction 和变量适配器
|
||||
|
||||
~~~elisp
|
||||
(let ((left (tp-signal-create 0))
|
||||
(right (tp-signal-create 0)))
|
||||
(tp-with-transaction
|
||||
(tp-signal-set left 1)
|
||||
(tp-signal-set right 2))
|
||||
(tp-signal-dispose left)
|
||||
(tp-signal-dispose right))
|
||||
|
||||
(tp-transaction-participate
|
||||
'my-external-state
|
||||
(lambda () (my-publish))
|
||||
(lambda () (my-rollback)))
|
||||
|
||||
(tp-variable-signal 'my-variable)
|
||||
(tp-variable-signal 'my-buffer-variable some-buffer)
|
||||
(tp-reactive-counters)
|
||||
(tp-reactive-reset-counters)
|
||||
(tp-reactive-reset)
|
||||
~~~
|
||||
|
||||
tp-with-transaction 将 signal、binding、surface 和注册的 transaction
|
||||
participant 一起原子处理。participant 必须在 active transaction 内注册；
|
||||
publish 在 surface publication 后、source commit 前运行，失败时按逆序
|
||||
rollback。tp-variable-signal 用 Emacs variable watcher 适配全局或指定
|
||||
Buffer 的变量，不是旧的 $variable API。
|
||||
|
||||
## 6. Retained surface
|
||||
|
||||
### 6.1 Plan、result 和 object
|
||||
|
||||
~~~elisp
|
||||
(tp-surface-plan-create
|
||||
:key 'label :kind 'text :text "Ready"
|
||||
:props '(face bold) :tags '(:role status)
|
||||
:capability 'content)
|
||||
~~~
|
||||
|
||||
Plan 字段为 key、kind、text、props、children、tags、capability。leaf 使用
|
||||
text，容器使用 children；同一层的 key 必须唯一。capability 是 content 或
|
||||
properties。
|
||||
|
||||
- tp-surface-plan-create 防御性复制 caller-owned 数据；
|
||||
- tp-surface-plan-create-owned 直接接收 candidate-local 数据；调用者必须
|
||||
转移所有权，之后不得修改或向其他 owner 暴露；
|
||||
- tp-surface-result-create 返回携带 plan 和 opaque client-state 的 producer
|
||||
result；
|
||||
- tp-surface-result-create-owned 只可对当前 active prepare context 使用，
|
||||
结果只消费一次。
|
||||
|
||||
producer 接收一个 prepare context，并应返回 plan 或 result：
|
||||
|
||||
~~~elisp
|
||||
(lambda (context)
|
||||
(let ((object (tp-object-ensure context nil 'row 'text)))
|
||||
(tp-surface-plan-create
|
||||
:key 'row :kind 'text :text "row"
|
||||
:props '(face italic)
|
||||
:capability 'content)))
|
||||
~~~
|
||||
|
||||
producer 不得在 prepare 阶段直接修改 live surface buffer；plan 不携带
|
||||
position、marker、patch operation、producer closure 或 continuation。
|
||||
|
||||
对象入口：
|
||||
|
||||
- tp-object-ensure 按 parent、sibling key、kind 返回或创建当前 candidate 的
|
||||
稳定 opaque object；
|
||||
- tp-object-live-p、tp-object-mounted-p 检查 object 状态；
|
||||
- tp-object-resolve 用 key path 从 surface side index 取得 object，不扫描文本；
|
||||
- tp-object-mounts 返回 :start、:end、:tags 的数值快照；
|
||||
- tp-object-retain 保留没有输出 fragment 的 object；
|
||||
- tp-object-retain-subtree 保留已证明未删除的 object 子树；
|
||||
- tp-object-reuse-subtree 复用已证明完全不变的 object 子树；
|
||||
- tp-object-attach-fragment 把一个 object 绑定到 content fragment；
|
||||
- tp-object-attach-content-range 把 object 绑定到 leaf 的相对字符范围；
|
||||
- tp-object-attach-content-ranges 批量绑定 range，并复制 tags；
|
||||
- tp-object-attach-content-ranges-owned 批量绑定 candidate-owned tags。
|
||||
|
||||
retain-subtree/reuse-subtree 不会替调用者证明 candidate 完整或输出未变化；
|
||||
producer 仍须提交完整 plan，并承担“不变”证明。
|
||||
|
||||
### 6.2 Mount、update、scope 和 report
|
||||
|
||||
~~~elisp
|
||||
(let* ((surface
|
||||
(tp-surface-mount
|
||||
buffer producer
|
||||
'(:capability content
|
||||
:start 1 :end 1
|
||||
:client-state initial-state
|
||||
:inhibit-read-only t
|
||||
:observers (my-after-commit)))))
|
||||
(tp-surface-update surface producer)
|
||||
(tp-surface-update-scoped
|
||||
surface
|
||||
(list object)
|
||||
producer
|
||||
'(:on-mismatch error :return-report t))
|
||||
(tp-surface-report surface)
|
||||
(tp-surface-report-summary surface)
|
||||
(tp-surface-inspect surface)
|
||||
(tp-surface-unmount surface))
|
||||
~~~
|
||||
|
||||
tp-surface-mount 的 plan-or-producer 可以是 plan、result 或 producer；
|
||||
producer 的调用上下文由 TP 管理。properties surface 只能写属性，content
|
||||
surface 才能拥有和更新文字。可用 mount options：
|
||||
:capability、:start、:end、:inhibit-read-only、:coordinate-mounts、
|
||||
:client-state、:observers。
|
||||
|
||||
tp-surface-update 发布下一份完整 candidate。tp-surface-update-scoped 仍要求
|
||||
producer 生成完整 candidate，但只授权指定 object 当前 mount 范围；
|
||||
:on-mismatch 默认报 tp-scope-mismatch，设为 root 才允许显式 root fallback；
|
||||
:return-report 控制是否返回 report。
|
||||
|
||||
其他 surface API：
|
||||
|
||||
- tp-surface-live-p、tp-surface-revision、tp-surface-client-state；
|
||||
- tp-surface-materialize-string 使用相同 producer/plan 语义生成一次性 string，
|
||||
但不保留 surface、object、binding、subscription 或 anchor；
|
||||
- tp-surface-at-point 通过 side index 返回当前位置的 live objects；
|
||||
- tp-surface-report 返回完整 defensive report；
|
||||
- tp-surface-report-summary 只返回 scalar commit metrics；
|
||||
- tp-surface-inspect 返回 surface、capability、revision、object/mount 数量、
|
||||
client state 和 report；
|
||||
- tp-surface-unmount 卸载并返回 report。Content 会删除自己的 span；
|
||||
properties 只撤销仍由 TP 拥有的 contribution。
|
||||
|
||||
Report 的常用字段包括：
|
||||
:transaction-id、:surface-id、:old-revision、:new-revision、
|
||||
:candidate-source-writes、:invalidated-bindings、:recomputed-bindings、
|
||||
:skipped-bindings、:reconciled-objects、:created-objects、:removed-objects、
|
||||
:moved-objects、:text-operations、:property-operations、
|
||||
:touched-characters、:full-root、:scope-count、:scope-range-count、
|
||||
:scope-fallback、:property-conflicts、:rolled-back、:failure、
|
||||
:observer-errors、:timing。
|
||||
|
||||
### 6.3 Host range 和 tp-watch
|
||||
|
||||
~~~elisp
|
||||
(let ((anchor
|
||||
(tp-range-anchor-create
|
||||
buffer start end
|
||||
:start-insertion-type nil
|
||||
:end-insertion-type t
|
||||
:boundary-policy 'shorten)))
|
||||
;; 在 producer 的 context 中：
|
||||
(tp-object-attach-range context object anchor)
|
||||
(tp-range-anchor-live-p anchor)
|
||||
(tp-range-rebase anchor))
|
||||
~~~
|
||||
|
||||
boundary-policy 可为 stale、shorten、remove。anchor 是 marker-backed opaque
|
||||
range；host text 编辑由 marker 跟随，TP 不扫描附近文字猜测位置。
|
||||
tp-range-rebase 明确接受当前 host properties 作为新 baseline。
|
||||
|
||||
tp-watch 是 properties-only surface 的便捷入口：
|
||||
|
||||
~~~elisp
|
||||
(let ((surface
|
||||
(tp-watch
|
||||
buffer start end
|
||||
(lambda ()
|
||||
(list 'face
|
||||
(if enabled 'success 'shadow))))))
|
||||
(tp-surface-report surface))
|
||||
~~~
|
||||
|
||||
compute 是零参数函数，返回原生 declarations。文字由 host 所有；返回值是
|
||||
底层 properties surface，可交给 update/report/inspect/unmount。
|
||||
|
||||
## 7. 属性查询、区间和 mutation policy
|
||||
|
||||
### 7.1 Direct query
|
||||
|
||||
- tp-get 返回范围内的 (START END PROPS) property intervals；指定 property
|
||||
或 nested path 时只返回对应区间；
|
||||
- tp-at 返回某一位置的完整 plist，或指定 property/nested path 的值；
|
||||
- tp-member 只在 property 存在时返回 (PROPERTY VALUE)，因此可区分 present
|
||||
nil 和 absent；
|
||||
- tp-intervals 返回对象范围的 property intervals，可用 absolute 请求 Buffer
|
||||
原生坐标；
|
||||
- tp-intervals-map 对每个 interval 调用函数；
|
||||
- tp-plist 返回位置或 string range 的合并 property plist；
|
||||
- tp-empty-p 判断对象是否为空；
|
||||
- tp-text-snapshot 返回 string 和 text properties 的防御性快照。
|
||||
|
||||
### 7.2 Native query
|
||||
|
||||
~~~elisp
|
||||
(tp-lookup position 'face
|
||||
:object buffer
|
||||
:mode :text-effective)
|
||||
(tp-property-change position :property 'face :direction :next)
|
||||
(tp-property-any start end 'face 'bold buffer)
|
||||
(tp-property-not-all start end 'face 'bold buffer)
|
||||
|
||||
(tp-with-mutation-policy '(:modified :silent :read-only :inhibit)
|
||||
(tp-apply buffer start end '(face bold)))
|
||||
~~~
|
||||
|
||||
tp-lookup 返回 tp-lookup-result，mode 可为：
|
||||
|
||||
- :text-direct：直接 text property；
|
||||
- :text-effective：考虑 category/default 等 text-property 继承；
|
||||
- :text-source：返回实际 text source；
|
||||
- :char：使用 get-char-property-and-overlay 的字符属性；
|
||||
- :char-source：字符属性的实际来源，overlay 会记录为 :overlay。
|
||||
|
||||
result 的 present-p 区分显式 nil；tp-property-change 的 direction 为 :next
|
||||
或 :previous，property 为 nil 时观察任意属性变化。
|
||||
|
||||
tp-with-mutation-policy 的 :modified 可为 :ordinary 或 :silent，
|
||||
:read-only 可为 :respect 或 :inhibit。支持 ordinary/respect、
|
||||
ordinary/inhibit、silent/inhibit；silent/respect 会报错。
|
||||
|
||||
## 8. Match、regexp、search 和 navigation
|
||||
|
||||
所有 search 都是 presence-aware：省略 VALUE 或显式传入 tp-any-value 匹配
|
||||
所有存在的值；显式 nil 只匹配“存在且值为 nil”。
|
||||
|
||||
### 8.1 按文字匹配并修改
|
||||
|
||||
- tp-match-set：literal pattern 的所有匹配上设置属性；
|
||||
- tp-match-reset：literal pattern 的所有匹配上重置属性；
|
||||
- tp-match-add：literal pattern 的所有匹配上合并属性；
|
||||
- tp-regexp-set、tp-regexp-reset、tp-regexp-add：regexp 匹配，可用 subexp
|
||||
只操作 capture group。
|
||||
|
||||
Pattern 可以是一个 string 或 string 列表。String object 返回新 string；
|
||||
Buffer object 原地修改并返回匹配范围列表。start > end 时边界会交换，
|
||||
匹配不会跨出指定范围。
|
||||
|
||||
### 8.2 查找和批量处理
|
||||
|
||||
~~~elisp
|
||||
(tp-search string 'status)
|
||||
(tp-search start end 'status 'ready buffer)
|
||||
(tp-forward 'status tp-any-value buffer 2)
|
||||
(tp-backward 'status nil buffer)
|
||||
(tp-search-map
|
||||
(lambda (text _start _end _index) (upcase text))
|
||||
'status tp-any-value buffer)
|
||||
~~~
|
||||
|
||||
- tp-search 返回所有匹配的 (START END VALUE)；
|
||||
- tp-forward / tp-backward 在 Buffer 中从 point 搜索并返回 prop-match，
|
||||
在 string 中返回 0-based 区间列表；
|
||||
- tp-forward-do / tp-backward-do 找到第 N 个匹配后只对最后一个执行
|
||||
function，不是 for-each；
|
||||
- tp-search-map 对每个匹配执行 function。function 可返回替换 string、
|
||||
修改 text 后的 string，或 nil 跳过。String 替换必须保持长度不变；
|
||||
Buffer 替换可以改变长度；
|
||||
- tp-search-forward / tp-search-backward 只是 Emacs
|
||||
text-property-search-* 的 obsolete raw wrapper，新增代码使用
|
||||
tp-forward / tp-backward 或直接使用 Emacs primitive。
|
||||
|
||||
## 9. Palette、内置 recipe 和显示辅助
|
||||
|
||||
~~~elisp
|
||||
(define-tp-palette status
|
||||
:fg ("#22863a" . "#3fb950")
|
||||
:bg ("#f0fff4" . "#1a2e1f"))
|
||||
|
||||
(tp-palette-color 'status :fg)
|
||||
(tp-palette-fg-color 'status)
|
||||
(tp-palette-bg-color 'status)
|
||||
(tp-palette-border-color 'status)
|
||||
(tp-palette-has-p 'status :fg)
|
||||
(tp-palette-pure 'status-fg)
|
||||
(tp-set "Ready" 'tp-palette 'status-fg)
|
||||
~~~
|
||||
|
||||
define-tp-palette（别名 tp-define-palette）注册 :fg、:bg、:border。颜色
|
||||
可以是 string、(LIGHT . DARK) 或 (:light LIGHT :dark DARK)。查询和主题工具：
|
||||
|
||||
tp-palette-alist 是 palette lookup 的单一来源；使用
|
||||
define-tp-palette/tp-define-palette 更新它。
|
||||
|
||||
- tp-theme-dark-p、tp-theme-light-p、tp-parse-color；
|
||||
- tp-palette-color、tp-palette-fg-color、tp-palette-bg-color、
|
||||
tp-palette-border-color；
|
||||
- tp-palette-has-p 判断 palette 或 key 是否存在；
|
||||
- tp-palette-p 判断 palette 名；
|
||||
- tp-palette-fg-p、tp-palette-bg-p、tp-palette-fbg-p、tp-palette-border-p
|
||||
判断 NAME-* variant；
|
||||
- tp-palette-pure 去掉 variant suffix；
|
||||
- tp-palette-show 打开 *tp-palette-gallery*，按 q 退出。
|
||||
|
||||
TP 自带的 recipe 包括：
|
||||
|
||||
tp-palette、tp-fg、tp-bg、tp-button、tp-underline、tp-delete、tp-link、
|
||||
tp-space、tp-headline、tp-action。
|
||||
|
||||
显示辅助：
|
||||
|
||||
- tp-pop-to-buffer：清空并填充 buffer 后 pop-to-buffer，最后设为只读；
|
||||
- tp-switch-to-buffer：同样的填充和只读行为，但使用 switch-to-buffer；
|
||||
- tp-display-buffer-mode：为 TP 显示 buffer 提供 buffer-local 的 q 退出键，
|
||||
不修改共享 major-mode map。
|
||||
|
||||
tp-display-buffer-mode-map 是该 minor mode 的 keymap；默认只绑定 q 到
|
||||
quit-window。
|
||||
|
||||
## 10. Debug 和公共 record
|
||||
|
||||
Debug 入口：
|
||||
|
||||
- tp-debug-mode、tp-debug-echo 控制日志行为；
|
||||
- tp-debug-log 记录格式化消息；
|
||||
- tp-debug-clear 清空日志；
|
||||
- tp-debug-show 显示日志；
|
||||
- tp-with-current-buffer 在指定 Buffer 中执行 body；
|
||||
- tp-face-properties 列出 face family properties。
|
||||
|
||||
以下公共结果类型由 cl-defstruct 提供 predicate 和字段 accessor。调用者不应
|
||||
直接调用内部 constructor；优先使用前文的 create/query API：
|
||||
|
||||
- tp-property-policy：id、normalizer、validator、equality、merge、projector；
|
||||
- tp-signal：id、committed-value、equality、scope、revision 等运行时字段；
|
||||
- tp-binding：id、owner、key、compute、last-value、dependencies、lifecycle
|
||||
等运行时字段；
|
||||
- tp-surface-plan：key、kind、text、props、children、tags、capability；
|
||||
- tp-surface-result：plan、client-state 及 owned/consumed 状态；
|
||||
- tp-lookup-result：property、value、present-p、source、mode、object、
|
||||
position、overlay。
|
||||
|
||||
## 11. 错误、生命周期和已删除 API
|
||||
|
||||
重要错误类型：
|
||||
|
||||
- core：tp-unsupported-buffer；
|
||||
- property：tp-property-error、tp-invalid-property-policy、
|
||||
tp-invalid-declaration；
|
||||
- recipe：tp-invalid-layer-definition、tp-unresolved-layer；
|
||||
- reactive：tp-reactive-error、tp-invalid-signal-scope、tp-disposed-signal、
|
||||
tp-disposed-binding、tp-binding-cycle；
|
||||
- surface：tp-surface-error、tp-invalid-surface-plan、tp-duplicate-object-key、
|
||||
tp-invalid-prepare-context、tp-stale-object、tp-cross-surface-object、
|
||||
tp-orphan-object、tp-capability-error、tp-stale-mount、
|
||||
tp-property-conflict、tp-dead-surface、tp-invalid-range-anchor、
|
||||
tp-invalid-content-range、tp-producer-buffer-mutation、
|
||||
tp-publication-mismatch、tp-owned-result-error、tp-scope-mismatch。
|
||||
|
||||
Live object、binding、surface、anchor 或 signal 被 dispose、unmount 或
|
||||
Buffer kill 后，继续使用会报相应 stale/disposed 错误。Observer 只在成功
|
||||
commit 后运行；observer error 会记录在 report，不会回滚已提交 publication。
|
||||
|
||||
TP 1.0 已删除并且不应在新代码中使用：
|
||||
|
||||
- tp-render.el、tp-stack.el、managed stack mutation；
|
||||
- tp-text、$variable、inline tp-name/tp-layers/tp-meta runtime database；
|
||||
- layer-to-buffer registry、scan-driven refresh、managed attach/detach；
|
||||
- tp-with-batch-updates 和旧 CSS/ECSS runtime integration。
|
||||
|
||||
因此，当前正确的组合是：静态声明用 recipe/direct API，已有文字的响应式
|
||||
属性用 tp-watch，TP 自己拥有的响应式文字用 content surface。
|
||||
|
||||
## 12. 完整模块索引
|
||||
|
||||
| 模块 | 当前公共入口 |
|
||||
| --- | --- |
|
||||
| tp-core.el | tp-debug-*、tp-with-current-buffer、tp-intervals、tp-intervals-map、tp-empty-p、tp-plist、tp-text-snapshot |
|
||||
| tp-style.el | tp-define-property-policy、tp-property-policy、tp-text-property-id、tp-register-text-property、tp-text-declarations、tp-computed、tp-resolve-value、tp-merge-declarations、tp-define-style、tp-style-declarations、tp-undefine-style |
|
||||
| tp-layer.el | define-tp/tp-define-layer、define-tps/define-tp-group/tp-define-group、layer/group query、tp-layer-reset、tp-undefine-*、tp-describe-layer |
|
||||
| tp-reactive.el | signal、binding、transaction、variable adapter、counter 和 reset API |
|
||||
| tp-surface.el | plan/result、object、range anchor、surface lifecycle、scoped update、report、tp-watch |
|
||||
| tp-ops.el | tp-propertize、tp-apply、tp-set、tp-reset、tp-add、tp-remove、tp-clear、tp-get、tp-at、tp-member |
|
||||
| tp-search.el | tp-match-*、tp-regexp-*、tp-search、tp-search-map、tp-forward*、tp-backward*、tp-any-value |
|
||||
| tp-query.el | tp-lookup、tp-property-change、tp-property-any、tp-property-not-all、tp-with-mutation-policy |
|
||||
| tp-palette.el | palette definition、theme/color lookup、palette predicates |
|
||||
| tp-builtins.el | built-in recipes、tp-palette-show、display-buffer macros/mode |
|
||||
|
||||
Makefile 提供 make test、make test-shuffled、make doctest、make compile-all WERROR=t、
|
||||
make checkdoc、make package-lint、make diff-check 和 make benchmark。实现细节
|
||||
和测试合同以 source、tests/、[API semantics](API-SEMANTICS.md) 和
|
||||
[architecture](ARCHITECTURE.md) 为准。
|
||||
@ -2,6 +2,8 @@
|
||||
|
||||
本文记录 TP 1.0 当前公共 API 的 ownership、presence、响应式、retained surface、事务与失败合同。它描述已经实现的行为；目标背景与设计理由见 [retained runtime architecture](retained-runtime-target-architecture.md)。
|
||||
|
||||
完整的公共符号、参数形状、返回值和示例见 [API reference](API-REFERENCE.md)。
|
||||
|
||||
## 1. 产品边界
|
||||
|
||||
TP 负责最终 Emacs text property policy/contribution、signals/bindings、stable objects、marker-backed mounts、surface diff、transaction、rollback 和 Buffer publication。
|
||||
@ -111,7 +113,7 @@ Search/match/regexp/navigation/query API 继续委托 Emacs 原生 text-property
|
||||
| `tags` | opaque indexed metadata，TP 不解释其业务含义 |
|
||||
| `capability` | `content` 或 `properties` |
|
||||
|
||||
Plan 不允许 marker、buffer position、patch op、producer closure 或 binding closure。Constructor 防御性复制 string、props、children 与 tags，使 caller 后续 mutation 不改变 committed plan。
|
||||
Plan 不允许 marker、buffer position、patch op、producer closure 或 binding closure。Constructor 防御性复制 caller 提供的 key、kind、text、props、children list 与 tags，使 caller 后续 mutation 不改变 committed plan。`tp-surface-result-create` 只携带 plan 与 opaque client state；TP 在 prepare transaction 内从该 plan 生成唯一的 authoritative rendered output，不接受第二份 caller-provided text 或 traversal records。Result 与 producer normalization 会在各自边界建立防御性 plan snapshot。Producer 如果为当前 candidate freshly allocate 了完整 plan tree，并且之后不再 mutation 或 expose，可使用 `tp-surface-plan-create-owned` 与 `tp-surface-result-create-owned` 将 plan 所有权转给 TP，跳过重复 snapshot；owned result 必须绑定当前 active prepare context，并且只允许被 prepare normalization 消费一次；普通 caller-owned plan 必须使用复制入口。
|
||||
|
||||
producer 在 prepare 阶段接收 context，并在产生 plan 前调用：
|
||||
|
||||
@ -125,6 +127,12 @@ Candidate object 只有成功 publication 后才变为 live。失败 candidate h
|
||||
|
||||
无可见字符但需要保留的 logical object 使用 `tp-object-retain`。一个 logical object 可以通过 `tp-object-attach-fragment` 关联多个离散 plan fragments；attachment 保存在 prepare side state，不进入 plan。
|
||||
|
||||
当 producer 已经证明一个现有 logical subtree 在本次 candidate 中保持不变，可以使用 `tp-object-retain-subtree` 复用当前 live root 下已知的 object path。该 API 会把 subtree objects 标记为 touched/retained，并保留其 live bindings；它不创建缺失对象，也不替 producer 验证 candidate plan、输出范围或布局不变性。调用方仍必须提交完整 candidate plan，并在不满足证明时回退到普通 `tp-object-ensure` 路径。若完整 candidate 仍会重新提交这些对象的 output attachment，但已证明它们的 identity、lifecycle 和 output 不变，可使用 `tp-object-reuse-subtree`：对象保留在 candidate 中但不进入 touched/reconcile 集合。
|
||||
|
||||
Content range ownership 有两个入口：`tp-object-attach-content-ranges` 对每个 `:tags` 建立防御性快照；只有当 producer 为当前 candidate 新建了 tags、之后不会再修改或暴露它们时，才可使用 `tp-object-attach-content-ranges-owned` 转移这些值的所有权并跳过复制。转移入口不改变失败 candidate 的 rollback 语义；未成功 publication 的值会随 candidate 一起丢弃。普通 caller-owned tags 必须使用复制入口。
|
||||
|
||||
`tp-surface-report` 始终返回完整的防御性 report snapshot。只需要 transaction、operation、scope 或 object reconciliation 计数等提交标量的 integration caller 应使用 `tp-surface-report-summary`，它不暴露 nested report payload，也不为读取这些标量复制整份 report。
|
||||
|
||||
## 8. Surface lifecycle
|
||||
|
||||
### 8.1 Materialize
|
||||
@ -147,7 +155,7 @@ Mount options 支持 `:capability`、`:start`、`:end`、`:inhibit-read-only`、
|
||||
|
||||
`content` surface 拥有其 span 的 text 和 properties，可以插入、删除、替换或移动输出。`properties` surface 只能贡献声明的 properties，不能替换 host text。
|
||||
|
||||
`tp-surface-update-scoped` 仍接收完整 candidate。TP 从 object-to-mount index 得到授权范围，验证 candidate 没有改变范围外输出，再在同一 transaction 发布。默认 mismatch 报 `tp-scope-mismatch`；`(:on-mismatch root)` 显式允许 full-root fallback。
|
||||
`tp-surface-update-scoped` 仍接收完整 candidate。TP 从 object-to-mount index 得到授权范围，验证 candidate 没有改变范围外输出，再在同一 transaction 发布。默认 mismatch 报 `tp-scope-mismatch`；`(:on-mismatch root)` 显式允许 full-root fallback。默认返回 defensive report snapshot；调用方如果只通过 `tp-surface-report-summary` 读取标量提交指标，可传 `(:return-report nil)` 避免构造完整 report snapshot。
|
||||
|
||||
相等 candidate 不产生 publication，surface revision 和 buffer modified state 保持不变。
|
||||
|
||||
@ -204,11 +212,16 @@ TP 为每个 interval 保存：
|
||||
|
||||
## 13. Error ownership
|
||||
|
||||
Surface publication 还会使用 `tp-invalid-content-range`、
|
||||
`tp-producer-buffer-mutation`、`tp-publication-mismatch` 和
|
||||
`tp-owned-result-error`；它们分别归属于 content range 校验、prepare
|
||||
buffer guard、publication journal 和 owned producer result 合同。
|
||||
|
||||
主要错误类型：
|
||||
|
||||
- property/declaration：`tp-property-error`、`tp-invalid-property-policy`、`tp-invalid-declaration`、`tp-invalid-layer-definition`、`tp-unresolved-layer`；
|
||||
- reactive：`tp-reactive-error`、`tp-invalid-signal-scope`、`tp-disposed-signal`、`tp-disposed-binding`、`tp-binding-cycle`；
|
||||
- retained surface：`tp-invalid-surface-plan`、`tp-duplicate-object-key`、`tp-invalid-prepare-context`、`tp-stale-object`、`tp-cross-surface-object`、`tp-orphan-object`、`tp-capability-error`、`tp-stale-mount`、`tp-property-conflict`、`tp-dead-surface`、`tp-invalid-range-anchor`、`tp-scope-mismatch`。
|
||||
- retained surface：`tp-surface-error`、`tp-invalid-surface-plan`、`tp-duplicate-object-key`、`tp-invalid-prepare-context`、`tp-stale-object`、`tp-cross-surface-object`、`tp-orphan-object`、`tp-capability-error`、`tp-stale-mount`、`tp-property-conflict`、`tp-dead-surface`、`tp-invalid-range-anchor`、`tp-invalid-content-range`、`tp-producer-buffer-mutation`、`tp-publication-mismatch`、`tp-owned-result-error`、`tp-scope-mismatch`。
|
||||
|
||||
内部 computation 不吞错或返回貌似合理的 fallback。只有用户入口和 batch test runner等外层边界负责把错误转换为展示信息。
|
||||
|
||||
|
||||
@ -2,6 +2,8 @@
|
||||
|
||||
本文描述 TP 1.0 当前实现的模块边界、权威状态、数据流和事务模型。公共行为合同见 [API semantics](API-SEMANTICS.md)，设计背景见 [retained runtime architecture](retained-runtime-target-architecture.md)。
|
||||
|
||||
按功能查找公共入口和用法时，使用 [API reference](API-REFERENCE.md)。
|
||||
|
||||
## 1. 定位
|
||||
|
||||
TP 是通用 retained/reactive text runtime：
|
||||
@ -110,7 +112,7 @@ Object identity is scoped to one surface and derived from:
|
||||
|
||||
Candidate objects exist only inside the context. Successful publication promotes them to live objects; failed contexts dispose them and their bindings/anchors. `tp-object-resolve` queries live identity by key path without creating state.
|
||||
|
||||
The context records touched objects/bindings. Omitted objects are removed. Omitted bindings default to deletion unless an explicit lifecycle says retain. A logical object with no direct plan node must call `tp-object-retain`; disjoint physical output is attached through `tp-object-attach-fragment`.
|
||||
The context records touched objects/bindings. Omitted objects are removed. Omitted bindings default to deletion unless an explicit lifecycle says retain. A logical object with no direct plan node must call `tp-object-retain`; disjoint physical output is attached through `tp-object-attach-fragment`. Content ranges normally use `tp-object-attach-content-ranges`, which defensively snapshots opaque tags. A producer that freshly allocates candidate-local tags and never mutates or exposes them may use `tp-object-attach-content-ranges-owned` to transfer those snapshots without another copy. The same candidate-local ownership rule applies to `tp-surface-plan-create-owned` and `tp-surface-result-create-owned`; an owned result is bound to the active prepare context and consumed once, while normal plan/result constructors remain defensive boundaries.
|
||||
|
||||
## 7. Pure surface plans
|
||||
|
||||
@ -170,7 +172,7 @@ TP reconciles object identity by the prepare tree and compares old/new plans for
|
||||
- mount/index changes;
|
||||
- scoped output authorization.
|
||||
|
||||
`tp-surface-update-scoped` maps requested objects directly through the object-to-mount index. For content surfaces it proves old/new changes stay within those mounted ranges; properties surfaces perform the equivalent contribution-range proof. A mismatch is an error unless root fallback is explicitly selected.
|
||||
`tp-surface-update-scoped` maps requested objects directly through the object-to-mount index. For content surfaces it proves old/new changes stay within those mounted ranges; properties surfaces perform the equivalent contribution-range proof. A mismatch is an error unless root fallback is explicitly selected. Callers that only need scalar commit metrics may request no report snapshot and read `tp-surface-report-summary` after publication.
|
||||
|
||||
An equal candidate produces no prepared publication. It preserves revision, report, buffer modified state, markers, and client state.
|
||||
|
||||
|
||||
@ -1,44 +1,69 @@
|
||||
# Reproducible benchmark evidence
|
||||
# Reproducible benchmark guide
|
||||
|
||||
> **Historical TP 0.3 benchmark snapshot; obsolete for TP 1.0.** These results measure the removed managed stack, `tp-text`, layer registry, scan-driven renderer, and 0.3 benchmark runner. They are preserved as historical evidence only and are neither TP 1.0 performance baselines nor current release gates. Current runtime structure and verification expectations are documented in the [README](../README.md), [current architecture](ARCHITECTURE.md), and [API contract](API-SEMANTICS.md).
|
||||
This document describes the benchmark runner shipped with TP 1.0. It measures
|
||||
the current retained/reactive runtime; it is not a historical TP 0.3 stack
|
||||
benchmark and it does not impose a release threshold.
|
||||
|
||||
## Command and environment
|
||||
## Run
|
||||
|
||||
```sh
|
||||
make benchmark \
|
||||
EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs \
|
||||
LOAD_EXTRA='-L /tmp/tp-elpa.Ur243x/dash-2.20.0'
|
||||
```
|
||||
Use the Makefile entry point:
|
||||
|
||||
- Emacs: 30.2
|
||||
- Fixed seeds: `1`, `7`, `42`, `747555`
|
||||
- Reproducible generated seed: `8675309`
|
||||
- Every scenario performs a correctness assertion before accepting timing.
|
||||
- The full command completed successfully on 2026-07-28.
|
||||
~~~sh
|
||||
make benchmark
|
||||
~~~
|
||||
|
||||
The runner is `tp-benchmark.el`; `make benchmark` is the stable entry point. Output rows include scenario, status, fixture, seed, requested/actual size, operations, scanned/changed/refreshed counts, elapsed wall time, and GC count.
|
||||
The equivalent batch command is:
|
||||
|
||||
## Representative result: seed 42
|
||||
~~~sh
|
||||
emacs -Q --batch -L . -l tp-benchmark.el -f tp-benchmark-run
|
||||
~~~
|
||||
|
||||
| Scenario | Requested / actual | Operations | Scanned | Changed | Refreshed | Elapsed (s) | GC |
|
||||
| --- | ---: | ---: | ---: | ---: | ---: | ---: | ---: |
|
||||
| large text | 100,000 | 2 | 100,000 | 100,000 | 0 | 0.000304 | 0 |
|
||||
| large text | 1,000,000 | 2 | 1,000,000 | 1,000,000 | 0 | 0.000323 | 0 |
|
||||
| fragmented intervals | 1,000 | 1 | 1,000 | 500 | 0 | 0.044254 | 0 |
|
||||
| fragmented intervals | 10,000 | 1 | 10,000 | 5,000 | 0 | 0.404836 | 1 |
|
||||
| fragmented intervals | 50,000 | 1 | 50,000 | 25,000 | 0 | 1.965066 | 3 |
|
||||
| stack depth | 1 | 2 | 2,000 | 2,000 | 0 | 0.000909 | 0 |
|
||||
| stack depth | 5 | 6 | 2,000 | 2,000 | 0 | 0.003204 | 0 |
|
||||
| stack depth | 20 | 21 | 2,000 | 2,000 | 0 | 0.012905 | 0 |
|
||||
| stack depth | 50 | 51 | 2,000 | 2,000 | 0 | 0.037830 | 0 |
|
||||
| reactive fan-out | 1 / 1 | 1 | 1 | 1 | 1 | 0.000763 | 0 |
|
||||
| reactive fan-out | 10 / 10 | 1 | 10 | 10 | 10 | 0.005469 | 0 |
|
||||
| reactive fan-out | 100 / 100 | 1 | 100 | 100 | 100 | 0.051376 | 0 |
|
||||
| reactive fan-out | 500 / 200 | 1 | 200 | 200 | 200 | 0.102989 | 0 |
|
||||
| theme refresh | 1 / 1 | 1 | 1,000 | 0 | 1 | 0.001317 | 0 |
|
||||
The runner uses fixed seeds 1, 7, 42, 747555 and generated seed 8675309. Each
|
||||
scenario performs a correctness assertion before timing the operation. Record
|
||||
the Emacs version, machine, seed, and full output when comparing runs.
|
||||
|
||||
The 500-buffer fan-out fixture is intentionally capped at 200 live buffers on local hardware; output reports both requested and actual counts. Theme refresh uses the v1 conservative managed-range strategy.
|
||||
## Scenarios
|
||||
|
||||
For every seed, the runner executes:
|
||||
|
||||
| Scenario | Fixtures |
|
||||
| --- | --- |
|
||||
| large-text | strings of 100,000 and 1,000,000 characters; set and presence-aware search |
|
||||
| fragmented | 1,000, 10,000, and 50,000 alternating property intervals |
|
||||
| retained-keyed-reconcile | retained content with 10, 100, and 1,000 stable keyed entries |
|
||||
| signal-sparse-update | one target binding beside 1, 100, and 10,000 unrelated bindings |
|
||||
| transaction-batch | 1, 100, and 10,000 writes to one retained surface |
|
||||
| equal-write-noop | the same write counts, all equal to the committed value |
|
||||
|
||||
The retained scenarios verify stable object reconciliation, correct published
|
||||
text, dependency-local recomputation, one publication for a batch, and no
|
||||
revision change for equal writes. A failed assertion aborts the run instead of
|
||||
producing misleading timing evidence.
|
||||
|
||||
## Output
|
||||
|
||||
Each row is a whitespace-separated key/value record. The stable fields are:
|
||||
|
||||
scenario, status, fixture, seed, requested, actual, operations, objects,
|
||||
subscribers, invalidated, recomputed, skipped, text-operations,
|
||||
property-operations, touched, revision, published, elapsed, gcs, and note.
|
||||
|
||||
The output is deliberately machine-readable enough for local comparison, but
|
||||
it is not a compatibility format. Interpret it together with the scenario
|
||||
source in tp-benchmark.el.
|
||||
|
||||
## Interpretation
|
||||
|
||||
These figures are advisory, not release thresholds. Fragmented interval count is the clearest scaling risk and should remain the first optimization target. Large-text lookup over one property run and deep-stack top lookup are cheap in this fixture, but those results must not be generalized to fragmented text or repeated stack mutation.
|
||||
These measurements are advisory. Runtime, garbage collection, Emacs build,
|
||||
machine load, and buffer implementation details affect absolute timings.
|
||||
Compare like-for-like runs, inspect correctness failures first, and use the
|
||||
reports/counters to explain a regression:
|
||||
|
||||
- fragmented measures expose interval-run scaling;
|
||||
- retained-keyed-reconcile measures keyed object reuse and publication work;
|
||||
- signal-sparse-update checks that unrelated bindings are not recomputed;
|
||||
- transaction-batch measures deduplicated recomputation and one surface commit;
|
||||
- equal-write-noop checks that equal values do not publish a new revision.
|
||||
|
||||
For the contracts behind these scenarios, read [API semantics](API-SEMANTICS.md),
|
||||
[architecture](ARCHITECTURE.md), and the [public API reference](API-REFERENCE.md).
|
||||
|
||||
@ -1,801 +1,12 @@
|
||||
# tp.el 代码分析报告
|
||||
# Code analysis（历史归档）
|
||||
|
||||
> **历史 TP 0.1/0.3 分析，TP 1.0 已废弃。** 本报告混合记录拆分前的单文件 TP 0.1 与后续 TP 0.3 模块状态，其中的 `tp-render.el`、`tp-stack.el`、`tp-text`、inline `tp-name`/`tp-layers` 和扫描式响应更新均已从 TP 1.0 删除。下文的文件结构、调用堆栈、代码位置、API 与“当前”状态只属于历史快照，不适用于现行实现；正文保持原样作为设计证据。当前事实见 [README](../README_CN.md)、[当前架构](ARCHITECTURE.md)、[API 合同](API-SEMANTICS.md) 与 [1.0 变更记录](../CHANGELOG.md)。
|
||||
这是早期 TP 0.1/0.3 的代码分析快照。它描述的 tp-render、tp-stack、tp-text、
|
||||
inline metadata 和 managed registry 已被 TP 1.0 删除，因此本文不再是当前
|
||||
实现的说明，也不应被用来推断可用 API。
|
||||
|
||||
本报告旨在帮助想要参与 tp.el 开发的开发者快速了解项目结构、核心功能实现、以及潜在的优化方向。
|
||||
当前代码的功能、用法和模块边界请阅读：
|
||||
|
||||
## 目录
|
||||
|
||||
- [项目概述](#项目概述)
|
||||
- [文件结构](#文件结构)
|
||||
- [核心功能函数调用堆栈](#核心功能函数调用堆栈)
|
||||
- [1. 文本属性设置 tp-set](#1-文本属性设置-tp-set)
|
||||
- [2. 深度合并属性 tp-add](#2-深度合并属性-tp-add)
|
||||
- [3. 属性层推送 tp-push-layer](#3-属性层推送-tp-push-layer)
|
||||
- [4. 响应式层定义 define-tp](#4-响应式层定义-define-tp)
|
||||
- [5. 响应式更新触发](#5-响应式更新触发)
|
||||
- [6. 模式匹配 tp-match-set](#6-模式匹配-tp-match-set)
|
||||
- [7. 搜索与遍历 tp-search-map](#7-搜索与遍历-tp-search-map)
|
||||
- [关键数据结构](#关键数据结构)
|
||||
- [潜在问题分析](#潜在问题分析)
|
||||
- [架构优化建议](#架构优化建议)
|
||||
- [开发入门指南](#开发入门指南)
|
||||
|
||||
---
|
||||
|
||||
## 项目概述
|
||||
|
||||
tp.el 是一个 Emacs Lisp 文本属性操作库，拆分前的单文件版本采用概念上的 **五层架构设计**：
|
||||
|
||||
```
|
||||
┌─────────────────────────────────────────────────────────────────┐
|
||||
│ 第五层：高级 API │
|
||||
│ tp-match-set, tp-regexp-set, tp-forward-do, tp-search-map │
|
||||
├─────────────────────────────────────────────────────────────────┤
|
||||
│ 第四层：响应式系统 │
|
||||
│ define-tp, define-tps, tp--reactive-variable-watcher │
|
||||
├─────────────────────────────────────────────────────────────────┤
|
||||
│ 第三层：属性层系统 │
|
||||
│ tp-push-layer, tp-pop-layer, tp-rotate-layer │
|
||||
├─────────────────────────────────────────────────────────────────┤
|
||||
│ 第二层：核心属性操作 │
|
||||
│ tp-set, tp-reset, tp-add, tp-get, tp-at, tp-remove │
|
||||
├─────────────────────────────────────────────────────────────────┤
|
||||
│ 第一层：基础工具函数 │
|
||||
│ tp--parse-args, tp--deep-merge-plist, tp-intervals │
|
||||
└─────────────────────────────────────────────────────────────────┘
|
||||
```
|
||||
|
||||
0.2.0 的模块拆分大体沿用了这一分层思路，并把"响应式系统向上调用高级 API"的
|
||||
矛盾收拢为 tp-render.el 安装的钩子变量，详见 [ARCHITECTURE.md](ARCHITECTURE.md)。
|
||||
|
||||
---
|
||||
|
||||
## 文件结构
|
||||
|
||||
当前（0.3.0）文件结构：
|
||||
|
||||
```
|
||||
tp/
|
||||
├── tp.el # 总入口，按序加载全部模块（62 行）
|
||||
├── tp-core.el # 区间遍历、plist/face 合并引擎、调试、$var 工具（781 行）
|
||||
├── tp-reactive.el # 响应式依赖注册表、变量监听、批量队列（370 行）
|
||||
├── tp-layer.el # define-tp / define-tps、层注册表与解析（1295 行）
|
||||
├── tp-ops.el # 核心属性操作 tp-set/get/at/remove/...（916 行）
|
||||
├── tp-search.el # 模式匹配、搜索与导航（810 行）
|
||||
├── tp-render.el # 响应式重渲染引擎（501 行）
|
||||
├── tp-stack.el # 属性层栈操作（709 行）
|
||||
├── tp-palette.el # 明/暗主题调色板数据（351 行）
|
||||
├── tp-builtins.el # 内置层与辅助工具（193 行）
|
||||
├── tests/
|
||||
│ ├── tp-tests.el # 综合 ERT 测试套件
|
||||
│ ├── tp-*-tests.el # 各模块回归测试套件
|
||||
│ ├── tp-doctest.el # README 可执行示例
|
||||
│ └── tp-run-shuffled.el # 乱序 ERT 运行器
|
||||
├── Makefile # test / compile / clean
|
||||
├── docs/
|
||||
│ ├── ARCHITECTURE.md # 架构文档
|
||||
│ ├── CODE-ANALYSIS.md # 代码分析报告（本文档）
|
||||
│ ├── reactive-text-properties.md # 响应式功能文档（中文）
|
||||
│ ├── reactive-text-properties-en.md # 响应式功能文档（英文）
|
||||
│ ├── reactive-optimization.md # 优化文档（中文）
|
||||
│ └── reactive-optimization-en.md # 优化文档（英文）
|
||||
├── README.md # 英文说明文档
|
||||
└── README_CN.md # 中文说明文档
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## 核心功能函数调用堆栈
|
||||
|
||||
### 1. 文本属性设置 tp-set
|
||||
|
||||
`tp-set` 是最核心的属性设置函数，支持三种调用方式。
|
||||
|
||||
#### 调用堆栈
|
||||
|
||||
```
|
||||
tp-set (用户调用入口)
|
||||
│
|
||||
├─→ tp--parse-args (解析参数格式)
|
||||
│ │
|
||||
│ └─→ tp--resolve-props (解析属性，包括层名称)
|
||||
│ │
|
||||
│ ├─→ tp-layer-props (获取层定义的属性)
|
||||
│ ├─→ tp--collect-reactive-symbols (收集 $var 符号)
|
||||
│ ├─→ tp--resolve-reactive-symbols (解析为实际值)
|
||||
│ └─→ tp--register-reactive-deps (注册响应式依赖)
|
||||
│
|
||||
├─→ tp--handle-tp-text-property (处理 tp-text 特殊属性)
|
||||
│ │
|
||||
│ └─→ (替换文本内容，如果 tp-text 存在)
|
||||
│
|
||||
└─→ put-text-property / propertize (Emacs 原生 API)
|
||||
```
|
||||
|
||||
#### 关键代码位置
|
||||
|
||||
（0.2.0 模块化后按"函数 → 模块文件"定位；文件内具体行号请用 `M-x xref-find-definitions` 查找。）
|
||||
|
||||
| 函数 | 模块文件 | 作用 |
|
||||
|------|----------|------|
|
||||
| `tp-set` | tp-ops.el | 主入口函数 |
|
||||
| `tp--parse-args` | tp-ops.el | 解析多种调用格式 |
|
||||
| `tp--resolve-props` | tp-layer.el | 展开层名称和响应式变量 |
|
||||
| `tp--handle-tp-text-property` | tp-render.el | 处理 tp-text 文本替换（经钩子 `tp--tp-text-handler-function` 安装到 tp-ops） |
|
||||
| `tp-add` | tp-ops.el | 深度合并属性 |
|
||||
| `tp-push-layer` | tp-stack.el | 推送层到栈顶 |
|
||||
| `tp-put-layer` | tp-stack.el | 在指定位置放置层 |
|
||||
| `define-tp` | tp-layer.el | 定义自定义层（宏）|
|
||||
| `define-tps` | tp-layer.el | 定义层组（宏）|
|
||||
| `tp--reactive-variable-watcher` | tp-reactive.el | 响应式变量监听器回调 |
|
||||
| `tp--update-layer-regions` | tp-render.el | 更新使用层的文本区域 |
|
||||
| `tp-search-map` | tp-search.el | 搜索并应用函数 |
|
||||
| `tp--match-apply` | tp-search.el | 模式匹配内部实现 |
|
||||
|
||||
---
|
||||
|
||||
### 2. 深度合并属性 tp-add
|
||||
|
||||
`tp-add` 实现属性的深度合并，特别是 face 属性的智能合并。
|
||||
|
||||
#### 调用堆栈
|
||||
|
||||
```
|
||||
tp-add (用户调用入口)
|
||||
│
|
||||
├─→ tp--parse-args (解析参数)
|
||||
│
|
||||
├─→ tp--handle-tp-text-property (处理 tp-text)
|
||||
│
|
||||
├─→ text-properties-at (获取现有属性)
|
||||
│
|
||||
├─→ tp--prepend-face (智能合并 face 属性)
|
||||
│ │
|
||||
│ └─→ tp--deep-merge-plist (递归合并 plist)
|
||||
│
|
||||
├─→ tp--deep-merge-plist (合并其他嵌套属性)
|
||||
│
|
||||
└─→ put-text-property (设置合并后的属性)
|
||||
```
|
||||
|
||||
#### Face 合并逻辑
|
||||
|
||||
```elisp
|
||||
;; 输入
|
||||
(tp-add 1 10 '(face (:foreground "red"))) ; 已存在
|
||||
(tp-add 1 10 '(face bold)) ; 新增
|
||||
|
||||
;; 结果: face 是 (bold (:foreground "red"))
|
||||
;; - 符号 face 被前置到列表
|
||||
;; - plist face 被深度合并
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
### 3. 属性层推送 tp-push-layer
|
||||
|
||||
`tp-push-layer` 将属性层推送到栈顶，实现多层属性的堆叠管理。
|
||||
|
||||
#### 调用堆栈
|
||||
|
||||
```
|
||||
tp-push-layer (用户调用入口)
|
||||
│
|
||||
└─→ tp-put-layer (在指定索引放置层)
|
||||
│
|
||||
├─→ tp--normalize-layer-spec (规范化层规格)
|
||||
│ │
|
||||
│ └─→ tp-layer-props (获取层属性，添加 tp-name)
|
||||
│
|
||||
├─→ tp-group-props (如果是层组，获取所有层属性)
|
||||
│
|
||||
├─→ tp-empty-p (检查是否为空)
|
||||
│
|
||||
├─→ tp--get-layer-stack (获取现有层栈)
|
||||
│
|
||||
├─→ tp--build-layer-props (构建包含 tp-layers 的属性)
|
||||
│
|
||||
└─→ tp-intervals-map (遍历区间应用属性)
|
||||
│
|
||||
└─→ set-text-properties / put-text-property
|
||||
```
|
||||
|
||||
#### 层栈存储结构
|
||||
|
||||
```elisp
|
||||
;; 可见层属性直接存储为文本属性
|
||||
;; 隐藏层存储在 tp-layers 属性中
|
||||
|
||||
;; 例如：两层栈
|
||||
'(face (:foreground "red") ; 顶层（可见）属性
|
||||
tp-name layer1 ; 顶层名称
|
||||
tp-layers ; 下层列表
|
||||
((face (:background "blue") ; 第一个隐藏层
|
||||
tp-name layer2)))
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
### 4. 响应式层定义 define-tp
|
||||
|
||||
`define-tp` 宏定义支持响应式变量的自定义层。
|
||||
|
||||
#### 宏展开流程
|
||||
|
||||
```
|
||||
define-tp (宏调用)
|
||||
│
|
||||
├─→ tp--parse-define-layer-args (解析 :props, :data, :compute, :watch, :transform)
|
||||
│
|
||||
├─→ tp--collect-reactive-symbols (收集所有 $var 符号)
|
||||
│
|
||||
├─→ tp--unregister-reactive-deps (如果重新定义，先清除旧依赖)
|
||||
│
|
||||
├─→ tp--ensure-reactive-variables (确保 $var 对应的变量已定义)
|
||||
│
|
||||
├─→ tp--register-layer-data (注册 :data 变量)
|
||||
│ │
|
||||
│ └─→ add-variable-watcher (为每个变量添加监听器)
|
||||
│
|
||||
├─→ tp--register-layer-computed (注册 :compute 计算属性)
|
||||
│
|
||||
├─→ tp--apply-initial-computed (计算初始值)
|
||||
│
|
||||
├─→ tp--register-reactive-deps (注册响应式依赖)
|
||||
│
|
||||
├─→ tp--register-layer-watchers (注册 :watch 回调)
|
||||
│
|
||||
├─→ tp--resolve-reactive-symbols (解析 $var 为当前值)
|
||||
│
|
||||
└─→ tp--set-layer-props (存储到 tp-layer-alist)
|
||||
```
|
||||
|
||||
#### 关键数据结构
|
||||
|
||||
```elisp
|
||||
;; 层定义存储
|
||||
tp-layer-alist
|
||||
;; => ((layer-name arglist body-form) ...)
|
||||
;; 或 ((layer-name nil resolved-props) ...) ; 非参数化层
|
||||
|
||||
;; 响应式依赖
|
||||
tp-reactive-deps
|
||||
;; => ((my-color . ((my-layer . '(face (:foreground $my-color)))))
|
||||
;; (my-bg . ((my-layer . '(face (:background $my-bg))))))
|
||||
|
||||
;; 计算属性
|
||||
tp-layer-computed
|
||||
;; => ((my-layer . ((full-name . (lambda () (concat first last))))))
|
||||
|
||||
;; 数据变量
|
||||
tp-layer-data
|
||||
;; => ((my-layer . (first-name last-name)))
|
||||
|
||||
;; 监听回调
|
||||
tp-layer-watchers
|
||||
;; => ((my-layer . ((first-name . (lambda (new old layer) ...)))))
|
||||
|
||||
;; 转换函数
|
||||
tp-layer-transforms
|
||||
;; => ((my-layer . (lambda (text) (upcase text))))
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
### 5. 响应式更新触发
|
||||
|
||||
当响应式变量通过 `setq` 改变时，自动触发更新。
|
||||
|
||||
#### 调用堆栈
|
||||
|
||||
```
|
||||
(setq my-color "blue") ; 用户改变变量
|
||||
│
|
||||
└─→ tp--reactive-variable-watcher (由 add-variable-watcher 注册)
|
||||
│
|
||||
├─→ (检查是否在批量更新模式)
|
||||
│ └─→ 如果是，添加到 tp--batch-update-pending 并返回
|
||||
│
|
||||
├─→ tp--invoke-layer-watchers (调用 :watch 回调)
|
||||
│
|
||||
├─→ tp--update-layer-computed (更新计算属性)
|
||||
│ │
|
||||
│ ├─→ (调用计算函数)
|
||||
│ ├─→ tp--resolve-reactive-symbols (解析新值)
|
||||
│ └─→ tp--set-layer-props (更新层定义)
|
||||
│
|
||||
├─→ tp--update-layer-regions (更新文本区域)
|
||||
│ │
|
||||
│ ├─→ tp-layer-props (获取新属性)
|
||||
│ │
|
||||
│ └─→ tp-search-map (遍历所有使用该层的区域)
|
||||
│ │
|
||||
│ └─→ tp-add (合并新属性)
|
||||
│
|
||||
└─→ tp--update-reactive-text (如果 tp-text 依赖该变量)
|
||||
│
|
||||
└─→ tp--replace-reactive-text-in-buffer
|
||||
│
|
||||
└─→ (删除旧文本，插入新文本)
|
||||
```
|
||||
|
||||
#### 批量更新优化
|
||||
|
||||
```elisp
|
||||
(tp-with-batch-updates
|
||||
(setq my-color "red") ; 不立即更新
|
||||
(setq my-bg "blue")) ; 不立即更新
|
||||
;; 退出时一次性更新所有变化
|
||||
|
||||
;; 内部实现:
|
||||
;; 1. 设置 tp--batch-update-active = t
|
||||
;; 2. 变量变化被记录到 tp--batch-update-pending
|
||||
;; 3. 退出时调用 tp--flush-batch-updates
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
### 6. 模式匹配 tp-match-set
|
||||
|
||||
`tp-match-set` 在字符串匹配处设置属性。
|
||||
|
||||
#### 调用堆栈
|
||||
|
||||
```
|
||||
tp-match-set (用户调用入口)
|
||||
│
|
||||
└─→ tp--match-apply (内部实现)
|
||||
│
|
||||
├─→ (如果 OBJECT 是字符串，copy-sequence 创建副本)
|
||||
│
|
||||
├─→ (循环搜索 PATTERN)
|
||||
│ │
|
||||
│ ├─→ search-forward / string-match
|
||||
│ │
|
||||
│ └─→ tp-set (在匹配区域设置属性)
|
||||
│
|
||||
└─→ (返回匹配区域列表或带属性字符串)
|
||||
```
|
||||
|
||||
#### 支持多模式
|
||||
|
||||
```elisp
|
||||
(tp-match-set '("TODO" "FIXME") '(face warning))
|
||||
;; => 匹配所有 TODO 和 FIXME
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
### 7. 搜索与遍历 tp-search-map
|
||||
|
||||
`tp-search-map` 对所有匹配属性的区域应用转换函数。
|
||||
|
||||
#### 调用堆栈
|
||||
|
||||
```
|
||||
tp-search-map (用户调用入口)
|
||||
│
|
||||
└─→ tp--search-do (内部搜索实现)
|
||||
│
|
||||
├─→ (区分字符串和缓冲区处理)
|
||||
│
|
||||
├─→ (对于字符串)
|
||||
│ │
|
||||
│ ├─→ text-property-search-forward (搜索)
|
||||
│ │
|
||||
│ └─→ (调用 FUNCTION，传入 text, start, end, idx)
|
||||
│ │
|
||||
│ └─→ (替换匹配文本为函数返回值)
|
||||
│
|
||||
└─→ (对于缓冲区)
|
||||
│
|
||||
├─→ text-property-search-forward
|
||||
│
|
||||
└─→ (相同处理，但修改缓冲区)
|
||||
```
|
||||
|
||||
#### 函数签名
|
||||
|
||||
```elisp
|
||||
(tp-search-map
|
||||
(lambda (text &optional start end idx)
|
||||
(upcase text)) ; 返回值替换原文本
|
||||
'marker ; 搜索的属性名
|
||||
nil ; 值（nil 表示不匹配值）
|
||||
my-string ; 目标对象
|
||||
0 ; 起始位置（可选）
|
||||
100) ; 结束位置（可选）
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## 关键数据结构
|
||||
|
||||
### 1. tp-layer-alist
|
||||
|
||||
存储所有层定义。
|
||||
|
||||
```elisp
|
||||
;; 非参数化层
|
||||
((highlight nil '(face (:background "yellow")))
|
||||
(error nil '(face (:foreground "red"))))
|
||||
|
||||
;; 参数化层
|
||||
((tp-space (pixel) `(display (space :width (,pixel)))))
|
||||
```
|
||||
|
||||
### 2. tp-layer-groups
|
||||
|
||||
存储层组定义。
|
||||
|
||||
```elisp
|
||||
((status-colors . (highlight error info))
|
||||
(moon-phases . (moon-phases-new moon-phases-full)))
|
||||
```
|
||||
|
||||
### 3. tp-reactive-deps
|
||||
|
||||
存储响应式依赖关系。
|
||||
|
||||
```elisp
|
||||
;; 变量 -> ((层名 . 使用该变量的属性列表) ...)
|
||||
((my-color . ((my-layer . '(face (:foreground $my-color)))
|
||||
(other-layer . '(face (:background $my-color)))))
|
||||
(my-size . ((size-layer . '(display (space :width $my-size))))))
|
||||
```
|
||||
|
||||
### 4. 层栈结构
|
||||
|
||||
文本区域的层栈通过 `tp-name` 和 `tp-layers` 属性存储。
|
||||
|
||||
```elisp
|
||||
;; 位置 1-10 的属性
|
||||
'(face (:foreground "red") ; 可见属性
|
||||
tp-name layer1 ; 顶层名称
|
||||
help-echo "tip" ; 可见属性
|
||||
tp-layers ; 隐藏层列表
|
||||
((face (:background "blue") tp-name layer2)
|
||||
(face (:underline t) tp-name layer3)))
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## 潜在问题分析
|
||||
|
||||
### 1. 性能问题
|
||||
|
||||
#### 问题 1.1：响应式更新可能导致性能瓶颈
|
||||
|
||||
**现象**：当一个响应式变量被多个层使用，且这些层被应用到大量文本区域时，变量变化会触发大量更新。
|
||||
|
||||
**代码位置**：`tp--update-layer-regions` 函数
|
||||
|
||||
**问题代码**：
|
||||
```elisp
|
||||
(defun tp--update-layer-regions (var layer-name)
|
||||
;; 遍历所有缓冲区
|
||||
(dolist (buf (buffer-list))
|
||||
;; 在每个缓冲区中搜索所有使用该层的区域
|
||||
(tp-search-map (lambda (txt) ...) 'tp-name layer-name nil buf)))
|
||||
```
|
||||
|
||||
**建议**：
|
||||
- 添加缓冲区级别的响应式依赖跟踪
|
||||
- 只更新实际使用该层的缓冲区
|
||||
- 考虑使用惰性更新策略
|
||||
|
||||
#### 问题 1.2：tp-intervals 可能在大文件中变慢
|
||||
|
||||
**现象**：`object-intervals` 返回整个对象的所有区间，然后过滤。
|
||||
|
||||
**建议**：对于大文件，考虑使用 `next-property-change` 进行增量遍历。
|
||||
|
||||
---
|
||||
|
||||
### 2. 内存问题
|
||||
|
||||
#### 问题 2.1：匿名层名称无限增长
|
||||
|
||||
**现象**：`tp--anonymous-layer-counter` 只增不减，匿名层名称永不重用。
|
||||
|
||||
**代码位置**：`tp--generate-anonymous-layer-name`
|
||||
|
||||
**建议**：
|
||||
- 使用弱引用跟踪匿名层
|
||||
- 当层不再被使用时自动清理
|
||||
|
||||
#### 问题 2.2：响应式依赖可能泄漏
|
||||
|
||||
**现象**：如果缓冲区被杀死，但响应式依赖未清理，可能导致内存泄漏。
|
||||
|
||||
**建议**：
|
||||
- 添加 `kill-buffer-hook` 来清理缓冲区相关的依赖
|
||||
- 定期检查并清理无效依赖
|
||||
|
||||
---
|
||||
|
||||
### 3. 功能问题
|
||||
|
||||
#### 问题 3.1：层栈深度无限制
|
||||
|
||||
**现象**：没有限制层栈的最大深度，可能导致性能问题。
|
||||
|
||||
**建议**：添加可配置的最大深度限制。
|
||||
|
||||
#### 问题 3.2：参数化层的参数验证不足
|
||||
|
||||
**现象**：参数化层不验证传入参数的类型和数量。
|
||||
|
||||
```elisp
|
||||
(define-tp tp-space (pixel)
|
||||
`(display (space :width (,pixel))))
|
||||
|
||||
;; 错误调用不会报错
|
||||
(tp-set "test" 'tp-space) ; 缺少参数
|
||||
```
|
||||
|
||||
**建议**：在层调用时添加参数验证。
|
||||
|
||||
---
|
||||
|
||||
### 4. 代码质量问题
|
||||
|
||||
#### 问题 4.1：部分函数过长
|
||||
|
||||
**现象**：某些函数超过 100 行，如 `tp--parse-args`、`tp-set`。
|
||||
|
||||
**建议**：拆分为更小的辅助函数。
|
||||
|
||||
#### 问题 4.2：文档字符串不一致
|
||||
|
||||
**现象**：部分内部函数缺少文档字符串。
|
||||
|
||||
**建议**：为所有公开函数和重要内部函数添加文档。
|
||||
|
||||
#### 问题 4.3：错误处理不完善
|
||||
|
||||
**现象**：某些边界情况没有清晰的错误消息。
|
||||
|
||||
```elisp
|
||||
;; 调用未定义的层
|
||||
(tp-set 1 10 'undefined-layer)
|
||||
;; 可能静默失败或产生不明确的错误
|
||||
```
|
||||
|
||||
**建议**：添加清晰的错误检查和消息。
|
||||
|
||||
---
|
||||
|
||||
### 5. 测试覆盖问题
|
||||
|
||||
#### 问题 5.1：某些边界情况未测试
|
||||
|
||||
**现象**：测试主要覆盖正常流程，边界情况覆盖不足。
|
||||
|
||||
**需要补充的测试**：
|
||||
- 空字符串/空缓冲区处理
|
||||
- 极端层栈深度
|
||||
- 循环依赖检测
|
||||
- 并发修改场景
|
||||
|
||||
---
|
||||
|
||||
## 架构优化建议
|
||||
|
||||
### 1. 短期优化（低成本高收益）
|
||||
|
||||
#### 1.1 添加错误边界
|
||||
|
||||
```elisp
|
||||
(defun tp-set (...)
|
||||
"..."
|
||||
(condition-case err
|
||||
(tp--set-internal ...)
|
||||
(error
|
||||
(tp-debug-log "Error in tp-set: %s" err)
|
||||
(signal (car err) (cdr err)))))
|
||||
```
|
||||
|
||||
#### 1.2 添加性能日志
|
||||
|
||||
```elisp
|
||||
(defmacro tp--with-timing (name &rest body)
|
||||
"Execute BODY and log timing if tp-debug-mode is enabled."
|
||||
`(let ((start (float-time)))
|
||||
(prog1 (progn ,@body)
|
||||
(when tp-debug-mode
|
||||
(tp-debug-log "%s took %.3fms"
|
||||
,name
|
||||
(* 1000 (- (float-time) start)))))))
|
||||
```
|
||||
|
||||
#### 1.3 参数验证
|
||||
|
||||
```elisp
|
||||
(defun tp-layer-props (name &optional include-tp-name)
|
||||
"Get properties for layer NAME."
|
||||
(unless (symbolp name)
|
||||
(error "Layer name must be a symbol: %S" name))
|
||||
...)
|
||||
```
|
||||
|
||||
### 2. 中期优化（改进用户体验）
|
||||
|
||||
#### 2.1 层定义的本地化
|
||||
|
||||
当前所有层定义是全局的。考虑支持缓冲区本地层：
|
||||
|
||||
```elisp
|
||||
(define-tp-local my-local-layer ()
|
||||
'(face bold))
|
||||
```
|
||||
|
||||
#### 2.2 层的命名空间
|
||||
|
||||
避免层名冲突：
|
||||
|
||||
```elisp
|
||||
(define-tp (my-package . highlight) ()
|
||||
'(face (:background "yellow")))
|
||||
```
|
||||
|
||||
#### 2.3 属性继承
|
||||
|
||||
允许层继承其他层：
|
||||
|
||||
```elisp
|
||||
(define-tp error-highlight ()
|
||||
:inherit 'base-highlight
|
||||
:props '(face (:foreground "red")))
|
||||
```
|
||||
|
||||
### 3. 长期优化（架构改进）
|
||||
|
||||
#### 3.1 响应式系统优化
|
||||
|
||||
考虑采用脏标记 + 批量更新模式：
|
||||
|
||||
```elisp
|
||||
;; 标记脏数据
|
||||
(defvar tp--dirty-layers nil)
|
||||
|
||||
;; 在 idle 时更新
|
||||
(run-with-idle-timer 0.1 t #'tp--flush-dirty-layers)
|
||||
```
|
||||
|
||||
#### 3.2 层栈优化
|
||||
|
||||
使用更高效的数据结构：
|
||||
|
||||
```elisp
|
||||
;; 当前：列表
|
||||
tp-layers -> ((props1) (props2) (props3))
|
||||
|
||||
;; 优化：使用向量
|
||||
tp-layers -> [props1 props2 props3]
|
||||
```
|
||||
|
||||
#### 3.3 增量更新
|
||||
|
||||
对于大区域，考虑增量更新：
|
||||
|
||||
```elisp
|
||||
(defun tp--update-region-incremental (start end new-props)
|
||||
"Update region incrementally using property change boundaries."
|
||||
(let ((pos start))
|
||||
(while (< pos end)
|
||||
(let ((next (next-single-property-change pos 'tp-name nil end)))
|
||||
(tp--update-single-interval pos next new-props)
|
||||
(setq pos next)))))
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## 开发入门指南
|
||||
|
||||
### 1. 开发环境设置
|
||||
|
||||
```elisp
|
||||
;; 加载开发版本
|
||||
(add-to-list 'load-path "/path/to/tp")
|
||||
(require 'tp)
|
||||
|
||||
;; 启用调试模式
|
||||
(setq tp-debug-mode t)
|
||||
(setq tp-debug-echo t)
|
||||
|
||||
;; 运行测试（全套 439 个 ERT 测试）
|
||||
;; make test
|
||||
```
|
||||
|
||||
### 2. 添加新功能的步骤
|
||||
|
||||
1. **理解分层架构**
|
||||
- 确定新功能属于哪个模块（见 [ARCHITECTURE.md](ARCHITECTURE.md)）
|
||||
- 遵循模块间调用规则（只调用前置模块的函数）
|
||||
|
||||
2. **编写测试用例**
|
||||
- 在 `tests/` 下对应模块的 `tp-*-tests.el`（或综合套件 `tp-tests.el`）中添加测试
|
||||
- 覆盖正常流程和边界情况
|
||||
|
||||
3. **实现功能**
|
||||
- 添加必要的辅助函数
|
||||
- 添加文档字符串
|
||||
- 处理错误情况
|
||||
|
||||
4. **更新文档**
|
||||
- 更新 README.md / README_CN.md
|
||||
- 如果涉及架构变化，更新 ARCHITECTURE.md
|
||||
|
||||
### 3. 调试技巧
|
||||
|
||||
```elisp
|
||||
;; 查看层定义
|
||||
tp-layer-alist
|
||||
|
||||
;; 查看响应式依赖
|
||||
tp-reactive-deps
|
||||
|
||||
;; 查看位置属性
|
||||
(tp-at 5)
|
||||
(tp-at 5 'face)
|
||||
(tp-at 5 '(face :foreground))
|
||||
|
||||
;; 查看区间
|
||||
(tp-intervals 1 100)
|
||||
|
||||
;; 查看调试日志
|
||||
(tp-debug-show)
|
||||
```
|
||||
|
||||
### 4. 常见开发任务
|
||||
|
||||
#### 添加新的核心属性函数
|
||||
|
||||
1. 在 `tp-ops.el` 添加函数
|
||||
2. 使用 `tp--parse-args` 解析参数
|
||||
3. 调用 Emacs 原生 API
|
||||
4. 添加测试用例
|
||||
|
||||
#### 添加新的层栈操作函数
|
||||
|
||||
1. 在 `tp-stack.el` 添加函数
|
||||
2. 使用 `tp--stack-map-region` 遍历区域内层栈
|
||||
3. 使用 `tp--get-layer-stack` 获取层栈
|
||||
4. 添加测试用例
|
||||
|
||||
#### 扩展响应式系统
|
||||
|
||||
1. 注册/监听逻辑放在 `tp-reactive.el`，渲染逻辑放在 `tp-render.el`
|
||||
2. 使用 `add-variable-watcher` 注册监听
|
||||
3. 在适当位置调用 `tp--update-layer-regions`（下层模块经钩子变量触发）
|
||||
4. 添加测试用例
|
||||
|
||||
---
|
||||
|
||||
## 总结
|
||||
|
||||
tp.el 是一个设计精良的文本属性操作库，其核心创新包括：
|
||||
|
||||
1. **统一的 API 设计**：同一函数支持多种调用方式
|
||||
2. **属性层系统**：实现了类似图层的属性管理
|
||||
3. **响应式更新**：借鉴前端框架思想，实现数据驱动 UI
|
||||
|
||||
主要的改进方向：
|
||||
|
||||
1. **性能优化**：响应式更新的效率、大文件处理
|
||||
2. **错误处理**：参数验证、清晰的错误消息
|
||||
3. **代码质量**：函数拆分、文档完善、测试覆盖
|
||||
|
||||
对于想要参与开发的贡献者，建议：
|
||||
|
||||
1. 从理解测试用例开始
|
||||
2. 使用调试模式跟踪执行流程
|
||||
3. 遵循分层架构原则
|
||||
4. 先写测试，后写实现
|
||||
|
||||
---
|
||||
|
||||
*报告生成时间: 2026-01-10（分析对象：拆分前的单文件 tp.el 0.1.0）*
|
||||
*文件结构与"关键代码位置"表更新于 2026-07-26（tp 0.2.0 模块化后）*
|
||||
- [TP 1.0 公共 API 参考](API-REFERENCE.md)
|
||||
- [API 语义合同](API-SEMANTICS.md)
|
||||
- [当前架构](ARCHITECTURE.md)
|
||||
- [README](../README_CN.md)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,214 +1,12 @@
|
||||
# tp.el Reactive System Optimization Documentation
|
||||
# Reactive optimization (historical archive)
|
||||
|
||||
> **Historical TP 0.3 document; obsolete for TP 1.0.** This document evaluates the removed `$variable`, `tp-text`, inline `tp-name`, `tp-render.el`, and scan-driven batching model and remains only as design history. None of the implementation-status claims, function names, or examples below describe TP 1.0. The current optimization model uses an exact signal/binding dependency graph, transaction batching, and retained-surface diffing; see the [README](../README.md), [current architecture](ARCHITECTURE.md), and [API contract](API-SEMANTICS.md).
|
||||
This page is a TP 0.3 performance note. Its stack, tp-text, batch-update,
|
||||
legacy reactive bookkeeping, and scan-renderer discussion is not part of TP 1.0.
|
||||
It is not a current performance baseline or implementation guide.
|
||||
|
||||
This document describes the optimizations and enhancements made to the tp.el reactive system based on practical experience from the [twidget](https://github.com/Kinneyzhang/twidget.git) project.
|
||||
For the current runtime, read:
|
||||
|
||||
## Optimization Suggestions Evaluation
|
||||
|
||||
The following evaluates and documents the implementation status of six optimization suggestions for the tp.el reactive system:
|
||||
|
||||
### 1. Granular Reactive Updates
|
||||
|
||||
**Suggestion**: Support partial updates within a region - only updating the reactive portion while preserving surrounding text properties.
|
||||
|
||||
**Evaluation**: Already implemented. tp.el uses `tp-search-map` over `tp-name`-tagged regions and interval-based update mechanisms to support fine-grained property updates. Updates only affect regions with specific `tp-name` properties, and only the layer's own property keys are replaced — properties contributed by other sources are left untouched.
|
||||
|
||||
### 2. Reactive Symbol Cleanup ✅ Already Implemented
|
||||
|
||||
**Suggestion**: Add a mechanism to unregister reactive symbols when widgets are destroyed.
|
||||
|
||||
**Evaluation**: Already implemented. The `tp--unregister-reactive-deps` function handles cleanup:
|
||||
- Called automatically when a layer is redefined
|
||||
- Called automatically when a layer is undefined (`tp-undefine-layer`)
|
||||
- Cleans up variable watchers, computed properties, and data variables
|
||||
|
||||
**Key functions**:
|
||||
- `tp--unregister-reactive-deps`
|
||||
- `tp--unregister-layer-watchers`
|
||||
- `tp--unregister-layer-computed`
|
||||
- `tp--unregister-layer-data`
|
||||
|
||||
### 3. Scoped Reactivity ✅ Already Implemented
|
||||
|
||||
**Suggestion**: Add instance/context scoping for reactive variables.
|
||||
|
||||
**Evaluation**: Already implemented. The `where` parameter supports buffer-local updates in:
|
||||
- `tp--update-layer-regions`
|
||||
- `tp--update-reactive-text`
|
||||
|
||||
When using `setq-local`, updates only affect the specific buffer.
|
||||
|
||||
### 4. Batched Updates 🆕 New Feature
|
||||
|
||||
**Suggestion**: When multiple reactive values change simultaneously, batch updates to avoid redundant buffer modifications.
|
||||
|
||||
**Implementation**: Added `tp-with-batch-updates` macro:
|
||||
|
||||
```elisp
|
||||
;; Using batch updates
|
||||
(tp-with-batch-updates
|
||||
(setq my-color "red")
|
||||
(setq my-size 14)
|
||||
(setq my-text "Hello"))
|
||||
;; All updates applied to buffer once at the end
|
||||
```
|
||||
|
||||
**Key functions and variables**:
|
||||
- `tp-with-batch-updates` - Batch update macro
|
||||
- `tp--batch-update-active` - Flag indicating batch mode
|
||||
- `tp--batch-update-pending` - List of pending updates
|
||||
- `tp--flush-batch-updates` - Apply all pending updates
|
||||
|
||||
### 5. Value Transformation 🆕 New Feature
|
||||
|
||||
**Suggestion**: Allow registering transformation functions that run when tp-text updates.
|
||||
|
||||
**Implementation**: Added `:transform` option:
|
||||
|
||||
```elisp
|
||||
;; Define a layer with transformation
|
||||
(define-tp currency-display ()
|
||||
:props '(face bold tp-text $amount)
|
||||
:data '((amount . "100"))
|
||||
:transform (lambda (text)
|
||||
(format "$%s.00" text)))
|
||||
|
||||
;; After application, 100 displays as $100.00
|
||||
```
|
||||
|
||||
**Key functions and variables**:
|
||||
- `tp-layer-transforms` - Stores layer transform functions
|
||||
- Transforms applied in `tp--handle-tp-text-property` and `tp--update-reactive-text`
|
||||
|
||||
### 6. Debug Mode 🆕 New Feature
|
||||
|
||||
**Suggestion**: Add a debug mode to trace reactive updates.
|
||||
|
||||
**Implementation**: Added debug functionality:
|
||||
|
||||
```elisp
|
||||
;; Enable debug mode
|
||||
(setq tp-debug-mode t)
|
||||
|
||||
;; Also show debug info in minibuffer
|
||||
(setq tp-debug-echo t)
|
||||
|
||||
;; View debug log
|
||||
(tp-debug-show)
|
||||
|
||||
;; Clear debug log
|
||||
(tp-debug-clear)
|
||||
```
|
||||
|
||||
**Key functions and variables**:
|
||||
- `tp-debug-mode` - Enable/disable debug mode
|
||||
- `tp-debug-echo` - Whether to echo debug info to minibuffer
|
||||
- `tp-debug-log` - Log debug information
|
||||
- `tp-debug-show` - Show debug buffer
|
||||
- `tp-debug-clear` - Clear debug log
|
||||
|
||||
Debug log includes:
|
||||
- Variable change notifications (old → new value)
|
||||
- Layer update tracking
|
||||
- Batch update start/end
|
||||
- Transform application info
|
||||
|
||||
## New Features in Detail
|
||||
|
||||
### Batch Updates (tp-with-batch-updates)
|
||||
|
||||
When modifying multiple reactive variables simultaneously, use batch updates to avoid multiple buffer updates:
|
||||
|
||||
```elisp
|
||||
(define-tp themed-text ()
|
||||
:props '(face (:foreground $fg-color :background $bg-color))
|
||||
:data '((fg-color . "white") (bg-color . "black")))
|
||||
|
||||
(with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-set 1 12 'themed-text)
|
||||
|
||||
;; Without batching: each setq triggers a buffer update
|
||||
(setq fg-color "yellow") ; First update
|
||||
(setq bg-color "navy") ; Second update
|
||||
|
||||
;; With batching: all changes applied once at the end
|
||||
(tp-with-batch-updates
|
||||
(setq fg-color "red")
|
||||
(setq bg-color "blue"))) ; Only one update
|
||||
```
|
||||
|
||||
### Value Transformation (:transform)
|
||||
|
||||
Transform functions allow processing tp-text values before display:
|
||||
|
||||
```elisp
|
||||
;; Number formatting
|
||||
(define-tp price-display ()
|
||||
:props '(tp-text $price)
|
||||
:data '((price . "99.9"))
|
||||
:transform (lambda (text)
|
||||
(format "$%.2f" (string-to-number text))))
|
||||
|
||||
;; Date formatting
|
||||
(define-tp date-display ()
|
||||
:props '(tp-text $timestamp)
|
||||
:data '((timestamp . "1703865600"))
|
||||
:transform (lambda (text)
|
||||
(format-time-string "%Y-%m-%d"
|
||||
(seconds-to-time (string-to-number text)))))
|
||||
|
||||
;; Uppercase conversion
|
||||
(define-tp uppercase-text ()
|
||||
:props '(tp-text $content)
|
||||
:data '((content . "hello"))
|
||||
:transform #'upcase)
|
||||
```
|
||||
|
||||
### Debug Mode
|
||||
|
||||
Debug mode helps developers understand the reactive update flow:
|
||||
|
||||
```elisp
|
||||
;; Enable full debugging
|
||||
(setq tp-debug-mode t)
|
||||
(setq tp-debug-echo t)
|
||||
|
||||
;; Define and use a reactive layer
|
||||
(define-tp test-layer ()
|
||||
:props '(face (:foreground $my-color))
|
||||
:data '((my-color . "red")))
|
||||
|
||||
(with-temp-buffer
|
||||
(insert "Test")
|
||||
(tp-set 1 5 'test-layer)
|
||||
(setq my-color "blue"))
|
||||
|
||||
;; Example debug output:
|
||||
;; [12:34:56.789] Variable my-color changed: "red" -> "blue" (where: global)
|
||||
;; [12:34:56.790] Updating layer test-layer (tp-text affected: no)
|
||||
```
|
||||
|
||||
## Architecture Notes
|
||||
|
||||
These optimizations follow tp.el's layered architecture principles:
|
||||
|
||||
1. **Debug Mode** - Basic utility layer functionality (`tp-core.el`)
|
||||
2. **Batch Updates** - Implemented in the reactive system layer (`tp-reactive.el`)
|
||||
3. **Value Transformation** - Implemented in layer definition and reactive text handling (`tp-layer.el` / `tp-render.el`)
|
||||
|
||||
All new features integrate seamlessly with the existing reactive system without breaking existing APIs.
|
||||
|
||||
## Function Reference
|
||||
|
||||
| Function/Variable | Description |
|
||||
|------------------|-------------|
|
||||
| `tp-debug-mode` | Enable debug mode |
|
||||
| `tp-debug-echo` | Enable minibuffer debug output |
|
||||
| `tp-debug-log` | Log debug information |
|
||||
| `tp-debug-show` | Show debug buffer |
|
||||
| `tp-debug-clear` | Clear debug log |
|
||||
| `tp-with-batch-updates` | Batch update macro |
|
||||
| `tp-layer-transforms` | Layer transform function storage |
|
||||
| `:transform` | Transform option in layer definition |
|
||||
- [TP 1.0 public API reference](API-REFERENCE.md)
|
||||
- [Current architecture](ARCHITECTURE.md)
|
||||
- [Current benchmark guide](BENCHMARKS.md)
|
||||
- [README](../README.md)
|
||||
|
||||
@ -1,214 +1,12 @@
|
||||
# tp.el 响应式系统优化文档
|
||||
# Reactive optimization（历史归档）
|
||||
|
||||
> **历史 TP 0.3 文档，TP 1.0 已废弃。** 本文评估的是已经删除的 `$variable`、`tp-text`、inline `tp-name`、`tp-render.el` 与扫描式批处理模型，仅作为设计历史保留；下文的实现状态、函数名和示例均不适用于 TP 1.0。当前优化模型建立在精确 signal/binding 依赖图、事务批处理和 retained surface diff 上，详见 [README](../README_CN.md)、[当前架构](ARCHITECTURE.md) 和 [API 合同](API-SEMANTICS.md)。
|
||||
本文是 TP 0.3 的性能分析记录，所讨论的 stack、tp-text、batch update、
|
||||
旧 reactive bookkeeping 和扫描式 renderer 已不属于 TP 1.0。它不提供当前
|
||||
性能基线，也不应作为实现指导。
|
||||
|
||||
本文档基于 [twidget](https://github.com/Kinneyzhang/twidget.git) 项目的实践经验，对 tp.el 的响应式系统进行了优化和增强。
|
||||
当前行为和 API 见：
|
||||
|
||||
## 优化建议评估
|
||||
|
||||
以下是针对 tp.el 响应式系统的六项优化建议的评估和实现情况：
|
||||
|
||||
### 1. 细粒度响应式更新（Granular Reactive Updates）
|
||||
|
||||
**建议**：支持区域内的部分更新，只更新响应式部分，保留周围文本属性。
|
||||
|
||||
**评估**：已经实现。tp.el 通过在带 `tp-name` 标记的区域上使用 `tp-search-map`，以及基于区间的更新机制，已经支持细粒度的属性更新。更新只影响具有特定 `tp-name` 的区域，并且只替换该层自身的属性键——由其他来源贡献的属性保持不变。
|
||||
|
||||
### 2. 响应式符号清理（Reactive Symbol Cleanup）✅ 已实现
|
||||
|
||||
**建议**：当 widget 销毁时，添加注销响应式符号的机制。
|
||||
|
||||
**评估**：已经实现。`tp--unregister-reactive-deps` 函数负责清理：
|
||||
- 当层被重新定义时自动调用
|
||||
- 当层被取消定义（`tp-undefine-layer`）时自动调用
|
||||
- 清理变量监听器、计算属性和数据变量
|
||||
|
||||
**关键函数**：
|
||||
- `tp--unregister-reactive-deps`
|
||||
- `tp--unregister-layer-watchers`
|
||||
- `tp--unregister-layer-computed`
|
||||
- `tp--unregister-layer-data`
|
||||
|
||||
### 3. 作用域响应式（Scoped Reactivity）✅ 已实现
|
||||
|
||||
**建议**：为响应式变量添加实例/上下文作用域。
|
||||
|
||||
**评估**：已经实现。`where` 参数在以下函数中支持缓冲区局部更新：
|
||||
- `tp--update-layer-regions`
|
||||
- `tp--update-reactive-text`
|
||||
|
||||
当使用 `setq-local` 时，更新只影响特定缓冲区。
|
||||
|
||||
### 4. 批量更新（Batched Updates）🆕 新增
|
||||
|
||||
**建议**：当多个响应式值同时变化时，批量处理更新以避免冗余的缓冲区修改。
|
||||
|
||||
**实现**：新增 `tp-with-batch-updates` 宏：
|
||||
|
||||
```elisp
|
||||
;; 使用批量更新
|
||||
(tp-with-batch-updates
|
||||
(setq my-color "red")
|
||||
(setq my-size 14)
|
||||
(setq my-text "Hello"))
|
||||
;; 所有更新在批量结束后一次性应用到缓冲区
|
||||
```
|
||||
|
||||
**关键函数和变量**：
|
||||
- `tp-with-batch-updates` - 批量更新宏
|
||||
- `tp--batch-update-active` - 标记是否在批量更新中
|
||||
- `tp--batch-update-pending` - 待处理的更新列表
|
||||
- `tp--flush-batch-updates` - 应用所有待处理更新
|
||||
|
||||
### 5. 值转换（Value Transformation）🆕 新增
|
||||
|
||||
**建议**：允许注册转换函数，在 tp-text 更新时运行。
|
||||
|
||||
**实现**：新增 `:transform` 选项：
|
||||
|
||||
```elisp
|
||||
;; 定义带转换的层
|
||||
(define-tp currency-display ()
|
||||
:props '(face bold tp-text $amount)
|
||||
:data '((amount . "100"))
|
||||
:transform (lambda (text)
|
||||
(format "$%s.00" text)))
|
||||
|
||||
;; 使用后，100 会显示为 $100.00
|
||||
```
|
||||
|
||||
**关键函数和变量**：
|
||||
- `tp-layer-transforms` - 存储层转换函数
|
||||
- 转换在 `tp--handle-tp-text-property` 和 `tp--update-reactive-text` 中应用
|
||||
|
||||
### 6. 调试模式（Debug Mode）🆕 新增
|
||||
|
||||
**建议**：添加调试模式以追踪响应式更新。
|
||||
|
||||
**实现**：新增调试功能：
|
||||
|
||||
```elisp
|
||||
;; 启用调试模式
|
||||
(setq tp-debug-mode t)
|
||||
|
||||
;; 同时在 minibuffer 显示调试信息
|
||||
(setq tp-debug-echo t)
|
||||
|
||||
;; 查看调试日志
|
||||
(tp-debug-show)
|
||||
|
||||
;; 清除调试日志
|
||||
(tp-debug-clear)
|
||||
```
|
||||
|
||||
**关键函数和变量**：
|
||||
- `tp-debug-mode` - 启用/禁用调试模式
|
||||
- `tp-debug-echo` - 是否在 minibuffer 显示调试信息
|
||||
- `tp-debug-log` - 记录调试信息
|
||||
- `tp-debug-show` - 显示调试缓冲区
|
||||
- `tp-debug-clear` - 清除调试日志
|
||||
|
||||
调试日志包含：
|
||||
- 变量变化通知（旧值 → 新值）
|
||||
- 层更新追踪
|
||||
- 批量更新开始/结束
|
||||
- 转换应用信息
|
||||
|
||||
## 新增功能详解
|
||||
|
||||
### 批量更新 (tp-with-batch-updates)
|
||||
|
||||
当需要同时修改多个响应式变量时，使用批量更新可以避免多次缓冲区更新：
|
||||
|
||||
```elisp
|
||||
(define-tp themed-text ()
|
||||
:props '(face (:foreground $fg-color :background $bg-color))
|
||||
:data '((fg-color . "white") (bg-color . "black")))
|
||||
|
||||
(with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-set 1 12 'themed-text)
|
||||
|
||||
;; 不使用批量更新：每个 setq 都会触发一次缓冲区更新
|
||||
(setq fg-color "yellow") ; 第一次更新
|
||||
(setq bg-color "navy") ; 第二次更新
|
||||
|
||||
;; 使用批量更新：所有变化在结束时一次性应用
|
||||
(tp-with-batch-updates
|
||||
(setq fg-color "red")
|
||||
(setq bg-color "blue"))) ; 只更新一次
|
||||
```
|
||||
|
||||
### 值转换 (:transform)
|
||||
|
||||
转换函数允许在显示前处理 tp-text 的值：
|
||||
|
||||
```elisp
|
||||
;; 数字格式化
|
||||
(define-tp price-display ()
|
||||
:props '(tp-text $price)
|
||||
:data '((price . "99.9"))
|
||||
:transform (lambda (text)
|
||||
(format "$%.2f" (string-to-number text))))
|
||||
|
||||
;; 日期格式化
|
||||
(define-tp date-display ()
|
||||
:props '(tp-text $timestamp)
|
||||
:data '((timestamp . "1703865600"))
|
||||
:transform (lambda (text)
|
||||
(format-time-string "%Y-%m-%d"
|
||||
(seconds-to-time (string-to-number text)))))
|
||||
|
||||
;; 大写转换
|
||||
(define-tp uppercase-text ()
|
||||
:props '(tp-text $content)
|
||||
:data '((content . "hello"))
|
||||
:transform #'upcase)
|
||||
```
|
||||
|
||||
### 调试模式
|
||||
|
||||
调试模式帮助开发者理解响应式更新流程：
|
||||
|
||||
```elisp
|
||||
;; 启用完整调试
|
||||
(setq tp-debug-mode t)
|
||||
(setq tp-debug-echo t)
|
||||
|
||||
;; 定义和使用响应式层
|
||||
(define-tp test-layer ()
|
||||
:props '(face (:foreground $my-color))
|
||||
:data '((my-color . "red")))
|
||||
|
||||
(with-temp-buffer
|
||||
(insert "Test")
|
||||
(tp-set 1 5 'test-layer)
|
||||
(setq my-color "blue"))
|
||||
|
||||
;; 调试输出示例：
|
||||
;; [12:34:56.789] Variable my-color changed: "red" -> "blue" (where: global)
|
||||
;; [12:34:56.790] Updating layer test-layer (tp-text affected: no)
|
||||
```
|
||||
|
||||
## 架构说明
|
||||
|
||||
这些优化遵循 tp.el 的分层架构原则：
|
||||
|
||||
1. **调试模式** - 作为基础工具层功能（`tp-core.el`）
|
||||
2. **批量更新** - 在响应式系统层实现（`tp-reactive.el`）
|
||||
3. **值转换** - 在层定义和响应式文本处理中实现（`tp-layer.el` / `tp-render.el`）
|
||||
|
||||
所有新功能都与现有的响应式系统无缝集成，不破坏现有 API。
|
||||
|
||||
## 相关函数一览
|
||||
|
||||
| 函数/变量 | 描述 |
|
||||
|----------|------|
|
||||
| `tp-debug-mode` | 启用调试模式 |
|
||||
| `tp-debug-echo` | 启用 minibuffer 调试输出 |
|
||||
| `tp-debug-log` | 记录调试信息 |
|
||||
| `tp-debug-show` | 显示调试缓冲区 |
|
||||
| `tp-debug-clear` | 清除调试日志 |
|
||||
| `tp-with-batch-updates` | 批量更新宏 |
|
||||
| `tp-layer-transforms` | 层转换函数存储 |
|
||||
| `:transform` | 层定义中的转换选项 |
|
||||
- [TP 1.0 公共 API 参考](API-REFERENCE.md)
|
||||
- [当前架构](ARCHITECTURE.md)
|
||||
- [当前 benchmark 说明](BENCHMARKS.md)
|
||||
- [README](../README_CN.md)
|
||||
|
||||
@ -1,510 +1,17 @@
|
||||
# tp.el Complete Guide to Reactive Text Properties
|
||||
# Reactive text properties (historical archive)
|
||||
|
||||
> **Historical TP 0.3 document; obsolete for TP 1.0.** This document records the removed `$variable`, `tp-text`, inline `tp-name`, and scan-driven reactive-update model and remains only as migration and design history. None of the APIs, examples, or “current behavior” claims below describe TP 1.0. The current reactive model uses signals, bindings, `tp-computed`, `tp-watch`, and retained surfaces; see the [README](../README.md), [current architecture](ARCHITECTURE.md), and [API contract](API-SEMANTICS.md).
|
||||
This page records TP 0.3-era design and implementation work. It is not a TP 1.0
|
||||
usage guide. The old tp-text, tp-render, tp-stack, $variable, inline metadata,
|
||||
and scan-driven refresh behavior described by the historical material was
|
||||
removed from the current runtime. Do not copy its APIs or examples.
|
||||
|
||||
> Bringing modern frontend framework reactive programming paradigms to the Emacs text properties world
|
||||
Read the current documentation instead:
|
||||
|
||||
## Introduction
|
||||
- [TP 1.0 public API reference](API-REFERENCE.md)
|
||||
- [API semantics](API-SEMANTICS.md)
|
||||
- [Current architecture](ARCHITECTURE.md)
|
||||
- [README](../README.md)
|
||||
|
||||
In traditional Emacs development, managing text properties has always been a tedious task. Whenever you want to change a property value, you need to manually find all related text regions and update them one by one. This approach is not only error-prone but also difficult to maintain.
|
||||
|
||||
**Reactive Text Properties** is one of the most innovative features in the tp.el library. It borrows the reactive programming concepts from modern frontend frameworks like Vue.js and React, allowing Emacs text properties to **automatically respond to variable changes**.
|
||||
|
||||
Imagine: you define the relationship between a variable and a property once, and from then on, whenever you change the variable's value, all text regions using that variable will **automatically update**. This is the magic of reactive text properties!
|
||||
|
||||
## From Traditional to Reactive
|
||||
|
||||
### Pain Points of the Traditional Approach
|
||||
|
||||
Let's first look at how the traditional approach handles dynamic text properties:
|
||||
|
||||
```lisp
|
||||
;; Traditional approach: define a color variable
|
||||
(defvar my-color "red")
|
||||
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Hello World")
|
||||
(tp-set 1 12 `(face (:foreground ,my-color)))
|
||||
|
||||
;; Here comes the problem: when you want to change the color...
|
||||
(setq my-color "blue")
|
||||
;; The text doesn't update automatically! You must manually reapply:
|
||||
(tp-set 1 12 `(face (:foreground ,my-color))))
|
||||
```
|
||||
|
||||
The problems with this approach are obvious:
|
||||
1. **Manual tracking**: You need to remember which text regions use which variables
|
||||
2. **Easy to miss**: In complex applications, it's easy to forget to update some regions
|
||||
3. **Code redundancy**: Update logic is scattered throughout the code
|
||||
|
||||
### The Elegance of Reactive Approach
|
||||
|
||||
Now let's see how the reactive approach solves these problems:
|
||||
|
||||
```lisp
|
||||
;; Reactive approach: define a color variable
|
||||
(defvar my-color "red")
|
||||
|
||||
;; Define a reactive layer using $my-color to reference the variable
|
||||
(define-tp my-highlight ()
|
||||
'(face (:foreground $my-color)))
|
||||
|
||||
;; Apply to text
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Hello World")
|
||||
(tp-set 1 12 'my-highlight)
|
||||
|
||||
;; Now, just change the variable!
|
||||
(setq my-color "blue")
|
||||
;; Magic happens: the text automatically turns blue!
|
||||
)
|
||||
```
|
||||
|
||||
Isn't that amazing? Let's dive deep into how this powerful feature works.
|
||||
|
||||
## Core Concepts
|
||||
|
||||
### Reactive Variables
|
||||
|
||||
In tp.el, any symbol starting with `$` is treated as a **reactive variable**. For example:
|
||||
- `$my-color` → references variable `my-color`
|
||||
- `$font-size` → references variable `font-size`
|
||||
- `$theme-background` → references variable `theme-background`
|
||||
|
||||
When you use these `$`-prefixed symbols in property definitions, tp.el will:
|
||||
1. Automatically resolve the variable's current value
|
||||
2. Register a watcher to monitor variable changes
|
||||
3. When the variable changes, automatically update all related text regions
|
||||
|
||||
## Basic Usage
|
||||
|
||||
### Your First Reactive Layer
|
||||
|
||||
Let's start with a simple example:
|
||||
|
||||
```lisp
|
||||
;; Define a global variable
|
||||
(defvar highlight-bg "yellow")
|
||||
|
||||
;; Define a reactive layer
|
||||
(define-tp simple-highlight ()
|
||||
'(face (:background $highlight-bg)))
|
||||
|
||||
;; Create a test buffer and apply the layer
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "This is text that needs highlighting")
|
||||
(tp-set 1 (point-max) 'simple-highlight)
|
||||
;; => "Initial background color: yellow"
|
||||
;; Change the variable
|
||||
(setq highlight-bg "cyan")
|
||||
;; => "Updated background color: cyan"
|
||||
)
|
||||
```
|
||||
|
||||
### Multiple Reactive Variables
|
||||
|
||||
A layer can reference multiple reactive variables:
|
||||
|
||||
```lisp
|
||||
;; Define multiple variables
|
||||
(defvar fg-color "white")
|
||||
(defvar bg-color "darkGreen")
|
||||
(defvar underline-color "red")
|
||||
|
||||
;; Define a layer using multiple variables
|
||||
(define-tp multi-var-layer ()
|
||||
'(face ( :foreground $fg-color
|
||||
:background $bg-color
|
||||
:underline (:color $underline-color))))
|
||||
|
||||
;; Test
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Multi-variable reactive example")
|
||||
(tp-set 1 (point-max) 'multi-var-layer)
|
||||
|
||||
;; Changing any variable triggers an update
|
||||
(setq fg-color "yellow") ; Foreground turns yellow
|
||||
(setq bg-color "navy") ; Background turns navy
|
||||
(setq underline-color "lime") ; Underline turns lime green
|
||||
)
|
||||
```
|
||||
|
||||
## Advanced Features: :data, :compute, and :watch
|
||||
|
||||
tp.el's reactive system borrows from Vue's API, providing three powerful keywords:
|
||||
|
||||
### :data - Define Additional Reactive State
|
||||
|
||||
Sometimes you need reactive variables that aren't directly used in `:props`. This is where `:data` comes in.
|
||||
|
||||
Main uses of `:data`:
|
||||
1. Define auxiliary variables that don't appear directly in properties
|
||||
2. Provide initial values for variables
|
||||
3. Work together with `:compute`
|
||||
|
||||
### :compute - Computed Properties
|
||||
|
||||
`:compute` lets you define **derived values**—their values are computed from other variables:
|
||||
|
||||
```lisp
|
||||
;; Complete computed properties example
|
||||
(define-tp computed-greeting ()
|
||||
:props '(display $full-greeting face (:foreground $status-color))
|
||||
:data '((user-name . "John")
|
||||
(greeting-prefix . "Hello"))
|
||||
:compute '((full-greeting (lambda ()
|
||||
(format "%s, %s! Welcome back."
|
||||
greeting-prefix user-name)))
|
||||
(status-color (lambda ()
|
||||
(if (string= user-name "Admin")
|
||||
"red"
|
||||
"green")))))
|
||||
|
||||
;; Test
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Test text")
|
||||
(tp-set 1 (point-max) 'computed-greeting)
|
||||
;; Initial state
|
||||
(message "full-greeting = %s" full-greeting)
|
||||
;; => "Hello, John! Welcome back."
|
||||
(message "status-color = %s" status-color)
|
||||
;; => "green"
|
||||
;; Change user-name
|
||||
(setq user-name "Admin")
|
||||
;; Computed properties update automatically!
|
||||
(message "full-greeting = %s" full-greeting)
|
||||
;; => "Hello, Admin! Welcome back."
|
||||
(message "status-color = %s" status-color)
|
||||
;; => "red"
|
||||
;; Change greeting-prefix
|
||||
(setq greeting-prefix "Hi")
|
||||
(message "full-greeting = %s" full-greeting))
|
||||
;; => "Hi, Admin! Welcome back."
|
||||
```
|
||||
|
||||
### :watch - Watch Variable Changes
|
||||
|
||||
`:watch` lets you execute **side effect** operations when variables change:
|
||||
|
||||
```lisp
|
||||
;; Layer with watchers
|
||||
(define-tp watched-layer ()
|
||||
:props '(face (:foreground $status-color))
|
||||
:data '((status-color . "green"))
|
||||
:watch '((status-color
|
||||
(lambda (new-val old-val layer-name)
|
||||
(message "[%s] Color changed from %s to %s"
|
||||
layer-name old-val new-val)))))
|
||||
|
||||
;; Test
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Test text")
|
||||
(tp-set 1 (point-max) 'watched-layer)
|
||||
|
||||
;; Change color - triggers watcher
|
||||
(setq status-color "yellow")
|
||||
;; Message: "[watched-layer] Color changed from green to yellow"
|
||||
|
||||
(setq status-color "red"))
|
||||
;; Message: "[watched-layer] Color changed from yellow to red"
|
||||
```
|
||||
|
||||
Typical uses for `:watch`:
|
||||
- Logging
|
||||
- Updating external state
|
||||
- Triggering notifications
|
||||
- Performing cleanup operations
|
||||
|
||||
## Complete Practical Examples
|
||||
|
||||
### Example 1: Dynamic Color Status Indicator
|
||||
|
||||
This example shows how to create an indicator that automatically changes color based on status:
|
||||
|
||||
```lisp
|
||||
(tp-layer-reset)
|
||||
|
||||
;; Define status color variables
|
||||
(defvar status-color "gray")
|
||||
(defvar status-text "Not Started")
|
||||
|
||||
;; Define status indicator layer
|
||||
(define-tp status-indicator ()
|
||||
'(face (:background $status-color) display $status-text))
|
||||
|
||||
;; Define status update function
|
||||
(defun set-status (status)
|
||||
"Set status, automatically update color and text"
|
||||
(pcase status
|
||||
('pending (setq status-color "gray" status-text "Pending"))
|
||||
('running (setq status-color "blue" status-text "Running"))
|
||||
('success (setq status-color "green" status-text "Success"))
|
||||
('warning (setq status-color "orange" status-text "Warning"))
|
||||
('error (setq status-color "red" status-text "Error"))))
|
||||
|
||||
;; Test the status indicator
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Status")
|
||||
(tp-set 1 (point-max) 'status-indicator)
|
||||
|
||||
;; Simulate status changes
|
||||
(set-status 'pending)
|
||||
(message "Status: %s, Color: %s" status-text status-color)
|
||||
;; => "Status: Pending, Color: gray"
|
||||
|
||||
(set-status 'running)
|
||||
(message "Status: %s, Color: %s" status-text status-color)
|
||||
;; => "Status: Running, Color: blue"
|
||||
|
||||
(set-status 'success)
|
||||
(message "Status: %s, Color: %s" status-text status-color))
|
||||
;; => "Status: Success, Color: green"
|
||||
```
|
||||
|
||||
### Example 2: Theme Switching System
|
||||
|
||||
This example shows how to create a switchable theme system:
|
||||
|
||||
```lisp
|
||||
(tp-layer-reset)
|
||||
|
||||
;; Define theme color variables
|
||||
(defvar keyword-color nil)
|
||||
(defvar string-color nil)
|
||||
|
||||
;; Define theme-related reactive layers
|
||||
(define-tp themed-keyword ()
|
||||
'(face (:foreground $keyword-color :weight bold)))
|
||||
|
||||
(define-tp themed-string ()
|
||||
'(face (:foreground $string-color)))
|
||||
|
||||
;; Define theme switching functions
|
||||
(defun switch-to-dark-theme ()
|
||||
"Switch to dark theme"
|
||||
(interactive)
|
||||
(setq keyword-color "light blue"
|
||||
string-color "green")
|
||||
(message "Switched to dark theme"))
|
||||
|
||||
(defun switch-to-light-theme ()
|
||||
"Switch to light theme"
|
||||
(interactive)
|
||||
(setq keyword-color "blue"
|
||||
string-color "dark green")
|
||||
(message "Switched to light theme"))
|
||||
|
||||
;; Test theme switching
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "(defun hello () \"greeting\")")
|
||||
|
||||
;; Apply different theme layers
|
||||
(tp-match-set "defun" 'themed-keyword)
|
||||
(tp-regexp-set "\".+\"" 'themed-string)
|
||||
|
||||
(switch-to-dark-theme)
|
||||
;; Initially using dark theme
|
||||
(message "Keyword color: %s" keyword-color)
|
||||
(message "String color: %s" string-color)
|
||||
|
||||
;; Switch to light theme
|
||||
(switch-to-light-theme)
|
||||
;; Text updates automatically!
|
||||
(message "Keyword color: %s" keyword-color)
|
||||
(message "String color: %s" string-color))
|
||||
```
|
||||
|
||||
## Anonymous Reactive Layers
|
||||
|
||||
Besides using `define-tp` to define named layers, you can also use reactive variables directly in property lists. tp.el will automatically generate unique names for these anonymous layers:
|
||||
|
||||
```lisp
|
||||
(tp-layer-reset)
|
||||
|
||||
(defvar inline-color "purple")
|
||||
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Anonymous reactive layer example")
|
||||
|
||||
;; Use $inline-color directly, no need to pre-define a layer
|
||||
(tp-set 1 (point-max) '(face (:foreground $inline-color)))
|
||||
|
||||
;; Text is now purple
|
||||
(message "Color: %s" (plist-get (tp-at 1 'face) :foreground))
|
||||
;; => "purple"
|
||||
|
||||
;; Change the variable
|
||||
(setq inline-color "orange")
|
||||
|
||||
;; Text automatically turns orange
|
||||
(message "Color: %s" (plist-get (tp-at 1 'face) :foreground)))
|
||||
;; => "orange"
|
||||
```
|
||||
|
||||
Anonymous reactive layers are suitable for simple scenarios where you don't need to reuse the same layer definition in multiple places.
|
||||
|
||||
## Reactive Text (tp-text)
|
||||
|
||||
Besides reactive text **properties**, tp.el also supports reactive **text content** itself. Through the special `tp-text` property, you can make the text content reactive too—when the bound variable changes, the text content automatically updates.
|
||||
|
||||
### Basic Usage
|
||||
|
||||
The `tp-text` property has two ways to use:
|
||||
|
||||
#### 1. Initialize with Current Text
|
||||
|
||||
When `tp-text` is `nil`, it will be automatically set to the current region's text content:
|
||||
|
||||
```lisp
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Hello World")
|
||||
;; When tp-text is nil, auto-initialize to current text "Hello"
|
||||
(tp-set 1 6 '(face bold tp-text nil))
|
||||
;; Now tp-text value is "Hello"
|
||||
(message "tp-text = %s" (tp-at 1 'tp-text)))
|
||||
;; => "Hello"
|
||||
```
|
||||
|
||||
#### 2. Replace Text Content
|
||||
|
||||
When `tp-text` is a string, it replaces the text in the region while preserving other text properties:
|
||||
|
||||
```lisp
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Hello World")
|
||||
;; When tp-text is a string, replace the text content
|
||||
(tp-set 1 6 '(face bold tp-text "Hi"))
|
||||
;; Text becomes "Hi World", and "Hi" still has bold style
|
||||
(message "buffer = %s" (buffer-string)))
|
||||
;; => "Hi World"
|
||||
```
|
||||
|
||||
### Reactive Text Layers
|
||||
|
||||
The real power of `tp-text` comes from combining it with reactive variables:
|
||||
|
||||
```lisp
|
||||
;; Define a reactive variable
|
||||
(defvar my-dynamic-text "Loading...")
|
||||
|
||||
;; Define a layer containing tp-text
|
||||
(define-tp dynamic-content ()
|
||||
:props '(face (:foreground "blue") tp-text $my-dynamic-text))
|
||||
|
||||
;; Apply to text
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "placeholder")
|
||||
(tp-set 1 12 'dynamic-content)
|
||||
;; Text now shows "Loading..."
|
||||
(message "Initial text: %s" (buffer-string))
|
||||
;; => "Loading..."
|
||||
|
||||
;; Change the variable
|
||||
(setq my-dynamic-text "Data loaded successfully!")
|
||||
;; Text updates automatically!
|
||||
(message "After update: %s" (buffer-string)))
|
||||
;; => "Data loaded successfully!"
|
||||
```
|
||||
|
||||
### Using :compute for Dynamic Text
|
||||
|
||||
`tp-text` can be combined with `:compute` to create dynamic text derived from other variables:
|
||||
|
||||
```lisp
|
||||
(define-tp greeting-layer ()
|
||||
:props '(face (:foreground "green") tp-text $full-greeting)
|
||||
:data '((user-name . "Guest")
|
||||
(greeting-prefix . "Welcome"))
|
||||
:compute '((full-greeting
|
||||
(lambda ()
|
||||
(format "%s, %s!" greeting-prefix user-name)))))
|
||||
|
||||
;; Apply to text
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "placeholder")
|
||||
(tp-set 1 12 'greeting-layer)
|
||||
;; Shows "Welcome, Guest!"
|
||||
(message "Initial: %s" (buffer-string))
|
||||
|
||||
;; Change user name
|
||||
(setq user-name "John")
|
||||
;; Text automatically updates to "Welcome, John!"
|
||||
(message "After update: %s" (buffer-string)))
|
||||
```
|
||||
|
||||
### Anonymous Reactive Text
|
||||
|
||||
You can also use reactive `tp-text` directly in property lists without defining a layer:
|
||||
|
||||
```lisp
|
||||
(defvar inline-text "Original content")
|
||||
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "placeholder")
|
||||
;; Directly use reactive tp-text
|
||||
(tp-set 1 12 '(face bold tp-text $inline-text))
|
||||
;; Shows "Original content"
|
||||
|
||||
;; Change the variable
|
||||
(setq inline-text "New content")
|
||||
;; Text automatically updates to "New content"
|
||||
)
|
||||
```
|
||||
|
||||
### Important Notes
|
||||
|
||||
1. **tp-text on strings returns a new string**: Emacs strings cannot change length in place, so string-object calls return a new string instead of modifying the original. A sub-region `tp-text` replaces only that region and keeps the rest of the string; the whole-string form returns just the replacement text.
|
||||
2. **Preserves existing properties**: When using `tp-set` or `tp-add` to set `tp-text`, existing text properties are preserved.
|
||||
3. **Non-reactive properties don't add tp-name**: If there are no reactive variables (`$` prefix) in the text properties, `tp-name` and other reactive-specific properties won't be added, maintaining native text property behavior.
|
||||
|
||||
## Value Transformation with :transform
|
||||
|
||||
The `:transform` keyword allows you to register a transformation function that processes `tp-text` values before they are displayed. This is useful for formatting numbers, dates, or other values:
|
||||
|
||||
```lisp
|
||||
;; Number formatting
|
||||
(define-tp price-display ()
|
||||
:props '(tp-text $price)
|
||||
:data '((price . "99.9"))
|
||||
:transform (lambda (text)
|
||||
(format "$%.2f" (string-to-number text))))
|
||||
;; 99.9 displays as $99.90
|
||||
|
||||
;; Date formatting
|
||||
(define-tp date-display ()
|
||||
:props '(tp-text $timestamp)
|
||||
:data '((timestamp . "1703865600"))
|
||||
:transform (lambda (text)
|
||||
(format-time-string "%Y-%m-%d"
|
||||
(seconds-to-time (string-to-number text)))))
|
||||
|
||||
;; Uppercase conversion
|
||||
(define-tp uppercase-text ()
|
||||
:props '(tp-text $content)
|
||||
:data '((content . "hello"))
|
||||
:transform #'upcase)
|
||||
;; "hello" displays as "HELLO"
|
||||
```
|
||||
|
||||
The transform function:
|
||||
- Receives the raw `tp-text` string value
|
||||
- Returns the transformed string for display
|
||||
- Is applied both on initial display and reactive updates
|
||||
- Must return a string; errors and non-string results propagate rather
|
||||
than leaving stale output visible
|
||||
|
||||
> 📖 **For more optimization features like batched updates and debug mode, see [Reactive System Optimization](reactive-optimization-en.md)**
|
||||
|
||||
## Summary
|
||||
|
||||
tp.el's reactive text properties feature brings a modern reactive programming experience to Emacs development. By using `$`-prefixed reactive variables, `:data` to define state, `:compute` for derived values, `:watch` to monitor changes, and `:transform` for value formatting, you can build a more dynamic and maintainable text property system.
|
||||
|
||||
Key points:
|
||||
1. **Reactive Variables**: Use `$` prefix to reference variables
|
||||
2. **:props**: Define properties containing reactive variables
|
||||
3. **:data**: Define additional reactive state and initial values
|
||||
4. **:compute**: Define computed properties derived from other variables
|
||||
5. **:watch**: Watch variable changes and execute side effects
|
||||
6. **:transform**: Transform tp-text values before display
|
||||
7. **Automatic Updates**: Change variable values, all related text updates automatically
|
||||
8. **Reactive Text (tp-text)**: Make text content itself reactive
|
||||
In TP 1.0, use direct property APIs/recipes for static declarations, tp-watch
|
||||
for reactive properties on host-owned text, and a content surface for text
|
||||
owned by TP.
|
||||
|
||||
@ -1,509 +1,15 @@
|
||||
# tp.el 响应式文本属性完全指南
|
||||
# Reactive text properties（历史归档）
|
||||
|
||||
> **历史 TP 0.3 文档，TP 1.0 已废弃。** 本文记录已经删除的 `$variable`、`tp-text`、inline `tp-name` 和扫描式响应更新模型，仅作为迁移与设计历史保留；下文的 API、示例和“当前行为”声明均不适用于 TP 1.0。当前响应式模型使用 signal、binding、`tp-computed`、`tp-watch` 与 retained surface，详见 [README](../README_CN.md)、[当前架构](ARCHITECTURE.md) 和 [API 合同](API-SEMANTICS.md)。
|
||||
本文是 TP 0.3 时代的设计/实现记录，不是 TP 1.0 用法文档。正文中出现的
|
||||
tp-text、tp-render、tp-stack、$variable、inline metadata、扫描式刷新等
|
||||
内容已经从当前运行时删除；不要复制其中的 API 或示例。
|
||||
|
||||
> 将现代前端框架的响应式编程范式带入 Emacs 文本属性世界
|
||||
当前实现请阅读：
|
||||
|
||||
## 引言
|
||||
- [TP 1.0 公共 API 参考](API-REFERENCE.md)
|
||||
- [API 语义合同](API-SEMANTICS.md)
|
||||
- [当前架构](ARCHITECTURE.md)
|
||||
- [中文 README](../README_CN.md)
|
||||
|
||||
在传统的 Emacs 开发中，文本属性（text properties）的管理一直是一个繁琐的任务。每当你想要改变某个属性值时，你需要手动找到所有相关的文本区域，然后逐一更新它们。这种方式不仅容易出错，而且难以维护。
|
||||
|
||||
**响应式文本属性**是 tp.el 库中最具创新性的功能之一。它借鉴了 Vue.js、React 等现代前端框架的响应式编程思想，让 Emacs 的文本属性能够**自动响应变量的变化**。
|
||||
|
||||
想象一下：你只需要定义一次变量与属性的关系，之后无论何时改变变量的值，所有使用该变量的文本区域都会**自动更新**。这就是响应式文本属性的魔力！
|
||||
|
||||
## 从传统方式到响应式方式
|
||||
|
||||
### 传统方式的痛点
|
||||
|
||||
让我们先看看传统方式如何处理动态文本属性：
|
||||
|
||||
```lisp
|
||||
;; 传统方式：定义一个颜色变量
|
||||
(defvar my-color "red")
|
||||
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Hello World")
|
||||
(tp-set 1 12 `(face (:foreground ,my-color)))
|
||||
|
||||
;; 问题来了：当你想改变颜色时...
|
||||
(setq my-color "blue")
|
||||
;; 文本不会自动更新！你必须手动重新应用：
|
||||
(tp-set 1 12 `(face (:foreground ,my-color))))
|
||||
```
|
||||
|
||||
这种方式的问题显而易见：
|
||||
1. **手动追踪**：你需要记住哪些文本区域使用了哪些变量
|
||||
2. **容易遗漏**：在复杂应用中很容易忘记更新某些区域
|
||||
3. **代码冗余**：更新逻辑散落在代码各处
|
||||
|
||||
### 响应式方式的优雅
|
||||
|
||||
现在让我们看看响应式方式如何解决这些问题：
|
||||
|
||||
```lisp
|
||||
;; 响应式方式：定义一个颜色变量
|
||||
(defvar my-color "red")
|
||||
|
||||
;; 定义一个响应式层，使用 $my-color 引用变量
|
||||
(define-tp my-highlight ()
|
||||
'(face (:foreground $my-color)))
|
||||
|
||||
;; 应用到文本
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Hello World")
|
||||
(tp-set 1 12 'my-highlight)
|
||||
|
||||
;; 现在，只需改变变量！
|
||||
(setq my-color "blue")
|
||||
;; 神奇的事情发生了：文本自动变成蓝色！
|
||||
)
|
||||
```
|
||||
|
||||
是不是很神奇？让我们深入了解这个强大功能的工作原理。
|
||||
|
||||
## 核心概念
|
||||
|
||||
### 响应式变量
|
||||
|
||||
在 tp.el 中，任何以 `$` 符号开头的符号都被视为**响应式变量**。例如：
|
||||
- `$my-color` → 引用变量 `my-color`
|
||||
- `$font-size` → 引用变量 `font-size`
|
||||
- `$theme-background` → 引用变量 `theme-background`
|
||||
|
||||
当你在属性定义中使用这些 `$` 前缀的符号时，tp.el 会：
|
||||
1. 自动解析变量的当前值
|
||||
2. 注册一个监听器，监视变量的变化
|
||||
3. 当变量改变时，自动更新所有相关的文本区域
|
||||
|
||||
## 基础用法
|
||||
|
||||
### 第一个响应式层
|
||||
|
||||
让我们从一个简单的例子开始：
|
||||
|
||||
```lisp
|
||||
;; 定义一个全局变量
|
||||
(defvar highlight-bg "yellow")
|
||||
|
||||
;; 定义响应式层
|
||||
(define-tp simple-highlight ()
|
||||
'(face (:background $highlight-bg)))
|
||||
|
||||
;; 创建测试缓冲区并应用层
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "这是一段需要高亮的文本")
|
||||
(tp-set 1 (point-max) 'simple-highlight)
|
||||
;; => "初始背景色: yellow"
|
||||
;; 改变变量
|
||||
(setq highlight-bg "cyan")
|
||||
;; => "更新后背景色: cyan"
|
||||
)
|
||||
```
|
||||
|
||||
### 多个响应式变量
|
||||
|
||||
一个层可以引用多个响应式变量：
|
||||
|
||||
```lisp
|
||||
;; 定义多个变量
|
||||
(defvar fg-color "white")
|
||||
(defvar bg-color "darkGreen")
|
||||
(defvar underline-color "red")
|
||||
|
||||
;; 定义使用多个变量的层
|
||||
(define-tp multi-var-layer ()
|
||||
'(face ( :foreground $fg-color
|
||||
:background $bg-color
|
||||
:underline (:color $underline-color))))
|
||||
|
||||
;; 测试
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "多变量响应式示例")
|
||||
(tp-set 1 (point-max) 'multi-var-layer)
|
||||
|
||||
;; 改变任何一个变量都会触发更新
|
||||
(setq fg-color "yellow") ; 前景色变黄
|
||||
(setq bg-color "navy") ; 背景色变海军蓝
|
||||
(setq underline-color "lime") ; 下划线变酸橙绿
|
||||
)
|
||||
```
|
||||
|
||||
## 进阶功能：:data、:compute 和 :watch
|
||||
|
||||
tp.el 的响应式系统借鉴了 Vue 的 API，提供了三个强大的关键字：
|
||||
|
||||
### :data - 定义额外的响应式状态
|
||||
|
||||
有时候你需要一些响应式变量，但它们不直接用于 `:props` 中。这时可以使用 `:data`。
|
||||
|
||||
`:data` 的主要用途：
|
||||
1. 定义不直接出现在属性中的辅助变量
|
||||
2. 为变量提供初始值
|
||||
3. 与 `:compute` 配合使用
|
||||
|
||||
### :compute - 计算属性
|
||||
|
||||
`:compute` 让你可以定义**派生值**——它们的值由其他变量计算得出：
|
||||
|
||||
```lisp
|
||||
;; 完整的计算属性示例
|
||||
(define-tp computed-greeting ()
|
||||
:props '(display $full-greeting face (:foreground $status-color))
|
||||
:data '((user-name . "张三")
|
||||
(greeting-prefix . "你好"))
|
||||
:compute '((full-greeting (lambda ()
|
||||
(format "%s, %s！欢迎回来。"
|
||||
greeting-prefix user-name)))
|
||||
(status-color (lambda ()
|
||||
(if (string= user-name "管理员")
|
||||
"red"
|
||||
"green")))))
|
||||
|
||||
;; 测试
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "测试文本")
|
||||
(tp-set 1 (point-max) 'computed-greeting)
|
||||
;; 初始状态
|
||||
(message "full-greeting = %s" full-greeting)
|
||||
;; => "你好, 张三！欢迎回来。"
|
||||
(message "status-color = %s" status-color)
|
||||
;; => "green"
|
||||
;; 改变 user-name
|
||||
(setq user-name "管理员")
|
||||
;; 计算属性自动更新！
|
||||
(message "full-greeting = %s" full-greeting)
|
||||
;; => "你好, 管理员！欢迎回来。"
|
||||
(message "status-color = %s" status-color)
|
||||
;; => "red"
|
||||
;; 改变 greeting-prefix
|
||||
(setq greeting-prefix "您好")
|
||||
(message "full-greeting = %s" full-greeting))
|
||||
;; => "您好, 管理员！欢迎回来。"
|
||||
```
|
||||
|
||||
### :watch - 监听变量变化
|
||||
|
||||
`:watch` 让你可以在变量改变时执行**副作用**操作：
|
||||
|
||||
```lisp
|
||||
;; 带监听器的层
|
||||
(define-tp watched-layer ()
|
||||
:props '(face (:foreground $status-color))
|
||||
:data '((status-color . "green"))
|
||||
:watch '((status-color
|
||||
(lambda (new-val old-val layer-name)
|
||||
(message "【%s】颜色从 %s 变为 %s"
|
||||
layer-name old-val new-val)))))
|
||||
|
||||
;; 测试
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "测试文本")
|
||||
(tp-set 1 (point-max) 'watched-layer)
|
||||
|
||||
;; 改变颜色 - 触发监听器
|
||||
(setq status-color "yellow")
|
||||
;; 消息: "【watched-layer】颜色从 green 变为 yellow"
|
||||
|
||||
(setq status-color "red"))
|
||||
;; 消息: "【watched-layer】颜色从 yellow 变为 red"
|
||||
```
|
||||
|
||||
`:watch` 的典型用途：
|
||||
- 记录日志
|
||||
- 更新外部状态
|
||||
- 触发通知
|
||||
- 执行清理操作
|
||||
|
||||
## 完整实战示例
|
||||
|
||||
### 示例一：动态颜色状态指示器
|
||||
|
||||
这个示例展示如何创建一个根据状态自动变色的指示器：
|
||||
|
||||
```lisp
|
||||
(tp-layer-reset)
|
||||
|
||||
;; 定义状态颜色变量
|
||||
(defvar status-color "gray")
|
||||
(defvar status-text "未开始")
|
||||
|
||||
;; 定义状态指示器层
|
||||
(define-tp status-indicator ()
|
||||
'(face (:background $status-color) display $status-text))
|
||||
|
||||
;; 定义状态更新函数
|
||||
(defun set-status (status)
|
||||
"设置状态，自动更新颜色和文本"
|
||||
(pcase status
|
||||
('pending (setq status-color "gray" status-text "待处理"))
|
||||
('running (setq status-color "blue" status-text "运行中"))
|
||||
('success (setq status-color "green" status-text "成功"))
|
||||
('warning (setq status-color "orange" status-text "警告"))
|
||||
('error (setq status-color "red" status-text "错误"))))
|
||||
|
||||
;; 测试状态指示器
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "状态")
|
||||
(tp-set 1 (point-max) 'status-indicator)
|
||||
|
||||
;; 模拟状态变化
|
||||
(set-status 'pending)
|
||||
(message "状态: %s, 颜色: %s" status-text status-color)
|
||||
;; => "状态: 待处理, 颜色: gray"
|
||||
|
||||
(set-status 'running)
|
||||
(message "状态: %s, 颜色: %s" status-text status-color)
|
||||
;; => "状态: 运行中, 颜色: blue"
|
||||
|
||||
(set-status 'success)
|
||||
(message "状态: %s, 颜色: %s" status-text status-color))
|
||||
;; => "状态: 成功, 颜色: green"
|
||||
```
|
||||
|
||||
### 示例二：主题切换系统
|
||||
|
||||
这个示例展示如何创建一个可切换的主题系统：
|
||||
|
||||
```lisp
|
||||
(tp-layer-reset)
|
||||
|
||||
;; 定义主题颜色变量
|
||||
(defvar keyword-color nil)
|
||||
(defvar string-color nil)
|
||||
|
||||
;; 定义主题相关的响应式层
|
||||
(define-tp themed-keyword ()
|
||||
'(face (:foreground $keyword-color :weight bold)))
|
||||
|
||||
(define-tp themed-string ()
|
||||
'(face (:foreground $string-color)))
|
||||
|
||||
;; 定义主题切换函数
|
||||
(defun switch-to-dark-theme ()
|
||||
"切换到深色主题"
|
||||
(interactive)
|
||||
(setq keyword-color "light blue"
|
||||
string-color "green")
|
||||
(message "已切换到深色主题"))
|
||||
|
||||
(defun switch-to-light-theme ()
|
||||
"切换到浅色主题"
|
||||
(interactive)
|
||||
(setq keyword-color "blue"
|
||||
string-color "dark green")
|
||||
(message "已切换到浅色主题"))
|
||||
|
||||
;; 测试主题切换
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "(defun hello () \"greeting\")")
|
||||
|
||||
;; 应用不同的主题层
|
||||
(tp-match-set "defun" 'themed-keyword)
|
||||
(tp-regexp-set "\".+\"" 'themed-string)
|
||||
|
||||
(switch-to-dark-theme)
|
||||
;; 初始是深色主题
|
||||
(message "关键字颜色: %s" keyword-color)
|
||||
(message "字符串颜色: %s" string-color)
|
||||
|
||||
;; 切换到浅色主题
|
||||
(switch-to-light-theme)
|
||||
;; 文本自动更新！
|
||||
(message "关键字颜色: %s" keyword-color)
|
||||
(message "字符串颜色: %s" string-color))
|
||||
```
|
||||
|
||||
## 匿名响应式层
|
||||
|
||||
除了使用 `define-tp` 定义命名层，你还可以直接在属性列表中使用响应式变量。tp.el 会自动为这些匿名层生成唯一的名称：
|
||||
|
||||
```lisp
|
||||
(tp-layer-reset)
|
||||
|
||||
(defvar inline-color "purple")
|
||||
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "匿名响应式层示例")
|
||||
|
||||
;; 直接使用 $inline-color，无需预先定义层
|
||||
(tp-set 1 (point-max) '(face (:foreground $inline-color)))
|
||||
|
||||
;; 文本现在是紫色的
|
||||
(message "颜色: %s" (plist-get (tp-at 1 'face) :foreground))
|
||||
;; => "purple"
|
||||
|
||||
;; 改变变量
|
||||
(setq inline-color "orange")
|
||||
|
||||
;; 文本自动变成橙色
|
||||
(message "颜色: %s" (plist-get (tp-at 1 'face) :foreground)))
|
||||
;; => "orange"
|
||||
```
|
||||
|
||||
匿名响应式层适用于简单的场景，当你不需要在多个地方复用同一个层定义时。
|
||||
|
||||
## 响应式文本 (tp-text)
|
||||
|
||||
除了响应式文本**属性**，tp.el 还支持响应式**文本内容**本身。通过特殊的 `tp-text` 属性，你可以让文本内容也变成响应式的——当绑定的变量改变时，文本内容会自动更新。
|
||||
|
||||
### 基本用法
|
||||
|
||||
`tp-text` 属性有两种使用方式：
|
||||
|
||||
#### 1. 初始化当前文本
|
||||
|
||||
当 `tp-text` 的值为 `nil` 时，它会被自动设置为当前区域的文本内容：
|
||||
|
||||
```lisp
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Hello World")
|
||||
;; tp-text 为 nil 时，自动初始化为当前文本 "Hello"
|
||||
(tp-set 1 6 '(face bold tp-text nil))
|
||||
;; 现在 tp-text 的值是 "Hello"
|
||||
(message "tp-text = %s" (tp-at 1 'tp-text)))
|
||||
;; => "Hello"
|
||||
```
|
||||
|
||||
#### 2. 替换文本内容
|
||||
|
||||
当 `tp-text` 的值为字符串时，它会替换区域内的文本，同时保留其他文本属性：
|
||||
|
||||
```lisp
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "Hello World")
|
||||
;; tp-text 为字符串时，替换文本内容
|
||||
(tp-set 1 6 '(face bold tp-text "Hi"))
|
||||
;; 文本变为 "Hi World"，且 "Hi" 仍然有 bold 样式
|
||||
(message "buffer = %s" (buffer-string)))
|
||||
;; => "Hi World"
|
||||
```
|
||||
|
||||
### 响应式文本层
|
||||
|
||||
`tp-text` 的真正威力在于与响应式变量结合使用：
|
||||
|
||||
```lisp
|
||||
;; 定义响应式变量
|
||||
(defvar my-dynamic-text "Loading...")
|
||||
|
||||
;; 定义包含 tp-text 的响应式层
|
||||
(define-tp dynamic-content ()
|
||||
:props '(face (:foreground "blue") tp-text $my-dynamic-text))
|
||||
|
||||
;; 应用到文本
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "placeholder")
|
||||
(tp-set 1 12 'dynamic-content)
|
||||
;; 文本现在显示 "Loading..."
|
||||
(message "初始文本: %s" (buffer-string))
|
||||
;; => "Loading..."
|
||||
|
||||
;; 改变变量
|
||||
(setq my-dynamic-text "数据加载完成!")
|
||||
;; 文本自动更新！
|
||||
(message "更新后: %s" (buffer-string)))
|
||||
;; => "数据加载完成!"
|
||||
```
|
||||
|
||||
### 使用 :compute 生成动态文本
|
||||
|
||||
`tp-text` 可以与 `:compute` 结合，创建由其他变量派生的动态文本：
|
||||
|
||||
```lisp
|
||||
(define-tp greeting-layer ()
|
||||
:props '(face (:foreground "green") tp-text $full-greeting)
|
||||
:data '((user-name . "访客")
|
||||
(greeting-prefix . "欢迎"))
|
||||
:compute '((full-greeting
|
||||
(lambda ()
|
||||
(format "%s, %s!" greeting-prefix user-name)))))
|
||||
|
||||
;; 应用到文本
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "placeholder")
|
||||
(tp-set 1 12 'greeting-layer)
|
||||
;; 显示 "欢迎, 访客!"
|
||||
(message "初始: %s" (buffer-string))
|
||||
|
||||
;; 改变用户名
|
||||
(setq user-name "张三")
|
||||
;; 文本自动更新为 "欢迎, 张三!"
|
||||
(message "更新后: %s" (buffer-string)))
|
||||
```
|
||||
|
||||
### 匿名响应式文本
|
||||
|
||||
你也可以直接在属性列表中使用响应式 `tp-text`，无需定义层：
|
||||
|
||||
```lisp
|
||||
(defvar inline-text "原始内容")
|
||||
|
||||
(tp-pop-to-buffer "*tp-test*"
|
||||
(insert "placeholder")
|
||||
;; 直接使用响应式 tp-text
|
||||
(tp-set 1 12 '(face bold tp-text $inline-text))
|
||||
;; 显示 "原始内容"
|
||||
|
||||
;; 改变变量
|
||||
(setq inline-text "新内容")
|
||||
;; 文本自动更新为 "新内容"
|
||||
)
|
||||
```
|
||||
|
||||
### 注意事项
|
||||
|
||||
1. **tp-text 作用于字符串时返回新字符串**：Emacs 字符串长度无法原地改变，因此字符串形式的调用会返回一个新字符串，而不是修改原字符串。子区域的 `tp-text` 只替换该区域并保留字符串的其余部分；整串形式则只返回替换后的文本。
|
||||
2. **保留现有属性**：使用 `tp-set` 或 `tp-add` 设置 `tp-text` 时，现有的文本属性会被保留。
|
||||
3. **非响应式属性不添加 tp-name**：如果文本属性中没有响应式变量（`$` 前缀），则不会添加 `tp-name` 等响应式专用属性，保持原生文本属性行为。
|
||||
|
||||
## 使用 :transform 进行值转换
|
||||
|
||||
`:transform` 关键字允许你注册一个转换函数，在 `tp-text` 值显示之前对其进行处理。这对于格式化数字、日期或其他值非常有用：
|
||||
|
||||
```lisp
|
||||
;; 数字格式化
|
||||
(define-tp price-display ()
|
||||
:props '(tp-text $price)
|
||||
:data '((price . "99.9"))
|
||||
:transform (lambda (text)
|
||||
(format "$%.2f" (string-to-number text))))
|
||||
;; 99.9 显示为 $99.90
|
||||
|
||||
;; 日期格式化
|
||||
(define-tp date-display ()
|
||||
:props '(tp-text $timestamp)
|
||||
:data '((timestamp . "1703865600"))
|
||||
:transform (lambda (text)
|
||||
(format-time-string "%Y-%m-%d"
|
||||
(seconds-to-time (string-to-number text)))))
|
||||
|
||||
;; 大写转换
|
||||
(define-tp uppercase-text ()
|
||||
:props '(tp-text $content)
|
||||
:data '((content . "hello"))
|
||||
:transform #'upcase)
|
||||
;; "hello" 显示为 "HELLO"
|
||||
```
|
||||
|
||||
转换函数的特点：
|
||||
- 接收原始的 `tp-text` 字符串值
|
||||
- 返回用于显示的转换后字符串
|
||||
- 在初始显示和响应式更新时都会应用
|
||||
- 必须返回字符串；错误或非字符串返回值会向上传播，避免继续显示陈旧结果
|
||||
|
||||
> 📖 **更多优化功能如批量更新和调试模式，请参阅 [响应式系统优化文档](reactive-optimization.md)**
|
||||
|
||||
## 总结
|
||||
|
||||
tp.el 的响应式文本属性功能为 Emacs 开发带来了现代化的响应式编程体验。通过使用 `$` 前缀的响应式变量、`:data` 定义状态、`:compute` 计算派生值、`:watch` 监听变化、`:transform` 格式化值，你可以构建出更加动态、易于维护的文本属性系统。
|
||||
|
||||
核心要点：
|
||||
1. **响应式变量**：使用 `$` 前缀引用变量
|
||||
2. **:props**：定义包含响应式变量的属性
|
||||
3. **:data**：定义额外的响应式状态和初始值
|
||||
4. **:compute**：定义由其他变量派生的计算属性
|
||||
5. **:watch**：监听变量变化并执行副作用
|
||||
6. **:transform**：在显示之前转换 tp-text 值
|
||||
7. **自动更新**：改变变量值，所有相关文本自动更新
|
||||
8. **响应式文本 (tp-text)**：让文本内容本身也能响应式更新
|
||||
TP 1.0 中，静态声明使用 direct property API/recipe，已有 host text 的响应式
|
||||
属性使用 tp-watch，TP 自己拥有的响应式文字使用 content surface。
|
||||
|
||||
@ -2,6 +2,9 @@
|
||||
|
||||
Chinese version: [TP Retained/Reactive Text Runtime 目标架构](retained-runtime-target-architecture.md).
|
||||
|
||||
For the public entry index, see [API-REFERENCE.md](API-REFERENCE.md); for
|
||||
behavior contracts, see [API-SEMANTICS.md](API-SEMANTICS.md).
|
||||
|
||||
Status: implemented TP 1.0 architecture contract. This document records the target boundaries now implemented and protected by tests; [ARCHITECTURE.md](ARCHITECTURE.md) and [API-SEMANTICS.md](API-SEMANTICS.md) are authoritative for current module and public-behavior facts. The `target-architecture` filename remains stable for existing links.
|
||||
|
||||
## 1. Product position
|
||||
@ -191,7 +194,7 @@ With no Ebox on `load-path`, TP 1.0 continuously verifies:
|
||||
|
||||
TP 1.0 is a major-version transition. Stateless public APIs that map directly to the unified core remain. Managed behavior that requires the inline `tp-layers`/`tp-meta` database or scan renderer is explicitly removed or replaced rather than retained in a hidden compatibility engine.
|
||||
|
||||
An explicit one-shot legacy import may scan historical propertized text and construct a surface. Normal signal/property/update hot paths never invoke it automatically.
|
||||
There is no legacy import API in TP 1.0. Callers must provide a plan or producer explicitly; TP never scans historical propertized text to reconstruct surface identity.
|
||||
|
||||
The current implementation has deleted the layer-to-buffer registry, scan-driven refresh hooks, old inline managed codec, duplicate transactions, and old batch renderer. The TP 1.0 package, tests, examples, and this document all work without an Ebox repository.
|
||||
|
||||
|
||||
@ -2,6 +2,9 @@
|
||||
|
||||
英文版见 [TP Retained/Reactive Text Runtime Target Architecture](retained-runtime-target-architecture-en.md)。
|
||||
|
||||
公共入口索引见 [API-REFERENCE.md](API-REFERENCE.md)；语义合同见
|
||||
[API-SEMANTICS.md](API-SEMANTICS.md)。
|
||||
|
||||
状态：TP 1.0 已实现的架构合同。本文记录已经落地并由测试保护的目标边界；当前模块和公共行为事实分别以 [ARCHITECTURE.md](ARCHITECTURE.md) 与 [API-SEMANTICS.md](API-SEMANTICS.md) 为准。文件名保留 `target-architecture` 以维持既有链接稳定。
|
||||
|
||||
## 1. 产品定位
|
||||
@ -191,7 +194,7 @@ TP 1.0 在没有 Ebox load-path 时必须长期通过：
|
||||
|
||||
TP 1.0 是主版本切换。能直接映射到统一 core 的静态 public API 保留；依赖 inline `tp-layers`/`tp-meta` database 和扫描式 renderer 才能工作的 managed behavior 必须明确删除或替换，不保留 hidden compatibility engine。
|
||||
|
||||
允许显式 one-shot legacy import 扫描历史 propertized text 并建立 surface；normal signal/property/update 热路径禁止自动调用它。
|
||||
当前没有 legacy import API；调用者必须显式提供 plan 或 producer。TP 不会扫描历史 propertized text 来重建 surface identity。
|
||||
|
||||
当前实现已经删除 layer→buffer registry、scan-driven refresh hooks、旧 inline managed codec、重复 transaction 和旧 batch renderer。TP 1.0 package、tests、examples 和本文档均可在没有 Ebox repository 的环境中独立工作。
|
||||
|
||||
|
||||
@ -161,6 +161,132 @@
|
||||
(should (equal (nth 0 copy) "value"))
|
||||
(should (equal (nth 1 copy) ["nested"])))))
|
||||
|
||||
(ert-deftest tp-core-test-property-value-copy-keeps-list-functions-opaque ()
|
||||
"Property copies keep list-shaped function values opaque."
|
||||
(let ((function-value '(lambda () 1)))
|
||||
(should (functionp function-value))
|
||||
(should (eq (tp--copy-property-value function-value)
|
||||
function-value))))
|
||||
|
||||
(ert-deftest tp-core-test-property-value-copy-deep-copies-string-properties ()
|
||||
"Property copies do not alias mutable values stored in string properties."
|
||||
(let* ((owners (list 'original))
|
||||
(text (copy-sequence "x")))
|
||||
(add-text-properties 0 1 (list 'ebox-content-owners owners) text)
|
||||
(let ((copy (tp--copy-property-value text)))
|
||||
(should-not (eq copy text))
|
||||
(should-not (eq (get-text-property 0 'ebox-content-owners copy)
|
||||
owners))
|
||||
(setcar owners 'caller-mutated)
|
||||
(should (equal (get-text-property 0 'ebox-content-owners copy)
|
||||
'(original)))
|
||||
(setcar (get-text-property 0 'ebox-content-owners copy) 'copy-mutated)
|
||||
(should (equal (get-text-property 0 'ebox-content-owners text)
|
||||
'(caller-mutated))))))
|
||||
|
||||
(ert-deftest tp-core-test-property-value-copy-preserves-source-identity-rules ()
|
||||
"Property copies memoize one source identity without canonicalizing equals."
|
||||
(let* ((shared (list 'shared))
|
||||
(equal-but-distinct (list 'shared))
|
||||
(value (list shared shared equal-but-distinct))
|
||||
(copy (tp--copy-property-value value)))
|
||||
(should (eq (nth 0 copy) (nth 1 copy)))
|
||||
(should-not (eq (nth 0 copy) (nth 2 copy)))
|
||||
(should-not (eq (nth 0 copy) shared))
|
||||
(should-not (eq (nth 2 copy) equal-but-distinct))
|
||||
(setcar shared 'source-mutated)
|
||||
(should (equal (nth 0 copy) '(shared)))
|
||||
(setcar (nth 0 copy) 'copy-mutated)
|
||||
(should (equal shared '(source-mutated)))
|
||||
(should (equal equal-but-distinct '(shared)))))
|
||||
|
||||
(ert-deftest tp-core-test-property-value-copy-reuses-string-identity ()
|
||||
"Property copies preserve repeated references to one propertized string."
|
||||
(let* ((shared (copy-sequence "shared"))
|
||||
(value (list shared shared))
|
||||
(copy (tp--copy-property-value value)))
|
||||
(should (eq (nth 0 copy) (nth 1 copy)))
|
||||
(should-not (eq (nth 0 copy) shared))))
|
||||
|
||||
(ert-deftest tp-core-test-text-snapshot-transfers-authorized-values ()
|
||||
"Text snapshots transfer only values explicitly owned by the caller."
|
||||
(let* ((owned (list :face t))
|
||||
(copied (list :face t))
|
||||
(text (copy-sequence "ab")))
|
||||
(put-text-property 0 1 'face owned text)
|
||||
(put-text-property 1 2 'payload copied text)
|
||||
(let ((snapshot
|
||||
(tp-text-snapshot
|
||||
text (lambda (property value)
|
||||
(and (eq property 'face) (eq value owned))))))
|
||||
(should (eq (get-text-property 0 'face snapshot) owned))
|
||||
(should-not (eq (get-text-property 1 'payload snapshot) copied))
|
||||
(should-not (eq (get-text-property 1 'payload snapshot) owned)))))
|
||||
|
||||
(ert-deftest tp-core-test-text-snapshot-transfer-does-not-pollute-copy-cache ()
|
||||
"Transferred values do not make an unauthorized property alias its source."
|
||||
(let* ((shared (list :face t))
|
||||
(text (copy-sequence "ab")))
|
||||
(put-text-property 0 1 'face shared text)
|
||||
(put-text-property 1 2 'payload shared text)
|
||||
(let ((snapshot
|
||||
(tp-text-snapshot
|
||||
text (lambda (property _value) (eq property 'face)))))
|
||||
(should (eq (get-text-property 0 'face snapshot) shared))
|
||||
(should-not (eq (get-text-property 1 'payload snapshot) shared))
|
||||
(should-not (eq (get-text-property 1 'payload snapshot)
|
||||
(get-text-property 0 'face snapshot))))))
|
||||
|
||||
(ert-deftest tp-core-test-text-snapshot-copies-propertized-strings-by-default ()
|
||||
"Text snapshots preserve nested string properties under strict copying."
|
||||
(let* ((first (propertize "x" 'nested 'first))
|
||||
(second (propertize "x" 'nested 'second))
|
||||
(text (copy-sequence "ab")))
|
||||
(put-text-property 0 1 'payload first text)
|
||||
(put-text-property 1 2 'payload second text)
|
||||
(let ((snapshot (tp-text-snapshot text)))
|
||||
(should-not (eq (get-text-property 0 'payload snapshot)
|
||||
(get-text-property 1 'payload snapshot)))
|
||||
(should (eq (get-text-property 0 'nested
|
||||
(get-text-property 0 'payload snapshot))
|
||||
'first))
|
||||
(should (eq (get-text-property 0 'nested
|
||||
(get-text-property 1 'payload snapshot))
|
||||
'second)))))
|
||||
|
||||
(ert-deftest tp-core-test-text-snapshot-copies-circular-values-by-default ()
|
||||
"Text snapshots copy circular values without invoking equality."
|
||||
(let* ((first (cons :cycle nil))
|
||||
(second (cons :cycle nil))
|
||||
(text (copy-sequence "ab")))
|
||||
(setcdr first first)
|
||||
(setcdr second second)
|
||||
(put-text-property 0 1 'payload first text)
|
||||
(put-text-property 1 2 'payload second text)
|
||||
(let ((snapshot (tp-text-snapshot text)))
|
||||
(should-not (eq (get-text-property 0 'payload snapshot)
|
||||
(get-text-property 1 'payload snapshot)))
|
||||
(should (eq (cdr (get-text-property 0 'payload snapshot))
|
||||
(get-text-property 0 'payload snapshot)))
|
||||
(should (eq (cdr (get-text-property 1 'payload snapshot))
|
||||
(get-text-property 1 'payload snapshot))))))
|
||||
|
||||
(ert-deftest tp-core-test-property-value-copy-preserves-flat-list-sharing ()
|
||||
"Flat-list snapshots memoize every cons cell, including shared tails."
|
||||
(let* ((tail (list :tail))
|
||||
(value (list (cons :head tail) tail))
|
||||
(copy (tp--copy-property-value value)))
|
||||
(should (eq (cdr (car copy)) (cadr copy)))
|
||||
(should-not (eq (cadr copy) tail))))
|
||||
|
||||
(ert-deftest tp-core-test-property-value-copy-terminates-on-circular-list ()
|
||||
"Circular list snapshots use the recursive memo path without looping."
|
||||
(let ((value (cons :cycle nil)))
|
||||
(setcdr value value)
|
||||
(let ((copy (tp--copy-property-value value)))
|
||||
(should-not (eq copy value))
|
||||
(should (eq (cdr copy) copy)))))
|
||||
|
||||
;;; API-COORD-01: ABSOLUTE coordinates in tp-intervals / tp-intervals-map
|
||||
|
||||
(ert-deftest tp-core-test-intervals-buffer-relative-default ()
|
||||
|
||||
@ -32,6 +32,16 @@
|
||||
(tp-surface-test--leaf 'root (number-to-string (tp-signal-read signal)))
|
||||
(list :value (tp-signal-peek signal)))))
|
||||
|
||||
(defvar-local tp-surface-test--corrupt-next nil
|
||||
"When non-nil, the test after-change hook corrupts one inserted range.")
|
||||
|
||||
(defun tp-surface-test--corrupt-after-change (beg end _old-length)
|
||||
"Corrupt one inserted range for publication rollback tests."
|
||||
(when (and tp-surface-test--corrupt-next (< beg end))
|
||||
(setq-local tp-surface-test--corrupt-next nil)
|
||||
(with-silent-modifications
|
||||
(put-text-property beg end 'face 'corrupt))))
|
||||
|
||||
(ert-deftest tp-surface-test-plan-validates-and-defensively-copies ()
|
||||
"Plans reject duplicate keys and own their caller-provided values."
|
||||
(let* ((callback (byte-compile
|
||||
@ -55,6 +65,156 @@
|
||||
:capability 'content)
|
||||
:type 'tp-duplicate-object-key)))
|
||||
|
||||
(ert-deftest tp-surface-test-plan-snapshots-nested-values ()
|
||||
"Nested plan values remain defensive snapshots across producer boundaries."
|
||||
(let* ((props (list 'face 'bold))
|
||||
(tags (list :role 'leaf))
|
||||
(text (copy-sequence "A"))
|
||||
(child (tp-surface-plan-create
|
||||
:key 'child :kind 'text :text text :props props :tags tags
|
||||
:capability 'content))
|
||||
(children (list child))
|
||||
(parent (tp-surface-plan-create
|
||||
:key 'root :kind 'group :children children
|
||||
:capability 'content))
|
||||
(result (tp-surface-result-create parent))
|
||||
(normalized-from-result
|
||||
(car (tp--producer-result result nil nil nil))))
|
||||
(tp-surface-test--with-buffer
|
||||
(let* ((surface (tp--create-surface
|
||||
buffer 'content '(:capability content)))
|
||||
(normalized-from-plan
|
||||
(car (tp--producer-result parent surface nil nil))))
|
||||
(let* ((result-plan (tp-surface-result-plan result))
|
||||
(result-child (car (tp-surface-plan-children result-plan))))
|
||||
(setf (tp-surface-plan-children result-plan) nil
|
||||
(tp-surface-plan-text result-child) "result-mutated")
|
||||
(setcar (tp-surface-plan-tags result-child) :result-mutated))
|
||||
(setcar props 'help-echo)
|
||||
(setcar tags :mutated)
|
||||
(aset text 0 ?Z)
|
||||
(setcar children nil)
|
||||
(setf (tp-surface-plan-text
|
||||
(car (tp-surface-plan-children parent)))
|
||||
"mutated")
|
||||
(should-not (eq (car (tp-surface-plan-children parent)) child))
|
||||
(should-not (eq (tp-surface-result-plan result) parent))
|
||||
(should-not (eq normalized-from-result parent))
|
||||
(should-not (eq normalized-from-plan parent))
|
||||
(let ((rendered (tp-surface-materialize-string normalized-from-result)))
|
||||
(should (equal (substring-no-properties rendered) "A"))
|
||||
(should (eq (get-text-property 0 'face rendered) 'bold)))
|
||||
(should (equal (tp-surface-plan-tags child) '(:role leaf)))))))
|
||||
|
||||
(ert-deftest tp-surface-test-owned-plan-result-transfers-candidate-tree ()
|
||||
"Owned plan and result constructors skip a duplicate candidate snapshot."
|
||||
(tp-surface-test--with-buffer
|
||||
(let* ((surface (tp--create-surface
|
||||
buffer 'content '(:capability content)))
|
||||
(context (tp--make-context surface)))
|
||||
(let ((tp--current-prepare-context context))
|
||||
(let* ((text (copy-sequence "owned"))
|
||||
(child (tp-surface-plan-create-owned
|
||||
:key 'child :kind 'text :text text
|
||||
:capability 'content))
|
||||
(parent (tp-surface-plan-create-owned
|
||||
:key 'root :kind 'group :children (list child)
|
||||
:capability 'content))
|
||||
(result (tp-surface-result-create-owned context parent))
|
||||
(copies 0)
|
||||
(original (symbol-function 'tp--copy-surface-plan)))
|
||||
(cl-letf (((symbol-function 'tp--copy-surface-plan)
|
||||
(lambda (&rest arguments)
|
||||
(cl-incf copies)
|
||||
(apply original arguments))))
|
||||
(should (eq (car (tp--producer-result result surface nil context))
|
||||
parent)))
|
||||
(should (= copies 0))
|
||||
(should (tp-surface-result-plan-owned-p result))
|
||||
(should (tp-surface-result-consumed-p result))
|
||||
(should-not (tp-surface-result-plan result))
|
||||
(should-not (tp-surface-result-client-state result))
|
||||
(should-not (tp-surface-result-owner-context result))
|
||||
(should-error
|
||||
(tp--producer-result result surface nil context)
|
||||
:type 'tp-owned-result-error)
|
||||
(should (eq (tp-surface-plan-text child) text)))))))
|
||||
|
||||
(ert-deftest tp-surface-test-owned-result-rejects-inactive-or-wrong-context ()
|
||||
"Rejected owned results remain unconsumed for inactive or wrong contexts."
|
||||
(tp-surface-test--with-buffer
|
||||
(let* ((surface (tp--create-surface
|
||||
buffer 'content '(:capability content)))
|
||||
(context (tp--make-context surface))
|
||||
(other-context (tp--make-context surface))
|
||||
(plan (tp-surface-plan-create-owned
|
||||
:key 'root :kind 'text :text "owned"
|
||||
:capability 'content)))
|
||||
(let ((tp--current-prepare-context context))
|
||||
(let ((result (tp-surface-result-create-owned context plan)))
|
||||
(setf (tp--context-active context) nil)
|
||||
(should-error
|
||||
(tp--producer-result
|
||||
result surface nil context)
|
||||
:type 'tp-owned-result-error)
|
||||
(should-not (tp-surface-result-consumed-p result))
|
||||
(should (eq (tp-surface-result-plan result) plan))
|
||||
(setf (tp--context-active context) t)
|
||||
(let ((tp--current-prepare-context other-context))
|
||||
(should-error
|
||||
(tp--producer-result result surface nil other-context)
|
||||
:type 'tp-owned-result-error))
|
||||
(should-not (tp-surface-result-consumed-p result)))))))
|
||||
|
||||
(ert-deftest tp-surface-test-direct-plan-prepare-snapshots-once ()
|
||||
"Direct plan prepare does not snapshot its already-copied plan twice."
|
||||
(let ((plan (tp-surface-test--leaf 'root "direct"))
|
||||
(copies 0)
|
||||
(original (symbol-function 'tp--copy-surface-plan)))
|
||||
(cl-letf (((symbol-function 'tp--copy-surface-plan)
|
||||
(lambda (&rest args)
|
||||
(cl-incf copies)
|
||||
(apply original args))))
|
||||
(should (equal (substring-no-properties
|
||||
(tp-surface-materialize-string plan))
|
||||
"direct"))
|
||||
(should (= copies 1)))))
|
||||
|
||||
(ert-deftest tp-surface-test-render-propagation-reuses-prepared-values ()
|
||||
"Rendering a prepared plan does not recursively copy inherited properties."
|
||||
(let* ((inherited-value (list :space :width 1))
|
||||
(parent (list 'display inherited-value))
|
||||
(child (list 'face 'bold))
|
||||
(render-copies 0)
|
||||
(copy-function (symbol-function 'tp--copy-property-value)))
|
||||
(cl-letf (((symbol-function 'tp--copy-property-value)
|
||||
(lambda (&rest arguments)
|
||||
(cl-incf render-copies)
|
||||
(apply copy-function arguments))))
|
||||
(let ((result (tp--plist-overlay parent child t)))
|
||||
(should (equal (plist-get result 'face) 'bold))
|
||||
(should (eq (plist-get result 'display) inherited-value))
|
||||
(should-not (eq result parent))))
|
||||
(should (= render-copies 0))))
|
||||
|
||||
(ert-deftest tp-surface-test-owned-render-transfers-property-values ()
|
||||
"Owned producer plans transfer candidate property values to rendered text."
|
||||
(let (candidate-value)
|
||||
(let ((rendered
|
||||
(tp-surface-materialize-string
|
||||
(lambda (context)
|
||||
(setq candidate-value (list :space :width 1))
|
||||
(tp-object-ensure context nil 'root 'text)
|
||||
(tp-surface-result-create-owned
|
||||
context
|
||||
(tp-surface-plan-create-owned
|
||||
:key 'root :kind 'text :text "owned"
|
||||
:props (list 'display candidate-value)
|
||||
:capability 'content))))))
|
||||
(should (equal (substring-no-properties rendered) "owned"))
|
||||
(should (eq (get-text-property 0 'display rendered)
|
||||
candidate-value)))))
|
||||
|
||||
(ert-deftest tp-surface-test-plan-copy-obeys-value-identity-rules ()
|
||||
"Plan data is copied while opaque records and functions keep identity."
|
||||
(with-temp-buffer
|
||||
@ -82,6 +242,31 @@
|
||||
(should (eq (nth 6 copy) (current-buffer)))
|
||||
(should (= calls 0)))))
|
||||
|
||||
(ert-deftest tp-surface-test-plan-copy-shares-source-identity-across-children ()
|
||||
"One plan snapshot reuses one copy for repeated source identities globally."
|
||||
(let* ((shared (list :shared t))
|
||||
(equal-but-distinct (list :shared t))
|
||||
(child-a (tp--make-surface-plan
|
||||
:key 'a :kind 'text :tags (list shared)))
|
||||
(child-b (tp--make-surface-plan
|
||||
:key 'b :kind 'text
|
||||
:tags (list shared equal-but-distinct)))
|
||||
(plan (tp--make-surface-plan
|
||||
:key 'root :kind 'group
|
||||
:children (list child-a child-b)))
|
||||
(copy (tp--copy-surface-plan plan))
|
||||
(copy-a
|
||||
(tp-surface-plan-tags
|
||||
(car (tp-surface-plan-children copy))))
|
||||
(copy-b
|
||||
(tp-surface-plan-tags
|
||||
(cadr (tp-surface-plan-children copy)))))
|
||||
(should (eq (car copy-a) (car copy-b)))
|
||||
(should-not (eq (car copy-b) (cadr copy-b)))
|
||||
(should-not (eq (car copy-b) equal-but-distinct))
|
||||
(should-not (eq (cadr copy-b) equal-but-distinct))
|
||||
(should-not (eq (car copy-a) shared))))
|
||||
|
||||
(ert-deftest tp-surface-test-retained-options-own-mutable-containers ()
|
||||
"Surface options copy data containers without cloning opaque identities."
|
||||
(tp-surface-test--with-buffer
|
||||
@ -149,6 +334,23 @@
|
||||
(should (equal (nth 0 second-payload) "report"))
|
||||
(should (equal (nth 1 second-payload) ["nested"]))))))
|
||||
|
||||
(ert-deftest tp-surface-test-report-summary-contains-only-commit-scalars ()
|
||||
"Report summary exposes Ebox metrics without exposing nested report data."
|
||||
(let ((surface
|
||||
(tp--make-surface
|
||||
:report '(:transaction-id 7 :text-operations 2
|
||||
:property-operations 3 :full-root nil
|
||||
:scope-count 4 :scope-range-count 5
|
||||
:scope-fallback t :reconciled-objects 6
|
||||
:created-objects 7 :removed-objects 8 :moved-objects 9
|
||||
:payload (:mutable value)))))
|
||||
(should (equal (tp-surface-report-summary surface)
|
||||
'(:transaction-id 7 :text-operations 2
|
||||
:property-operations 3 :full-root nil
|
||||
:scope-count 4 :scope-range-count 5
|
||||
:scope-fallback t :reconciled-objects 6
|
||||
:created-objects 7 :removed-objects 8 :moved-objects 9)))))
|
||||
|
||||
(ert-deftest tp-surface-test-materialize-producer-is-ephemeral ()
|
||||
"Pure materialization leaves no live object, binding, or subscription."
|
||||
(let ((signal (tp-signal-create 7)) object binding)
|
||||
@ -183,6 +385,284 @@
|
||||
(should (eq (get-text-property 1 'face buffer) 'italic))
|
||||
(should (= (plist-get (tp-surface-report surface) :text-operations) 1)))))
|
||||
|
||||
(ert-deftest tp-surface-test-coordinate-content-mounts-keep-public-ranges ()
|
||||
"Coordinate content mounts avoid marker churn without changing the API."
|
||||
(tp-surface-test--with-buffer
|
||||
(let* ((surface
|
||||
(tp-surface-mount
|
||||
buffer (tp-surface-test--leaf 'root "abc")
|
||||
'(:capability content :coordinate-mounts t)))
|
||||
(object (tp-object-resolve surface '(root)))
|
||||
(mount (car (gethash object (tp--surface-mount-index surface)))))
|
||||
(should (integerp (tp--surface-mount-start mount)))
|
||||
(should (integerp (tp--surface-mount-end mount)))
|
||||
(should (tp-object-mounted-p object))
|
||||
(should (equal (car (tp-object-mounts object))
|
||||
'(:start 1 :end 4 :tags nil)))
|
||||
(tp-surface-update surface (tp-surface-test--leaf 'root "abcd"))
|
||||
(should (equal (car (tp-object-mounts object))
|
||||
'(:start 1 :end 5 :tags nil))))))
|
||||
|
||||
(ert-deftest tp-surface-test-batched-content-ranges-preserve-order ()
|
||||
"Batched content ranges retain attachment order and caller isolation."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((tags (list :slot 'first)))
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let ((object (tp-object-ensure context nil 'root 'text)))
|
||||
(tp-object-attach-content-ranges
|
||||
context object
|
||||
(list (list :object object :start 0 :end 1 :tags tags)
|
||||
(list :object object :start 1 :end 3
|
||||
:tags '(:slot second))))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'text :text "abc"
|
||||
:capability 'content))))
|
||||
(surface (tp-surface-mount
|
||||
buffer producer
|
||||
'(:capability content :coordinate-mounts t)))
|
||||
(object (tp-object-resolve surface '(root))))
|
||||
(setcar tags :mutated)
|
||||
(should (equal (tp-object-mounts object)
|
||||
'((:start 1 :end 4 :tags nil)
|
||||
(:start 1 :end 2 :tags (:slot first))
|
||||
(:start 2 :end 4 :tags (:slot second)))))))))
|
||||
|
||||
(ert-deftest tp-surface-test-batched-content-ranges-reuse-identical-tags ()
|
||||
"A bulk attach shares one snapshot when the same TAGS object is reused."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((tags (list :slot 'same)))
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let ((object (tp-object-ensure context nil 'root 'text)))
|
||||
(tp-object-attach-content-ranges
|
||||
context object
|
||||
(list (list :object object :start 0 :end 1
|
||||
:tags tags)
|
||||
(list :object object :start 1 :end 2
|
||||
:tags tags)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'text :text "ab"
|
||||
:capability 'content))))
|
||||
(surface (tp-surface-mount
|
||||
buffer producer
|
||||
'(:capability content :coordinate-mounts t)))
|
||||
(object (tp-object-resolve surface '(root)))
|
||||
(tagged
|
||||
(cl-remove-if-not
|
||||
(lambda (mount)
|
||||
(equal (tp--surface-mount-tags mount) '(:slot same)))
|
||||
(gethash object (tp--surface-mount-index surface)))))
|
||||
(should (= (length tagged) 2))
|
||||
(should (eq (tp--surface-mount-tags (car tagged))
|
||||
(tp--surface-mount-tags (cadr tagged))))
|
||||
(let ((public-tags (plist-get (cadr (tp-object-mounts object))
|
||||
:tags)))
|
||||
(setcar public-tags :public-mutated)
|
||||
(should (equal (plist-get (cadr (tp-object-mounts object)) :tags)
|
||||
'(:slot same))))
|
||||
(setcar tags :mutated)
|
||||
(should (equal (tp-object-mounts object)
|
||||
'((:start 1 :end 3 :tags nil)
|
||||
(:start 1 :end 2 :tags (:slot same))
|
||||
(:start 2 :end 3 :tags (:slot same)))))))))
|
||||
|
||||
(ert-deftest tp-surface-test-batched-content-ranges-keep-opaque-tags-separate ()
|
||||
"Equal opaque tag values keep independent bulk snapshots."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((left-tags (copy-sequence "same"))
|
||||
(right-tags (copy-sequence "same")))
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let ((object (tp-object-ensure context nil 'root 'text)))
|
||||
(tp-object-attach-content-ranges
|
||||
context object
|
||||
(list (list :object object :start 0 :end 1
|
||||
:tags left-tags)
|
||||
(list :object object :start 1 :end 2
|
||||
:tags right-tags)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'text :text "ab"
|
||||
:capability 'content))))
|
||||
(surface (tp-surface-mount
|
||||
buffer producer
|
||||
'(:capability content :coordinate-mounts t)))
|
||||
(object (tp-object-resolve surface '(root)))
|
||||
(tagged
|
||||
(cl-remove-if-not
|
||||
(lambda (mount)
|
||||
(stringp (tp--surface-mount-tags mount)))
|
||||
(gethash object (tp--surface-mount-index surface)))))
|
||||
(should (= (length tagged) 2))
|
||||
(should-not (eq (tp--surface-mount-tags (car tagged))
|
||||
(tp--surface-mount-tags (cadr tagged))))
|
||||
(aset left-tags 0 ?X)
|
||||
(should (equal (mapcar (lambda (mount)
|
||||
(tp--surface-mount-tags mount))
|
||||
tagged)
|
||||
'("same" "same")))))))
|
||||
|
||||
(ert-deftest tp-surface-test-singular-content-range-snapshots-each-call ()
|
||||
"Separate singular attachments snapshot mutable tags independently."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((tags (list :slot 'before)))
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let ((object (tp-object-ensure context nil 'root 'text)))
|
||||
(tp-object-attach-content-range
|
||||
context object object 0 1 tags)
|
||||
(setcar (cdr tags) 'after)
|
||||
(tp-object-attach-content-range
|
||||
context object object 1 2 tags)
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'text :text "abc"
|
||||
:capability 'content))))
|
||||
(surface (tp-surface-mount
|
||||
buffer producer
|
||||
'(:capability content :coordinate-mounts t)))
|
||||
(object (tp-object-resolve surface '(root))))
|
||||
(should (equal (tp-object-mounts object)
|
||||
'((:start 1 :end 4 :tags nil)
|
||||
(:start 1 :end 2 :tags (:slot before))
|
||||
(:start 2 :end 3 :tags (:slot after)))))))))
|
||||
|
||||
(ert-deftest tp-surface-test-owned-batched-content-ranges-transfer-tags ()
|
||||
"Owned bulk ranges retain freshly allocated TAGS without another copy."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((tags (list :slot 'owned)))
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let ((object (tp-object-ensure context nil 'root 'text)))
|
||||
(tp-object-attach-content-ranges-owned
|
||||
context object
|
||||
(list (list :object object :start 0 :end 1 :tags tags)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'text :text "a"
|
||||
:capability 'content))))
|
||||
(surface (tp-surface-mount
|
||||
buffer producer
|
||||
'(:capability content :coordinate-mounts t)))
|
||||
(object (tp-object-resolve surface '(root)))
|
||||
(mount (cadr (tp-object-mounts object))))
|
||||
(should (eq tags (tp--surface-mount-tags
|
||||
(cadr (gethash object
|
||||
(tp--surface-mount-index surface))))))
|
||||
(should (equal (plist-get mount :tags) '(:slot owned)))))))
|
||||
|
||||
(ert-deftest tp-surface-test-owned-batched-content-ranges-reuse-tags-object ()
|
||||
"Owned bulk ranges reuse the same transferred TAGS object."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((tags (list :slot 'owned-same)))
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let ((object (tp-object-ensure context nil 'root 'text)))
|
||||
(tp-object-attach-content-ranges-owned
|
||||
context object
|
||||
(list (list :object object :start 0 :end 1 :tags tags)
|
||||
(list :object object :start 1 :end 2 :tags tags)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'text :text "ab"
|
||||
:capability 'content))))
|
||||
(surface (tp-surface-mount
|
||||
buffer producer
|
||||
'(:capability content :coordinate-mounts t)))
|
||||
(object (tp-object-resolve surface '(root)))
|
||||
(tagged
|
||||
(cl-remove-if-not
|
||||
(lambda (mount)
|
||||
(equal (tp--surface-mount-tags mount)
|
||||
'(:slot owned-same)))
|
||||
(gethash object (tp--surface-mount-index surface)))))
|
||||
(should (= (length tagged) 2))
|
||||
(should (eq (tp--surface-mount-tags (car tagged)) tags))
|
||||
(should (eq (tp--surface-mount-tags (car tagged))
|
||||
(tp--surface-mount-tags (cadr tagged))))))))
|
||||
|
||||
(ert-deftest tp-surface-test-owned-batched-content-ranges-roll-back-tags ()
|
||||
"A failed owned range publication restores the previous live TAGS."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((text "a")
|
||||
(tags (list :slot 'live)))
|
||||
(cl-labels
|
||||
((producer
|
||||
(context)
|
||||
(let ((object (tp-object-ensure context nil 'root 'text)))
|
||||
(tp-object-attach-content-ranges-owned
|
||||
context object
|
||||
(list (list :object object :start 0 :end 1 :tags tags)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'text :text text :capability 'content))))
|
||||
(let* ((surface (tp-surface-mount
|
||||
buffer #'producer
|
||||
'(:capability content :coordinate-mounts t)))
|
||||
(object (tp-object-resolve surface '(root)))
|
||||
(revision (tp-surface-revision surface))
|
||||
(live-tags
|
||||
(tp--surface-mount-tags
|
||||
(cadr (gethash object
|
||||
(tp--surface-mount-index surface)))))
|
||||
(candidate-tags (list :slot 'candidate)))
|
||||
(setq text "b"
|
||||
tags candidate-tags)
|
||||
(let ((tp--surface-publication-step-function
|
||||
(lambda (step _surface)
|
||||
(when (eq step 'client-state)
|
||||
(error "Injected owned range rollback")))))
|
||||
(should-error (tp-surface-update surface #'producer)))
|
||||
(should (= (tp-surface-revision surface) revision))
|
||||
(should (equal (buffer-string) "a"))
|
||||
(should (eq object (tp-object-resolve surface '(root))))
|
||||
(should
|
||||
(eq live-tags
|
||||
(tp--surface-mount-tags
|
||||
(cadr (gethash object
|
||||
(tp--surface-mount-index surface)))))))))))
|
||||
|
||||
(ert-deftest tp-surface-test-content-publication-preserves-point ()
|
||||
"Content publication writes properties without losing the point."
|
||||
(tp-surface-test--with-buffer
|
||||
(let* ((surface
|
||||
(tp-surface-mount
|
||||
buffer (tp-surface-test--leaf 'root "old value" '(face bold))
|
||||
'(:capability content)))
|
||||
(report
|
||||
(progn
|
||||
(goto-char 6)
|
||||
(tp-surface-update
|
||||
surface (tp-surface-test--leaf 'root "new value" '(face italic))))))
|
||||
(should (equal (buffer-string) "new value"))
|
||||
(should (eq (get-text-property 1 'face buffer) 'italic))
|
||||
(should (= (point) 6))
|
||||
(should (= (plist-get report :text-operations) 1))
|
||||
(should (= (plist-get report :property-operations) 1)))))
|
||||
|
||||
(ert-deftest tp-surface-test-content-publication-reapplies-hook-corruption ()
|
||||
"A hook that changes inserted properties must be corrected before commit."
|
||||
(tp-surface-test--with-buffer
|
||||
(let (surface before revision)
|
||||
(add-hook 'after-change-functions
|
||||
#'tp-surface-test--corrupt-after-change nil t)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq surface
|
||||
(tp-surface-mount
|
||||
buffer (tp-surface-test--leaf 'root "old" '(face bold))
|
||||
'(:capability content)))
|
||||
(setq before (buffer-substring 1 4)
|
||||
revision (tp-surface-revision surface)
|
||||
tp-surface-test--corrupt-next t)
|
||||
(tp-surface-update
|
||||
surface (tp-surface-test--leaf 'root "new" '(face italic)))
|
||||
(should (equal (buffer-string) "new"))
|
||||
(should (= (tp-surface-revision surface) (1+ revision)))
|
||||
(should (eq (get-text-property 1 'face buffer) 'italic))
|
||||
(should-not (equal-including-properties (buffer-substring 1 4)
|
||||
before)))
|
||||
(when (and surface (tp-surface-live-p surface))
|
||||
(tp-surface-unmount surface))
|
||||
(remove-hook 'after-change-functions
|
||||
#'tp-surface-test--corrupt-after-change t)))))
|
||||
|
||||
(ert-deftest tp-surface-test-scoped-content-update-publishes-one-object ()
|
||||
"A scoped update should replace only its retained object's mounted text."
|
||||
(tp-surface-test--with-buffer
|
||||
@ -214,6 +694,67 @@
|
||||
(should (= (plist-get report :scope-range-count) 1))
|
||||
(should (= (plist-get report :touched-characters) 4)))))))
|
||||
|
||||
(ert-deftest tp-surface-test-scoped-update-can-skip-report-snapshot ()
|
||||
"A scoped caller may skip an unused defensive report snapshot."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((middle "B") middle-object)
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let ((root (tp-object-ensure context nil 'root 'group)))
|
||||
(setq middle-object
|
||||
(tp-object-ensure context root 'middle 'text)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'group :capability 'content
|
||||
:children (list (tp-surface-test--leaf 'middle middle)))))
|
||||
(surface (tp-surface-mount buffer producer '(:capability content)))
|
||||
(copies 0)
|
||||
(original (symbol-function 'tp-surface-report)))
|
||||
(setq middle "LONG")
|
||||
(cl-letf (((symbol-function 'tp-surface-report)
|
||||
(lambda (&rest arguments)
|
||||
(cl-incf copies)
|
||||
(apply original arguments))))
|
||||
(should-not
|
||||
(tp-surface-update-scoped
|
||||
surface (list middle-object) producer '(:return-report nil))))
|
||||
(should (= copies 0))
|
||||
(should (= (tp-surface-revision surface) 2))))))
|
||||
|
||||
(ert-deftest tp-surface-test-scoped-content-property-only-keeps-text-stable ()
|
||||
"A scoped property-only change must not replace its character range."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((middle-face 'bold) middle-object)
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let ((root (tp-object-ensure context nil 'root 'group)))
|
||||
(tp-object-ensure context root 'left 'text)
|
||||
(setq middle-object
|
||||
(tp-object-ensure context root 'middle 'text))
|
||||
(tp-object-ensure context root 'right 'text))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'group :capability 'content
|
||||
:children
|
||||
(list (tp-surface-test--leaf 'left "A")
|
||||
(tp-surface-test--leaf 'middle "B"
|
||||
(list 'face middle-face))
|
||||
(tp-surface-test--leaf 'right "C")))))
|
||||
(surface
|
||||
(tp-surface-mount buffer producer '(:capability content)))
|
||||
(marker (copy-marker 3 t)))
|
||||
(setq middle-face 'italic)
|
||||
(cl-letf (((symbol-function 'delete-region)
|
||||
(lambda (&rest _)
|
||||
(error "Scoped property update replaced text"))))
|
||||
(let ((report
|
||||
(tp-surface-update-scoped
|
||||
surface (list middle-object) producer)))
|
||||
(should (= (plist-get report :text-operations) 0))
|
||||
(should (> (plist-get report :property-operations) 0))))
|
||||
(should (equal (buffer-string) "ABC"))
|
||||
(should (eq (get-text-property 2 'face) 'italic))
|
||||
(should (= (marker-position marker) 3))
|
||||
(set-marker marker nil)))))
|
||||
|
||||
(ert-deftest tp-surface-test-scoped-update-supports-disjoint-object-mounts ()
|
||||
"One logical scope should update all of its disjoint mounts atomically."
|
||||
(tp-surface-test--with-buffer
|
||||
@ -550,6 +1091,143 @@
|
||||
'((:start 1 :end 3 :tags (:slot left))
|
||||
(:start 3 :end 6 :tags (:slot right)))))))))
|
||||
|
||||
(ert-deftest tp-surface-test-retain-subtree-preserves-omitted-objects-and-bindings ()
|
||||
"Retaining a live subtree preserves its objects and default bindings."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((value "before") logical child binding)
|
||||
(cl-labels
|
||||
((producer (context)
|
||||
(let ((root (tp-object-ensure context nil 'root 'group)))
|
||||
(if logical
|
||||
(tp-object-retain-subtree context logical)
|
||||
(setq logical
|
||||
(tp-object-ensure context root 'logical 'group)
|
||||
child
|
||||
(tp-object-ensure context logical 'child 'item)
|
||||
binding
|
||||
(tp-bind logical '(test . value)
|
||||
(lambda () value)))
|
||||
(tp-object-retain context logical)
|
||||
(tp-object-retain context child))
|
||||
(tp-object-ensure context root 'text 'text)
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'group :capability 'content
|
||||
:children (list (tp-surface-test--leaf 'text value))))))
|
||||
(let* ((surface (tp-surface-mount
|
||||
buffer #'producer '(:capability content)))
|
||||
(revision (tp-surface-revision surface)))
|
||||
(setq value "after")
|
||||
(tp-surface-update surface #'producer)
|
||||
(should (= (tp-surface-revision surface) (1+ revision)))
|
||||
(should (eq logical (tp-object-resolve surface '(root logical))))
|
||||
(should (eq child (tp-object-resolve
|
||||
surface '(root logical child))))
|
||||
(should (tp-binding-live-p binding))
|
||||
(should (equal (buffer-string) "after")))))))
|
||||
|
||||
(ert-deftest tp-surface-test-reuse-subtree-skips-unchanged-reconcile ()
|
||||
"Reusing a proven subtree keeps its objects without reconciling them."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((value "before") logical child binding)
|
||||
(cl-labels
|
||||
((producer (context)
|
||||
(let ((root (tp-object-ensure context nil 'root 'group)))
|
||||
(if logical
|
||||
(tp-object-reuse-subtree context logical)
|
||||
(setq logical
|
||||
(tp-object-ensure context root 'logical 'group)
|
||||
child
|
||||
(tp-object-ensure context logical 'child 'item)
|
||||
binding
|
||||
(tp-bind logical '(test . value)
|
||||
(lambda () value)))
|
||||
(tp-object-retain context logical)
|
||||
(tp-object-retain context child))
|
||||
(tp-object-ensure context root 'text 'text))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'group :capability 'content
|
||||
:children (list (tp-surface-test--leaf 'text value)))))
|
||||
(let* ((surface (tp-surface-mount
|
||||
buffer #'producer '(:capability content)))
|
||||
(revision (tp-surface-revision surface)))
|
||||
(setq value "after")
|
||||
(tp-surface-update surface #'producer)
|
||||
(should (= (tp-surface-revision surface) (1+ revision)))
|
||||
(should (= (plist-get (tp-surface-report surface)
|
||||
:reconciled-objects)
|
||||
2))
|
||||
(should (eq logical (tp-object-resolve surface '(root logical))))
|
||||
(should (eq child (tp-object-resolve
|
||||
surface '(root logical child))))
|
||||
(should (tp-binding-live-p binding))
|
||||
(should (equal (buffer-string) "after")))))))
|
||||
|
||||
(ert-deftest tp-surface-test-logical-object-owns-leaf-local-ranges ()
|
||||
"One logical object can own multiple ranges in one content leaf."
|
||||
(tp-surface-test--with-buffer
|
||||
(let* ((producer
|
||||
(lambda (context)
|
||||
(let* ((root (tp-object-ensure context nil 'root 'group))
|
||||
(left (tp-object-ensure context root 'left 'item))
|
||||
(right (tp-object-ensure context root 'right 'item))
|
||||
(leaf (tp-object-ensure context root 'leaf 'text)))
|
||||
(tp-object-attach-content-range
|
||||
context left leaf 0 1 '(:slot left))
|
||||
(tp-object-attach-content-range
|
||||
context left leaf 3 4 '(:slot right))
|
||||
(tp-object-attach-content-range
|
||||
context right leaf 1 3 '(:slot middle)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'group :capability 'content
|
||||
:children
|
||||
(list (tp-surface-plan-create
|
||||
:key 'leaf :kind 'text :text "ABCD"
|
||||
:capability 'content)))))
|
||||
(surface (tp-surface-mount
|
||||
buffer producer '(:capability content)))
|
||||
(left (tp-object-resolve surface '(root left)))
|
||||
(right (tp-object-resolve surface '(root right))))
|
||||
(should (equal (buffer-string) "ABCD"))
|
||||
(should (equal (tp-object-mounts left)
|
||||
'((:start 1 :end 2 :tags (:slot left))
|
||||
(:start 4 :end 5 :tags (:slot right)))))
|
||||
(should (equal (tp-object-mounts right)
|
||||
'((:start 2 :end 4 :tags (:slot middle))))))))
|
||||
|
||||
(ert-deftest tp-surface-test-leaf-local-ranges-validate-before-publication ()
|
||||
"Leaf-local ranges reject malformed and out-of-bounds attachments."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((producer
|
||||
(lambda (context)
|
||||
(let* ((root (tp-object-ensure context nil 'root 'group))
|
||||
(owner (tp-object-ensure context root 'owner 'item))
|
||||
(leaf (tp-object-ensure context root 'leaf 'text)))
|
||||
(tp-object-attach-content-range
|
||||
context owner leaf 0 0 '(:slot empty)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'group :capability 'content
|
||||
:children
|
||||
(list (tp-surface-plan-create
|
||||
:key 'leaf :kind 'text :text "AB"
|
||||
:capability 'content))))))
|
||||
(should-error (tp-surface-mount buffer producer '(:capability content))
|
||||
:type 'tp-invalid-content-range)
|
||||
(let ((producer
|
||||
(lambda (context)
|
||||
(let* ((root (tp-object-ensure context nil 'root 'group))
|
||||
(owner (tp-object-ensure context root 'owner 'item))
|
||||
(leaf (tp-object-ensure context root 'leaf 'text)))
|
||||
(tp-object-attach-content-range
|
||||
context owner leaf 0 3 '(:slot too-long)))
|
||||
(tp-surface-plan-create
|
||||
:key 'root :kind 'group :capability 'content
|
||||
:children
|
||||
(list (tp-surface-plan-create
|
||||
:key 'leaf :kind 'text :text "AB"
|
||||
:capability 'content))))))
|
||||
(should-error (tp-surface-mount buffer producer '(:capability content))
|
||||
:type 'tp-invalid-content-range)))))
|
||||
|
||||
(ert-deftest tp-surface-test-explicitly-retained-object-may-be-unmounted ()
|
||||
"An explicitly retained logical object may have no rendered characters."
|
||||
(tp-surface-test--with-buffer
|
||||
@ -742,6 +1420,16 @@
|
||||
(when (and surface (tp-surface-live-p surface))
|
||||
(tp-surface-unmount surface))))))
|
||||
|
||||
(ert-deftest tp-surface-test-content-property-diff-detects-interior-boundary ()
|
||||
"Content property diffing notices a mismatch after a matching first char."
|
||||
(tp-surface-test--with-buffer
|
||||
(insert "abc")
|
||||
(put-text-property 1 2 'face 'bold)
|
||||
(let ((rendered (copy-sequence "abc")))
|
||||
(put-text-property 0 3 'face 'bold rendered)
|
||||
(should (tp--string-property-run-diff-p
|
||||
buffer 1 rendered 0 3)))))
|
||||
|
||||
(ert-deftest tp-surface-test-unmount-preserves-conflicting-host-value ()
|
||||
"Unmount removes only TP's still-current property contribution."
|
||||
(tp-surface-test--with-buffer
|
||||
@ -902,15 +1590,20 @@
|
||||
'(:capability content)))
|
||||
(revision (tp-surface-revision surface))
|
||||
(object (tp-object-resolve surface '(root)))
|
||||
(tp--surface-publication-step-function
|
||||
(lambda (current _surface)
|
||||
(when (eq current step) (error "Injected %s failure" step)))))
|
||||
(should-error
|
||||
(tp-surface-update
|
||||
surface
|
||||
(reached nil)
|
||||
(producer
|
||||
(lambda (context)
|
||||
(tp-object-ensure context nil 'root 'text)
|
||||
(tp-surface-result-create
|
||||
(tp-surface-test--leaf 'root "new" '(face bold))
|
||||
(list :candidate step))))
|
||||
(tp--surface-publication-step-function
|
||||
(lambda (current _surface)
|
||||
(push current reached)
|
||||
(when (eq current step) (error "Injected %s failure" step)))))
|
||||
(should-error
|
||||
(tp-surface-update surface producer))
|
||||
(should (memq step reached))
|
||||
(should (equal-including-properties (buffer-string) "old"))
|
||||
(should (= (tp-surface-revision surface) revision))
|
||||
(should (eq object (tp-object-resolve surface '(root))))))))
|
||||
@ -1102,6 +1795,20 @@
|
||||
"x"))
|
||||
(tp-surface-unmount surface))))
|
||||
|
||||
(ert-deftest tp-surface-test-no-observer-skips-report-snapshot ()
|
||||
"A surface without observers does not copy an unused asynchronous report."
|
||||
(tp-surface-test--with-buffer
|
||||
(let ((copies 0)
|
||||
(original (symbol-function 'tp-surface-report)))
|
||||
(cl-letf (((symbol-function 'tp-surface-report)
|
||||
(lambda (&rest arguments)
|
||||
(cl-incf copies)
|
||||
(apply original arguments))))
|
||||
(tp-surface-mount
|
||||
buffer (tp-surface-test--leaf 'root "committed")
|
||||
'(:capability content)))
|
||||
(should (= copies 0)))))
|
||||
|
||||
(ert-deftest tp-surface-test-observer-failure-does-not-roll-back ()
|
||||
"Observer errors are recorded after a successful publication."
|
||||
(tp-surface-test--with-buffer
|
||||
|
||||
153
tp-core.el
153
tp-core.el
@ -271,24 +271,159 @@ Otherwise, START-OR-STRING and END define the range."
|
||||
do (setq result (plist-put result key val)))))
|
||||
result)))
|
||||
|
||||
(defun tp--copy-property-value (value)
|
||||
(defconst tp--copy-cache-missing (make-symbol "tp-copy-cache-missing")
|
||||
"Sentinel for a missing defensive-copy memo entry.")
|
||||
|
||||
(defun tp--copy-mutable-property-value-p (value)
|
||||
"Return non-nil when VALUE is a recursively copied property container."
|
||||
(and (not (functionp value))
|
||||
(or (consp value)
|
||||
(stringp value)
|
||||
(and (vectorp value) (not (recordp value))))))
|
||||
|
||||
(defun tp--copy-cons-spine (value cache)
|
||||
"Return a single-pass memoized copy of cons spine VALUE using CACHE.
|
||||
Each cons cell is allocated and entered into CACHE before its car is copied,
|
||||
so dotted tails, shared suffixes, and cycles retain their source topology."
|
||||
(let ((source value)
|
||||
head
|
||||
tail
|
||||
reused-p)
|
||||
(while (consp source)
|
||||
(let ((cached (gethash source cache tp--copy-cache-missing)))
|
||||
(if (not (eq cached tp--copy-cache-missing))
|
||||
(progn
|
||||
(if tail
|
||||
(setcdr tail cached)
|
||||
(setq head cached))
|
||||
(setq reused-p t
|
||||
source nil))
|
||||
(let ((copy (cons nil nil)))
|
||||
(puthash source copy cache)
|
||||
(if tail
|
||||
(setcdr tail copy)
|
||||
(setq head copy))
|
||||
(let ((item (car source)))
|
||||
(setcar
|
||||
copy
|
||||
(if (and (not (functionp item))
|
||||
(or (consp item)
|
||||
(stringp item)
|
||||
(and (vectorp item) (not (recordp item)))))
|
||||
(tp--copy-property-value item cache)
|
||||
item)))
|
||||
(setq tail copy
|
||||
source (cdr source))))))
|
||||
(when (and tail (not reused-p))
|
||||
(setcdr tail
|
||||
(if (null source)
|
||||
nil
|
||||
(tp--copy-property-value source cache))))
|
||||
head))
|
||||
|
||||
(defun tp--copy-proper-cons-list (value cache)
|
||||
"Return a fast memoized copy of uncached proper-list VALUE.
|
||||
The whole spine is registered before mutable cars are copied, preserving
|
||||
back-references from cars while `copy-sequence' supplies the spine cheaply."
|
||||
(let ((source value)
|
||||
(cache-free-p t))
|
||||
(while (and cache-free-p (consp source))
|
||||
(when (not (eq (gethash source cache tp--copy-cache-missing)
|
||||
tp--copy-cache-missing))
|
||||
(setq cache-free-p nil))
|
||||
(setq source (cdr source)))
|
||||
(if (not cache-free-p)
|
||||
(tp--copy-cons-spine value cache)
|
||||
(let* ((copy (copy-sequence value))
|
||||
(source value)
|
||||
(target copy))
|
||||
(while (consp source)
|
||||
(puthash source target cache)
|
||||
(let ((item (car source)))
|
||||
(when (and (not (functionp item))
|
||||
(or (consp item)
|
||||
(stringp item)
|
||||
(and (vectorp item) (not (recordp item)))))
|
||||
(setcar target (tp--copy-property-value item cache))))
|
||||
(setq source (cdr source)
|
||||
target (cdr target)))
|
||||
copy))))
|
||||
|
||||
(defun tp--copy-string-with-properties
|
||||
(value &optional cache reuse-property-p)
|
||||
"Return a copy of string VALUE with recursively copied property values.
|
||||
REUSE-PROPERTY-P, when non-nil, is called with PROPERTY and VALUE. A non-nil
|
||||
result transfers that exact candidate-owned VALUE into the returned string;
|
||||
the caller must ensure that VALUE is not mutated by another owner. Values not
|
||||
transferred keep strict source-identity memoization and recursive copying."
|
||||
(let* ((cache (or cache (make-hash-table :test #'eq)))
|
||||
(cached (gethash value cache tp--copy-cache-missing)))
|
||||
(if (not (eq cached tp--copy-cache-missing))
|
||||
cached
|
||||
(let ((copy (copy-sequence value))
|
||||
(position 0)
|
||||
(length (length value)))
|
||||
(puthash value copy cache)
|
||||
(while (< position length)
|
||||
(let ((next (or (next-property-change position value) length))
|
||||
(properties (text-properties-at position value))
|
||||
updates)
|
||||
(while properties
|
||||
(let* ((property (pop properties))
|
||||
(original (pop properties))
|
||||
(mutable-p
|
||||
(tp--copy-mutable-property-value-p original))
|
||||
(reuse-p
|
||||
(and mutable-p reuse-property-p
|
||||
(funcall reuse-property-p property original)))
|
||||
(copied
|
||||
(if reuse-p
|
||||
original
|
||||
(if mutable-p
|
||||
(tp--copy-property-value original cache)
|
||||
original))))
|
||||
(unless (eq copied original)
|
||||
(push property updates)
|
||||
(push copied updates))))
|
||||
(when updates
|
||||
(add-text-properties position next (nreverse updates) copy))
|
||||
(setq position next)))
|
||||
copy))))
|
||||
|
||||
(defun tp-text-snapshot (text &optional reuse-property-p)
|
||||
"Return a defensive copy of TEXT and its mutable text-property values.
|
||||
REUSE-PROPERTY-P, when non-nil, is called with PROPERTY and VALUE. A non-nil
|
||||
result transfers that exact candidate-owned VALUE into the snapshot; the
|
||||
caller must ensure that VALUE is not mutated by another owner. Without the
|
||||
predicate, repeated source identities share defensive copies and all mutable
|
||||
values are recursively isolated."
|
||||
(unless (stringp text)
|
||||
(signal 'wrong-type-argument (list 'stringp text)))
|
||||
(tp--copy-string-with-properties text nil reuse-property-p))
|
||||
|
||||
(defun tp--copy-property-value (value &optional cache)
|
||||
"Return a defensive copy of mutable containers in property VALUE.
|
||||
Cons cells, strings, and vectors are copied recursively. Functions, records,
|
||||
and other opaque objects keep their identity; functions are never executed."
|
||||
(if (not (tp--copy-mutable-property-value-p value))
|
||||
value
|
||||
(let* ((cache (or cache (make-hash-table :test #'eq)))
|
||||
(cached (gethash value cache tp--copy-cache-missing)))
|
||||
(if (not (eq cached tp--copy-cache-missing))
|
||||
cached
|
||||
(cond
|
||||
((functionp value) value)
|
||||
((recordp value) value)
|
||||
((consp value)
|
||||
(cons (tp--copy-property-value (car value))
|
||||
(tp--copy-property-value (cdr value))))
|
||||
((stringp value) (copy-sequence value))
|
||||
(if (proper-list-p value)
|
||||
(tp--copy-proper-cons-list value cache)
|
||||
(tp--copy-cons-spine value cache)))
|
||||
((stringp value) (tp--copy-string-with-properties value cache))
|
||||
((vectorp value)
|
||||
(let ((copy (copy-sequence value)))
|
||||
(puthash value copy cache)
|
||||
(dotimes (index (length copy))
|
||||
(aset copy index
|
||||
(tp--copy-property-value (aref copy index))))
|
||||
copy))
|
||||
(t value)))
|
||||
(tp--copy-property-value (aref copy index) cache)))
|
||||
copy)))))))
|
||||
|
||||
(defun tp--deep-merge-plist (base new)
|
||||
"Deep merge NEW plist into BASE plist.
|
||||
|
||||
579
tp-surface.el
579
tp-surface.el
@ -42,20 +42,31 @@
|
||||
(define-error 'tp-dead-surface "Dead TP surface" 'tp-surface-error)
|
||||
(define-error 'tp-invalid-range-anchor "Invalid TP range anchor"
|
||||
'tp-surface-error)
|
||||
(define-error 'tp-invalid-content-range "Invalid TP content leaf range"
|
||||
'tp-surface-error)
|
||||
(define-error 'tp-producer-buffer-mutation
|
||||
"TP producer mutated a live surface buffer during prepare"
|
||||
'tp-surface-error)
|
||||
(define-error 'tp-publication-mismatch
|
||||
"TP publication was changed by an external buffer hook"
|
||||
'tp-surface-error)
|
||||
(define-error 'tp-scope-mismatch "Scoped TP update changed outside its objects"
|
||||
'tp-surface-error)
|
||||
(define-error 'tp-owned-result-error "Invalid TP owned producer result"
|
||||
'tp-surface-error)
|
||||
|
||||
(cl-defstruct (tp-surface-plan (:constructor tp--make-surface-plan))
|
||||
"Pure retained node data accepted by a TP surface."
|
||||
key kind text props children tags capability)
|
||||
|
||||
(cl-defstruct (tp-surface-result
|
||||
(:constructor tp--make-surface-result (plan client-state)))
|
||||
"A producer result carrying PLAN and opaque CLIENT-STATE."
|
||||
plan client-state)
|
||||
(:constructor tp--make-surface-result
|
||||
(plan client-state &optional plan-owned-p
|
||||
owner-context)))
|
||||
"A producer result carrying PLAN and opaque CLIENT-STATE.
|
||||
PLAN-OWNED-P marks an explicit candidate-local ownership transfer. The
|
||||
owned result is bound to OWNER-CONTEXT and consumed once during prepare."
|
||||
plan client-state plan-owned-p owner-context consumed-p)
|
||||
|
||||
(cl-defstruct (tp-surface
|
||||
(:constructor tp--make-surface)
|
||||
@ -76,7 +87,8 @@
|
||||
(:conc-name tp--context-))
|
||||
"Short-lived candidate identity and attachment owner."
|
||||
surface objects touched retained bindings attachments fragment-attachments
|
||||
child-seen child-positions new-objects created-anchors active ephemeral)
|
||||
content-range-attachments child-seen
|
||||
child-positions new-objects created-anchors active ephemeral)
|
||||
|
||||
(cl-defstruct (tp-range-anchor
|
||||
(:constructor tp--make-range-anchor)
|
||||
@ -87,6 +99,10 @@
|
||||
(cl-defstruct (tp--surface-mount (:constructor tp--make-surface-mount))
|
||||
object start end tags capability anchor)
|
||||
|
||||
(defun tp--mount-position (position)
|
||||
"Return numeric POSITION for a marker or coordinate mount endpoint."
|
||||
(if (markerp position) (marker-position position) position))
|
||||
|
||||
(cl-defstruct (tp--property-ledger (:constructor tp--make-property-ledger))
|
||||
start end property baseline-present baseline-value published-present
|
||||
published-value anchors)
|
||||
@ -110,6 +126,7 @@
|
||||
(defvar tp--surface-publishing nil)
|
||||
(defvar tp--surface-guarding-prepare nil)
|
||||
(defvar tp--surface-publication-step-function nil)
|
||||
(defvar tp--content-published-ranges nil)
|
||||
|
||||
(defvar-local tp--buffer-surfaces nil)
|
||||
(defvar-local tp--surface-character-tick 0)
|
||||
@ -148,22 +165,43 @@
|
||||
(signal 'tp-duplicate-object-key (list key)))
|
||||
(puthash key t seen)))))
|
||||
|
||||
(defun tp--copy-surface-plan (plan)
|
||||
"Return a validated defensive copy of PLAN."
|
||||
(defun tp--validate-surface-plan-tree (plan)
|
||||
"Validate PLAN recursively without copying its caller-owned values."
|
||||
(unless (tp-surface-plan-p plan)
|
||||
(signal 'wrong-type-argument (list 'tp-surface-plan-p plan)))
|
||||
(let* ((children (mapcar #'tp--copy-surface-plan
|
||||
(let ((children (tp-surface-plan-children plan)))
|
||||
(tp--validate-plan-fields
|
||||
(tp-surface-plan-kind plan)
|
||||
(tp-surface-plan-text plan)
|
||||
(tp-surface-plan-props plan)
|
||||
children
|
||||
(tp-surface-plan-capability plan))
|
||||
(tp--validate-sibling-keys children)
|
||||
(dolist (child children)
|
||||
(tp--validate-surface-plan-tree child)))
|
||||
plan)
|
||||
|
||||
(defun tp--copy-surface-plan (plan &optional cache)
|
||||
"Return a validated defensive snapshot of PLAN.
|
||||
CACHE is shared by one top-level snapshot so repeated source identities retain
|
||||
one copied identity across sibling nodes without canonicalizing equal values."
|
||||
(unless (tp-surface-plan-p plan)
|
||||
(signal 'wrong-type-argument (list 'tp-surface-plan-p plan)))
|
||||
(let* ((cache (or cache (make-hash-table :test #'eq)))
|
||||
(children
|
||||
(mapcar (lambda (child)
|
||||
(tp--copy-surface-plan child cache))
|
||||
(tp-surface-plan-children plan)))
|
||||
(kind (tp--copy-property-value (tp-surface-plan-kind plan)))
|
||||
(text (tp--copy-property-value (tp-surface-plan-text plan)))
|
||||
(props (tp--copy-property-value (tp-surface-plan-props plan)))
|
||||
(kind (tp--copy-property-value (tp-surface-plan-kind plan) cache))
|
||||
(text (tp--copy-property-value (tp-surface-plan-text plan) cache))
|
||||
(props (tp--copy-property-value (tp-surface-plan-props plan) cache))
|
||||
(capability (tp-surface-plan-capability plan)))
|
||||
(tp--validate-plan-fields kind text props children capability)
|
||||
(tp--validate-sibling-keys children)
|
||||
(tp--make-surface-plan
|
||||
:key (tp--copy-property-value (tp-surface-plan-key plan))
|
||||
:key (tp--copy-property-value (tp-surface-plan-key plan) cache)
|
||||
:kind kind :text text :props props :children children
|
||||
:tags (tp--copy-property-value (tp-surface-plan-tags plan))
|
||||
:tags (tp--copy-property-value (tp-surface-plan-tags plan) cache)
|
||||
:capability capability)))
|
||||
|
||||
(cl-defun tp-surface-plan-create
|
||||
@ -177,9 +215,37 @@ plans, TAGS are opaque metadata, and CAPABILITY is `content' or `properties'."
|
||||
:key key :kind kind :text text :props props :children children
|
||||
:tags tags :capability capability)))
|
||||
|
||||
(cl-defun tp-surface-plan-create-owned
|
||||
(&key key kind text props children tags capability)
|
||||
"Create a candidate-local surface plan without copying its values.
|
||||
KEY, KIND, TEXT, PROPS, CHILDREN, TAGS, and CAPABILITY have the same meanings
|
||||
as in `tp-surface-plan-create'. The caller transfers ownership of those
|
||||
values; after this call they must not be mutated or exposed to another owner.
|
||||
Use `tp-surface-plan-create' for ordinary caller-owned values."
|
||||
(tp--validate-surface-plan-tree
|
||||
(tp--make-surface-plan
|
||||
:key key :kind kind :text text :props props :children children
|
||||
:tags tags :capability capability)))
|
||||
|
||||
(defun tp-surface-result-create (plan &optional client-state)
|
||||
"Return a producer result containing PLAN and opaque CLIENT-STATE."
|
||||
(tp--make-surface-result (tp--copy-surface-plan plan) client-state))
|
||||
"Return a producer result containing PLAN and opaque CLIENT-STATE.
|
||||
TP always renders the submitted plan inside its prepare transaction. This
|
||||
keeps the plan as the single authoritative source for published content."
|
||||
(tp--make-surface-result
|
||||
(tp--copy-surface-plan plan) client-state))
|
||||
|
||||
(defun tp-surface-result-create-owned (context plan &optional client-state)
|
||||
"Create a one-shot result by adopting candidate-local PLAN.
|
||||
CONTEXT must be the active prepare context that owns PLAN. PLAN and all
|
||||
nested values must be freshly allocated for that candidate and must not be
|
||||
mutated or exposed after this call. CLIENT-STATE is opaque producer state.
|
||||
Use `tp-surface-result-create' for ordinary caller-owned plans."
|
||||
(tp--validate-prepare-context context)
|
||||
(unless (eq context tp--current-prepare-context)
|
||||
(signal 'tp-owned-result-error
|
||||
(list :context-not-current context tp--current-prepare-context)))
|
||||
(tp--make-surface-result
|
||||
(tp--validate-surface-plan-tree plan) client-state t context))
|
||||
|
||||
(defun tp--property-value-equal-p (property left right)
|
||||
"Return non-nil when PROPERTY values LEFT and RIGHT are policy-equal."
|
||||
@ -274,7 +340,8 @@ plans, TAGS are opaque metadata, and CAPABILITY is `content' or `properties'."
|
||||
(let ((object (tp--make-surface-object
|
||||
:id (cl-incf tp--object-id-counter)
|
||||
:surface (tp--context-surface context) :parent parent
|
||||
:key (tp--copy-property-value key) :kind kind :path path
|
||||
:key (tp--copy-property-value key)
|
||||
:kind kind :path path
|
||||
:candidate-context context)))
|
||||
(push object (tp--context-new-objects context))
|
||||
object))
|
||||
@ -309,6 +376,17 @@ plans, TAGS are opaque metadata, and CAPABILITY is `content' or `properties'."
|
||||
(let ((object (gethash key-path (tp--surface-objects surface))))
|
||||
(and (tp-object-live-p object) object)))
|
||||
|
||||
(defun tp-object-mounted-p (object)
|
||||
"Return non-nil when live OBJECT owns at least one published mount.
|
||||
This predicate does not copy mount tags; use `tp-object-mounts' when callers
|
||||
need the public coordinate and metadata snapshots."
|
||||
(unless (tp-object-live-p object)
|
||||
(signal 'tp-stale-object (list object)))
|
||||
(and (gethash object
|
||||
(tp--surface-mount-index
|
||||
(tp--surface-object-surface object)))
|
||||
t))
|
||||
|
||||
(defun tp-object-mounts (object)
|
||||
"Return OBJECT's live numeric mount ranges and opaque tags.
|
||||
Each result is a plist with `:start', `:end', and `:tags'. Marker objects
|
||||
@ -319,8 +397,8 @@ remain private so callers cannot mutate TP's publication coordinates."
|
||||
(mounts (gethash object (tp--surface-mount-index surface))))
|
||||
(mapcar
|
||||
(lambda (mount)
|
||||
(list :start (marker-position (tp--surface-mount-start mount))
|
||||
:end (marker-position (tp--surface-mount-end mount))
|
||||
(list :start (tp--mount-position (tp--surface-mount-start mount))
|
||||
:end (tp--mount-position (tp--surface-mount-end mount))
|
||||
:tags (tp--copy-property-value
|
||||
(tp--surface-mount-tags mount))))
|
||||
mounts)))
|
||||
@ -338,6 +416,7 @@ When EPHEMERAL is non-nil, no identity may be promoted."
|
||||
:bindings (make-hash-table :test #'eq)
|
||||
:attachments (make-hash-table :test #'eq)
|
||||
:fragment-attachments (make-hash-table :test #'eq)
|
||||
:content-range-attachments (make-hash-table :test #'eq)
|
||||
:child-seen (make-hash-table :test #'eq)
|
||||
:child-positions (make-hash-table :test #'eq)
|
||||
:active t :ephemeral ephemeral))
|
||||
@ -348,7 +427,8 @@ When EPHEMERAL is non-nil, no identity may be promoted."
|
||||
(unless (and (tp-object-p object)
|
||||
(eq (tp--surface-object-surface object)
|
||||
(tp--context-surface context))
|
||||
(gethash object (tp--context-touched context)))
|
||||
(or (gethash object (tp--context-touched context))
|
||||
(gethash object (tp--context-retained context))))
|
||||
(signal 'tp-stale-object (list object))))
|
||||
|
||||
(defun tp-object-retain (context object)
|
||||
@ -357,6 +437,71 @@ When EPHEMERAL is non-nil, no identity may be promoted."
|
||||
(puthash object t (tp--context-retained context))
|
||||
object)
|
||||
|
||||
(defun tp--object-path-prefix-p (prefix path)
|
||||
"Return non-nil when PREFIX is a path prefix of PATH."
|
||||
(and (<= (length prefix) (length path))
|
||||
(equal prefix (cl-subseq path 0 (length prefix)))))
|
||||
|
||||
(defun tp-object-retain-subtree (context root)
|
||||
"Retain the existing object subtree rooted at live ROOT in CONTEXT.
|
||||
ROOT must be a live object already owned by CONTEXT's surface. The operation
|
||||
marks ROOT and every already-known descendant as touched and retained, and
|
||||
also keeps their live bindings in the candidate lifecycle. It does not
|
||||
create missing objects or prove that an omitted subtree is unchanged; the
|
||||
producer must provide that proof and a complete candidate plan separately."
|
||||
(tp--validate-prepare-context context)
|
||||
(unless (tp-object-p root)
|
||||
(signal 'wrong-type-argument (list 'tp-object-p root)))
|
||||
(let* ((surface (tp--context-surface context))
|
||||
(path (tp--surface-object-path root))
|
||||
(objects (tp--context-objects context)))
|
||||
(unless (and (tp-object-live-p root)
|
||||
(eq root (gethash path objects)))
|
||||
(signal 'tp-stale-object (list root)))
|
||||
(maphash
|
||||
(lambda (_candidate-path object)
|
||||
(when (tp--object-path-prefix-p
|
||||
path (tp--surface-object-path object))
|
||||
(unless (and (eq (tp--surface-object-surface object) surface)
|
||||
(tp-object-live-p object))
|
||||
(signal 'tp-stale-object (list object)))
|
||||
(puthash object t (tp--context-touched context))
|
||||
(puthash object t (tp--context-retained context))
|
||||
(dolist (binding (tp-binding-owner-bindings object))
|
||||
(when (tp-binding-live-p binding)
|
||||
(puthash binding t (tp--context-bindings context))))))
|
||||
objects))
|
||||
root)
|
||||
|
||||
(defun tp-object-reuse-subtree (context root)
|
||||
"Reuse a proven unchanged live subtree in CONTEXT.
|
||||
ROOT must be a live object already owned by CONTEXT's surface. The subtree's
|
||||
objects and live bindings remain in the candidate, but are not marked touched
|
||||
or reconciled. The caller must still provide a complete candidate plan and
|
||||
prove that the subtree's identity, output, and lifecycle are unchanged."
|
||||
(tp--validate-prepare-context context)
|
||||
(unless (tp-object-p root)
|
||||
(signal 'wrong-type-argument (list 'tp-object-p root)))
|
||||
(let* ((surface (tp--context-surface context))
|
||||
(path (tp--surface-object-path root))
|
||||
(objects (tp--context-objects context)))
|
||||
(unless (and (tp-object-live-p root)
|
||||
(eq root (gethash path objects)))
|
||||
(signal 'tp-stale-object (list root)))
|
||||
(maphash
|
||||
(lambda (_candidate-path object)
|
||||
(when (tp--object-path-prefix-p
|
||||
path (tp--surface-object-path object))
|
||||
(unless (and (eq (tp--surface-object-surface object) surface)
|
||||
(tp-object-live-p object))
|
||||
(signal 'tp-stale-object (list object)))
|
||||
(puthash object t (tp--context-retained context))
|
||||
(dolist (binding (tp-binding-owner-bindings object))
|
||||
(when (tp-binding-live-p binding)
|
||||
(puthash binding t (tp--context-bindings context))))))
|
||||
objects))
|
||||
root)
|
||||
|
||||
(defun tp-object-attach-fragment (context object fragment &optional tags)
|
||||
"Attach logical OBJECT to output FRAGMENT with opaque TAGS in CONTEXT.
|
||||
OBJECT and FRAGMENT must be candidate handles from the same content surface.
|
||||
@ -375,6 +520,87 @@ marker-backed mounts after publication."
|
||||
(tp--context-fragment-attachments context)))
|
||||
(tp-object-retain context object))
|
||||
|
||||
(defun tp--validate-content-range (start end)
|
||||
"Signal unless START and END describe a nonempty local leaf range."
|
||||
(unless (and (integerp start) (integerp end)
|
||||
(>= start 0) (> end start))
|
||||
(signal 'tp-invalid-content-range (list :start start :end end))))
|
||||
|
||||
(defun tp--copy-content-range-tags (tags &optional copies)
|
||||
"Return a defensive copy of non-nil content-range TAGS.
|
||||
COPIES, when non-nil, is a call-local `eq' cache owned by one bulk attach
|
||||
operation. A singular attach always snapshots TAGS independently, so later
|
||||
caller mutation cannot alter an earlier attachment."
|
||||
(if (null tags)
|
||||
nil
|
||||
(let ((copy (and copies (gethash tags copies))))
|
||||
(or copy
|
||||
(let ((copy (tp--copy-property-value tags)))
|
||||
(when copies
|
||||
(puthash tags copy copies))
|
||||
copy)))))
|
||||
|
||||
(defun tp-object-attach-content-range
|
||||
(context object leaf start end &optional tags)
|
||||
"Attach OBJECT to [START, END) in candidate content LEAF for CONTEXT.
|
||||
START and END are character offsets relative to LEAF's text, not buffer
|
||||
positions. LEAF must be a candidate text leaf in the same content surface;
|
||||
the range is validated against its rendered length during prepare. TAGS are
|
||||
opaque metadata copied into the eventual marker-backed mount."
|
||||
(tp--validate-context-object context object)
|
||||
(tp--validate-context-object context leaf)
|
||||
(tp--validate-content-range start end)
|
||||
(let ((attachments
|
||||
(gethash leaf (tp--context-content-range-attachments context))))
|
||||
(puthash leaf
|
||||
(cons (list :object object :start start :end end
|
||||
:tags (tp--copy-content-range-tags tags))
|
||||
attachments)
|
||||
(tp--context-content-range-attachments context)))
|
||||
(unless (gethash object (tp--context-retained context))
|
||||
(tp-object-retain context object)))
|
||||
|
||||
(defun tp--attach-content-ranges (context leaf ranges copy-tags-p)
|
||||
"Attach RANGES to LEAF for CONTEXT, copying TAGS when COPY-TAGS-P is non-nil."
|
||||
(tp--validate-context-object context leaf)
|
||||
(let ((attachments (gethash leaf
|
||||
(tp--context-content-range-attachments context)))
|
||||
(copies (and copy-tags-p (make-hash-table :test #'eq)))
|
||||
added)
|
||||
(dolist (range ranges)
|
||||
(let ((object (plist-get range :object))
|
||||
(start (plist-get range :start))
|
||||
(end (plist-get range :end))
|
||||
(tags (plist-get range :tags)))
|
||||
(tp--validate-context-object context object)
|
||||
(tp--validate-content-range start end)
|
||||
(push (list :object object :start start :end end
|
||||
:tags (if copy-tags-p
|
||||
(tp--copy-content-range-tags tags copies)
|
||||
tags))
|
||||
added)
|
||||
(unless (gethash object (tp--context-retained context))
|
||||
(tp-object-retain context object))))
|
||||
(puthash leaf (nconc added attachments)
|
||||
(tp--context-content-range-attachments context)))
|
||||
ranges)
|
||||
|
||||
(defun tp-object-attach-content-ranges (context leaf ranges)
|
||||
"Attach multiple OBJECT ranges to candidate content LEAF for CONTEXT.
|
||||
RANGES contains plists with `:object', `:start', `:end', and optional `:tags'.
|
||||
TP defensively copies every non-nil TAGS value. The ranges retain input order
|
||||
after publication and reuse a snapshot only when the same TAGS object recurs
|
||||
in one bulk attach."
|
||||
(tp--attach-content-ranges context leaf ranges t))
|
||||
|
||||
(defun tp-object-attach-content-ranges-owned (context leaf ranges)
|
||||
"Attach candidate RANGES to LEAF for CONTEXT with owned TAGS snapshots.
|
||||
Use this only when each non-nil TAGS value was freshly allocated for the
|
||||
candidate and will not be mutated or exposed to caller mutation after this
|
||||
call. TP transfers those values without copying; failed candidates discard
|
||||
the transferred values with the rest of their prepare state."
|
||||
(tp--attach-content-ranges context leaf ranges nil))
|
||||
|
||||
(defun tp--touch-context-binding (context binding)
|
||||
"Record BINDING as touched by CONTEXT."
|
||||
(let ((owner (tp-binding-owner binding)))
|
||||
@ -384,13 +610,20 @@ marker-backed mounts after publication."
|
||||
(signal 'tp-cross-surface-object (list owner)))
|
||||
(puthash binding t (tp--context-bindings context))))
|
||||
|
||||
(defun tp--plist-overlay (parent child)
|
||||
"Return a fresh plist where CHILD values override PARENT values."
|
||||
(let ((result (tp--copy-property-value parent)))
|
||||
(defun tp--plist-overlay (parent child &optional owned-p)
|
||||
"Return a fresh plist where CHILD values override PARENT values.
|
||||
When OWNED-P is non-nil, reuse candidate-owned property values while copying
|
||||
only the plist spine. The non-owned path keeps the defensive value copies
|
||||
needed by ordinary TP callers."
|
||||
(let ((result (if owned-p
|
||||
(copy-sequence parent)
|
||||
(tp--copy-property-value parent))))
|
||||
(cl-loop for (property value) on child by #'cddr
|
||||
do (setq result
|
||||
(plist-put result property
|
||||
(tp--copy-property-value value))))
|
||||
(if owned-p
|
||||
value
|
||||
(tp--copy-property-value value)))))
|
||||
result))
|
||||
|
||||
(defun tp--plan-segment (plan position)
|
||||
@ -398,13 +631,14 @@ marker-backed mounts after publication."
|
||||
(or (tp-surface-plan-key plan)
|
||||
(list :position position :kind (tp-surface-plan-kind plan))))
|
||||
|
||||
(defun tp--render-plan (plan context)
|
||||
"Return PLAN's propertized string and side records in CONTEXT."
|
||||
(defun tp--render-plan (plan context &optional owned-p)
|
||||
"Return PLAN's propertized string and side records in CONTEXT.
|
||||
OWNED-P transfers candidate-local property values through the render pass."
|
||||
(let (records)
|
||||
(cl-labels
|
||||
((walk (node path inherited offset)
|
||||
(let* ((props (tp--plist-overlay
|
||||
inherited (tp-surface-plan-props node)))
|
||||
inherited (tp-surface-plan-props node) owned-p))
|
||||
(begin offset)
|
||||
(children (tp-surface-plan-children node))
|
||||
pieces)
|
||||
@ -425,7 +659,8 @@ marker-backed mounts after publication."
|
||||
(unless object
|
||||
(signal 'tp-orphan-object (list path)))
|
||||
(push (list :path path :object object :start begin :end offset
|
||||
:props props :tags (tp-surface-plan-tags node))
|
||||
:props props :tags (tp-surface-plan-tags node)
|
||||
:leaf (null children))
|
||||
records))
|
||||
(cons (apply #'concat (nreverse pieces)) offset))))
|
||||
(let* ((path (list (tp--plan-segment plan 0)))
|
||||
@ -492,17 +727,34 @@ marker-backed mounts after publication."
|
||||
(dolist (child (tp-surface-plan-children plan))
|
||||
(tp--validate-plan-capability child capability))))
|
||||
|
||||
(defun tp--producer-result (value surface options)
|
||||
"Normalize producer VALUE for SURFACE using OPTIONS."
|
||||
(defun tp--producer-result (value surface options context)
|
||||
"Normalize producer VALUE for SURFACE and active CONTEXT using OPTIONS."
|
||||
(cond
|
||||
((tp-surface-result-p value)
|
||||
(cons (tp--copy-surface-plan (tp-surface-result-plan value))
|
||||
(tp-surface-result-client-state value)))
|
||||
(let ((owned-p (tp-surface-result-plan-owned-p value)))
|
||||
(if owned-p
|
||||
(progn
|
||||
(unless (and context
|
||||
(tp--context-active context)
|
||||
(eq context tp--current-prepare-context)
|
||||
(eq context (tp-surface-result-owner-context value))
|
||||
(not (tp-surface-result-consumed-p value)))
|
||||
(signal 'tp-owned-result-error (list value context)))
|
||||
(let ((plan (tp-surface-result-plan value))
|
||||
(client-state (tp-surface-result-client-state value)))
|
||||
(setf (tp-surface-result-consumed-p value) t
|
||||
(tp-surface-result-plan value) nil
|
||||
(tp-surface-result-client-state value) nil
|
||||
(tp-surface-result-owner-context value) nil)
|
||||
(list plan client-state t)))
|
||||
(list (tp--copy-surface-plan (tp-surface-result-plan value))
|
||||
(tp-surface-result-client-state value) nil))))
|
||||
((tp-surface-plan-p value)
|
||||
(cons (tp--copy-surface-plan value)
|
||||
(list (tp--copy-surface-plan value)
|
||||
(if (plist-member options :client-state)
|
||||
(plist-get options :client-state)
|
||||
(tp--surface-client-state surface))))
|
||||
(tp--surface-client-state surface))
|
||||
nil))
|
||||
(t (signal 'tp-invalid-surface-plan (list value)))))
|
||||
|
||||
(defun tp--context-binding-removals (context objects)
|
||||
@ -553,34 +805,71 @@ marker-backed mounts after publication."
|
||||
count (and old-position (/= old-position position))))))
|
||||
|
||||
(defun tp--candidate-object-list (context)
|
||||
"Return CONTEXT's touched objects."
|
||||
"Return CONTEXT's touched and retained candidate objects."
|
||||
(let (objects)
|
||||
(maphash (lambda (object _present) (push object objects))
|
||||
(tp--context-touched context))
|
||||
(maphash
|
||||
(lambda (_path object)
|
||||
(when (or (gethash object (tp--context-touched context))
|
||||
(gethash object (tp--context-retained context)))
|
||||
(push object objects)))
|
||||
(tp--context-objects context))
|
||||
objects))
|
||||
|
||||
(defun tp--content-mount-spec (object record &optional tags)
|
||||
"Return one content mount spec for OBJECT over RECORD with TAGS."
|
||||
(defun tp--candidate-reconciled-count (context created)
|
||||
"Return the number of touched retained objects in CONTEXT excluding CREATED."
|
||||
(- (hash-table-count (tp--context-touched context))
|
||||
(length created)))
|
||||
|
||||
(defun tp--content-mount-spec (object record &optional tags tags-owned-p)
|
||||
"Return one content mount spec for OBJECT over RECORD with TAGS.
|
||||
TAGS-OWNED-P skips a second snapshot when TAGS already belongs to the candidate."
|
||||
(list :object object :start (plist-get record :start)
|
||||
:end (plist-get record :end)
|
||||
:tags (tp--copy-property-value
|
||||
(if tags tags (plist-get record :tags)))))
|
||||
:tags (if tags-owned-p
|
||||
tags
|
||||
(tp--copy-property-value
|
||||
(if tags tags (plist-get record :tags))))))
|
||||
|
||||
(defun tp--content-mount-specs (records context)
|
||||
"Return direct and logical-fragment mount specs for RECORDS in CONTEXT."
|
||||
"Return direct and logical range mount specs for RECORDS in CONTEXT."
|
||||
(let (specs)
|
||||
(dolist (record records)
|
||||
(let* ((fragment (plist-get record :object))
|
||||
(attachments
|
||||
(let* ((leaf (plist-get record :object))
|
||||
(fragment-attachments
|
||||
(nreverse
|
||||
(copy-sequence
|
||||
(gethash fragment
|
||||
(tp--context-fragment-attachments context))))))
|
||||
(push (tp--content-mount-spec fragment record) specs)
|
||||
(dolist (attachment attachments)
|
||||
(gethash leaf
|
||||
(tp--context-fragment-attachments context)))))
|
||||
(range-attachments
|
||||
(nreverse
|
||||
(copy-sequence
|
||||
(gethash leaf
|
||||
(tp--context-content-range-attachments context))))))
|
||||
(push (tp--content-mount-spec leaf record) specs)
|
||||
(dolist (attachment fragment-attachments)
|
||||
(push (tp--content-mount-spec
|
||||
(car attachment) record (cdr attachment))
|
||||
specs))))
|
||||
(car attachment) record (cdr attachment) t)
|
||||
specs))
|
||||
(when range-attachments
|
||||
(unless (plist-get record :leaf)
|
||||
(signal 'tp-invalid-content-range
|
||||
(list :leaf leaf :reason 'not-a-text-leaf)))
|
||||
(let ((leaf-start (plist-get record :start))
|
||||
(leaf-length (- (plist-get record :end)
|
||||
(plist-get record :start))))
|
||||
(dolist (attachment range-attachments)
|
||||
(let ((start (plist-get attachment :start))
|
||||
(end (plist-get attachment :end)))
|
||||
(unless (and (<= end leaf-length)
|
||||
(<= start end))
|
||||
(signal 'tp-invalid-content-range
|
||||
(list :start start :end end
|
||||
:leaf-length leaf-length)))
|
||||
(push (list :object (plist-get attachment :object)
|
||||
:start (+ leaf-start start)
|
||||
:end (+ leaf-start end)
|
||||
:tags (plist-get attachment :tags))
|
||||
specs)))))))
|
||||
(nreverse specs)))
|
||||
|
||||
(defun tp--plan-record-mount-specs (records capability context)
|
||||
@ -610,8 +899,8 @@ marker-backed mounts after publication."
|
||||
(dolist (other tp--buffer-surfaces)
|
||||
(unless (eq other surface)
|
||||
(dolist (mount (tp--surface-mounts other))
|
||||
(let ((start (marker-position (tp--surface-mount-start mount)))
|
||||
(end (marker-position (tp--surface-mount-end mount))))
|
||||
(let ((start (tp--mount-position (tp--surface-mount-start mount)))
|
||||
(end (tp--mount-position (tp--surface-mount-end mount))))
|
||||
(when (cl-some (lambda (range)
|
||||
(tp--ranges-overlap-p
|
||||
(car range) (cdr range) start end))
|
||||
@ -626,10 +915,13 @@ marker-backed mounts after publication."
|
||||
(tp--binding-touch-function
|
||||
(lambda (binding) (tp--touch-context-binding context binding))))
|
||||
(if (functionp input)
|
||||
(tp--producer-result (funcall input context) surface options)
|
||||
(tp--producer-result (funcall input context) surface options context)
|
||||
(let ((plan (tp--copy-surface-plan input)))
|
||||
(tp--ensure-plan-objects context plan)
|
||||
(tp--producer-result plan surface options)))))
|
||||
(list plan
|
||||
(if (plist-member options :client-state)
|
||||
(plist-get options :client-state)
|
||||
(tp--surface-client-state surface)))))))
|
||||
|
||||
(defun tp--call-with-prepare-buffer-guard (surface function)
|
||||
"Call FUNCTION while rejecting producer edits to SURFACE's buffer."
|
||||
@ -677,6 +969,21 @@ marker-backed mounts after publication."
|
||||
(setcdr (car merged) (max (cdar merged) (cdr range)))
|
||||
(push range merged)))))
|
||||
|
||||
(defun tp--subtract-ranges (ranges exclusions)
|
||||
"Return RANGES with EXCLUSIONS removed.
|
||||
Both arguments contain numeric half-open relative intervals."
|
||||
(let (result)
|
||||
(dolist (range ranges (nreverse result))
|
||||
(let ((cursor (car range))
|
||||
(end (cdr range)))
|
||||
(dolist (exclusion exclusions)
|
||||
(when (and (< cursor end) (> (cdr exclusion) cursor))
|
||||
(when (< cursor (car exclusion))
|
||||
(push (cons cursor (min end (car exclusion))) result))
|
||||
(setq cursor (max cursor (cdr exclusion)))))
|
||||
(when (< cursor end)
|
||||
(push (cons cursor end) result))))))
|
||||
|
||||
(defun tp--live-scope-ranges (surface objects &optional relative)
|
||||
"Return live mount ranges for OBJECTS on SURFACE.
|
||||
When RELATIVE is non-nil, return offsets from the surface start."
|
||||
@ -686,8 +993,8 @@ When RELATIVE is non-nil, return offsets from the surface start."
|
||||
ranges)
|
||||
(dolist (object objects)
|
||||
(dolist (mount (gethash object (tp--surface-mount-index surface)))
|
||||
(let ((start (marker-position (tp--surface-mount-start mount)))
|
||||
(end (marker-position (tp--surface-mount-end mount))))
|
||||
(let ((start (tp--mount-position (tp--surface-mount-start mount)))
|
||||
(end (tp--mount-position (tp--surface-mount-end mount))))
|
||||
(unless (and start end)
|
||||
(signal 'tp-stale-mount (list object)))
|
||||
(push (cons (- start base) (- end base)) ranges))))
|
||||
@ -849,12 +1156,13 @@ OPTIONS configure the mount and INITIAL is non-nil for first publication."
|
||||
surface
|
||||
(lambda ()
|
||||
(tp--prepare-input surface input options context))))
|
||||
(plan (car normalized))
|
||||
(client-state (cdr normalized))
|
||||
(plan (nth 0 normalized))
|
||||
(client-state (nth 1 normalized))
|
||||
(owned-p (nth 2 normalized))
|
||||
(_capability (tp--validate-plan-capability
|
||||
plan (tp--surface-capability surface)))
|
||||
(_tree (tp--validate-context-tree context plan))
|
||||
(render-result (tp--render-plan plan context))
|
||||
(render-result (tp--render-plan plan context owned-p))
|
||||
(rendered (car render-result))
|
||||
(records (cdr render-result))
|
||||
(objects (tp--candidate-object-list context))
|
||||
@ -885,7 +1193,7 @@ OPTIONS configure the mount and INITIAL is non-nil for first publication."
|
||||
:client-state client-state :producer input :initial initial
|
||||
:created created :removed removed
|
||||
:moved (tp--plan-moved-count (tp--surface-plan surface) plan)
|
||||
:reconciled (- (length objects) (length created))
|
||||
:reconciled (tp--candidate-reconciled-count context created)
|
||||
:scope-objects scope-objects
|
||||
:scope-patches (plist-get scope-analysis :patches)
|
||||
:scope-fallback (plist-get scope-analysis :fallback)))
|
||||
@ -1241,7 +1549,11 @@ MOUNT-SPECS and SURFACE provide ranges for PROPERTIES."
|
||||
(defun tp-surface-mount (buffer plan-or-producer &optional options)
|
||||
"Mount PLAN-OR-PRODUCER into BUFFER according to OPTIONS.
|
||||
OPTIONS accepts :capability (`content' or `properties'), :start, :end,
|
||||
:inhibit-read-only, :client-state, and :observers. Return a surface handle."
|
||||
:inhibit-read-only, :coordinate-mounts, :client-state, and :observers. When
|
||||
:coordinate-mounts is non-nil, content mounts store numeric coordinates rather
|
||||
than private markers; use it only when host edits make the whole content
|
||||
surface stale and all writes are published through TP. Return a surface
|
||||
handle."
|
||||
(let* ((target (get-buffer buffer))
|
||||
(_live (unless (buffer-live-p target)
|
||||
(signal 'tp-unsupported-buffer (list buffer))))
|
||||
@ -1274,11 +1586,17 @@ PLAN-OR-PRODUCER has the same full candidate contract as
|
||||
`tp-surface-update'. TP resolves OBJECTS through its mount index and rejects
|
||||
any candidate output change outside their ranges before publication.
|
||||
|
||||
OPTIONS accepts `:on-mismatch'. Its default, `error', signals
|
||||
`tp-scope-mismatch'; `root' permits an explicit full-surface fallback."
|
||||
OPTIONS accepts `:on-mismatch' and `:return-report'. Its default mismatch
|
||||
policy, `error', signals `tp-scope-mismatch'; `root' permits an explicit
|
||||
full-surface fallback. The report is returned as a defensive snapshot by
|
||||
default; `:return-report nil' avoids materializing that snapshot when the
|
||||
caller reads the scalar summary from the surface instead."
|
||||
(tp--validate-live-surface surface)
|
||||
(setq objects (tp--normalize-surface-scopes surface objects))
|
||||
(let ((on-mismatch (or (plist-get options :on-mismatch) 'error)))
|
||||
(let ((on-mismatch (or (plist-get options :on-mismatch) 'error))
|
||||
(return-report (if (plist-member options :return-report)
|
||||
(plist-get options :return-report)
|
||||
t)))
|
||||
(unless (memq on-mismatch '(error root))
|
||||
(signal 'wrong-type-argument
|
||||
(list '(member error root) on-mismatch)))
|
||||
@ -1287,8 +1605,9 @@ OPTIONS accepts `:on-mismatch'. Its default, `error', signals
|
||||
(tp--install-surface-producer
|
||||
surface plan-or-producer (tp--surface-options surface) nil)
|
||||
(tp--set-surface-scope-request
|
||||
surface objects (list :on-mismatch on-mismatch)))))
|
||||
(tp-surface-report surface))
|
||||
surface objects (list :on-mismatch on-mismatch))))
|
||||
(when return-report
|
||||
(tp-surface-report surface))))
|
||||
|
||||
(defun tp--edit-touches-span-p (beg edit-end start end)
|
||||
"Return non-nil when BEG..EDIT-END touches the old START..END span."
|
||||
@ -1433,8 +1752,8 @@ OPTIONS accepts `:on-mismatch'. Its default, `error', signals
|
||||
(mapcar (lambda (mount)
|
||||
(list (tp--surface-mount-object mount)
|
||||
(tp--surface-mount-anchor mount)
|
||||
(- (marker-position (tp--surface-mount-start mount)) base)
|
||||
(- (marker-position (tp--surface-mount-end mount)) base)
|
||||
(- (tp--mount-position (tp--surface-mount-start mount)) base)
|
||||
(- (tp--mount-position (tp--surface-mount-end mount)) base)
|
||||
(tp--surface-mount-tags mount)))
|
||||
(tp--surface-mounts surface))))
|
||||
|
||||
@ -1500,6 +1819,23 @@ OPTIONS accepts `:on-mismatch'. Its default, `error', signals
|
||||
(setq count (1+ count)))
|
||||
count))
|
||||
|
||||
(defun tp--validate-published-content-range (buffer start rendered)
|
||||
"Validate inserted BUFFER text from START with RENDERED.
|
||||
Return whether the properties match.
|
||||
An external `after-change-functions' hook may alter the inserted properties;
|
||||
return nil for that recoverable case so TP reapplies the rendered runs. A
|
||||
character rewrite is not recoverable at the property layer and signals before
|
||||
the transaction can commit."
|
||||
(with-current-buffer buffer
|
||||
(let ((end (+ start (length rendered))))
|
||||
(unless (and (<= (point-min) start) (<= end (point-max))
|
||||
(equal (buffer-substring-no-properties start end)
|
||||
(substring-no-properties rendered)))
|
||||
(signal 'tp-publication-mismatch
|
||||
(list :buffer buffer :start start :end end)))
|
||||
(equal-including-properties
|
||||
(buffer-substring start end) rendered))))
|
||||
|
||||
(defun tp--content-text-operation (surface rendered)
|
||||
"Publish SURFACE's minimal character replacement for RENDERED."
|
||||
(pcase-let* ((`(,start . ,end) (tp--surface-range surface))
|
||||
@ -1510,18 +1846,30 @@ OPTIONS accepts `:on-mismatch'. Its default, `error', signals
|
||||
(unless (equal old new)
|
||||
(delete-region (+ start prefix) (- end suffix))
|
||||
(goto-char (+ start prefix))
|
||||
(insert (substring new prefix (- (length new) suffix))))
|
||||
(let ((inserted (substring rendered prefix (- (length rendered) suffix))))
|
||||
(insert inserted)
|
||||
(when (tp--validate-published-content-range
|
||||
(tp--surface-buffer surface) (+ start prefix) inserted)
|
||||
(push (cons prefix (- (length new) suffix))
|
||||
tp--content-published-ranges))))
|
||||
(set-marker (tp--surface-start surface) start)
|
||||
(set-marker (tp--surface-end surface) (+ start (length new)))
|
||||
(if (equal old new) 0 1)))
|
||||
|
||||
(defun tp--string-property-run-diff-p (buffer start rendered from to)
|
||||
"Return non-nil when BUFFER at START differs from RENDERED on FROM..TO."
|
||||
(cl-loop for offset from from below to
|
||||
thereis
|
||||
(not (tp--plan-props-equal-p
|
||||
(text-properties-at (+ start offset) buffer)
|
||||
(text-properties-at offset rendered)))))
|
||||
"Return non-nil when BUFFER at START differs from RENDERED on FROM..TO.
|
||||
The rendered interval is already one direct-property run. Compare its
|
||||
boundary value once and reject an interior buffer boundary; scanning every
|
||||
character makes a large rendered surface quadratic in its number of runs."
|
||||
(let* ((buffer-start (+ start from))
|
||||
(buffer-end (+ start to))
|
||||
(buffer-next (or (next-property-change
|
||||
buffer-start buffer buffer-end)
|
||||
buffer-end)))
|
||||
(or (not (tp--plan-props-equal-p
|
||||
(text-properties-at buffer-start buffer)
|
||||
(text-properties-at from rendered)))
|
||||
(< buffer-next buffer-end))))
|
||||
|
||||
(defun tp--content-property-operations-in-range
|
||||
(buffer start rendered from to)
|
||||
@ -1545,6 +1893,11 @@ When SCOPED is non-nil, inspect only RANGES, including an empty set."
|
||||
(let* ((buffer (tp--surface-buffer surface))
|
||||
(start (marker-position (tp--surface-start surface)))
|
||||
(ranges (if scoped ranges (list (cons 0 (length rendered)))))
|
||||
(ranges
|
||||
(if tp--content-published-ranges
|
||||
(tp--subtract-ranges
|
||||
ranges (tp--coalesce-ranges tp--content-published-ranges))
|
||||
ranges))
|
||||
operations)
|
||||
(dolist (range ranges operations)
|
||||
(setq operations
|
||||
@ -1580,18 +1933,24 @@ When SCOPED is non-nil, inspect only RANGES, including an empty set."
|
||||
(tp--apply-property-operation buffer operation))))))
|
||||
|
||||
(defun tp--make-content-mounts (prepared)
|
||||
"Create marker-backed content mounts for PREPARED."
|
||||
"Create content mounts for PREPARED using its declared coordinate policy."
|
||||
(let* ((surface (tp--prepared-surface-surface prepared))
|
||||
(buffer (tp--surface-buffer surface))
|
||||
(base (marker-position (tp--surface-start surface))))
|
||||
(base (marker-position (tp--surface-start surface)))
|
||||
(coordinate-p (plist-get (tp--surface-options surface)
|
||||
:coordinate-mounts)))
|
||||
(mapcar
|
||||
(lambda (spec)
|
||||
(tp--make-surface-mount
|
||||
:object (plist-get spec :object)
|
||||
:start (with-current-buffer buffer
|
||||
(copy-marker (+ base (plist-get spec :start)) nil))
|
||||
:end (with-current-buffer buffer
|
||||
(copy-marker (+ base (plist-get spec :end)) t))
|
||||
:start (if coordinate-p
|
||||
(+ base (plist-get spec :start))
|
||||
(with-current-buffer buffer
|
||||
(copy-marker (+ base (plist-get spec :start)) nil)))
|
||||
:end (if coordinate-p
|
||||
(+ base (plist-get spec :end))
|
||||
(with-current-buffer buffer
|
||||
(copy-marker (+ base (plist-get spec :end)) t)))
|
||||
:tags (plist-get spec :tags) :capability 'content))
|
||||
(tp--prepared-surface-mount-specs prepared))))
|
||||
|
||||
@ -1718,11 +2077,22 @@ Return the number of text operations."
|
||||
(let* ((start (+ base (plist-get patch :old-start)))
|
||||
(end (+ base (plist-get patch :old-end)))
|
||||
(replacement (plist-get patch :replacement))
|
||||
(plain (substring-no-properties replacement)))
|
||||
(unless (equal (buffer-substring-no-properties start end) plain)
|
||||
(delete-region start end)
|
||||
(goto-char start)
|
||||
(insert plain)
|
||||
(old-plain (buffer-substring-no-properties start end))
|
||||
(new-plain (substring-no-properties replacement))
|
||||
(prefix (tp--common-prefix-length old-plain new-plain))
|
||||
(suffix (tp--common-suffix-length old-plain new-plain prefix))
|
||||
(old-end (- end suffix))
|
||||
(new-end (- (length replacement) suffix)))
|
||||
(unless (equal old-plain new-plain)
|
||||
(delete-region (+ start prefix) old-end)
|
||||
(goto-char (+ start prefix))
|
||||
(let ((inserted (substring replacement prefix new-end)))
|
||||
(insert inserted)
|
||||
(when (tp--validate-published-content-range
|
||||
(tp--surface-buffer surface) (+ start prefix) inserted)
|
||||
(push (cons (+ (plist-get patch :new-start) prefix)
|
||||
(+ (plist-get patch :new-start) new-end))
|
||||
tp--content-published-ranges)))
|
||||
(cl-incf count))))
|
||||
(set-marker (tp--surface-start surface) base)
|
||||
(set-marker (tp--surface-end surface) (+ base (length rendered)))
|
||||
@ -1738,6 +2108,7 @@ Return the number of text operations."
|
||||
(patches (tp--prepared-surface-scope-patches prepared))
|
||||
(text-operations 0)
|
||||
property-operations)
|
||||
(let (tp--content-published-ranges)
|
||||
(with-current-buffer buffer
|
||||
(save-restriction
|
||||
(widen)
|
||||
@ -1757,7 +2128,7 @@ Return the number of text operations."
|
||||
(and scoped (not fallback))))
|
||||
(tp--apply-content-property-operations buffer property-operations)
|
||||
(tp--publication-step 'property surface))))
|
||||
(cons text-operations (length property-operations))))
|
||||
(cons text-operations (length property-operations)))))
|
||||
|
||||
(defun tp--publish-buffer-properties (prepared)
|
||||
"Publish PREPARED's host-range property operations."
|
||||
@ -2052,7 +2423,9 @@ Return the number of text operations."
|
||||
(defun tp--cancel-change-group-safely (group)
|
||||
"Cancel active change GROUP without allowing quit to interrupt rollback."
|
||||
(when group
|
||||
(let ((inhibit-quit t))
|
||||
(let ((inhibit-quit t)
|
||||
(inhibit-modification-hooks t)
|
||||
(tp--surface-publishing t))
|
||||
(condition-case nil
|
||||
(cancel-change-group group)
|
||||
(error nil)))))
|
||||
@ -2148,10 +2521,11 @@ Return the number of text operations."
|
||||
|
||||
(defun tp--enqueue-surface-observers (surface)
|
||||
"Schedule SURFACE observers outside the publishing transaction."
|
||||
(let ((observers (copy-sequence (tp--surface-observers surface)))
|
||||
(when-let ((observers (tp--surface-observers surface)))
|
||||
(let ((observers (copy-sequence observers))
|
||||
(report (tp-surface-report surface)))
|
||||
(tp--enqueue-after-commit
|
||||
(lambda () (tp--run-surface-observers surface observers report)))))
|
||||
(lambda () (tp--run-surface-observers surface observers report))))))
|
||||
|
||||
(defun tp--surface-commit-transaction ()
|
||||
"Commit buffer edits and finalize every transaction surface."
|
||||
@ -2189,10 +2563,11 @@ Return the number of text operations."
|
||||
(unwind-protect
|
||||
(let* ((normalized
|
||||
(tp--prepare-input surface plan-or-producer nil context))
|
||||
(plan (car normalized)))
|
||||
(plan (car normalized))
|
||||
(owned-p (nth 2 normalized)))
|
||||
(tp--validate-plan-capability plan 'content)
|
||||
(tp--validate-context-tree context plan)
|
||||
(setq rendered (car (tp--render-plan plan context))
|
||||
(setq rendered (car (tp--render-plan plan context owned-p))
|
||||
success t)
|
||||
rendered)
|
||||
(setf (tp--context-active context) t)
|
||||
@ -2387,8 +2762,8 @@ owns the property; conflicting host values are preserved and reported."
|
||||
(let ((point (or position (point))))
|
||||
(dolist (surface tp--buffer-surfaces)
|
||||
(dolist (mount (tp--surface-index surface))
|
||||
(let ((start (marker-position (tp--surface-mount-start mount)))
|
||||
(end (marker-position (tp--surface-mount-end mount))))
|
||||
(let ((start (tp--mount-position (tp--surface-mount-start mount)))
|
||||
(end (tp--mount-position (tp--surface-mount-end mount))))
|
||||
(when (and start end (<= start point) (< point end))
|
||||
(cl-pushnew (tp--surface-mount-object mount) objects
|
||||
:test #'eq)))))))
|
||||
@ -2403,6 +2778,26 @@ owns the property; conflicting host values are preserved and reported."
|
||||
(signal 'wrong-type-argument (list 'tp-surface-p surface)))
|
||||
(tp--copy-property-value (tp--surface-report surface)))
|
||||
|
||||
(defun tp-surface-report-summary (surface)
|
||||
"Return scalar commit metrics for SURFACE without copying its full report.
|
||||
The returned plist contains only numbers, symbols, booleans, or nil. Use
|
||||
`tp-surface-report' when callers need arbitrary report payloads or a defensive
|
||||
snapshot of nested values."
|
||||
(unless (tp-surface-p surface)
|
||||
(signal 'wrong-type-argument (list 'tp-surface-p surface)))
|
||||
(let ((report (tp--surface-report surface)))
|
||||
(list :transaction-id (plist-get report :transaction-id)
|
||||
:text-operations (plist-get report :text-operations)
|
||||
:property-operations (plist-get report :property-operations)
|
||||
:full-root (plist-get report :full-root)
|
||||
:scope-count (plist-get report :scope-count)
|
||||
:scope-range-count (plist-get report :scope-range-count)
|
||||
:scope-fallback (plist-get report :scope-fallback)
|
||||
:reconciled-objects (plist-get report :reconciled-objects)
|
||||
:created-objects (plist-get report :created-objects)
|
||||
:removed-objects (plist-get report :removed-objects)
|
||||
:moved-objects (plist-get report :moved-objects))))
|
||||
|
||||
(defun tp-surface-inspect (surface)
|
||||
"Return read-only retained diagnostics for SURFACE."
|
||||
(tp--validate-live-surface surface)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user