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. a published node tree in place.
Visible mounted buffers follow their displaying window automatically. Ebox Visible mounted buffers follow their displaying window automatically. Ebox
coalesces continuous size events and publishes only the latest sample after publishes every size event immediately through its retained incremental path.
`ebox-viewport-resize-delay` (0.05 seconds by default). 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 `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. 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 ## 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 | | 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) | | 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 | | 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 | | 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. | | 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` render 外部动态绑定 `ebox-viewport-width`（像素）与 `ebox-viewport-height`
（行数）。不要原地修改已经发布的 node tree。 （行数）。不要原地修改已经发布的 node tree。
可见的 mounted buffer 会自动跟随展示它的 window。Ebox 合并连续 size event， 可见的 mounted buffer 会自动跟随展示它的 window。Ebox 通过 retained 增量路径
并在 `ebox-viewport-resize-delay`（默认 0.05 秒）后只发布最新 sample。 立即发布每个 size event。Emacs hook 串行执行并拒绝重入；这里没有第二套宿主
hook、timer 或 viewport queue。
`ebox-viewport-window-width` 返回 controller 使用的同一个显示安全像素宽度； `ebox-viewport-window-width` 返回 controller 使用的同一个显示安全像素宽度；
宿主不应再安装第二套 resize hook 或宽度算法。 宿主不应再安装第二套 resize hook 或宽度算法。
旧的 `ebox-viewport-resize-delay` 已删除；立即发布不再需要迁移 timer 配置。
## 7. Selector ## 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 | | 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） | | 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 | | 预测 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 | | 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 使用的临时目录。 | | 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 () (defun ebox--darwin-physical-memory-bytes ()
"Return macOS physical memory in bytes, or nil when unavailable." "Return macOS physical memory in bytes, or nil when unavailable."
(when (eq system-type 'darwin) (when (eq system-type 'darwin)
(when-let ((sysctl (executable-find "sysctl"))) (when-let* ((sysctl (executable-find "sysctl")))
(with-temp-buffer (with-temp-buffer
(when (zerop (call-process sysctl nil t nil "-n" "hw.memsize")) (when (zerop (call-process sysctl nil t nil "-n" "hw.memsize"))
(goto-char (point-min)) (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." "Return local physical memory in bytes, or nil when unavailable."
(when (eq ebox--physical-memory-bytes 'unknown) (when (eq ebox--physical-memory-bytes 'unknown)
(setq ebox--physical-memory-bytes (setq ebox--physical-memory-bytes
(or (when-let ((info (or (when-let* ((info
(and (fboundp 'memory-info) (and (fboundp 'memory-info)
(let ((default-directory (let ((default-directory
temporary-file-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))) (max gc-cons-percentage ebox-render-gc-cons-percentage)))
(cl-incf ebox--deferred-render-gc-generation) (cl-incf ebox--deferred-render-gc-generation)
(cl-incf ebox--deferred-render-gc-depth) (cl-incf ebox--deferred-render-gc-depth)
(when-let ((threshold (when-let* ((threshold
(ebox--effective-deferred-render-gc-cons-threshold))) (ebox--effective-deferred-render-gc-cons-threshold)))
(setq gc-cons-threshold threshold)) (setq gc-cons-threshold threshold))
(unless ebox--deferred-render-gc-state (unless ebox--deferred-render-gc-state
@ -327,7 +327,7 @@ Return FUNCTION's value."
(:font-height . :height) (:font-height . :height)
(:font-weight . :weight) (:font-weight . :weight)
(:font-slant . :slant))) (: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)))) (setq face (plist-put face (cdr entry) value))))
face)) face))
@ -377,7 +377,7 @@ foreground color."
This backend mapper intentionally accepts computed style facts and emits only This backend mapper intentionally accepts computed style facts and emits only
buffer-facing paint properties. Layout-only properties never pass through." buffer-facing paint properties. Layout-only properties never pass through."
(let ((face (ebox-buffer--font-face style))) (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 (setq face
(cond (cond
((tp-paint-slot-p foreground) ((tp-paint-slot-p foreground)
@ -386,7 +386,7 @@ buffer-facing paint properties. Layout-only properties never pass through."
((eq foreground 'ebox/default-foreground) ((eq foreground 'ebox/default-foreground)
(append (ebox-buffer--default-foreground-face) face)) (append (ebox-buffer--default-foreground-face) face))
(t (plist-put face :foreground foreground))))) (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 (setq face
(if (tp-paint-slot-p background) (if (tp-paint-slot-p background)
(let ((slot-face (tp-paint-slot-face 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) (defun ebox--propertize-typography (string style)
"Apply STYLE's typography to one copy of STRING." "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))) (let ((copy (copy-sequence string)))
(ebox--add-render-face! copy 0 (length copy) face t) (ebox--add-render-face! copy 0 (length copy) face t)
(ebox--register-render-owned-face-values string copy)) (ebox--register-render-owned-face-values string copy))
@ -813,7 +813,7 @@ parent layout change."
(setq ok t) (setq ok t)
(cl-loop for width in slot-widths (cl-loop for width in slot-widths
for line = (or (pop lines) (ebox-pixel-space 0)) 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 (ebox-buffer--pad-line-to-slot-width
line width))) line width)))
(push padded-line padded) (push padded-line padded)

8
ebox-cache.el
View File

@ -175,13 +175,13 @@
"Return distinct scopes for CACHE-NAMES." "Return distinct scopes for CACHE-NAMES."
(let (scopes) (let (scopes)
(dolist (name cache-names) (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))) (cl-pushnew (ebox-cache-spec-scope spec) scopes :test #'equal)))
scopes)) scopes))
(defun ebox-cache-record-hit (buffer cache-name) (defun ebox-cache-record-hit (buffer cache-name)
"Record a CACHE-NAME hit for BUFFER's current update report." "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 (plist-put state :cache-hit-count
(1+ (or (plist-get state :cache-hit-count) 0))) (1+ (or (plist-get state :cache-hit-count) 0)))
(ebox-cache--push-unique-values (ebox-cache--push-unique-values
@ -189,7 +189,7 @@
(defun ebox-cache-record-miss (buffer cache-name) (defun ebox-cache-record-miss (buffer cache-name)
"Record a CACHE-NAME miss for BUFFER's current update report." "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 (plist-put state :cache-miss-count
(1+ (or (plist-get state :cache-miss-count) 0))) (1+ (or (plist-get state :cache-miss-count) 0)))
(ebox-cache--push-unique-values (ebox-cache--push-unique-values
@ -197,7 +197,7 @@
(defun ebox-cache-record-invalidation (buffer cache-names reason) (defun ebox-cache-record-invalidation (buffer cache-names reason)
"Record invalidated CACHE-NAMES and REASON for BUFFER." "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-invalidated cache-names)
(ebox-cache--push-unique-values (ebox-cache--push-unique-values
state :cache-scope (ebox-cache--spec-scopes cache-names)) 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)))) (let ((payload (ebox-child-range--segment-payload (nth 2 record))))
(dotimes (offset (length payload)) (dotimes (offset (length payload))
(ebox-child-range--metric-add metrics 'old-affected-payload-visits) (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 (setq key-root
(ebox-child-range--hash-change (ebox-child-range--hash-change
key-root key nil (funcall hash-function key) 0 t metrics)))))) key-root key nil (funcall hash-function key) 0 t metrics))))))
(dolist (record records) (dolist (record records)
(let ((index (nth 1 record)) (payload (nth 3 record))) (let ((index (nth 1 record)) (payload (nth 3 record)))
(dotimes (offset (length payload)) (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 (setq key-root
(ebox-child-range--hash-change (ebox-child-range--hash-change
key-root key (cons index offset) 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)) (let* ((children (ebox-child-range--segment-node-children node))
(slot (ebox-child-range--digit index (1- height)))) (slot (ebox-child-range--digit index (1- height))))
(dotimes (cursor slot) (dotimes (cursor slot)
(when-let ((child (aref children cursor))) (when-let* ((child (aref children cursor)))
(setq weight (+ weight (setq weight (+ weight
(ebox-child-range--segment-node-weight child))))) (ebox-child-range--segment-node-weight child)))))
(setq node (aref children slot) (setq node (aref children slot)
@ -389,7 +389,7 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location."
(let (records) (let (records)
(dotimes (index (ebox-child-range--sequence-count sequence)) (dotimes (index (ebox-child-range--sequence-count sequence))
(let ((segment (ebox-child-range--segment-at sequence index))) (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)))) (push (list ref index) records))))
(nreverse records))) (nreverse records)))
@ -398,10 +398,10 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location."
(let ((nodes 0) (edges 0)) (let ((nodes 0) (edges 0))
(cl-labels ((walk (node) (cl-labels ((walk (node)
(setq nodes (1+ nodes)) (setq nodes (1+ nodes))
(when-let ((children (when-let* ((children
(ebox-child-range--segment-node-children node))) (ebox-child-range--segment-node-children node)))
(dotimes (slot 32) (dotimes (slot 32)
(when-let ((child (aref children slot))) (when-let* ((child (aref children slot)))
(setq edges (1+ edges)) (setq edges (1+ edges))
(walk child)))))) (walk child))))))
(walk (ebox-child-range--sequence-root sequence))) (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." "Return `(VECTORS . SLOTS)' allocated by SEQUENCE's segment trie."
(let ((vectors 0)) (let ((vectors 0))
(cl-labels ((walk (node) (cl-labels ((walk (node)
(when-let ((children (when-let* ((children
(ebox-child-range--segment-node-children node))) (ebox-child-range--segment-node-children node)))
(setq vectors (1+ vectors)) (setq vectors (1+ vectors))
(dotimes (slot 32) (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))) (walk (ebox-child-range--sequence-root sequence)))
(cons vectors (* 32 vectors)))) (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) (when (or (plist-member raw-props :width)
(and (null (plist-get props :width)) (and (null (plist-get props :width))
(ebox--viewport-pixel-width nil))) (ebox--viewport-pixel-width nil)))
(when-let ((content-viewport (when-let* ((content-viewport
(ebox--wrapper-content-viewport-pixel wrapper-box))) (ebox--wrapper-content-viewport-pixel wrapper-box)))
(plist-put props :width (list content-viewport)))) (plist-put props :width (list content-viewport))))
(when (and (plist-member raw-props :height) (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)) (ebox--normalize-horizontal-size-value (car value) allowed-keywords))
((memq value allowed-keywords) value) ((memq value allowed-keywords) value)
((and (consp value) (eq (car value) 'fit-content)) ((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) (let ((pixels (if (ebox--viewport-size-value-p limit)
'viewport 'viewport
(ebox--nonnegative-horizontal-size-pixels limit nil)))) (ebox--nonnegative-horizontal-size-pixels limit nil))))
@ -502,11 +502,11 @@ grapheme."
"Return BOX's total main-axis size constraint from PROPERTY." "Return BOX's total main-axis size constraint from PROPERTY."
(when (plist-member box property) (when (plist-member box property)
(if (eq axis 'row) (if (eq axis 'row)
(when-let ((content-size (when-let* ((content-size
(ebox--resolve-size-content-pixel (ebox--resolve-size-content-pixel
box (ebox-get box property) nil))) box (ebox-get box property) nil)))
(+ (ebox--side-pixel box) content-size)) (+ (ebox--side-pixel box) content-size))
(when-let ((block-size (when-let* ((block-size
(ebox--box-sizing-content-height (ebox--box-sizing-content-height
box (ebox-get box property)))) box (ebox-get box property))))
(+ (ebox--side-height box) block-size))))) (+ (ebox--side-height box) block-size)))))
@ -568,7 +568,7 @@ grapheme."
(puthash node t ebox--render-recached-source-node-cache)) (puthash node t ebox--render-recached-source-node-cache))
(pcase (plist-get node :ebox-type) (pcase (plist-get node :ebox-type)
('box ('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)) (puthash region-id node ebox--region-box-table))
(ebox--flex-recache-source-boxes (ebox--flex-recache-source-boxes
(plist-get node :ebox-content-node))) (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) (defun ebox--flex-measure-cache-value (probe)
"Return a copied cached measurement from PROBE, or nil on a miss." "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))) (copy-sequence cached)))
(defun ebox--flex-render-cache-signature (node) (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 The Elisp scalar algorithm remains the exact fallback and owns all item
metadata and rendering decisions." metadata and rendering decisions."
(or (when (and main-limit (integerp main-gap)) (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))) (funcall backend lines main-limit main-gap)))
(mapcar (lambda (line) (mapcar (lambda (line)
(ebox--flex-size-line line main-limit main-gap)) (ebox--flex-size-line line main-limit main-gap))
@ -1546,7 +1546,7 @@ its child."
(defun ebox--render-flex-box (node rendered) (defun ebox--render-flex-box (node rendered)
"Render flex NODE's container box around RENDERED, when present." "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)) (let ((copy (copy-sequence box))
(region-id (ebox--ensure-region-id box))) (region-id (ebox--ensure-region-id box)))
(plist-put copy :region-id region-id) (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) (defun ebox--flex-window-render-box-lines (node content complete limit)
"Return NODE flex wrapper lines around CONTENT up to LIMIT." "Return NODE flex wrapper lines around CONTENT up to LIMIT."
(let* ((rendered (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)) (let ((copy (ebox--flex-window-wrapper-copy box complete))
(region-id (ebox--ensure-region-id box))) (region-id (ebox--ensure-region-id box)))
(plist-put copy :region-id region-id) (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) (defun ebox--flex-window-cache-lookup (node limit &optional cache-context)
"Return cached flex window render for NODE and LIMIT, or nil." "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)))) (or cache-context (ebox--flex-window-cache-context node))))
(let* ((node-id (plist-get cache-context :node-id)) (let* ((node-id (plist-get cache-context :node-id))
(signature (plist-get cache-context :signature)) (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 :completion-prefix-tail-rewrite-count
(plist-get (plist-get
complete :completion-prefix-tail-rewrite-count)))) 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) (list node-id 'flex-window 'prefix)
signature))) signature)))
(let* ((lines (plist-get prefix :lines)) (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 lines))
(last result-lines)) (last result-lines))
:complete nil))))) :complete nil)))))
(when-let ((exact (when-let* ((exact
(ebox--render-cache-lookup (ebox--render-cache-lookup
(list node-id 'flex-window limit) (list node-id 'flex-window limit)
signature))) 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) (defun ebox--flex-window-prefix-cache-lookup (node &optional cache-context)
"Return NODE's cached incomplete flex prefix state, or nil." "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)))) (or cache-context (ebox--flex-window-cache-context node))))
(let* ((node-id (plist-get cache-context :node-id)) (let* ((node-id (plist-get cache-context :node-id))
(signature (plist-get cache-context :signature))) (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 (defun ebox--flex-window-prefix-cache-store
(node pieces next-index result &optional cache-context) (node pieces next-index result &optional cache-context)
"Store NODE incomplete flex prefix PIECES through NEXT-INDEX." "Store NODE incomplete flex prefix PIECES through NEXT-INDEX."
(when-let ((cache-context (when-let* ((cache-context
(and result (and result
(or cache-context (or cache-context
(ebox--flex-window-cache-context node))))) (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 (defun ebox--flex-window-cache-store
(node limit result &optional cache-context) (node limit result &optional cache-context)
"Store NODE flex window RESULT for LIMIT when possible." "Store NODE flex window RESULT for LIMIT when possible."
(when-let ((cache-context (when-let* ((cache-context
(and result (and result
(or cache-context (or cache-context
(ebox--flex-window-cache-context node))))) (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))) (lines (ebox--flex-break-lines items main-size main-gap wrap)))
(when (eq wrap 'wrap-reverse) (when (eq wrap 'wrap-reverse)
(setq lines (nreverse lines))) (setq lines (nreverse lines)))
(when-let ((line (when-let* ((line
(cl-find-if (cl-find-if
(lambda (candidate) (lambda (candidate)
(cl-some (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." "Return NODE's display, layout, flex, and paint style signature."
(when (listp node) (when (listp node)
(let ((signature (list :display (ebox--computed-display 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) (dolist (key ebox--style-signature-keys)
(when (plist-member style-node key) (when (plist-member style-node key)
(setq signature (setq signature
(plist-put signature key (plist-get style-node key))))) (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 (setq signature
(plist-put signature :flex-participation participation)))) (plist-put signature :flex-participation participation))))
(when (eq (ebox--display-inner node) 'flex) (when (eq (ebox--display-inner node) 'flex)
(setq signature (setq signature
(plist-put signature :flex-props (plist-put signature :flex-props
(plist-get node :props)))) (plist-get node :props))))
(when-let ((participation (ebox--flex-participation-props node))) (when-let* ((participation (ebox--flex-participation-props node)))
(setq signature (setq signature
(plist-put signature :flex-participation participation))) (plist-put signature :flex-participation participation)))
signature))) 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) (defun ebox-grid--clamp-track-size (track size)
"Clamp SIZE to TRACK's fixed maximum when one exists." "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) (min size maximum)
size)) size))
@ -607,7 +607,7 @@ size for start/center/end alignment unless it would overflow its track."
(defun ebox--render-grid-box (node rendered) (defun ebox--render-grid-box (node rendered)
"Render grid NODE's optional visual wrapper around 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)) (let ((copy (copy-sequence box))
(region-id (ebox--ensure-region-id box))) (region-id (ebox--ensure-region-id box)))
(plist-put copy :region-id region-id) (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) (defun ebox--render-cache-replay-entry-side-effects (entry)
"Replay ENTRY's scroll side effects before its rendered output is reused." "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))) (gethash entry ebox--render-cache-entry-side-effects-table)))
(ebox--replay-scroll-cache-actions (ebox--replay-scroll-cache-actions
(plist-get metadata :scroll-actions) (plist-get metadata :scroll-actions)
@ -788,7 +788,7 @@ This normally does no work. It rebuilds metadata only after a defensive
(pcase kind (pcase kind
('viewport t) ('viewport t)
('root-width ('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) (equal (ebox--literal-root-pixel-width box)
(plist-get prepared :root-width)))) (plist-get prepared :root-width))))
(_ nil))))) (_ 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. "Return NODE's exact cache context, with `:rendered' when reusable.
FORCE includes the complete viewport context in the cache signature. FORCE includes the complete viewport context in the cache signature.
EXTERNAL-SIGNATURE may prove a viewport-dependent non-root context." EXTERNAL-SIGNATURE may prove a viewport-dependent non-root context."
(when-let ((context (when-let* ((context
(ebox--render-cache-context (ebox--render-cache-context
node force external-signature))) node force external-signature)))
(let* ((ebox--render-cache-table (plist-get context :cache)) (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; When FORCE is non-nil, cache NODE even when its output is viewport-dependent;
the complete viewport context remains part of the render signature. the complete viewport context remains part of the render signature.
CACHE-PROBE may supply a prior exact miss from an accelerator boundary." 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)))) (ebox--take-prepared-root-render node))))
(prog1 prepared (prog1 prepared
(ebox--replay-render-output-provenance 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) (defun ebox--buffer-root-node-id (buffer)
"Return BUFFER's root runtime node id." "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))) (ebox--ensure-node-id root)))
(defun ebox--runtime-region-id-conflict (region-id-set target-buffer) (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 (maphash
(lambda (buffer state) (lambda (buffer state)
(unless (eq buffer target) (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 (maphash
(lambda (region-id _present) (lambda (region-id _present)
(when (gethash region-id owner-set) (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) (defun ebox-incremental--adjust-runtime-type-count (table node delta)
"Adjust NODE's raw selector-type count in TABLE by 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))) (let ((count (+ (or (gethash type table) 0) delta)))
(cond (cond
((< count 0) ((< count 0)
@ -1028,7 +1028,7 @@ same traversal in complete-render overwrite order."
(runtime-type-count-table (make-hash-table :test 'eq)) (runtime-type-count-table (make-hash-table :test 'eq))
native-node-postorder range-sequence-p) native-node-postorder range-sequence-p)
(cl-labels ((index-host-ref (node node-id) (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))) (let ((count (hash-table-count host-ref-table)))
(puthash host-ref node-id host-ref-table) (puthash host-ref node-id host-ref-table)
(when (= count (hash-table-count 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) (unless (gethash region-id region-node-table)
(puthash region-id node-id region-node-table)))) (puthash region-id node-id region-node-table))))
('flex ('flex
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(let ((region-id (ebox--ensure-region-id box))) (let ((region-id (ebox--ensure-region-id box)))
(puthash region-id t region-id-set) (puthash region-id t region-id-set)
;; Preserve the recursive lookup's first-match ;; Preserve the recursive lookup's first-match
@ -1070,7 +1070,7 @@ same traversal in complete-render overwrite order."
(puthash (ebox--ensure-region-id node) (puthash (ebox--ensure-region-id node)
node region-box-table)) node region-box-table))
('flex ('flex
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(puthash (ebox--ensure-region-id box) (puthash (ebox--ensure-region-id box)
box region-box-table)))))) box region-box-table))))))
(visit (node parent-id native-layout-p) (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)) (puthash node-id parent-id parent-table))
(index-region-id node node-id) (index-region-id node node-id)
(index-host-ref 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) (setq range-sequence-p t)
(dotimes (dotimes
(segment-index (segment-index
@ -1242,7 +1242,7 @@ same traversal in complete-render overwrite order."
"Return REGION-ID's smallest render-owner node id in BUFFER. "Return REGION-ID's smallest render-owner node id in BUFFER.
Use the persistent runtime index when available. Legacy runtime states that 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." 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)) (gethash region-id table))
(when-let* ((root (ebox--buffer-root-node buffer)) (when-let* ((root (ebox--buffer-root-node buffer))
(path (ebox--node-path-to-region root region-id))) (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. "Return REGION-ID's smallest render-owner node in BUFFER.
Use both persistent runtime indexes in the normal path. Fall back to the Use both persistent runtime indexes in the normal path. Fall back to the
recursive region path only for legacy or incomplete runtime state." 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-region-render-owner-node-id buffer region-id)))
(ebox--buffer-runtime-node buffer node-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 Discard the isolated reflow scratch tree unless
PRESERVE-REFLOW-PREWARM-SCRATCH is non-nil. Callers may preserve it only PRESERVE-REFLOW-PREWARM-SCRATCH is non-nil. Callers may preserve it only
while validating one predicted root-width mutation against the new revision." 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 (let ((revision
(1+ (or (plist-get state :runtime-revision) 0)))) (1+ (or (plist-get state :runtime-revision) 0))))
(plist-put state :runtime-revision revision) (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) (defun ebox--buffer-viewport-dependent-node-id-axes (buffer)
"Return cached viewport-dependent node ids by axis for 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) (if (and (plist-get state :viewport-dependent-node-ids-ready)
(plist-member state :viewport-dependent-node-id-axes)) (plist-member state :viewport-dependent-node-id-axes))
(plist-get 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) (defun ebox--buffer-viewport-dependent-node-ids (buffer)
"Return cached viewport-dependent node ids for 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) (ebox--buffer-viewport-dependent-node-id-axes buffer)
(plist-get state :viewport-dependent-node-ids))) (plist-get state :viewport-dependent-node-ids)))
(defun ebox--invalidate-buffer-viewport-dependencies (buffer) (defun ebox--invalidate-buffer-viewport-dependencies (buffer)
"Invalidate BUFFER's cached viewport dependency list." "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-ids nil)
(plist-put state :viewport-dependent-node-id-axes nil) (plist-put state :viewport-dependent-node-id-axes nil)
(plist-put state :viewport-dependent-node-ids-ready 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) (defun ebox--layout-snapshot (buffer node-id)
"Return BUFFER's layout snapshot for 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) (let ((snapshot (or (gethash node-id snapshots)
(when-let ((node (ebox--snapshot-published-node (when-let* ((node (ebox--snapshot-published-node
buffer node-id))) buffer node-id)))
(let ((created (let ((created
(ebox--node-layout-snapshot (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. "Return a copy of BUFFER's current layout snapshot table.
When DETAILS is non-nil, include derived buffer spans and line signatures in When DETAILS is non-nil, include derived buffer spans and line signatures in
the returned copy without mutating BUFFER's stored snapshot table." 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) (when (and (plist-get state :root-node)
(not (plist-get state :layout-snapshots-complete-p))) (not (plist-get state :layout-snapshots-complete-p)))
(ebox--refresh-buffer-layout-snapshots buffer details))) (ebox--refresh-buffer-layout-snapshots buffer details)))
(let ((copy (make-hash-table :test 'equal))) (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) (let (entries)
(maphash (lambda (node-id snapshot) (maphash (lambda (node-id snapshot)
(push (cons node-id (push (cons node-id
@ -1479,9 +1479,9 @@ the returned copy without mutating BUFFER's stored snapshot table."
(defun ebox--clear-layout-snapshots (buffer) (defun ebox--clear-layout-snapshots (buffer)
"Clear BUFFER's layout snapshots." "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)) (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))) (clrhash snapshots)))
(defun ebox--plist-remove-key (plist key) (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. "Remove stored buffer-owned runtime state for BUFFER.
Defaults to the current buffer." Defaults to the current buffer."
(let ((buffer (or buffer (current-buffer)))) (let ((buffer (or buffer (current-buffer))))
(when-let ((cache (ebox--buffer-render-cache buffer))) (when-let* ((cache (ebox--buffer-render-cache buffer)))
(when-let ((root-cache (when-let* ((root-cache
(gethash cache ebox--render-root-cache-table-table))) (gethash cache ebox--render-root-cache-table-table)))
(remhash root-cache ebox--render-cache-ring-table)) (remhash root-cache ebox--render-cache-ring-table))
(remhash cache ebox--render-root-cache-table-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)) (dolist (region-id (get-text-property pos 'ebox-content-owners))
(cl-pushnew region-id ids :test #'equal)) (cl-pushnew region-id ids :test #'equal))
(dolist (entry ebox-region-types) (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))) (cl-pushnew region-id ids :test #'equal)))
ids)) ids))
@ -1551,7 +1551,7 @@ Defaults to the current buffer."
"Return all ebox region role/id pairs present at POS." "Return all ebox region role/id pairs present at POS."
(let (role-ids) (let (role-ids)
(dolist (entry ebox-region-types) (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))) (push (cons (car entry) region-id) role-ids)))
role-ids)) role-ids))
@ -1572,7 +1572,7 @@ Defaults to the current buffer."
(let ((map (make-hash-table :test 'eql))) (let ((map (make-hash-table :test 'eql)))
(puthash region-id map region-lines) (puthash region-id map region-lines)
map)))) map))))
(if-let ((range (gethash line-number line-map))) (if-let* ((range (gethash line-number line-map)))
(setcdr range (max (cdr range) end)) (setcdr range (max (cdr range) end))
(puthash line-number (cons start end) line-map)))) (puthash line-number (cons start end) line-map))))
@ -1681,10 +1681,10 @@ therefore unsafe."
(candidate-lines (make-hash-table :test 'eql)) (candidate-lines (make-hash-table :test 'eql))
spans) spans)
(dolist (region-id region-ids) (dolist (region-id region-ids)
(when-let ((line-map (gethash region-id region-lines))) (when-let* ((line-map (gethash region-id region-lines)))
(maphash (maphash
(lambda (line-number range) (lambda (line-number range)
(if-let ((existing (gethash line-number candidate-lines))) (if-let* ((existing (gethash line-number candidate-lines)))
(progn (progn
(setcar existing (min (car existing) (car range))) (setcar existing (min (car existing) (car range)))
(setcdr existing (max (cdr existing) (cdr range)))) (setcdr existing (max (cdr existing) (cdr range))))
@ -1728,7 +1728,7 @@ therefore unsafe."
(range-start (max (point) line-start)) (range-start (max (point) line-start))
(range-end (min end line-end))) (range-end (min end line-end)))
(when (< range-start range-end) (when (< range-start range-end)
(if-let ((existing (gethash line-start line-ranges))) (if-let* ((existing (gethash line-start line-ranges)))
(progn (progn
(setcar existing (min (car existing) range-start)) (setcar existing (min (car existing) range-start))
(setcdr existing (max (cdr existing) range-end))) (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) (defun ebox--ensure-layout-snapshot-spans (buffer node-id)
"Ensure BUFFER's stored snapshot for NODE-ID has buffer span details." "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) (if (ebox--layout-snapshot-spans-p snapshot)
snapshot snapshot
(when-let ((node (ebox--snapshot-published-node buffer node-id))) (when-let* ((node (ebox--snapshot-published-node buffer node-id)))
(let ((detailed (let ((detailed
(ebox--with-layout-snapshot-detail-context buffer (ebox--with-layout-snapshot-detail-context buffer
(ebox--complete-layout-snapshot-spans (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) (defun ebox--ensure-layout-snapshot-details (buffer node-id)
"Ensure BUFFER's stored snapshot for NODE-ID has expensive detail fields." "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) (if (ebox--layout-snapshot-detailed-p snapshot)
snapshot snapshot
(when-let ((node (ebox--snapshot-published-node buffer node-id))) (when-let* ((node (ebox--snapshot-published-node buffer node-id)))
(let ((detailed (let ((detailed
(ebox--with-layout-snapshot-detail-context buffer (ebox--with-layout-snapshot-detail-context buffer
(ebox--complete-layout-snapshot buffer node snapshot)))) (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) (defun ebox--refresh-buffer-layout-snapshots (buffer &optional details)
"Recapture BUFFER's layout snapshots from its stored runtime root. "Recapture BUFFER's layout snapshots from its stored runtime root.
When DETAILS is non-nil, include expensive per-line detail fields." 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) (ebox--clear-layout-snapshots buffer)
(let ((ebox--node-region-ids-cache (make-hash-table :test 'eq))) (let ((ebox--node-region-ids-cache (make-hash-table :test 'eq)))
(if details (if details
(ebox--with-layout-snapshot-index-context buffer (ebox--with-layout-snapshot-index-context buffer
(ebox--capture-layout-snapshots buffer root t)) (ebox--capture-layout-snapshots buffer root t))
(ebox--capture-layout-snapshots buffer root))) (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)))) (plist-put state :layout-snapshots-complete-p t))))
(defconst ebox--dirty-kind-order (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)) (car ebox-incremental--candidate-proof-node-table))
(gethash node-id (gethash node-id
(cdr ebox-incremental--candidate-proof-node-table))) (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)) (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)))) (ebox--runtime-node-by-id root node-id))))
(defun ebox--runtime-parent-id (buffer node-id) (defun ebox--runtime-parent-id (buffer node-id)
"Return NODE-ID's parent id in BUFFER runtime state." "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))) (gethash node-id parent-table)))
(defun ebox--invalidate-runtime-render-signature-path (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 signature-cache (clrhash signature-cache))
(when height-cache (clrhash height-cache))) (when height-cache (clrhash height-cache)))
(while node-id (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 signature-cache (remhash node signature-cache))
(when height-cache (remhash node height-cache))) (when height-cache (remhash node height-cache)))
(setq node-id (gethash node-id parent-table))))) (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) (defun ebox--dirty-provenance-node-ids (dirty)
"Return the distinct source node ids recorded by DIRTY provenance." "Return the distinct source node ids recorded by DIRTY provenance."
(delete-dups (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)) (list node-id))
(copy-sequence (or (plist-get dirty :node-ids) nil))))) (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 (remaining (if same-owner
(delq same-owner (copy-sequence ops)) (delq same-owner (copy-sequence ops))
(copy-sequence ops)))) (copy-sequence ops))))
(if-let ((dominator (if-let* ((dominator
(cl-find-if (cl-find-if
(lambda (op) (lambda (op)
(ebox--patch-op-dominates-p buffer op candidate)) (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 (ebox--patch-op 'paint-patch node-id
:dirty entry)) :dirty entry))
(_ (_
(if-let ((span-owner-id (if-let* ((span-owner-id
(and buffer (and buffer
(ebox--span-patch-owner-id-for-dirty-entry (ebox--span-patch-owner-id-for-dirty-entry
entry buffer)))) 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." "Return FLEX-NODE's child whose source owns NODE-ID."
(cl-find-if (cl-find-if
(lambda (child) (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))) (equal (plist-get source :node-id) node-id)))
(ebox-tree-layout-children flex-node))) (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 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 updates unless the auto flex basis stays fixed and the new minimum still fits
the already published slot." 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)) (let* ((item-props (ebox--flex-item-props child))
(fixed-basis-p (fixed-basis-p
(ebox--flex-fixed-basis-content-allocation-stable-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) (defun ebox--span-patchable-owner-p (buffer node-id)
"Return non-nil when NODE-ID can attempt verified span patching." "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 (and ;; Planning only needs to reject an explicitly visible overflow
;; owner. Content-dependent overflow remains part of the final ;; owner. Content-dependent overflow remains part of the final
;; span/role validator; formatting it here for every ancestor made ;; 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 ;; Allocation shape is coordinate-independent and survives a
;; detail-generation bump. The later owner/surface proof still ;; detail-generation bump. The later owner/surface proof still
;; resolves exact current spans before publication. ;; 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)) (plist-get snapshot :allocation-shape))
(when-let* ((snapshot (when-let* ((snapshot
(ebox--ensure-layout-snapshot-spans buffer node-id)) (ebox--ensure-layout-snapshot-spans buffer node-id))
@ -3424,7 +3424,7 @@ hash lookups instead of a scan of the whole set."
(dominator nil)) (dominator nil))
(maphash (maphash
(lambda (ancestor-id _present) (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 (when (and (>= (ebox--patch-operation-strength
(plist-get (aref entry 0) :op)) (plist-get (aref entry 0) :op))
(ebox--patch-operation-strength 'span-patch)) (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) (defun ebox--flex-participation-viewport-dependent-p (node)
"Return non-nil when NODE's flex item metadata depends on viewport context." "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 (ebox--viewport-dependent-size-value-p
(plist-get participation :flex-basis)))) (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) (defun ebox--viewport-dependent-node-ids (node)
"Return runtime node ids under NODE that depend on viewport context." "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)))))) (delete-dups (copy-sequence (append (car axes) (cdr axes))))))
(defun ebox--viewport-dirty-set (root) (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. "Return the implicit viewport constraint change for BUFFER.
AXES may be `width', `height', `both', or `none'. Nil means both axes for AXES may be `width', `height', `both', or `none'. Nil means both axes for
legacy callers." legacy callers."
(when-let ((root (ebox--buffer-root-node buffer))) (when-let* ((root (ebox--buffer-root-node buffer)))
(let* ((node-ids (let* ((node-ids
(pcase axes (pcase axes
('width ('width
@ -3860,7 +3860,7 @@ during `ebox-incremental-flush'."
(defun ebox-incremental--batch-change (buffer pending) (defun ebox-incremental--batch-change (buffer pending)
"Return a normalized batch constraint change for BUFFER and 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 (ebox--constraint-change
'batch 'batch 'batch 'batch 'batch 'batch
(ebox--ensure-node-id root) (ebox--ensure-node-id root)
@ -4624,7 +4624,7 @@ Cost is proportional to the replacements, never to the page."
(when (and sibling-id (when (and sibling-id
(not (equal sibling-id node-id)) (not (equal sibling-id node-id))
(equal (plist-get (equal (plist-get
(if-let (if-let*
((sibling-replacement ((sibling-replacement
(ebox-incremental--candidate-replacement-for-anchor (ebox-incremental--candidate-replacement-for-anchor
entries sibling-id))) 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. ;; Host refs must be fresh or freed by this same commit.
(when host-ref-table (when host-ref-table
(dolist (ref (collect-host-refs replacement nil)) (dolist (ref (collect-host-refs replacement nil))
(when-let ((existing-anchor (when-let* ((existing-anchor
(gethash ref replacement-host-refs))) (gethash ref replacement-host-refs)))
(unless (or (ancestor-p existing-anchor node-id) (unless (or (ancestor-p existing-anchor node-id)
(ancestor-p node-id existing-anchor)) (ancestor-p node-id existing-anchor))
(error "Ebox declarative host reference %S is not unique" (error "Ebox declarative host reference %S is not unique"
ref))) ref)))
(puthash ref node-id replacement-host-refs) (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) (unless (inside-replaced-anchor-p owner-id)
(error (error
"Ebox declarative host reference %S is not unique" "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) (defun ebox-incremental--copy-detached-history (state)
"Return an unpublished detached identity history copied from 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 (ebox-incremental--make-detached-history
:table :table
(copy-hash-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)))) (let ((table (copy-hash-table (plist-get old-state :range-ref-table))))
(cl-labels (cl-labels
((walk (node function) ((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)) (dolist (record (ebox-child-range--range-records sequence))
(funcall function node record))) (funcall function node record)))
(dolist (child (ebox-tree--children-raw node)) (dolist (child (ebox-tree--children-raw node))
(walk child function)))) (walk child function))))
(dolist (anchor anchors) (dolist (anchor anchors)
(when-let ((old (gethash (car anchor) (when-let* ((old (gethash (car anchor)
(plist-get old-state :node-table)))) (plist-get old-state :node-table))))
(walk old (walk old
(lambda (_parent record) (lambda (_parent record)
@ -5424,13 +5424,13 @@ Return the same pure surface-input shape as
(when (hash-table-p old-snapshots) (when (hash-table-p old-snapshots)
(maphash (maphash
(lambda (node-id _node) (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))) (puthash node-id (copy-sequence snapshot) snapshots)))
candidate-node-table) candidate-node-table)
;; A root type replacement receives a fresh runtime id, but its patch ;; A root type replacement receives a fresh runtime id, but its patch
;; owner still covers the currently published complete-buffer geometry. ;; owner still covers the currently published complete-buffer geometry.
(unless (equal old-root-id candidate-root-id) (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 (copy-sequence snapshot))
(setq snapshot (plist-put snapshot :node-id candidate-root-id)) (setq snapshot (plist-put snapshot :node-id candidate-root-id))
(puthash candidate-root-id snapshot snapshots)))) (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 (defun ebox-incremental--simple-new-child-splice-p
(buffer owner-id dirty) (buffer owner-id dirty)
"Return non-nil when DIRTY is a cheap vertical child splice." "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)) (pcase-let* ((old-ids (plist-get dirty :old-child-ids))
(new-ids (plist-get dirty :new-child-ids)) (new-ids (plist-get dirty :new-child-ids))
(`(,_old-middle ,new-middle) (`(,_old-middle ,new-middle)
(ebox-incremental--child-list-middle old-ids new-ids))) (ebox-incremental--child-list-middle old-ids new-ids)))
(and (eq (plist-get owner :ebox-type) 'stack) (and (eq (plist-get owner :ebox-type) 'stack)
(eq (ebox-tree-display-inner owner) 'column) (eq (ebox-tree-display-inner owner) 'column)
(when-let ((snapshot (when-let* ((snapshot
(ebox--ensure-layout-snapshot-spans (ebox--ensure-layout-snapshot-spans
buffer owner-id))) buffer owner-id)))
(unless (with-current-buffer buffer (unless (with-current-buffer buffer
@ -5593,10 +5593,10 @@ Return the same pure surface-input shape as
((hash-table-p owned-table))) ((hash-table-p owned-table)))
(copy-hash-table owned-table) (copy-hash-table owned-table)
(let ((table (make-hash-table :test 'equal))) (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 (maphash
(lambda (region-id _present) (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))) (puthash region-id box table)))
region-id-set)) region-id-set))
table))) table)))
@ -5636,7 +5636,7 @@ Return the same pure surface-input shape as
(ebox--ensure-node-id node) (ebox--ensure-node-id node)
node)) node))
('flex ('flex
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box) (list (ebox--ensure-region-id box)
(ebox--ensure-node-id node) (ebox--ensure-node-id node)
box))))) box)))))
@ -5680,7 +5680,7 @@ complete preorder first-owner and postorder last-box semantics."
(cl-labels (cl-labels
((visit (node) ((visit (node)
(when (and (listp node) (not (stringp node))) (when (and (listp node) (not (stringp node)))
(when-let ((record (when-let* ((record
(ebox-incremental--candidate-node-region-record node))) (ebox-incremental--candidate-node-region-record node)))
(pcase-let ((`(,region-id ,owner-id ,_box) record)) (pcase-let ((`(,region-id ,owner-id ,_box) record))
(when (gethash region-id region-ids) (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))))) (puthash region-id owner-id region-node-table)))))
(dolist (child (ebox--node-children node)) (dolist (child (ebox--node-children node))
(visit child)) (visit child))
(when-let ((record (when-let* ((record
(ebox-incremental--candidate-node-region-record node))) (ebox-incremental--candidate-node-region-record node)))
(pcase-let ((`(,region-id ,_owner-id ,box) record)) (pcase-let ((`(,region-id ,_owner-id ,box) record))
(when (gethash region-id region-ids) (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) runtime-type-count-table node -1)
(remhash node-id node-table) (remhash node-id node-table)
(remhash node-id parent-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) (when (equal (gethash host-ref host-ref-table) node-id)
(remhash host-ref host-ref-table))) (remhash host-ref host-ref-table)))
(when-let ((record (when-let* ((record
(ebox-incremental--candidate-node-region-record node))) (ebox-incremental--candidate-node-region-record node)))
(puthash (car record) t affected-region-ids)) (puthash (car record) t affected-region-ids))
(when (hash-table-p old-region-box-count-table) (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 (when old-node
(ebox-incremental--adjust-runtime-type-count (ebox-incremental--adjust-runtime-type-count
runtime-type-count-table old-node -1) runtime-type-count-table old-node -1)
(when-let ((record (when-let* ((record
(ebox-incremental--candidate-node-region-record (ebox-incremental--candidate-node-region-record
old-node))) old-node)))
(puthash (car record) t affected-region-ids)) (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)) (remhash node-id parent-table))
;; Replacement subtrees were validated before recording and ;; Replacement subtrees were validated before recording and
;; checked against untouched Host refs before path copying. ;; 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)) (puthash new-host-ref node-id host-ref-table))
(when-let ((record (when-let* ((record
(ebox-incremental--candidate-node-region-record (ebox-incremental--candidate-node-region-record
new-node))) new-node)))
(puthash (car record) t affected-region-ids)) (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: ;; TOUCHED is preorder, matching `ebox--runtime-index' ownership:
;; a flex owner claims its wrapper before the wrapper box is visited. ;; a flex owner claims its wrapper before the wrapper box is visited.
(dolist (entry touched) (dolist (entry touched)
(when-let ((record (when-let* ((record
(ebox-incremental--candidate-node-region-record (ebox-incremental--candidate-node-region-record
(nth 1 entry)))) (nth 1 entry))))
(pcase-let ((`(,region-id ,owner-id ,box) record)) (pcase-let ((`(,region-id ,owner-id ,box) record))
@ -6221,7 +6221,7 @@ CANDIDATE-INDEX is the prepared runtime index for CANDIDATE-ROOT."
dirty) dirty)
(maphash (maphash
(lambda (node-id new-node) (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 (let* ((changed-keys
(ebox-tree-node-local-changed-keys (ebox-tree-node-local-changed-keys
old-node new-node)) 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)) (hash-table-p candidate-node-table))
(maphash (maphash
(lambda (node-id candidate-node) (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))) (let ((cached (gethash old-node old-cache missing)))
(unless (eq cached missing) (unless (eq cached missing)
(puthash candidate-node cached candidate-cache))))) (puthash candidate-node cached candidate-cache)))))
@ -6391,7 +6391,7 @@ must be recomputed in the next publication."
old-node-table old-parent-table old-node-table old-parent-table
candidate-cache nil)) candidate-cache nil))
(dolist (node-id (append touched-node-ids removed-node-ids)) (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))) (remhash old-node candidate-cache)))
candidate-cache)) candidate-cache))
@ -6606,7 +6606,7 @@ must be recomputed in the next publication."
('geometry ('geometry
(ebox--patch-op-from-dirty-entry entry buffer)) (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--span-patch-owner-id-for-dirty-entry entry buffer)))
(ebox--patch-op 'span-patch span-owner-id :dirty entry) (ebox--patch-op 'span-patch span-owner-id :dirty entry)
(when (and (eq dirty-kind 'structure) (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 ;; One dirty entry needs no dominance/coalescing pass. Build
;; its tentative operation directly; the exact span or ;; its tentative operation directly; the exact span or
;; allocation proof below still owns authorization. ;; allocation proof below still owns authorization.
(when-let ((op (when-let* ((op
(ebox-incremental--declarative-tentative-op (ebox-incremental--declarative-tentative-op
buffer dirty))) buffer dirty)))
(list op))) (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)) (index (ebox--make-patch-op-merge-index))
ops) ops)
(ebox--with-layout-snapshot-detail-context buffer (ebox--with-layout-snapshot-detail-context buffer
(if-let ((coalesced-op (if-let* ((coalesced-op
(and (not (and (not
(ebox-incremental--dirty-set-has-child-splice-p (ebox-incremental--dirty-set-has-child-splice-p
buffer render-dirty-set)) 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 (defun ebox-incremental--layout-owner-plan
(buffer old-state candidate-state dirty-set) (buffer old-state candidate-state dirty-set)
"Return BUFFER layout-owner plan from OLD-STATE to CANDIDATE-STATE for 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 (cl-remove-if
(lambda (entry) (lambda (entry)
(eq (plist-get entry :dirty-kind) 'metadata)) (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 (cl-some
(lambda (entry) (lambda (entry)
(and (eq (plist-get entry :dirty-kind) 'structure) (and (eq (plist-get entry :dirty-kind) 'structure)
(when-let ((object (when-let* ((object
(gethash (plist-get entry :node-id) (gethash (plist-get entry :node-id)
objects))) objects)))
(null (gethash object style-states))))) (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) (defun ebox-incremental--root-owner-plan (buffer dirty-set)
"Return one conservative root owner operation for 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 (list
(ebox--patch-op (ebox--patch-op
'owner-rerender root-id '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) (defun ebox-incremental--native-frame-plan (buffer dirty-set)
"Return the bounded publication plan for a complete native frame." "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 (list
(ebox--patch-op (ebox--patch-op
'native-frame root-id '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) (and (consp value)
(or (eq (car value) 'viewport-height) (or (eq (car value) 'viewport-height)
(memq (car value) '(+ -))))) (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)) (ebox--box-sizing-content-height box (max 0 height))
fallback)) fallback))
(t (t
@ -925,7 +925,7 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values."
(defun ebox--box-content (box) (defun ebox--box-content (box)
"Return BOX content, rendering any lazy child layout content if present." "Return BOX content, rendering any lazy child layout content if present."
(ebox--propertize-typography (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--render-box-content-node box node))
(ebox-get box :content)) (ebox-get box :content))
box)) box))
@ -980,7 +980,7 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values."
(defun ebox--stretch-content-pixel (box) (defun ebox--stretch-content-pixel (box)
"Return BOX's stretch-fit content width, or nil without a viewport." "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))))) (max 0 (- viewport (ebox--side-pixel box)))))
(defun ebox--fit-content-pixel (box limit) (defun ebox--fit-content-pixel (box limit)
@ -1000,7 +1000,7 @@ Return nil for intrinsic sizes such as min-content and max-content."
(cond (cond
((null value) nil) ((null value) nil)
((ebox--viewport-size-value-p value) ((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))) (ebox--box-sizing-content-pixel box viewport)))
((numberp value) ((numberp value)
(ebox--box-sizing-content-pixel box 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))) (let ((limit (cadr value)))
(cond (cond
((ebox--viewport-size-value-p limit) ((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))) (ebox--box-sizing-content-pixel box viewport)))
((numberp limit) ((numberp limit)
(ebox--box-sizing-content-pixel box limit)) (ebox--box-sizing-content-pixel box limit))
@ -1087,7 +1087,7 @@ FALLBACK is used for nil and auto values."
(cond (cond
((null value) fallback) ((null value) fallback)
((eq value 'viewport) ((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) (ebox--box-sizing-content-pixel box viewport)
fallback)) fallback))
((numberp value) ((numberp value)
@ -2153,7 +2153,7 @@ last cached leaf instead of walking the stack from the beginning."
(defun ebox--scroll-window-content-height (box) (defun ebox--scroll-window-content-height (box)
"Return BOX's definite scroll content height, or nil." "Return BOX's definite scroll content height, or nil."
(when-let ((fixed-height (when-let* ((fixed-height
(ebox--resolve-size-content-height (ebox--resolve-size-content-height
box (ebox-get box :height) nil))) box (ebox-get box :height) nil)))
(ebox--content-height box fixed-height))) (ebox--content-height box fixed-height)))
@ -2706,7 +2706,7 @@ no included vertical margin."
(ebox--propertize-underline (ebox--propertize-underline
(car tail) border-bottom-color) (car tail) border-bottom-color)
'ebox-bb region-id)))) 'ebox-bb region-id))))
(when-let ((properties (ebox-get box :surface-properties))) (when-let* ((properties (ebox-get box :surface-properties)))
(setq lines (setq lines
(mapcar (lambda (line) (mapcar (lambda (line)
(ebox--apply-surface-properties line properties)) (ebox--apply-surface-properties line properties))

6
ebox-native-commit.el
View File

@ -112,7 +112,7 @@
do (puthash (plist-get child :node-id) do (puthash (plist-get child :node-id)
(cons parent-id position) table))) (cons parent-id position) table)))
nodes) 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))) (puthash (plist-get root :node-id) (cons nil 0) table)))
table)) table))
@ -391,7 +391,7 @@ type, key, parent, and sibling position are identical."
(defun ebox-native-commit--promote-pending-frame (state session) (defun ebox-native-commit--promote-pending-frame (state session)
"Promote STATE's previously published pending frame in 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 (ebox-native-reflow-confirm-native-frame
session (plist-get pending :generation) (plist-get pending :key) session (plist-get pending :generation) (plist-get pending :key)
(plist-get pending :confirmed-revision)) (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)) (memq (plist-get state :projection-kind) '(nil native-frame))
(ebox-native-commit--runtime-types-supported-p state) (ebox-native-commit--runtime-types-supported-p state)
(ebox-native-commit--region-index-safe-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 (condition-case err
(let* ((frame (ebox-native-commit--retained-frame (let* ((frame (ebox-native-commit--retained-frame
state node frame-spec)) state node frame-spec))

56
ebox-native-reflow.el
View File

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

6
ebox-selector.el
View File

@ -106,10 +106,10 @@
(pcase (and (listp node) (plist-get node :ebox-type)) (pcase (and (listp node) (plist-get node :ebox-type))
('box (ebox--ensure-region-id node)) ('box (ebox--ensure-region-id node))
('flex ('flex
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(ebox--ensure-region-id box))) (ebox--ensure-region-id box)))
('grid ('grid
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(ebox--ensure-region-id box))) (ebox--ensure-region-id box)))
('flex-item ('flex-item
(ebox-selector--node-region-id (plist-get node :node))) (ebox-selector--node-region-id (plist-get node :node)))
@ -254,7 +254,7 @@
(defun ebox-selector--query-buffer-index (buffer selector ast) (defun ebox-selector--query-buffer-index (buffer selector ast)
"Return `(SUPPORTED . HANDLES)' for an indexed AST query in BUFFER." "Return `(SUPPORTED . HANDLES)' for an indexed AST query in BUFFER."
(when (ebox-selector--descendant-indexable-p ast) (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 (cons
t t
(ebox-selector--entries-to-buffer-handles (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) (defun ebox-style-canonical-name (name)
"Return canonical CSS-like longhand property name for 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))) (plist-get property :name)))
(defun ebox-style-schema-id (name) (defun ebox-style-schema-id (name)
"Return namespaced ECSS schema id for Ebox property 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))) (plist-get property :id)))
(defun ebox-style--put (plist key value) (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 :validator (ebox-style--validator
(plist-get property :validator)) (plist-get property :validator))
:equality #'equal))) :equality #'equal)))
(when-let ((shorthand (ebox-style--shorthand (when-let* ((shorthand (ebox-style--shorthand
(plist-get property :shorthand)))) (plist-get property :shorthand))))
(setq options (plist-put options :shorthand shorthand))) (setq options (plist-put options :shorthand shorthand)))
options)) options))
@ -980,7 +980,7 @@ child colors are handled by `ebox-style--theme-parent-delta-computed'."
(defun ebox-style--add-border-aggregates (style) (defun ebox-style--add-border-aggregates (style)
"Add uniform border shorthand facts to public computed STYLE." "Add uniform border shorthand facts to public computed STYLE."
(dolist (component '(width style color) 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 (setq style
(plist-put style (intern (format ":border-%s" component)) value))))) (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) (defun ebox-style--apply-container-wrapper (node style &optional snapshot)
"Apply computed STYLE to NODE's internal visual wrapper." "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 (ebox-style--apply-engine-values
wrapper wrapper
(ebox-style--box-values style snapshot)) (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))) (when-let* ((source (plist-get item :node)))
(let* ((source-style (plist-get source :ebox-computed-style)) (let* ((source-style (plist-get source :ebox-computed-style))
(child-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))) (plist-get child :ebox-computed-style)))
(values (values
(append (append
@ -1234,7 +1234,7 @@ SNAPSHOT reuses a previously detached ECSS values snapshot when supplied."
(defun ebox-style-dirty-kind (name) (defun ebox-style-dirty-kind (name)
"Return dirty kind for canonical property or alias 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))) (plist-get property :dirty-kind)))
(defun ebox-style-signature (computed-style groups) (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) (defun ebox-surface--style-state-table (previous-state)
"Copy retained style state from PREVIOUS-STATE into a weak table." "Copy retained style state from PREVIOUS-STATE into a weak table."
(let ((table (make-hash-table :test 'eq :weakness 'key))) (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)) (maphash (lambda (object state) (puthash object state table)) previous))
table)) table))
@ -294,7 +294,7 @@ construction time and can use the static projection path."
(ebox-surface--signals-scroll signals))) (ebox-surface--signals-scroll signals)))
(when (tp-signal-live-p signal) (when (tp-signal-live-p signal)
(tp-signal-dispose 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) (when (buffer-live-p buffer)
(with-current-buffer buffer (with-current-buffer buffer
(when (eq ebox-surface--context-signals signals) (when (eq ebox-surface--context-signals signals)
@ -311,6 +311,18 @@ construction time and can use the static projection path."
table)) table))
(sort offsets (lambda (left right) (< (car left) (car right)))))) (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 (defun ebox-surface--context-values
(buffer old-state state-overrides) (buffer old-state state-overrides)
"Return BUFFER context values after OLD-STATE and 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 (let ((scroll-table
(value :scroll-state-table (value :scroll-state-table
(plist-get old-state :scroll-state-table))) (plist-get old-state :scroll-state-table)))
;; Prefer the window the user is actually interacting with. A (window (ebox-surface--buffer-display-window buffer)))
;; 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)))))
(list :viewport-width (list :viewport-width
(value :viewport-width (value :viewport-width
(or ebox-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) (defun ebox-surface-region-bounds (buffer region-id &optional roles)
"Return numeric bounds for REGION-ID's TP mounts in BUFFER. "Return numeric bounds for REGION-ID's TP mounts in BUFFER.
ROLES has the same filtering meaning as in `ebox-surface-region-mounts'." 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)) (cons (apply #'min (mapcar (lambda (mount) (plist-get mount :start)) mounts))
(apply #'max (mapcar (lambda (mount) (plist-get mount :end)) mounts))))) (apply #'max (mapcar (lambda (mount) (plist-get mount :end)) mounts)))))
(defun ebox-surface--runtime-keys (state key) (defun ebox-surface--runtime-keys (state key)
"Return hash keys stored under KEY in runtime STATE." "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))) (ebox-surface--hash-keys table)))
(defun ebox-surface--bind-scroll-states-to-buffer (state buffer) (defun ebox-surface--bind-scroll-states-to-buffer (state buffer)
"Bind every semantic scroll state in STATE to its owning 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 (maphash
(lambda (region-id scroll-state) (lambda (region-id scroll-state)
(puthash region-id (plist-put scroll-state :buffer buffer) table)) (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")) (error "Ebox framework participant is not unpublished"))
(setf (ebox-surface--framework-participant-state participant) 'published) (setf (ebox-surface--framework-participant-state participant) 'published)
(setq report (ebox-surface--participant-report participant report '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)) (funcall publish report))
report) report)
@ -559,7 +561,7 @@ ROLES has the same filtering meaning as in `ebox-surface-region-mounts'."
(ebox-surface--participant-report (ebox-surface--participant-report
participant (ebox-surface--framework-participant-report participant) participant (ebox-surface--framework-participant-report participant)
'rolled-back) 'rolled-back)
(when-let ((rollback (when-let* ((rollback
(ebox-surface--framework-participant-rollback participant))) (ebox-surface--framework-participant-rollback participant)))
(let ((inhibit-quit t) (let ((inhibit-quit t)
(quit-flag nil)) (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 ;; not the now-committed TP mounts. Drop only those owners' derived
;; geometry so the next transaction lazily captures the committed ;; geometry so the next transaction lazily captures the committed
;; spans and cannot drift across a repeated selection round trip. ;; 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)) (dolist (proof (plist-get new-state :owner-scoped-proofs))
(when (plist-get proof :role-owned-lines-p) (when (plist-get proof :role-owned-lines-p)
(let ((owner-id (plist-get proof :owner-id))) (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 (puthash owner-id
(ebox--layout-snapshot-strip-details snapshot) (ebox--layout-snapshot-strip-details snapshot)
snapshots)))))) 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) (defun ebox-surface--reconcile-candidate (root previous-state)
"Reconcile styled ROOT with PREVIOUS-STATE runtime identities." "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)) (ebox-tree-reconcile-runtime previous-root root))
root) root)
@ -1401,7 +1403,7 @@ published generation so a failed transaction has no cache state to restore."
(cl-labels (cl-labels
((visit (node) ((visit (node)
(when (and (listp node) (not (stringp 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)) (puthash region-id t ids))
(dolist (child (ebox-tree--children-raw node)) (dolist (child (ebox-tree--children-raw node))
(visit child))))) (visit child)))))
@ -1416,7 +1418,7 @@ published generation so a failed transaction has no cache state to restore."
(defun ebox-surface--node-key (node) (defun ebox-surface--node-key (node)
"Return NODE's namespaced sibling key, or nil for positional identity." "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))) (list 'ebox/key key)))
(defun ebox-surface--node-kind (node) (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-signature selector-tree-token
stylesheet-subject-local-p) stylesheet-subject-local-p)
"Compute and apply NODE style using retained OBJECT and SUBJECT-TABLE." "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) (if (and (hash-table-p ebox-surface--inline-style-value-cache)
(not (ebox-surface--node-style-binding-required-p node))) (not (ebox-surface--node-style-binding-required-p node)))
(when-let* ((parent (ecss-subject-parent subject)) (when-let* ((parent (ecss-subject-parent subject))
(binding (gethash parent bindings-by-subject))) (binding (gethash parent bindings-by-subject)))
(puthash subject binding 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))) (puthash subject state states-by-subject)))
(ebox-style-apply-computed (ebox-style-apply-computed
node node
@ -1787,7 +1789,7 @@ dependencies, or any malformed index conservatively preserves root planning."
(defun ebox-surface--retained-scroll-lookahead (state) (defun ebox-surface--retained-scroll-lookahead (state)
"Return lookahead needed to retain STATE's prepared lazy prefixes." "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)) (let ((maximum 0))
(maphash (maphash
(lambda (_region-id scroll-state) (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." "Restore reusable lazy-scroll SNAPSHOT fields into TABLE."
(maphash (maphash
(lambda (region-id metadata) (lambda (region-id metadata)
(when-let ((state (gethash region-id table))) (when-let* ((state (gethash region-id table)))
(while metadata (while metadata
(setq state (setq state
(plist-put state (pop metadata) (pop metadata)))) (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)) (when (and (hash-table-p nodes) (hash-table-p objects))
(maphash (maphash
(lambda (node-id object) (lambda (node-id object)
(when-let ((node (gethash node-id nodes))) (when-let* ((node (gethash node-id nodes)))
(plist-put node :surface-object object))) (plist-put node :surface-object object)))
objects)) objects))
state)) state))
@ -2251,7 +2253,7 @@ old allocated width while the owner changes its natural content length."
(if (or allocation-closure-p (if (or allocation-closure-p
retain-external-owner-suffix-p) retain-external-owner-suffix-p)
(and owned-rendered (and owned-rendered
(when-let ((owners (when-let* ((owners
(ebox-surface--retained-external-owner-suffix (ebox-surface--retained-external-owner-suffix
buffer spans region-ids))) buffer spans region-ids)))
(ebox--add-content-owners owned-rendered owners))) (ebox--add-content-owners owned-rendered owners)))
@ -2366,7 +2368,7 @@ old allocated width while the owner changes its natural content length."
(sort pairs (sort pairs
(lambda (left right) (lambda (left right)
(< (car (car left)) (car (car right)))))) (< (car (car left)) (car (car right))))))
(when-let ((output (when-let* ((output
(ebox-surface--replace-buffer-spans (ebox-surface--replace-buffer-spans
source origin (mapcar #'car pairs) source origin (mapcar #'car pairs)
(mapcar #'cdr pairs)))) (mapcar #'cdr pairs))))
@ -2607,7 +2609,7 @@ causes the caller to use the ordinary full projection."
(make-hash-table :test #'equal))) (make-hash-table :test #'equal)))
(when (and output old-fragments paint-owner-ids) (when (and output old-fragments paint-owner-ids)
(dolist (fragment old-fragments) (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) (puthash address fragment old-by-address)
(let* ((roles (plist-get fragment :paint-role-ids)) (let* ((roles (plist-get fragment :paint-role-ids))
(owner (cdr (assq 'content roles))) (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) (defun ebox-surface--role-ids-from-properties (properties)
"Return namespaced Ebox role/id pairs from PROPERTIES." "Return namespaced Ebox role/id pairs from PROPERTIES."
(let (roles) (let (roles)
(when-let ((region-id (when-let* ((region-id
(plist-get properties 'ebox-overflow-foreground-source))) (plist-get properties 'ebox-overflow-foreground-source)))
(push (cons 'overflow-foreground region-id) roles)) (push (cons 'overflow-foreground region-id) roles))
(dolist (region-id (plist-get properties 'ebox-content-owners)) (dolist (region-id (plist-get properties 'ebox-content-owners))
(cl-pushnew (cons 'content-owner region-id) roles :test #'equal)) (cl-pushnew (cons 'content-owner region-id) roles :test #'equal))
(dolist (entry ebox-region-types) (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))) (cl-pushnew (cons (car entry) region-id) roles :test #'equal)))
(nreverse roles))) (nreverse roles)))
@ -2934,11 +2936,11 @@ when it needs to mutate them."
(setq position (max next (1+ position))))) (setq position (max next (1+ position)))))
(setq fragments (nreverse fragments)) (setq fragments (nreverse fragments))
(dolist (fragment 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) (setq previous-role-ids roles)
(plist-put fragment :previous-role-ids previous-role-ids))) (plist-put fragment :previous-role-ids previous-role-ids)))
(dolist (fragment (reverse (copy-sequence fragments))) (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) (setq next-role-ids roles)
(plist-put fragment :role-ids (plist-put fragment :role-ids
(delete-dups (delete-dups
@ -3046,7 +3048,7 @@ and shifted without inspecting its text properties."
(plist-put copy :paint-address (plist-put copy :paint-address
(copy-tree (copy-tree
(plist-get old :paint-address))) (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 (plist-put copy :paint-node-chain
(copy-sequence chain))) (copy-sequence chain)))
(plist-put copy :text output) (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) (defun ebox-surface--materialized-fragment-ledger (state)
"Return STATE's paint ledger, expanding a native frame only on demand." "Return STATE's paint ledger, expanding a native frame only on demand."
(let ((ledger (plist-get state :surface-fragments))) (let ((ledger (plist-get state :surface-fragments)))
(if-let ((frame (and (listp ledger) (if-let* ((frame (and (listp ledger)
(plist-get ledger :native-frame)))) (plist-get ledger :native-frame))))
(ebox-native-reflow-frame-fragments frame) (ebox-native-reflow-frame-fragments frame)
ledger))) ledger)))
@ -3472,7 +3474,7 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges."
(let ((region-nodes (plist-get state :region-node-table)) (let ((region-nodes (plist-get state :region-node-table))
(parents (plist-get state :parent-table)) deepest deepest-depth) (parents (plist-get state :parent-table)) deepest deepest-depth)
(dolist (entry role-ids) (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))) (let ((depth (ebox-surface--node-depth state node-id)))
(when (or (null deepest-depth) (> depth deepest-depth)) (when (or (null deepest-depth) (> depth deepest-depth))
(setq deepest node-id deepest-depth 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) (defun ebox-surface--box-face-contributions (box)
"Return BOX typography and color contributions in render order." "Return BOX typography and color contributions in render order."
(let (faces) (let (faces)
(when-let ((font (ebox-buffer--font-face box))) (when-let* ((font (ebox-buffer--font-face box)))
(push font faces)) (push font faces))
(when-let ((color (plist-get box :color))) (when-let* ((color (plist-get box :color)))
(push (ebox-surface--foreground-face color) faces)) (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)) (push (list :background background) faces))
(nreverse faces))) (nreverse faces)))
@ -3508,7 +3510,7 @@ ANCESTOR-P means BOX wraps a more specific rendered surface."
(let (faces) (let (faces)
(cond (cond
((memq 'overflow-foreground roles) ((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))) (push (ebox-surface--foreground-face color) faces)))
((memq 'bl roles) ((memq 'bl roles)
(push (ebox-buffer-side-border-face (push (ebox-buffer-side-border-face
@ -3531,7 +3533,7 @@ ANCESTOR-P means BOX wraps a more specific rendered surface."
(list (list
(list :underline (list :underline
(append '(:position t) (append '(:position t)
(when-let ((color (when-let* ((color
(plist-get box :border-bottom-color))) (plist-get box :border-bottom-color)))
(list :color color)))))))) (list :color color))))))))
faces)) faces))
@ -3661,7 +3663,7 @@ relative face contributions and performs the final merge during prepare."
(if baseline (if baseline
(put-text-property 0 length 'face baseline text) (put-text-property 0 length 'face baseline text)
(remove-text-properties 0 length '(face nil) 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)))) (let ((props (list 'face (copy-tree face))))
(if (and contributions (if (and contributions
(= (plist-get (car contributions) :end) offset) (= (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))) (let ((roles (cl-remove pair (plist-get fragment key) :test #'equal)))
(plist-put fragment key (if anchor-p (append roles (list pair)) roles)))) (plist-put fragment key (if anchor-p (append roles (list pair)) roles))))
(when (> (length (plist-get fragment :text)) 0) (when (> (length (plist-get fragment :text)) 0)
(if-let ((owner (if-let* ((owner
(cdr (cl-find role (cdr (cl-find role
(plist-get fragment :paint-role-ids) (plist-get fragment :paint-role-ids)
:key #'car :test #'eq :from-end t)))) :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) (and (eq projection-kind 'mixed-owner-reflow)
(plist-get previous-state :viewport-dependent-node-ids-ready) (plist-get previous-state :viewport-dependent-node-ids-ready)
(plist-member previous-state :viewport-dependent-node-id-axes) (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 (cl-every
(lambda (entry) (lambda (entry)
(cl-every (cl-every
@ -4079,7 +4081,7 @@ published runtime and must be consumed without clearing those shared nodes."
previous-state state) previous-state state)
(ebox-surface--render-candidate state))) (ebox-surface--render-candidate state)))
((memq projection-kind '(span-patch owner-scoped)) ((memq projection-kind '(span-patch owner-scoped))
(if-let ((span-output (if-let* ((span-output
(ebox-surface--span-patch-output (ebox-surface--span-patch-output
(ebox-surface--signals-buffer signals) state))) (ebox-surface--signals-buffer signals) state)))
span-output 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) (when (listp node)
(let ((attributes (let ((attributes
(delq nil (delq nil
(list (when-let ((id (ebox-tree-node-id node))) (list (when-let* ((id (ebox-tree-node-id node)))
(cons :id id)) (cons :id id))
(when-let ((key (ebox-tree-node-key node))) (when-let* ((key (ebox-tree-node-key node)))
(cons :key key)))))) (cons :key key))))))
(dolist (attribute (plist-get node :selector-attributes)) (dolist (attribute (plist-get node :selector-attributes))
(unless (consp attribute) (unless (consp attribute)
@ -145,11 +145,11 @@ This is an optimization for snapshot capture, not buffer runtime state.")
('stack ('stack
(ebox-tree-layout-children node)) (ebox-tree-layout-children node))
('flex ('flex
(append (when-let ((box (plist-get node :box))) (append (when-let* ((box (plist-get node :box)))
(list box)) (list box))
(ebox-tree-layout-children node))) (ebox-tree-layout-children node)))
('grid ('grid
(append (when-let ((box (plist-get node :box))) (append (when-let* ((box (plist-get node :box)))
(list box)) (list box))
(ebox-tree-layout-children node))) (ebox-tree-layout-children node)))
('flex-item ('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. "Return CHILD's identity replacement from REPLACEMENTS, when present.
REPLACEMENTS is an alist whose keys are compared with `eq'. Nil is not a REPLACEMENTS is an alist whose keys are compared with `eq'. Nil is not a
child and is therefore never used as a replacement key." 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) (cdr replacement)
child)) child))
@ -253,7 +253,7 @@ still copied while every nested value remains shared."
(ebox-tree--replace-direct-child-list children replacements))) (ebox-tree--replace-direct-child-list children replacements)))
(unless (eq replaced children) (unless (eq replaced children)
(setq copy (plist-put copy :children replaced))))) (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)))) (plist-get copy :ebox-child-sequence))))
(let ((updated sequence) changed fallback) (let ((updated sequence) changed fallback)
(dolist (replacement replacements) (dolist (replacement replacements)
@ -349,7 +349,7 @@ original object identity."
(setq copy (without copy :children)) (setq copy (without copy :children))
(pcase type (pcase type
((or 'flex 'grid) ((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))))) (setq copy (plist-put copy :box (copy-node box)))))
('concat ('concat
(setq copy (without (without copy :left) :right))) (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))) node node-id-set region-id-set)))
(pcase (plist-get node :ebox-type) (pcase (plist-get node :ebox-type)
('box ('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 (plist-put shell :ebox-content-node
(ebox-tree--runtime-identity-skeleton (ebox-tree--runtime-identity-skeleton
child node-id-set region-id-set)))) 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)) child node-id-set region-id-set))
(ebox-tree-layout-children node)))) (ebox-tree-layout-children node))))
((or 'flex 'grid) ((or 'flex 'grid)
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(plist-put shell :box (plist-put shell :box
(ebox-tree--runtime-identity-skeleton (ebox-tree--runtime-identity-skeleton
box node-id-set region-id-set))) 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)) child node-id-set region-id-set))
(ebox-tree-layout-children node)))) (ebox-tree-layout-children node))))
('flex-item ('flex-item
(when-let ((child (plist-get node :node))) (when-let* ((child (plist-get node :node)))
(plist-put shell :node (plist-put shell :node
(ebox-tree--runtime-identity-skeleton (ebox-tree--runtime-identity-skeleton
child node-id-set region-id-set))))) 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, ;; focused preflight is also used by initial buffer mounting,
;; where it must remain finite for malformed graphs. ;; where it must remain finite for malformed graphs.
(unless (gethash node active) (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))) (let ((count (hash-table-count host-refs)))
(puthash host-ref t host-refs) (puthash host-ref t host-refs)
(when (= count (hash-table-count 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")) (error "Ebox child Range descriptor is invalid here"))
(push entry children)))) (push entry children))))
(dolist (child (nreverse children)) (dolist (child (nreverse children))
(when-let ((key (and (listp child) (when-let* ((key (and (listp child)
(not (stringp child)) (not (stringp child))
(plist-get child :key)))) (plist-get child :key))))
(when (gethash key keys) (when (gethash key keys)
@ -647,7 +647,7 @@ look like a geometry mutation."
(memq (plist-get node :ebox-type) '(grid flex)))) (memq (plist-get node :ebox-type) '(grid flex))))
(push key signature) (push key signature)
(push value 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 :ebox-layout-props signature)
(push layout signature)) (push layout signature))
(nreverse signature))) (nreverse signature)))
@ -751,11 +751,11 @@ candidate runtime index agree."
(children) (children)
(let ((table (make-hash-table :test 'equal))) (let ((table (make-hash-table :test 'equal)))
(dolist (child children table) (dolist (child children table)
(when-let ((key (node-key child))) (when-let* ((key (node-key child)))
(puthash key child table))))) (puthash key child table)))))
(match-child (match-child
(old-children old-keyed new-child index) (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))) (let ((old-child (gethash key old-keyed)))
(and (same-type-p old-child new-child) old-child)) (and (same-type-p old-child new-child) old-child))
(let ((old-child (nth index old-children))) (let ((old-child (nth index old-children)))
@ -809,7 +809,7 @@ candidate runtime index agree."
"Return NODE's logical children without internal layout adapters." "Return NODE's logical children without internal layout adapters."
(pcase (and (listp node) (plist-get node :ebox-type)) (pcase (and (listp node) (plist-get node :ebox-type))
('box ('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))) (ebox-tree--semantic-layout-leaves content-node)))
((or 'concat 'stack) ((or 'concat 'stack)
(ebox-tree--semantic-layout-leaves node)) (ebox-tree--semantic-layout-leaves node))
@ -831,11 +831,11 @@ candidate runtime index agree."
(when (and (listp node) (not (stringp node))) (when (and (listp node) (not (stringp node)))
(let* ((current-path (append path (list node))) (let* ((current-path (append path (list node)))
(entry (cons node current-path))) (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)) (prepend id-table id entry))
(dolist (class (ebox-tree-node-classes node)) (dolist (class (ebox-tree-node-classes node))
(prepend class-table class entry)) (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)) (prepend type-table type entry))
(dolist (child (ebox-tree-semantic-children node)) (dolist (child (ebox-tree-semantic-children node))
(visit child current-path)))))) (visit child current-path))))))
@ -937,14 +937,14 @@ not only the public update ids."
(ebox-tree-layout-children node)))) (ebox-tree-layout-children node))))
('flex ('flex
(append (append
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box))) (list (ebox--ensure-region-id box)))
(apply #'append (apply #'append
(mapcar #'ebox-tree-node-all-region-ids (mapcar #'ebox-tree-node-all-region-ids
(ebox-tree-layout-children node))))) (ebox-tree-layout-children node)))))
('grid ('grid
(append (append
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box))) (list (ebox--ensure-region-id box)))
(apply #'append (apply #'append
(mapcar #'ebox-tree-node-all-region-ids (mapcar #'ebox-tree-node-all-region-ids
@ -981,14 +981,14 @@ cannot be inspected and reports no conflict."
(ebox-tree-layout-children node))) (ebox-tree-layout-children node)))
('flex ('flex
(or (and inherited (or (and inherited
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(and (plist-get box paint-key) t))) (and (plist-get box paint-key) t)))
(cl-some (lambda (child) (cl-some (lambda (child)
(ebox-tree-node-paint-conflict-p child paint-key t)) (ebox-tree-node-paint-conflict-p child paint-key t))
(ebox-tree-layout-children node)))) (ebox-tree-layout-children node))))
('grid ('grid
(or (and inherited (or (and inherited
(when-let ((box (plist-get node :box))) (when-let* ((box (plist-get node :box)))
(and (plist-get box paint-key) t))) (and (plist-get box paint-key) t)))
(cl-some (lambda (child) (cl-some (lambda (child)
(ebox-tree-node-paint-conflict-p child paint-key t)) (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 ('box
(or (when (equal (ebox-get node :region-id) region-id) (or (when (equal (ebox-get node :region-id) region-id)
(list node)) (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) (plist-get node :ebox-content-node)
region-id))) region-id)))
(append path (list node))))) (append path (list node)))))
('concat ('concat
(catch 'found (catch 'found
(dolist (child (ebox-tree-layout-children node)) (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))))) (throw 'found (append path (list node)))))
nil)) nil))
('stack ('stack
(catch 'found (catch 'found
(dolist (child (ebox-tree-layout-children node)) (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))))) (throw 'found (append path (list node)))))
nil)) nil))
('flex ('flex
@ -1034,7 +1034,7 @@ wrapper's visible content is produced by the flex renderer."
(t (t
(catch 'found (catch 'found
(dolist (child (ebox-tree-layout-children node)) (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))))) (throw 'found (append path (list node)))))
nil)))) nil))))
('grid ('grid
@ -1045,7 +1045,7 @@ wrapper's visible content is produced by the flex renderer."
(t (t
(catch 'found (catch 'found
(dolist (child (ebox-tree-layout-children node)) (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))))) (throw 'found (append path (list node)))))
nil)))) nil))))
('flex-item ('flex-item

105
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: ;;; Commentary:
;; Emacs owns window events; Ebox owns the mounted viewport. This module is ;; Emacs owns window events; Ebox owns the mounted viewport. This module is
;; the single bridge between them. Size hooks only sample the latest visible ;; the single bridge between them. Size hooks only sample the latest visible
;; dimensions. One deferred callback per buffer publishes the newest sample, ;; dimensions and synchronously publish one exact incremental viewport update.
;; so continuous frame dragging cannot enqueue synchronous layout transactions. ;; Emacs serializes the hook; Ebox's retained renderer bounds each transaction.
;;; Code: ;;; Code:
(require 'cl-lib)
(require 'ebox-surface) (require 'ebox-surface)
(declare-function ebox--buffer-render-state "ebox-incremental" (buffer)) (declare-function ebox--buffer-render-state "ebox-incremental" (buffer))
(declare-function ebox-rerender-buffer-with-context (declare-function ebox-rerender-buffer-with-context
"ebox" (buffer viewport-width &optional viewport-height)) "ebox" (buffer viewport-width &optional viewport-height))
(defcustom ebox-viewport-resize-delay 0.05 (defvar ebox--window-size-change-in-progress nil
"Seconds after the latest size event before publishing its viewport. "Non-nil while Ebox is synchronizing visible window viewports.
Continuous size events replace one pending sample for each mounted buffer." External GUI events cannot interleave in Emacs's single thread. A nested call
:type 'number can only originate from the current publication and therefore has no newer
:group 'ebox) window geometry to publish.")
(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.")
(defun ebox-viewport-window-width (window) (defun ebox-viewport-window-width (window)
"Return Ebox's display-safe viewport width for live WINDOW." "Return Ebox's display-safe viewport width for live WINDOW."
(and (window-live-p window) (and (window-live-p window)
(ebox-surface--window-content-width 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) (defun ebox--window-size-change (frame)
"Sample latest viewports for mounted Ebox buffers visible in FRAME." "Synchronize mounted Ebox buffers visible in FRAME immediately."
(when (and (frame-live-p frame) (not noninteractive)) (when (and (frame-live-p frame)
(let ((seen (make-hash-table :test #'eq))) (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)) (dolist (window (window-list frame 'no-minibuf))
(when (window-live-p window) (when (window-live-p window)
(let ((buffer (window-buffer window))) (let ((buffer (window-buffer window)))
(unless (gethash buffer seen) (unless (gethash buffer seen)
(puthash buffer t seen) (puthash buffer t seen)
(when (and (buffer-live-p buffer) (let ((display-window
(ebox-surface-buffer-mounted-p buffer)) (and (buffer-live-p buffer)
(let* ((state (ebox--buffer-render-state buffer)) (ebox-surface--buffer-display-window buffer))))
(width (ebox-viewport-window-width window)) (when (and (window-live-p display-window)
(height (window-body-height window))) (eq (window-frame display-window) frame)
(when (and width (ebox-surface-buffer-mounted-p buffer))
state (let* ((state (ebox--buffer-render-state buffer))
(not (and (width (ebox-viewport-window-width display-window))
(= width (height (window-body-height display-window)))
(or (plist-get state :viewport-width) -1)) (when (and width
(= height state
(or (plist-get state :viewport-height) (not (and
-1))))) (= width
(ebox--schedule-buffer-viewport-resize (or (plist-get state :viewport-width)
buffer window width height))))))))))) -1))
(= height
(or (plist-get state :viewport-height)
-1)))))
(ebox-rerender-buffer-with-context
buffer width height))))))))))))
(when (boundp 'window-size-change-functions) (when (boundp 'window-size-change-functions)
(add-hook 'window-size-change-functions #'ebox--window-size-change)) (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. "Set PROPERTY to VALUE in BOX and return the modified box.
Registered style properties also update BOX's canonical ECSS declarations so a Registered style properties also update BOX's canonical ECSS declarations so a
later cascade computes from the public mutation instead of stale source data." 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)))) (ebox-style-compile-declarations (list property value))))
(plist-put (plist-put
box :ebox-style-declarations box :ebox-style-declarations
@ -648,7 +648,7 @@ ALIGN can be `top', `center', or `bottom'."
(len (length string))) (len (length string)))
(catch 'found (catch 'found
(while (< pos len) (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)) (throw 'found id))
(setq pos (or (next-single-property-change (setq pos (or (next-single-property-change
pos 'ebox-content string) pos 'ebox-content string)
@ -660,7 +660,7 @@ ALIGN can be `top', `center', or `bottom'."
(len (length string)) (len (length string))
ids) ids)
(while (< pos len) (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) (unless (memq id ids)
(setq ids (append ids (list id))))) (setq ids (append ids (list id)))))
(setq pos (1+ pos))) (setq pos (1+ pos)))
@ -702,13 +702,13 @@ Use this to capture ids *before* inserting into a buffer:
(mapcar #'ebox-region-ids (mapcar #'ebox-region-ids
(ebox--layout-children node)))) (ebox--layout-children node))))
((eq type 'flex) ((eq type 'flex)
(if-let ((box (plist-get node :box))) (if-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box)) (list (ebox--ensure-region-id box))
(apply #'append (apply #'append
(mapcar #'ebox-region-ids (mapcar #'ebox-region-ids
(ebox-tree-layout-children node))))) (ebox-tree-layout-children node)))))
((eq type 'grid) ((eq type 'grid)
(if-let ((box (plist-get node :box))) (if-let* ((box (plist-get node :box)))
(list (ebox--ensure-region-id box)) (list (ebox--ensure-region-id box))
(apply #'append (apply #'append
(mapcar #'ebox-region-ids (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." "Return a KEY -> child hash table for explicitly keyed CHILDREN."
(let ((table (make-hash-table :test 'equal))) (let ((table (make-hash-table :test 'equal)))
(dolist (child children) (dolist (child children)
(when-let ((key (ebox--runtime-node-key child))) (when-let* ((key (ebox--runtime-node-key child)))
(puthash key child table))) (puthash key child table)))
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) (defun ebox--runtime-keyed-match (old-keyed new-child)
"Return the keyed old child that should match 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))) (let ((old-child (gethash key old-keyed)))
(when (ebox--runtime-same-type-p old-child new-child) (when (ebox--runtime-same-type-p old-child new-child)
old-child)))) old-child))))
@ -910,7 +910,7 @@ Properties are expanded recursively according to `ebox-property-rules'."
(defun ebox--scroll-cancel-idle-prefetch (region-id) (defun ebox--scroll-cancel-idle-prefetch (region-id)
"Cancel any pending idle prefix prefetch for 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) (when (timerp timer)
(cancel-timer timer)) (cancel-timer timer))
(remhash region-id ebox--scroll-idle-prefetch-timers))) (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) (defun ebox--idle-continuation-delay (delay)
"Return an idle-timer threshold one fresh DELAY beyond current idle time." "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)) (float-time idle))
0) 0)
(max 0 (or delay 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) (defun ebox--scroll-schedule-idle-prefetch (region-id &optional delay)
"Schedule input-yielding lazy prefix prefetch for REGION-ID when useful." "Schedule input-yielding lazy prefix prefetch for REGION-ID when useful."
(ebox--scroll-cancel-idle-prefetch region-id) (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-allow-noninteractive-prefetch)
(ebox--scroll-get-state region-id)))) (ebox--scroll-get-state region-id))))
(when (and (ebox--scroll-idle-prefetch-needed-p state) (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) (defun ebox--smooth-scroll-active-p (region-id)
"Return non-nil when REGION-ID has an active smooth scroll timer." "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)) (and (timerp (plist-get entry :timer))
(not (plist-get entry :waiting-prefetch))))) (not (plist-get entry :waiting-prefetch)))))
(defun ebox--smooth-scroll-resume-after-prefetch (region-id) (defun ebox--smooth-scroll-resume-after-prefetch (region-id)
"Resume REGION-ID smooth scrolling after a paused lazy prefetch." "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) (when (plist-get entry :waiting-prefetch)
(plist-put entry :waiting-prefetch nil) (plist-put entry :waiting-prefetch nil)
(unless (timerp (plist-get entry :timer)) (unless (timerp (plist-get entry :timer))
@ -1065,7 +1065,7 @@ request; callers that represent GUI animation ticks pass their tick size."
region-id region-id
(ebox--idle-continuation-delay (ebox--idle-continuation-delay
ebox-scroll-lazy-idle-prefetch-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)) (let ((buffer (ebox--scroll-state-buffer state))
(cache-miss-target (cache-miss-target
(plist-get state :cache-miss-prefetch-target-lines))) (plist-get state :cache-miss-prefetch-target-lines)))
@ -1215,7 +1215,7 @@ owns the exact continuation cache for the captured viewport context."
(maphash (maphash
(lambda (region-id _) (lambda (region-id _)
(cl-incf retained-cost 48) (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))) (let ((template (ebox--scroll-cache-state-template state)))
(cl-incf (cl-incf
retained-cost retained-cost
@ -1318,7 +1318,7 @@ remain transaction-local."
ebox--collect-rebuilt-scroll-state-region-ids) ebox--collect-rebuilt-scroll-state-region-ids)
(cl-pushnew region-id ebox--rebuilt-scroll-state-region-ids (cl-pushnew region-id ebox--rebuilt-scroll-state-region-ids
:test #'equal)) :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 (let ((ebox--defer-scroll-content-index
(or ebox--defer-scroll-content-index (or ebox--defer-scroll-content-index
(plist-get state :render-content-prefix) (plist-get state :render-content-prefix)
@ -1355,7 +1355,7 @@ remain transaction-local."
(= (length native-lines) content-height)) (= (length native-lines) content-height))
(list offset native-lines)) (list offset native-lines))
((and (integerp content-height) (>= content-height 0)) ((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))) (let* ((max-offset (max 0 (- (length lines) content-height)))
(offset (max 0 (min max-offset offset))) (offset (max 0 (min max-offset offset)))
(end (min (+ offset content-height) (length lines)))) (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) (defun ebox--scroll-state-materialize-lines (region-id state)
"Return STATE after materializing lazy scroll content for REGION-ID." "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 (let* ((old-visible
(ebox--scroll-state-rendered-visible-window state)) (ebox--scroll-state-rendered-visible-window state))
(old-refresh-required (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)) (plist-get (ebox--buffer-render-state buffer) :scroll-region-ids))
region-ids) region-ids)
(dolist (node-id node-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) (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) (when (ebox--scroll-state-covers-node-p buffer state node)
(cl-pushnew region-id region-ids :test #'equal)))))) (cl-pushnew region-id region-ids :test #'equal))))))
(nreverse region-ids))) (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." "Return ebox role/id pairs at POS in STRING."
(let (role-ids) (let (role-ids)
(dolist (entry ebox-region-types) (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))) (push (cons (car entry) region-id) role-ids)))
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)) (dolist (region-id (get-text-property pos 'ebox-content-owners string))
(cl-pushnew region-id ids :test #'equal)) (cl-pushnew region-id ids :test #'equal))
(dolist (entry ebox-region-types) (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))) (cl-pushnew region-id ids :test #'equal)))
ids)) ids))
@ -1902,7 +1902,7 @@ object. Unrelated ownerless and foreign-buffer states remain isolated."
(cl-loop for line in lines (cl-loop for line in lines
for idx from 0 for idx from 0
do (when (ebox--scroll-line-region-present-p line region-ids) 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))) line region-set)))
(push (cons idx span) spans)))) (push (cons idx span) spans))))
(nreverse spans))) (nreverse spans)))
@ -1931,7 +1931,7 @@ Decoration-only legacy lines fall back to the complete role scanner."
(setq topology-seen t) (setq topology-seen t)
(cl-pushnew region-id ids :test #'equal)) (cl-pushnew region-id ids :test #'equal))
(dolist (property '(ebox-content ebox-content-owner)) (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) (setq topology-seen t)
(cl-pushnew region-id ids :test #'equal))) (cl-pushnew region-id ids :test #'equal)))
(setq pos (setq pos
@ -1960,7 +1960,7 @@ uses their rendered descendants."
(limit (length line)) (limit (length line))
ids) ids)
(while (< pos limit) (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)) (cl-pushnew region-id ids :test #'equal))
(setq pos (setq pos
(max (1+ pos) (max (1+ pos)
@ -1972,7 +1972,7 @@ uses their rendered descendants."
(defun ebox--scroll-line-bounds-index-add (index line-index line) (defun ebox--scroll-line-bounds-index-add (index line-index line)
"Add LINE at LINE-INDEX to lightweight region bounds INDEX." "Add LINE at LINE-INDEX to lightweight region bounds INDEX."
(dolist (region-id (ebox--scroll-line-direct-content-region-ids line)) (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) (setcdr bounds line-index)
(puthash region-id (cons line-index line-index) index))) (puthash region-id (cons line-index line-index) index)))
index) index)
@ -2015,7 +2015,7 @@ uses their rendered descendants."
for line-index from 0 for line-index from 0
do do
(dolist (region-id (ebox--scroll-line-region-ids line)) (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 line (ebox--region-id-set
(list region-id))))) (list region-id)))))
(puthash 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) (defun ebox--scroll-index-add-line (index line-index line)
"Add LINE at LINE-INDEX to INDEX." "Add LINE at LINE-INDEX to INDEX."
(dolist (region-id (ebox--scroll-line-region-ids line)) (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))))) line (ebox--region-id-set (list region-id)))))
(puthash region-id (puthash region-id
(cons (cons line-index span) (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, 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 scan for only REGION-IDS; building the all-region index synchronously is much
more expensive than the targeted fallback on a long lazy prefix." 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 ;; A ready exact index already proves both membership and spans. Building
;; the prefix-wide membership set first adds an O(prefix) tax to visible ;; the prefix-wide membership set first adds an O(prefix) tax to visible
;; updates after scrolling. ;; 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 (when (ebox--scroll-region-id-set-intersects-p
content-region-id-set region-ids) content-region-id-set region-ids)
(let ((hints (plist-get state :region-line-span-hints))) (let ((hints (plist-get state :region-line-span-hints)))
(if-let ((hint-spans (if-let* ((hint-spans
(and hints (and hints
(cl-loop for region-id in region-ids (cl-loop for region-id in region-ids
for spans = (gethash region-id hints) 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)))
((= line-index (car indices)) ((= line-index (car indices))
(when (ebox--scroll-line-region-present-p line region-ids) (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))) line region-set)))
(push (cons line-index span) spans))) (push (cons line-index span) spans)))
(setq indices (cdr indices))))) (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) (defun ebox--cancel-buffer-reflow-cache-prewarm (buffer)
"Cancel pending predicted reflow-cache warming for 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) (when (timerp timer)
(cancel-timer timer))) (cancel-timer timer)))
(remhash buffer ebox--reflow-cache-prewarm-timers)) (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) (defun ebox--cancel-buffer-runtime-prewarm (buffer)
"Cancel and discard pending runtime prewarming for BUFFER." "Cancel and discard pending runtime prewarming for BUFFER."
(ebox--cancel-buffer-reflow-cache-prewarm 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) (when (timerp timer)
(cancel-timer timer))) (cancel-timer timer)))
(remhash buffer ebox--runtime-prewarm-timers) (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) (defun ebox--root-region-box (root region-id)
"Return ROOT's box carrying REGION-ID, including a flex wrapper box." "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 (cond
((eq (plist-get owner :ebox-type) 'box) owner) ((eq (plist-get owner :ebox-type) 'box) owner)
((and (eq (plist-get owner :ebox-type) 'flex) ((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 is scheduled for the next width at the same nonzero delta; invalid nonpositive
predictions are skipped." predictions are skipped."
(ebox--cancel-buffer-reflow-cache-prewarm buffer) (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) (buffer-live-p buffer)
(ebox--buffer-render-state buffer)))) (ebox--buffer-render-state buffer))))
(let* ((delta (and (numberp old-viewport-width) (let* ((delta (and (numberp old-viewport-width)
@ -2660,7 +2660,7 @@ scroll surface."
:phase (if native-ready-p 'native-scroll 'snapshots) :phase (if native-ready-p 'native-scroll 'snapshots)
:snapshot-stack :snapshot-stack
(unless native-ready-p (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)))) (list (vector root :uninitialized t t))))
:node-region-ids-cache (make-hash-table :test 'eq) :node-region-ids-cache (make-hash-table :test 'eq)
:viewport-width-ids-rev nil :viewport-width-ids-rev nil
@ -2675,7 +2675,7 @@ scroll surface."
"Schedule BUFFER's next runtime prewarm slice after DELAY." "Schedule BUFFER's next runtime prewarm slice after DELAY."
(when (and (buffer-live-p buffer) (when (and (buffer-live-p buffer)
(gethash buffer ebox--runtime-prewarm-jobs)) (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) (when (timerp old)
(cancel-timer old))) (cancel-timer old)))
(puthash buffer (puthash buffer
@ -2690,7 +2690,7 @@ scroll surface."
RETAINED-ONLY-P is deliberately true after ordinary commits and resizes; the RETAINED-ONLY-P is deliberately true after ordinary commits and resizes; the
initial mount and visible-window handoff leave it nil." initial mount and visible-window handoff leave it nil."
(ebox--cancel-buffer-runtime-prewarm buffer) (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) (buffer-live-p buffer)
(ebox--buffer-render-state buffer)))) (ebox--buffer-render-state buffer))))
(puthash buffer (ebox--runtime-prewarm-new-job (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)))))) (ebox--node-layout-snapshot buffer node nil))))))
(setq count (1+ count)))) (setq count (1+ count))))
(unless (plist-get job :snapshot-stack) (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 (let ((width-ids (nreverse
(plist-get job :viewport-width-ids-rev))) (plist-get job :viewport-width-ids-rev)))
(height-ids (nreverse (height-ids (nreverse
@ -2814,7 +2814,7 @@ Return non-nil when descendant width dependencies remain relevant."
(tails (plist-get task :tails)) (tails (plist-get task :tails))
(line-index (plist-get task :line-index))) (line-index (plist-get task :line-index)))
(dolist (region-id (ebox--scroll-line-region-ids line)) (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))))) line (ebox--region-id-set (list region-id)))))
(let* ((cell (list (cons line-index span))) (let* ((cell (list (cons line-index span)))
(tail (gethash region-id tails))) (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)) (let* ((sources (plist-get job :scroll-sources))
(source (car sources))) (source (car sources)))
(plist-put job :scroll-sources (cdr sources)) (plist-put job :scroll-sources (cdr sources))
(when-let ((task (when-let* ((task
(ebox--runtime-prewarm-scroll-source-task (ebox--runtime-prewarm-scroll-source-task
buffer source))) buffer source)))
(plist-put job :scroll-task task))) (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 (list :result 0 :state state
:offset (or (plist-get state :scroll-offset) 0) :offset (or (plist-get state :scroll-offset) 0)
:native-materialize-p t))) :native-materialize-p t)))
(when-let ((window (get-buffer-window buffer t))) (when-let* ((window (get-buffer-window buffer t)))
(with-current-buffer buffer (with-current-buffer buffer
(goto-char (min old-point (point-max)))) (goto-char (min old-point (point-max))))
(set-window-point window (point)) (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) (defun ebox--runtime-prewarm-step (buffer)
"Run one bounded runtime prewarm slice for BUFFER. "Run one bounded runtime prewarm slice for BUFFER.
Return non-nil while more work remains." 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))) (let ((state (ebox--buffer-render-state buffer)))
(if (or (not (buffer-live-p buffer)) (if (or (not (buffer-live-p buffer))
(not (eq state (plist-get job :render-state))) (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) (defun ebox--runtime-prewarm-drain (buffer)
"Synchronously drain BUFFER's scheduled prewarm job for tests and profiling." "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) (when (timerp timer)
(cancel-timer timer)) (cancel-timer timer))
(remhash buffer ebox--runtime-prewarm-timers)) (remhash buffer ebox--runtime-prewarm-timers))
@ -3012,7 +3012,7 @@ Return non-nil while more work remains."
completed) completed)
(while (and (> limit 0) (not completed)) (while (and (> limit 0) (not completed))
(unless (gethash buffer ebox--runtime-prewarm-jobs) (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)))) (ebox--buffer-render-state buffer))))
(puthash buffer (ebox--runtime-prewarm-new-job buffer state) (puthash buffer (ebox--runtime-prewarm-new-job buffer state)
ebox--runtime-prewarm-jobs))) ebox--runtime-prewarm-jobs)))
@ -3031,7 +3031,7 @@ Return non-nil while more work remains."
(let (candidates) (let (candidates)
(maphash (maphash
(lambda (region-id _state) (lambda (region-id _state)
(when-let ((bounds (when-let* ((bounds
(ebox-surface-region-bounds (ebox-surface-region-bounds
(current-buffer) region-id))) (current-buffer) region-id)))
(when (and (<= (car bounds) pos) (< pos (cdr bounds))) (when (and (<= (car bounds) pos) (< pos (cdr bounds)))
@ -3061,7 +3061,7 @@ nested owners may render equal-sized clipped spans."
(let (candidates) (let (candidates)
(maphash (maphash
(lambda (region-id _state) (lambda (region-id _state)
(when-let ((bounds (when-let* ((bounds
(ebox-surface-region-bounds (ebox-surface-region-bounds
(current-buffer) region-id))) (current-buffer) region-id)))
(push (cons 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) (defun ebox--scrollable-region-p (region-id delta)
"Return non-nil when REGION-ID can consume DELTA lines." "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)) (let* ((scroll-offset (or (plist-get state :scroll-offset) 0))
(content-lines (plist-get state :content-lines)) (content-lines (plist-get state :content-lines))
(content-height (plist-get state :content-height)) (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) (defun ebox--smooth-scroll-stop (region-id)
"Stop pending smooth wheel scroll animation for REGION-ID." "Stop pending smooth wheel scroll animation for REGION-ID."
(when-let ((entry (gethash region-id ebox--smooth-scroll-state-table))) (when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table)))
(when-let ((timer (plist-get entry :timer))) (when-let* ((timer (plist-get entry :timer)))
(cancel-timer timer)) (cancel-timer timer))
(remhash region-id ebox--smooth-scroll-state-table) (remhash region-id ebox--smooth-scroll-state-table)
(ebox--deferred-render-gc-schedule-restore) (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 (defun ebox--smooth-scroll-pause-for-prefetch
(region-id entry pending) (region-id entry pending)
"Pause REGION-ID smooth scroll ENTRY until lazy prefetch extends the cache." "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) (when (timerp timer)
(cancel-timer timer))) (cancel-timer timer)))
(plist-put entry :timer nil) (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) (defun ebox--smooth-scroll-clamp-pending (region-id pending)
"Clamp PENDING lines to REGION-ID's remaining scrollable range." "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)) (let* ((scroll-offset (or (plist-get state :scroll-offset) 0))
(lazy-forward (lazy-forward
(and (> pending 0) (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) (defun ebox--smooth-scroll-lazy-boundary-p (region-id delta)
"Return non-nil when DELTA would cross REGION-ID's lazy prefix boundary." "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)))) (ebox--scroll-get-state region-id))))
(let* ((scroll-offset (or (plist-get state :scroll-offset) 0)) (let* ((scroll-offset (or (plist-get state :scroll-offset) 0))
(content-lines (plist-get state :content-lines)) (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. ;; pending distance; the timer coalesces them into frame-sized edits.
(unless had-timer (unless had-timer
(ebox--smooth-scroll-tick region-id)) (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)) (unless (timerp (plist-get entry :timer))
(plist-put (plist-put
entry :timer 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) (defun ebox--scroll-region-can-consume-complete-p (region-id delta)
"Return non-nil when REGION-ID can consume all signed DELTA now." "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)) (let* ((offset (or (plist-get state :scroll-offset) 0))
(height (or (plist-get state :content-height) 0)) (height (or (plist-get state :content-height) 0))
(maximum (max 0 (- (length (plist-get state :content-lines)) (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. "Remove all runtime caches owned by BUFFER.
Defaults to the current buffer." Defaults to the current buffer."
(let ((buffer (or buffer (current-buffer)))) (let ((buffer (or buffer (current-buffer))))
(ebox--cancel-buffer-viewport-resize buffer)
(ebox--cancel-buffer-runtime-prewarm 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--clear-region-runtime-caches
(ebox--node-all-region-ids root))) (ebox--node-all-region-ids root)))
(ebox--clear-buffer-render-state buffer))) (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) (defun ebox--surface-region-scroll-context (buffer region-id)
"Return read-only scroll publication context for REGION-ID in BUFFER." "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)) (let ((region-ids (ebox--node-all-region-ids node))
states) states)
(maphash (maphash
@ -4017,7 +4016,7 @@ cannot be changed through the unpublished batch root."
(defun ebox--surface-region-scroll-report (context changed-keys) (defun ebox--surface-region-scroll-report (context changed-keys)
"Return TP-era scroll report fields for CONTEXT and 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))) (let* ((count (length (plist-get context :states)))
(paint-p (paint-p
(eq (ebox--region-update-dirty-kind changed-keys) 'paint)) (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) (plist-get (plist-get commit-input :state-overrides)
:scroll-state-table))) :scroll-state-table)))
(dolist (entry (plist-get context :states)) (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) (plist-put state :lazy-scroll-prefix-dirty t)
(puthash (car entry) state table))))) (puthash (car entry) state table)))))
commit-input) 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." "Return NODE's margin-free role bounds in BUFFER, or nil."
(let (start end) (let (start end)
(dolist (region-id (ebox--node-all-region-ids node)) (dolist (region-id (ebox--node-all-region-ids node))
(when-let ((bounds (when-let* ((bounds
(ebox-surface-region-bounds (ebox-surface-region-bounds
buffer region-id ebox--horizontal-border-anchor-roles))) buffer region-id ebox--horizontal-border-anchor-roles)))
(setq start (if start (min start (car bounds)) (car bounds)) (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." "Return fallback TP mount bounds for NODE in BUFFER, or nil."
(let (start end) (let (start end)
(dolist (region-id (ebox--node-all-region-ids node)) (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)) (setq start (if start (min start (car bounds)) (car bounds))
end (if end (max end (cdr bounds)) (cdr bounds))))) end (if end (max end (cdr bounds)) (cdr bounds)))))
(and start end (< start end) (cons start end)))) (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 :publish callback :rollback framework-rollback
:state 'unpublished :diagnostics nil)) :state 'unpublished :diagnostics nil))
(_surface (_surface
(if-let ((scope-node-ids (if-let* ((scope-node-ids
(plist-get commit-input :scope-node-ids))) (plist-get commit-input :scope-node-ids)))
(ebox-surface-update-buffer-scoped (ebox-surface-update-buffer-scoped
buffer source scope-node-ids buffer source scope-node-ids

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

@ -541,7 +541,7 @@
(if (plist-get check :ok) "PASS" "FAIL") (if (plist-get check :ok) "PASS" "FAIL")
(plist-get check :name) (plist-get check :name)
(plist-get check :detail)))) (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 (format "TP-REPORT %S\n" tp-report)))
(princ "\n"))) (princ "\n")))

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

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

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

@ -79,7 +79,7 @@
(len (length string)) (len (length string))
values) values)
(while (< pos len) (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) (unless (memq value values)
(setq values (append values (list value))))) (setq values (append values (list value)))))
(setq pos (1+ pos))) (setq pos (1+ pos)))

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

@ -110,7 +110,7 @@
((symbol-function 'message) #'ignore)) ((symbol-function 'message) #'ignore))
(should (ebox-byte-compile)) (should (ebox-byte-compile))
(should (equal (nreverse compiled) ebox--compile-sources))) (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))))) (kill-buffer buffer)))))
(ert-deftest ebox-package-includes-native-build-source () (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*") (when (get-buffer " *other-window*")
(kill-buffer " *other-window*"))))) (kill-buffer " *other-window*")))))
(ert-deftest ebox-window-size-change-coalesces-to-latest-visible-viewport () (ert-deftest ebox-window-size-change-publishes-every-visible-viewport ()
"Continuous frame changes publish only the latest sampled viewport." "Continuous frame changes publish each sampled viewport immediately."
(let* ((buffer (generate-new-buffer " *ebox-window-size-change*")) (let* ((buffer (generate-new-buffer " *ebox-window-size-change*"))
(window (selected-window)) (window (selected-window))
(old-buffer (window-buffer window)) (old-buffer (window-buffer window))
(sampled-height (window-body-height window)) (sampled-height (window-body-height window))
(sampled-widths (number-sequence 240 430 10)) (sampled-widths (number-sequence 240 430 10))
scheduled
cancelled
calls) calls)
(unwind-protect (unwind-protect
(progn (progn
@ -195,52 +193,115 @@
(lambda (target width height) (lambda (target width height)
(push (list target width height) calls))) (push (list target width height) calls)))
((symbol-function 'run-at-time) ((symbol-function 'run-at-time)
(lambda (delay _repeat function &rest arguments) (lambda (&rest _)
(let ((timer (intern (format "ebox-resize-timer-%d" (ert-fail "viewport delivery must not schedule a timer")))
(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)))
(noninteractive nil)) (noninteractive nil))
(dotimes (_index 20) (dotimes (_index 20)
(ebox--window-size-change (selected-frame))) (ebox--window-size-change (selected-frame)))
(should-not calls) (should (= (length calls) 20))
(should (= (length scheduled) 20)) (should
(should (= (length cancelled) 19)) (equal (mapcar #'cadr (nreverse (copy-sequence calls)))
(pcase-let ((`(,_timer ,delay ,function ,arguments) (number-sequence 240 430 10)))
(car scheduled))) (should (cl-every (lambda (call)
(should (= delay ebox-viewport-resize-delay)) (and (eq (car call) buffer)
(apply function arguments)) (= (nth 2 call) sampled-height)))
(should (equal calls calls))))
(list (list buffer 430 sampled-height))))))
(set-window-buffer window old-buffer) (set-window-buffer window old-buffer)
(when (boundp 'ebox--viewport-resize-pending-table)
(clrhash ebox--viewport-resize-pending-table))
(kill-buffer buffer)))) (kill-buffer buffer))))
(ert-deftest ebox-buffer-cleanup-cancels-pending-viewport-resize () (ert-deftest ebox-window-size-change-rejects-reentrant-publication ()
"A dead mounted buffer cannot retain a viewport timer or pending sample." "A viewport commit cannot recursively enter the global size hook."
(let ((buffer (generate-new-buffer " *ebox-viewport-cleanup*")) (let* ((buffer (generate-new-buffer " *ebox-reentrant-window-size*"))
(timer 'ebox-test-viewport-cleanup-timer) (window (selected-window))
cancelled) (old-buffer (window-buffer window))
(sampled-widths '(420 440))
calls)
(unwind-protect (unwind-protect
(progn (progn
(puthash buffer (vector 1 (selected-window) 400 20 timer) (set-window-buffer window buffer)
ebox--viewport-resize-pending-table) (cl-letf (((symbol-function 'ebox--buffer-render-state)
(cl-letf (((symbol-function 'timerp) (lambda (_buffer)
(lambda (value) (eq value timer))) '(:viewport-width 100 :viewport-height 10)))
((symbol-function 'cancel-timer) ((symbol-function 'ebox-surface-buffer-mounted-p)
(lambda (value) (setq cancelled value)))) (lambda (_buffer) t))
(with-current-buffer buffer (ebox--cleanup-current-buffer))) ((symbol-function 'ebox-surface--window-content-width)
(should (eq cancelled timer)) (lambda (_window) (pop sampled-widths)))
(should-not (gethash buffer ebox--viewport-resize-pending-table))) ((symbol-function 'window-body-height)
(remhash buffer ebox--viewport-resize-pending-table) (lambda (&rest _) 20))
(when (buffer-live-p buffer) (kill-buffer buffer))))) ((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) (defun ebox-surface-test--hash-fingerprint (table)
"Return a stable content fingerprint for hash TABLE. "Return a stable content fingerprint for hash TABLE.