Compare commits
No commits in common. "main" and "perf-scroll-baseline-2026-08-27" have entirely different histories.
main
...
perf-scrol
13
README.en.md
13
README.en.md
@ -13,15 +13,12 @@ This repository is a new lowercase `ecss` project. It neither modifies nor depen
|
|||||||
```elisp
|
```elisp
|
||||||
(require 'ecss)
|
(require 'ecss)
|
||||||
|
|
||||||
(let* ((package
|
(let ((schemas (ecss-schema-set-create))
|
||||||
(ecss-schema-package-create
|
|
||||||
'demo
|
|
||||||
'((:id demo/color :initial "black" :inherits t
|
|
||||||
:validator stringp :aliases (:color) :impacts (paint)))))
|
|
||||||
(schemas (ecss-schema-set-compose package))
|
|
||||||
(sheet (ecss-stylesheet-create))
|
(sheet (ecss-stylesheet-create))
|
||||||
(button (ecss-subject-create
|
(button (ecss-subject-create
|
||||||
:type "button" :classes '("primary"))))
|
:type "button" :classes '("primary"))))
|
||||||
|
(ecss-schema-set-define
|
||||||
|
schemas 'demo/color :initial "black" :inherits t :validator #'stringp)
|
||||||
(ecss-stylesheet-add-rule
|
(ecss-stylesheet-add-rule
|
||||||
sheet schemas "button.primary" '(demo/color "royalblue"))
|
sheet schemas "button.primary" '(demo/color "royalblue"))
|
||||||
(ecss-computed-style-value
|
(ecss-computed-style-value
|
||||||
@ -33,9 +30,9 @@ This repository is a new lowercase `ecss` project. It neither modifies nor depen
|
|||||||
## Core boundary
|
## Core boundary
|
||||||
|
|
||||||
- `ecss-selector.el` owns the selector AST, parser, matcher, specificity, and generic subject adapter.
|
- `ecss-selector.el` owns the selector AST, parser, matcher, specificity, and generic subject adapter.
|
||||||
- `ecss-cascade.el` owns immutable package schemas, surface schema sets, stylesheets, complete winner ordering, inheritance, variable resolution, and provenance.
|
- `ecss-cascade.el` owns explicit schema sets, stylesheets, complete winner ordering, inheritance, variable resolution, and provenance.
|
||||||
- `ecss.el` is the public package facade and has no behavioral load side effects.
|
- `ecss.el` is the public package facade and has no behavioral load side effects.
|
||||||
- Package schemas and composed schema sets are immutable. Stylesheets change only through explicit authoring APIs. `ecss-compute-style` mutates neither its inputs nor the current buffer.
|
- Schema sets and stylesheets change only through explicit authoring APIs. `ecss-compute-style` mutates neither its inputs nor the current buffer.
|
||||||
- An ordinary function value always remains a value. ECSS calls code only through an explicitly supplied `:value-resolver`; ECSS itself knows nothing about TP bindings, Ebox nodes, or consumer-specific value-source types.
|
- An ordinary function value always remains a value. ECSS calls code only through an explicitly supplied `:value-resolver`; ECSS itself knows nothing about TP bindings, Ebox nodes, or consumer-specific value-source types.
|
||||||
|
|
||||||
See [Architecture](docs/architecture.en.md) and [API Reference](docs/api.en.md) for the complete contract.
|
See [Architecture](docs/architecture.en.md) and [API Reference](docs/api.en.md) for the complete contract.
|
||||||
|
|||||||
13
README.md
13
README.md
@ -13,15 +13,12 @@
|
|||||||
```elisp
|
```elisp
|
||||||
(require 'ecss)
|
(require 'ecss)
|
||||||
|
|
||||||
(let* ((package
|
(let ((schemas (ecss-schema-set-create))
|
||||||
(ecss-schema-package-create
|
|
||||||
'demo
|
|
||||||
'((:id demo/color :initial "black" :inherits t
|
|
||||||
:validator stringp :aliases (:color) :impacts (paint)))))
|
|
||||||
(schemas (ecss-schema-set-compose package))
|
|
||||||
(sheet (ecss-stylesheet-create))
|
(sheet (ecss-stylesheet-create))
|
||||||
(button (ecss-subject-create
|
(button (ecss-subject-create
|
||||||
:type "button" :classes '("primary"))))
|
:type "button" :classes '("primary"))))
|
||||||
|
(ecss-schema-set-define
|
||||||
|
schemas 'demo/color :initial "black" :inherits t :validator #'stringp)
|
||||||
(ecss-stylesheet-add-rule
|
(ecss-stylesheet-add-rule
|
||||||
sheet schemas "button.primary" '(demo/color "royalblue"))
|
sheet schemas "button.primary" '(demo/color "royalblue"))
|
||||||
(ecss-computed-style-value
|
(ecss-computed-style-value
|
||||||
@ -33,9 +30,9 @@
|
|||||||
## 核心边界
|
## 核心边界
|
||||||
|
|
||||||
- `ecss-selector.el`:selector AST/parser/matcher/specificity 与通用 subject adapter。
|
- `ecss-selector.el`:selector AST/parser/matcher/specificity 与通用 subject adapter。
|
||||||
- `ecss-cascade.el`:不可变 package schema、surface schema set、stylesheet、完整 winner 顺序、继承、变量解析和 provenance。
|
- `ecss-cascade.el`:显式 schema set、stylesheet、完整 winner 顺序、继承、变量解析和 provenance。
|
||||||
- `ecss.el`:公开 package facade;加载时没有行为副作用。
|
- `ecss.el`:公开 package facade;加载时没有行为副作用。
|
||||||
- package schema 与组合后的 schema set 不可变;stylesheet 只由显式 authoring API 修改;`ecss-compute-style` 不修改输入对象或当前 Buffer。
|
- schema set 和 stylesheet 只在显式 authoring API 中修改;`ecss-compute-style` 不修改输入对象或当前 Buffer。
|
||||||
- 普通 function value 永远是普通值。只有调用者显式传入 `:value-resolver` 时,ECSS 才调用该 resolver;ECSS 自己不认识 TP binding、Ebox node 或任何业务 value-source 类型。
|
- 普通 function value 永远是普通值。只有调用者显式传入 `:value-resolver` 时,ECSS 才调用该 resolver;ECSS 自己不认识 TP binding、Ebox node 或任何业务 value-source 类型。
|
||||||
|
|
||||||
详细设计见 [架构](docs/architecture.zh.md) 与 [API 参考](docs/api.zh.md)。
|
详细设计见 [架构](docs/architecture.zh.md) 与 [API 参考](docs/api.zh.md)。
|
||||||
|
|||||||
@ -4,19 +4,14 @@
|
|||||||
|
|
||||||
## Schemas
|
## Schemas
|
||||||
|
|
||||||
- `(ecss-schema-package-create PACKAGE-ID DEFINITIONS)` validates and snapshots one package's property definitions.
|
- `(ecss-schema-set-create)` creates an isolated registry.
|
||||||
- `(ecss-schema-package-id PACKAGE)` and `(ecss-schema-package-property-ids PACKAGE)` return detached identity/index data.
|
- `(ecss-schema-set-define SCHEMAS ID &rest OPTIONS)` atomically registers a namespaced property. OPTIONS are `:initial`, `:inherits`, `:normalizer`, `:validator`, `:equality`, and `:shorthand`.
|
||||||
- `(ecss-schema-set-compose &rest PACKAGES)` atomically composes one surface's immutable schema set. A package, canonical, or alias collision rejects the whole composition.
|
- `(ecss-schema-set-property SCHEMAS ID)` returns a defensive schema copy.
|
||||||
- `(ecss-schema-set-package-ids SCHEMAS)` and `(ecss-schema-set-property-ids SCHEMAS)` return stable composition order.
|
- `(ecss-schema-set-property-ids SCHEMAS)` returns stable registration order.
|
||||||
- `(ecss-schema-set-canonical-id SCHEMAS NAME)` resolves an exact alias to its canonical ID.
|
|
||||||
- `(ecss-schema-set-property SCHEMAS ID)` returns a defensive schema copy for a canonical ID or exact alias.
|
|
||||||
- `(ecss-schema-set-property-metadata SCHEMAS ID)` returns detached metadata.
|
|
||||||
- `(ecss-expand-declarations SCHEMAS DECLARATIONS)` validates properties and expands each shorthand once.
|
- `(ecss-expand-declarations SCHEMAS DECLARATIONS)` validates properties and expands each shorthand once.
|
||||||
- `(ecss-merge-declarations SCHEMAS &rest DECLARATION-GROUPS)` expands and merges groups from left to right. Later groups replace the same longhand, while explicit nil remains a declaration.
|
- `(ecss-merge-declarations SCHEMAS &rest DECLARATION-GROUPS)` expands and merges groups from left to right. Later groups replace the same longhand, while explicit nil remains a declaration.
|
||||||
|
|
||||||
Each definition is a plist containing `:id`, a nonempty `:impacts`, and optional `:initial`, `:inherits`, `:normalizer`, `:validator`, `:equality`, `:shorthand`, `:aliases`, `:projections`, and `:metadata`. A property ID is a symbol containing `/`, such as `demo/color`. Aliases exist only at declaration normalization. Canonical/alias, duplicate-alias, and shorthand/owned-longhand conflicts in one declaration are errors rather than implicit last-wins; later declaration groups still replace earlier groups.
|
A property ID is a symbol containing `/`, such as `demo/color`. Custom properties need no schema and use `--name` symbols. `initial` is normalized and validated once at schema registration; already computed initial and inherited values do not run the normalizer again.
|
||||||
|
|
||||||
Custom properties need no schema and use `--name` symbols. `initial` is normalized and validated once when the package is created; already computed initial and inherited values do not run the normalizer again. Packages and composed schema sets expose no mutator.
|
|
||||||
|
|
||||||
## Subjects and selectors
|
## Subjects and selectors
|
||||||
|
|
||||||
@ -54,13 +49,11 @@ Do not pass both `:stylesheet` and `:rules`. `:rules` accepts the rule list retu
|
|||||||
- `(ecss-computed-style-custom-properties STYLE)` returns a deterministic custom-property plist.
|
- `(ecss-computed-style-custom-properties STYLE)` returns a deterministic custom-property plist.
|
||||||
- `(ecss-computed-style-active-properties STYLE)` returns property IDs supplied by valid declarations or active inheritance, preserving explicit nil versus absence. An invalid winner falling back to the initial value is not presented as an active declaration.
|
- `(ecss-computed-style-active-properties STYLE)` returns property IDs supplied by valid declarations or active inheritance, preserving explicit nil versus absence. An invalid winner falling back to the initial value is not presented as an active declaration.
|
||||||
- `(ecss-computed-style-specified-properties STYLE)` returns longhand property IDs that have cascade winners, independent of whether provenance was requested.
|
- `(ecss-computed-style-specified-properties STYLE)` returns longhand property IDs that have cascade winners, independent of whether provenance was requested.
|
||||||
- `(ecss-computed-style-precedence-winner STYLE PROPERTIES)` returns the property ID whose already-selected declaration winner has the highest cascade precedence. It never reruns cascade or requires public provenance.
|
|
||||||
- `(ecss-computed-style-copy-with-values STYLE VALUES &key active-properties specified-properties)` returns an immutable-style copy for a consumer that has already proved selector/cascade facts unchanged and only needs to replace computed values.
|
- `(ecss-computed-style-copy-with-values STYLE VALUES &key active-properties specified-properties)` returns an immutable-style copy for a consumer that has already proved selector/cascade facts unchanged and only needs to replace computed values.
|
||||||
- `(ecss-computed-style-provenance STYLE)` returns winner, origin, importance, layer, specificity, scope/source/declaration order, validity, and fallback facts.
|
- `(ecss-computed-style-provenance STYLE)` returns winner, origin, importance, layer, specificity, scope/source/declaration order, validity, and fallback facts.
|
||||||
- `(ecss-computed-style-diagnostics STYLE)` returns deterministic diagnostics such as custom-property cycles.
|
- `(ecss-computed-style-diagnostics STYLE)` returns deterministic diagnostics such as custom-property cycles.
|
||||||
- `(ecss-computed-style-value STYLE PROPERTY &optional FALLBACK)` reads one detached value; PROPERTY may be canonical or an exact alias.
|
- `(ecss-computed-style-value STYLE PROPERTY &optional FALLBACK)` reads one value.
|
||||||
- `(ecss-computed-style-property-fact STYLE PROPERTY)` returns one detached typed fact containing the canonical property, computed value, owner, impact set, projections, winner provenance, and metadata. The same fact can be routed to multiple impact consumers without normalizing its value again.
|
|
||||||
- `(ecss-computed-style-present-p STYLE PROPERTY)` detects an active property even when its value is nil.
|
- `(ecss-computed-style-present-p STYLE PROPERTY)` detects an active property even when its value is nil.
|
||||||
- `(ecss-computed-style-specified-p STYLE PROPERTY)` detects whether a longhand property has a cascade winner.
|
- `(ecss-computed-style-specified-p STYLE PROPERTY)` detects whether a longhand property has a cascade winner.
|
||||||
|
|
||||||
No public schema or computed getter exposes a mutable registry or computed-style object. Mutating a returned value cannot change a computed style, schema set, or stylesheet.
|
Every aggregate getter returns a defensive copy. Mutating a returned value cannot change a computed style, schema set, or stylesheet.
|
||||||
|
|||||||
@ -4,19 +4,14 @@
|
|||||||
|
|
||||||
## Schema
|
## Schema
|
||||||
|
|
||||||
- `(ecss-schema-package-create PACKAGE-ID DEFINITIONS)` 一次校验并快照一个 package 的属性定义。
|
- `(ecss-schema-set-create)` 创建隔离 registry。
|
||||||
- `(ecss-schema-package-id PACKAGE)` 与 `(ecss-schema-package-property-ids PACKAGE)` 返回 detached identity/index 信息。
|
- `(ecss-schema-set-define SCHEMAS ID &rest OPTIONS)` 原子注册 namespaced property。OPTIONS 是 `:initial`、`:inherits`、`:normalizer`、`:validator`、`:equality`、`:shorthand`。
|
||||||
- `(ecss-schema-set-compose &rest PACKAGES)` 原子组合一个 surface 的不可变 schema set;package、canonical 与 alias 冲突都会使整次组合失败。
|
- `(ecss-schema-set-property SCHEMAS ID)` 返回 defensive schema copy。
|
||||||
- `(ecss-schema-set-package-ids SCHEMAS)` 与 `(ecss-schema-set-property-ids SCHEMAS)` 返回稳定组合顺序。
|
- `(ecss-schema-set-property-ids SCHEMAS)` 返回稳定注册顺序。
|
||||||
- `(ecss-schema-set-canonical-id SCHEMAS NAME)` 把 exact alias 解析为 canonical ID。
|
|
||||||
- `(ecss-schema-set-property SCHEMAS ID)` 返回 defensive schema copy;`ID` 可以是 canonical 或 exact alias。
|
|
||||||
- `(ecss-schema-set-property-metadata SCHEMAS ID)` 返回 detached metadata。
|
|
||||||
- `(ecss-expand-declarations SCHEMAS DECLARATIONS)` 校验属性并只展开一次 shorthand。
|
- `(ecss-expand-declarations SCHEMAS DECLARATIONS)` 校验属性并只展开一次 shorthand。
|
||||||
- `(ecss-merge-declarations SCHEMAS &rest DECLARATION-GROUPS)` 按从左到右的优先级展开并合并多组声明;后组覆盖相同 longhand,显式 nil 不会被当作缺省。
|
- `(ecss-merge-declarations SCHEMAS &rest DECLARATION-GROUPS)` 按从左到右的优先级展开并合并多组声明;后组覆盖相同 longhand,显式 nil 不会被当作缺省。
|
||||||
|
|
||||||
每个 definition 是包含 `:id`、非空 `:impacts`,以及可选 `:initial`、`:inherits`、`:normalizer`、`:validator`、`:equality`、`:shorthand`、`:aliases`、`:projections`、`:metadata` 的 plist。Property ID 必须是包含 `/` 的 symbol,例如 `demo/color`。Alias 只存在于声明归一化入口;同一声明中 canonical/alias、重复 alias 或 shorthand/owned-longhand 冲突会报错,不采用隐式 last-wins。不同 declaration group 仍由后组覆盖前组。
|
Property ID 必须是包含 `/` 的 symbol,例如 `demo/color`。Custom property 不需要 schema,使用 `--name` symbol。`initial` 在 schema 注册时规范化并校验一次;已计算的 initial/inherited value 不会再次执行 normalizer。
|
||||||
|
|
||||||
Custom property 不需要 schema,使用 `--name` symbol。`initial` 在 package 创建时规范化并校验一次;已计算的 initial/inherited value 不会再次执行 normalizer。Package 与组合后的 schema set 没有公共 mutator。
|
|
||||||
|
|
||||||
## Subject 与 selector
|
## Subject 与 selector
|
||||||
|
|
||||||
@ -54,13 +49,11 @@ ORIGIN 是 `ua`、`user`、`author`、`animation` 或 `transition`。Inline decl
|
|||||||
- `(ecss-computed-style-custom-properties STYLE)` 返回 deterministic custom-property plist。
|
- `(ecss-computed-style-custom-properties STYLE)` 返回 deterministic custom-property plist。
|
||||||
- `(ecss-computed-style-active-properties STYLE)` 返回由有效 declaration 或 active inheritance 实际提供的 property ids,保留 explicit nil 与 absence 的区别;invalid winner 回退到 initial 时不伪装成 active declaration。
|
- `(ecss-computed-style-active-properties STYLE)` 返回由有效 declaration 或 active inheritance 实际提供的 property ids,保留 explicit nil 与 absence 的区别;invalid winner 回退到 initial 时不伪装成 active declaration。
|
||||||
- `(ecss-computed-style-specified-properties STYLE)` 返回存在 cascade winner 的长手 property ids,独立于是否请求 provenance。
|
- `(ecss-computed-style-specified-properties STYLE)` 返回存在 cascade winner 的长手 property ids,独立于是否请求 provenance。
|
||||||
- `(ecss-computed-style-precedence-winner STYLE PROPERTIES)` 返回这些 canonical property 已选 winner 中 cascade 优先级最高的 property ID;不会重跑 cascade,也不要求公开 provenance。
|
|
||||||
- `(ecss-computed-style-copy-with-values STYLE VALUES &key active-properties specified-properties)` 在 selector/cascade 事实已证明不变、只需替换 computed values 时返回新的 immutable-style copy。
|
- `(ecss-computed-style-copy-with-values STYLE VALUES &key active-properties specified-properties)` 在 selector/cascade 事实已证明不变、只需替换 computed values 时返回新的 immutable-style copy。
|
||||||
- `(ecss-computed-style-provenance STYLE)` 返回 winner、origin、important、layer、specificity、scope/source/declaration order、valid/fallback 等事实。
|
- `(ecss-computed-style-provenance STYLE)` 返回 winner、origin、important、layer、specificity、scope/source/declaration order、valid/fallback 等事实。
|
||||||
- `(ecss-computed-style-diagnostics STYLE)` 返回 custom-property cycle 等 deterministic diagnostics。
|
- `(ecss-computed-style-diagnostics STYLE)` 返回 custom-property cycle 等 deterministic diagnostics。
|
||||||
- `(ecss-computed-style-value STYLE PROPERTY &optional FALLBACK)` 读取 detached 单值;PROPERTY 可以是 canonical 或 exact alias。
|
- `(ecss-computed-style-value STYLE PROPERTY &optional FALLBACK)` 读取单值。
|
||||||
- `(ecss-computed-style-property-fact STYLE PROPERTY)` 返回一个 detached typed fact,包含 canonical property、computed value、owner、impact set、projections、winner provenance 与 metadata。同一个 fact 可同时交给多个 impact consumer,不重新规范化其 value。
|
|
||||||
- `(ecss-computed-style-present-p STYLE PROPERTY)` 判断 property 是否 active,即使值为 nil。
|
- `(ecss-computed-style-present-p STYLE PROPERTY)` 判断 property 是否 active,即使值为 nil。
|
||||||
- `(ecss-computed-style-specified-p STYLE PROPERTY)` 判断长手 property 是否存在 cascade winner。
|
- `(ecss-computed-style-specified-p STYLE PROPERTY)` 判断长手 property 是否存在 cascade winner。
|
||||||
|
|
||||||
所有公共 schema/computed getter 都不会暴露 registry 或 computed style 的可变内部对象。调用者修改返回值不会改变 computed style、schema set 或 stylesheet。
|
所有 aggregate getter 都返回 defensive copy。调用者修改返回值不会改变 computed style、schema set 或 stylesheet。
|
||||||
|
|||||||
@ -21,13 +21,9 @@ consumer schemas + subject adapter + stylesheet + parent style
|
|||||||
|
|
||||||
`ecss` does not know how computed values are displayed. TP may convert final text-property contributions into retained surface patches. Ebox may interpret final Box/Flex/Grid properties as measurement, layout, and painting consequences. Ordinary callers may use `ecss` without either package.
|
`ecss` does not know how computed values are displayed. TP may convert final text-property contributions into retained surface patches. Ebox may interpret final Box/Flex/Grid properties as measurement, layout, and painting consequences. Ordinary callers may use `ecss` without either package.
|
||||||
|
|
||||||
## Package schemas and explicit surfaces
|
## Explicit objects instead of process-global state
|
||||||
|
|
||||||
Each owning package creates one immutable `ecss-schema-package`. A concrete surface then atomically composes the required packages with `ecss-schema-set-compose`. Composition rejects duplicate packages and canonical/canonical, canonical/alias, and alias/alias collisions. There is no process-global mutable registry and no last-wins registration, so applications can compose different property vocabularies in one Emacs process without interference.
|
Each consumer creates its own `ecss-schema-set` and `ecss-stylesheet`. Two applications can use the same selector tokens, different property vocabularies, and different layer orders in one Emacs process without interference. UA, user, and author origins inside one stylesheet also keep independent layer orders. Schema registration and rule addition are explicit atomic authoring operations. Failure cannot leave a partial schema, a half-added layer, or an incorrect source order.
|
||||||
|
|
||||||
Aliases exist only at declaration normalization and disappear before cascade. An alias/canonical duplicate or a shorthand/owned-longhand conflict inside one declaration fails immediately. The schema set retains owner, impact, and projection facts, and a computed style references that set instead of building a second computed tree. Packages and schema sets expose no mutator; public queries return detached data.
|
|
||||||
|
|
||||||
Stylesheets remain explicitly owned mutable authoring objects. UA, user, and author origins inside one stylesheet keep independent layer orders. Rule addition is atomic, so failure cannot leave a half-added layer or an incorrect source order.
|
|
||||||
|
|
||||||
## Subjects and adapters
|
## Subjects and adapters
|
||||||
|
|
||||||
|
|||||||
@ -21,13 +21,9 @@ consumer schemas + subject adapter + stylesheet + parent style
|
|||||||
|
|
||||||
`ecss` 不知道 computed values 最终如何显示。TP 可以把最终文本属性贡献转换成 retained surface patch;Ebox 可以把最终 Box/Flex/Grid 属性解释成 measurement、layout 与 painting 后果;普通调用者也可以完全不用 TP/Ebox。
|
`ecss` 不知道 computed values 最终如何显示。TP 可以把最终文本属性贡献转换成 retained surface patch;Ebox 可以把最终 Box/Flex/Grid 属性解释成 measurement、layout 与 painting 后果;普通调用者也可以完全不用 TP/Ebox。
|
||||||
|
|
||||||
## Package schema 与显式 surface
|
## 显式对象而不是进程全局状态
|
||||||
|
|
||||||
每个 owning package 一次创建不可变 `ecss-schema-package`;具体 surface 再用 `ecss-schema-set-compose` 原子组合所需 package。组合阶段统一拒绝重复 package、canonical/canonical、canonical/alias 与 alias/alias 冲突,不存在进程全局 mutable registry 或 last-wins 注册。两个应用因此可以在同一 Emacs 中组合不同 property vocabulary 而互不污染。
|
每个 consumer 创建自己的 `ecss-schema-set` 与 `ecss-stylesheet`。两个应用可以在同一 Emacs 中使用同名 selector token、不同 property vocabulary 和不同 layer 顺序而互不污染;同一 stylesheet 中的 UA、user 与 author origin 也分别维护自己的 layer order。schema 注册与 rule 添加是显式、原子的 authoring 操作;一次失败不会留下半注册 schema、半添加 layer 或错误 source order。
|
||||||
|
|
||||||
Alias 只属于声明归一化入口,进入 cascade 前消失;同一声明中 alias/canonical 重复或 shorthand 与其输出 longhand 冲突会立即失败。Schema set 同时保存 owner、impact 与 projection facts,computed style 直接引用该 set,不建立第二棵 computed tree。Package/schema set 不提供 mutator,公共查询返回 detached 数据。
|
|
||||||
|
|
||||||
Stylesheet 仍是每个调用者显式拥有的可变 authoring 对象。同一 stylesheet 中的 UA、user 与 author origin 分别维护 layer order;rule 添加是原子的,一次失败不会留下半添加 layer 或错误 source order。
|
|
||||||
|
|
||||||
## Subject 与 adapter
|
## Subject 与 adapter
|
||||||
|
|
||||||
|
|||||||
360
ecss-cascade.el
360
ecss-cascade.el
@ -25,20 +25,13 @@
|
|||||||
(cl-defstruct (ecss-property-schema
|
(cl-defstruct (ecss-property-schema
|
||||||
(:constructor ecss--make-property-schema))
|
(:constructor ecss--make-property-schema))
|
||||||
"Schema governing one namespaced cascade property."
|
"Schema governing one namespaced cascade property."
|
||||||
id owner initial inherits normalizer validator equality shorthand
|
id initial inherits normalizer validator equality shorthand)
|
||||||
aliases impacts projections metadata)
|
|
||||||
|
|
||||||
(cl-defstruct (ecss-schema-package
|
|
||||||
(:constructor ecss--make-schema-package)
|
|
||||||
(:conc-name ecss--schema-package-))
|
|
||||||
"Immutable property schema registry owned by one package."
|
|
||||||
id table order)
|
|
||||||
|
|
||||||
(cl-defstruct (ecss-schema-set
|
(cl-defstruct (ecss-schema-set
|
||||||
(:constructor ecss--make-schema-set)
|
(:constructor ecss--make-schema-set)
|
||||||
(:conc-name ecss--schema-set-))
|
(:conc-name ecss--schema-set-))
|
||||||
"Immutable composition of package-owned property schemas."
|
"Explicit registry of consumer-owned property schemas."
|
||||||
package-ids table aliases order)
|
table order)
|
||||||
|
|
||||||
(cl-defstruct (ecss-stylesheet
|
(cl-defstruct (ecss-stylesheet
|
||||||
(:constructor ecss--make-stylesheet)
|
(:constructor ecss--make-stylesheet)
|
||||||
@ -54,19 +47,8 @@
|
|||||||
(:constructor ecss--make-computed-style)
|
(:constructor ecss--make-computed-style)
|
||||||
(:conc-name ecss--computed-style-))
|
(:conc-name ecss--computed-style-))
|
||||||
"Computed declarations, custom properties, metadata, and diagnostics."
|
"Computed declarations, custom properties, metadata, and diagnostics."
|
||||||
schemas values custom-properties active-properties specified-properties
|
values custom-properties active-properties specified-properties
|
||||||
winners provenance diagnostics)
|
provenance diagnostics)
|
||||||
|
|
||||||
(cl-defstruct (ecss-computed-property-fact
|
|
||||||
(:constructor ecss--make-computed-property-fact))
|
|
||||||
"One detached typed value with its package-owned schema facts."
|
|
||||||
(property nil :read-only t)
|
|
||||||
(value nil :read-only t)
|
|
||||||
(owner nil :read-only t)
|
|
||||||
(impacts nil :read-only t)
|
|
||||||
(projections nil :read-only t)
|
|
||||||
(provenance nil :read-only t)
|
|
||||||
(metadata nil :read-only t))
|
|
||||||
|
|
||||||
(cl-defstruct (ecss--wide (:constructor ecss--make-wide)) kind)
|
(cl-defstruct (ecss--wide (:constructor ecss--make-wide)) kind)
|
||||||
(cl-defstruct (ecss--important (:constructor ecss--make-important)) value)
|
(cl-defstruct (ecss--important (:constructor ecss--make-important)) value)
|
||||||
@ -78,9 +60,8 @@
|
|||||||
scope-distance source-order declaration-order selector)
|
scope-distance source-order declaration-order selector)
|
||||||
|
|
||||||
(defconst ecss--schema-option-keys
|
(defconst ecss--schema-option-keys
|
||||||
'(:id :initial :inherits :normalizer :validator :equality :shorthand
|
'(:initial :inherits :normalizer :validator :equality :shorthand)
|
||||||
:aliases :impacts :projections :metadata)
|
"Accepted property schema option keys.")
|
||||||
"Accepted keys in one package property definition.")
|
|
||||||
|
|
||||||
(defconst ecss--origins '(ua user author animation transition)
|
(defconst ecss--origins '(ua user author animation transition)
|
||||||
"Supported standard CSS cascade origins.")
|
"Supported standard CSS cascade origins.")
|
||||||
@ -91,6 +72,10 @@
|
|||||||
(defconst ecss--invalid (make-symbol "ecss-invalid-value"))
|
(defconst ecss--invalid (make-symbol "ecss-invalid-value"))
|
||||||
(defconst ecss--absent (make-symbol "ecss-absent-value"))
|
(defconst ecss--absent (make-symbol "ecss-absent-value"))
|
||||||
|
|
||||||
|
(defun ecss-schema-set-create ()
|
||||||
|
"Create an empty independent property schema set."
|
||||||
|
(ecss--make-schema-set :table (make-hash-table :test #'eq) :order nil))
|
||||||
|
|
||||||
(defun ecss--schema-set-check (schemas)
|
(defun ecss--schema-set-check (schemas)
|
||||||
"Return SCHEMAS or signal when it is not a schema set."
|
"Return SCHEMAS or signal when it is not a schema set."
|
||||||
(unless (ecss-schema-set-p schemas)
|
(unless (ecss-schema-set-p schemas)
|
||||||
@ -117,27 +102,6 @@
|
|||||||
(cl-loop for key in options by #'cddr
|
(cl-loop for key in options by #'cddr
|
||||||
always (memq key ecss--schema-option-keys))))
|
always (memq key ecss--schema-option-keys))))
|
||||||
|
|
||||||
(defun ecss--plist-unique-keys-p (plist)
|
|
||||||
"Return non-nil when PLIST contains each key once."
|
|
||||||
(let (seen valid)
|
|
||||||
(setq valid t)
|
|
||||||
(while (and plist valid)
|
|
||||||
(let ((key (pop plist)))
|
|
||||||
(pop plist)
|
|
||||||
(setq valid (not (memq key seen)))
|
|
||||||
(push key seen)))
|
|
||||||
valid))
|
|
||||||
|
|
||||||
(defun ecss--unique-symbol-list-p (value &optional nonempty)
|
|
||||||
"Return non-nil when VALUE is a unique symbol list.
|
|
||||||
When NONEMPTY is non-nil, reject an empty list."
|
|
||||||
(and (proper-list-p value)
|
|
||||||
(or (not nonempty) value)
|
|
||||||
(cl-every (lambda (item)
|
|
||||||
(and (symbolp item) item))
|
|
||||||
value)
|
|
||||||
(= (length value) (length (delete-dups (copy-sequence value))))))
|
|
||||||
|
|
||||||
(defun ecss--schema-option (options key fallback)
|
(defun ecss--schema-option (options key fallback)
|
||||||
"Return KEY from OPTIONS when present, otherwise FALLBACK."
|
"Return KEY from OPTIONS when present, otherwise FALLBACK."
|
||||||
(if (plist-member options key) (plist-get options key) fallback))
|
(if (plist-member options key) (plist-get options key) fallback))
|
||||||
@ -158,177 +122,66 @@ When NONEMPTY is non-nil, reject an empty list."
|
|||||||
(list :invalid-initial initial)))
|
(list :invalid-initial initial)))
|
||||||
(ecss--copy-boundary-data normalized)))
|
(ecss--copy-boundary-data normalized)))
|
||||||
|
|
||||||
(defun ecss--build-property-schema (owner definition)
|
(defun ecss--build-property-schema (id options)
|
||||||
"Build a validated property schema owned by OWNER from DEFINITION."
|
"Build a validated property schema for ID from OPTIONS."
|
||||||
(let ((id (plist-get definition :id)))
|
|
||||||
(unless (and (ecss--canonical-property-id-p id)
|
(unless (and (ecss--canonical-property-id-p id)
|
||||||
(ecss--options-valid-p definition)
|
(ecss--options-valid-p options))
|
||||||
(ecss--plist-unique-keys-p definition)
|
(signal 'ecss-invalid-property-schema (list :property id options)))
|
||||||
(ecss--unique-symbol-list-p
|
(ecss--validate-schema-functions options)
|
||||||
(or (plist-get definition :aliases) nil))
|
(let* ((normalizer (ecss--schema-option options :normalizer #'identity))
|
||||||
(ecss--unique-symbol-list-p
|
(validator (ecss--schema-option
|
||||||
(plist-get definition :impacts) t)
|
options :validator (lambda (_value) t)))
|
||||||
(ecss--unique-symbol-list-p
|
|
||||||
(or (plist-get definition :projections) nil)))
|
|
||||||
(signal 'ecss-invalid-property-schema
|
|
||||||
(list :property id definition)))
|
|
||||||
(ecss--validate-schema-functions definition)
|
|
||||||
(let* ((normalizer
|
|
||||||
(ecss--schema-option definition :normalizer #'identity))
|
|
||||||
(validator
|
|
||||||
(ecss--schema-option
|
|
||||||
definition :validator (lambda (_value) t)))
|
|
||||||
(initial (ecss--normalize-schema-initial
|
(initial (ecss--normalize-schema-initial
|
||||||
(plist-get definition :initial) normalizer validator)))
|
(plist-get options :initial) normalizer validator)))
|
||||||
(ecss--make-property-schema
|
(ecss--make-property-schema
|
||||||
:id id :owner owner :initial initial
|
:id id :initial initial
|
||||||
:inherits (and (plist-get definition :inherits) t)
|
:inherits (and (plist-get options :inherits) t)
|
||||||
:normalizer normalizer :validator validator
|
:normalizer normalizer :validator validator
|
||||||
:equality (ecss--schema-option definition :equality #'equal)
|
:equality (ecss--schema-option options :equality #'equal)
|
||||||
:shorthand (plist-get definition :shorthand)
|
:shorthand (plist-get options :shorthand))))
|
||||||
:aliases (ecss--copy-boundary-data (plist-get definition :aliases))
|
|
||||||
:impacts (ecss--copy-boundary-data (plist-get definition :impacts))
|
|
||||||
:projections (ecss--copy-boundary-data
|
|
||||||
(plist-get definition :projections))
|
|
||||||
:metadata (ecss--copy-boundary-data
|
|
||||||
(plist-get definition :metadata))))))
|
|
||||||
|
|
||||||
(defun ecss--composition-collision (name kind existing-kind)
|
|
||||||
"Signal NAME collision between KIND and EXISTING-KIND."
|
|
||||||
(signal 'ecss-invalid-property-schema
|
|
||||||
(list :collision name kind existing-kind)))
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun ecss-schema-package-create (package-id definitions)
|
(defun ecss-schema-set-define (schemas id &rest options)
|
||||||
"Create immutable PACKAGE-ID schema registry from DEFINITIONS."
|
"Atomically define property ID with OPTIONS in SCHEMAS."
|
||||||
(unless (and (symbolp package-id) package-id (not (keywordp package-id)))
|
(ecss--schema-set-check schemas)
|
||||||
(signal 'ecss-invalid-property-schema
|
(let* ((schema (ecss--build-property-schema id options))
|
||||||
(list :package-id package-id)))
|
(table (ecss--schema-set-table schemas)))
|
||||||
(unless (proper-list-p definitions)
|
(unless (gethash id table)
|
||||||
(signal 'ecss-invalid-property-schema
|
(setf (ecss--schema-set-order schemas)
|
||||||
(list :definitions definitions)))
|
(append (ecss--schema-set-order schemas) (list id))))
|
||||||
(let ((table (make-hash-table :test #'eq))
|
|
||||||
(aliases (make-hash-table :test #'eq))
|
|
||||||
order)
|
|
||||||
(dolist (definition definitions)
|
|
||||||
(unless (proper-list-p definition)
|
|
||||||
(signal 'ecss-invalid-property-schema
|
|
||||||
(list :definition definition)))
|
|
||||||
(let* ((schema (ecss--build-property-schema package-id definition))
|
|
||||||
(id (ecss-property-schema-id schema)))
|
|
||||||
(when (gethash id table)
|
|
||||||
(signal 'ecss-invalid-property-schema
|
|
||||||
(list :duplicate-property id)))
|
|
||||||
(when (gethash id aliases)
|
|
||||||
(ecss--composition-collision id 'canonical 'alias))
|
|
||||||
(puthash id schema table)
|
(puthash id schema table)
|
||||||
(push id order)
|
(ecss--copy-property-schema schema)))
|
||||||
(dolist (alias (ecss-property-schema-aliases schema))
|
|
||||||
(when (gethash alias table)
|
|
||||||
(ecss--composition-collision alias 'alias 'canonical))
|
|
||||||
(when (gethash alias aliases)
|
|
||||||
(ecss--composition-collision alias 'alias 'alias))
|
|
||||||
(puthash alias id aliases))))
|
|
||||||
(ecss--make-schema-package
|
|
||||||
:id package-id :table table :order (nreverse order))))
|
|
||||||
|
|
||||||
(defun ecss-schema-package-id (package)
|
|
||||||
"Return immutable PACKAGE identity."
|
|
||||||
(unless (ecss-schema-package-p package)
|
|
||||||
(signal 'wrong-type-argument (list 'ecss-schema-package-p package)))
|
|
||||||
(ecss--schema-package-id package))
|
|
||||||
|
|
||||||
(defun ecss-schema-package-property-ids (package)
|
|
||||||
"Return canonical property identifiers owned by PACKAGE."
|
|
||||||
(unless (ecss-schema-package-p package)
|
|
||||||
(signal 'wrong-type-argument (list 'ecss-schema-package-p package)))
|
|
||||||
(copy-sequence (ecss--schema-package-order package)))
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defun ecss-schema-set-compose (&rest packages)
|
|
||||||
"Compose immutable PACKAGES into one atomic schema set."
|
|
||||||
(let ((package-ids nil)
|
|
||||||
(table (make-hash-table :test #'eq))
|
|
||||||
(aliases (make-hash-table :test #'eq))
|
|
||||||
order)
|
|
||||||
(dolist (package packages)
|
|
||||||
(unless (ecss-schema-package-p package)
|
|
||||||
(signal 'wrong-type-argument (list 'ecss-schema-package-p package)))
|
|
||||||
(let ((package-id (ecss--schema-package-id package)))
|
|
||||||
(when (memq package-id package-ids)
|
|
||||||
(signal 'ecss-invalid-property-schema
|
|
||||||
(list :duplicate-package package-id)))
|
|
||||||
(push package-id package-ids))
|
|
||||||
(dolist (id (ecss--schema-package-order package))
|
|
||||||
(when (gethash id table)
|
|
||||||
(ecss--composition-collision id 'canonical 'canonical))
|
|
||||||
(when (gethash id aliases)
|
|
||||||
(ecss--composition-collision id 'canonical 'alias))
|
|
||||||
(let ((schema (gethash id (ecss--schema-package-table package))))
|
|
||||||
(puthash id schema table)
|
|
||||||
(push id order)
|
|
||||||
(dolist (alias (ecss-property-schema-aliases schema))
|
|
||||||
(when (gethash alias table)
|
|
||||||
(ecss--composition-collision alias 'alias 'canonical))
|
|
||||||
(when (gethash alias aliases)
|
|
||||||
(ecss--composition-collision alias 'alias 'alias))
|
|
||||||
(puthash alias id aliases)))))
|
|
||||||
(ecss--make-schema-set
|
|
||||||
:package-ids (nreverse package-ids) :table table :aliases aliases
|
|
||||||
:order (nreverse order))))
|
|
||||||
|
|
||||||
(defun ecss--copy-property-schema (schema)
|
(defun ecss--copy-property-schema (schema)
|
||||||
"Return a defensive copy of SCHEMA."
|
"Return a defensive copy of SCHEMA."
|
||||||
(let ((copy (copy-ecss-property-schema schema)))
|
(let ((copy (copy-ecss-property-schema schema)))
|
||||||
(setf (ecss-property-schema-initial copy)
|
(setf (ecss-property-schema-initial copy)
|
||||||
(ecss--copy-boundary-data
|
(ecss--copy-boundary-data
|
||||||
(ecss-property-schema-initial schema))
|
(ecss-property-schema-initial schema)))
|
||||||
(ecss-property-schema-aliases copy)
|
|
||||||
(ecss--copy-boundary-data (ecss-property-schema-aliases schema))
|
|
||||||
(ecss-property-schema-impacts copy)
|
|
||||||
(ecss--copy-boundary-data (ecss-property-schema-impacts schema))
|
|
||||||
(ecss-property-schema-projections copy)
|
|
||||||
(ecss--copy-boundary-data (ecss-property-schema-projections schema))
|
|
||||||
(ecss-property-schema-metadata copy)
|
|
||||||
(ecss--copy-boundary-data (ecss-property-schema-metadata schema)))
|
|
||||||
copy))
|
copy))
|
||||||
|
|
||||||
(defun ecss-schema-set-package-ids (schemas)
|
|
||||||
"Return package identities composed into SCHEMAS."
|
|
||||||
(ecss--schema-set-check schemas)
|
|
||||||
(copy-sequence (ecss--schema-set-package-ids schemas)))
|
|
||||||
|
|
||||||
(defun ecss-schema-set-canonical-id (schemas name)
|
|
||||||
"Return canonical property identifier for NAME in SCHEMAS, or nil."
|
|
||||||
(ecss--schema-set-check schemas)
|
|
||||||
(cond ((gethash name (ecss--schema-set-table schemas)) name)
|
|
||||||
((gethash name (ecss--schema-set-aliases schemas)))))
|
|
||||||
|
|
||||||
(defun ecss-schema-set-property (schemas id)
|
(defun ecss-schema-set-property (schemas id)
|
||||||
"Return a defensive property schema copy for ID or alias in SCHEMAS."
|
"Return a defensive copy of property ID from SCHEMAS, or nil."
|
||||||
(ecss--schema-set-check schemas)
|
(ecss--schema-set-check schemas)
|
||||||
(when-let* ((canonical (ecss-schema-set-canonical-id schemas id))
|
(when-let* ((schema (gethash id (ecss--schema-set-table schemas))))
|
||||||
(schema (gethash canonical (ecss--schema-set-table schemas))))
|
|
||||||
(ecss--copy-property-schema schema)))
|
(ecss--copy-property-schema schema)))
|
||||||
|
|
||||||
(defun ecss-schema-set-property-ids (schemas)
|
(defun ecss-schema-set-property-ids (schemas)
|
||||||
"Return property identifiers from SCHEMAS in registration order."
|
"Return property identifiers from SCHEMAS in registration order."
|
||||||
(ecss--schema-set-check schemas)
|
(ecss--schema-set-check schemas)
|
||||||
(copy-sequence (ecss--schema-set-order schemas)))
|
(ecss--copy-boundary-data (ecss--schema-set-order schemas)))
|
||||||
|
|
||||||
(defun ecss-schema-set-property-metadata (schemas id)
|
(defun ecss-schema-set-clear (schemas)
|
||||||
"Return detached property metadata for ID in SCHEMAS."
|
"Remove every property schema from SCHEMAS."
|
||||||
(ecss--schema-set-check schemas)
|
(ecss--schema-set-check schemas)
|
||||||
(when-let* ((canonical (ecss-schema-set-canonical-id schemas id))
|
(clrhash (ecss--schema-set-table schemas))
|
||||||
(schema (gethash canonical (ecss--schema-set-table schemas))))
|
(setf (ecss--schema-set-order schemas) nil)
|
||||||
(ecss--copy-boundary-data (ecss-property-schema-metadata schema))))
|
schemas)
|
||||||
|
|
||||||
(defun ecss-property-equal-p (schemas property left right)
|
(defun ecss-property-equal-p (schemas property left right)
|
||||||
"Return whether PROPERTY values LEFT and RIGHT are equal in SCHEMAS."
|
"Return whether PROPERTY values LEFT and RIGHT are equal in SCHEMAS."
|
||||||
(ecss--schema-set-check schemas)
|
(ecss--schema-set-check schemas)
|
||||||
(let* ((canonical (ecss-schema-set-canonical-id schemas property))
|
(let ((schema (gethash property (ecss--schema-set-table schemas))))
|
||||||
(schema (and canonical
|
|
||||||
(gethash canonical (ecss--schema-set-table schemas)))))
|
|
||||||
(unless schema
|
(unless schema
|
||||||
(signal 'ecss-invalid-declaration (list :unknown-property property)))
|
(signal 'ecss-invalid-declaration (list :unknown-property property)))
|
||||||
(funcall (ecss-property-schema-equality schema) left right)))
|
(funcall (ecss-property-schema-equality schema) left right)))
|
||||||
@ -362,8 +215,7 @@ When NONEMPTY is non-nil, reject an empty list."
|
|||||||
|
|
||||||
(defun ecss--schema-for (schemas property)
|
(defun ecss--schema-for (schemas property)
|
||||||
"Return PROPERTY schema from SCHEMAS, or nil."
|
"Return PROPERTY schema from SCHEMAS, or nil."
|
||||||
(when-let* ((canonical (ecss-schema-set-canonical-id schemas property)))
|
(gethash property (ecss--schema-set-table schemas)))
|
||||||
(gethash canonical (ecss--schema-set-table schemas))))
|
|
||||||
|
|
||||||
(defun ecss--validate-declaration-property (schemas property)
|
(defun ecss--validate-declaration-property (schemas property)
|
||||||
"Return PROPERTY when it is valid for SCHEMAS."
|
"Return PROPERTY when it is valid for SCHEMAS."
|
||||||
@ -401,9 +253,7 @@ When NONEMPTY is non-nil, reject an empty list."
|
|||||||
(defun ecss--expand-declaration (schemas property value)
|
(defun ecss--expand-declaration (schemas property value)
|
||||||
"Expand one PROPERTY VALUE declaration using SCHEMAS."
|
"Expand one PROPERTY VALUE declaration using SCHEMAS."
|
||||||
(ecss--validate-declaration-property schemas property)
|
(ecss--validate-declaration-property schemas property)
|
||||||
(let* ((canonical (or (ecss-schema-set-canonical-id schemas property)
|
(let ((schema (ecss--schema-for schemas property)))
|
||||||
property))
|
|
||||||
(schema (ecss--schema-for schemas canonical)))
|
|
||||||
(if-let* ((expander (and schema
|
(if-let* ((expander (and schema
|
||||||
(ecss-property-schema-shorthand schema))))
|
(ecss-property-schema-shorthand schema))))
|
||||||
(pcase-let* ((`(,raw . ,important) (ecss--unwrap-important value))
|
(pcase-let* ((`(,raw . ,important) (ecss--unwrap-important value))
|
||||||
@ -411,15 +261,9 @@ When NONEMPTY is non-nil, reject an empty list."
|
|||||||
(ecss--copy-boundary-data
|
(ecss--copy-boundary-data
|
||||||
(funcall expander
|
(funcall expander
|
||||||
(ecss--copy-boundary-data raw)))))
|
(ecss--copy-boundary-data raw)))))
|
||||||
(ecss--validate-expanded-longhands schemas canonical expanded)
|
(ecss--validate-expanded-longhands schemas property expanded)
|
||||||
(ecss--tag-important
|
(ecss--tag-important expanded important))
|
||||||
(cl-loop for (longhand longhand-value) on expanded by #'cddr
|
(list property (ecss--copy-boundary-data value)))))
|
||||||
append
|
|
||||||
(list (or (ecss-schema-set-canonical-id schemas longhand)
|
|
||||||
longhand)
|
|
||||||
longhand-value))
|
|
||||||
important))
|
|
||||||
(list canonical (ecss--copy-boundary-data value)))))
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun ecss-expand-declarations (schemas declarations)
|
(defun ecss-expand-declarations (schemas declarations)
|
||||||
@ -427,25 +271,8 @@ When NONEMPTY is non-nil, reject an empty list."
|
|||||||
(ecss--schema-set-check schemas)
|
(ecss--schema-set-check schemas)
|
||||||
(unless (ecss--declaration-list-p declarations)
|
(unless (ecss--declaration-list-p declarations)
|
||||||
(signal 'ecss-invalid-declaration (list :declarations declarations)))
|
(signal 'ecss-invalid-declaration (list :declarations declarations)))
|
||||||
(let ((seen (make-hash-table :test #'eq)) result)
|
(cl-loop for (property value) on declarations by #'cddr
|
||||||
(cl-loop
|
append (ecss--expand-declaration schemas property value)))
|
||||||
for (source-property source-value) on declarations by #'cddr
|
|
||||||
for expanded = (ecss--expand-declaration
|
|
||||||
schemas source-property source-value)
|
|
||||||
do
|
|
||||||
(cl-loop
|
|
||||||
for (property value) on expanded by #'cddr
|
|
||||||
for previous = (gethash property seen)
|
|
||||||
do
|
|
||||||
(when previous
|
|
||||||
(signal 'ecss-invalid-declaration
|
|
||||||
(list :duplicate-property property
|
|
||||||
:first-source previous
|
|
||||||
:second-source source-property)))
|
|
||||||
(puthash property source-property seen)
|
|
||||||
(push property result)
|
|
||||||
(push value result)))
|
|
||||||
(nreverse result)))
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun ecss-merge-declarations (schemas &rest declaration-groups)
|
(defun ecss-merge-declarations (schemas &rest declaration-groups)
|
||||||
@ -1061,9 +888,9 @@ handle explicit sources, and DIAGNOSTICS records variable failures."
|
|||||||
PARENT-STYLE and CUSTOM-TABLES supply inherited values. SUBJECT and RESOLVER
|
PARENT-STYLE and CUSTOM-TABLES supply inherited values. SUBJECT and RESOLVER
|
||||||
handle explicit sources. DIAGNOSTICS records failures; PROVENANCE-P retains
|
handle explicit sources. DIAGNOSTICS records failures; PROVENANCE-P retains
|
||||||
facts."
|
facts."
|
||||||
(let (values active specified winners provenance)
|
(let (values active specified provenance)
|
||||||
(dolist (property (ecss--schema-set-order schemas))
|
(dolist (property (ecss--schema-set-order schemas))
|
||||||
(let ((schema (gethash property (ecss--schema-set-table schemas))))
|
(let ((schema (ecss--schema-for schemas property)))
|
||||||
(unless (ecss-property-schema-shorthand schema)
|
(unless (ecss-property-schema-shorthand schema)
|
||||||
(pcase-let ((`(,value ,winner ,invalid ,source)
|
(pcase-let ((`(,value ,winner ,invalid ,source)
|
||||||
(ecss--resolve-property-candidates
|
(ecss--resolve-property-candidates
|
||||||
@ -1076,15 +903,13 @@ facts."
|
|||||||
(ecss--parent-property-active-p parent-style property)))
|
(ecss--parent-property-active-p parent-style property)))
|
||||||
(push property active))
|
(push property active))
|
||||||
(when winner
|
(when winner
|
||||||
(push property specified)
|
(push property specified))
|
||||||
(unless invalid
|
|
||||||
(setq winners (plist-put winners property winner))))
|
|
||||||
(when provenance-p
|
(when provenance-p
|
||||||
(setq provenance
|
(setq provenance
|
||||||
(plist-put provenance property
|
(plist-put provenance property
|
||||||
(ecss--property-provenance
|
(ecss--property-provenance
|
||||||
winner invalid source))))))))
|
winner invalid source))))))))
|
||||||
(list values (nreverse active) (nreverse specified) winners provenance)))
|
(list values (nreverse active) (nreverse specified) provenance)))
|
||||||
|
|
||||||
(defun ecss--validate-rule-declarations (schemas rule)
|
(defun ecss--validate-rule-declarations (schemas rule)
|
||||||
"Validate canonical declarations in RULE against SCHEMAS."
|
"Validate canonical declarations in RULE against SCHEMAS."
|
||||||
@ -1145,15 +970,13 @@ non-nil, is the only function allowed to evaluate caller-owned value sources;
|
|||||||
(custom (ecss--resolved-custom-properties
|
(custom (ecss--resolved-custom-properties
|
||||||
(car raw-facts) diagnostics)))
|
(car raw-facts) diagnostics)))
|
||||||
(let ((custom-tables (ecss--custom-value-tables custom)))
|
(let ((custom-tables (ecss--custom-value-tables custom)))
|
||||||
(pcase-let ((`(,values ,active ,specified ,winners ,property-facts)
|
(pcase-let ((`(,values ,active ,specified ,property-facts)
|
||||||
(ecss--compute-property-values
|
(ecss--compute-property-values
|
||||||
schemas table parent-style custom-tables subject value-resolver
|
schemas table parent-style custom-tables subject value-resolver
|
||||||
diagnostics provenance)))
|
diagnostics provenance)))
|
||||||
(ecss--make-computed-style
|
(ecss--make-computed-style
|
||||||
:schemas schemas :values values :custom-properties custom
|
:values values :custom-properties custom :active-properties active
|
||||||
:active-properties active
|
|
||||||
:specified-properties specified
|
:specified-properties specified
|
||||||
:winners winners
|
|
||||||
:provenance (and provenance
|
:provenance (and provenance
|
||||||
(append (cadr raw-facts) property-facts))
|
(append (cadr raw-facts) property-facts))
|
||||||
:diagnostics (nreverse (car diagnostics))))))))
|
:diagnostics (nreverse (car diagnostics))))))))
|
||||||
@ -1210,27 +1033,6 @@ the public boundary."
|
|||||||
(ecss--copy-boundary-data
|
(ecss--copy-boundary-data
|
||||||
(ecss--computed-style-specified-properties style)))
|
(ecss--computed-style-specified-properties style)))
|
||||||
|
|
||||||
(defun ecss-computed-style-precedence-winner (style properties)
|
|
||||||
"Return the highest-precedence declared property in PROPERTIES for STYLE.
|
|
||||||
PROPERTIES may use canonical IDs or aliases from STYLE's schema set. Nil is
|
|
||||||
returned when none has a cascade winner. The comparison reuses ECSS's exact
|
|
||||||
cascade ordering and does not require public provenance materialization."
|
|
||||||
(setq style (ecss--computed-style-check style))
|
|
||||||
(let ((schemas (ecss--computed-style-schemas style))
|
|
||||||
(winners (ecss--computed-style-winners style))
|
|
||||||
winner-property winner)
|
|
||||||
(dolist (property properties winner-property)
|
|
||||||
(let* ((canonical
|
|
||||||
(or (ecss-schema-set-canonical-id schemas property)
|
|
||||||
(signal 'ecss-invalid-declaration
|
|
||||||
(list :unknown-property property))))
|
|
||||||
(candidate (plist-get winners canonical)))
|
|
||||||
(when (and candidate
|
|
||||||
(or (null winner)
|
|
||||||
(ecss--candidate-higher-p candidate winner)))
|
|
||||||
(setq winner-property canonical
|
|
||||||
winner candidate))))))
|
|
||||||
|
|
||||||
(defun ecss-computed-style-provenance (style)
|
(defun ecss-computed-style-provenance (style)
|
||||||
"Return defensive winner provenance from computed STYLE."
|
"Return defensive winner provenance from computed STYLE."
|
||||||
(ecss--computed-style-check style)
|
(ecss--computed-style-check style)
|
||||||
@ -1243,53 +1045,21 @@ cascade ordering and does not require public provenance materialization."
|
|||||||
|
|
||||||
(defun ecss-computed-style-value (style property &optional fallback)
|
(defun ecss-computed-style-value (style property &optional fallback)
|
||||||
"Return PROPERTY from computed STYLE, or FALLBACK when absent."
|
"Return PROPERTY from computed STYLE, or FALLBACK when absent."
|
||||||
(setq style (ecss--computed-style-check style))
|
(let ((values (ecss--computed-style-values
|
||||||
(let* ((schemas (ecss--computed-style-schemas style))
|
(ecss--computed-style-check style))))
|
||||||
(canonical (or (ecss-schema-set-canonical-id schemas property)
|
(if (plist-member values property) (plist-get values property) fallback)))
|
||||||
property))
|
|
||||||
(values (ecss--computed-style-values style)))
|
|
||||||
(if (plist-member values canonical)
|
|
||||||
(ecss--copy-boundary-data (plist-get values canonical))
|
|
||||||
fallback)))
|
|
||||||
|
|
||||||
(defun ecss-computed-style-property-fact (style property)
|
|
||||||
"Return one immutable computed fact for PROPERTY in STYLE, or nil."
|
|
||||||
(setq style (ecss--computed-style-check style))
|
|
||||||
(let* ((schemas (ecss--computed-style-schemas style))
|
|
||||||
(canonical (ecss-schema-set-canonical-id schemas property))
|
|
||||||
(schema (and canonical
|
|
||||||
(gethash canonical (ecss--schema-set-table schemas))))
|
|
||||||
(values (ecss--computed-style-values style)))
|
|
||||||
(when (and schema (plist-member values canonical))
|
|
||||||
(ecss--make-computed-property-fact
|
|
||||||
:property canonical
|
|
||||||
:value (ecss--copy-boundary-data (plist-get values canonical))
|
|
||||||
:owner (ecss-property-schema-owner schema)
|
|
||||||
:impacts (ecss--copy-boundary-data
|
|
||||||
(ecss-property-schema-impacts schema))
|
|
||||||
:projections (ecss--copy-boundary-data
|
|
||||||
(ecss-property-schema-projections schema))
|
|
||||||
:provenance
|
|
||||||
(ecss--copy-boundary-data
|
|
||||||
(plist-get (ecss--computed-style-provenance style) canonical))
|
|
||||||
:metadata (ecss--copy-boundary-data
|
|
||||||
(ecss-property-schema-metadata schema))))))
|
|
||||||
|
|
||||||
(defun ecss-computed-style-present-p (style property)
|
(defun ecss-computed-style-present-p (style property)
|
||||||
"Return non-nil when PROPERTY is actively supplied in computed STYLE."
|
"Return non-nil when PROPERTY is actively supplied in computed STYLE."
|
||||||
(setq style (ecss--computed-style-check style))
|
(memq property
|
||||||
(memq (or (ecss-schema-set-canonical-id
|
(ecss--computed-style-active-properties
|
||||||
(ecss--computed-style-schemas style) property)
|
(ecss--computed-style-check style))))
|
||||||
property)
|
|
||||||
(ecss--computed-style-active-properties style)))
|
|
||||||
|
|
||||||
(defun ecss-computed-style-specified-p (style property)
|
(defun ecss-computed-style-specified-p (style property)
|
||||||
"Return non-nil when PROPERTY has a cascade winner in computed STYLE."
|
"Return non-nil when PROPERTY has a cascade winner in computed STYLE."
|
||||||
(setq style (ecss--computed-style-check style))
|
(memq property
|
||||||
(memq (or (ecss-schema-set-canonical-id
|
(ecss--computed-style-specified-properties
|
||||||
(ecss--computed-style-schemas style) property)
|
(ecss--computed-style-check style))))
|
||||||
property)
|
|
||||||
(ecss--computed-style-specified-properties style)))
|
|
||||||
|
|
||||||
(provide 'ecss-cascade)
|
(provide 'ecss-cascade)
|
||||||
;;; ecss-cascade.el ends here
|
;;; ecss-cascade.el ends here
|
||||||
|
|||||||
@ -49,16 +49,6 @@
|
|||||||
Function values retain identity so executable literals remain callable."
|
Function values retain identity so executable literals remain callable."
|
||||||
(cond
|
(cond
|
||||||
((functionp value) value)
|
((functionp value) value)
|
||||||
((hash-table-p value)
|
|
||||||
(let ((copy (copy-hash-table value)))
|
|
||||||
(clrhash copy)
|
|
||||||
(maphash
|
|
||||||
(lambda (key item)
|
|
||||||
(puthash (ecss--copy-boundary-data key)
|
|
||||||
(ecss--copy-boundary-data item)
|
|
||||||
copy))
|
|
||||||
value)
|
|
||||||
copy))
|
|
||||||
((consp value)
|
((consp value)
|
||||||
(cons (ecss--copy-boundary-data (car value))
|
(cons (ecss--copy-boundary-data (car value))
|
||||||
(ecss--copy-boundary-data (cdr value))))
|
(ecss--copy-boundary-data (cdr value))))
|
||||||
|
|||||||
@ -11,28 +11,24 @@
|
|||||||
|
|
||||||
(defun ecss-cascade-test--schemas ()
|
(defun ecss-cascade-test--schemas ()
|
||||||
"Return the standard test schema set."
|
"Return the standard test schema set."
|
||||||
(ecss-schema-set-compose
|
(let ((schemas (ecss-schema-set-create)))
|
||||||
(ecss-schema-package-create
|
(ecss-schema-set-define
|
||||||
'app
|
schemas 'app/color :initial "black" :inherits t
|
||||||
(append
|
:validator #'stringp)
|
||||||
(list
|
(ecss-schema-set-define
|
||||||
(list :id 'app/color :initial "black" :inherits t
|
schemas 'app/width :initial 0 :validator #'integerp)
|
||||||
:validator #'stringp :impacts '(paint))
|
(ecss-schema-set-define schemas 'app/payload :initial nil :inherits t)
|
||||||
(list :id 'app/width :initial 0 :validator #'integerp
|
(dolist (property '(app/padding-top app/padding-right
|
||||||
:impacts '(geometry))
|
|
||||||
(list :id 'app/payload :initial nil :inherits t :impacts '(data)))
|
|
||||||
(mapcar (lambda (property)
|
|
||||||
(list :id property :initial 0 :validator #'integerp
|
|
||||||
:impacts '(geometry)))
|
|
||||||
'(app/padding-top app/padding-right
|
|
||||||
app/padding-bottom app/padding-left))
|
app/padding-bottom app/padding-left))
|
||||||
(list
|
(ecss-schema-set-define
|
||||||
(list
|
schemas property :initial 0 :validator #'integerp))
|
||||||
:id 'app/padding :initial nil :impacts '(geometry)
|
(ecss-schema-set-define
|
||||||
|
schemas 'app/padding
|
||||||
:shorthand
|
:shorthand
|
||||||
(lambda (value)
|
(lambda (value)
|
||||||
(list 'app/padding-top value 'app/padding-right value
|
(list 'app/padding-top value 'app/padding-right value
|
||||||
'app/padding-bottom value 'app/padding-left value))))))))
|
'app/padding-bottom value 'app/padding-left value)))
|
||||||
|
schemas))
|
||||||
|
|
||||||
(defun ecss-cascade-test--subject (&rest options)
|
(defun ecss-cascade-test--subject (&rest options)
|
||||||
"Return a button subject using OPTIONS."
|
"Return a button subject using OPTIONS."
|
||||||
@ -63,36 +59,30 @@
|
|||||||
(should (equal "blue"
|
(should (equal "blue"
|
||||||
(ecss-computed-style-value copy 'app/color)))))
|
(ecss-computed-style-value copy 'app/color)))))
|
||||||
|
|
||||||
(ert-deftest ecss-cascade-test-schema-construction-is-atomic ()
|
(ert-deftest ecss-cascade-test-schema-registration-is-atomic ()
|
||||||
|
(let ((schemas (ecss-schema-set-create)))
|
||||||
|
(ecss-schema-set-define schemas 'app/width :initial 4 :validator #'integerp)
|
||||||
(should-error
|
(should-error
|
||||||
(ecss-schema-package-create
|
(ecss-schema-set-define schemas 'app/width :initial "bad"
|
||||||
'app
|
:validator #'integerp)
|
||||||
'((:id app/width :initial 4 :validator integerp :impacts (geometry))
|
|
||||||
(:id app/bad :initial "bad" :validator integerp :impacts (geometry))))
|
|
||||||
:type 'ecss-invalid-property-schema)
|
:type 'ecss-invalid-property-schema)
|
||||||
(let ((schemas
|
|
||||||
(ecss-schema-set-compose
|
|
||||||
(ecss-schema-package-create
|
|
||||||
'app
|
|
||||||
'((:id app/width :initial 4 :validator integerp
|
|
||||||
:impacts (geometry)))))))
|
|
||||||
(should (= (ecss-property-schema-initial
|
(should (= (ecss-property-schema-initial
|
||||||
(ecss-schema-set-property schemas 'app/width))
|
(ecss-schema-set-property schemas 'app/width))
|
||||||
4))))
|
4))
|
||||||
|
(should-error
|
||||||
|
(ecss-schema-set-define schemas 'not-namespaced :initial 1)
|
||||||
|
:type 'ecss-invalid-property-schema)
|
||||||
|
(should (equal (ecss-schema-set-property-ids schemas) '(app/width)))))
|
||||||
|
|
||||||
(ert-deftest ecss-cascade-test-computed-defaults-are-not-renormalized ()
|
(ert-deftest ecss-cascade-test-computed-defaults-are-not-renormalized ()
|
||||||
(let ((subject (ecss-cascade-test--subject))
|
(let ((schemas (ecss-schema-set-create))
|
||||||
|
(subject (ecss-cascade-test--subject))
|
||||||
(normalizations 0))
|
(normalizations 0))
|
||||||
(let* ((schemas
|
(ecss-schema-set-define
|
||||||
(ecss-schema-set-compose
|
schemas 'app/value :initial 2 :inherits t
|
||||||
(ecss-schema-package-create
|
:normalizer (lambda (value) (cl-incf normalizations) (* value 10))
|
||||||
'app
|
:validator #'integerp)
|
||||||
(list
|
(let* ((initial (ecss-compute-style schemas subject))
|
||||||
(list :id 'app/value :initial 2 :inherits t
|
|
||||||
:normalizer
|
|
||||||
(lambda (value) (cl-incf normalizations) (* value 10))
|
|
||||||
:validator #'integerp :impacts '(data))))))
|
|
||||||
(initial (ecss-compute-style schemas subject))
|
|
||||||
(declared (ecss-compute-style
|
(declared (ecss-compute-style
|
||||||
schemas subject :declarations '(app/value 3)))
|
schemas subject :declarations '(app/value 3)))
|
||||||
(inherited (ecss-compute-style
|
(inherited (ecss-compute-style
|
||||||
@ -146,15 +136,21 @@
|
|||||||
(should (eq (aref merged-value 1) literal))
|
(should (eq (aref merged-value 1) literal))
|
||||||
(should (eq (funcall (aref merged-value 1)) :literal))))
|
(should (eq (funcall (aref merged-value 1)) :literal))))
|
||||||
|
|
||||||
(ert-deftest ecss-cascade-test-shorthand-and-longhand-conflict-in-one-source ()
|
(ert-deftest ecss-cascade-test-shorthand-and-longhand-follow-declaration-order ()
|
||||||
(let ((schemas (ecss-cascade-test--schemas))
|
(let ((schemas (ecss-cascade-test--schemas))
|
||||||
(subject (ecss-cascade-test--subject)))
|
(subject (ecss-cascade-test--subject)))
|
||||||
(dolist (declarations
|
(should (= (ecss-cascade-test--value
|
||||||
'((app/padding 1 app/padding-left 2)
|
(ecss-compute-style
|
||||||
(app/padding-left 2 app/padding 1)))
|
schemas subject
|
||||||
(should-error
|
:declarations '(app/padding 1 app/padding-left 2))
|
||||||
(ecss-compute-style schemas subject :declarations declarations)
|
'app/padding-left)
|
||||||
:type 'ecss-invalid-declaration))))
|
2))
|
||||||
|
(should (= (ecss-cascade-test--value
|
||||||
|
(ecss-compute-style
|
||||||
|
schemas subject
|
||||||
|
:declarations '(app/padding-left 2 app/padding 1))
|
||||||
|
'app/padding-left)
|
||||||
|
1))))
|
||||||
|
|
||||||
(ert-deftest ecss-cascade-test-rule-addition-is-atomic ()
|
(ert-deftest ecss-cascade-test-rule-addition-is-atomic ()
|
||||||
(let ((schemas (ecss-cascade-test--schemas))
|
(let ((schemas (ecss-cascade-test--schemas))
|
||||||
@ -630,13 +626,9 @@
|
|||||||
'((theme base)))))))
|
'((theme base)))))))
|
||||||
|
|
||||||
(ert-deftest ecss-cascade-test-schema-boundaries-copy-mutable-values ()
|
(ert-deftest ecss-cascade-test-schema-boundaries-copy-mutable-values ()
|
||||||
(let* ((caller-initial (vector (copy-sequence "base")))
|
(let* ((schemas (ecss-schema-set-create))
|
||||||
(schemas
|
(caller-initial (vector (copy-sequence "base"))))
|
||||||
(ecss-schema-set-compose
|
(ecss-schema-set-define schemas 'app/value :initial caller-initial)
|
||||||
(ecss-schema-package-create
|
|
||||||
'app
|
|
||||||
(list (list :id 'app/value :initial caller-initial
|
|
||||||
:impacts '(data)))))))
|
|
||||||
(aset (aref caller-initial 0) 0 ?X)
|
(aset (aref caller-initial 0) 0 ?X)
|
||||||
(let ((stored (ecss-property-schema-initial
|
(let ((stored (ecss-property-schema-initial
|
||||||
(ecss-schema-set-property schemas 'app/value))))
|
(ecss-schema-set-property schemas 'app/value))))
|
||||||
@ -751,55 +743,6 @@
|
|||||||
(should (equal (ecss-computed-style-specified-properties declared)
|
(should (equal (ecss-computed-style-specified-properties declared)
|
||||||
'(app/color app/width app/payload)))))
|
'(app/color app/width app/payload)))))
|
||||||
|
|
||||||
(ert-deftest ecss-cascade-test-cross-property-projection-reuses-cascade-order ()
|
|
||||||
"A consumer projection should choose among property winners without recascade."
|
|
||||||
(let* ((schemas (ecss-cascade-test--schemas))
|
|
||||||
(stylesheet (ecss-stylesheet-create))
|
|
||||||
(subject (ecss-cascade-test--subject
|
|
||||||
:id "hero" :classes '("target"))))
|
|
||||||
(ecss-stylesheet-add-rule
|
|
||||||
stylesheet schemas ".target" '(app/padding-left 1))
|
|
||||||
(ecss-stylesheet-add-rule
|
|
||||||
stylesheet schemas "#hero" '(app/width 2))
|
|
||||||
(let* ((ruled (ecss-compute-style
|
|
||||||
schemas subject :stylesheet stylesheet))
|
|
||||||
(inline (ecss-compute-style
|
|
||||||
schemas subject :stylesheet stylesheet
|
|
||||||
:declarations '(app/padding-left 3)))
|
|
||||||
(copy (ecss-computed-style-copy-with-values
|
|
||||||
inline (ecss-computed-style-values inline))))
|
|
||||||
(should (eq (ecss-computed-style-precedence-winner
|
|
||||||
ruled '(app/padding-left app/width))
|
|
||||||
'app/width))
|
|
||||||
(should (eq (ecss-computed-style-precedence-winner
|
|
||||||
inline '(app/padding-left app/width))
|
|
||||||
'app/padding-left))
|
|
||||||
(should (eq (ecss-computed-style-precedence-winner
|
|
||||||
copy '(app/padding-left app/width))
|
|
||||||
'app/padding-left))
|
|
||||||
(should-not (ecss-computed-style-provenance inline)))))
|
|
||||||
|
|
||||||
(ert-deftest ecss-cascade-test-cross-property-projection-skips-invalid-winner ()
|
|
||||||
"An invalid declaration must not override a valid cross-property fact."
|
|
||||||
(let* ((schemas (ecss-cascade-test--schemas))
|
|
||||||
(stylesheet (ecss-stylesheet-create))
|
|
||||||
(subject (ecss-cascade-test--subject
|
|
||||||
:id "hero" :classes '("target"))))
|
|
||||||
(ecss-stylesheet-add-rule
|
|
||||||
stylesheet schemas ".target" '(app/padding-left 5))
|
|
||||||
(ecss-stylesheet-add-rule
|
|
||||||
stylesheet schemas "#hero" '(app/width "invalid"))
|
|
||||||
(let ((style (ecss-compute-style
|
|
||||||
schemas subject :stylesheet stylesheet)))
|
|
||||||
(should (eq (ecss-computed-style-precedence-winner
|
|
||||||
style '(app/padding-left app/width))
|
|
||||||
'app/padding-left))
|
|
||||||
(should (memq 'app/width
|
|
||||||
(ecss-computed-style-specified-properties style)))
|
|
||||||
(should-not (memq 'app/width
|
|
||||||
(ecss-computed-style-active-properties style)))
|
|
||||||
(should (= (ecss-computed-style-value style 'app/width) 0)))))
|
|
||||||
|
|
||||||
(ert-deftest ecss-cascade-test-provenance-getter-copies-selector-data ()
|
(ert-deftest ecss-cascade-test-provenance-getter-copies-selector-data ()
|
||||||
(let ((schemas (ecss-cascade-test--schemas))
|
(let ((schemas (ecss-cascade-test--schemas))
|
||||||
(stylesheet (ecss-stylesheet-create))
|
(stylesheet (ecss-stylesheet-create))
|
||||||
|
|||||||
@ -49,16 +49,12 @@
|
|||||||
"0.1.0")))))
|
"0.1.0")))))
|
||||||
|
|
||||||
(ert-deftest ecss-package-test-independent-schema-and-stylesheet-state ()
|
(ert-deftest ecss-package-test-independent-schema-and-stylesheet-state ()
|
||||||
(let ((left-schemas
|
(let ((left-schemas (ecss-schema-set-create))
|
||||||
(ecss-schema-set-compose
|
(right-schemas (ecss-schema-set-create))
|
||||||
(ecss-schema-package-create
|
|
||||||
'left '((:id left/color :initial "left" :impacts (paint))))))
|
|
||||||
(right-schemas
|
|
||||||
(ecss-schema-set-compose
|
|
||||||
(ecss-schema-package-create
|
|
||||||
'right '((:id right/color :initial "right" :impacts (paint))))))
|
|
||||||
(left-sheet (ecss-stylesheet-create))
|
(left-sheet (ecss-stylesheet-create))
|
||||||
(right-sheet (ecss-stylesheet-create)))
|
(right-sheet (ecss-stylesheet-create)))
|
||||||
|
(ecss-schema-set-define left-schemas 'left/color :initial "left")
|
||||||
|
(ecss-schema-set-define right-schemas 'right/color :initial "right")
|
||||||
(ecss-stylesheet-add-rule
|
(ecss-stylesheet-add-rule
|
||||||
left-sheet left-schemas "*" '(left/color "changed"))
|
left-sheet left-schemas "*" '(left/color "changed"))
|
||||||
(should (null (ecss-stylesheet-rules right-sheet)))
|
(should (null (ecss-stylesheet-rules right-sheet)))
|
||||||
|
|||||||
@ -1,271 +0,0 @@
|
|||||||
;;; ecss-schema-tests.el --- Immutable schema composition tests -*- lexical-binding: t; -*-
|
|
||||||
|
|
||||||
;; Copyright (C) 2026 Geekinney
|
|
||||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(require 'ert)
|
|
||||||
(require 'ecss)
|
|
||||||
|
|
||||||
(defun ecss-schema-test--definition (id &rest options)
|
|
||||||
"Return a complete schema definition for ID extended by OPTIONS."
|
|
||||||
(let ((definition (list :id id :initial nil :impacts '(paint))))
|
|
||||||
(while options
|
|
||||||
(setq definition (plist-put definition (pop options) (pop options))))
|
|
||||||
definition))
|
|
||||||
|
|
||||||
(defun ecss-schema-test--package (id definitions)
|
|
||||||
"Return immutable package ID built from DEFINITIONS."
|
|
||||||
(ecss-schema-package-create id definitions))
|
|
||||||
|
|
||||||
(ert-deftest ecss-schema-package-validates-identity-and-definitions ()
|
|
||||||
"Package and property identities have one strict grammar."
|
|
||||||
(dolist (id '(nil :app "app" 4))
|
|
||||||
(should-error
|
|
||||||
(ecss-schema-package-create id nil)
|
|
||||||
:type 'ecss-invalid-property-schema))
|
|
||||||
(dolist (definition
|
|
||||||
'((:id plain :impacts (paint))
|
|
||||||
(:id app/color :impacts nil)
|
|
||||||
(:id app/color :impacts (paint paint))
|
|
||||||
(:id app/color :impacts (paint) :aliases (:tone :tone))
|
|
||||||
(:id app/color :impacts (paint) :projections (tp tp))))
|
|
||||||
(should-error
|
|
||||||
(ecss-schema-package-create 'app (list definition))
|
|
||||||
:type 'ecss-invalid-property-schema))
|
|
||||||
(dolist
|
|
||||||
(definitions
|
|
||||||
'(((:id app/color :impacts (paint) :aliases (:tone))
|
|
||||||
(:id app/gap :impacts (geometry) :aliases (:tone)))
|
|
||||||
((:id app/color :impacts (paint) :aliases (app/gap))
|
|
||||||
(:id app/gap :impacts (geometry)))
|
|
||||||
((:id app/color :impacts (paint))
|
|
||||||
(:id app/gap :impacts (geometry) :aliases (app/color)))))
|
|
||||||
(should-error
|
|
||||||
(ecss-schema-package-create 'app definitions)
|
|
||||||
:type 'ecss-invalid-property-schema)))
|
|
||||||
|
|
||||||
(ert-deftest ecss-schema-package-copies-all-caller-owned-input ()
|
|
||||||
"Package creation snapshots mutable schema input exactly once."
|
|
||||||
(let* ((initial (vector (copy-sequence "red")))
|
|
||||||
(aliases (list :tone))
|
|
||||||
(impacts (list 'paint))
|
|
||||||
(projections (list 'tp))
|
|
||||||
(metadata-table
|
|
||||||
(let ((table (make-hash-table :test #'eq)))
|
|
||||||
(puthash 'role 'label table)
|
|
||||||
table))
|
|
||||||
(metadata (list :contexts (list 'text) :index metadata-table))
|
|
||||||
(definition
|
|
||||||
(list :id 'app/color :initial initial :aliases aliases
|
|
||||||
:impacts impacts :projections projections :metadata metadata))
|
|
||||||
(package (ecss-schema-package-create 'app (list definition)))
|
|
||||||
(schemas (ecss-schema-set-compose package)))
|
|
||||||
(aset (aref initial 0) 0 ?X)
|
|
||||||
(setcar aliases :damaged)
|
|
||||||
(setcar impacts 'geometry)
|
|
||||||
(setcar projections 'layout)
|
|
||||||
(setcar (plist-get metadata :contexts) 'box)
|
|
||||||
(puthash 'role 'damaged metadata-table)
|
|
||||||
(let ((property (ecss-schema-set-property schemas 'app/color)))
|
|
||||||
(should (equal ["red"] (ecss-property-schema-initial property)))
|
|
||||||
(should (equal '(:tone) (ecss-property-schema-aliases property)))
|
|
||||||
(should (equal '(paint) (ecss-property-schema-impacts property)))
|
|
||||||
(should (equal '(tp) (ecss-property-schema-projections property)))
|
|
||||||
(let ((stored (ecss-property-schema-metadata property)))
|
|
||||||
(should (equal '(text) (plist-get stored :contexts)))
|
|
||||||
(should (eq 'label (gethash 'role (plist-get stored :index))))))
|
|
||||||
(let ((canonical-metadata
|
|
||||||
(ecss-schema-set-property-metadata schemas 'app/color))
|
|
||||||
(alias-metadata
|
|
||||||
(ecss-schema-set-property-metadata schemas :tone)))
|
|
||||||
(should (equal (plist-get canonical-metadata :contexts)
|
|
||||||
(plist-get alias-metadata :contexts)))
|
|
||||||
(should (eq (gethash 'role (plist-get canonical-metadata :index))
|
|
||||||
(gethash 'role (plist-get alias-metadata :index))))
|
|
||||||
(setcar (plist-get canonical-metadata :contexts) 'damaged)
|
|
||||||
(puthash 'role 'damaged (plist-get canonical-metadata :index))
|
|
||||||
(let ((stored
|
|
||||||
(ecss-schema-set-property-metadata schemas 'app/color)))
|
|
||||||
(should (equal '(text) (plist-get stored :contexts)))
|
|
||||||
(should (eq 'label (gethash 'role (plist-get stored :index))))))))
|
|
||||||
|
|
||||||
(ert-deftest ecss-schema-set-compose-rejects-complete-collision-matrix ()
|
|
||||||
"Composition rejects package, canonical, and alias collisions atomically."
|
|
||||||
(let* ((left
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'left (list (ecss-schema-test--definition
|
|
||||||
'left/color :aliases '(shared/tone)))))
|
|
||||||
(same-canonical
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'right (list (ecss-schema-test--definition 'left/color))))
|
|
||||||
(canonical-over-alias
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'right (list (ecss-schema-test--definition 'shared/tone))))
|
|
||||||
(alias-over-canonical
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'right (list (ecss-schema-test--definition
|
|
||||||
'right/color :aliases '(left/color)))))
|
|
||||||
(same-alias
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'right (list (ecss-schema-test--definition
|
|
||||||
'right/color :aliases '(shared/tone))))))
|
|
||||||
(should-error (ecss-schema-set-compose left left)
|
|
||||||
:type 'ecss-invalid-property-schema)
|
|
||||||
(dolist (right (list same-canonical canonical-over-alias
|
|
||||||
alias-over-canonical same-alias))
|
|
||||||
(should-error (ecss-schema-set-compose left right)
|
|
||||||
:type 'ecss-invalid-property-schema)
|
|
||||||
(should (equal '(left/color)
|
|
||||||
(ecss-schema-set-property-ids
|
|
||||||
(ecss-schema-set-compose left))))
|
|
||||||
(should (= 1 (length (ecss-schema-package-property-ids right)))))))
|
|
||||||
|
|
||||||
(ert-deftest ecss-schema-set-exposes-immutable-composition-index ()
|
|
||||||
"Composed package order, canonical lookup, and schemas are deterministic."
|
|
||||||
(let* ((app
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'app (list (ecss-schema-test--definition
|
|
||||||
'app/color :aliases '(:tone)))))
|
|
||||||
(ui
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'ui (list (ecss-schema-test--definition 'ui/gap))))
|
|
||||||
(schemas (ecss-schema-set-compose app ui))
|
|
||||||
(ids (ecss-schema-set-property-ids schemas))
|
|
||||||
(packages (ecss-schema-set-package-ids schemas))
|
|
||||||
(property (ecss-schema-set-property schemas :tone)))
|
|
||||||
(should (eq 'app (ecss-schema-package-id app)))
|
|
||||||
(should (equal '(app/color) (ecss-schema-package-property-ids app)))
|
|
||||||
(should (equal '(app ui) packages))
|
|
||||||
(should (equal '(app/color ui/gap) ids))
|
|
||||||
(should (eq 'app/color (ecss-schema-set-canonical-id schemas :tone)))
|
|
||||||
(should (eq 'app/color (ecss-property-schema-id property)))
|
|
||||||
(should (eq 'app (ecss-property-schema-owner property)))
|
|
||||||
(setcar ids 'damaged)
|
|
||||||
(setcar packages 'damaged)
|
|
||||||
(setf (ecss-property-schema-owner property) 'damaged)
|
|
||||||
(should (equal '(app ui) (ecss-schema-set-package-ids schemas)))
|
|
||||||
(should (equal '(app/color ui/gap)
|
|
||||||
(ecss-schema-set-property-ids schemas)))
|
|
||||||
(should (eq 'app
|
|
||||||
(ecss-property-schema-owner
|
|
||||||
(ecss-schema-set-property schemas 'app/color))))))
|
|
||||||
|
|
||||||
(ert-deftest ecss-schema-aliases-disappear-before-cascade ()
|
|
||||||
"Alias declarations normalize to canonical property identifiers."
|
|
||||||
(let* ((package
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'app
|
|
||||||
(list (ecss-schema-test--definition
|
|
||||||
'app/color :initial "black" :aliases '(:tone)
|
|
||||||
:validator #'stringp))))
|
|
||||||
(schemas (ecss-schema-set-compose package))
|
|
||||||
(expanded (ecss-expand-declarations schemas '(:tone "red")))
|
|
||||||
(style (ecss-compute-style
|
|
||||||
schemas (ecss-subject-create :type "box")
|
|
||||||
:declarations '(:tone "red") :provenance t)))
|
|
||||||
(should (equal '(app/color "red") expanded))
|
|
||||||
(should (equal '(app/color "red")
|
|
||||||
(ecss-computed-style-values style)))
|
|
||||||
(should (equal "red" (ecss-computed-style-value style :tone)))
|
|
||||||
(should (ecss-property-equal-p schemas :tone "red" "red"))
|
|
||||||
(dolist (declarations
|
|
||||||
'((:tone "red" app/color "blue")
|
|
||||||
(:tone "red" :tone "blue")))
|
|
||||||
(should-error
|
|
||||||
(ecss-expand-declarations schemas declarations)
|
|
||||||
:type 'ecss-invalid-declaration))))
|
|
||||||
|
|
||||||
(ert-deftest ecss-schema-shorthand-conflicts-with-owned-longhand ()
|
|
||||||
"One declaration source cannot produce the same canonical output twice."
|
|
||||||
(let* ((package
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'app
|
|
||||||
(list
|
|
||||||
(ecss-schema-test--definition 'app/top)
|
|
||||||
(ecss-schema-test--definition
|
|
||||||
'app/padding
|
|
||||||
:shorthand (lambda (value) (list 'app/top value))))))
|
|
||||||
(schemas (ecss-schema-set-compose package)))
|
|
||||||
(should-error
|
|
||||||
(ecss-expand-declarations
|
|
||||||
schemas '(app/padding 1 app/top 2))
|
|
||||||
:type 'ecss-invalid-declaration)
|
|
||||||
(should (equal '(app/top 2)
|
|
||||||
(ecss-merge-declarations
|
|
||||||
schemas '(app/padding 1) '(app/top 2))))))
|
|
||||||
|
|
||||||
(ert-deftest ecss-computed-property-fact-shares-value-and-multi-impact ()
|
|
||||||
"One typed fact carries value, provenance, and every declared impact."
|
|
||||||
(let* ((metadata (list :contexts '(text box)))
|
|
||||||
(package
|
|
||||||
(ecss-schema-test--package
|
|
||||||
'app
|
|
||||||
(list (ecss-schema-test--definition
|
|
||||||
'app/font :initial nil :impacts '(geometry paint)
|
|
||||||
:projections '(measure tp) :metadata metadata))))
|
|
||||||
(schemas (ecss-schema-set-compose package))
|
|
||||||
(value (list :family "Mono"))
|
|
||||||
(style (ecss-compute-style
|
|
||||||
schemas (ecss-subject-create :type "text")
|
|
||||||
:declarations (list 'app/font value) :provenance t))
|
|
||||||
(fact (ecss-computed-style-property-fact style 'app/font))
|
|
||||||
(original-provenance
|
|
||||||
(copy-tree (ecss-computed-property-fact-provenance fact))))
|
|
||||||
(should (ecss-computed-property-fact-p fact))
|
|
||||||
(should (equal (ecss-computed-property-fact-value fact)
|
|
||||||
(ecss-computed-style-value style 'app/font)))
|
|
||||||
(should (equal '(geometry paint)
|
|
||||||
(ecss-computed-property-fact-impacts fact)))
|
|
||||||
(should (equal '(measure tp)
|
|
||||||
(ecss-computed-property-fact-projections fact)))
|
|
||||||
(should (eq 'app (ecss-computed-property-fact-owner fact)))
|
|
||||||
(should (plist-get (ecss-computed-property-fact-provenance fact) :source))
|
|
||||||
(should (equal (ecss-computed-property-fact-metadata fact)
|
|
||||||
(ecss-schema-set-property-metadata schemas 'app/font)))
|
|
||||||
(let* ((fact-value (ecss-computed-property-fact-value fact))
|
|
||||||
(geometry-value fact-value)
|
|
||||||
(paint-value fact-value)
|
|
||||||
(impacts (ecss-computed-property-fact-impacts fact))
|
|
||||||
(projections (ecss-computed-property-fact-projections fact))
|
|
||||||
(provenance (ecss-computed-property-fact-provenance fact))
|
|
||||||
(fact-metadata (ecss-computed-property-fact-metadata fact)))
|
|
||||||
(setcar fact-value :damaged-value)
|
|
||||||
(setcar impacts 'damaged-impact)
|
|
||||||
(setcar projections 'damaged-projection)
|
|
||||||
(setcar provenance :damaged)
|
|
||||||
(setcar (plist-get fact-metadata :contexts) 'damaged-context)
|
|
||||||
(let ((fresh (ecss-computed-style-property-fact style 'app/font)))
|
|
||||||
(should (eq geometry-value paint-value))
|
|
||||||
(should (equal '(:family "Mono")
|
|
||||||
(ecss-computed-property-fact-value fresh)))
|
|
||||||
(should (equal '(:family "Mono")
|
|
||||||
(ecss-computed-style-value style 'app/font)))
|
|
||||||
(should (equal '(geometry paint)
|
|
||||||
(ecss-computed-property-fact-impacts fresh)))
|
|
||||||
(should (equal '(measure tp)
|
|
||||||
(ecss-computed-property-fact-projections fresh)))
|
|
||||||
(should (plist-get
|
|
||||||
(ecss-computed-property-fact-provenance fresh) :source))
|
|
||||||
(should (equal '(text box)
|
|
||||||
(plist-get
|
|
||||||
(ecss-computed-property-fact-metadata fresh)
|
|
||||||
:contexts)))))
|
|
||||||
(let* ((replacement (list :family "Serif"))
|
|
||||||
(copy (ecss-computed-style-copy-with-values
|
|
||||||
style (list 'app/font replacement)))
|
|
||||||
(copy-fact
|
|
||||||
(ecss-computed-style-property-fact copy 'app/font)))
|
|
||||||
(should (equal replacement
|
|
||||||
(ecss-computed-style-value copy 'app/font)))
|
|
||||||
(should (equal (ecss-computed-property-fact-value copy-fact)
|
|
||||||
(ecss-computed-style-value copy 'app/font)))
|
|
||||||
(should (equal original-provenance
|
|
||||||
(ecss-computed-property-fact-provenance copy-fact)))
|
|
||||||
(should (equal '(geometry paint)
|
|
||||||
(ecss-computed-property-fact-impacts copy-fact))))))
|
|
||||||
|
|
||||||
(provide 'ecss-schema-tests)
|
|
||||||
|
|
||||||
;;; ecss-schema-tests.el ends here
|
|
||||||
Loading…
Reference in New Issue
Block a user