geekinney/ebox
1
0
Fork 0
Code Issues Pull Requests Actions 21 Packages Projects Releases Wiki Activity

fix: restore immediate retained viewport updates

Browse Source
This commit is contained in:
Kinneyzhang 2026-08-26 00:09:53 +08:00
parent d58ec51650
commit fcfbeb0368
24 changed files with 466 additions and 438 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
docs/user/ebox-api-reference.en.md
View File

@ -432,10 +432,13 @@ in pixels and `ebox-viewport-height` in lines around the render. Do not mutate
a published node tree in place.
Visible mounted buffers follow their displaying window automatically. Ebox
coalesces continuous size events and publishes only the latest sample after
`ebox-viewport-resize-delay` (0.05 seconds by default).
publishes every size event immediately through its retained incremental path.
The Emacs hook is serialized and reentrant calls are rejected; there is no
second host hook, timer, or viewport queue.
`ebox-viewport-window-width` returns the same display-safe pixel width used by
that controller, so hosts must not install a second resize hook or width rule.
The former `ebox-viewport-resize-delay` setting has been removed; immediate
delivery has no timer setting to migrate.
## 7. Selectors
@ -522,7 +525,6 @@ The main customization variables are:
| Lazy scroll | `ebox-scroll-lazy-prefix-lookahead-lines` 8; `ebox-scroll-lazy-idle-prefetch-lines` 128; `ebox-scroll-lazy-idle-prefetch-slice-lines` 16; `ebox-scroll-lazy-idle-prefetch-delay` 0.15 |
| Runtime prewarm | `ebox-runtime-idle-prewarm` t; `ebox-runtime-idle-prewarm-delay` 0.1; `ebox-runtime-idle-prewarm-prefix-resume-delay` 2.0; `ebox-runtime-idle-prewarm-slice-size` 32; `ebox-native-buffer-scroll` t (initial/visible-window handoff only; strict root-owner proof) |
| Predicted reflow | `ebox-runtime-idle-reflow-cache-prewarm` t; `ebox-runtime-idle-reflow-cache-prewarm-delay` 0.15 |
| Viewport delivery | `ebox-viewport-resize-delay` 0.05; continuous window events replace one pending sample per mounted buffer |
| Reflow GC | `ebox-reflow-cache-prewarm-gc-cons-threshold` `auto`; `ebox-reflow-cache-prewarm-gc-auto-frame-budget` 0.2; `ebox-reflow-cache-prewarm-gc-auto-min-threshold` 64 MiB; `ebox-reflow-cache-prewarm-gc-auto-max-threshold` 1 GiB; `ebox-reflow-cache-prewarm-gc-auto-initial-threshold` 512 MiB; `ebox-reflow-cache-prewarm-gc-auto-target-layouts` 24; `ebox-reflow-cache-prewarm-gc-cons-percentage` 0.1 |
| Visual verification | `ebox-visual-check-output-dir` points to the temporary directory used for optional screenshots and reports. |

7
docs/user/ebox-api-reference.zh.md
View File

@ -392,10 +392,12 @@ report；若后续 phase 失败，rollback 最多一次接收同一个 report，
render 外部动态绑定 `ebox-viewport-width`（像素）与 `ebox-viewport-height`
（行数）。不要原地修改已经发布的 node tree。
可见的 mounted buffer 会自动跟随展示它的 window。Ebox 合并连续 size event，
并在 `ebox-viewport-resize-delay`（默认 0.05 秒）后只发布最新 sample。
可见的 mounted buffer 会自动跟随展示它的 window。Ebox 通过 retained 增量路径
立即发布每个 size event。Emacs hook 串行执行并拒绝重入；这里没有第二套宿主
hook、timer 或 viewport queue。
`ebox-viewport-window-width` 返回 controller 使用的同一个显示安全像素宽度；
宿主不应再安装第二套 resize hook 或宽度算法。
旧的 `ebox-viewport-resize-delay` 已删除；立即发布不再需要迁移 timer 配置。
## 7. Selector
@ -473,7 +475,6 @@ text scale 和固定 `display` space；它也是布局使用的公共测量原
| Lazy scroll | `ebox-scroll-lazy-prefix-lookahead-lines` 8；`ebox-scroll-lazy-idle-prefetch-lines` 128；`ebox-scroll-lazy-idle-prefetch-slice-lines` 16；`ebox-scroll-lazy-idle-prefetch-delay` 0.15 |
| Runtime prewarm | `ebox-runtime-idle-prewarm` t；`ebox-runtime-idle-prewarm-delay` 0.1；`ebox-runtime-idle-prewarm-prefix-resume-delay` 2.0；`ebox-runtime-idle-prewarm-slice-size` 32；`ebox-native-buffer-scroll` t（仅 initial/visible-window handoff；严格 root-owner proof） |
| 预测 reflow | `ebox-runtime-idle-reflow-cache-prewarm` t；`ebox-runtime-idle-reflow-cache-prewarm-delay` 0.15 |
| Viewport delivery | `ebox-viewport-resize-delay` 0.05；连续 window event 对每个 mounted buffer 只保留一个最新 sample |
| Reflow GC | `ebox-reflow-cache-prewarm-gc-cons-threshold` `auto`；`ebox-reflow-cache-prewarm-gc-auto-frame-budget` 0.2；`ebox-reflow-cache-prewarm-gc-auto-min-threshold` 64 MiB；`ebox-reflow-cache-prewarm-gc-auto-max-threshold` 1 GiB；`ebox-reflow-cache-prewarm-gc-auto-initial-threshold` 512 MiB；`ebox-reflow-cache-prewarm-gc-auto-target-layouts` 24；`ebox-reflow-cache-prewarm-gc-cons-percentage` 0.1 |
| Visual verification | `ebox-visual-check-output-dir` 指向可选 screenshot/report 使用的临时目录。 |

16
ebox-buffer-backend.el
View File

@ -54,7 +54,7 @@ Set this to a byte count for a fixed budget, or nil to leave the setting alone."
(defun ebox--darwin-physical-memory-bytes ()
"Return macOS physical memory in bytes, or nil when unavailable."
(when (eq system-type 'darwin)
(when-let ((sysctl (executable-find "sysctl")))
(when-let* ((sysctl (executable-find "sysctl")))
(with-temp-buffer
(when (zerop (call-process sysctl nil t nil "-n" "hw.memsize"))
(goto-char (point-min))
@ -65,7 +65,7 @@ Set this to a byte count for a fixed budget, or nil to leave the setting alone."
"Return local physical memory in bytes, or nil when unavailable."
(when (eq ebox--physical-memory-bytes 'unknown)
(setq ebox--physical-memory-bytes
(or (when-let ((info
(or (when-let* ((info
(and (fboundp 'memory-info)
(let ((default-directory
temporary-file-directory))
@ -175,7 +175,7 @@ Set this to nil to leave `gc-cons-percentage' unchanged.")
(max gc-cons-percentage ebox-render-gc-cons-percentage)))
(cl-incf ebox--deferred-render-gc-generation)
(cl-incf ebox--deferred-render-gc-depth)
(when-let ((threshold
(when-let* ((threshold
(ebox--effective-deferred-render-gc-cons-threshold)))
(setq gc-cons-threshold threshold))
(unless ebox--deferred-render-gc-state
@ -327,7 +327,7 @@ Return FUNCTION's value."
(:font-height . :height)
(:font-weight . :weight)
(:font-slant . :slant)))
(when-let ((value (plist-get style (car entry))))
(when-let* ((value (plist-get style (car entry))))
(setq face (plist-put face (cdr entry) value))))
face))
@ -377,7 +377,7 @@ foreground color."
This backend mapper intentionally accepts computed style facts and emits only
buffer-facing paint properties. Layout-only properties never pass through."
(let ((face (ebox-buffer--font-face style)))
(when-let ((foreground (ebox-buffer--paint-color style role)))
(when-let* ((foreground (ebox-buffer--paint-color style role)))
(setq face
(cond
((tp-paint-slot-p foreground)
@ -386,7 +386,7 @@ buffer-facing paint properties. Layout-only properties never pass through."
((eq foreground 'ebox/default-foreground)
(append (ebox-buffer--default-foreground-face) face))
(t (plist-put face :foreground foreground)))))
(when-let ((background (ebox-buffer--paint-background-color style role)))
(when-let* ((background (ebox-buffer--paint-background-color style role)))
(setq face
(if (tp-paint-slot-p background)
(let ((slot-face (tp-paint-slot-face background)))
@ -397,7 +397,7 @@ buffer-facing paint properties. Layout-only properties never pass through."
(defun ebox--propertize-typography (string style)
"Apply STYLE's typography to one copy of STRING."
(if-let ((face (ebox-buffer--font-face style)))
(if-let* ((face (ebox-buffer--font-face style)))
(let ((copy (copy-sequence string)))
(ebox--add-render-face! copy 0 (length copy) face t)
(ebox--register-render-owned-face-values string copy))
@ -813,7 +813,7 @@ parent layout change."
(setq ok t)
(cl-loop for width in slot-widths
for line = (or (pop lines) (ebox-pixel-space 0))
do (if-let ((padded-line
do (if-let* ((padded-line
(ebox-buffer--pad-line-to-slot-width
line width)))
(push padded-line padded)

8
ebox-cache.el
View File

@ -175,13 +175,13 @@
"Return distinct scopes for CACHE-NAMES."
(let (scopes)
(dolist (name cache-names)
(when-let ((spec (ebox-cache-spec name)))
(when-let* ((spec (ebox-cache-spec name)))
(cl-pushnew (ebox-cache-spec-scope spec) scopes :test #'equal)))
scopes))
(defun ebox-cache-record-hit (buffer cache-name)
"Record a CACHE-NAME hit for BUFFER's current update report."
(when-let ((state (ebox-cache--report-state buffer)))
(when-let* ((state (ebox-cache--report-state buffer)))
(plist-put state :cache-hit-count
(1+ (or (plist-get state :cache-hit-count) 0)))
(ebox-cache--push-unique-values
@ -189,7 +189,7 @@
(defun ebox-cache-record-miss (buffer cache-name)
"Record a CACHE-NAME miss for BUFFER's current update report."
(when-let ((state (ebox-cache--report-state buffer)))
(when-let* ((state (ebox-cache--report-state buffer)))
(plist-put state :cache-miss-count
(1+ (or (plist-get state :cache-miss-count) 0)))
(ebox-cache--push-unique-values
@ -197,7 +197,7 @@
(defun ebox-cache-record-invalidation (buffer cache-names reason)
"Record invalidated CACHE-NAMES and REASON for BUFFER."
(when-let ((state (ebox-cache--report-state buffer)))
(when-let* ((state (ebox-cache--report-state buffer)))
(ebox-cache--push-unique-values state :cache-invalidated cache-names)
(ebox-cache--push-unique-values
state :cache-scope (ebox-cache--spec-scopes cache-names))

16
ebox-child-range.el
View File

@ -302,14 +302,14 @@ those NEW items already name canonical published objects and are not copied."
(let ((payload (ebox-child-range--segment-payload (nth 2 record))))
(dotimes (offset (length payload))
(ebox-child-range--metric-add metrics 'old-affected-payload-visits)
(when-let ((key (plist-get (aref payload offset) :key)))
(when-let* ((key (plist-get (aref payload offset) :key)))
(setq key-root
(ebox-child-range--hash-change
key-root key nil (funcall hash-function key) 0 t metrics))))))
(dolist (record records)
(let ((index (nth 1 record)) (payload (nth 3 record)))
(dotimes (offset (length payload))
(when-let ((key (plist-get (aref payload offset) :key)))
(when-let* ((key (plist-get (aref payload offset) :key)))
(setq key-root
(ebox-child-range--hash-change
key-root key (cons index offset)
@ -365,7 +365,7 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location."
(let* ((children (ebox-child-range--segment-node-children node))
(slot (ebox-child-range--digit index (1- height))))
(dotimes (cursor slot)
(when-let ((child (aref children cursor)))
(when-let* ((child (aref children cursor)))
(setq weight (+ weight
(ebox-child-range--segment-node-weight child)))))
(setq node (aref children slot)
@ -389,7 +389,7 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location."
(let (records)
(dotimes (index (ebox-child-range--sequence-count sequence))
(let ((segment (ebox-child-range--segment-at sequence index)))
(when-let ((ref (ebox-child-range--segment-ref segment)))
(when-let* ((ref (ebox-child-range--segment-ref segment)))
(push (list ref index) records))))
(nreverse records)))
@ -398,10 +398,10 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location."
(let ((nodes 0) (edges 0))
(cl-labels ((walk (node)
(setq nodes (1+ nodes))
(when-let ((children
(when-let* ((children
(ebox-child-range--segment-node-children node)))
(dotimes (slot 32)
(when-let ((child (aref children slot)))
(when-let* ((child (aref children slot)))
(setq edges (1+ edges))
(walk child))))))
(walk (ebox-child-range--sequence-root sequence)))
@ -411,11 +411,11 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location."
"Return `(VECTORS . SLOTS)' allocated by SEQUENCE's segment trie."
(let ((vectors 0))
(cl-labels ((walk (node)
(when-let ((children
(when-let* ((children
(ebox-child-range--segment-node-children node)))
(setq vectors (1+ vectors))
(dotimes (slot 32)
(when-let ((child (aref children slot))) (walk child))))))
(when-let* ((child (aref children slot))) (walk child))))))
(walk (ebox-child-range--sequence-root sequence)))
(cons vectors (* 32 vectors))))

32
ebox-flex.el
View File

@ -170,7 +170,7 @@ That text is preformatted and must not be sent through the default wrapper."
(when (or (plist-member raw-props :width)
(and (null (plist-get props :width))
(ebox--viewport-pixel-width nil)))
(when-let ((content-viewport
(when-let* ((content-viewport
(ebox--wrapper-content-viewport-pixel wrapper-box)))
(plist-put props :width (list content-viewport))))
(when (and (plist-member raw-props :height)
@ -204,7 +204,7 @@ ALLOWED-KEYWORDS is the CSS keyword set valid for the property being parsed."
(ebox--normalize-horizontal-size-value (car value) allowed-keywords))
((memq value allowed-keywords) value)
((and (consp value) (eq (car value) 'fit-content))
(if-let ((limit (cadr value)))
(if-let* ((limit (cadr value)))
(let ((pixels (if (ebox--viewport-size-value-p limit)
'viewport
(ebox--nonnegative-horizontal-size-pixels limit nil))))
@ -502,11 +502,11 @@ grapheme."
"Return BOX's total main-axis size constraint from PROPERTY."
(when (plist-member box property)
(if (eq axis 'row)
(when-let ((content-size
(when-let* ((content-size
(ebox--resolve-size-content-pixel
box (ebox-get box property) nil)))
(+ (ebox--side-pixel box) content-size))
(when-let ((block-size
(when-let* ((block-size
(ebox--box-sizing-content-height
box (ebox-get box property))))
(+ (ebox--side-height box) block-size)))))
@ -568,7 +568,7 @@ grapheme."
(puthash node t ebox--render-recached-source-node-cache))
(pcase (plist-get node :ebox-type)
('box
(when-let ((region-id (ebox-get node :region-id)))
(when-let* ((region-id (ebox-get node :region-id)))
(puthash region-id node ebox--region-box-table))
(ebox--flex-recache-source-boxes
(plist-get node :ebox-content-node)))
@ -656,7 +656,7 @@ caller can pass the same miss context to the renderer."
(defun ebox--flex-measure-cache-value (probe)
"Return a copied cached measurement from PROBE, or nil on a miss."
(when-let ((cached (plist-get probe :cached)))
(when-let* ((cached (plist-get probe :cached)))
(copy-sequence cached)))
(defun ebox--flex-render-cache-signature (node)
@ -1204,7 +1204,7 @@ Return a sized render entry containing the rendered string and dimensions."
The Elisp scalar algorithm remains the exact fallback and owns all item
metadata and rendering decisions."
(or (when (and main-limit (integerp main-gap))
(when-let ((backend (ebox--flex-native-size-lines-backend)))
(when-let* ((backend (ebox--flex-native-size-lines-backend)))
(funcall backend lines main-limit main-gap)))
(mapcar (lambda (line)
(ebox--flex-size-line line main-limit main-gap))
@ -1546,7 +1546,7 @@ its child."
(defun ebox--render-flex-box (node rendered)
"Render flex NODE's container box around RENDERED, when present."
(if-let ((box (plist-get node :box)))
(if-let* ((box (plist-get node :box)))
(let ((copy (copy-sequence box))
(region-id (ebox--ensure-region-id box)))
(plist-put copy :region-id region-id)
@ -1735,7 +1735,7 @@ a prefix of the eventual full wrapper render."
(defun ebox--flex-window-render-box-lines (node content complete limit)
"Return NODE flex wrapper lines around CONTENT up to LIMIT."
(let* ((rendered
(if-let ((box (plist-get node :box)))
(if-let* ((box (plist-get node :box)))
(let ((copy (ebox--flex-window-wrapper-copy box complete))
(region-id (ebox--ensure-region-id box)))
(plist-put copy :region-id region-id)
@ -1968,7 +1968,7 @@ the chunk begins at the wrapper top and should include top chrome."
(defun ebox--flex-window-cache-lookup (node limit &optional cache-context)
"Return cached flex window render for NODE and LIMIT, or nil."
(when-let ((cache-context
(when-let* ((cache-context
(or cache-context (ebox--flex-window-cache-context node))))
(let* ((node-id (plist-get cache-context :node-id))
(signature (plist-get cache-context :signature))
@ -1992,7 +1992,7 @@ the chunk begins at the wrapper top and should include top chrome."
:completion-prefix-tail-rewrite-count
(plist-get
complete :completion-prefix-tail-rewrite-count))))
(when-let ((prefix (ebox--render-cache-lookup
(when-let* ((prefix (ebox--render-cache-lookup
(list node-id 'flex-window 'prefix)
signature)))
(let* ((lines (plist-get prefix :lines))
@ -2010,7 +2010,7 @@ the chunk begins at the wrapper top and should include top chrome."
(last lines))
(last result-lines))
:complete nil)))))
(when-let ((exact
(when-let* ((exact
(ebox--render-cache-lookup
(list node-id 'flex-window limit)
signature)))
@ -2026,7 +2026,7 @@ the chunk begins at the wrapper top and should include top chrome."
(defun ebox--flex-window-prefix-cache-lookup (node &optional cache-context)
"Return NODE's cached incomplete flex prefix state, or nil."
(when-let ((cache-context
(when-let* ((cache-context
(or cache-context (ebox--flex-window-cache-context node))))
(let* ((node-id (plist-get cache-context :node-id))
(signature (plist-get cache-context :signature)))
@ -2037,7 +2037,7 @@ the chunk begins at the wrapper top and should include top chrome."
(defun ebox--flex-window-prefix-cache-store
(node pieces next-index result &optional cache-context)
"Store NODE incomplete flex prefix PIECES through NEXT-INDEX."
(when-let ((cache-context
(when-let* ((cache-context
(and result
(or cache-context
(ebox--flex-window-cache-context node)))))
@ -2064,7 +2064,7 @@ the chunk begins at the wrapper top and should include top chrome."
(defun ebox--flex-window-cache-store
(node limit result &optional cache-context)
"Store NODE flex window RESULT for LIMIT when possible."
(when-let ((cache-context
(when-let* ((cache-context
(and result
(or cache-context
(ebox--flex-window-cache-context node)))))
@ -2498,7 +2498,7 @@ Return nil when NODE's flex configuration needs a full rerender."
(lines (ebox--flex-break-lines items main-size main-gap wrap)))
(when (eq wrap 'wrap-reverse)
(setq lines (nreverse lines)))
(when-let ((line
(when-let* ((line
(cl-find-if
(lambda (candidate)
(cl-some

6
ebox-fragment.el
View File

@ -164,19 +164,19 @@ Backend marker and buffer span data are intentionally excluded."
"Return NODE's display, layout, flex, and paint style signature."
(when (listp node)
(let ((signature (list :display (ebox--computed-display node))))
(when-let ((style-node (ebox-fragment-style-source-node node)))
(when-let* ((style-node (ebox-fragment-style-source-node node)))
(dolist (key ebox--style-signature-keys)
(when (plist-member style-node key)
(setq signature
(plist-put signature key (plist-get style-node key)))))
(when-let ((participation (ebox--flex-participation-props style-node)))
(when-let* ((participation (ebox--flex-participation-props style-node)))
(setq signature
(plist-put signature :flex-participation participation))))
(when (eq (ebox--display-inner node) 'flex)
(setq signature
(plist-put signature :flex-props
(plist-get node :props))))
(when-let ((participation (ebox--flex-participation-props node)))
(when-let* ((participation (ebox--flex-participation-props node)))
(setq signature
(plist-put signature :flex-participation participation)))
signature)))

4
ebox-grid.el
View File

@ -381,7 +381,7 @@ letting the grid fall back to each child's intrinsic width."
(defun ebox-grid--clamp-track-size (track size)
"Clamp SIZE to TRACK's fixed maximum when one exists."
(if-let ((maximum (ebox-grid--track-max track)))
(if-let* ((maximum (ebox-grid--track-max track)))
(min size maximum)
size))
@ -607,7 +607,7 @@ size for start/center/end alignment unless it would overflow its track."
(defun ebox--render-grid-box (node rendered)
"Render grid NODE's optional visual wrapper around RENDERED."
(if-let ((box (plist-get node :box)))
(if-let* ((box (plist-get node :box)))
(let ((copy (copy-sequence box))
(region-id (ebox--ensure-region-id box)))
(plist-put copy :region-id region-id)

168
ebox-incremental.el
View File

@ -730,7 +730,7 @@ This normally does no work. It rebuilds metadata only after a defensive
(defun ebox--render-cache-replay-entry-side-effects (entry)
"Replay ENTRY's scroll side effects before its rendered output is reused."
(when-let ((metadata
(when-let* ((metadata
(gethash entry ebox--render-cache-entry-side-effects-table)))
(ebox--replay-scroll-cache-actions
(plist-get metadata :scroll-actions)
@ -788,7 +788,7 @@ This normally does no work. It rebuilds metadata only after a defensive
(pcase kind
('viewport t)
('root-width
(when-let ((box (ebox--root-region-box node region-id)))
(when-let* ((box (ebox--root-region-box node region-id)))
(equal (ebox--literal-root-pixel-width box)
(plist-get prepared :root-width))))
(_ nil)))))
@ -848,7 +848,7 @@ This normally does no work. It rebuilds metadata only after a defensive
"Return NODE's exact cache context, with `:rendered' when reusable.
FORCE includes the complete viewport context in the cache signature.
EXTERNAL-SIGNATURE may prove a viewport-dependent non-root context."
(when-let ((context
(when-let* ((context
(ebox--render-cache-context
node force external-signature)))
(let* ((ebox--render-cache-table (plist-get context :cache))
@ -883,7 +883,7 @@ EXTERNAL-SIGNATURE may prove a viewport-dependent non-root context."
When FORCE is non-nil, cache NODE even when its output is viewport-dependent;
the complete viewport context remains part of the render signature.
CACHE-PROBE may supply a prior exact miss from an accelerator boundary."
(if-let ((prepared (and force
(if-let* ((prepared (and force
(ebox--take-prepared-root-render node))))
(prog1 prepared
(ebox--replay-render-output-provenance prepared)
@ -981,7 +981,7 @@ Keys are region-id, values are plists with :scroll-offset, :content-lines, etc."
(defun ebox--buffer-root-node-id (buffer)
"Return BUFFER's root runtime node id."
(when-let ((root (ebox--buffer-root-node buffer)))
(when-let* ((root (ebox--buffer-root-node buffer)))
(ebox--ensure-node-id root)))
(defun ebox--runtime-region-id-conflict (region-id-set target-buffer)
@ -992,7 +992,7 @@ Keys are region-id, values are plists with :scroll-offset, :content-lines, etc."
(maphash
(lambda (buffer state)
(unless (eq buffer target)
(when-let ((owner-set (plist-get state :region-id-set)))
(when-let* ((owner-set (plist-get state :region-id-set)))
(maphash
(lambda (region-id _present)
(when (gethash region-id owner-set)
@ -1004,7 +1004,7 @@ Keys are region-id, values are plists with :scroll-offset, :content-lines, etc."
(defun ebox-incremental--adjust-runtime-type-count (table node delta)
"Adjust NODE's raw selector-type count in TABLE by DELTA."
(when-let ((type (ebox-tree-node-selector-type node)))
(when-let* ((type (ebox-tree-node-selector-type node)))
(let ((count (+ (or (gethash type table) 0) delta)))
(cond
((< count 0)
@ -1028,7 +1028,7 @@ same traversal in complete-render overwrite order."
(runtime-type-count-table (make-hash-table :test 'eq))
native-node-postorder range-sequence-p)
(cl-labels ((index-host-ref (node node-id)
(when-let ((host-ref (plist-get node :host-ref)))
(when-let* ((host-ref (plist-get node :host-ref)))
(let ((count (hash-table-count host-ref-table)))
(puthash host-ref node-id host-ref-table)
(when (= count (hash-table-count host-ref-table))
@ -1051,7 +1051,7 @@ same traversal in complete-render overwrite order."
(unless (gethash region-id region-node-table)
(puthash region-id node-id region-node-table))))
('flex
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(let ((region-id (ebox--ensure-region-id box)))
(puthash region-id t region-id-set)
;; Preserve the recursive lookup's first-match
@ -1070,7 +1070,7 @@ same traversal in complete-render overwrite order."
(puthash (ebox--ensure-region-id node)
node region-box-table))
('flex
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(puthash (ebox--ensure-region-id box)
box region-box-table))))))
(visit (node parent-id native-layout-p)
@ -1085,7 +1085,7 @@ same traversal in complete-render overwrite order."
(puthash node-id parent-id parent-table))
(index-region-id node node-id)
(index-host-ref node node-id)
(when-let ((sequence (plist-get node :ebox-child-sequence)))
(when-let* ((sequence (plist-get node :ebox-child-sequence)))
(setq range-sequence-p t)
(dotimes
(segment-index
@ -1242,7 +1242,7 @@ same traversal in complete-render overwrite order."
"Return REGION-ID's smallest render-owner node id in BUFFER.
Use the persistent runtime index when available. Legacy runtime states that
lack the index, or an indexed entry, fall back to a recursive tree lookup."
(or (when-let ((table (ebox--buffer-region-node-table buffer)))
(or (when-let* ((table (ebox--buffer-region-node-table buffer)))
(gethash region-id table))
(when-let* ((root (ebox--buffer-root-node buffer))
(path (ebox--node-path-to-region root region-id)))
@ -1252,7 +1252,7 @@ lack the index, or an indexed entry, fall back to a recursive tree lookup."
"Return REGION-ID's smallest render-owner node in BUFFER.
Use both persistent runtime indexes in the normal path. Fall back to the
recursive region path only for legacy or incomplete runtime state."
(when-let ((node-id
(when-let* ((node-id
(ebox--buffer-region-render-owner-node-id buffer region-id)))
(ebox--buffer-runtime-node buffer node-id)))
@ -1286,7 +1286,7 @@ recursive region path only for legacy or incomplete runtime state."
Discard the isolated reflow scratch tree unless
PRESERVE-REFLOW-PREWARM-SCRATCH is non-nil. Callers may preserve it only
while validating one predicted root-width mutation against the new revision."
(when-let ((state (ebox--buffer-render-state buffer)))
(when-let* ((state (ebox--buffer-render-state buffer)))
(let ((revision
(1+ (or (plist-get state :runtime-revision) 0))))
(plist-put state :runtime-revision revision)
@ -1296,7 +1296,7 @@ while validating one predicted root-width mutation against the new revision."
(defun ebox--buffer-viewport-dependent-node-id-axes (buffer)
"Return cached viewport-dependent node ids by axis for BUFFER."
(when-let ((state (ebox--buffer-render-state buffer)))
(when-let* ((state (ebox--buffer-render-state buffer)))
(if (and (plist-get state :viewport-dependent-node-ids-ready)
(plist-member state :viewport-dependent-node-id-axes))
(plist-get state :viewport-dependent-node-id-axes)
@ -1320,13 +1320,13 @@ while validating one predicted root-width mutation against the new revision."
(defun ebox--buffer-viewport-dependent-node-ids (buffer)
"Return cached viewport-dependent node ids for BUFFER."
(when-let ((state (ebox--buffer-render-state buffer)))
(when-let* ((state (ebox--buffer-render-state buffer)))
(ebox--buffer-viewport-dependent-node-id-axes buffer)
(plist-get state :viewport-dependent-node-ids)))
(defun ebox--invalidate-buffer-viewport-dependencies (buffer)
"Invalidate BUFFER's cached viewport dependency list."
(when-let ((state (ebox--buffer-render-state buffer)))
(when-let* ((state (ebox--buffer-render-state buffer)))
(plist-put state :viewport-dependent-node-ids nil)
(plist-put state :viewport-dependent-node-id-axes nil)
(plist-put state :viewport-dependent-node-ids-ready nil)))
@ -1380,9 +1380,9 @@ while validating one predicted root-width mutation against the new revision."
(defun ebox--layout-snapshot (buffer node-id)
"Return BUFFER's layout snapshot for NODE-ID."
(when-let ((snapshots (ebox--ensure-buffer-layout-snapshots buffer)))
(when-let* ((snapshots (ebox--ensure-buffer-layout-snapshots buffer)))
(let ((snapshot (or (gethash node-id snapshots)
(when-let ((node (ebox--snapshot-published-node
(when-let* ((node (ebox--snapshot-published-node
buffer node-id)))
(let ((created
(ebox--node-layout-snapshot
@ -1439,12 +1439,12 @@ Use `ebox--with-layout-snapshot-index-context' for batch snapshot capture."
"Return a copy of BUFFER's current layout snapshot table.
When DETAILS is non-nil, include derived buffer spans and line signatures in
the returned copy without mutating BUFFER's stored snapshot table."
(when-let ((state (ebox--buffer-render-state buffer)))
(when-let* ((state (ebox--buffer-render-state buffer)))
(when (and (plist-get state :root-node)
(not (plist-get state :layout-snapshots-complete-p)))
(ebox--refresh-buffer-layout-snapshots buffer details)))
(let ((copy (make-hash-table :test 'equal)))
(when-let ((snapshots (ebox--ensure-buffer-layout-snapshots buffer)))
(when-let* ((snapshots (ebox--ensure-buffer-layout-snapshots buffer)))
(let (entries)
(maphash (lambda (node-id snapshot)
(push (cons node-id
@ -1479,9 +1479,9 @@ the returned copy without mutating BUFFER's stored snapshot table."
(defun ebox--clear-layout-snapshots (buffer)
"Clear BUFFER's layout snapshots."
(when-let ((state (ebox--buffer-render-state buffer)))
(when-let* ((state (ebox--buffer-render-state buffer)))
(plist-put state :layout-snapshots-complete-p nil))
(when-let ((snapshots (ebox--ensure-buffer-layout-snapshots buffer)))
(when-let* ((snapshots (ebox--ensure-buffer-layout-snapshots buffer)))
(clrhash snapshots)))
(defun ebox--plist-remove-key (plist key)
@ -1505,8 +1505,8 @@ the returned copy without mutating BUFFER's stored snapshot table."
"Remove stored buffer-owned runtime state for BUFFER.
Defaults to the current buffer."
(let ((buffer (or buffer (current-buffer))))
(when-let ((cache (ebox--buffer-render-cache buffer)))
(when-let ((root-cache
(when-let* ((cache (ebox--buffer-render-cache buffer)))
(when-let* ((root-cache
(gethash cache ebox--render-root-cache-table-table)))
(remhash root-cache ebox--render-cache-ring-table))
(remhash cache ebox--render-root-cache-table-table)
@ -1543,7 +1543,7 @@ Defaults to the current buffer."
(dolist (region-id (get-text-property pos 'ebox-content-owners))
(cl-pushnew region-id ids :test #'equal))
(dolist (entry ebox-region-types)
(when-let ((region-id (get-text-property pos (cdr entry))))
(when-let* ((region-id (get-text-property pos (cdr entry))))
(cl-pushnew region-id ids :test #'equal)))
ids))
@ -1551,7 +1551,7 @@ Defaults to the current buffer."
"Return all ebox region role/id pairs present at POS."
(let (role-ids)
(dolist (entry ebox-region-types)
(when-let ((region-id (get-text-property pos (cdr entry))))
(when-let* ((region-id (get-text-property pos (cdr entry))))
(push (cons (car entry) region-id) role-ids)))
role-ids))
@ -1572,7 +1572,7 @@ Defaults to the current buffer."
(let ((map (make-hash-table :test 'eql)))
(puthash region-id map region-lines)
map))))
(if-let ((range (gethash line-number line-map)))
(if-let* ((range (gethash line-number line-map)))
(setcdr range (max (cdr range) end))
(puthash line-number (cons start end) line-map))))
@ -1681,10 +1681,10 @@ therefore unsafe."
(candidate-lines (make-hash-table :test 'eql))
spans)
(dolist (region-id region-ids)
(when-let ((line-map (gethash region-id region-lines)))
(when-let* ((line-map (gethash region-id region-lines)))
(maphash
(lambda (line-number range)
(if-let ((existing (gethash line-number candidate-lines)))
(if-let* ((existing (gethash line-number candidate-lines)))
(progn
(setcar existing (min (car existing) (car range)))
(setcdr existing (max (cdr existing) (cdr range))))
@ -1728,7 +1728,7 @@ therefore unsafe."
(range-start (max (point) line-start))
(range-end (min end line-end)))
(when (< range-start range-end)
(if-let ((existing (gethash line-start line-ranges)))
(if-let* ((existing (gethash line-start line-ranges)))
(progn
(setcar existing (min (car existing) range-start))
(setcdr existing (max (cdr existing) range-end)))
@ -2032,10 +2032,10 @@ the planning pass has one for this buffer."
(defun ebox--ensure-layout-snapshot-spans (buffer node-id)
"Ensure BUFFER's stored snapshot for NODE-ID has buffer span details."
(when-let ((snapshot (ebox--layout-snapshot buffer node-id)))
(when-let* ((snapshot (ebox--layout-snapshot buffer node-id)))
(if (ebox--layout-snapshot-spans-p snapshot)
snapshot
(when-let ((node (ebox--snapshot-published-node buffer node-id)))
(when-let* ((node (ebox--snapshot-published-node buffer node-id)))
(let ((detailed
(ebox--with-layout-snapshot-detail-context buffer
(ebox--complete-layout-snapshot-spans
@ -2045,10 +2045,10 @@ the planning pass has one for this buffer."
(defun ebox--ensure-layout-snapshot-details (buffer node-id)
"Ensure BUFFER's stored snapshot for NODE-ID has expensive detail fields."
(when-let ((snapshot (ebox--layout-snapshot buffer node-id)))
(when-let* ((snapshot (ebox--layout-snapshot buffer node-id)))
(if (ebox--layout-snapshot-detailed-p snapshot)
snapshot
(when-let ((node (ebox--snapshot-published-node buffer node-id)))
(when-let* ((node (ebox--snapshot-published-node buffer node-id)))
(let ((detailed
(ebox--with-layout-snapshot-detail-context buffer
(ebox--complete-layout-snapshot buffer node snapshot))))
@ -2069,14 +2069,14 @@ When DETAILS is non-nil, include expensive per-line detail fields."
(defun ebox--refresh-buffer-layout-snapshots (buffer &optional details)
"Recapture BUFFER's layout snapshots from its stored runtime root.
When DETAILS is non-nil, include expensive per-line detail fields."
(when-let ((root (ebox--buffer-root-node buffer)))
(when-let* ((root (ebox--buffer-root-node buffer)))
(ebox--clear-layout-snapshots buffer)
(let ((ebox--node-region-ids-cache (make-hash-table :test 'eq)))
(if details
(ebox--with-layout-snapshot-index-context buffer
(ebox--capture-layout-snapshots buffer root t))
(ebox--capture-layout-snapshots buffer root)))
(when-let ((state (ebox--buffer-render-state buffer)))
(when-let* ((state (ebox--buffer-render-state buffer)))
(plist-put state :layout-snapshots-complete-p t))))
(defconst ebox--dirty-kind-order
@ -2170,14 +2170,14 @@ When DETAILS is non-nil, include expensive per-line detail fields."
(car ebox-incremental--candidate-proof-node-table))
(gethash node-id
(cdr ebox-incremental--candidate-proof-node-table)))
(when-let ((node-table (ebox--buffer-node-table buffer)))
(when-let* ((node-table (ebox--buffer-node-table buffer)))
(gethash node-id node-table))
(when-let ((root (ebox--buffer-root-node buffer)))
(when-let* ((root (ebox--buffer-root-node buffer)))
(ebox--runtime-node-by-id root node-id))))
(defun ebox--runtime-parent-id (buffer node-id)
"Return NODE-ID's parent id in BUFFER runtime state."
(when-let ((parent-table (ebox--buffer-parent-table buffer)))
(when-let* ((parent-table (ebox--buffer-parent-table buffer)))
(gethash node-id parent-table)))
(defun ebox--invalidate-runtime-render-signature-path
@ -2188,7 +2188,7 @@ When DETAILS is non-nil, include expensive per-line detail fields."
(when signature-cache (clrhash signature-cache))
(when height-cache (clrhash height-cache)))
(while node-id
(when-let ((node (gethash node-id node-table)))
(when-let* ((node (gethash node-id node-table)))
(when signature-cache (remhash node signature-cache))
(when height-cache (remhash node height-cache)))
(setq node-id (gethash node-id parent-table)))))
@ -2303,7 +2303,7 @@ checks pays one walk per distinct node instead of one walk per pair."
(defun ebox--dirty-provenance-node-ids (dirty)
"Return the distinct source node ids recorded by DIRTY provenance."
(delete-dups
(append (when-let ((node-id (plist-get dirty :node-id)))
(append (when-let* ((node-id (plist-get dirty :node-id)))
(list node-id))
(copy-sequence (or (plist-get dirty :node-ids) nil)))))
@ -2412,7 +2412,7 @@ checks pays one walk per distinct node instead of one walk per pair."
(remaining (if same-owner
(delq same-owner (copy-sequence ops))
(copy-sequence ops))))
(if-let ((dominator
(if-let* ((dominator
(cl-find-if
(lambda (op)
(ebox--patch-op-dominates-p buffer op candidate))
@ -2684,7 +2684,7 @@ When BUFFER is non-nil, non-paint entries promote to patchable owners."
(ebox--patch-op 'paint-patch node-id
:dirty entry))
(_
(if-let ((span-owner-id
(if-let* ((span-owner-id
(and buffer
(ebox--span-patch-owner-id-for-dirty-entry
entry buffer))))
@ -2909,7 +2909,7 @@ cross-axis keys change its row footprint, exactly the pair
"Return FLEX-NODE's child whose source owns NODE-ID."
(cl-find-if
(lambda (child)
(when-let ((source (ebox--flex-item-source-node child)))
(when-let* ((source (ebox--flex-item-source-node child)))
(equal (plist-get source :node-id) node-id)))
(ebox-tree-layout-children flex-node)))
@ -2969,7 +2969,7 @@ is still verified by the existing rendered slot-footprint proof."
Unknown changes fail closed. A fixed outer size is insufficient for content
updates unless the auto flex basis stays fixed and the new minimum still fits
the already published slot."
(when-let ((style-node (ebox-fragment-style-source-node node)))
(when-let* ((style-node (ebox-fragment-style-source-node node)))
(let* ((item-props (ebox--flex-item-props child))
(fixed-basis-p
(ebox--flex-fixed-basis-content-allocation-stable-p
@ -3223,7 +3223,7 @@ running expensive span and snapshot checks."
(defun ebox--span-patchable-owner-p (buffer node-id)
"Return non-nil when NODE-ID can attempt verified span patching."
(when-let ((node (ebox--buffer-runtime-node buffer node-id)))
(when-let* ((node (ebox--buffer-runtime-node buffer node-id)))
(and ;; Planning only needs to reject an explicitly visible overflow
;; owner. Content-dependent overflow remains part of the final
;; span/role validator; formatting it here for every ancestor made
@ -3233,7 +3233,7 @@ running expensive span and snapshot checks."
;; Allocation shape is coordinate-independent and survives a
;; detail-generation bump. The later owner/surface proof still
;; resolves exact current spans before publication.
(when-let ((snapshot (ebox--layout-snapshot buffer node-id)))
(when-let* ((snapshot (ebox--layout-snapshot buffer node-id)))
(plist-get snapshot :allocation-shape))
(when-let* ((snapshot
(ebox--ensure-layout-snapshot-spans buffer node-id))
@ -3424,7 +3424,7 @@ hash lookups instead of a scan of the whole set."
(dominator nil))
(maphash
(lambda (ancestor-id _present)
(when-let ((entry (gethash ancestor-id owner-table)))
(when-let* ((entry (gethash ancestor-id owner-table)))
(when (and (>= (ebox--patch-operation-strength
(plist-get (aref entry 0) :op))
(ebox--patch-operation-strength 'span-patch))
@ -3561,7 +3561,7 @@ When NIL-DEPENDENT is non-nil, nil is treated as viewport-dependent auto width."
(defun ebox--flex-participation-viewport-dependent-p (node)
"Return non-nil when NODE's flex item metadata depends on viewport context."
(when-let ((participation (ebox--flex-participation-props node)))
(when-let* ((participation (ebox--flex-participation-props node)))
(ebox--viewport-dependent-size-value-p
(plist-get participation :flex-basis))))
@ -3674,7 +3674,7 @@ Definite width contains descendant width ids, but not height ids."
(defun ebox--viewport-dependent-node-ids (node)
"Return runtime node ids under NODE that depend on viewport context."
(when-let ((axes (ebox--viewport-dependent-node-id-axes node)))
(when-let* ((axes (ebox--viewport-dependent-node-id-axes node)))
(delete-dups (copy-sequence (append (car axes) (cdr axes))))))
(defun ebox--viewport-dirty-set (root)
@ -3688,7 +3688,7 @@ Definite width contains descendant width ids, but not height ids."
"Return the implicit viewport constraint change for BUFFER.
AXES may be `width', `height', `both', or `none'. Nil means both axes for
legacy callers."
(when-let ((root (ebox--buffer-root-node buffer)))
(when-let* ((root (ebox--buffer-root-node buffer)))
(let* ((node-ids
(pcase axes
('width
@ -3860,7 +3860,7 @@ during `ebox-incremental-flush'."
(defun ebox-incremental--batch-change (buffer pending)
"Return a normalized batch constraint change for BUFFER and PENDING."
(when-let ((root (ebox--buffer-root-node buffer)))
(when-let* ((root (ebox--buffer-root-node buffer)))
(ebox--constraint-change
'batch 'batch 'batch
(ebox--ensure-node-id root)
@ -4624,7 +4624,7 @@ Cost is proportional to the replacements, never to the page."
(when (and sibling-id
(not (equal sibling-id node-id))
(equal (plist-get
(if-let
(if-let*
((sibling-replacement
(ebox-incremental--candidate-replacement-for-anchor
entries sibling-id)))
@ -4639,14 +4639,14 @@ Cost is proportional to the replacements, never to the page."
;; Host refs must be fresh or freed by this same commit.
(when host-ref-table
(dolist (ref (collect-host-refs replacement nil))
(when-let ((existing-anchor
(when-let* ((existing-anchor
(gethash ref replacement-host-refs)))
(unless (or (ancestor-p existing-anchor node-id)
(ancestor-p node-id existing-anchor))
(error "Ebox declarative host reference %S is not unique"
ref)))
(puthash ref node-id replacement-host-refs)
(when-let ((owner-id (gethash ref host-ref-table)))
(when-let* ((owner-id (gethash ref host-ref-table)))
(unless (inside-replaced-anchor-p owner-id)
(error
"Ebox declarative host reference %S is not unique"
@ -4654,7 +4654,7 @@ Cost is proportional to the replacements, never to the page."
(defun ebox-incremental--copy-detached-history (state)
"Return an unpublished detached identity history copied from STATE."
(if-let ((history (plist-get state :detached-identity-history)))
(if-let* ((history (plist-get state :detached-identity-history)))
(ebox-incremental--make-detached-history
:table
(copy-hash-table
@ -4932,13 +4932,13 @@ but must re-enter the candidate indexes as a new object."
(let ((table (copy-hash-table (plist-get old-state :range-ref-table))))
(cl-labels
((walk (node function)
(when-let ((sequence (plist-get node :ebox-child-sequence)))
(when-let* ((sequence (plist-get node :ebox-child-sequence)))
(dolist (record (ebox-child-range--range-records sequence))
(funcall function node record)))
(dolist (child (ebox-tree--children-raw node))
(walk child function))))
(dolist (anchor anchors)
(when-let ((old (gethash (car anchor)
(when-let* ((old (gethash (car anchor)
(plist-get old-state :node-table))))
(walk old
(lambda (_parent record)
@ -5424,13 +5424,13 @@ Return the same pure surface-input shape as
(when (hash-table-p old-snapshots)
(maphash
(lambda (node-id _node)
(when-let ((snapshot (gethash node-id old-snapshots)))
(when-let* ((snapshot (gethash node-id old-snapshots)))
(puthash node-id (copy-sequence snapshot) snapshots)))
candidate-node-table)
;; A root type replacement receives a fresh runtime id, but its patch
;; owner still covers the currently published complete-buffer geometry.
(unless (equal old-root-id candidate-root-id)
(when-let ((snapshot (gethash old-root-id old-snapshots)))
(when-let* ((snapshot (gethash old-root-id old-snapshots)))
(setq snapshot (copy-sequence snapshot))
(setq snapshot (plist-put snapshot :node-id candidate-root-id))
(puthash candidate-root-id snapshot snapshots))))
@ -5536,14 +5536,14 @@ Return the same pure surface-input shape as
(defun ebox-incremental--simple-new-child-splice-p
(buffer owner-id dirty)
"Return non-nil when DIRTY is a cheap vertical child splice."
(when-let ((owner (ebox--buffer-runtime-node buffer owner-id)))
(when-let* ((owner (ebox--buffer-runtime-node buffer owner-id)))
(pcase-let* ((old-ids (plist-get dirty :old-child-ids))
(new-ids (plist-get dirty :new-child-ids))
(`(,_old-middle ,new-middle)
(ebox-incremental--child-list-middle old-ids new-ids)))
(and (eq (plist-get owner :ebox-type) 'stack)
(eq (ebox-tree-display-inner owner) 'column)
(when-let ((snapshot
(when-let* ((snapshot
(ebox--ensure-layout-snapshot-spans
buffer owner-id)))
(unless (with-current-buffer buffer
@ -5593,10 +5593,10 @@ Return the same pure surface-input shape as
((hash-table-p owned-table)))
(copy-hash-table owned-table)
(let ((table (make-hash-table :test 'equal)))
(when-let ((region-id-set (plist-get state :region-id-set)))
(when-let* ((region-id-set (plist-get state :region-id-set)))
(maphash
(lambda (region-id _present)
(when-let ((box (gethash region-id ebox--region-box-table)))
(when-let* ((box (gethash region-id ebox--region-box-table)))
(puthash region-id box table)))
region-id-set))
table)))
@ -5636,7 +5636,7 @@ Return the same pure surface-input shape as
(ebox--ensure-node-id node)
node))
('flex
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box)
(ebox--ensure-node-id node)
box)))))
@ -5680,7 +5680,7 @@ complete preorder first-owner and postorder last-box semantics."
(cl-labels
((visit (node)
(when (and (listp node) (not (stringp node)))
(when-let ((record
(when-let* ((record
(ebox-incremental--candidate-node-region-record node)))
(pcase-let ((`(,region-id ,owner-id ,_box) record))
(when (gethash region-id region-ids)
@ -5689,7 +5689,7 @@ complete preorder first-owner and postorder last-box semantics."
(puthash region-id owner-id region-node-table)))))
(dolist (child (ebox--node-children node))
(visit child))
(when-let ((record
(when-let* ((record
(ebox-incremental--candidate-node-region-record node)))
(pcase-let ((`(,region-id ,_owner-id ,box) record))
(when (gethash region-id region-ids)
@ -6009,10 +6009,10 @@ replace those O(n) table copies without changing this delta contract."
runtime-type-count-table node -1)
(remhash node-id node-table)
(remhash node-id parent-table)
(when-let ((host-ref (plist-get node :host-ref)))
(when-let* ((host-ref (plist-get node :host-ref)))
(when (equal (gethash host-ref host-ref-table) node-id)
(remhash host-ref host-ref-table)))
(when-let ((record
(when-let* ((record
(ebox-incremental--candidate-node-region-record node)))
(puthash (car record) t affected-region-ids))
(when (hash-table-p old-region-box-count-table)
@ -6035,7 +6035,7 @@ replace those O(n) table copies without changing this delta contract."
(when old-node
(ebox-incremental--adjust-runtime-type-count
runtime-type-count-table old-node -1)
(when-let ((record
(when-let* ((record
(ebox-incremental--candidate-node-region-record
old-node)))
(puthash (car record) t affected-region-ids))
@ -6050,9 +6050,9 @@ replace those O(n) table copies without changing this delta contract."
(remhash node-id parent-table))
;; Replacement subtrees were validated before recording and
;; checked against untouched Host refs before path copying.
(when-let ((new-host-ref (plist-get new-node :host-ref)))
(when-let* ((new-host-ref (plist-get new-node :host-ref)))
(puthash new-host-ref node-id host-ref-table))
(when-let ((record
(when-let* ((record
(ebox-incremental--candidate-node-region-record
new-node)))
(puthash (car record) t affected-region-ids))
@ -6080,7 +6080,7 @@ replace those O(n) table copies without changing this delta contract."
;; TOUCHED is preorder, matching `ebox--runtime-index' ownership:
;; a flex owner claims its wrapper before the wrapper box is visited.
(dolist (entry touched)
(when-let ((record
(when-let* ((record
(ebox-incremental--candidate-node-region-record
(nth 1 entry))))
(pcase-let ((`(,region-id ,owner-id ,box) record))
@ -6221,7 +6221,7 @@ CANDIDATE-INDEX is the prepared runtime index for CANDIDATE-ROOT."
dirty)
(maphash
(lambda (node-id new-node)
(when-let ((old-node (gethash node-id old-table)))
(when-let* ((old-node (gethash node-id old-table)))
(let* ((changed-keys
(ebox-tree-node-local-changed-keys
old-node new-node))
@ -6367,7 +6367,7 @@ candidate therefore owns its cache tables until TP commits the generation."
(hash-table-p candidate-node-table))
(maphash
(lambda (node-id candidate-node)
(when-let ((old-node (gethash node-id old-node-table)))
(when-let* ((old-node (gethash node-id old-node-table)))
(let ((cached (gethash old-node old-cache missing)))
(unless (eq cached missing)
(puthash candidate-node cached candidate-cache)))))
@ -6391,7 +6391,7 @@ must be recomputed in the next publication."
old-node-table old-parent-table
candidate-cache nil))
(dolist (node-id (append touched-node-ids removed-node-ids))
(when-let ((old-node (gethash node-id old-node-table)))
(when-let* ((old-node (gethash node-id old-node-table)))
(remhash old-node candidate-cache)))
candidate-cache))
@ -6606,7 +6606,7 @@ must be recomputed in the next publication."
('geometry
(ebox--patch-op-from-dirty-entry entry buffer))
(_
(if-let ((span-owner-id
(if-let* ((span-owner-id
(ebox--span-patch-owner-id-for-dirty-entry entry buffer)))
(ebox--patch-op 'span-patch span-owner-id :dirty entry)
(when (and (eq dirty-kind 'structure)
@ -6898,7 +6898,7 @@ It never partitions larger dirty sets, preserving their existing coalescing."
;; One dirty entry needs no dominance/coalescing pass. Build
;; its tentative operation directly; the exact span or
;; allocation proof below still owns authorization.
(when-let ((op
(when-let* ((op
(ebox-incremental--declarative-tentative-op
buffer dirty)))
(list op)))
@ -7500,7 +7500,7 @@ rendered into its retained slot and must pass the complete footprint proof."
(index (ebox--make-patch-op-merge-index))
ops)
(ebox--with-layout-snapshot-detail-context buffer
(if-let ((coalesced-op
(if-let* ((coalesced-op
(and (not
(ebox-incremental--dirty-set-has-child-splice-p
buffer render-dirty-set))
@ -7555,7 +7555,7 @@ rendered into its retained slot and must pass the complete footprint proof."
(defun ebox-incremental--layout-owner-plan
(buffer old-state candidate-state dirty-set)
"Return BUFFER layout-owner plan from OLD-STATE to CANDIDATE-STATE for DIRTY-SET."
(when-let ((render-dirty-set
(when-let* ((render-dirty-set
(cl-remove-if
(lambda (entry)
(eq (plist-get entry :dirty-kind) 'metadata))
@ -7591,7 +7591,7 @@ closure may still plan one for a later owner-scoped surface projection."
(cl-some
(lambda (entry)
(and (eq (plist-get entry :dirty-kind) 'structure)
(when-let ((object
(when-let* ((object
(gethash (plist-get entry :node-id)
objects)))
(null (gethash object style-states)))))
@ -7636,7 +7636,7 @@ closure may still plan one for a later owner-scoped surface projection."
(defun ebox-incremental--root-owner-plan (buffer dirty-set)
"Return one conservative root owner operation for DIRTY-SET."
(when-let ((root-id (ebox--buffer-root-node-id buffer)))
(when-let* ((root-id (ebox--buffer-root-node-id buffer)))
(list
(ebox--patch-op
'owner-rerender root-id
@ -7645,7 +7645,7 @@ closure may still plan one for a later owner-scoped surface projection."
(defun ebox-incremental--native-frame-plan (buffer dirty-set)
"Return the bounded publication plan for a complete native frame."
(when-let ((root-id (ebox--buffer-root-node-id buffer)))
(when-let* ((root-id (ebox--buffer-root-node-id buffer)))
(list
(ebox--patch-op
'native-frame root-id

16
ebox-layout.el
View File

@ -865,7 +865,7 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values."
(and (consp value)
(or (eq (car value) 'viewport-height)
(memq (car value) '(+ -)))))
(if-let ((height (ebox--resolve-height-expression-lines value)))
(if-let* ((height (ebox--resolve-height-expression-lines value)))
(ebox--box-sizing-content-height box (max 0 height))
fallback))
(t
@ -925,7 +925,7 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values."
(defun ebox--box-content (box)
"Return BOX content, rendering any lazy child layout content if present."
(ebox--propertize-typography
(or (when-let ((node (ebox--box-content-node box)))
(or (when-let* ((node (ebox--box-content-node box)))
(ebox--render-box-content-node box node))
(ebox-get box :content))
box))
@ -980,7 +980,7 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values."
(defun ebox--stretch-content-pixel (box)
"Return BOX's stretch-fit content width, or nil without a viewport."
(when-let ((viewport (ebox--viewport-pixel-width nil)))
(when-let* ((viewport (ebox--viewport-pixel-width nil)))
(max 0 (- viewport (ebox--side-pixel box)))))
(defun ebox--fit-content-pixel (box limit)
@ -1000,7 +1000,7 @@ Return nil for intrinsic sizes such as min-content and max-content."
(cond
((null value) nil)
((ebox--viewport-size-value-p value)
(when-let ((viewport (ebox--viewport-pixel-width nil)))
(when-let* ((viewport (ebox--viewport-pixel-width nil)))
(ebox--box-sizing-content-pixel box viewport)))
((numberp value)
(ebox--box-sizing-content-pixel box value))
@ -1010,7 +1010,7 @@ Return nil for intrinsic sizes such as min-content and max-content."
(let ((limit (cadr value)))
(cond
((ebox--viewport-size-value-p limit)
(when-let ((viewport (ebox--viewport-pixel-width nil)))
(when-let* ((viewport (ebox--viewport-pixel-width nil)))
(ebox--box-sizing-content-pixel box viewport)))
((numberp limit)
(ebox--box-sizing-content-pixel box limit))
@ -1087,7 +1087,7 @@ FALLBACK is used for nil and auto values."
(cond
((null value) fallback)
((eq value 'viewport)
(if-let ((viewport (ebox--viewport-pixel-width nil)))
(if-let* ((viewport (ebox--viewport-pixel-width nil)))
(ebox--box-sizing-content-pixel box viewport)
fallback))
((numberp value)
@ -2153,7 +2153,7 @@ last cached leaf instead of walking the stack from the beginning."
(defun ebox--scroll-window-content-height (box)
"Return BOX's definite scroll content height, or nil."
(when-let ((fixed-height
(when-let* ((fixed-height
(ebox--resolve-size-content-height
box (ebox-get box :height) nil)))
(ebox--content-height box fixed-height)))
@ -2706,7 +2706,7 @@ no included vertical margin."
(ebox--propertize-underline
(car tail) border-bottom-color)
'ebox-bb region-id))))
(when-let ((properties (ebox-get box :surface-properties)))
(when-let* ((properties (ebox-get box :surface-properties)))
(setq lines
(mapcar (lambda (line)
(ebox--apply-surface-properties line properties))

6
ebox-native-commit.el
View File

@ -112,7 +112,7 @@
do (puthash (plist-get child :node-id)
(cons parent-id position) table)))
nodes)
(when-let ((root (plist-get state :root-node)))
(when-let* ((root (plist-get state :root-node)))
(puthash (plist-get root :node-id) (cons nil 0) table)))
table))
@ -391,7 +391,7 @@ type, key, parent, and sibling position are identical."
(defun ebox-native-commit--promote-pending-frame (state session)
"Promote STATE's previously published pending frame in SESSION."
(when-let ((pending (plist-get state :native-sync-pending)))
(when-let* ((pending (plist-get state :native-sync-pending)))
(ebox-native-reflow-confirm-native-frame
session (plist-get pending :generation) (plist-get pending :key)
(plist-get pending :confirmed-revision))
@ -485,7 +485,7 @@ Return nil without mutating STATE when the native capability proof is absent."
(memq (plist-get state :projection-kind) '(nil native-frame))
(ebox-native-commit--runtime-types-supported-p state)
(ebox-native-commit--region-index-safe-p state))
(when-let ((frame-spec (ebox-native-commit--frame-spec state node)))
(when-let* ((frame-spec (ebox-native-commit--frame-spec state node)))
(condition-case err
(let* ((frame (ebox-native-commit--retained-frame
state node frame-spec))

56
ebox-native-reflow.el
View File

@ -103,7 +103,7 @@
(defun ebox-native-reflow--rust-target ()
"Return the Rust target triple matching the current Emacs binary."
(when-let ((architecture (ebox-native-reflow--rust-architecture)))
(when-let* ((architecture (ebox-native-reflow--rust-architecture)))
(pcase system-type
('darwin (format "%s-apple-darwin" architecture))
('gnu/linux (format "%s-unknown-linux-gnu" architecture))
@ -339,7 +339,7 @@ validation.")
(defun ebox-native-reflow--candidate-paths ()
"Return the sole configured native module candidate path."
(when-let ((candidate
(when-let* ((candidate
(ebox-native-reflow--expand-candidate
ebox-native-reflow-module-path)))
(list candidate)))
@ -429,7 +429,7 @@ fails after moving the current module aside, restore that previous module."
(defun ebox-native-reflow--tool-release (output)
"Return the numeric Cargo or rustc release parsed from OUTPUT."
(when-let ((line (ebox-native-reflow--tool-version output)))
(when-let* ((line (ebox-native-reflow--tool-version output)))
(when (string-match
"\\`\\(?:cargo\\|rustc\\) \\([0-9]+\\(?:\\.[0-9]+\\)+\\)"
line)
@ -449,7 +449,7 @@ fails after moving the current module aside, restore that previous module."
(defun ebox-native-reflow--rustup-toolchains (rustup)
"Return installed toolchain names reported by RUSTUP."
(when-let ((output
(when-let* ((output
(ebox-native-reflow--command-output rustup "toolchain" "list")))
(mapcar (lambda (line) (car (split-string line " " t)))
(split-string output "\n" t))))
@ -850,7 +850,7 @@ next Emacs start."
(defun ebox-native-reflow--append-build-log (format-string &rest arguments)
"Append FORMAT-STRING and ARGUMENTS to the native build buffer."
(when-let ((buffer (get-buffer ebox-native-reflow--build-buffer-name)))
(when-let* ((buffer (get-buffer ebox-native-reflow--build-buffer-name)))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(goto-char (point-max))
@ -858,7 +858,7 @@ next Emacs start."
(defun ebox-native-reflow--refresh-status-buffer ()
"Refresh an existing native status buffer without selecting it."
(when-let ((buffer (get-buffer "*Ebox Native Status*")))
(when-let* ((buffer (get-buffer "*Ebox Native Status*")))
(with-current-buffer buffer
(let ((inhibit-read-only t)
(diagnosis (ebox-native--diagnose)))
@ -1917,7 +1917,7 @@ backend has a matching two-dimensional layout contract."
(ebox--layout-children node)))
((eq (plist-get node :ebox-type) 'flex)
(cl-every #'ebox-native-reflow--native-node-supported-p
(append (when-let ((box (plist-get node :box)))
(append (when-let* ((box (plist-get node :box)))
(list box))
(ebox-tree-layout-children node))))
((eq (plist-get node :ebox-type) 'flex-item)
@ -2150,7 +2150,7 @@ per call, and no call recursively visits the captured Ebox tree."
(defun ebox-native-reflow--retained-layout-children (node)
"Return NODE children referenced by one compiled native fragment."
(pcase (plist-get node :ebox-type)
('box (when-let ((child (plist-get node :ebox-content-node)))
('box (when-let* ((child (plist-get node :ebox-content-node)))
(list child)))
((or 'concat 'stack) (ebox--layout-children node))
('flex
@ -3509,7 +3509,7 @@ typed line-width and property invariants instead of repeating them in Emacs."
(session generation key &optional expected)
"Take and materialize SESSION's semantic layout result.
EXPECTED may add exact tape identity fields beyond GENERATION and KEY."
(when-let ((payload
(when-let* ((payload
(ebox-native--module-take
(ebox-native-reflow--live-handle session) generation key)))
(let ((identity (copy-sequence expected)))
@ -3618,7 +3618,7 @@ root effect metadata required by a thin host commit."
This compatibility entry returns only the rendered string. New runtime
callers should consume `ebox-native-reflow-execute-sync' and commit its effect
metadata together with the text."
(when-let ((result
(when-let* ((result
(ebox-native-reflow-execute-sync node frame layout-package)))
(plist-get result :rendered)))
@ -3726,11 +3726,11 @@ metadata together with the text."
fragments)))
(setq fragments (nreverse fragments))
(dolist (fragment fragments)
(if-let ((roles (plist-get fragment :role-ids)))
(if-let* ((roles (plist-get fragment :role-ids)))
(setq previous-role-ids roles)
(plist-put fragment :previous-role-ids previous-role-ids)))
(dolist (fragment (reverse (copy-sequence fragments)))
(if-let ((roles (plist-get fragment :role-ids)))
(if-let* ((roles (plist-get fragment :role-ids)))
(setq next-role-ids roles)
(plist-put fragment :role-ids
(delete-dups
@ -3771,7 +3771,7 @@ metadata together with the text."
(defun ebox-native-reflow-take (session generation key)
"Take SESSION's GENERATION KEY result as a UTF-8 string, or nil."
(when-let ((bytes
(when-let* ((bytes
(ebox-native--module-take
(ebox-native-reflow--live-handle session) generation key)))
(decode-coding-string bytes 'utf-8 t)))
@ -3882,7 +3882,7 @@ published frame has been installed."
(defun ebox-native-reflow--preparation-key
(preparation logical-key full-p)
"Return PREPARATION's native key for LOGICAL-KEY and FULL-P."
(when-let ((keys
(when-let* ((keys
(gethash logical-key
(ebox-native-reflow-preparation-key-table
preparation))))
@ -3900,7 +3900,7 @@ published frame has been installed."
(defun ebox-native-reflow--stop-preparation-ready-watch (preparation)
"Stop PREPARATION's main-thread readiness timer."
(when-let ((timer
(when-let* ((timer
(ebox-native-reflow-preparation-ready-timer preparation)))
(when (timerp timer)
(cancel-timer timer))
@ -3934,7 +3934,7 @@ published frame has been installed."
(defun ebox-native-reflow--readiness-sentinel (process _event)
"Surface an unexpected native readiness channel close for PROCESS."
(when-let ((session
(when-let* ((session
(process-get process 'ebox-native-reflow-session)))
(when (and (eq process
(ebox-native-reflow-session-readiness-process session))
@ -3991,7 +3991,7 @@ published frame has been installed."
(when-let* ((session
(ebox-native-reflow-preparation-native-session preparation))
((ebox-native-reflow--ensure-session-readiness session)))
(when-let ((current
(when-let* ((current
(ebox-native-reflow-session-readiness-preparation session)))
(unless (eq current preparation)
(error "Native reflow session already routes another preparation")))
@ -4001,7 +4001,7 @@ published frame has been installed."
(defun ebox-native-reflow--clear-preparation-readiness (preparation)
"Clear PREPARATION's route without closing its session channel."
(when-let ((session
(when-let* ((session
(ebox-native-reflow-preparation-native-session preparation)))
(when (eq preparation
(ebox-native-reflow-session-readiness-preparation session))
@ -4009,7 +4009,7 @@ published frame has been installed."
(defun ebox-native-reflow--idle-continuation-delay (delay)
"Return a fresh idle threshold DELAY beyond the current idle duration."
(+ (or (when-let ((idle (current-idle-time)))
(+ (or (when-let* ((idle (current-idle-time)))
(float-time idle))
0)
(max 0 (or delay 0))))
@ -4059,7 +4059,7 @@ published frame has been installed."
(unless (or (ebox-native-reflow-preparation-stopped-p preparation)
(ebox-native-reflow-preparation-error preparation))
(setf (ebox-native-reflow-preparation-error preparation) message)
(when-let ((function
(when-let* ((function
(ebox-native-reflow-preparation-error-function preparation)))
(funcall function preparation message))))
@ -4079,7 +4079,7 @@ published frame has been installed."
(let ((materialized-p
(ebox-native-reflow--materialize-next-ready-frame
preparation)))
(when-let ((function
(when-let* ((function
(ebox-native-reflow-preparation-ready-function
preparation)))
(funcall function preparation nil))
@ -4202,7 +4202,7 @@ creating and releasing a session for this preparation."
:error-function error-function
:idle-watch-p idle-watch-p
:window-start-line
(when-let ((window (get-buffer-window buffer t)))
(when-let* ((window (get-buffer-window buffer t)))
(with-current-buffer buffer
(save-restriction
(widen)
@ -4247,7 +4247,7 @@ When FULL-P is non-nil, query the complete restoration job."
(ebox-native-reflow--preparation-cache-key
logical-key full-p)
cache))
(when-let ((native-key
(when-let* ((native-key
(ebox-native-reflow--preparation-key
preparation logical-key full-p)))
(ebox-native-reflow-ready-p
@ -4479,7 +4479,7 @@ NATIVE-FULL-P selects the native key that produced the published frame."
(ebox-native-reflow-preparation-source-root preparation))))
(let ((confirmed-revision (or (plist-get state :runtime-revision) 0)))
(when (and complete-p spec)
(when-let ((native-key
(when-let* ((native-key
(ebox-native-reflow--preparation-key
preparation (plist-get spec :key) native-full-p)))
(ebox-native-reflow-confirm-native-frame
@ -4495,7 +4495,7 @@ NATIVE-FULL-P selects the native key that produced the published frame."
(defun ebox-native-reflow-preparation-stats (preparation)
"Return PREPARATION's native bounded-runtime statistics."
(or (ebox-native-reflow-preparation-final-stats preparation)
(when-let ((session
(when-let* ((session
(ebox-native-reflow-preparation-native-session
preparation)))
(unless (ebox-native-reflow-session-released-p session)
@ -4508,12 +4508,12 @@ NATIVE-FULL-P selects the native key that produced the published frame."
(setf (ebox-native-reflow-preparation-stopped-p preparation) t)
(ebox-native-reflow--stop-preparation-ready-watch preparation)
(ebox-native-reflow--clear-preparation-readiness preparation)
(when-let ((cache
(when-let* ((cache
(ebox-native-reflow-preparation-frame-cache preparation)))
(clrhash cache))
(setf (ebox-native-reflow-preparation-materialization-queue preparation)
nil)
(when-let ((session
(when-let* ((session
(ebox-native-reflow-preparation-native-session preparation)))
(unless (ebox-native-reflow-session-released-p session)
(ignore-errors
@ -4525,7 +4525,7 @@ NATIVE-FULL-P selects the native key that produced the published frame."
preparation)
(unwind-protect
(ebox-native-reflow-release-session session)
(when-let ((stats
(when-let* ((stats
(ebox-native-reflow-preparation-final-stats
preparation)))
(plist-put stats :alive nil)))))))

6
ebox-render-context.el
View File

@ -49,7 +49,7 @@
(defun ebox--register-render-owned-text-value (property value)
"Register Ebox-created VALUE for PROPERTY in the active render candidate."
(when value
(when-let ((values (ebox--render-owned-text-values-for property t)))
(when-let* ((values (ebox--render-owned-text-values-for property t)))
(puthash value t values)))
value)
@ -58,7 +58,7 @@
REGISTRY defaults to the active render candidate."
(let ((ebox--render-owned-text-values
(or registry ebox--render-owned-text-values)))
(when-let ((values (ebox--render-owned-text-values-for property)))
(when-let* ((values (ebox--render-owned-text-values-for property)))
(gethash value values))))
(defun ebox--capture-paint-origins! (string start end)
@ -155,7 +155,7 @@ including strings returned from a render-cache hit."
"Replay owned property identities recorded for RENDERED into this candidate."
(when (and (stringp rendered)
(hash-table-p ebox--render-owned-text-values))
(when-let ((provenance
(when-let* ((provenance
(gethash rendered ebox--render-output-provenance-table)))
(maphash
(lambda (property values)

6
ebox-selector.el
View File

@ -106,10 +106,10 @@
(pcase (and (listp node) (plist-get node :ebox-type))
('box (ebox--ensure-region-id node))
('flex
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(ebox--ensure-region-id box)))
('grid
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(ebox--ensure-region-id box)))
('flex-item
(ebox-selector--node-region-id (plist-get node :node)))
@ -254,7 +254,7 @@
(defun ebox-selector--query-buffer-index (buffer selector ast)
"Return `(SUPPORTED . HANDLES)' for an indexed AST query in BUFFER."
(when (ebox-selector--descendant-indexable-p ast)
(when-let ((indexed (ebox-selector--indexed-candidates buffer ast)))
(when-let* ((indexed (ebox-selector--indexed-candidates buffer ast)))
(cons
t
(ebox-selector--entries-to-buffer-handles

14
ebox-style.el
View File

@ -274,12 +274,12 @@ every `ebox-create' needlessly copies the entire property metadata domain.")
(defun ebox-style-canonical-name (name)
"Return canonical CSS-like longhand property name for NAME."
(when-let ((property (ebox-style-property name)))
(when-let* ((property (ebox-style-property name)))
(plist-get property :name)))
(defun ebox-style-schema-id (name)
"Return namespaced ECSS schema id for Ebox property NAME."
(when-let ((property (ebox-style-property name)))
(when-let* ((property (ebox-style-property name)))
(plist-get property :id)))
(defun ebox-style--put (plist key value)
@ -610,7 +610,7 @@ every `ebox-create' needlessly copies the entire property metadata domain.")
:validator (ebox-style--validator
(plist-get property :validator))
:equality #'equal)))
(when-let ((shorthand (ebox-style--shorthand
(when-let* ((shorthand (ebox-style--shorthand
(plist-get property :shorthand))))
(setq options (plist-put options :shorthand shorthand)))
options))
@ -980,7 +980,7 @@ child colors are handled by `ebox-style--theme-parent-delta-computed'."
(defun ebox-style--add-border-aggregates (style)
"Add uniform border shorthand facts to public computed STYLE."
(dolist (component '(width style color) style)
(when-let ((value (ebox-style--common-border-value style component)))
(when-let* ((value (ebox-style--common-border-value style component)))
(setq style
(plist-put style (intern (format ":border-%s" component)) value)))))
@ -1130,7 +1130,7 @@ SNAPSHOT reuses a previously detached ECSS values snapshot when supplied."
(defun ebox-style--apply-container-wrapper (node style &optional snapshot)
"Apply computed STYLE to NODE's internal visual wrapper."
(when-let ((wrapper (ebox-style--container-wrapper node style snapshot)))
(when-let* ((wrapper (ebox-style--container-wrapper node style snapshot)))
(ebox-style--apply-engine-values
wrapper
(ebox-style--box-values style snapshot))
@ -1220,7 +1220,7 @@ SNAPSHOT reuses a previously detached ECSS values snapshot when supplied."
(when-let* ((source (plist-get item :node)))
(let* ((source-style (plist-get source :ebox-computed-style))
(child-style
(when-let ((child (plist-get source :ebox-content-node)))
(when-let* ((child (plist-get source :ebox-content-node)))
(plist-get child :ebox-computed-style)))
(values
(append
@ -1234,7 +1234,7 @@ SNAPSHOT reuses a previously detached ECSS values snapshot when supplied."
(defun ebox-style-dirty-kind (name)
"Return dirty kind for canonical property or alias NAME."
(when-let ((property (ebox-style-property name)))
(when-let* ((property (ebox-style-property name)))
(plist-get property :dirty-kind)))
(defun ebox-style-signature (computed-style groups)

96
ebox-surface.el
View File

@ -183,7 +183,7 @@ owned; no per-fragment substring is allocated."
(defun ebox-surface--style-state-table (previous-state)
"Copy retained style state from PREVIOUS-STATE into a weak table."
(let ((table (make-hash-table :test 'eq :weakness 'key)))
(when-let ((previous (plist-get previous-state :style-binding-states)))
(when-let* ((previous (plist-get previous-state :style-binding-states)))
(maphash (lambda (object state) (puthash object state table)) previous))
table))
@ -294,7 +294,7 @@ construction time and can use the static projection path."
(ebox-surface--signals-scroll signals)))
(when (tp-signal-live-p signal)
(tp-signal-dispose signal)))
(when-let ((buffer (ebox-surface--signals-buffer signals)))
(when-let* ((buffer (ebox-surface--signals-buffer signals)))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (eq ebox-surface--context-signals signals)
@ -311,6 +311,18 @@ construction time and can use the static projection path."
table))
(sort offsets (lambda (left right) (< (car left) (car right))))))
(defun ebox-surface--buffer-display-window (buffer)
"Return the canonical live display window for BUFFER.
Prefer the window the user is interacting with, then the selected frame, then
another visible frame. One mounted surface owns one viewport, so all context
and resize paths must consume this same choice."
(or (and (window-live-p (selected-window))
(eq (window-buffer (selected-window)) buffer)
(selected-window))
(get-buffer-window buffer (selected-frame))
(get-buffer-window buffer t)
(and (not noninteractive) (selected-window))))
(defun ebox-surface--context-values
(buffer old-state state-overrides)
"Return BUFFER context values after OLD-STATE and STATE-OVERRIDES."
@ -324,17 +336,7 @@ construction time and can use the static projection path."
(let ((scroll-table
(value :scroll-state-table
(plist-get old-state :scroll-state-table)))
;; Prefer the window the user is actually interacting with. A
;; buffer may also be visible in an older client frame; choosing
;; that arbitrary window would silently resize a live surface on a
;; later incremental commit.
(window
(or (and (window-live-p (selected-window))
(eq (window-buffer (selected-window)) buffer)
(selected-window))
(get-buffer-window buffer (selected-frame))
(get-buffer-window buffer t)
(and (not noninteractive) (selected-window)))))
(window (ebox-surface--buffer-display-window buffer)))
(list :viewport-width
(value :viewport-width
(or ebox-viewport-width
@ -448,18 +450,18 @@ The returned ranges are numeric snapshots; TP retains marker ownership."
(defun ebox-surface-region-bounds (buffer region-id &optional roles)
"Return numeric bounds for REGION-ID's TP mounts in BUFFER.
ROLES has the same filtering meaning as in `ebox-surface-region-mounts'."
(when-let ((mounts (ebox-surface-region-mounts buffer region-id roles)))
(when-let* ((mounts (ebox-surface-region-mounts buffer region-id roles)))
(cons (apply #'min (mapcar (lambda (mount) (plist-get mount :start)) mounts))
(apply #'max (mapcar (lambda (mount) (plist-get mount :end)) mounts)))))
(defun ebox-surface--runtime-keys (state key)
"Return hash keys stored under KEY in runtime STATE."
(when-let ((table (plist-get state key)))
(when-let* ((table (plist-get state key)))
(ebox-surface--hash-keys table)))
(defun ebox-surface--bind-scroll-states-to-buffer (state buffer)
"Bind every semantic scroll state in STATE to its owning BUFFER."
(when-let ((table (plist-get state :scroll-state-table)))
(when-let* ((table (plist-get state :scroll-state-table)))
(maphash
(lambda (region-id scroll-state)
(puthash region-id (plist-put scroll-state :buffer buffer) table))
@ -546,7 +548,7 @@ ROLES has the same filtering meaning as in `ebox-surface-region-mounts'."
(error "Ebox framework participant is not unpublished"))
(setf (ebox-surface--framework-participant-state participant) 'published)
(setq report (ebox-surface--participant-report participant report 'published))
(when-let ((publish (ebox-surface--framework-participant-publish participant)))
(when-let* ((publish (ebox-surface--framework-participant-publish participant)))
(funcall publish report))
report)
@ -559,7 +561,7 @@ ROLES has the same filtering meaning as in `ebox-surface-region-mounts'."
(ebox-surface--participant-report
participant (ebox-surface--framework-participant-report participant)
'rolled-back)
(when-let ((rollback
(when-let* ((rollback
(ebox-surface--framework-participant-rollback participant)))
(let ((inhibit-quit t)
(quit-flag nil))
@ -633,11 +635,11 @@ FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil."
;; not the now-committed TP mounts. Drop only those owners' derived
;; geometry so the next transaction lazily captures the committed
;; spans and cannot drift across a repeated selection round trip.
(when-let ((snapshots (plist-get new-state :layout-snapshots)))
(when-let* ((snapshots (plist-get new-state :layout-snapshots)))
(dolist (proof (plist-get new-state :owner-scoped-proofs))
(when (plist-get proof :role-owned-lines-p)
(let ((owner-id (plist-get proof :owner-id)))
(when-let ((snapshot (gethash owner-id snapshots)))
(when-let* ((snapshot (gethash owner-id snapshots)))
(puthash owner-id
(ebox--layout-snapshot-strip-details snapshot)
snapshots))))))
@ -1391,7 +1393,7 @@ published generation so a failed transaction has no cache state to restore."
(defun ebox-surface--reconcile-candidate (root previous-state)
"Reconcile styled ROOT with PREVIOUS-STATE runtime identities."
(when-let ((previous-root (plist-get previous-state :root-node)))
(when-let* ((previous-root (plist-get previous-state :root-node)))
(ebox-tree-reconcile-runtime previous-root root))
root)
@ -1401,7 +1403,7 @@ published generation so a failed transaction has no cache state to restore."
(cl-labels
((visit (node)
(when (and (listp node) (not (stringp node)))
(when-let ((region-id (plist-get node :region-id)))
(when-let* ((region-id (plist-get node :region-id)))
(puthash region-id t ids))
(dolist (child (ebox-tree--children-raw node))
(visit child)))))
@ -1416,7 +1418,7 @@ published generation so a failed transaction has no cache state to restore."
(defun ebox-surface--node-key (node)
"Return NODE's namespaced sibling key, or nil for positional identity."
(when-let ((key (plist-get node :key)))
(when-let* ((key (plist-get node :key)))
(list 'ebox/key key)))
(defun ebox-surface--node-kind (node)
@ -1593,13 +1595,13 @@ published generation so a failed transaction has no cache state to restore."
stylesheet-signature selector-tree-token
stylesheet-subject-local-p)
"Compute and apply NODE style using retained OBJECT and SUBJECT-TABLE."
(when-let ((subject (gethash node subject-table)))
(when-let* ((subject (gethash node subject-table)))
(if (and (hash-table-p ebox-surface--inline-style-value-cache)
(not (ebox-surface--node-style-binding-required-p node)))
(when-let* ((parent (ecss-subject-parent subject))
(binding (gethash parent bindings-by-subject)))
(puthash subject binding bindings-by-subject)
(when-let ((state (gethash parent states-by-subject)))
(when-let* ((state (gethash parent states-by-subject)))
(puthash subject state states-by-subject)))
(ebox-style-apply-computed
node
@ -1787,7 +1789,7 @@ dependencies, or any malformed index conservatively preserves root planning."
(defun ebox-surface--retained-scroll-lookahead (state)
"Return lookahead needed to retain STATE's prepared lazy prefixes."
(when-let ((table (plist-get state :scroll-state-table)))
(when-let* ((table (plist-get state :scroll-state-table)))
(let ((maximum 0))
(maphash
(lambda (_region-id scroll-state)
@ -1838,7 +1840,7 @@ valid because their declarative layout and viewport did not change."
"Restore reusable lazy-scroll SNAPSHOT fields into TABLE."
(maphash
(lambda (region-id metadata)
(when-let ((state (gethash region-id table)))
(when-let* ((state (gethash region-id table)))
(while metadata
(setq state
(plist-put state (pop metadata) (pop metadata))))
@ -1926,7 +1928,7 @@ valid because their declarative layout and viewport did not change."
(when (and (hash-table-p nodes) (hash-table-p objects))
(maphash
(lambda (node-id object)
(when-let ((node (gethash node-id nodes)))
(when-let* ((node (gethash node-id nodes)))
(plist-put node :surface-object object)))
objects))
state))
@ -2251,7 +2253,7 @@ old allocated width while the owner changes its natural content length."
(if (or allocation-closure-p
retain-external-owner-suffix-p)
(and owned-rendered
(when-let ((owners
(when-let* ((owners
(ebox-surface--retained-external-owner-suffix
buffer spans region-ids)))
(ebox--add-content-owners owned-rendered owners)))
@ -2366,7 +2368,7 @@ old allocated width while the owner changes its natural content length."
(sort pairs
(lambda (left right)
(< (car (car left)) (car (car right))))))
(when-let ((output
(when-let* ((output
(ebox-surface--replace-buffer-spans
source origin (mapcar #'car pairs)
(mapcar #'cdr pairs))))
@ -2607,7 +2609,7 @@ causes the caller to use the ordinary full projection."
(make-hash-table :test #'equal)))
(when (and output old-fragments paint-owner-ids)
(dolist (fragment old-fragments)
(when-let ((address (plist-get fragment :paint-address)))
(when-let* ((address (plist-get fragment :paint-address)))
(puthash address fragment old-by-address)
(let* ((roles (plist-get fragment :paint-role-ids))
(owner (cdr (assq 'content roles)))
@ -2789,13 +2791,13 @@ box with wrapper chrome falls back to the retained wrapper renderer."
(defun ebox-surface--role-ids-from-properties (properties)
"Return namespaced Ebox role/id pairs from PROPERTIES."
(let (roles)
(when-let ((region-id
(when-let* ((region-id
(plist-get properties 'ebox-overflow-foreground-source)))
(push (cons 'overflow-foreground region-id) roles))
(dolist (region-id (plist-get properties 'ebox-content-owners))
(cl-pushnew (cons 'content-owner region-id) roles :test #'equal))
(dolist (entry ebox-region-types)
(when-let ((region-id (plist-get properties (cdr entry))))
(when-let* ((region-id (plist-get properties (cdr entry))))
(cl-pushnew (cons (car entry) region-id) roles :test #'equal)))
(nreverse roles)))
@ -2934,11 +2936,11 @@ when it needs to mutate them."
(setq position (max next (1+ position)))))
(setq fragments (nreverse fragments))
(dolist (fragment fragments)
(if-let ((roles (plist-get fragment :role-ids)))
(if-let* ((roles (plist-get fragment :role-ids)))
(setq previous-role-ids roles)
(plist-put fragment :previous-role-ids previous-role-ids)))
(dolist (fragment (reverse (copy-sequence fragments)))
(if-let ((roles (plist-get fragment :role-ids)))
(if-let* ((roles (plist-get fragment :role-ids)))
(setq next-role-ids roles)
(plist-put fragment :role-ids
(delete-dups
@ -3046,7 +3048,7 @@ and shifted without inspecting its text properties."
(plist-put copy :paint-address
(copy-tree
(plist-get old :paint-address)))
(when-let ((chain (plist-get old :paint-node-chain)))
(when-let* ((chain (plist-get old :paint-node-chain)))
(plist-put copy :paint-node-chain
(copy-sequence chain)))
(plist-put copy :text output)
@ -3251,7 +3253,7 @@ Adjacent ranges merge only when both their owner and opaque tags match."
(defun ebox-surface--materialized-fragment-ledger (state)
"Return STATE's paint ledger, expanding a native frame only on demand."
(let ((ledger (plist-get state :surface-fragments)))
(if-let ((frame (and (listp ledger)
(if-let* ((frame (and (listp ledger)
(plist-get ledger :native-frame))))
(ebox-native-reflow-frame-fragments frame)
ledger)))
@ -3472,7 +3474,7 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges."
(let ((region-nodes (plist-get state :region-node-table))
(parents (plist-get state :parent-table)) deepest deepest-depth)
(dolist (entry role-ids)
(when-let ((node-id (gethash (cdr entry) region-nodes)))
(when-let* ((node-id (gethash (cdr entry) region-nodes)))
(let ((depth (ebox-surface--node-depth state node-id)))
(when (or (null deepest-depth) (> depth deepest-depth))
(setq deepest node-id deepest-depth depth)))))
@ -3494,11 +3496,11 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges."
(defun ebox-surface--box-face-contributions (box)
"Return BOX typography and color contributions in render order."
(let (faces)
(when-let ((font (ebox-buffer--font-face box)))
(when-let* ((font (ebox-buffer--font-face box)))
(push font faces))
(when-let ((color (plist-get box :color)))
(when-let* ((color (plist-get box :color)))
(push (ebox-surface--foreground-face color) faces))
(when-let ((background (plist-get box :bgcolor)))
(when-let* ((background (plist-get box :bgcolor)))
(push (list :background background) faces))
(nreverse faces)))
@ -3508,7 +3510,7 @@ ANCESTOR-P means BOX wraps a more specific rendered surface."
(let (faces)
(cond
((memq 'overflow-foreground roles)
(when-let ((color (plist-get box :color)))
(when-let* ((color (plist-get box :color)))
(push (ebox-surface--foreground-face color) faces)))
((memq 'bl roles)
(push (ebox-buffer-side-border-face
@ -3531,7 +3533,7 @@ ANCESTOR-P means BOX wraps a more specific rendered surface."
(list
(list :underline
(append '(:position t)
(when-let ((color
(when-let* ((color
(plist-get box :border-bottom-color)))
(list :color color))))))))
faces))
@ -3661,7 +3663,7 @@ relative face contributions and performs the final merge during prepare."
(if baseline
(put-text-property 0 length 'face baseline text)
(remove-text-properties 0 length '(face nil) text))
(when-let ((face (ebox-surface--face-value faces)))
(when-let* ((face (ebox-surface--face-value faces)))
(let ((props (list 'face (copy-tree face))))
(if (and contributions
(= (plist-get (car contributions) :end) offset)
@ -3717,7 +3719,7 @@ relative face contributions and performs the final merge during prepare."
(let ((roles (cl-remove pair (plist-get fragment key) :test #'equal)))
(plist-put fragment key (if anchor-p (append roles (list pair)) roles))))
(when (> (length (plist-get fragment :text)) 0)
(if-let ((owner
(if-let* ((owner
(cdr (cl-find role
(plist-get fragment :paint-role-ids)
:key #'car :test #'eq :from-end t))))
@ -3854,7 +3856,7 @@ but cannot introduce or remove a viewport expression or node identity."
(and (eq projection-kind 'mixed-owner-reflow)
(plist-get previous-state :viewport-dependent-node-ids-ready)
(plist-member previous-state :viewport-dependent-node-id-axes)
(when-let ((proof (plist-get state-overrides :mixed-owner-proof)))
(when-let* ((proof (plist-get state-overrides :mixed-owner-proof)))
(cl-every
(lambda (entry)
(cl-every
@ -4079,7 +4081,7 @@ published runtime and must be consumed without clearing those shared nodes."
previous-state state)
(ebox-surface--render-candidate state)))
((memq projection-kind '(span-patch owner-scoped))
(if-let ((span-output
(if-let* ((span-output
(ebox-surface--span-patch-output
(ebox-surface--signals-buffer signals) state)))
span-output

54
ebox-tree.el
View File

@ -122,9 +122,9 @@ This is an optimization for snapshot capture, not buffer runtime state.")
(when (listp node)
(let ((attributes
(delq nil
(list (when-let ((id (ebox-tree-node-id node)))
(list (when-let* ((id (ebox-tree-node-id node)))
(cons :id id))
(when-let ((key (ebox-tree-node-key node)))
(when-let* ((key (ebox-tree-node-key node)))
(cons :key key))))))
(dolist (attribute (plist-get node :selector-attributes))
(unless (consp attribute)
@ -145,11 +145,11 @@ This is an optimization for snapshot capture, not buffer runtime state.")
('stack
(ebox-tree-layout-children node))
('flex
(append (when-let ((box (plist-get node :box)))
(append (when-let* ((box (plist-get node :box)))
(list box))
(ebox-tree-layout-children node)))
('grid
(append (when-let ((box (plist-get node :box)))
(append (when-let* ((box (plist-get node :box)))
(list box))
(ebox-tree-layout-children node)))
('flex-item
@ -182,7 +182,7 @@ New row/column containers store flat `:children'. Legacy `ebox-concat' and
"Return CHILD's identity replacement from REPLACEMENTS, when present.
REPLACEMENTS is an alist whose keys are compared with `eq'. Nil is not a
child and is therefore never used as a replacement key."
(if-let ((replacement (and child (assq child replacements))))
(if-let* ((replacement (and child (assq child replacements))))
(cdr replacement)
child))
@ -253,7 +253,7 @@ still copied while every nested value remains shared."
(ebox-tree--replace-direct-child-list children replacements)))
(unless (eq replaced children)
(setq copy (plist-put copy :children replaced)))))
(when-let ((sequence (and (memq type '(concat stack flex grid))
(when-let* ((sequence (and (memq type '(concat stack flex grid))
(plist-get copy :ebox-child-sequence))))
(let ((updated sequence) changed fallback)
(dolist (replacement replacements)
@ -349,7 +349,7 @@ original object identity."
(setq copy (without copy :children))
(pcase type
((or 'flex 'grid)
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(setq copy (plist-put copy :box (copy-node box)))))
('concat
(setq copy (without (without copy :left) :right)))
@ -393,7 +393,7 @@ Record its identities in NODE-ID-SET and REGION-ID-SET."
node node-id-set region-id-set)))
(pcase (plist-get node :ebox-type)
('box
(when-let ((child (plist-get node :ebox-content-node)))
(when-let* ((child (plist-get node :ebox-content-node)))
(plist-put shell :ebox-content-node
(ebox-tree--runtime-identity-skeleton
child node-id-set region-id-set))))
@ -405,7 +405,7 @@ Record its identities in NODE-ID-SET and REGION-ID-SET."
child node-id-set region-id-set))
(ebox-tree-layout-children node))))
((or 'flex 'grid)
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(plist-put shell :box
(ebox-tree--runtime-identity-skeleton
box node-id-set region-id-set)))
@ -416,7 +416,7 @@ Record its identities in NODE-ID-SET and REGION-ID-SET."
child node-id-set region-id-set))
(ebox-tree-layout-children node))))
('flex-item
(when-let ((child (plist-get node :node)))
(when-let* ((child (plist-get node :node)))
(plist-put shell :node
(ebox-tree--runtime-identity-skeleton
child node-id-set region-id-set)))))
@ -459,7 +459,7 @@ Host references are root-global opaque metadata and are compared with `equal'."
;; focused preflight is also used by initial buffer mounting,
;; where it must remain finite for malformed graphs.
(unless (gethash node active)
(when-let ((host-ref (plist-get node :host-ref)))
(when-let* ((host-ref (plist-get node :host-ref)))
(let ((count (hash-table-count host-refs)))
(puthash host-ref t host-refs)
(when (= count (hash-table-count host-refs))
@ -530,7 +530,7 @@ and all explicit identities are compared with `equal'. Return ROOT on success."
(error "Ebox child Range descriptor is invalid here"))
(push entry children))))
(dolist (child (nreverse children))
(when-let ((key (and (listp child)
(when-let* ((key (and (listp child)
(not (stringp child))
(plist-get child :key))))
(when (gethash key keys)
@ -647,7 +647,7 @@ look like a geometry mutation."
(memq (plist-get node :ebox-type) '(grid flex))))
(push key signature)
(push value signature))))
(when-let ((layout (ebox-tree--layout-props-source-signature node)))
(when-let* ((layout (ebox-tree--layout-props-source-signature node)))
(push :ebox-layout-props signature)
(push layout signature))
(nreverse signature)))
@ -751,11 +751,11 @@ candidate runtime index agree."
(children)
(let ((table (make-hash-table :test 'equal)))
(dolist (child children table)
(when-let ((key (node-key child)))
(when-let* ((key (node-key child)))
(puthash key child table)))))
(match-child
(old-children old-keyed new-child index)
(if-let ((key (node-key new-child)))
(if-let* ((key (node-key new-child)))
(let ((old-child (gethash key old-keyed)))
(and (same-type-p old-child new-child) old-child))
(let ((old-child (nth index old-children)))
@ -809,7 +809,7 @@ candidate runtime index agree."
"Return NODE's logical children without internal layout adapters."
(pcase (and (listp node) (plist-get node :ebox-type))
('box
(when-let ((content-node (plist-get node :ebox-content-node)))
(when-let* ((content-node (plist-get node :ebox-content-node)))
(ebox-tree--semantic-layout-leaves content-node)))
((or 'concat 'stack)
(ebox-tree--semantic-layout-leaves node))
@ -831,11 +831,11 @@ candidate runtime index agree."
(when (and (listp node) (not (stringp node)))
(let* ((current-path (append path (list node)))
(entry (cons node current-path)))
(when-let ((id (ebox-tree-node-id node)))
(when-let* ((id (ebox-tree-node-id node)))
(prepend id-table id entry))
(dolist (class (ebox-tree-node-classes node))
(prepend class-table class entry))
(when-let ((type (ebox-tree-node-selector-type node)))
(when-let* ((type (ebox-tree-node-selector-type node)))
(prepend type-table type entry))
(dolist (child (ebox-tree-semantic-children node))
(visit child current-path))))))
@ -937,14 +937,14 @@ not only the public update ids."
(ebox-tree-layout-children node))))
('flex
(append
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box)))
(apply #'append
(mapcar #'ebox-tree-node-all-region-ids
(ebox-tree-layout-children node)))))
('grid
(append
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box)))
(apply #'append
(mapcar #'ebox-tree-node-all-region-ids
@ -981,14 +981,14 @@ cannot be inspected and reports no conflict."
(ebox-tree-layout-children node)))
('flex
(or (and inherited
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(and (plist-get box paint-key) t)))
(cl-some (lambda (child)
(ebox-tree-node-paint-conflict-p child paint-key t))
(ebox-tree-layout-children node))))
('grid
(or (and inherited
(when-let ((box (plist-get node :box)))
(when-let* ((box (plist-get node :box)))
(and (plist-get box paint-key) t)))
(cl-some (lambda (child)
(ebox-tree-node-paint-conflict-p child paint-key t))
@ -1010,20 +1010,20 @@ wrapper's visible content is produced by the flex renderer."
('box
(or (when (equal (ebox-get node :region-id) region-id)
(list node))
(when-let ((path (ebox-tree-node-path-to-region
(when-let* ((path (ebox-tree-node-path-to-region
(plist-get node :ebox-content-node)
region-id)))
(append path (list node)))))
('concat
(catch 'found
(dolist (child (ebox-tree-layout-children node))
(when-let ((path (ebox-tree-node-path-to-region child region-id)))
(when-let* ((path (ebox-tree-node-path-to-region child region-id)))
(throw 'found (append path (list node)))))
nil))
('stack
(catch 'found
(dolist (child (ebox-tree-layout-children node))
(when-let ((path (ebox-tree-node-path-to-region child region-id)))
(when-let* ((path (ebox-tree-node-path-to-region child region-id)))
(throw 'found (append path (list node)))))
nil))
('flex
@ -1034,7 +1034,7 @@ wrapper's visible content is produced by the flex renderer."
(t
(catch 'found
(dolist (child (ebox-tree-layout-children node))
(when-let ((path (ebox-tree-node-path-to-region child region-id)))
(when-let* ((path (ebox-tree-node-path-to-region child region-id)))
(throw 'found (append path (list node)))))
nil))))
('grid
@ -1045,7 +1045,7 @@ wrapper's visible content is produced by the flex renderer."
(t
(catch 'found
(dolist (child (ebox-tree-layout-children node))
(when-let ((path (ebox-tree-node-path-to-region child region-id)))
(when-let* ((path (ebox-tree-node-path-to-region child region-id)))
(throw 'found (append path (list node)))))
nil))))
('flex-item

87
ebox-viewport.el
View File

@ -1,99 +1,62 @@
;;; ebox-viewport.el --- Coalesced Emacs viewport delivery -*- lexical-binding: t; -*-
;;; ebox-viewport.el --- Immediate Emacs viewport delivery -*- lexical-binding: t; -*-
;;; Commentary:
;; Emacs owns window events; Ebox owns the mounted viewport. This module is
;; the single bridge between them. Size hooks only sample the latest visible
;; dimensions. One deferred callback per buffer publishes the newest sample,
;; so continuous frame dragging cannot enqueue synchronous layout transactions.
;; dimensions and synchronously publish one exact incremental viewport update.
;; Emacs serializes the hook; Ebox's retained renderer bounds each transaction.
;;; Code:
(require 'cl-lib)
(require 'ebox-surface)
(declare-function ebox--buffer-render-state "ebox-incremental" (buffer))
(declare-function ebox-rerender-buffer-with-context
"ebox" (buffer viewport-width &optional viewport-height))
(defcustom ebox-viewport-resize-delay 0.05
"Seconds after the latest size event before publishing its viewport.
Continuous size events replace one pending sample for each mounted buffer."
:type 'number
:group 'ebox)
(defvar ebox--viewport-resize-pending-table (make-hash-table :test #'eq)
"Buffer-keyed latest viewport samples awaiting publication.")
(defvar ebox--viewport-resize-generation 0
"Monotonic identity for pending viewport samples.")
(defvar ebox--window-size-change-in-progress nil
"Non-nil while Ebox is synchronizing visible window viewports.
External GUI events cannot interleave in Emacs's single thread. A nested call
can only originate from the current publication and therefore has no newer
window geometry to publish.")
(defun ebox-viewport-window-width (window)
"Return Ebox's display-safe viewport width for live WINDOW."
(and (window-live-p window)
(ebox-surface--window-content-width window)))
(defun ebox--cancel-buffer-viewport-resize (buffer)
"Cancel BUFFER's pending viewport publication."
(when-let* ((pending (gethash buffer ebox--viewport-resize-pending-table)))
(let ((timer (aref pending 4)))
(when (timerp timer) (cancel-timer timer)))
(remhash buffer ebox--viewport-resize-pending-table))
nil)
(defun ebox--viewport-resize-apply (buffer generation)
"Publish BUFFER's pending viewport identified by GENERATION."
(when-let* ((pending (gethash buffer ebox--viewport-resize-pending-table)))
(when (= generation (aref pending 0))
(remhash buffer ebox--viewport-resize-pending-table)
(let ((window (aref pending 1))
(width (aref pending 2))
(height (aref pending 3)))
(when (and (buffer-live-p buffer)
(window-live-p window)
(eq (window-buffer window) buffer)
(ebox-surface-buffer-mounted-p buffer))
(let ((state (ebox--buffer-render-state buffer)))
(unless (and (= width (or (plist-get state :viewport-width) -1))
(= height (or (plist-get state :viewport-height) -1)))
(ebox-rerender-buffer-with-context buffer width height))))))))
(defun ebox--schedule-buffer-viewport-resize
(buffer window width height)
"Replace BUFFER's pending viewport with WINDOW, WIDTH, and HEIGHT."
(ebox--cancel-buffer-viewport-resize buffer)
(let* ((generation (cl-incf ebox--viewport-resize-generation))
(pending (vector generation window width height nil)))
(puthash buffer pending ebox--viewport-resize-pending-table)
(aset pending 4
(run-at-time
(max 0 ebox-viewport-resize-delay) nil
#'ebox--viewport-resize-apply buffer generation)))
buffer)
(defun ebox--window-size-change (frame)
"Sample latest viewports for mounted Ebox buffers visible in FRAME."
(when (and (frame-live-p frame) (not noninteractive))
(let ((seen (make-hash-table :test #'eq)))
"Synchronize mounted Ebox buffers visible in FRAME immediately."
(when (and (frame-live-p frame)
(not noninteractive)
(not ebox--window-size-change-in-progress))
(let ((ebox--window-size-change-in-progress t)
(seen (make-hash-table :test #'eq)))
(dolist (window (window-list frame 'no-minibuf))
(when (window-live-p window)
(let ((buffer (window-buffer window)))
(unless (gethash buffer seen)
(puthash buffer t seen)
(when (and (buffer-live-p buffer)
(let ((display-window
(and (buffer-live-p buffer)
(ebox-surface--buffer-display-window buffer))))
(when (and (window-live-p display-window)
(eq (window-frame display-window) frame)
(ebox-surface-buffer-mounted-p buffer))
(let* ((state (ebox--buffer-render-state buffer))
(width (ebox-viewport-window-width window))
(height (window-body-height window)))
(width (ebox-viewport-window-width display-window))
(height (window-body-height display-window)))
(when (and width
state
(not (and
(= width
(or (plist-get state :viewport-width) -1))
(or (plist-get state :viewport-width)
-1))
(= height
(or (plist-get state :viewport-height)
-1)))))
(ebox--schedule-buffer-viewport-resize
buffer window width height)))))))))))
(ebox-rerender-buffer-with-context
buffer width height))))))))))))
(when (boundp 'window-size-change-functions)
(add-hook 'window-size-change-functions #'ebox--window-size-change))

123
ebox.el
View File

@ -440,7 +440,7 @@ PLIST is a property list that overrides the defaults."
"Set PROPERTY to VALUE in BOX and return the modified box.
Registered style properties also update BOX's canonical ECSS declarations so a
later cascade computes from the public mutation instead of stale source data."
(when-let ((declaration
(when-let* ((declaration
(ebox-style-compile-declarations (list property value))))
(plist-put
box :ebox-style-declarations
@ -648,7 +648,7 @@ ALIGN can be `top', `center', or `bottom'."
(len (length string)))
(catch 'found
(while (< pos len)
(when-let ((id (get-text-property pos 'ebox-content string)))
(when-let* ((id (get-text-property pos 'ebox-content string)))
(throw 'found id))
(setq pos (or (next-single-property-change
pos 'ebox-content string)
@ -660,7 +660,7 @@ ALIGN can be `top', `center', or `bottom'."
(len (length string))
ids)
(while (< pos len)
(when-let ((id (get-text-property pos 'ebox-content string)))
(when-let* ((id (get-text-property pos 'ebox-content string)))
(unless (memq id ids)
(setq ids (append ids (list id)))))
(setq pos (1+ pos)))
@ -702,13 +702,13 @@ Use this to capture ids *before* inserting into a buffer:
(mapcar #'ebox-region-ids
(ebox--layout-children node))))
((eq type 'flex)
(if-let ((box (plist-get node :box)))
(if-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box))
(apply #'append
(mapcar #'ebox-region-ids
(ebox-tree-layout-children node)))))
((eq type 'grid)
(if-let ((box (plist-get node :box)))
(if-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box))
(apply #'append
(mapcar #'ebox-region-ids
@ -760,7 +760,7 @@ Use this to capture ids *before* inserting into a buffer:
"Return a KEY -> child hash table for explicitly keyed CHILDREN."
(let ((table (make-hash-table :test 'equal)))
(dolist (child children)
(when-let ((key (ebox--runtime-node-key child)))
(when-let* ((key (ebox--runtime-node-key child)))
(puthash key child table)))
table))
@ -773,7 +773,7 @@ Use this to capture ids *before* inserting into a buffer:
(defun ebox--runtime-keyed-match (old-keyed new-child)
"Return the keyed old child that should match NEW-CHILD."
(when-let ((key (ebox--runtime-node-key new-child)))
(when-let* ((key (ebox--runtime-node-key new-child)))
(let ((old-child (gethash key old-keyed)))
(when (ebox--runtime-same-type-p old-child new-child)
old-child))))
@ -910,7 +910,7 @@ Properties are expanded recursively according to `ebox-property-rules'."
(defun ebox--scroll-cancel-idle-prefetch (region-id)
"Cancel any pending idle prefix prefetch for REGION-ID."
(when-let ((timer (gethash region-id ebox--scroll-idle-prefetch-timers)))
(when-let* ((timer (gethash region-id ebox--scroll-idle-prefetch-timers)))
(when (timerp timer)
(cancel-timer timer))
(remhash region-id ebox--scroll-idle-prefetch-timers)))
@ -948,7 +948,7 @@ Properties are expanded recursively according to `ebox-property-rules'."
(defun ebox--idle-continuation-delay (delay)
"Return an idle-timer threshold one fresh DELAY beyond current idle time."
(+ (or (when-let ((idle (current-idle-time)))
(+ (or (when-let* ((idle (current-idle-time)))
(float-time idle))
0)
(max 0 (or delay 0))))
@ -956,7 +956,7 @@ Properties are expanded recursively according to `ebox-property-rules'."
(defun ebox--scroll-schedule-idle-prefetch (region-id &optional delay)
"Schedule input-yielding lazy prefix prefetch for REGION-ID when useful."
(ebox--scroll-cancel-idle-prefetch region-id)
(when-let ((state (and (or (not noninteractive)
(when-let* ((state (and (or (not noninteractive)
ebox--scroll-allow-noninteractive-prefetch)
(ebox--scroll-get-state region-id))))
(when (and (ebox--scroll-idle-prefetch-needed-p state)
@ -1040,13 +1040,13 @@ request; callers that represent GUI animation ticks pass their tick size."
(defun ebox--smooth-scroll-active-p (region-id)
"Return non-nil when REGION-ID has an active smooth scroll timer."
(when-let ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(and (timerp (plist-get entry :timer))
(not (plist-get entry :waiting-prefetch)))))
(defun ebox--smooth-scroll-resume-after-prefetch (region-id)
"Resume REGION-ID smooth scrolling after a paused lazy prefetch."
(when-let ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(when (plist-get entry :waiting-prefetch)
(plist-put entry :waiting-prefetch nil)
(unless (timerp (plist-get entry :timer))
@ -1065,7 +1065,7 @@ request; callers that represent GUI animation ticks pass their tick size."
region-id
(ebox--idle-continuation-delay
ebox-scroll-lazy-idle-prefetch-delay))
(when-let ((state (ebox--scroll-get-state region-id)))
(when-let* ((state (ebox--scroll-get-state region-id)))
(let ((buffer (ebox--scroll-state-buffer state))
(cache-miss-target
(plist-get state :cache-miss-prefetch-target-lines)))
@ -1215,7 +1215,7 @@ owns the exact continuation cache for the captured viewport context."
(maphash
(lambda (region-id _)
(cl-incf retained-cost 48)
(if-let ((state (ebox--scroll-get-state region-id)))
(if-let* ((state (ebox--scroll-get-state region-id)))
(let ((template (ebox--scroll-cache-state-template state)))
(cl-incf
retained-cost
@ -1318,7 +1318,7 @@ remain transaction-local."
ebox--collect-rebuilt-scroll-state-region-ids)
(cl-pushnew region-id ebox--rebuilt-scroll-state-region-ids
:test #'equal))
(when-let ((content-lines (plist-get state :content-lines)))
(when-let* ((content-lines (plist-get state :content-lines)))
(let ((ebox--defer-scroll-content-index
(or ebox--defer-scroll-content-index
(plist-get state :render-content-prefix)
@ -1355,7 +1355,7 @@ remain transaction-local."
(= (length native-lines) content-height))
(list offset native-lines))
((and (integerp content-height) (>= content-height 0))
(when-let ((lines (plist-get state :rendered-content-lines)))
(when-let* ((lines (plist-get state :rendered-content-lines)))
(let* ((max-offset (max 0 (- (length lines) content-height)))
(offset (max 0 (min max-offset offset)))
(end (min (+ offset content-height) (length lines))))
@ -1628,7 +1628,7 @@ the currently displayed rendered slice actually changed."
(defun ebox--scroll-state-materialize-lines (region-id state)
"Return STATE after materializing lazy scroll content for REGION-ID."
(if-let ((materialize (plist-get state :materialize-content-lines)))
(if-let* ((materialize (plist-get state :materialize-content-lines)))
(let* ((old-visible
(ebox--scroll-state-rendered-visible-window state))
(old-refresh-required
@ -1810,9 +1810,9 @@ object. Unrelated ownerless and foreign-buffer states remain isolated."
(plist-get (ebox--buffer-render-state buffer) :scroll-region-ids))
region-ids)
(dolist (node-id node-ids)
(when-let ((node (ebox--buffer-runtime-node buffer node-id)))
(when-let* ((node (ebox--buffer-runtime-node buffer node-id)))
(dolist (region-id buffer-region-ids)
(when-let ((state (ebox--scroll-get-state region-id)))
(when-let* ((state (ebox--scroll-get-state region-id)))
(when (ebox--scroll-state-covers-node-p buffer state node)
(cl-pushnew region-id region-ids :test #'equal))))))
(nreverse region-ids)))
@ -1830,7 +1830,7 @@ object. Unrelated ownerless and foreign-buffer states remain isolated."
"Return ebox role/id pairs at POS in STRING."
(let (role-ids)
(dolist (entry ebox-region-types)
(when-let ((region-id (get-text-property pos (cdr entry) string)))
(when-let* ((region-id (get-text-property pos (cdr entry) string)))
(push (cons (car entry) region-id) role-ids)))
role-ids))
@ -1840,7 +1840,7 @@ object. Unrelated ownerless and foreign-buffer states remain isolated."
(dolist (region-id (get-text-property pos 'ebox-content-owners string))
(cl-pushnew region-id ids :test #'equal))
(dolist (entry ebox-region-types)
(when-let ((region-id (get-text-property pos (cdr entry) string)))
(when-let* ((region-id (get-text-property pos (cdr entry) string)))
(cl-pushnew region-id ids :test #'equal)))
ids))
@ -1902,7 +1902,7 @@ object. Unrelated ownerless and foreign-buffer states remain isolated."
(cl-loop for line in lines
for idx from 0
do (when (ebox--scroll-line-region-present-p line region-ids)
(when-let ((span (ebox--scroll-line-region-span
(when-let* ((span (ebox--scroll-line-region-span
line region-set)))
(push (cons idx span) spans))))
(nreverse spans)))
@ -1931,7 +1931,7 @@ Decoration-only legacy lines fall back to the complete role scanner."
(setq topology-seen t)
(cl-pushnew region-id ids :test #'equal))
(dolist (property '(ebox-content ebox-content-owner))
(when-let ((region-id (get-text-property pos property line)))
(when-let* ((region-id (get-text-property pos property line)))
(setq topology-seen t)
(cl-pushnew region-id ids :test #'equal)))
(setq pos
@ -1960,7 +1960,7 @@ uses their rendered descendants."
(limit (length line))
ids)
(while (< pos limit)
(when-let ((region-id (get-text-property pos 'ebox-content line)))
(when-let* ((region-id (get-text-property pos 'ebox-content line)))
(cl-pushnew region-id ids :test #'equal))
(setq pos
(max (1+ pos)
@ -1972,7 +1972,7 @@ uses their rendered descendants."
(defun ebox--scroll-line-bounds-index-add (index line-index line)
"Add LINE at LINE-INDEX to lightweight region bounds INDEX."
(dolist (region-id (ebox--scroll-line-direct-content-region-ids line))
(if-let ((bounds (gethash region-id index)))
(if-let* ((bounds (gethash region-id index)))
(setcdr bounds line-index)
(puthash region-id (cons line-index line-index) index)))
index)
@ -2015,7 +2015,7 @@ uses their rendered descendants."
for line-index from 0
do
(dolist (region-id (ebox--scroll-line-region-ids line))
(when-let ((span (ebox--scroll-line-region-span
(when-let* ((span (ebox--scroll-line-region-span
line (ebox--region-id-set
(list region-id)))))
(puthash region-id
@ -2076,7 +2076,7 @@ fall back to the complete role scanner."
(defun ebox--scroll-index-add-line (index line-index line)
"Add LINE at LINE-INDEX to INDEX."
(dolist (region-id (ebox--scroll-line-region-ids line))
(when-let ((span (ebox--scroll-line-region-span
(when-let* ((span (ebox--scroll-line-region-span
line (ebox--region-id-set (list region-id)))))
(puthash region-id
(cons (cons line-index span)
@ -2146,7 +2146,7 @@ fall back to the complete role scanner."
Dynamic updates reuse an already prepared index. When no ready index exists,
scan for only REGION-IDS; building the all-region index synchronously is much
more expensive than the targeted fallback on a long lazy prefix."
(if-let ((index (plist-get state :region-line-span-index)))
(if-let* ((index (plist-get state :region-line-span-index)))
;; A ready exact index already proves both membership and spans. Building
;; the prefix-wide membership set first adds an O(prefix) tax to visible
;; updates after scrolling.
@ -2156,7 +2156,7 @@ more expensive than the targeted fallback on a long lazy prefix."
(when (ebox--scroll-region-id-set-intersects-p
content-region-id-set region-ids)
(let ((hints (plist-get state :region-line-span-hints)))
(if-let ((hint-spans
(if-let* ((hint-spans
(and hints
(cl-loop for region-id in region-ids
for spans = (gethash region-id hints)
@ -2187,7 +2187,7 @@ bound rendered-line inspection without scanning or indexing the whole prefix."
((< line-index (car indices)))
((= line-index (car indices))
(when (ebox--scroll-line-region-present-p line region-ids)
(when-let ((span (ebox--scroll-line-region-span
(when-let* ((span (ebox--scroll-line-region-span
line region-set)))
(push (cons line-index span) spans)))
(setq indices (cdr indices)))))
@ -2196,7 +2196,7 @@ bound rendered-line inspection without scanning or indexing the whole prefix."
(defun ebox--cancel-buffer-reflow-cache-prewarm (buffer)
"Cancel pending predicted reflow-cache warming for BUFFER."
(when-let ((timer (gethash buffer ebox--reflow-cache-prewarm-timers)))
(when-let* ((timer (gethash buffer ebox--reflow-cache-prewarm-timers)))
(when (timerp timer)
(cancel-timer timer)))
(remhash buffer ebox--reflow-cache-prewarm-timers))
@ -2204,7 +2204,7 @@ bound rendered-line inspection without scanning or indexing the whole prefix."
(defun ebox--cancel-buffer-runtime-prewarm (buffer)
"Cancel and discard pending runtime prewarming for BUFFER."
(ebox--cancel-buffer-reflow-cache-prewarm buffer)
(when-let ((timer (gethash buffer ebox--runtime-prewarm-timers)))
(when-let* ((timer (gethash buffer ebox--runtime-prewarm-timers)))
(when (timerp timer)
(cancel-timer timer)))
(remhash buffer ebox--runtime-prewarm-timers)
@ -2450,7 +2450,7 @@ published or mutated. Return non-nil when the isolated render ran."
(defun ebox--root-region-box (root region-id)
"Return ROOT's box carrying REGION-ID, including a flex wrapper box."
(when-let ((owner (car (ebox--node-path-to-region root region-id))))
(when-let* ((owner (car (ebox--node-path-to-region root region-id))))
(cond
((eq (plist-get owner :ebox-type) 'box) owner)
((and (eq (plist-get owner :ebox-type) 'flex)
@ -2607,7 +2607,7 @@ OLD-VIEWPORT-WIDTH and VIEWPORT-WIDTH describe the completed reflow. One job
is scheduled for the next width at the same nonzero delta; invalid nonpositive
predictions are skipped."
(ebox--cancel-buffer-reflow-cache-prewarm buffer)
(when-let ((state (and (ebox--reflow-cache-prewarm-enabled-p)
(when-let* ((state (and (ebox--reflow-cache-prewarm-enabled-p)
(buffer-live-p buffer)
(ebox--buffer-render-state buffer))))
(let* ((delta (and (numberp old-viewport-width)
@ -2660,7 +2660,7 @@ scroll surface."
:phase (if native-ready-p 'native-scroll 'snapshots)
:snapshot-stack
(unless native-ready-p
(when-let ((root (plist-get state :root-node)))
(when-let* ((root (plist-get state :root-node)))
(list (vector root :uninitialized t t))))
:node-region-ids-cache (make-hash-table :test 'eq)
:viewport-width-ids-rev nil
@ -2675,7 +2675,7 @@ scroll surface."
"Schedule BUFFER's next runtime prewarm slice after DELAY."
(when (and (buffer-live-p buffer)
(gethash buffer ebox--runtime-prewarm-jobs))
(when-let ((old (gethash buffer ebox--runtime-prewarm-timers)))
(when-let* ((old (gethash buffer ebox--runtime-prewarm-timers)))
(when (timerp old)
(cancel-timer old)))
(puthash buffer
@ -2690,7 +2690,7 @@ scroll surface."
RETAINED-ONLY-P is deliberately true after ordinary commits and resizes; the
initial mount and visible-window handoff leave it nil."
(ebox--cancel-buffer-runtime-prewarm buffer)
(when-let ((state (and (ebox--runtime-prewarm-enabled-p)
(when-let* ((state (and (ebox--runtime-prewarm-enabled-p)
(buffer-live-p buffer)
(ebox--buffer-render-state buffer))))
(puthash buffer (ebox--runtime-prewarm-new-job
@ -2794,7 +2794,7 @@ Return non-nil when descendant width dependencies remain relevant."
(ebox--node-layout-snapshot buffer node nil))))))
(setq count (1+ count))))
(unless (plist-get job :snapshot-stack)
(when-let ((state (ebox--buffer-render-state buffer)))
(when-let* ((state (ebox--buffer-render-state buffer)))
(let ((width-ids (nreverse
(plist-get job :viewport-width-ids-rev)))
(height-ids (nreverse
@ -2814,7 +2814,7 @@ Return non-nil when descendant width dependencies remain relevant."
(tails (plist-get task :tails))
(line-index (plist-get task :line-index)))
(dolist (region-id (ebox--scroll-line-region-ids line))
(when-let ((span (ebox--scroll-line-region-span
(when-let* ((span (ebox--scroll-line-region-span
line (ebox--region-id-set (list region-id)))))
(let* ((cell (list (cons line-index span)))
(tail (gethash region-id tails)))
@ -2893,7 +2893,7 @@ Return non-nil when descendant width dependencies remain relevant."
(let* ((sources (plist-get job :scroll-sources))
(source (car sources)))
(plist-put job :scroll-sources (cdr sources))
(when-let ((task
(when-let* ((task
(ebox--runtime-prewarm-scroll-source-task
buffer source)))
(plist-put job :scroll-task task)))
@ -2956,7 +2956,7 @@ events use the native window afterwards and never enter the TP surface plan."
(list :result 0 :state state
:offset (or (plist-get state :scroll-offset) 0)
:native-materialize-p t)))
(when-let ((window (get-buffer-window buffer t)))
(when-let* ((window (get-buffer-window buffer t)))
(with-current-buffer buffer
(goto-char (min old-point (point-max))))
(set-window-point window (point))
@ -2970,7 +2970,7 @@ events use the native window afterwards and never enter the TP surface plan."
(defun ebox--runtime-prewarm-step (buffer)
"Run one bounded runtime prewarm slice for BUFFER.
Return non-nil while more work remains."
(when-let ((job (gethash buffer ebox--runtime-prewarm-jobs)))
(when-let* ((job (gethash buffer ebox--runtime-prewarm-jobs)))
(let ((state (ebox--buffer-render-state buffer)))
(if (or (not (buffer-live-p buffer))
(not (eq state (plist-get job :render-state)))
@ -3004,7 +3004,7 @@ Return non-nil while more work remains."
(defun ebox--runtime-prewarm-drain (buffer)
"Synchronously drain BUFFER's scheduled prewarm job for tests and profiling."
(when-let ((timer (gethash buffer ebox--runtime-prewarm-timers)))
(when-let* ((timer (gethash buffer ebox--runtime-prewarm-timers)))
(when (timerp timer)
(cancel-timer timer))
(remhash buffer ebox--runtime-prewarm-timers))
@ -3012,7 +3012,7 @@ Return non-nil while more work remains."
completed)
(while (and (> limit 0) (not completed))
(unless (gethash buffer ebox--runtime-prewarm-jobs)
(when-let ((state (and (buffer-live-p buffer)
(when-let* ((state (and (buffer-live-p buffer)
(ebox--buffer-render-state buffer))))
(puthash buffer (ebox--runtime-prewarm-new-job buffer state)
ebox--runtime-prewarm-jobs)))
@ -3031,7 +3031,7 @@ Return non-nil while more work remains."
(let (candidates)
(maphash
(lambda (region-id _state)
(when-let ((bounds
(when-let* ((bounds
(ebox-surface-region-bounds
(current-buffer) region-id)))
(when (and (<= (car bounds) pos) (< pos (cdr bounds)))
@ -3061,7 +3061,7 @@ nested owners may render equal-sized clipped spans."
(let (candidates)
(maphash
(lambda (region-id _state)
(when-let ((bounds
(when-let* ((bounds
(ebox-surface-region-bounds
(current-buffer) region-id)))
(push (cons region-id
@ -3502,7 +3502,7 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input."
(defun ebox--scrollable-region-p (region-id delta)
"Return non-nil when REGION-ID can consume DELTA lines."
(when-let ((state (and region-id (ebox--scroll-get-state region-id))))
(when-let* ((state (and region-id (ebox--scroll-get-state region-id))))
(let* ((scroll-offset (or (plist-get state :scroll-offset) 0))
(content-lines (plist-get state :content-lines))
(content-height (plist-get state :content-height))
@ -3524,8 +3524,8 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input."
(defun ebox--smooth-scroll-stop (region-id)
"Stop pending smooth wheel scroll animation for REGION-ID."
(when-let ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(when-let ((timer (plist-get entry :timer)))
(when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(when-let* ((timer (plist-get entry :timer)))
(cancel-timer timer))
(remhash region-id ebox--smooth-scroll-state-table)
(ebox--deferred-render-gc-schedule-restore)
@ -3534,7 +3534,7 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input."
(defun ebox--smooth-scroll-pause-for-prefetch
(region-id entry pending)
"Pause REGION-ID smooth scroll ENTRY until lazy prefetch extends the cache."
(when-let ((timer (plist-get entry :timer)))
(when-let* ((timer (plist-get entry :timer)))
(when (timerp timer)
(cancel-timer timer)))
(plist-put entry :timer nil)
@ -3544,7 +3544,7 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input."
(defun ebox--smooth-scroll-clamp-pending (region-id pending)
"Clamp PENDING lines to REGION-ID's remaining scrollable range."
(if-let ((state (and region-id (ebox--scroll-get-state region-id))))
(if-let* ((state (and region-id (ebox--scroll-get-state region-id))))
(let* ((scroll-offset (or (plist-get state :scroll-offset) 0))
(lazy-forward
(and (> pending 0)
@ -3570,7 +3570,7 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input."
(defun ebox--smooth-scroll-lazy-boundary-p (region-id delta)
"Return non-nil when DELTA would cross REGION-ID's lazy prefix boundary."
(when-let ((state (and (> delta 0)
(when-let* ((state (and (> delta 0)
(ebox--scroll-get-state region-id))))
(let* ((scroll-offset (or (plist-get state :scroll-offset) 0))
(content-lines (plist-get state :content-lines))
@ -3660,7 +3660,7 @@ animation was admitted because one owner can consume the complete intent."
;; pending distance; the timer coalesces them into frame-sized edits.
(unless had-timer
(ebox--smooth-scroll-tick region-id))
(when-let ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(unless (timerp (plist-get entry :timer))
(plist-put
entry :timer
@ -3720,7 +3720,7 @@ FALLBACK is the Emacs scroll command to call when ebox cannot scroll."
(defun ebox--scroll-region-can-consume-complete-p (region-id delta)
"Return non-nil when REGION-ID can consume all signed DELTA now."
(when-let ((state (and region-id (ebox--scroll-get-state region-id))))
(when-let* ((state (and region-id (ebox--scroll-get-state region-id))))
(let* ((offset (or (plist-get state :scroll-offset) 0))
(height (or (plist-get state :content-height) 0))
(maximum (max 0 (- (length (plist-get state :content-lines))
@ -3848,9 +3848,8 @@ With prefix ARG, scroll by that many content lines."
"Remove all runtime caches owned by BUFFER.
Defaults to the current buffer."
(let ((buffer (or buffer (current-buffer))))
(ebox--cancel-buffer-viewport-resize buffer)
(ebox--cancel-buffer-runtime-prewarm buffer)
(when-let ((root (ebox--buffer-root-node buffer)))
(when-let* ((root (ebox--buffer-root-node buffer)))
(ebox--clear-region-runtime-caches
(ebox--node-all-region-ids root)))
(ebox--clear-buffer-render-state buffer)))
@ -3992,7 +3991,7 @@ cannot be changed through the unpublished batch root."
(defun ebox--surface-region-scroll-context (buffer region-id)
"Return read-only scroll publication context for REGION-ID in BUFFER."
(when-let ((node (ebox--buffer-region-render-owner-node buffer region-id)))
(when-let* ((node (ebox--buffer-region-render-owner-node buffer region-id)))
(let ((region-ids (ebox--node-all-region-ids node))
states)
(maphash
@ -4017,7 +4016,7 @@ cannot be changed through the unpublished batch root."
(defun ebox--surface-region-scroll-report (context changed-keys)
"Return TP-era scroll report fields for CONTEXT and CHANGED-KEYS."
(when-let ((node (plist-get context :node)))
(when-let* ((node (plist-get context :node)))
(let* ((count (length (plist-get context :states)))
(paint-p
(eq (ebox--region-update-dirty-kind changed-keys) 'paint))
@ -4060,7 +4059,7 @@ cannot be changed through the unpublished batch root."
(plist-get (plist-get commit-input :state-overrides)
:scroll-state-table)))
(dolist (entry (plist-get context :states))
(when-let ((state (gethash (car entry) table)))
(when-let* ((state (gethash (car entry) table)))
(plist-put state :lazy-scroll-prefix-dirty t)
(puthash (car entry) state table)))))
commit-input)
@ -4380,7 +4379,7 @@ NODE can be any box/concat/stack node created by `ebox-create',
"Return NODE's margin-free role bounds in BUFFER, or nil."
(let (start end)
(dolist (region-id (ebox--node-all-region-ids node))
(when-let ((bounds
(when-let* ((bounds
(ebox-surface-region-bounds
buffer region-id ebox--horizontal-border-anchor-roles)))
(setq start (if start (min start (car bounds)) (car bounds))
@ -4391,7 +4390,7 @@ NODE can be any box/concat/stack node created by `ebox-create',
"Return fallback TP mount bounds for NODE in BUFFER, or nil."
(let (start end)
(dolist (region-id (ebox--node-all-region-ids node))
(when-let ((bounds (ebox-surface-region-bounds buffer region-id)))
(when-let* ((bounds (ebox-surface-region-bounds buffer region-id)))
(setq start (if start (min start (car bounds)) (car bounds))
end (if end (max end (cdr bounds)) (cdr bounds)))))
(and start end (< start end) (cons start end))))
@ -4560,7 +4559,7 @@ Return the successful publication report stored by `ebox-buffer-update-report'."
:publish callback :rollback framework-rollback
:state 'unpublished :diagnostics nil))
(_surface
(if-let ((scope-node-ids
(if-let* ((scope-node-ids
(plist-get commit-input :scope-node-ids)))
(ebox-surface-update-buffer-scoped
buffer source scope-node-ids

2
scripts/ebox-performance-evaluator.el
View File

@ -541,7 +541,7 @@
(if (plist-get check :ok) "PASS" "FAIL")
(plist-get check :name)
(plist-get check :detail))))
(when-let ((tp-report (plist-get report :tp-report)))
(when-let* ((tp-report (plist-get report :tp-report)))
(princ (format "TP-REPORT %S\n" tp-report)))
(princ "\n")))

6
tests/ebox-core-render-tests.el
View File

@ -4436,7 +4436,7 @@
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-test*")
layout))
(when-let ((cache
(when-let* ((cache
(plist-get (ebox--buffer-render-state buffer)
:render-signature-cache)))
(clrhash cache))
@ -8150,7 +8150,7 @@
(length (plist-get state
:rendered-content-lines)))))
(should (= (plist-get state :content-height) 12)))
(when-let ((materialize
(when-let* ((materialize
(plist-get state :materialize-content-lines)))
(plist-put
state :materialize-content-lines
@ -8481,7 +8481,7 @@
(ebox-scroll-lazy-prefix-lookahead-lines 0))
(cl-letf (((symbol-function 'ebox--render-box)
(lambda (box)
(when-let ((id (and (listp box) (ebox-get box :id))))
(when-let* ((id (and (listp box) (ebox-get box :id))))
(when (and (string-prefix-p "item-" id)
(>= (string-to-number
(substring id (length "item-")))

2
tests/ebox-flex-tests.el
View File

@ -79,7 +79,7 @@
(len (length string))
values)
(while (< pos len)
(when-let ((value (get-text-property pos property string)))
(when-let* ((value (get-text-property pos property string)))
(unless (memq value values)
(setq values (append values (list value)))))
(setq pos (1+ pos)))

2
tests/ebox-package-tests.el
View File

@ -110,7 +110,7 @@
((symbol-function 'message) #'ignore))
(should (ebox-byte-compile))
(should (equal (nreverse compiled) ebox--compile-sources)))
(when-let ((buffer (get-buffer "*Ebox Byte Compile*")))
(when-let* ((buffer (get-buffer "*Ebox Byte Compile*")))
(kill-buffer buffer)))))
(ert-deftest ebox-package-includes-native-build-source ()

145
tests/ebox-surface-tests.el
View File

@ -171,15 +171,13 @@
(when (get-buffer " *other-window*")
(kill-buffer " *other-window*")))))
(ert-deftest ebox-window-size-change-coalesces-to-latest-visible-viewport ()
"Continuous frame changes publish only the latest sampled viewport."
(ert-deftest ebox-window-size-change-publishes-every-visible-viewport ()
"Continuous frame changes publish each sampled viewport immediately."
(let* ((buffer (generate-new-buffer " *ebox-window-size-change*"))
(window (selected-window))
(old-buffer (window-buffer window))
(sampled-height (window-body-height window))
(sampled-widths (number-sequence 240 430 10))
scheduled
cancelled
calls)
(unwind-protect
(progn
@ -195,52 +193,115 @@
(lambda (target width height)
(push (list target width height) calls)))
((symbol-function 'run-at-time)
(lambda (delay _repeat function &rest arguments)
(let ((timer (intern (format "ebox-resize-timer-%d"
(1+ (length scheduled))))))
(push (list timer delay function arguments) scheduled)
timer)))
((symbol-function 'timerp)
(lambda (value)
(string-prefix-p "ebox-resize-timer-"
(symbol-name value))))
((symbol-function 'cancel-timer)
(lambda (timer) (push timer cancelled)))
(lambda (&rest _)
(ert-fail "viewport delivery must not schedule a timer")))
(noninteractive nil))
(dotimes (_index 20)
(ebox--window-size-change (selected-frame)))
(should-not calls)
(should (= (length scheduled) 20))
(should (= (length cancelled) 19))
(pcase-let ((`(,_timer ,delay ,function ,arguments)
(car scheduled)))
(should (= delay ebox-viewport-resize-delay))
(apply function arguments))
(should (equal calls
(list (list buffer 430 sampled-height))))))
(should (= (length calls) 20))
(should
(equal (mapcar #'cadr (nreverse (copy-sequence calls)))
(number-sequence 240 430 10)))
(should (cl-every (lambda (call)
(and (eq (car call) buffer)
(= (nth 2 call) sampled-height)))
calls))))
(set-window-buffer window old-buffer)
(when (boundp 'ebox--viewport-resize-pending-table)
(clrhash ebox--viewport-resize-pending-table))
(kill-buffer buffer))))
(ert-deftest ebox-buffer-cleanup-cancels-pending-viewport-resize ()
"A dead mounted buffer cannot retain a viewport timer or pending sample."
(let ((buffer (generate-new-buffer " *ebox-viewport-cleanup*"))
(timer 'ebox-test-viewport-cleanup-timer)
cancelled)
(ert-deftest ebox-window-size-change-rejects-reentrant-publication ()
"A viewport commit cannot recursively enter the global size hook."
(let* ((buffer (generate-new-buffer " *ebox-reentrant-window-size*"))
(window (selected-window))
(old-buffer (window-buffer window))
(sampled-widths '(420 440))
calls)
(unwind-protect
(progn
(puthash buffer (vector 1 (selected-window) 400 20 timer)
ebox--viewport-resize-pending-table)
(cl-letf (((symbol-function 'timerp)
(lambda (value) (eq value timer)))
((symbol-function 'cancel-timer)
(lambda (value) (setq cancelled value))))
(with-current-buffer buffer (ebox--cleanup-current-buffer)))
(should (eq cancelled timer))
(should-not (gethash buffer ebox--viewport-resize-pending-table)))
(remhash buffer ebox--viewport-resize-pending-table)
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(set-window-buffer window buffer)
(cl-letf (((symbol-function 'ebox--buffer-render-state)
(lambda (_buffer)
'(:viewport-width 100 :viewport-height 10)))
((symbol-function 'ebox-surface-buffer-mounted-p)
(lambda (_buffer) t))
((symbol-function 'ebox-surface--window-content-width)
(lambda (_window) (pop sampled-widths)))
((symbol-function 'window-body-height)
(lambda (&rest _) 20))
((symbol-function 'ebox-rerender-buffer-with-context)
(lambda (&rest arguments)
(push arguments calls)
(ebox--window-size-change (selected-frame))))
(noninteractive nil))
(ebox--window-size-change (selected-frame)))
(should (= (length calls) 1))
(should (equal sampled-widths '(440))))
(set-window-buffer window old-buffer)
(kill-buffer buffer))))
(ert-deftest ebox-window-size-change-restores-guard-after-error ()
"A failed viewport update cannot leave future window events suppressed."
(let* ((buffer (generate-new-buffer " *ebox-window-size-error*"))
(window (selected-window))
(old-buffer (window-buffer window))
(fail t)
calls)
(unwind-protect
(progn
(set-window-buffer window buffer)
(cl-letf (((symbol-function 'ebox--buffer-render-state)
(lambda (_buffer)
'(:viewport-width 100 :viewport-height 10)))
((symbol-function 'ebox-surface-buffer-mounted-p)
(lambda (_buffer) t))
((symbol-function 'ebox-surface--window-content-width)
(lambda (_window) 420))
((symbol-function 'window-body-height)
(lambda (&rest _) 20))
((symbol-function 'ebox-rerender-buffer-with-context)
(lambda (&rest arguments)
(push arguments calls)
(when fail (error "viewport update failed"))))
(noninteractive nil))
(should-error (ebox--window-size-change (selected-frame)))
(should-not ebox--window-size-change-in-progress)
(setq fail nil)
(ebox--window-size-change (selected-frame)))
(should (= (length calls) 2)))
(set-window-buffer window old-buffer)
(kill-buffer buffer))))
(ert-deftest ebox-window-size-change-follows-canonical-display-frame ()
"A stale frame cannot overwrite a surface owned by another live frame."
(let ((buffer (generate-new-buffer " *ebox-canonical-frame*"))
calls)
(unwind-protect
(cl-letf (((symbol-function 'frame-live-p) (lambda (_frame) t))
((symbol-function 'window-list)
(lambda (&rest _) '(event-window)))
((symbol-function 'window-live-p) (lambda (_window) t))
((symbol-function 'window-buffer) (lambda (_window) buffer))
((symbol-function 'window-frame)
(lambda (_window) 'canonical-frame))
((symbol-function 'ebox-surface--buffer-display-window)
(lambda (_buffer) 'canonical-window))
((symbol-function 'ebox-surface-buffer-mounted-p)
(lambda (_buffer) t))
((symbol-function 'ebox--buffer-render-state)
(lambda (_buffer)
'(:viewport-width 100 :viewport-height 10)))
((symbol-function 'ebox-surface--window-content-width)
(lambda (_window) 420))
((symbol-function 'window-body-height)
(lambda (&rest _) 20))
((symbol-function 'ebox-rerender-buffer-with-context)
(lambda (&rest arguments) (push arguments calls)))
(noninteractive nil))
(ebox--window-size-change 'stale-frame)
(should-not calls)
(ebox--window-size-change 'canonical-frame)
(should (equal calls (list (list buffer 420 20)))))
(kill-buffer buffer))))
(defun ebox-surface-test--hash-fingerprint (table)
"Return a stable content fingerprint for hash TABLE.