From fcfbeb0368175fde7ab1e3fa7df906b3098dcf86 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Wed, 26 Aug 2026 00:09:53 +0800 Subject: [PATCH] fix: restore immediate retained viewport updates --- docs/user/ebox-api-reference.en.md | 8 +- docs/user/ebox-api-reference.zh.md | 7 +- ebox-buffer-backend.el | 16 +-- ebox-cache.el | 8 +- ebox-child-range.el | 16 +-- ebox-flex.el | 32 ++--- ebox-fragment.el | 6 +- ebox-grid.el | 4 +- ebox-incremental.el | 168 +++++++++++++------------- ebox-layout.el | 16 +-- ebox-native-commit.el | 6 +- ebox-native-reflow.el | 56 ++++----- ebox-render-context.el | 6 +- ebox-selector.el | 6 +- ebox-style.el | 14 +-- ebox-surface.el | 96 ++++++++------- ebox-tree.el | 54 ++++----- ebox-viewport.el | 105 ++++++---------- ebox.el | 123 ++++++++++--------- scripts/ebox-performance-evaluator.el | 2 +- tests/ebox-core-render-tests.el | 6 +- tests/ebox-flex-tests.el | 2 +- tests/ebox-package-tests.el | 2 +- tests/ebox-surface-tests.el | 145 +++++++++++++++------- 24 files changed, 466 insertions(+), 438 deletions(-) diff --git a/docs/user/ebox-api-reference.en.md b/docs/user/ebox-api-reference.en.md index e80823a..668a776 100644 --- a/docs/user/ebox-api-reference.en.md +++ b/docs/user/ebox-api-reference.en.md @@ -432,10 +432,13 @@ in pixels and `ebox-viewport-height` in lines around the render. Do not mutate a published node tree in place. Visible mounted buffers follow their displaying window automatically. Ebox -coalesces continuous size events and publishes only the latest sample after -`ebox-viewport-resize-delay` (0.05 seconds by default). +publishes every size event immediately through its retained incremental path. +The Emacs hook is serialized and reentrant calls are rejected; there is no +second host hook, timer, or viewport queue. `ebox-viewport-window-width` returns the same display-safe pixel width used by that controller, so hosts must not install a second resize hook or width rule. +The former `ebox-viewport-resize-delay` setting has been removed; immediate +delivery has no timer setting to migrate. ## 7. Selectors @@ -522,7 +525,6 @@ The main customization variables are: | Lazy scroll | `ebox-scroll-lazy-prefix-lookahead-lines` 8; `ebox-scroll-lazy-idle-prefetch-lines` 128; `ebox-scroll-lazy-idle-prefetch-slice-lines` 16; `ebox-scroll-lazy-idle-prefetch-delay` 0.15 | | Runtime prewarm | `ebox-runtime-idle-prewarm` t; `ebox-runtime-idle-prewarm-delay` 0.1; `ebox-runtime-idle-prewarm-prefix-resume-delay` 2.0; `ebox-runtime-idle-prewarm-slice-size` 32; `ebox-native-buffer-scroll` t (initial/visible-window handoff only; strict root-owner proof) | | Predicted reflow | `ebox-runtime-idle-reflow-cache-prewarm` t; `ebox-runtime-idle-reflow-cache-prewarm-delay` 0.15 | -| Viewport delivery | `ebox-viewport-resize-delay` 0.05; continuous window events replace one pending sample per mounted buffer | | Reflow GC | `ebox-reflow-cache-prewarm-gc-cons-threshold` `auto`; `ebox-reflow-cache-prewarm-gc-auto-frame-budget` 0.2; `ebox-reflow-cache-prewarm-gc-auto-min-threshold` 64 MiB; `ebox-reflow-cache-prewarm-gc-auto-max-threshold` 1 GiB; `ebox-reflow-cache-prewarm-gc-auto-initial-threshold` 512 MiB; `ebox-reflow-cache-prewarm-gc-auto-target-layouts` 24; `ebox-reflow-cache-prewarm-gc-cons-percentage` 0.1 | | Visual verification | `ebox-visual-check-output-dir` points to the temporary directory used for optional screenshots and reports. | diff --git a/docs/user/ebox-api-reference.zh.md b/docs/user/ebox-api-reference.zh.md index f0bb7c0..784c397 100644 --- a/docs/user/ebox-api-reference.zh.md +++ b/docs/user/ebox-api-reference.zh.md @@ -392,10 +392,12 @@ report；若后续 phase 失败，rollback 最多一次接收同一个 report， render 外部动态绑定 `ebox-viewport-width`（像素）与 `ebox-viewport-height` （行数）。不要原地修改已经发布的 node tree。 -可见的 mounted buffer 会自动跟随展示它的 window。Ebox 合并连续 size event， -并在 `ebox-viewport-resize-delay`（默认 0.05 秒）后只发布最新 sample。 +可见的 mounted buffer 会自动跟随展示它的 window。Ebox 通过 retained 增量路径 +立即发布每个 size event。Emacs hook 串行执行并拒绝重入；这里没有第二套宿主 +hook、timer 或 viewport queue。 `ebox-viewport-window-width` 返回 controller 使用的同一个显示安全像素宽度； 宿主不应再安装第二套 resize hook 或宽度算法。 +旧的 `ebox-viewport-resize-delay` 已删除；立即发布不再需要迁移 timer 配置。 ## 7. Selector @@ -473,7 +475,6 @@ text scale 和固定 `display` space；它也是布局使用的公共测量原 | Lazy scroll | `ebox-scroll-lazy-prefix-lookahead-lines` 8；`ebox-scroll-lazy-idle-prefetch-lines` 128；`ebox-scroll-lazy-idle-prefetch-slice-lines` 16；`ebox-scroll-lazy-idle-prefetch-delay` 0.15 | | Runtime prewarm | `ebox-runtime-idle-prewarm` t；`ebox-runtime-idle-prewarm-delay` 0.1；`ebox-runtime-idle-prewarm-prefix-resume-delay` 2.0；`ebox-runtime-idle-prewarm-slice-size` 32；`ebox-native-buffer-scroll` t（仅 initial/visible-window handoff；严格 root-owner proof） | | 预测 reflow | `ebox-runtime-idle-reflow-cache-prewarm` t；`ebox-runtime-idle-reflow-cache-prewarm-delay` 0.15 | -| Viewport delivery | `ebox-viewport-resize-delay` 0.05；连续 window event 对每个 mounted buffer 只保留一个最新 sample | | Reflow GC | `ebox-reflow-cache-prewarm-gc-cons-threshold` `auto`；`ebox-reflow-cache-prewarm-gc-auto-frame-budget` 0.2；`ebox-reflow-cache-prewarm-gc-auto-min-threshold` 64 MiB；`ebox-reflow-cache-prewarm-gc-auto-max-threshold` 1 GiB；`ebox-reflow-cache-prewarm-gc-auto-initial-threshold` 512 MiB；`ebox-reflow-cache-prewarm-gc-auto-target-layouts` 24；`ebox-reflow-cache-prewarm-gc-cons-percentage` 0.1 | | Visual verification | `ebox-visual-check-output-dir` 指向可选 screenshot/report 使用的临时目录。 | diff --git a/ebox-buffer-backend.el b/ebox-buffer-backend.el index 2ef6412..b77d1fa 100644 --- a/ebox-buffer-backend.el +++ b/ebox-buffer-backend.el @@ -54,7 +54,7 @@ Set this to a byte count for a fixed budget, or nil to leave the setting alone." (defun ebox--darwin-physical-memory-bytes () "Return macOS physical memory in bytes, or nil when unavailable." (when (eq system-type 'darwin) - (when-let ((sysctl (executable-find "sysctl"))) + (when-let* ((sysctl (executable-find "sysctl"))) (with-temp-buffer (when (zerop (call-process sysctl nil t nil "-n" "hw.memsize")) (goto-char (point-min)) @@ -65,7 +65,7 @@ Set this to a byte count for a fixed budget, or nil to leave the setting alone." "Return local physical memory in bytes, or nil when unavailable." (when (eq ebox--physical-memory-bytes 'unknown) (setq ebox--physical-memory-bytes - (or (when-let ((info + (or (when-let* ((info (and (fboundp 'memory-info) (let ((default-directory temporary-file-directory)) @@ -175,7 +175,7 @@ Set this to nil to leave `gc-cons-percentage' unchanged.") (max gc-cons-percentage ebox-render-gc-cons-percentage))) (cl-incf ebox--deferred-render-gc-generation) (cl-incf ebox--deferred-render-gc-depth) - (when-let ((threshold + (when-let* ((threshold (ebox--effective-deferred-render-gc-cons-threshold))) (setq gc-cons-threshold threshold)) (unless ebox--deferred-render-gc-state @@ -327,7 +327,7 @@ Return FUNCTION's value." (:font-height . :height) (:font-weight . :weight) (:font-slant . :slant))) - (when-let ((value (plist-get style (car entry)))) + (when-let* ((value (plist-get style (car entry)))) (setq face (plist-put face (cdr entry) value)))) face)) @@ -377,7 +377,7 @@ foreground color." This backend mapper intentionally accepts computed style facts and emits only buffer-facing paint properties. Layout-only properties never pass through." (let ((face (ebox-buffer--font-face style))) - (when-let ((foreground (ebox-buffer--paint-color style role))) + (when-let* ((foreground (ebox-buffer--paint-color style role))) (setq face (cond ((tp-paint-slot-p foreground) @@ -386,7 +386,7 @@ buffer-facing paint properties. Layout-only properties never pass through." ((eq foreground 'ebox/default-foreground) (append (ebox-buffer--default-foreground-face) face)) (t (plist-put face :foreground foreground))))) - (when-let ((background (ebox-buffer--paint-background-color style role))) + (when-let* ((background (ebox-buffer--paint-background-color style role))) (setq face (if (tp-paint-slot-p background) (let ((slot-face (tp-paint-slot-face background))) @@ -397,7 +397,7 @@ buffer-facing paint properties. Layout-only properties never pass through." (defun ebox--propertize-typography (string style) "Apply STYLE's typography to one copy of STRING." - (if-let ((face (ebox-buffer--font-face style))) + (if-let* ((face (ebox-buffer--font-face style))) (let ((copy (copy-sequence string))) (ebox--add-render-face! copy 0 (length copy) face t) (ebox--register-render-owned-face-values string copy)) @@ -813,7 +813,7 @@ parent layout change." (setq ok t) (cl-loop for width in slot-widths for line = (or (pop lines) (ebox-pixel-space 0)) - do (if-let ((padded-line + do (if-let* ((padded-line (ebox-buffer--pad-line-to-slot-width line width))) (push padded-line padded) diff --git a/ebox-cache.el b/ebox-cache.el index 6f1f7d7..eece383 100644 --- a/ebox-cache.el +++ b/ebox-cache.el @@ -175,13 +175,13 @@ "Return distinct scopes for CACHE-NAMES." (let (scopes) (dolist (name cache-names) - (when-let ((spec (ebox-cache-spec name))) + (when-let* ((spec (ebox-cache-spec name))) (cl-pushnew (ebox-cache-spec-scope spec) scopes :test #'equal))) scopes)) (defun ebox-cache-record-hit (buffer cache-name) "Record a CACHE-NAME hit for BUFFER's current update report." - (when-let ((state (ebox-cache--report-state buffer))) + (when-let* ((state (ebox-cache--report-state buffer))) (plist-put state :cache-hit-count (1+ (or (plist-get state :cache-hit-count) 0))) (ebox-cache--push-unique-values @@ -189,7 +189,7 @@ (defun ebox-cache-record-miss (buffer cache-name) "Record a CACHE-NAME miss for BUFFER's current update report." - (when-let ((state (ebox-cache--report-state buffer))) + (when-let* ((state (ebox-cache--report-state buffer))) (plist-put state :cache-miss-count (1+ (or (plist-get state :cache-miss-count) 0))) (ebox-cache--push-unique-values @@ -197,7 +197,7 @@ (defun ebox-cache-record-invalidation (buffer cache-names reason) "Record invalidated CACHE-NAMES and REASON for BUFFER." - (when-let ((state (ebox-cache--report-state buffer))) + (when-let* ((state (ebox-cache--report-state buffer))) (ebox-cache--push-unique-values state :cache-invalidated cache-names) (ebox-cache--push-unique-values state :cache-scope (ebox-cache--spec-scopes cache-names)) diff --git a/ebox-child-range.el b/ebox-child-range.el index c793d52..ccded2a 100644 --- a/ebox-child-range.el +++ b/ebox-child-range.el @@ -302,14 +302,14 @@ those NEW items already name canonical published objects and are not copied." (let ((payload (ebox-child-range--segment-payload (nth 2 record)))) (dotimes (offset (length payload)) (ebox-child-range--metric-add metrics 'old-affected-payload-visits) - (when-let ((key (plist-get (aref payload offset) :key))) + (when-let* ((key (plist-get (aref payload offset) :key))) (setq key-root (ebox-child-range--hash-change key-root key nil (funcall hash-function key) 0 t metrics)))))) (dolist (record records) (let ((index (nth 1 record)) (payload (nth 3 record))) (dotimes (offset (length payload)) - (when-let ((key (plist-get (aref payload offset) :key))) + (when-let* ((key (plist-get (aref payload offset) :key))) (setq key-root (ebox-child-range--hash-change key-root key (cons index offset) @@ -365,7 +365,7 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location." (let* ((children (ebox-child-range--segment-node-children node)) (slot (ebox-child-range--digit index (1- height)))) (dotimes (cursor slot) - (when-let ((child (aref children cursor))) + (when-let* ((child (aref children cursor))) (setq weight (+ weight (ebox-child-range--segment-node-weight child))))) (setq node (aref children slot) @@ -389,7 +389,7 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location." (let (records) (dotimes (index (ebox-child-range--sequence-count sequence)) (let ((segment (ebox-child-range--segment-at sequence index))) - (when-let ((ref (ebox-child-range--segment-ref segment))) + (when-let* ((ref (ebox-child-range--segment-ref segment))) (push (list ref index) records)))) (nreverse records))) @@ -398,10 +398,10 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location." (let ((nodes 0) (edges 0)) (cl-labels ((walk (node) (setq nodes (1+ nodes)) - (when-let ((children + (when-let* ((children (ebox-child-range--segment-node-children node))) (dotimes (slot 32) - (when-let ((child (aref children slot))) + (when-let* ((child (aref children slot))) (setq edges (1+ edges)) (walk child)))))) (walk (ebox-child-range--sequence-root sequence))) @@ -411,11 +411,11 @@ SEGMENT-INDEX and OFFSET identify its exact material-child location." "Return `(VECTORS . SLOTS)' allocated by SEQUENCE's segment trie." (let ((vectors 0)) (cl-labels ((walk (node) - (when-let ((children + (when-let* ((children (ebox-child-range--segment-node-children node))) (setq vectors (1+ vectors)) (dotimes (slot 32) - (when-let ((child (aref children slot))) (walk child)))))) + (when-let* ((child (aref children slot))) (walk child)))))) (walk (ebox-child-range--sequence-root sequence))) (cons vectors (* 32 vectors)))) diff --git a/ebox-flex.el b/ebox-flex.el index c1585f2..43b2df6 100644 --- a/ebox-flex.el +++ b/ebox-flex.el @@ -170,7 +170,7 @@ That text is preformatted and must not be sent through the default wrapper." (when (or (plist-member raw-props :width) (and (null (plist-get props :width)) (ebox--viewport-pixel-width nil))) - (when-let ((content-viewport + (when-let* ((content-viewport (ebox--wrapper-content-viewport-pixel wrapper-box))) (plist-put props :width (list content-viewport)))) (when (and (plist-member raw-props :height) @@ -204,7 +204,7 @@ ALLOWED-KEYWORDS is the CSS keyword set valid for the property being parsed." (ebox--normalize-horizontal-size-value (car value) allowed-keywords)) ((memq value allowed-keywords) value) ((and (consp value) (eq (car value) 'fit-content)) - (if-let ((limit (cadr value))) + (if-let* ((limit (cadr value))) (let ((pixels (if (ebox--viewport-size-value-p limit) 'viewport (ebox--nonnegative-horizontal-size-pixels limit nil)))) @@ -502,11 +502,11 @@ grapheme." "Return BOX's total main-axis size constraint from PROPERTY." (when (plist-member box property) (if (eq axis 'row) - (when-let ((content-size + (when-let* ((content-size (ebox--resolve-size-content-pixel box (ebox-get box property) nil))) (+ (ebox--side-pixel box) content-size)) - (when-let ((block-size + (when-let* ((block-size (ebox--box-sizing-content-height box (ebox-get box property)))) (+ (ebox--side-height box) block-size))))) @@ -568,7 +568,7 @@ grapheme." (puthash node t ebox--render-recached-source-node-cache)) (pcase (plist-get node :ebox-type) ('box - (when-let ((region-id (ebox-get node :region-id))) + (when-let* ((region-id (ebox-get node :region-id))) (puthash region-id node ebox--region-box-table)) (ebox--flex-recache-source-boxes (plist-get node :ebox-content-node))) @@ -656,7 +656,7 @@ caller can pass the same miss context to the renderer." (defun ebox--flex-measure-cache-value (probe) "Return a copied cached measurement from PROBE, or nil on a miss." - (when-let ((cached (plist-get probe :cached))) + (when-let* ((cached (plist-get probe :cached))) (copy-sequence cached))) (defun ebox--flex-render-cache-signature (node) @@ -1204,7 +1204,7 @@ Return a sized render entry containing the rendered string and dimensions." The Elisp scalar algorithm remains the exact fallback and owns all item metadata and rendering decisions." (or (when (and main-limit (integerp main-gap)) - (when-let ((backend (ebox--flex-native-size-lines-backend))) + (when-let* ((backend (ebox--flex-native-size-lines-backend))) (funcall backend lines main-limit main-gap))) (mapcar (lambda (line) (ebox--flex-size-line line main-limit main-gap)) @@ -1546,7 +1546,7 @@ its child." (defun ebox--render-flex-box (node rendered) "Render flex NODE's container box around RENDERED, when present." - (if-let ((box (plist-get node :box))) + (if-let* ((box (plist-get node :box))) (let ((copy (copy-sequence box)) (region-id (ebox--ensure-region-id box))) (plist-put copy :region-id region-id) @@ -1735,7 +1735,7 @@ a prefix of the eventual full wrapper render." (defun ebox--flex-window-render-box-lines (node content complete limit) "Return NODE flex wrapper lines around CONTENT up to LIMIT." (let* ((rendered - (if-let ((box (plist-get node :box))) + (if-let* ((box (plist-get node :box))) (let ((copy (ebox--flex-window-wrapper-copy box complete)) (region-id (ebox--ensure-region-id box))) (plist-put copy :region-id region-id) @@ -1968,7 +1968,7 @@ the chunk begins at the wrapper top and should include top chrome." (defun ebox--flex-window-cache-lookup (node limit &optional cache-context) "Return cached flex window render for NODE and LIMIT, or nil." - (when-let ((cache-context + (when-let* ((cache-context (or cache-context (ebox--flex-window-cache-context node)))) (let* ((node-id (plist-get cache-context :node-id)) (signature (plist-get cache-context :signature)) @@ -1992,7 +1992,7 @@ the chunk begins at the wrapper top and should include top chrome." :completion-prefix-tail-rewrite-count (plist-get complete :completion-prefix-tail-rewrite-count)))) - (when-let ((prefix (ebox--render-cache-lookup + (when-let* ((prefix (ebox--render-cache-lookup (list node-id 'flex-window 'prefix) signature))) (let* ((lines (plist-get prefix :lines)) @@ -2010,7 +2010,7 @@ the chunk begins at the wrapper top and should include top chrome." (last lines)) (last result-lines)) :complete nil))))) - (when-let ((exact + (when-let* ((exact (ebox--render-cache-lookup (list node-id 'flex-window limit) signature))) @@ -2026,7 +2026,7 @@ the chunk begins at the wrapper top and should include top chrome." (defun ebox--flex-window-prefix-cache-lookup (node &optional cache-context) "Return NODE's cached incomplete flex prefix state, or nil." - (when-let ((cache-context + (when-let* ((cache-context (or cache-context (ebox--flex-window-cache-context node)))) (let* ((node-id (plist-get cache-context :node-id)) (signature (plist-get cache-context :signature))) @@ -2037,7 +2037,7 @@ the chunk begins at the wrapper top and should include top chrome." (defun ebox--flex-window-prefix-cache-store (node pieces next-index result &optional cache-context) "Store NODE incomplete flex prefix PIECES through NEXT-INDEX." - (when-let ((cache-context + (when-let* ((cache-context (and result (or cache-context (ebox--flex-window-cache-context node))))) @@ -2064,7 +2064,7 @@ the chunk begins at the wrapper top and should include top chrome." (defun ebox--flex-window-cache-store (node limit result &optional cache-context) "Store NODE flex window RESULT for LIMIT when possible." - (when-let ((cache-context + (when-let* ((cache-context (and result (or cache-context (ebox--flex-window-cache-context node))))) @@ -2498,7 +2498,7 @@ Return nil when NODE's flex configuration needs a full rerender." (lines (ebox--flex-break-lines items main-size main-gap wrap))) (when (eq wrap 'wrap-reverse) (setq lines (nreverse lines))) - (when-let ((line + (when-let* ((line (cl-find-if (lambda (candidate) (cl-some diff --git a/ebox-fragment.el b/ebox-fragment.el index f64ccd7..327306e 100644 --- a/ebox-fragment.el +++ b/ebox-fragment.el @@ -164,19 +164,19 @@ Backend marker and buffer span data are intentionally excluded." "Return NODE's display, layout, flex, and paint style signature." (when (listp node) (let ((signature (list :display (ebox--computed-display node)))) - (when-let ((style-node (ebox-fragment-style-source-node node))) + (when-let* ((style-node (ebox-fragment-style-source-node node))) (dolist (key ebox--style-signature-keys) (when (plist-member style-node key) (setq signature (plist-put signature key (plist-get style-node key))))) - (when-let ((participation (ebox--flex-participation-props style-node))) + (when-let* ((participation (ebox--flex-participation-props style-node))) (setq signature (plist-put signature :flex-participation participation)))) (when (eq (ebox--display-inner node) 'flex) (setq signature (plist-put signature :flex-props (plist-get node :props)))) - (when-let ((participation (ebox--flex-participation-props node))) + (when-let* ((participation (ebox--flex-participation-props node))) (setq signature (plist-put signature :flex-participation participation))) signature))) diff --git a/ebox-grid.el b/ebox-grid.el index 9a8d36e..86dbbec 100644 --- a/ebox-grid.el +++ b/ebox-grid.el @@ -381,7 +381,7 @@ letting the grid fall back to each child's intrinsic width." (defun ebox-grid--clamp-track-size (track size) "Clamp SIZE to TRACK's fixed maximum when one exists." - (if-let ((maximum (ebox-grid--track-max track))) + (if-let* ((maximum (ebox-grid--track-max track))) (min size maximum) size)) @@ -607,7 +607,7 @@ size for start/center/end alignment unless it would overflow its track." (defun ebox--render-grid-box (node rendered) "Render grid NODE's optional visual wrapper around RENDERED." - (if-let ((box (plist-get node :box))) + (if-let* ((box (plist-get node :box))) (let ((copy (copy-sequence box)) (region-id (ebox--ensure-region-id box))) (plist-put copy :region-id region-id) diff --git a/ebox-incremental.el b/ebox-incremental.el index 3bc79c3..0a2e05a 100644 --- a/ebox-incremental.el +++ b/ebox-incremental.el @@ -730,7 +730,7 @@ This normally does no work. It rebuilds metadata only after a defensive (defun ebox--render-cache-replay-entry-side-effects (entry) "Replay ENTRY's scroll side effects before its rendered output is reused." - (when-let ((metadata + (when-let* ((metadata (gethash entry ebox--render-cache-entry-side-effects-table))) (ebox--replay-scroll-cache-actions (plist-get metadata :scroll-actions) @@ -788,7 +788,7 @@ This normally does no work. It rebuilds metadata only after a defensive (pcase kind ('viewport t) ('root-width - (when-let ((box (ebox--root-region-box node region-id))) + (when-let* ((box (ebox--root-region-box node region-id))) (equal (ebox--literal-root-pixel-width box) (plist-get prepared :root-width)))) (_ nil))))) @@ -848,7 +848,7 @@ This normally does no work. It rebuilds metadata only after a defensive "Return NODE's exact cache context, with `:rendered' when reusable. FORCE includes the complete viewport context in the cache signature. EXTERNAL-SIGNATURE may prove a viewport-dependent non-root context." - (when-let ((context + (when-let* ((context (ebox--render-cache-context node force external-signature))) (let* ((ebox--render-cache-table (plist-get context :cache)) @@ -883,7 +883,7 @@ EXTERNAL-SIGNATURE may prove a viewport-dependent non-root context." When FORCE is non-nil, cache NODE even when its output is viewport-dependent; the complete viewport context remains part of the render signature. CACHE-PROBE may supply a prior exact miss from an accelerator boundary." - (if-let ((prepared (and force + (if-let* ((prepared (and force (ebox--take-prepared-root-render node)))) (prog1 prepared (ebox--replay-render-output-provenance prepared) @@ -981,7 +981,7 @@ Keys are region-id, values are plists with :scroll-offset, :content-lines, etc." (defun ebox--buffer-root-node-id (buffer) "Return BUFFER's root runtime node id." - (when-let ((root (ebox--buffer-root-node buffer))) + (when-let* ((root (ebox--buffer-root-node buffer))) (ebox--ensure-node-id root))) (defun ebox--runtime-region-id-conflict (region-id-set target-buffer) @@ -992,7 +992,7 @@ Keys are region-id, values are plists with :scroll-offset, :content-lines, etc." (maphash (lambda (buffer state) (unless (eq buffer target) - (when-let ((owner-set (plist-get state :region-id-set))) + (when-let* ((owner-set (plist-get state :region-id-set))) (maphash (lambda (region-id _present) (when (gethash region-id owner-set) @@ -1004,7 +1004,7 @@ Keys are region-id, values are plists with :scroll-offset, :content-lines, etc." (defun ebox-incremental--adjust-runtime-type-count (table node delta) "Adjust NODE's raw selector-type count in TABLE by DELTA." - (when-let ((type (ebox-tree-node-selector-type node))) + (when-let* ((type (ebox-tree-node-selector-type node))) (let ((count (+ (or (gethash type table) 0) delta))) (cond ((< count 0) @@ -1028,7 +1028,7 @@ same traversal in complete-render overwrite order." (runtime-type-count-table (make-hash-table :test 'eq)) native-node-postorder range-sequence-p) (cl-labels ((index-host-ref (node node-id) - (when-let ((host-ref (plist-get node :host-ref))) + (when-let* ((host-ref (plist-get node :host-ref))) (let ((count (hash-table-count host-ref-table))) (puthash host-ref node-id host-ref-table) (when (= count (hash-table-count host-ref-table)) @@ -1051,7 +1051,7 @@ same traversal in complete-render overwrite order." (unless (gethash region-id region-node-table) (puthash region-id node-id region-node-table)))) ('flex - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (let ((region-id (ebox--ensure-region-id box))) (puthash region-id t region-id-set) ;; Preserve the recursive lookup's first-match @@ -1070,7 +1070,7 @@ same traversal in complete-render overwrite order." (puthash (ebox--ensure-region-id node) node region-box-table)) ('flex - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (puthash (ebox--ensure-region-id box) box region-box-table)))))) (visit (node parent-id native-layout-p) @@ -1085,7 +1085,7 @@ same traversal in complete-render overwrite order." (puthash node-id parent-id parent-table)) (index-region-id node node-id) (index-host-ref node node-id) - (when-let ((sequence (plist-get node :ebox-child-sequence))) + (when-let* ((sequence (plist-get node :ebox-child-sequence))) (setq range-sequence-p t) (dotimes (segment-index @@ -1242,7 +1242,7 @@ same traversal in complete-render overwrite order." "Return REGION-ID's smallest render-owner node id in BUFFER. Use the persistent runtime index when available. Legacy runtime states that lack the index, or an indexed entry, fall back to a recursive tree lookup." - (or (when-let ((table (ebox--buffer-region-node-table buffer))) + (or (when-let* ((table (ebox--buffer-region-node-table buffer))) (gethash region-id table)) (when-let* ((root (ebox--buffer-root-node buffer)) (path (ebox--node-path-to-region root region-id))) @@ -1252,7 +1252,7 @@ lack the index, or an indexed entry, fall back to a recursive tree lookup." "Return REGION-ID's smallest render-owner node in BUFFER. Use both persistent runtime indexes in the normal path. Fall back to the recursive region path only for legacy or incomplete runtime state." - (when-let ((node-id + (when-let* ((node-id (ebox--buffer-region-render-owner-node-id buffer region-id))) (ebox--buffer-runtime-node buffer node-id))) @@ -1286,7 +1286,7 @@ recursive region path only for legacy or incomplete runtime state." Discard the isolated reflow scratch tree unless PRESERVE-REFLOW-PREWARM-SCRATCH is non-nil. Callers may preserve it only while validating one predicted root-width mutation against the new revision." - (when-let ((state (ebox--buffer-render-state buffer))) + (when-let* ((state (ebox--buffer-render-state buffer))) (let ((revision (1+ (or (plist-get state :runtime-revision) 0)))) (plist-put state :runtime-revision revision) @@ -1296,7 +1296,7 @@ while validating one predicted root-width mutation against the new revision." (defun ebox--buffer-viewport-dependent-node-id-axes (buffer) "Return cached viewport-dependent node ids by axis for BUFFER." - (when-let ((state (ebox--buffer-render-state buffer))) + (when-let* ((state (ebox--buffer-render-state buffer))) (if (and (plist-get state :viewport-dependent-node-ids-ready) (plist-member state :viewport-dependent-node-id-axes)) (plist-get state :viewport-dependent-node-id-axes) @@ -1320,13 +1320,13 @@ while validating one predicted root-width mutation against the new revision." (defun ebox--buffer-viewport-dependent-node-ids (buffer) "Return cached viewport-dependent node ids for BUFFER." - (when-let ((state (ebox--buffer-render-state buffer))) + (when-let* ((state (ebox--buffer-render-state buffer))) (ebox--buffer-viewport-dependent-node-id-axes buffer) (plist-get state :viewport-dependent-node-ids))) (defun ebox--invalidate-buffer-viewport-dependencies (buffer) "Invalidate BUFFER's cached viewport dependency list." - (when-let ((state (ebox--buffer-render-state buffer))) + (when-let* ((state (ebox--buffer-render-state buffer))) (plist-put state :viewport-dependent-node-ids nil) (plist-put state :viewport-dependent-node-id-axes nil) (plist-put state :viewport-dependent-node-ids-ready nil))) @@ -1380,9 +1380,9 @@ while validating one predicted root-width mutation against the new revision." (defun ebox--layout-snapshot (buffer node-id) "Return BUFFER's layout snapshot for NODE-ID." - (when-let ((snapshots (ebox--ensure-buffer-layout-snapshots buffer))) + (when-let* ((snapshots (ebox--ensure-buffer-layout-snapshots buffer))) (let ((snapshot (or (gethash node-id snapshots) - (when-let ((node (ebox--snapshot-published-node + (when-let* ((node (ebox--snapshot-published-node buffer node-id))) (let ((created (ebox--node-layout-snapshot @@ -1439,12 +1439,12 @@ Use `ebox--with-layout-snapshot-index-context' for batch snapshot capture." "Return a copy of BUFFER's current layout snapshot table. When DETAILS is non-nil, include derived buffer spans and line signatures in the returned copy without mutating BUFFER's stored snapshot table." - (when-let ((state (ebox--buffer-render-state buffer))) + (when-let* ((state (ebox--buffer-render-state buffer))) (when (and (plist-get state :root-node) (not (plist-get state :layout-snapshots-complete-p))) (ebox--refresh-buffer-layout-snapshots buffer details))) (let ((copy (make-hash-table :test 'equal))) - (when-let ((snapshots (ebox--ensure-buffer-layout-snapshots buffer))) + (when-let* ((snapshots (ebox--ensure-buffer-layout-snapshots buffer))) (let (entries) (maphash (lambda (node-id snapshot) (push (cons node-id @@ -1479,9 +1479,9 @@ the returned copy without mutating BUFFER's stored snapshot table." (defun ebox--clear-layout-snapshots (buffer) "Clear BUFFER's layout snapshots." - (when-let ((state (ebox--buffer-render-state buffer))) + (when-let* ((state (ebox--buffer-render-state buffer))) (plist-put state :layout-snapshots-complete-p nil)) - (when-let ((snapshots (ebox--ensure-buffer-layout-snapshots buffer))) + (when-let* ((snapshots (ebox--ensure-buffer-layout-snapshots buffer))) (clrhash snapshots))) (defun ebox--plist-remove-key (plist key) @@ -1505,8 +1505,8 @@ the returned copy without mutating BUFFER's stored snapshot table." "Remove stored buffer-owned runtime state for BUFFER. Defaults to the current buffer." (let ((buffer (or buffer (current-buffer)))) - (when-let ((cache (ebox--buffer-render-cache buffer))) - (when-let ((root-cache + (when-let* ((cache (ebox--buffer-render-cache buffer))) + (when-let* ((root-cache (gethash cache ebox--render-root-cache-table-table))) (remhash root-cache ebox--render-cache-ring-table)) (remhash cache ebox--render-root-cache-table-table) @@ -1543,7 +1543,7 @@ Defaults to the current buffer." (dolist (region-id (get-text-property pos 'ebox-content-owners)) (cl-pushnew region-id ids :test #'equal)) (dolist (entry ebox-region-types) - (when-let ((region-id (get-text-property pos (cdr entry)))) + (when-let* ((region-id (get-text-property pos (cdr entry)))) (cl-pushnew region-id ids :test #'equal))) ids)) @@ -1551,7 +1551,7 @@ Defaults to the current buffer." "Return all ebox region role/id pairs present at POS." (let (role-ids) (dolist (entry ebox-region-types) - (when-let ((region-id (get-text-property pos (cdr entry)))) + (when-let* ((region-id (get-text-property pos (cdr entry)))) (push (cons (car entry) region-id) role-ids))) role-ids)) @@ -1572,7 +1572,7 @@ Defaults to the current buffer." (let ((map (make-hash-table :test 'eql))) (puthash region-id map region-lines) map)))) - (if-let ((range (gethash line-number line-map))) + (if-let* ((range (gethash line-number line-map))) (setcdr range (max (cdr range) end)) (puthash line-number (cons start end) line-map)))) @@ -1681,10 +1681,10 @@ therefore unsafe." (candidate-lines (make-hash-table :test 'eql)) spans) (dolist (region-id region-ids) - (when-let ((line-map (gethash region-id region-lines))) + (when-let* ((line-map (gethash region-id region-lines))) (maphash (lambda (line-number range) - (if-let ((existing (gethash line-number candidate-lines))) + (if-let* ((existing (gethash line-number candidate-lines))) (progn (setcar existing (min (car existing) (car range))) (setcdr existing (max (cdr existing) (cdr range)))) @@ -1728,7 +1728,7 @@ therefore unsafe." (range-start (max (point) line-start)) (range-end (min end line-end))) (when (< range-start range-end) - (if-let ((existing (gethash line-start line-ranges))) + (if-let* ((existing (gethash line-start line-ranges))) (progn (setcar existing (min (car existing) range-start)) (setcdr existing (max (cdr existing) range-end))) @@ -2032,10 +2032,10 @@ the planning pass has one for this buffer." (defun ebox--ensure-layout-snapshot-spans (buffer node-id) "Ensure BUFFER's stored snapshot for NODE-ID has buffer span details." - (when-let ((snapshot (ebox--layout-snapshot buffer node-id))) + (when-let* ((snapshot (ebox--layout-snapshot buffer node-id))) (if (ebox--layout-snapshot-spans-p snapshot) snapshot - (when-let ((node (ebox--snapshot-published-node buffer node-id))) + (when-let* ((node (ebox--snapshot-published-node buffer node-id))) (let ((detailed (ebox--with-layout-snapshot-detail-context buffer (ebox--complete-layout-snapshot-spans @@ -2045,10 +2045,10 @@ the planning pass has one for this buffer." (defun ebox--ensure-layout-snapshot-details (buffer node-id) "Ensure BUFFER's stored snapshot for NODE-ID has expensive detail fields." - (when-let ((snapshot (ebox--layout-snapshot buffer node-id))) + (when-let* ((snapshot (ebox--layout-snapshot buffer node-id))) (if (ebox--layout-snapshot-detailed-p snapshot) snapshot - (when-let ((node (ebox--snapshot-published-node buffer node-id))) + (when-let* ((node (ebox--snapshot-published-node buffer node-id))) (let ((detailed (ebox--with-layout-snapshot-detail-context buffer (ebox--complete-layout-snapshot buffer node snapshot)))) @@ -2069,14 +2069,14 @@ When DETAILS is non-nil, include expensive per-line detail fields." (defun ebox--refresh-buffer-layout-snapshots (buffer &optional details) "Recapture BUFFER's layout snapshots from its stored runtime root. When DETAILS is non-nil, include expensive per-line detail fields." - (when-let ((root (ebox--buffer-root-node buffer))) + (when-let* ((root (ebox--buffer-root-node buffer))) (ebox--clear-layout-snapshots buffer) (let ((ebox--node-region-ids-cache (make-hash-table :test 'eq))) (if details (ebox--with-layout-snapshot-index-context buffer (ebox--capture-layout-snapshots buffer root t)) (ebox--capture-layout-snapshots buffer root))) - (when-let ((state (ebox--buffer-render-state buffer))) + (when-let* ((state (ebox--buffer-render-state buffer))) (plist-put state :layout-snapshots-complete-p t)))) (defconst ebox--dirty-kind-order @@ -2170,14 +2170,14 @@ When DETAILS is non-nil, include expensive per-line detail fields." (car ebox-incremental--candidate-proof-node-table)) (gethash node-id (cdr ebox-incremental--candidate-proof-node-table))) - (when-let ((node-table (ebox--buffer-node-table buffer))) + (when-let* ((node-table (ebox--buffer-node-table buffer))) (gethash node-id node-table)) - (when-let ((root (ebox--buffer-root-node buffer))) + (when-let* ((root (ebox--buffer-root-node buffer))) (ebox--runtime-node-by-id root node-id)))) (defun ebox--runtime-parent-id (buffer node-id) "Return NODE-ID's parent id in BUFFER runtime state." - (when-let ((parent-table (ebox--buffer-parent-table buffer))) + (when-let* ((parent-table (ebox--buffer-parent-table buffer))) (gethash node-id parent-table))) (defun ebox--invalidate-runtime-render-signature-path @@ -2188,7 +2188,7 @@ When DETAILS is non-nil, include expensive per-line detail fields." (when signature-cache (clrhash signature-cache)) (when height-cache (clrhash height-cache))) (while node-id - (when-let ((node (gethash node-id node-table))) + (when-let* ((node (gethash node-id node-table))) (when signature-cache (remhash node signature-cache)) (when height-cache (remhash node height-cache))) (setq node-id (gethash node-id parent-table))))) @@ -2303,7 +2303,7 @@ checks pays one walk per distinct node instead of one walk per pair." (defun ebox--dirty-provenance-node-ids (dirty) "Return the distinct source node ids recorded by DIRTY provenance." (delete-dups - (append (when-let ((node-id (plist-get dirty :node-id))) + (append (when-let* ((node-id (plist-get dirty :node-id))) (list node-id)) (copy-sequence (or (plist-get dirty :node-ids) nil))))) @@ -2412,7 +2412,7 @@ checks pays one walk per distinct node instead of one walk per pair." (remaining (if same-owner (delq same-owner (copy-sequence ops)) (copy-sequence ops)))) - (if-let ((dominator + (if-let* ((dominator (cl-find-if (lambda (op) (ebox--patch-op-dominates-p buffer op candidate)) @@ -2684,7 +2684,7 @@ When BUFFER is non-nil, non-paint entries promote to patchable owners." (ebox--patch-op 'paint-patch node-id :dirty entry)) (_ - (if-let ((span-owner-id + (if-let* ((span-owner-id (and buffer (ebox--span-patch-owner-id-for-dirty-entry entry buffer)))) @@ -2909,7 +2909,7 @@ cross-axis keys change its row footprint, exactly the pair "Return FLEX-NODE's child whose source owns NODE-ID." (cl-find-if (lambda (child) - (when-let ((source (ebox--flex-item-source-node child))) + (when-let* ((source (ebox--flex-item-source-node child))) (equal (plist-get source :node-id) node-id))) (ebox-tree-layout-children flex-node))) @@ -2969,7 +2969,7 @@ is still verified by the existing rendered slot-footprint proof." Unknown changes fail closed. A fixed outer size is insufficient for content updates unless the auto flex basis stays fixed and the new minimum still fits the already published slot." - (when-let ((style-node (ebox-fragment-style-source-node node))) + (when-let* ((style-node (ebox-fragment-style-source-node node))) (let* ((item-props (ebox--flex-item-props child)) (fixed-basis-p (ebox--flex-fixed-basis-content-allocation-stable-p @@ -3223,7 +3223,7 @@ running expensive span and snapshot checks." (defun ebox--span-patchable-owner-p (buffer node-id) "Return non-nil when NODE-ID can attempt verified span patching." - (when-let ((node (ebox--buffer-runtime-node buffer node-id))) + (when-let* ((node (ebox--buffer-runtime-node buffer node-id))) (and ;; Planning only needs to reject an explicitly visible overflow ;; owner. Content-dependent overflow remains part of the final ;; span/role validator; formatting it here for every ancestor made @@ -3233,7 +3233,7 @@ running expensive span and snapshot checks." ;; Allocation shape is coordinate-independent and survives a ;; detail-generation bump. The later owner/surface proof still ;; resolves exact current spans before publication. - (when-let ((snapshot (ebox--layout-snapshot buffer node-id))) + (when-let* ((snapshot (ebox--layout-snapshot buffer node-id))) (plist-get snapshot :allocation-shape)) (when-let* ((snapshot (ebox--ensure-layout-snapshot-spans buffer node-id)) @@ -3424,7 +3424,7 @@ hash lookups instead of a scan of the whole set." (dominator nil)) (maphash (lambda (ancestor-id _present) - (when-let ((entry (gethash ancestor-id owner-table))) + (when-let* ((entry (gethash ancestor-id owner-table))) (when (and (>= (ebox--patch-operation-strength (plist-get (aref entry 0) :op)) (ebox--patch-operation-strength 'span-patch)) @@ -3561,7 +3561,7 @@ When NIL-DEPENDENT is non-nil, nil is treated as viewport-dependent auto width." (defun ebox--flex-participation-viewport-dependent-p (node) "Return non-nil when NODE's flex item metadata depends on viewport context." - (when-let ((participation (ebox--flex-participation-props node))) + (when-let* ((participation (ebox--flex-participation-props node))) (ebox--viewport-dependent-size-value-p (plist-get participation :flex-basis)))) @@ -3674,7 +3674,7 @@ Definite width contains descendant width ids, but not height ids." (defun ebox--viewport-dependent-node-ids (node) "Return runtime node ids under NODE that depend on viewport context." - (when-let ((axes (ebox--viewport-dependent-node-id-axes node))) + (when-let* ((axes (ebox--viewport-dependent-node-id-axes node))) (delete-dups (copy-sequence (append (car axes) (cdr axes)))))) (defun ebox--viewport-dirty-set (root) @@ -3688,7 +3688,7 @@ Definite width contains descendant width ids, but not height ids." "Return the implicit viewport constraint change for BUFFER. AXES may be `width', `height', `both', or `none'. Nil means both axes for legacy callers." - (when-let ((root (ebox--buffer-root-node buffer))) + (when-let* ((root (ebox--buffer-root-node buffer))) (let* ((node-ids (pcase axes ('width @@ -3860,7 +3860,7 @@ during `ebox-incremental-flush'." (defun ebox-incremental--batch-change (buffer pending) "Return a normalized batch constraint change for BUFFER and PENDING." - (when-let ((root (ebox--buffer-root-node buffer))) + (when-let* ((root (ebox--buffer-root-node buffer))) (ebox--constraint-change 'batch 'batch 'batch (ebox--ensure-node-id root) @@ -4624,7 +4624,7 @@ Cost is proportional to the replacements, never to the page." (when (and sibling-id (not (equal sibling-id node-id)) (equal (plist-get - (if-let + (if-let* ((sibling-replacement (ebox-incremental--candidate-replacement-for-anchor entries sibling-id))) @@ -4639,14 +4639,14 @@ Cost is proportional to the replacements, never to the page." ;; Host refs must be fresh or freed by this same commit. (when host-ref-table (dolist (ref (collect-host-refs replacement nil)) - (when-let ((existing-anchor + (when-let* ((existing-anchor (gethash ref replacement-host-refs))) (unless (or (ancestor-p existing-anchor node-id) (ancestor-p node-id existing-anchor)) (error "Ebox declarative host reference %S is not unique" ref))) (puthash ref node-id replacement-host-refs) - (when-let ((owner-id (gethash ref host-ref-table))) + (when-let* ((owner-id (gethash ref host-ref-table))) (unless (inside-replaced-anchor-p owner-id) (error "Ebox declarative host reference %S is not unique" @@ -4654,7 +4654,7 @@ Cost is proportional to the replacements, never to the page." (defun ebox-incremental--copy-detached-history (state) "Return an unpublished detached identity history copied from STATE." - (if-let ((history (plist-get state :detached-identity-history))) + (if-let* ((history (plist-get state :detached-identity-history))) (ebox-incremental--make-detached-history :table (copy-hash-table @@ -4932,13 +4932,13 @@ but must re-enter the candidate indexes as a new object." (let ((table (copy-hash-table (plist-get old-state :range-ref-table)))) (cl-labels ((walk (node function) - (when-let ((sequence (plist-get node :ebox-child-sequence))) + (when-let* ((sequence (plist-get node :ebox-child-sequence))) (dolist (record (ebox-child-range--range-records sequence)) (funcall function node record))) (dolist (child (ebox-tree--children-raw node)) (walk child function)))) (dolist (anchor anchors) - (when-let ((old (gethash (car anchor) + (when-let* ((old (gethash (car anchor) (plist-get old-state :node-table)))) (walk old (lambda (_parent record) @@ -5424,13 +5424,13 @@ Return the same pure surface-input shape as (when (hash-table-p old-snapshots) (maphash (lambda (node-id _node) - (when-let ((snapshot (gethash node-id old-snapshots))) + (when-let* ((snapshot (gethash node-id old-snapshots))) (puthash node-id (copy-sequence snapshot) snapshots))) candidate-node-table) ;; A root type replacement receives a fresh runtime id, but its patch ;; owner still covers the currently published complete-buffer geometry. (unless (equal old-root-id candidate-root-id) - (when-let ((snapshot (gethash old-root-id old-snapshots))) + (when-let* ((snapshot (gethash old-root-id old-snapshots))) (setq snapshot (copy-sequence snapshot)) (setq snapshot (plist-put snapshot :node-id candidate-root-id)) (puthash candidate-root-id snapshot snapshots)))) @@ -5536,14 +5536,14 @@ Return the same pure surface-input shape as (defun ebox-incremental--simple-new-child-splice-p (buffer owner-id dirty) "Return non-nil when DIRTY is a cheap vertical child splice." - (when-let ((owner (ebox--buffer-runtime-node buffer owner-id))) + (when-let* ((owner (ebox--buffer-runtime-node buffer owner-id))) (pcase-let* ((old-ids (plist-get dirty :old-child-ids)) (new-ids (plist-get dirty :new-child-ids)) (`(,_old-middle ,new-middle) (ebox-incremental--child-list-middle old-ids new-ids))) (and (eq (plist-get owner :ebox-type) 'stack) (eq (ebox-tree-display-inner owner) 'column) - (when-let ((snapshot + (when-let* ((snapshot (ebox--ensure-layout-snapshot-spans buffer owner-id))) (unless (with-current-buffer buffer @@ -5593,10 +5593,10 @@ Return the same pure surface-input shape as ((hash-table-p owned-table))) (copy-hash-table owned-table) (let ((table (make-hash-table :test 'equal))) - (when-let ((region-id-set (plist-get state :region-id-set))) + (when-let* ((region-id-set (plist-get state :region-id-set))) (maphash (lambda (region-id _present) - (when-let ((box (gethash region-id ebox--region-box-table))) + (when-let* ((box (gethash region-id ebox--region-box-table))) (puthash region-id box table))) region-id-set)) table))) @@ -5636,7 +5636,7 @@ Return the same pure surface-input shape as (ebox--ensure-node-id node) node)) ('flex - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (list (ebox--ensure-region-id box) (ebox--ensure-node-id node) box))))) @@ -5680,7 +5680,7 @@ complete preorder first-owner and postorder last-box semantics." (cl-labels ((visit (node) (when (and (listp node) (not (stringp node))) - (when-let ((record + (when-let* ((record (ebox-incremental--candidate-node-region-record node))) (pcase-let ((`(,region-id ,owner-id ,_box) record)) (when (gethash region-id region-ids) @@ -5689,7 +5689,7 @@ complete preorder first-owner and postorder last-box semantics." (puthash region-id owner-id region-node-table))))) (dolist (child (ebox--node-children node)) (visit child)) - (when-let ((record + (when-let* ((record (ebox-incremental--candidate-node-region-record node))) (pcase-let ((`(,region-id ,_owner-id ,box) record)) (when (gethash region-id region-ids) @@ -6009,10 +6009,10 @@ replace those O(n) table copies without changing this delta contract." runtime-type-count-table node -1) (remhash node-id node-table) (remhash node-id parent-table) - (when-let ((host-ref (plist-get node :host-ref))) + (when-let* ((host-ref (plist-get node :host-ref))) (when (equal (gethash host-ref host-ref-table) node-id) (remhash host-ref host-ref-table))) - (when-let ((record + (when-let* ((record (ebox-incremental--candidate-node-region-record node))) (puthash (car record) t affected-region-ids)) (when (hash-table-p old-region-box-count-table) @@ -6035,7 +6035,7 @@ replace those O(n) table copies without changing this delta contract." (when old-node (ebox-incremental--adjust-runtime-type-count runtime-type-count-table old-node -1) - (when-let ((record + (when-let* ((record (ebox-incremental--candidate-node-region-record old-node))) (puthash (car record) t affected-region-ids)) @@ -6050,9 +6050,9 @@ replace those O(n) table copies without changing this delta contract." (remhash node-id parent-table)) ;; Replacement subtrees were validated before recording and ;; checked against untouched Host refs before path copying. - (when-let ((new-host-ref (plist-get new-node :host-ref))) + (when-let* ((new-host-ref (plist-get new-node :host-ref))) (puthash new-host-ref node-id host-ref-table)) - (when-let ((record + (when-let* ((record (ebox-incremental--candidate-node-region-record new-node))) (puthash (car record) t affected-region-ids)) @@ -6080,7 +6080,7 @@ replace those O(n) table copies without changing this delta contract." ;; TOUCHED is preorder, matching `ebox--runtime-index' ownership: ;; a flex owner claims its wrapper before the wrapper box is visited. (dolist (entry touched) - (when-let ((record + (when-let* ((record (ebox-incremental--candidate-node-region-record (nth 1 entry)))) (pcase-let ((`(,region-id ,owner-id ,box) record)) @@ -6221,7 +6221,7 @@ CANDIDATE-INDEX is the prepared runtime index for CANDIDATE-ROOT." dirty) (maphash (lambda (node-id new-node) - (when-let ((old-node (gethash node-id old-table))) + (when-let* ((old-node (gethash node-id old-table))) (let* ((changed-keys (ebox-tree-node-local-changed-keys old-node new-node)) @@ -6367,7 +6367,7 @@ candidate therefore owns its cache tables until TP commits the generation." (hash-table-p candidate-node-table)) (maphash (lambda (node-id candidate-node) - (when-let ((old-node (gethash node-id old-node-table))) + (when-let* ((old-node (gethash node-id old-node-table))) (let ((cached (gethash old-node old-cache missing))) (unless (eq cached missing) (puthash candidate-node cached candidate-cache))))) @@ -6391,7 +6391,7 @@ must be recomputed in the next publication." old-node-table old-parent-table candidate-cache nil)) (dolist (node-id (append touched-node-ids removed-node-ids)) - (when-let ((old-node (gethash node-id old-node-table))) + (when-let* ((old-node (gethash node-id old-node-table))) (remhash old-node candidate-cache))) candidate-cache)) @@ -6606,7 +6606,7 @@ must be recomputed in the next publication." ('geometry (ebox--patch-op-from-dirty-entry entry buffer)) (_ - (if-let ((span-owner-id + (if-let* ((span-owner-id (ebox--span-patch-owner-id-for-dirty-entry entry buffer))) (ebox--patch-op 'span-patch span-owner-id :dirty entry) (when (and (eq dirty-kind 'structure) @@ -6898,7 +6898,7 @@ It never partitions larger dirty sets, preserving their existing coalescing." ;; One dirty entry needs no dominance/coalescing pass. Build ;; its tentative operation directly; the exact span or ;; allocation proof below still owns authorization. - (when-let ((op + (when-let* ((op (ebox-incremental--declarative-tentative-op buffer dirty))) (list op))) @@ -7500,7 +7500,7 @@ rendered into its retained slot and must pass the complete footprint proof." (index (ebox--make-patch-op-merge-index)) ops) (ebox--with-layout-snapshot-detail-context buffer - (if-let ((coalesced-op + (if-let* ((coalesced-op (and (not (ebox-incremental--dirty-set-has-child-splice-p buffer render-dirty-set)) @@ -7555,7 +7555,7 @@ rendered into its retained slot and must pass the complete footprint proof." (defun ebox-incremental--layout-owner-plan (buffer old-state candidate-state dirty-set) "Return BUFFER layout-owner plan from OLD-STATE to CANDIDATE-STATE for DIRTY-SET." - (when-let ((render-dirty-set + (when-let* ((render-dirty-set (cl-remove-if (lambda (entry) (eq (plist-get entry :dirty-kind) 'metadata)) @@ -7591,7 +7591,7 @@ closure may still plan one for a later owner-scoped surface projection." (cl-some (lambda (entry) (and (eq (plist-get entry :dirty-kind) 'structure) - (when-let ((object + (when-let* ((object (gethash (plist-get entry :node-id) objects))) (null (gethash object style-states))))) @@ -7636,7 +7636,7 @@ closure may still plan one for a later owner-scoped surface projection." (defun ebox-incremental--root-owner-plan (buffer dirty-set) "Return one conservative root owner operation for DIRTY-SET." - (when-let ((root-id (ebox--buffer-root-node-id buffer))) + (when-let* ((root-id (ebox--buffer-root-node-id buffer))) (list (ebox--patch-op 'owner-rerender root-id @@ -7645,7 +7645,7 @@ closure may still plan one for a later owner-scoped surface projection." (defun ebox-incremental--native-frame-plan (buffer dirty-set) "Return the bounded publication plan for a complete native frame." - (when-let ((root-id (ebox--buffer-root-node-id buffer))) + (when-let* ((root-id (ebox--buffer-root-node-id buffer))) (list (ebox--patch-op 'native-frame root-id diff --git a/ebox-layout.el b/ebox-layout.el index afcd214..e2f32d4 100644 --- a/ebox-layout.el +++ b/ebox-layout.el @@ -865,7 +865,7 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values." (and (consp value) (or (eq (car value) 'viewport-height) (memq (car value) '(+ -))))) - (if-let ((height (ebox--resolve-height-expression-lines value))) + (if-let* ((height (ebox--resolve-height-expression-lines value))) (ebox--box-sizing-content-height box (max 0 height)) fallback)) (t @@ -925,7 +925,7 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values." (defun ebox--box-content (box) "Return BOX content, rendering any lazy child layout content if present." (ebox--propertize-typography - (or (when-let ((node (ebox--box-content-node box))) + (or (when-let* ((node (ebox--box-content-node box))) (ebox--render-box-content-node box node)) (ebox-get box :content)) box)) @@ -980,7 +980,7 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values." (defun ebox--stretch-content-pixel (box) "Return BOX's stretch-fit content width, or nil without a viewport." - (when-let ((viewport (ebox--viewport-pixel-width nil))) + (when-let* ((viewport (ebox--viewport-pixel-width nil))) (max 0 (- viewport (ebox--side-pixel box))))) (defun ebox--fit-content-pixel (box limit) @@ -1000,7 +1000,7 @@ Return nil for intrinsic sizes such as min-content and max-content." (cond ((null value) nil) ((ebox--viewport-size-value-p value) - (when-let ((viewport (ebox--viewport-pixel-width nil))) + (when-let* ((viewport (ebox--viewport-pixel-width nil))) (ebox--box-sizing-content-pixel box viewport))) ((numberp value) (ebox--box-sizing-content-pixel box value)) @@ -1010,7 +1010,7 @@ Return nil for intrinsic sizes such as min-content and max-content." (let ((limit (cadr value))) (cond ((ebox--viewport-size-value-p limit) - (when-let ((viewport (ebox--viewport-pixel-width nil))) + (when-let* ((viewport (ebox--viewport-pixel-width nil))) (ebox--box-sizing-content-pixel box viewport))) ((numberp limit) (ebox--box-sizing-content-pixel box limit)) @@ -1087,7 +1087,7 @@ FALLBACK is used for nil and auto values." (cond ((null value) fallback) ((eq value 'viewport) - (if-let ((viewport (ebox--viewport-pixel-width nil))) + (if-let* ((viewport (ebox--viewport-pixel-width nil))) (ebox--box-sizing-content-pixel box viewport) fallback)) ((numberp value) @@ -2153,7 +2153,7 @@ last cached leaf instead of walking the stack from the beginning." (defun ebox--scroll-window-content-height (box) "Return BOX's definite scroll content height, or nil." - (when-let ((fixed-height + (when-let* ((fixed-height (ebox--resolve-size-content-height box (ebox-get box :height) nil))) (ebox--content-height box fixed-height))) @@ -2706,7 +2706,7 @@ no included vertical margin." (ebox--propertize-underline (car tail) border-bottom-color) 'ebox-bb region-id)))) - (when-let ((properties (ebox-get box :surface-properties))) + (when-let* ((properties (ebox-get box :surface-properties))) (setq lines (mapcar (lambda (line) (ebox--apply-surface-properties line properties)) diff --git a/ebox-native-commit.el b/ebox-native-commit.el index 4b00a49..bb82af1 100644 --- a/ebox-native-commit.el +++ b/ebox-native-commit.el @@ -112,7 +112,7 @@ do (puthash (plist-get child :node-id) (cons parent-id position) table))) nodes) - (when-let ((root (plist-get state :root-node))) + (when-let* ((root (plist-get state :root-node))) (puthash (plist-get root :node-id) (cons nil 0) table))) table)) @@ -391,7 +391,7 @@ type, key, parent, and sibling position are identical." (defun ebox-native-commit--promote-pending-frame (state session) "Promote STATE's previously published pending frame in SESSION." - (when-let ((pending (plist-get state :native-sync-pending))) + (when-let* ((pending (plist-get state :native-sync-pending))) (ebox-native-reflow-confirm-native-frame session (plist-get pending :generation) (plist-get pending :key) (plist-get pending :confirmed-revision)) @@ -485,7 +485,7 @@ Return nil without mutating STATE when the native capability proof is absent." (memq (plist-get state :projection-kind) '(nil native-frame)) (ebox-native-commit--runtime-types-supported-p state) (ebox-native-commit--region-index-safe-p state)) - (when-let ((frame-spec (ebox-native-commit--frame-spec state node))) + (when-let* ((frame-spec (ebox-native-commit--frame-spec state node))) (condition-case err (let* ((frame (ebox-native-commit--retained-frame state node frame-spec)) diff --git a/ebox-native-reflow.el b/ebox-native-reflow.el index 5796979..b9c2730 100644 --- a/ebox-native-reflow.el +++ b/ebox-native-reflow.el @@ -103,7 +103,7 @@ (defun ebox-native-reflow--rust-target () "Return the Rust target triple matching the current Emacs binary." - (when-let ((architecture (ebox-native-reflow--rust-architecture))) + (when-let* ((architecture (ebox-native-reflow--rust-architecture))) (pcase system-type ('darwin (format "%s-apple-darwin" architecture)) ('gnu/linux (format "%s-unknown-linux-gnu" architecture)) @@ -339,7 +339,7 @@ validation.") (defun ebox-native-reflow--candidate-paths () "Return the sole configured native module candidate path." - (when-let ((candidate + (when-let* ((candidate (ebox-native-reflow--expand-candidate ebox-native-reflow-module-path))) (list candidate))) @@ -429,7 +429,7 @@ fails after moving the current module aside, restore that previous module." (defun ebox-native-reflow--tool-release (output) "Return the numeric Cargo or rustc release parsed from OUTPUT." - (when-let ((line (ebox-native-reflow--tool-version output))) + (when-let* ((line (ebox-native-reflow--tool-version output))) (when (string-match "\\`\\(?:cargo\\|rustc\\) \\([0-9]+\\(?:\\.[0-9]+\\)+\\)" line) @@ -449,7 +449,7 @@ fails after moving the current module aside, restore that previous module." (defun ebox-native-reflow--rustup-toolchains (rustup) "Return installed toolchain names reported by RUSTUP." - (when-let ((output + (when-let* ((output (ebox-native-reflow--command-output rustup "toolchain" "list"))) (mapcar (lambda (line) (car (split-string line " " t))) (split-string output "\n" t)))) @@ -850,7 +850,7 @@ next Emacs start." (defun ebox-native-reflow--append-build-log (format-string &rest arguments) "Append FORMAT-STRING and ARGUMENTS to the native build buffer." - (when-let ((buffer (get-buffer ebox-native-reflow--build-buffer-name))) + (when-let* ((buffer (get-buffer ebox-native-reflow--build-buffer-name))) (with-current-buffer buffer (let ((inhibit-read-only t)) (goto-char (point-max)) @@ -858,7 +858,7 @@ next Emacs start." (defun ebox-native-reflow--refresh-status-buffer () "Refresh an existing native status buffer without selecting it." - (when-let ((buffer (get-buffer "*Ebox Native Status*"))) + (when-let* ((buffer (get-buffer "*Ebox Native Status*"))) (with-current-buffer buffer (let ((inhibit-read-only t) (diagnosis (ebox-native--diagnose))) @@ -1917,7 +1917,7 @@ backend has a matching two-dimensional layout contract." (ebox--layout-children node))) ((eq (plist-get node :ebox-type) 'flex) (cl-every #'ebox-native-reflow--native-node-supported-p - (append (when-let ((box (plist-get node :box))) + (append (when-let* ((box (plist-get node :box))) (list box)) (ebox-tree-layout-children node)))) ((eq (plist-get node :ebox-type) 'flex-item) @@ -2150,7 +2150,7 @@ per call, and no call recursively visits the captured Ebox tree." (defun ebox-native-reflow--retained-layout-children (node) "Return NODE children referenced by one compiled native fragment." (pcase (plist-get node :ebox-type) - ('box (when-let ((child (plist-get node :ebox-content-node))) + ('box (when-let* ((child (plist-get node :ebox-content-node))) (list child))) ((or 'concat 'stack) (ebox--layout-children node)) ('flex @@ -3509,7 +3509,7 @@ typed line-width and property invariants instead of repeating them in Emacs." (session generation key &optional expected) "Take and materialize SESSION's semantic layout result. EXPECTED may add exact tape identity fields beyond GENERATION and KEY." - (when-let ((payload + (when-let* ((payload (ebox-native--module-take (ebox-native-reflow--live-handle session) generation key))) (let ((identity (copy-sequence expected))) @@ -3618,7 +3618,7 @@ root effect metadata required by a thin host commit." This compatibility entry returns only the rendered string. New runtime callers should consume `ebox-native-reflow-execute-sync' and commit its effect metadata together with the text." - (when-let ((result + (when-let* ((result (ebox-native-reflow-execute-sync node frame layout-package))) (plist-get result :rendered))) @@ -3726,11 +3726,11 @@ metadata together with the text." fragments))) (setq fragments (nreverse fragments)) (dolist (fragment fragments) - (if-let ((roles (plist-get fragment :role-ids))) + (if-let* ((roles (plist-get fragment :role-ids))) (setq previous-role-ids roles) (plist-put fragment :previous-role-ids previous-role-ids))) (dolist (fragment (reverse (copy-sequence fragments))) - (if-let ((roles (plist-get fragment :role-ids))) + (if-let* ((roles (plist-get fragment :role-ids))) (setq next-role-ids roles) (plist-put fragment :role-ids (delete-dups @@ -3771,7 +3771,7 @@ metadata together with the text." (defun ebox-native-reflow-take (session generation key) "Take SESSION's GENERATION KEY result as a UTF-8 string, or nil." - (when-let ((bytes + (when-let* ((bytes (ebox-native--module-take (ebox-native-reflow--live-handle session) generation key))) (decode-coding-string bytes 'utf-8 t))) @@ -3882,7 +3882,7 @@ published frame has been installed." (defun ebox-native-reflow--preparation-key (preparation logical-key full-p) "Return PREPARATION's native key for LOGICAL-KEY and FULL-P." - (when-let ((keys + (when-let* ((keys (gethash logical-key (ebox-native-reflow-preparation-key-table preparation)))) @@ -3900,7 +3900,7 @@ published frame has been installed." (defun ebox-native-reflow--stop-preparation-ready-watch (preparation) "Stop PREPARATION's main-thread readiness timer." - (when-let ((timer + (when-let* ((timer (ebox-native-reflow-preparation-ready-timer preparation))) (when (timerp timer) (cancel-timer timer)) @@ -3934,7 +3934,7 @@ published frame has been installed." (defun ebox-native-reflow--readiness-sentinel (process _event) "Surface an unexpected native readiness channel close for PROCESS." - (when-let ((session + (when-let* ((session (process-get process 'ebox-native-reflow-session))) (when (and (eq process (ebox-native-reflow-session-readiness-process session)) @@ -3991,7 +3991,7 @@ published frame has been installed." (when-let* ((session (ebox-native-reflow-preparation-native-session preparation)) ((ebox-native-reflow--ensure-session-readiness session))) - (when-let ((current + (when-let* ((current (ebox-native-reflow-session-readiness-preparation session))) (unless (eq current preparation) (error "Native reflow session already routes another preparation"))) @@ -4001,7 +4001,7 @@ published frame has been installed." (defun ebox-native-reflow--clear-preparation-readiness (preparation) "Clear PREPARATION's route without closing its session channel." - (when-let ((session + (when-let* ((session (ebox-native-reflow-preparation-native-session preparation))) (when (eq preparation (ebox-native-reflow-session-readiness-preparation session)) @@ -4009,7 +4009,7 @@ published frame has been installed." (defun ebox-native-reflow--idle-continuation-delay (delay) "Return a fresh idle threshold DELAY beyond the current idle duration." - (+ (or (when-let ((idle (current-idle-time))) + (+ (or (when-let* ((idle (current-idle-time))) (float-time idle)) 0) (max 0 (or delay 0)))) @@ -4059,7 +4059,7 @@ published frame has been installed." (unless (or (ebox-native-reflow-preparation-stopped-p preparation) (ebox-native-reflow-preparation-error preparation)) (setf (ebox-native-reflow-preparation-error preparation) message) - (when-let ((function + (when-let* ((function (ebox-native-reflow-preparation-error-function preparation))) (funcall function preparation message)))) @@ -4079,7 +4079,7 @@ published frame has been installed." (let ((materialized-p (ebox-native-reflow--materialize-next-ready-frame preparation))) - (when-let ((function + (when-let* ((function (ebox-native-reflow-preparation-ready-function preparation))) (funcall function preparation nil)) @@ -4202,7 +4202,7 @@ creating and releasing a session for this preparation." :error-function error-function :idle-watch-p idle-watch-p :window-start-line - (when-let ((window (get-buffer-window buffer t))) + (when-let* ((window (get-buffer-window buffer t))) (with-current-buffer buffer (save-restriction (widen) @@ -4247,7 +4247,7 @@ When FULL-P is non-nil, query the complete restoration job." (ebox-native-reflow--preparation-cache-key logical-key full-p) cache)) - (when-let ((native-key + (when-let* ((native-key (ebox-native-reflow--preparation-key preparation logical-key full-p))) (ebox-native-reflow-ready-p @@ -4479,7 +4479,7 @@ NATIVE-FULL-P selects the native key that produced the published frame." (ebox-native-reflow-preparation-source-root preparation)))) (let ((confirmed-revision (or (plist-get state :runtime-revision) 0))) (when (and complete-p spec) - (when-let ((native-key + (when-let* ((native-key (ebox-native-reflow--preparation-key preparation (plist-get spec :key) native-full-p))) (ebox-native-reflow-confirm-native-frame @@ -4495,7 +4495,7 @@ NATIVE-FULL-P selects the native key that produced the published frame." (defun ebox-native-reflow-preparation-stats (preparation) "Return PREPARATION's native bounded-runtime statistics." (or (ebox-native-reflow-preparation-final-stats preparation) - (when-let ((session + (when-let* ((session (ebox-native-reflow-preparation-native-session preparation))) (unless (ebox-native-reflow-session-released-p session) @@ -4508,12 +4508,12 @@ NATIVE-FULL-P selects the native key that produced the published frame." (setf (ebox-native-reflow-preparation-stopped-p preparation) t) (ebox-native-reflow--stop-preparation-ready-watch preparation) (ebox-native-reflow--clear-preparation-readiness preparation) - (when-let ((cache + (when-let* ((cache (ebox-native-reflow-preparation-frame-cache preparation))) (clrhash cache)) (setf (ebox-native-reflow-preparation-materialization-queue preparation) nil) - (when-let ((session + (when-let* ((session (ebox-native-reflow-preparation-native-session preparation))) (unless (ebox-native-reflow-session-released-p session) (ignore-errors @@ -4525,7 +4525,7 @@ NATIVE-FULL-P selects the native key that produced the published frame." preparation) (unwind-protect (ebox-native-reflow-release-session session) - (when-let ((stats + (when-let* ((stats (ebox-native-reflow-preparation-final-stats preparation))) (plist-put stats :alive nil))))))) diff --git a/ebox-render-context.el b/ebox-render-context.el index 63c4f16..a58c21c 100644 --- a/ebox-render-context.el +++ b/ebox-render-context.el @@ -49,7 +49,7 @@ (defun ebox--register-render-owned-text-value (property value) "Register Ebox-created VALUE for PROPERTY in the active render candidate." (when value - (when-let ((values (ebox--render-owned-text-values-for property t))) + (when-let* ((values (ebox--render-owned-text-values-for property t))) (puthash value t values))) value) @@ -58,7 +58,7 @@ REGISTRY defaults to the active render candidate." (let ((ebox--render-owned-text-values (or registry ebox--render-owned-text-values))) - (when-let ((values (ebox--render-owned-text-values-for property))) + (when-let* ((values (ebox--render-owned-text-values-for property))) (gethash value values)))) (defun ebox--capture-paint-origins! (string start end) @@ -155,7 +155,7 @@ including strings returned from a render-cache hit." "Replay owned property identities recorded for RENDERED into this candidate." (when (and (stringp rendered) (hash-table-p ebox--render-owned-text-values)) - (when-let ((provenance + (when-let* ((provenance (gethash rendered ebox--render-output-provenance-table))) (maphash (lambda (property values) diff --git a/ebox-selector.el b/ebox-selector.el index b1403c2..82d434d 100644 --- a/ebox-selector.el +++ b/ebox-selector.el @@ -106,10 +106,10 @@ (pcase (and (listp node) (plist-get node :ebox-type)) ('box (ebox--ensure-region-id node)) ('flex - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (ebox--ensure-region-id box))) ('grid - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (ebox--ensure-region-id box))) ('flex-item (ebox-selector--node-region-id (plist-get node :node))) @@ -254,7 +254,7 @@ (defun ebox-selector--query-buffer-index (buffer selector ast) "Return `(SUPPORTED . HANDLES)' for an indexed AST query in BUFFER." (when (ebox-selector--descendant-indexable-p ast) - (when-let ((indexed (ebox-selector--indexed-candidates buffer ast))) + (when-let* ((indexed (ebox-selector--indexed-candidates buffer ast))) (cons t (ebox-selector--entries-to-buffer-handles diff --git a/ebox-style.el b/ebox-style.el index ff04e0d..c0e3545 100644 --- a/ebox-style.el +++ b/ebox-style.el @@ -274,12 +274,12 @@ every `ebox-create' needlessly copies the entire property metadata domain.") (defun ebox-style-canonical-name (name) "Return canonical CSS-like longhand property name for NAME." - (when-let ((property (ebox-style-property name))) + (when-let* ((property (ebox-style-property name))) (plist-get property :name))) (defun ebox-style-schema-id (name) "Return namespaced ECSS schema id for Ebox property NAME." - (when-let ((property (ebox-style-property name))) + (when-let* ((property (ebox-style-property name))) (plist-get property :id))) (defun ebox-style--put (plist key value) @@ -610,7 +610,7 @@ every `ebox-create' needlessly copies the entire property metadata domain.") :validator (ebox-style--validator (plist-get property :validator)) :equality #'equal))) - (when-let ((shorthand (ebox-style--shorthand + (when-let* ((shorthand (ebox-style--shorthand (plist-get property :shorthand)))) (setq options (plist-put options :shorthand shorthand))) options)) @@ -980,7 +980,7 @@ child colors are handled by `ebox-style--theme-parent-delta-computed'." (defun ebox-style--add-border-aggregates (style) "Add uniform border shorthand facts to public computed STYLE." (dolist (component '(width style color) style) - (when-let ((value (ebox-style--common-border-value style component))) + (when-let* ((value (ebox-style--common-border-value style component))) (setq style (plist-put style (intern (format ":border-%s" component)) value))))) @@ -1130,7 +1130,7 @@ SNAPSHOT reuses a previously detached ECSS values snapshot when supplied." (defun ebox-style--apply-container-wrapper (node style &optional snapshot) "Apply computed STYLE to NODE's internal visual wrapper." - (when-let ((wrapper (ebox-style--container-wrapper node style snapshot))) + (when-let* ((wrapper (ebox-style--container-wrapper node style snapshot))) (ebox-style--apply-engine-values wrapper (ebox-style--box-values style snapshot)) @@ -1220,7 +1220,7 @@ SNAPSHOT reuses a previously detached ECSS values snapshot when supplied." (when-let* ((source (plist-get item :node))) (let* ((source-style (plist-get source :ebox-computed-style)) (child-style - (when-let ((child (plist-get source :ebox-content-node))) + (when-let* ((child (plist-get source :ebox-content-node))) (plist-get child :ebox-computed-style))) (values (append @@ -1234,7 +1234,7 @@ SNAPSHOT reuses a previously detached ECSS values snapshot when supplied." (defun ebox-style-dirty-kind (name) "Return dirty kind for canonical property or alias NAME." - (when-let ((property (ebox-style-property name))) + (when-let* ((property (ebox-style-property name))) (plist-get property :dirty-kind))) (defun ebox-style-signature (computed-style groups) diff --git a/ebox-surface.el b/ebox-surface.el index 2ac3394..93639ae 100644 --- a/ebox-surface.el +++ b/ebox-surface.el @@ -183,7 +183,7 @@ owned; no per-fragment substring is allocated." (defun ebox-surface--style-state-table (previous-state) "Copy retained style state from PREVIOUS-STATE into a weak table." (let ((table (make-hash-table :test 'eq :weakness 'key))) - (when-let ((previous (plist-get previous-state :style-binding-states))) + (when-let* ((previous (plist-get previous-state :style-binding-states))) (maphash (lambda (object state) (puthash object state table)) previous)) table)) @@ -294,7 +294,7 @@ construction time and can use the static projection path." (ebox-surface--signals-scroll signals))) (when (tp-signal-live-p signal) (tp-signal-dispose signal))) - (when-let ((buffer (ebox-surface--signals-buffer signals))) + (when-let* ((buffer (ebox-surface--signals-buffer signals))) (when (buffer-live-p buffer) (with-current-buffer buffer (when (eq ebox-surface--context-signals signals) @@ -311,6 +311,18 @@ construction time and can use the static projection path." table)) (sort offsets (lambda (left right) (< (car left) (car right)))))) +(defun ebox-surface--buffer-display-window (buffer) + "Return the canonical live display window for BUFFER. +Prefer the window the user is interacting with, then the selected frame, then +another visible frame. One mounted surface owns one viewport, so all context +and resize paths must consume this same choice." + (or (and (window-live-p (selected-window)) + (eq (window-buffer (selected-window)) buffer) + (selected-window)) + (get-buffer-window buffer (selected-frame)) + (get-buffer-window buffer t) + (and (not noninteractive) (selected-window)))) + (defun ebox-surface--context-values (buffer old-state state-overrides) "Return BUFFER context values after OLD-STATE and STATE-OVERRIDES." @@ -324,17 +336,7 @@ construction time and can use the static projection path." (let ((scroll-table (value :scroll-state-table (plist-get old-state :scroll-state-table))) - ;; Prefer the window the user is actually interacting with. A - ;; buffer may also be visible in an older client frame; choosing - ;; that arbitrary window would silently resize a live surface on a - ;; later incremental commit. - (window - (or (and (window-live-p (selected-window)) - (eq (window-buffer (selected-window)) buffer) - (selected-window)) - (get-buffer-window buffer (selected-frame)) - (get-buffer-window buffer t) - (and (not noninteractive) (selected-window))))) + (window (ebox-surface--buffer-display-window buffer))) (list :viewport-width (value :viewport-width (or ebox-viewport-width @@ -448,18 +450,18 @@ The returned ranges are numeric snapshots; TP retains marker ownership." (defun ebox-surface-region-bounds (buffer region-id &optional roles) "Return numeric bounds for REGION-ID's TP mounts in BUFFER. ROLES has the same filtering meaning as in `ebox-surface-region-mounts'." - (when-let ((mounts (ebox-surface-region-mounts buffer region-id roles))) + (when-let* ((mounts (ebox-surface-region-mounts buffer region-id roles))) (cons (apply #'min (mapcar (lambda (mount) (plist-get mount :start)) mounts)) (apply #'max (mapcar (lambda (mount) (plist-get mount :end)) mounts))))) (defun ebox-surface--runtime-keys (state key) "Return hash keys stored under KEY in runtime STATE." - (when-let ((table (plist-get state key))) + (when-let* ((table (plist-get state key))) (ebox-surface--hash-keys table))) (defun ebox-surface--bind-scroll-states-to-buffer (state buffer) "Bind every semantic scroll state in STATE to its owning BUFFER." - (when-let ((table (plist-get state :scroll-state-table))) + (when-let* ((table (plist-get state :scroll-state-table))) (maphash (lambda (region-id scroll-state) (puthash region-id (plist-put scroll-state :buffer buffer) table)) @@ -546,7 +548,7 @@ ROLES has the same filtering meaning as in `ebox-surface-region-mounts'." (error "Ebox framework participant is not unpublished")) (setf (ebox-surface--framework-participant-state participant) 'published) (setq report (ebox-surface--participant-report participant report 'published)) - (when-let ((publish (ebox-surface--framework-participant-publish participant))) + (when-let* ((publish (ebox-surface--framework-participant-publish participant))) (funcall publish report)) report) @@ -559,7 +561,7 @@ ROLES has the same filtering meaning as in `ebox-surface-region-mounts'." (ebox-surface--participant-report participant (ebox-surface--framework-participant-report participant) 'rolled-back) - (when-let ((rollback + (when-let* ((rollback (ebox-surface--framework-participant-rollback participant))) (let ((inhibit-quit t) (quit-flag nil)) @@ -633,11 +635,11 @@ FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil." ;; not the now-committed TP mounts. Drop only those owners' derived ;; geometry so the next transaction lazily captures the committed ;; spans and cannot drift across a repeated selection round trip. - (when-let ((snapshots (plist-get new-state :layout-snapshots))) + (when-let* ((snapshots (plist-get new-state :layout-snapshots))) (dolist (proof (plist-get new-state :owner-scoped-proofs)) (when (plist-get proof :role-owned-lines-p) (let ((owner-id (plist-get proof :owner-id))) - (when-let ((snapshot (gethash owner-id snapshots))) + (when-let* ((snapshot (gethash owner-id snapshots))) (puthash owner-id (ebox--layout-snapshot-strip-details snapshot) snapshots)))))) @@ -1391,7 +1393,7 @@ published generation so a failed transaction has no cache state to restore." (defun ebox-surface--reconcile-candidate (root previous-state) "Reconcile styled ROOT with PREVIOUS-STATE runtime identities." - (when-let ((previous-root (plist-get previous-state :root-node))) + (when-let* ((previous-root (plist-get previous-state :root-node))) (ebox-tree-reconcile-runtime previous-root root)) root) @@ -1401,7 +1403,7 @@ published generation so a failed transaction has no cache state to restore." (cl-labels ((visit (node) (when (and (listp node) (not (stringp node))) - (when-let ((region-id (plist-get node :region-id))) + (when-let* ((region-id (plist-get node :region-id))) (puthash region-id t ids)) (dolist (child (ebox-tree--children-raw node)) (visit child))))) @@ -1416,7 +1418,7 @@ published generation so a failed transaction has no cache state to restore." (defun ebox-surface--node-key (node) "Return NODE's namespaced sibling key, or nil for positional identity." - (when-let ((key (plist-get node :key))) + (when-let* ((key (plist-get node :key))) (list 'ebox/key key))) (defun ebox-surface--node-kind (node) @@ -1593,13 +1595,13 @@ published generation so a failed transaction has no cache state to restore." stylesheet-signature selector-tree-token stylesheet-subject-local-p) "Compute and apply NODE style using retained OBJECT and SUBJECT-TABLE." - (when-let ((subject (gethash node subject-table))) + (when-let* ((subject (gethash node subject-table))) (if (and (hash-table-p ebox-surface--inline-style-value-cache) (not (ebox-surface--node-style-binding-required-p node))) (when-let* ((parent (ecss-subject-parent subject)) (binding (gethash parent bindings-by-subject))) (puthash subject binding bindings-by-subject) - (when-let ((state (gethash parent states-by-subject))) + (when-let* ((state (gethash parent states-by-subject))) (puthash subject state states-by-subject))) (ebox-style-apply-computed node @@ -1787,7 +1789,7 @@ dependencies, or any malformed index conservatively preserves root planning." (defun ebox-surface--retained-scroll-lookahead (state) "Return lookahead needed to retain STATE's prepared lazy prefixes." - (when-let ((table (plist-get state :scroll-state-table))) + (when-let* ((table (plist-get state :scroll-state-table))) (let ((maximum 0)) (maphash (lambda (_region-id scroll-state) @@ -1838,7 +1840,7 @@ valid because their declarative layout and viewport did not change." "Restore reusable lazy-scroll SNAPSHOT fields into TABLE." (maphash (lambda (region-id metadata) - (when-let ((state (gethash region-id table))) + (when-let* ((state (gethash region-id table))) (while metadata (setq state (plist-put state (pop metadata) (pop metadata)))) @@ -1926,7 +1928,7 @@ valid because their declarative layout and viewport did not change." (when (and (hash-table-p nodes) (hash-table-p objects)) (maphash (lambda (node-id object) - (when-let ((node (gethash node-id nodes))) + (when-let* ((node (gethash node-id nodes))) (plist-put node :surface-object object))) objects)) state)) @@ -2251,7 +2253,7 @@ old allocated width while the owner changes its natural content length." (if (or allocation-closure-p retain-external-owner-suffix-p) (and owned-rendered - (when-let ((owners + (when-let* ((owners (ebox-surface--retained-external-owner-suffix buffer spans region-ids))) (ebox--add-content-owners owned-rendered owners))) @@ -2366,7 +2368,7 @@ old allocated width while the owner changes its natural content length." (sort pairs (lambda (left right) (< (car (car left)) (car (car right)))))) - (when-let ((output + (when-let* ((output (ebox-surface--replace-buffer-spans source origin (mapcar #'car pairs) (mapcar #'cdr pairs)))) @@ -2607,7 +2609,7 @@ causes the caller to use the ordinary full projection." (make-hash-table :test #'equal))) (when (and output old-fragments paint-owner-ids) (dolist (fragment old-fragments) - (when-let ((address (plist-get fragment :paint-address))) + (when-let* ((address (plist-get fragment :paint-address))) (puthash address fragment old-by-address) (let* ((roles (plist-get fragment :paint-role-ids)) (owner (cdr (assq 'content roles))) @@ -2789,13 +2791,13 @@ box with wrapper chrome falls back to the retained wrapper renderer." (defun ebox-surface--role-ids-from-properties (properties) "Return namespaced Ebox role/id pairs from PROPERTIES." (let (roles) - (when-let ((region-id + (when-let* ((region-id (plist-get properties 'ebox-overflow-foreground-source))) (push (cons 'overflow-foreground region-id) roles)) (dolist (region-id (plist-get properties 'ebox-content-owners)) (cl-pushnew (cons 'content-owner region-id) roles :test #'equal)) (dolist (entry ebox-region-types) - (when-let ((region-id (plist-get properties (cdr entry)))) + (when-let* ((region-id (plist-get properties (cdr entry)))) (cl-pushnew (cons (car entry) region-id) roles :test #'equal))) (nreverse roles))) @@ -2934,11 +2936,11 @@ when it needs to mutate them." (setq position (max next (1+ position))))) (setq fragments (nreverse fragments)) (dolist (fragment fragments) - (if-let ((roles (plist-get fragment :role-ids))) + (if-let* ((roles (plist-get fragment :role-ids))) (setq previous-role-ids roles) (plist-put fragment :previous-role-ids previous-role-ids))) (dolist (fragment (reverse (copy-sequence fragments))) - (if-let ((roles (plist-get fragment :role-ids))) + (if-let* ((roles (plist-get fragment :role-ids))) (setq next-role-ids roles) (plist-put fragment :role-ids (delete-dups @@ -3046,7 +3048,7 @@ and shifted without inspecting its text properties." (plist-put copy :paint-address (copy-tree (plist-get old :paint-address))) - (when-let ((chain (plist-get old :paint-node-chain))) + (when-let* ((chain (plist-get old :paint-node-chain))) (plist-put copy :paint-node-chain (copy-sequence chain))) (plist-put copy :text output) @@ -3251,7 +3253,7 @@ Adjacent ranges merge only when both their owner and opaque tags match." (defun ebox-surface--materialized-fragment-ledger (state) "Return STATE's paint ledger, expanding a native frame only on demand." (let ((ledger (plist-get state :surface-fragments))) - (if-let ((frame (and (listp ledger) + (if-let* ((frame (and (listp ledger) (plist-get ledger :native-frame)))) (ebox-native-reflow-frame-fragments frame) ledger))) @@ -3472,7 +3474,7 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges." (let ((region-nodes (plist-get state :region-node-table)) (parents (plist-get state :parent-table)) deepest deepest-depth) (dolist (entry role-ids) - (when-let ((node-id (gethash (cdr entry) region-nodes))) + (when-let* ((node-id (gethash (cdr entry) region-nodes))) (let ((depth (ebox-surface--node-depth state node-id))) (when (or (null deepest-depth) (> depth deepest-depth)) (setq deepest node-id deepest-depth depth))))) @@ -3494,11 +3496,11 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges." (defun ebox-surface--box-face-contributions (box) "Return BOX typography and color contributions in render order." (let (faces) - (when-let ((font (ebox-buffer--font-face box))) + (when-let* ((font (ebox-buffer--font-face box))) (push font faces)) - (when-let ((color (plist-get box :color))) + (when-let* ((color (plist-get box :color))) (push (ebox-surface--foreground-face color) faces)) - (when-let ((background (plist-get box :bgcolor))) + (when-let* ((background (plist-get box :bgcolor))) (push (list :background background) faces)) (nreverse faces))) @@ -3508,7 +3510,7 @@ ANCESTOR-P means BOX wraps a more specific rendered surface." (let (faces) (cond ((memq 'overflow-foreground roles) - (when-let ((color (plist-get box :color))) + (when-let* ((color (plist-get box :color))) (push (ebox-surface--foreground-face color) faces))) ((memq 'bl roles) (push (ebox-buffer-side-border-face @@ -3531,7 +3533,7 @@ ANCESTOR-P means BOX wraps a more specific rendered surface." (list (list :underline (append '(:position t) - (when-let ((color + (when-let* ((color (plist-get box :border-bottom-color))) (list :color color)))))))) faces)) @@ -3661,7 +3663,7 @@ relative face contributions and performs the final merge during prepare." (if baseline (put-text-property 0 length 'face baseline text) (remove-text-properties 0 length '(face nil) text)) - (when-let ((face (ebox-surface--face-value faces))) + (when-let* ((face (ebox-surface--face-value faces))) (let ((props (list 'face (copy-tree face)))) (if (and contributions (= (plist-get (car contributions) :end) offset) @@ -3717,7 +3719,7 @@ relative face contributions and performs the final merge during prepare." (let ((roles (cl-remove pair (plist-get fragment key) :test #'equal))) (plist-put fragment key (if anchor-p (append roles (list pair)) roles)))) (when (> (length (plist-get fragment :text)) 0) - (if-let ((owner + (if-let* ((owner (cdr (cl-find role (plist-get fragment :paint-role-ids) :key #'car :test #'eq :from-end t)))) @@ -3854,7 +3856,7 @@ but cannot introduce or remove a viewport expression or node identity." (and (eq projection-kind 'mixed-owner-reflow) (plist-get previous-state :viewport-dependent-node-ids-ready) (plist-member previous-state :viewport-dependent-node-id-axes) - (when-let ((proof (plist-get state-overrides :mixed-owner-proof))) + (when-let* ((proof (plist-get state-overrides :mixed-owner-proof))) (cl-every (lambda (entry) (cl-every @@ -4079,7 +4081,7 @@ published runtime and must be consumed without clearing those shared nodes." previous-state state) (ebox-surface--render-candidate state))) ((memq projection-kind '(span-patch owner-scoped)) - (if-let ((span-output + (if-let* ((span-output (ebox-surface--span-patch-output (ebox-surface--signals-buffer signals) state))) span-output diff --git a/ebox-tree.el b/ebox-tree.el index 4cd4b27..45a3e6e 100644 --- a/ebox-tree.el +++ b/ebox-tree.el @@ -122,9 +122,9 @@ This is an optimization for snapshot capture, not buffer runtime state.") (when (listp node) (let ((attributes (delq nil - (list (when-let ((id (ebox-tree-node-id node))) + (list (when-let* ((id (ebox-tree-node-id node))) (cons :id id)) - (when-let ((key (ebox-tree-node-key node))) + (when-let* ((key (ebox-tree-node-key node))) (cons :key key)))))) (dolist (attribute (plist-get node :selector-attributes)) (unless (consp attribute) @@ -145,11 +145,11 @@ This is an optimization for snapshot capture, not buffer runtime state.") ('stack (ebox-tree-layout-children node)) ('flex - (append (when-let ((box (plist-get node :box))) + (append (when-let* ((box (plist-get node :box))) (list box)) (ebox-tree-layout-children node))) ('grid - (append (when-let ((box (plist-get node :box))) + (append (when-let* ((box (plist-get node :box))) (list box)) (ebox-tree-layout-children node))) ('flex-item @@ -182,7 +182,7 @@ New row/column containers store flat `:children'. Legacy `ebox-concat' and "Return CHILD's identity replacement from REPLACEMENTS, when present. REPLACEMENTS is an alist whose keys are compared with `eq'. Nil is not a child and is therefore never used as a replacement key." - (if-let ((replacement (and child (assq child replacements)))) + (if-let* ((replacement (and child (assq child replacements)))) (cdr replacement) child)) @@ -253,7 +253,7 @@ still copied while every nested value remains shared." (ebox-tree--replace-direct-child-list children replacements))) (unless (eq replaced children) (setq copy (plist-put copy :children replaced))))) - (when-let ((sequence (and (memq type '(concat stack flex grid)) + (when-let* ((sequence (and (memq type '(concat stack flex grid)) (plist-get copy :ebox-child-sequence)))) (let ((updated sequence) changed fallback) (dolist (replacement replacements) @@ -349,7 +349,7 @@ original object identity." (setq copy (without copy :children)) (pcase type ((or 'flex 'grid) - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (setq copy (plist-put copy :box (copy-node box))))) ('concat (setq copy (without (without copy :left) :right))) @@ -393,7 +393,7 @@ Record its identities in NODE-ID-SET and REGION-ID-SET." node node-id-set region-id-set))) (pcase (plist-get node :ebox-type) ('box - (when-let ((child (plist-get node :ebox-content-node))) + (when-let* ((child (plist-get node :ebox-content-node))) (plist-put shell :ebox-content-node (ebox-tree--runtime-identity-skeleton child node-id-set region-id-set)))) @@ -405,7 +405,7 @@ Record its identities in NODE-ID-SET and REGION-ID-SET." child node-id-set region-id-set)) (ebox-tree-layout-children node)))) ((or 'flex 'grid) - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (plist-put shell :box (ebox-tree--runtime-identity-skeleton box node-id-set region-id-set))) @@ -416,7 +416,7 @@ Record its identities in NODE-ID-SET and REGION-ID-SET." child node-id-set region-id-set)) (ebox-tree-layout-children node)))) ('flex-item - (when-let ((child (plist-get node :node))) + (when-let* ((child (plist-get node :node))) (plist-put shell :node (ebox-tree--runtime-identity-skeleton child node-id-set region-id-set))))) @@ -459,7 +459,7 @@ Host references are root-global opaque metadata and are compared with `equal'." ;; focused preflight is also used by initial buffer mounting, ;; where it must remain finite for malformed graphs. (unless (gethash node active) - (when-let ((host-ref (plist-get node :host-ref))) + (when-let* ((host-ref (plist-get node :host-ref))) (let ((count (hash-table-count host-refs))) (puthash host-ref t host-refs) (when (= count (hash-table-count host-refs)) @@ -530,7 +530,7 @@ and all explicit identities are compared with `equal'. Return ROOT on success." (error "Ebox child Range descriptor is invalid here")) (push entry children)))) (dolist (child (nreverse children)) - (when-let ((key (and (listp child) + (when-let* ((key (and (listp child) (not (stringp child)) (plist-get child :key)))) (when (gethash key keys) @@ -647,7 +647,7 @@ look like a geometry mutation." (memq (plist-get node :ebox-type) '(grid flex)))) (push key signature) (push value signature)))) - (when-let ((layout (ebox-tree--layout-props-source-signature node))) + (when-let* ((layout (ebox-tree--layout-props-source-signature node))) (push :ebox-layout-props signature) (push layout signature)) (nreverse signature))) @@ -751,11 +751,11 @@ candidate runtime index agree." (children) (let ((table (make-hash-table :test 'equal))) (dolist (child children table) - (when-let ((key (node-key child))) + (when-let* ((key (node-key child))) (puthash key child table))))) (match-child (old-children old-keyed new-child index) - (if-let ((key (node-key new-child))) + (if-let* ((key (node-key new-child))) (let ((old-child (gethash key old-keyed))) (and (same-type-p old-child new-child) old-child)) (let ((old-child (nth index old-children))) @@ -809,7 +809,7 @@ candidate runtime index agree." "Return NODE's logical children without internal layout adapters." (pcase (and (listp node) (plist-get node :ebox-type)) ('box - (when-let ((content-node (plist-get node :ebox-content-node))) + (when-let* ((content-node (plist-get node :ebox-content-node))) (ebox-tree--semantic-layout-leaves content-node))) ((or 'concat 'stack) (ebox-tree--semantic-layout-leaves node)) @@ -831,11 +831,11 @@ candidate runtime index agree." (when (and (listp node) (not (stringp node))) (let* ((current-path (append path (list node))) (entry (cons node current-path))) - (when-let ((id (ebox-tree-node-id node))) + (when-let* ((id (ebox-tree-node-id node))) (prepend id-table id entry)) (dolist (class (ebox-tree-node-classes node)) (prepend class-table class entry)) - (when-let ((type (ebox-tree-node-selector-type node))) + (when-let* ((type (ebox-tree-node-selector-type node))) (prepend type-table type entry)) (dolist (child (ebox-tree-semantic-children node)) (visit child current-path)))))) @@ -937,14 +937,14 @@ not only the public update ids." (ebox-tree-layout-children node)))) ('flex (append - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (list (ebox--ensure-region-id box))) (apply #'append (mapcar #'ebox-tree-node-all-region-ids (ebox-tree-layout-children node))))) ('grid (append - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (list (ebox--ensure-region-id box))) (apply #'append (mapcar #'ebox-tree-node-all-region-ids @@ -981,14 +981,14 @@ cannot be inspected and reports no conflict." (ebox-tree-layout-children node))) ('flex (or (and inherited - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (and (plist-get box paint-key) t))) (cl-some (lambda (child) (ebox-tree-node-paint-conflict-p child paint-key t)) (ebox-tree-layout-children node)))) ('grid (or (and inherited - (when-let ((box (plist-get node :box))) + (when-let* ((box (plist-get node :box))) (and (plist-get box paint-key) t))) (cl-some (lambda (child) (ebox-tree-node-paint-conflict-p child paint-key t)) @@ -1010,20 +1010,20 @@ wrapper's visible content is produced by the flex renderer." ('box (or (when (equal (ebox-get node :region-id) region-id) (list node)) - (when-let ((path (ebox-tree-node-path-to-region + (when-let* ((path (ebox-tree-node-path-to-region (plist-get node :ebox-content-node) region-id))) (append path (list node))))) ('concat (catch 'found (dolist (child (ebox-tree-layout-children node)) - (when-let ((path (ebox-tree-node-path-to-region child region-id))) + (when-let* ((path (ebox-tree-node-path-to-region child region-id))) (throw 'found (append path (list node))))) nil)) ('stack (catch 'found (dolist (child (ebox-tree-layout-children node)) - (when-let ((path (ebox-tree-node-path-to-region child region-id))) + (when-let* ((path (ebox-tree-node-path-to-region child region-id))) (throw 'found (append path (list node))))) nil)) ('flex @@ -1034,7 +1034,7 @@ wrapper's visible content is produced by the flex renderer." (t (catch 'found (dolist (child (ebox-tree-layout-children node)) - (when-let ((path (ebox-tree-node-path-to-region child region-id))) + (when-let* ((path (ebox-tree-node-path-to-region child region-id))) (throw 'found (append path (list node))))) nil)))) ('grid @@ -1045,7 +1045,7 @@ wrapper's visible content is produced by the flex renderer." (t (catch 'found (dolist (child (ebox-tree-layout-children node)) - (when-let ((path (ebox-tree-node-path-to-region child region-id))) + (when-let* ((path (ebox-tree-node-path-to-region child region-id))) (throw 'found (append path (list node))))) nil)))) ('flex-item diff --git a/ebox-viewport.el b/ebox-viewport.el index 1cfb991..2d04eaf 100644 --- a/ebox-viewport.el +++ b/ebox-viewport.el @@ -1,99 +1,62 @@ -;;; ebox-viewport.el --- Coalesced Emacs viewport delivery -*- lexical-binding: t; -*- +;;; ebox-viewport.el --- Immediate Emacs viewport delivery -*- lexical-binding: t; -*- ;;; Commentary: ;; Emacs owns window events; Ebox owns the mounted viewport. This module is ;; the single bridge between them. Size hooks only sample the latest visible -;; dimensions. One deferred callback per buffer publishes the newest sample, -;; so continuous frame dragging cannot enqueue synchronous layout transactions. +;; dimensions and synchronously publish one exact incremental viewport update. +;; Emacs serializes the hook; Ebox's retained renderer bounds each transaction. ;;; Code: -(require 'cl-lib) (require 'ebox-surface) (declare-function ebox--buffer-render-state "ebox-incremental" (buffer)) (declare-function ebox-rerender-buffer-with-context "ebox" (buffer viewport-width &optional viewport-height)) -(defcustom ebox-viewport-resize-delay 0.05 - "Seconds after the latest size event before publishing its viewport. -Continuous size events replace one pending sample for each mounted buffer." - :type 'number - :group 'ebox) - -(defvar ebox--viewport-resize-pending-table (make-hash-table :test #'eq) - "Buffer-keyed latest viewport samples awaiting publication.") - -(defvar ebox--viewport-resize-generation 0 - "Monotonic identity for pending viewport samples.") +(defvar ebox--window-size-change-in-progress nil + "Non-nil while Ebox is synchronizing visible window viewports. +External GUI events cannot interleave in Emacs's single thread. A nested call +can only originate from the current publication and therefore has no newer +window geometry to publish.") (defun ebox-viewport-window-width (window) "Return Ebox's display-safe viewport width for live WINDOW." (and (window-live-p window) (ebox-surface--window-content-width window))) -(defun ebox--cancel-buffer-viewport-resize (buffer) - "Cancel BUFFER's pending viewport publication." - (when-let* ((pending (gethash buffer ebox--viewport-resize-pending-table))) - (let ((timer (aref pending 4))) - (when (timerp timer) (cancel-timer timer))) - (remhash buffer ebox--viewport-resize-pending-table)) - nil) - -(defun ebox--viewport-resize-apply (buffer generation) - "Publish BUFFER's pending viewport identified by GENERATION." - (when-let* ((pending (gethash buffer ebox--viewport-resize-pending-table))) - (when (= generation (aref pending 0)) - (remhash buffer ebox--viewport-resize-pending-table) - (let ((window (aref pending 1)) - (width (aref pending 2)) - (height (aref pending 3))) - (when (and (buffer-live-p buffer) - (window-live-p window) - (eq (window-buffer window) buffer) - (ebox-surface-buffer-mounted-p buffer)) - (let ((state (ebox--buffer-render-state buffer))) - (unless (and (= width (or (plist-get state :viewport-width) -1)) - (= height (or (plist-get state :viewport-height) -1))) - (ebox-rerender-buffer-with-context buffer width height)))))))) - -(defun ebox--schedule-buffer-viewport-resize - (buffer window width height) - "Replace BUFFER's pending viewport with WINDOW, WIDTH, and HEIGHT." - (ebox--cancel-buffer-viewport-resize buffer) - (let* ((generation (cl-incf ebox--viewport-resize-generation)) - (pending (vector generation window width height nil))) - (puthash buffer pending ebox--viewport-resize-pending-table) - (aset pending 4 - (run-at-time - (max 0 ebox-viewport-resize-delay) nil - #'ebox--viewport-resize-apply buffer generation))) - buffer) - (defun ebox--window-size-change (frame) - "Sample latest viewports for mounted Ebox buffers visible in FRAME." - (when (and (frame-live-p frame) (not noninteractive)) - (let ((seen (make-hash-table :test #'eq))) + "Synchronize mounted Ebox buffers visible in FRAME immediately." + (when (and (frame-live-p frame) + (not noninteractive) + (not ebox--window-size-change-in-progress)) + (let ((ebox--window-size-change-in-progress t) + (seen (make-hash-table :test #'eq))) (dolist (window (window-list frame 'no-minibuf)) (when (window-live-p window) (let ((buffer (window-buffer window))) (unless (gethash buffer seen) (puthash buffer t seen) - (when (and (buffer-live-p buffer) - (ebox-surface-buffer-mounted-p buffer)) - (let* ((state (ebox--buffer-render-state buffer)) - (width (ebox-viewport-window-width window)) - (height (window-body-height window))) - (when (and width - state - (not (and - (= width - (or (plist-get state :viewport-width) -1)) - (= height - (or (plist-get state :viewport-height) - -1))))) - (ebox--schedule-buffer-viewport-resize - buffer window width height))))))))))) + (let ((display-window + (and (buffer-live-p buffer) + (ebox-surface--buffer-display-window buffer)))) + (when (and (window-live-p display-window) + (eq (window-frame display-window) frame) + (ebox-surface-buffer-mounted-p buffer)) + (let* ((state (ebox--buffer-render-state buffer)) + (width (ebox-viewport-window-width display-window)) + (height (window-body-height display-window))) + (when (and width + state + (not (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)))))))))))) (when (boundp 'window-size-change-functions) (add-hook 'window-size-change-functions #'ebox--window-size-change)) diff --git a/ebox.el b/ebox.el index 0677ca0..c84af7e 100644 --- a/ebox.el +++ b/ebox.el @@ -440,7 +440,7 @@ PLIST is a property list that overrides the defaults." "Set PROPERTY to VALUE in BOX and return the modified box. Registered style properties also update BOX's canonical ECSS declarations so a later cascade computes from the public mutation instead of stale source data." - (when-let ((declaration + (when-let* ((declaration (ebox-style-compile-declarations (list property value)))) (plist-put box :ebox-style-declarations @@ -648,7 +648,7 @@ ALIGN can be `top', `center', or `bottom'." (len (length string))) (catch 'found (while (< pos len) - (when-let ((id (get-text-property pos 'ebox-content string))) + (when-let* ((id (get-text-property pos 'ebox-content string))) (throw 'found id)) (setq pos (or (next-single-property-change pos 'ebox-content string) @@ -660,7 +660,7 @@ ALIGN can be `top', `center', or `bottom'." (len (length string)) ids) (while (< pos len) - (when-let ((id (get-text-property pos 'ebox-content string))) + (when-let* ((id (get-text-property pos 'ebox-content string))) (unless (memq id ids) (setq ids (append ids (list id))))) (setq pos (1+ pos))) @@ -702,13 +702,13 @@ Use this to capture ids *before* inserting into a buffer: (mapcar #'ebox-region-ids (ebox--layout-children node)))) ((eq type 'flex) - (if-let ((box (plist-get node :box))) + (if-let* ((box (plist-get node :box))) (list (ebox--ensure-region-id box)) (apply #'append (mapcar #'ebox-region-ids (ebox-tree-layout-children node))))) ((eq type 'grid) - (if-let ((box (plist-get node :box))) + (if-let* ((box (plist-get node :box))) (list (ebox--ensure-region-id box)) (apply #'append (mapcar #'ebox-region-ids @@ -760,7 +760,7 @@ Use this to capture ids *before* inserting into a buffer: "Return a KEY -> child hash table for explicitly keyed CHILDREN." (let ((table (make-hash-table :test 'equal))) (dolist (child children) - (when-let ((key (ebox--runtime-node-key child))) + (when-let* ((key (ebox--runtime-node-key child))) (puthash key child table))) table)) @@ -773,7 +773,7 @@ Use this to capture ids *before* inserting into a buffer: (defun ebox--runtime-keyed-match (old-keyed new-child) "Return the keyed old child that should match NEW-CHILD." - (when-let ((key (ebox--runtime-node-key new-child))) + (when-let* ((key (ebox--runtime-node-key new-child))) (let ((old-child (gethash key old-keyed))) (when (ebox--runtime-same-type-p old-child new-child) old-child)))) @@ -910,7 +910,7 @@ Properties are expanded recursively according to `ebox-property-rules'." (defun ebox--scroll-cancel-idle-prefetch (region-id) "Cancel any pending idle prefix prefetch for REGION-ID." - (when-let ((timer (gethash region-id ebox--scroll-idle-prefetch-timers))) + (when-let* ((timer (gethash region-id ebox--scroll-idle-prefetch-timers))) (when (timerp timer) (cancel-timer timer)) (remhash region-id ebox--scroll-idle-prefetch-timers))) @@ -948,7 +948,7 @@ Properties are expanded recursively according to `ebox-property-rules'." (defun ebox--idle-continuation-delay (delay) "Return an idle-timer threshold one fresh DELAY beyond current idle time." - (+ (or (when-let ((idle (current-idle-time))) + (+ (or (when-let* ((idle (current-idle-time))) (float-time idle)) 0) (max 0 (or delay 0)))) @@ -956,7 +956,7 @@ Properties are expanded recursively according to `ebox-property-rules'." (defun ebox--scroll-schedule-idle-prefetch (region-id &optional delay) "Schedule input-yielding lazy prefix prefetch for REGION-ID when useful." (ebox--scroll-cancel-idle-prefetch region-id) - (when-let ((state (and (or (not noninteractive) + (when-let* ((state (and (or (not noninteractive) ebox--scroll-allow-noninteractive-prefetch) (ebox--scroll-get-state region-id)))) (when (and (ebox--scroll-idle-prefetch-needed-p state) @@ -1040,13 +1040,13 @@ request; callers that represent GUI animation ticks pass their tick size." (defun ebox--smooth-scroll-active-p (region-id) "Return non-nil when REGION-ID has an active smooth scroll timer." - (when-let ((entry (gethash region-id ebox--smooth-scroll-state-table))) + (when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table))) (and (timerp (plist-get entry :timer)) (not (plist-get entry :waiting-prefetch))))) (defun ebox--smooth-scroll-resume-after-prefetch (region-id) "Resume REGION-ID smooth scrolling after a paused lazy prefetch." - (when-let ((entry (gethash region-id ebox--smooth-scroll-state-table))) + (when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table))) (when (plist-get entry :waiting-prefetch) (plist-put entry :waiting-prefetch nil) (unless (timerp (plist-get entry :timer)) @@ -1065,7 +1065,7 @@ request; callers that represent GUI animation ticks pass their tick size." region-id (ebox--idle-continuation-delay ebox-scroll-lazy-idle-prefetch-delay)) - (when-let ((state (ebox--scroll-get-state region-id))) + (when-let* ((state (ebox--scroll-get-state region-id))) (let ((buffer (ebox--scroll-state-buffer state)) (cache-miss-target (plist-get state :cache-miss-prefetch-target-lines))) @@ -1215,7 +1215,7 @@ owns the exact continuation cache for the captured viewport context." (maphash (lambda (region-id _) (cl-incf retained-cost 48) - (if-let ((state (ebox--scroll-get-state region-id))) + (if-let* ((state (ebox--scroll-get-state region-id))) (let ((template (ebox--scroll-cache-state-template state))) (cl-incf retained-cost @@ -1318,7 +1318,7 @@ remain transaction-local." ebox--collect-rebuilt-scroll-state-region-ids) (cl-pushnew region-id ebox--rebuilt-scroll-state-region-ids :test #'equal)) - (when-let ((content-lines (plist-get state :content-lines))) + (when-let* ((content-lines (plist-get state :content-lines))) (let ((ebox--defer-scroll-content-index (or ebox--defer-scroll-content-index (plist-get state :render-content-prefix) @@ -1355,7 +1355,7 @@ remain transaction-local." (= (length native-lines) content-height)) (list offset native-lines)) ((and (integerp content-height) (>= content-height 0)) - (when-let ((lines (plist-get state :rendered-content-lines))) + (when-let* ((lines (plist-get state :rendered-content-lines))) (let* ((max-offset (max 0 (- (length lines) content-height))) (offset (max 0 (min max-offset offset))) (end (min (+ offset content-height) (length lines)))) @@ -1628,7 +1628,7 @@ the currently displayed rendered slice actually changed." (defun ebox--scroll-state-materialize-lines (region-id state) "Return STATE after materializing lazy scroll content for REGION-ID." - (if-let ((materialize (plist-get state :materialize-content-lines))) + (if-let* ((materialize (plist-get state :materialize-content-lines))) (let* ((old-visible (ebox--scroll-state-rendered-visible-window state)) (old-refresh-required @@ -1810,9 +1810,9 @@ object. Unrelated ownerless and foreign-buffer states remain isolated." (plist-get (ebox--buffer-render-state buffer) :scroll-region-ids)) region-ids) (dolist (node-id node-ids) - (when-let ((node (ebox--buffer-runtime-node buffer node-id))) + (when-let* ((node (ebox--buffer-runtime-node buffer node-id))) (dolist (region-id buffer-region-ids) - (when-let ((state (ebox--scroll-get-state region-id))) + (when-let* ((state (ebox--scroll-get-state region-id))) (when (ebox--scroll-state-covers-node-p buffer state node) (cl-pushnew region-id region-ids :test #'equal)))))) (nreverse region-ids))) @@ -1830,7 +1830,7 @@ object. Unrelated ownerless and foreign-buffer states remain isolated." "Return ebox role/id pairs at POS in STRING." (let (role-ids) (dolist (entry ebox-region-types) - (when-let ((region-id (get-text-property pos (cdr entry) string))) + (when-let* ((region-id (get-text-property pos (cdr entry) string))) (push (cons (car entry) region-id) role-ids))) role-ids)) @@ -1840,7 +1840,7 @@ object. Unrelated ownerless and foreign-buffer states remain isolated." (dolist (region-id (get-text-property pos 'ebox-content-owners string)) (cl-pushnew region-id ids :test #'equal)) (dolist (entry ebox-region-types) - (when-let ((region-id (get-text-property pos (cdr entry) string))) + (when-let* ((region-id (get-text-property pos (cdr entry) string))) (cl-pushnew region-id ids :test #'equal))) ids)) @@ -1902,7 +1902,7 @@ object. Unrelated ownerless and foreign-buffer states remain isolated." (cl-loop for line in lines for idx from 0 do (when (ebox--scroll-line-region-present-p line region-ids) - (when-let ((span (ebox--scroll-line-region-span + (when-let* ((span (ebox--scroll-line-region-span line region-set))) (push (cons idx span) spans)))) (nreverse spans))) @@ -1931,7 +1931,7 @@ Decoration-only legacy lines fall back to the complete role scanner." (setq topology-seen t) (cl-pushnew region-id ids :test #'equal)) (dolist (property '(ebox-content ebox-content-owner)) - (when-let ((region-id (get-text-property pos property line))) + (when-let* ((region-id (get-text-property pos property line))) (setq topology-seen t) (cl-pushnew region-id ids :test #'equal))) (setq pos @@ -1960,7 +1960,7 @@ uses their rendered descendants." (limit (length line)) ids) (while (< pos limit) - (when-let ((region-id (get-text-property pos 'ebox-content line))) + (when-let* ((region-id (get-text-property pos 'ebox-content line))) (cl-pushnew region-id ids :test #'equal)) (setq pos (max (1+ pos) @@ -1972,7 +1972,7 @@ uses their rendered descendants." (defun ebox--scroll-line-bounds-index-add (index line-index line) "Add LINE at LINE-INDEX to lightweight region bounds INDEX." (dolist (region-id (ebox--scroll-line-direct-content-region-ids line)) - (if-let ((bounds (gethash region-id index))) + (if-let* ((bounds (gethash region-id index))) (setcdr bounds line-index) (puthash region-id (cons line-index line-index) index))) index) @@ -2015,7 +2015,7 @@ uses their rendered descendants." for line-index from 0 do (dolist (region-id (ebox--scroll-line-region-ids line)) - (when-let ((span (ebox--scroll-line-region-span + (when-let* ((span (ebox--scroll-line-region-span line (ebox--region-id-set (list region-id))))) (puthash region-id @@ -2076,7 +2076,7 @@ fall back to the complete role scanner." (defun ebox--scroll-index-add-line (index line-index line) "Add LINE at LINE-INDEX to INDEX." (dolist (region-id (ebox--scroll-line-region-ids line)) - (when-let ((span (ebox--scroll-line-region-span + (when-let* ((span (ebox--scroll-line-region-span line (ebox--region-id-set (list region-id))))) (puthash region-id (cons (cons line-index span) @@ -2146,7 +2146,7 @@ fall back to the complete role scanner." Dynamic updates reuse an already prepared index. When no ready index exists, scan for only REGION-IDS; building the all-region index synchronously is much more expensive than the targeted fallback on a long lazy prefix." - (if-let ((index (plist-get state :region-line-span-index))) + (if-let* ((index (plist-get state :region-line-span-index))) ;; A ready exact index already proves both membership and spans. Building ;; the prefix-wide membership set first adds an O(prefix) tax to visible ;; updates after scrolling. @@ -2156,7 +2156,7 @@ more expensive than the targeted fallback on a long lazy prefix." (when (ebox--scroll-region-id-set-intersects-p content-region-id-set region-ids) (let ((hints (plist-get state :region-line-span-hints))) - (if-let ((hint-spans + (if-let* ((hint-spans (and hints (cl-loop for region-id in region-ids for spans = (gethash region-id hints) @@ -2187,7 +2187,7 @@ bound rendered-line inspection without scanning or indexing the whole prefix." ((< line-index (car indices))) ((= line-index (car indices)) (when (ebox--scroll-line-region-present-p line region-ids) - (when-let ((span (ebox--scroll-line-region-span + (when-let* ((span (ebox--scroll-line-region-span line region-set))) (push (cons line-index span) spans))) (setq indices (cdr indices))))) @@ -2196,7 +2196,7 @@ bound rendered-line inspection without scanning or indexing the whole prefix." (defun ebox--cancel-buffer-reflow-cache-prewarm (buffer) "Cancel pending predicted reflow-cache warming for BUFFER." - (when-let ((timer (gethash buffer ebox--reflow-cache-prewarm-timers))) + (when-let* ((timer (gethash buffer ebox--reflow-cache-prewarm-timers))) (when (timerp timer) (cancel-timer timer))) (remhash buffer ebox--reflow-cache-prewarm-timers)) @@ -2204,7 +2204,7 @@ bound rendered-line inspection without scanning or indexing the whole prefix." (defun ebox--cancel-buffer-runtime-prewarm (buffer) "Cancel and discard pending runtime prewarming for BUFFER." (ebox--cancel-buffer-reflow-cache-prewarm buffer) - (when-let ((timer (gethash buffer ebox--runtime-prewarm-timers))) + (when-let* ((timer (gethash buffer ebox--runtime-prewarm-timers))) (when (timerp timer) (cancel-timer timer))) (remhash buffer ebox--runtime-prewarm-timers) @@ -2450,7 +2450,7 @@ published or mutated. Return non-nil when the isolated render ran." (defun ebox--root-region-box (root region-id) "Return ROOT's box carrying REGION-ID, including a flex wrapper box." - (when-let ((owner (car (ebox--node-path-to-region root region-id)))) + (when-let* ((owner (car (ebox--node-path-to-region root region-id)))) (cond ((eq (plist-get owner :ebox-type) 'box) owner) ((and (eq (plist-get owner :ebox-type) 'flex) @@ -2607,7 +2607,7 @@ OLD-VIEWPORT-WIDTH and VIEWPORT-WIDTH describe the completed reflow. One job is scheduled for the next width at the same nonzero delta; invalid nonpositive predictions are skipped." (ebox--cancel-buffer-reflow-cache-prewarm buffer) - (when-let ((state (and (ebox--reflow-cache-prewarm-enabled-p) + (when-let* ((state (and (ebox--reflow-cache-prewarm-enabled-p) (buffer-live-p buffer) (ebox--buffer-render-state buffer)))) (let* ((delta (and (numberp old-viewport-width) @@ -2660,7 +2660,7 @@ scroll surface." :phase (if native-ready-p 'native-scroll 'snapshots) :snapshot-stack (unless native-ready-p - (when-let ((root (plist-get state :root-node))) + (when-let* ((root (plist-get state :root-node))) (list (vector root :uninitialized t t)))) :node-region-ids-cache (make-hash-table :test 'eq) :viewport-width-ids-rev nil @@ -2675,7 +2675,7 @@ scroll surface." "Schedule BUFFER's next runtime prewarm slice after DELAY." (when (and (buffer-live-p buffer) (gethash buffer ebox--runtime-prewarm-jobs)) - (when-let ((old (gethash buffer ebox--runtime-prewarm-timers))) + (when-let* ((old (gethash buffer ebox--runtime-prewarm-timers))) (when (timerp old) (cancel-timer old))) (puthash buffer @@ -2690,7 +2690,7 @@ scroll surface." RETAINED-ONLY-P is deliberately true after ordinary commits and resizes; the initial mount and visible-window handoff leave it nil." (ebox--cancel-buffer-runtime-prewarm buffer) - (when-let ((state (and (ebox--runtime-prewarm-enabled-p) + (when-let* ((state (and (ebox--runtime-prewarm-enabled-p) (buffer-live-p buffer) (ebox--buffer-render-state buffer)))) (puthash buffer (ebox--runtime-prewarm-new-job @@ -2794,7 +2794,7 @@ Return non-nil when descendant width dependencies remain relevant." (ebox--node-layout-snapshot buffer node nil)))))) (setq count (1+ count)))) (unless (plist-get job :snapshot-stack) - (when-let ((state (ebox--buffer-render-state buffer))) + (when-let* ((state (ebox--buffer-render-state buffer))) (let ((width-ids (nreverse (plist-get job :viewport-width-ids-rev))) (height-ids (nreverse @@ -2814,7 +2814,7 @@ Return non-nil when descendant width dependencies remain relevant." (tails (plist-get task :tails)) (line-index (plist-get task :line-index))) (dolist (region-id (ebox--scroll-line-region-ids line)) - (when-let ((span (ebox--scroll-line-region-span + (when-let* ((span (ebox--scroll-line-region-span line (ebox--region-id-set (list region-id))))) (let* ((cell (list (cons line-index span))) (tail (gethash region-id tails))) @@ -2893,7 +2893,7 @@ Return non-nil when descendant width dependencies remain relevant." (let* ((sources (plist-get job :scroll-sources)) (source (car sources))) (plist-put job :scroll-sources (cdr sources)) - (when-let ((task + (when-let* ((task (ebox--runtime-prewarm-scroll-source-task buffer source))) (plist-put job :scroll-task task))) @@ -2956,7 +2956,7 @@ events use the native window afterwards and never enter the TP surface plan." (list :result 0 :state state :offset (or (plist-get state :scroll-offset) 0) :native-materialize-p t))) - (when-let ((window (get-buffer-window buffer t))) + (when-let* ((window (get-buffer-window buffer t))) (with-current-buffer buffer (goto-char (min old-point (point-max)))) (set-window-point window (point)) @@ -2970,7 +2970,7 @@ events use the native window afterwards and never enter the TP surface plan." (defun ebox--runtime-prewarm-step (buffer) "Run one bounded runtime prewarm slice for BUFFER. Return non-nil while more work remains." - (when-let ((job (gethash buffer ebox--runtime-prewarm-jobs))) + (when-let* ((job (gethash buffer ebox--runtime-prewarm-jobs))) (let ((state (ebox--buffer-render-state buffer))) (if (or (not (buffer-live-p buffer)) (not (eq state (plist-get job :render-state))) @@ -3004,7 +3004,7 @@ Return non-nil while more work remains." (defun ebox--runtime-prewarm-drain (buffer) "Synchronously drain BUFFER's scheduled prewarm job for tests and profiling." - (when-let ((timer (gethash buffer ebox--runtime-prewarm-timers))) + (when-let* ((timer (gethash buffer ebox--runtime-prewarm-timers))) (when (timerp timer) (cancel-timer timer)) (remhash buffer ebox--runtime-prewarm-timers)) @@ -3012,7 +3012,7 @@ Return non-nil while more work remains." completed) (while (and (> limit 0) (not completed)) (unless (gethash buffer ebox--runtime-prewarm-jobs) - (when-let ((state (and (buffer-live-p buffer) + (when-let* ((state (and (buffer-live-p buffer) (ebox--buffer-render-state buffer)))) (puthash buffer (ebox--runtime-prewarm-new-job buffer state) ebox--runtime-prewarm-jobs))) @@ -3031,7 +3031,7 @@ Return non-nil while more work remains." (let (candidates) (maphash (lambda (region-id _state) - (when-let ((bounds + (when-let* ((bounds (ebox-surface-region-bounds (current-buffer) region-id))) (when (and (<= (car bounds) pos) (< pos (cdr bounds))) @@ -3061,7 +3061,7 @@ nested owners may render equal-sized clipped spans." (let (candidates) (maphash (lambda (region-id _state) - (when-let ((bounds + (when-let* ((bounds (ebox-surface-region-bounds (current-buffer) region-id))) (push (cons region-id @@ -3502,7 +3502,7 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input." (defun ebox--scrollable-region-p (region-id delta) "Return non-nil when REGION-ID can consume DELTA lines." - (when-let ((state (and region-id (ebox--scroll-get-state region-id)))) + (when-let* ((state (and region-id (ebox--scroll-get-state region-id)))) (let* ((scroll-offset (or (plist-get state :scroll-offset) 0)) (content-lines (plist-get state :content-lines)) (content-height (plist-get state :content-height)) @@ -3524,8 +3524,8 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input." (defun ebox--smooth-scroll-stop (region-id) "Stop pending smooth wheel scroll animation for REGION-ID." - (when-let ((entry (gethash region-id ebox--smooth-scroll-state-table))) - (when-let ((timer (plist-get entry :timer))) + (when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table))) + (when-let* ((timer (plist-get entry :timer))) (cancel-timer timer)) (remhash region-id ebox--smooth-scroll-state-table) (ebox--deferred-render-gc-schedule-restore) @@ -3534,7 +3534,7 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input." (defun ebox--smooth-scroll-pause-for-prefetch (region-id entry pending) "Pause REGION-ID smooth scroll ENTRY until lazy prefetch extends the cache." - (when-let ((timer (plist-get entry :timer))) + (when-let* ((timer (plist-get entry :timer))) (when (timerp timer) (cancel-timer timer))) (plist-put entry :timer nil) @@ -3544,7 +3544,7 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input." (defun ebox--smooth-scroll-clamp-pending (region-id pending) "Clamp PENDING lines to REGION-ID's remaining scrollable range." - (if-let ((state (and region-id (ebox--scroll-get-state region-id)))) + (if-let* ((state (and region-id (ebox--scroll-get-state region-id)))) (let* ((scroll-offset (or (plist-get state :scroll-offset) 0)) (lazy-forward (and (> pending 0) @@ -3570,7 +3570,7 @@ NATIVE-RESIDUAL; refresh-only publication never consumes user input." (defun ebox--smooth-scroll-lazy-boundary-p (region-id delta) "Return non-nil when DELTA would cross REGION-ID's lazy prefix boundary." - (when-let ((state (and (> delta 0) + (when-let* ((state (and (> delta 0) (ebox--scroll-get-state region-id)))) (let* ((scroll-offset (or (plist-get state :scroll-offset) 0)) (content-lines (plist-get state :content-lines)) @@ -3660,7 +3660,7 @@ animation was admitted because one owner can consume the complete intent." ;; pending distance; the timer coalesces them into frame-sized edits. (unless had-timer (ebox--smooth-scroll-tick region-id)) - (when-let ((entry (gethash region-id ebox--smooth-scroll-state-table))) + (when-let* ((entry (gethash region-id ebox--smooth-scroll-state-table))) (unless (timerp (plist-get entry :timer)) (plist-put entry :timer @@ -3720,7 +3720,7 @@ FALLBACK is the Emacs scroll command to call when ebox cannot scroll." (defun ebox--scroll-region-can-consume-complete-p (region-id delta) "Return non-nil when REGION-ID can consume all signed DELTA now." - (when-let ((state (and region-id (ebox--scroll-get-state region-id)))) + (when-let* ((state (and region-id (ebox--scroll-get-state region-id)))) (let* ((offset (or (plist-get state :scroll-offset) 0)) (height (or (plist-get state :content-height) 0)) (maximum (max 0 (- (length (plist-get state :content-lines)) @@ -3848,9 +3848,8 @@ With prefix ARG, scroll by that many content lines." "Remove all runtime caches owned by BUFFER. Defaults to the current buffer." (let ((buffer (or buffer (current-buffer)))) - (ebox--cancel-buffer-viewport-resize buffer) (ebox--cancel-buffer-runtime-prewarm buffer) - (when-let ((root (ebox--buffer-root-node buffer))) + (when-let* ((root (ebox--buffer-root-node buffer))) (ebox--clear-region-runtime-caches (ebox--node-all-region-ids root))) (ebox--clear-buffer-render-state buffer))) @@ -3992,7 +3991,7 @@ cannot be changed through the unpublished batch root." (defun ebox--surface-region-scroll-context (buffer region-id) "Return read-only scroll publication context for REGION-ID in BUFFER." - (when-let ((node (ebox--buffer-region-render-owner-node buffer region-id))) + (when-let* ((node (ebox--buffer-region-render-owner-node buffer region-id))) (let ((region-ids (ebox--node-all-region-ids node)) states) (maphash @@ -4017,7 +4016,7 @@ cannot be changed through the unpublished batch root." (defun ebox--surface-region-scroll-report (context changed-keys) "Return TP-era scroll report fields for CONTEXT and CHANGED-KEYS." - (when-let ((node (plist-get context :node))) + (when-let* ((node (plist-get context :node))) (let* ((count (length (plist-get context :states))) (paint-p (eq (ebox--region-update-dirty-kind changed-keys) 'paint)) @@ -4060,7 +4059,7 @@ cannot be changed through the unpublished batch root." (plist-get (plist-get commit-input :state-overrides) :scroll-state-table))) (dolist (entry (plist-get context :states)) - (when-let ((state (gethash (car entry) table))) + (when-let* ((state (gethash (car entry) table))) (plist-put state :lazy-scroll-prefix-dirty t) (puthash (car entry) state table))))) commit-input) @@ -4380,7 +4379,7 @@ NODE can be any box/concat/stack node created by `ebox-create', "Return NODE's margin-free role bounds in BUFFER, or nil." (let (start end) (dolist (region-id (ebox--node-all-region-ids node)) - (when-let ((bounds + (when-let* ((bounds (ebox-surface-region-bounds buffer region-id ebox--horizontal-border-anchor-roles))) (setq start (if start (min start (car bounds)) (car bounds)) @@ -4391,7 +4390,7 @@ NODE can be any box/concat/stack node created by `ebox-create', "Return fallback TP mount bounds for NODE in BUFFER, or nil." (let (start end) (dolist (region-id (ebox--node-all-region-ids node)) - (when-let ((bounds (ebox-surface-region-bounds buffer region-id))) + (when-let* ((bounds (ebox-surface-region-bounds buffer region-id))) (setq start (if start (min start (car bounds)) (car bounds)) end (if end (max end (cdr bounds)) (cdr bounds))))) (and start end (< start end) (cons start end)))) @@ -4560,7 +4559,7 @@ Return the successful publication report stored by `ebox-buffer-update-report'." :publish callback :rollback framework-rollback :state 'unpublished :diagnostics nil)) (_surface - (if-let ((scope-node-ids + (if-let* ((scope-node-ids (plist-get commit-input :scope-node-ids))) (ebox-surface-update-buffer-scoped buffer source scope-node-ids diff --git a/scripts/ebox-performance-evaluator.el b/scripts/ebox-performance-evaluator.el index 4e3ed38..222a6f2 100644 --- a/scripts/ebox-performance-evaluator.el +++ b/scripts/ebox-performance-evaluator.el @@ -541,7 +541,7 @@ (if (plist-get check :ok) "PASS" "FAIL") (plist-get check :name) (plist-get check :detail)))) - (when-let ((tp-report (plist-get report :tp-report))) + (when-let* ((tp-report (plist-get report :tp-report))) (princ (format "TP-REPORT %S\n" tp-report))) (princ "\n"))) diff --git a/tests/ebox-core-render-tests.el b/tests/ebox-core-render-tests.el index 5092f36..d29f0ce 100644 --- a/tests/ebox-core-render-tests.el +++ b/tests/ebox-core-render-tests.el @@ -4436,7 +4436,7 @@ (ebox-render-to-buffer (generate-new-buffer-name " *ebox-test*") layout)) - (when-let ((cache + (when-let* ((cache (plist-get (ebox--buffer-render-state buffer) :render-signature-cache))) (clrhash cache)) @@ -8150,7 +8150,7 @@ (length (plist-get state :rendered-content-lines))))) (should (= (plist-get state :content-height) 12))) - (when-let ((materialize + (when-let* ((materialize (plist-get state :materialize-content-lines))) (plist-put state :materialize-content-lines @@ -8481,7 +8481,7 @@ (ebox-scroll-lazy-prefix-lookahead-lines 0)) (cl-letf (((symbol-function 'ebox--render-box) (lambda (box) - (when-let ((id (and (listp box) (ebox-get box :id)))) + (when-let* ((id (and (listp box) (ebox-get box :id)))) (when (and (string-prefix-p "item-" id) (>= (string-to-number (substring id (length "item-"))) diff --git a/tests/ebox-flex-tests.el b/tests/ebox-flex-tests.el index e9df210..9884a05 100644 --- a/tests/ebox-flex-tests.el +++ b/tests/ebox-flex-tests.el @@ -79,7 +79,7 @@ (len (length string)) values) (while (< pos len) - (when-let ((value (get-text-property pos property string))) + (when-let* ((value (get-text-property pos property string))) (unless (memq value values) (setq values (append values (list value))))) (setq pos (1+ pos))) diff --git a/tests/ebox-package-tests.el b/tests/ebox-package-tests.el index ad06f3a..430fb8d 100644 --- a/tests/ebox-package-tests.el +++ b/tests/ebox-package-tests.el @@ -110,7 +110,7 @@ ((symbol-function 'message) #'ignore)) (should (ebox-byte-compile)) (should (equal (nreverse compiled) ebox--compile-sources))) - (when-let ((buffer (get-buffer "*Ebox Byte Compile*"))) + (when-let* ((buffer (get-buffer "*Ebox Byte Compile*"))) (kill-buffer buffer))))) (ert-deftest ebox-package-includes-native-build-source () diff --git a/tests/ebox-surface-tests.el b/tests/ebox-surface-tests.el index 48f9e06..0f46e6e 100644 --- a/tests/ebox-surface-tests.el +++ b/tests/ebox-surface-tests.el @@ -171,15 +171,13 @@ (when (get-buffer " *other-window*") (kill-buffer " *other-window*"))))) -(ert-deftest ebox-window-size-change-coalesces-to-latest-visible-viewport () - "Continuous frame changes publish only the latest sampled viewport." +(ert-deftest ebox-window-size-change-publishes-every-visible-viewport () + "Continuous frame changes publish each sampled viewport immediately." (let* ((buffer (generate-new-buffer " *ebox-window-size-change*")) (window (selected-window)) (old-buffer (window-buffer window)) (sampled-height (window-body-height window)) (sampled-widths (number-sequence 240 430 10)) - scheduled - cancelled calls) (unwind-protect (progn @@ -195,52 +193,115 @@ (lambda (target width height) (push (list target width height) calls))) ((symbol-function 'run-at-time) - (lambda (delay _repeat function &rest arguments) - (let ((timer (intern (format "ebox-resize-timer-%d" - (1+ (length scheduled)))))) - (push (list timer delay function arguments) scheduled) - timer))) - ((symbol-function 'timerp) - (lambda (value) - (string-prefix-p "ebox-resize-timer-" - (symbol-name value)))) - ((symbol-function 'cancel-timer) - (lambda (timer) (push timer cancelled))) + (lambda (&rest _) + (ert-fail "viewport delivery must not schedule a timer"))) (noninteractive nil)) (dotimes (_index 20) (ebox--window-size-change (selected-frame))) - (should-not calls) - (should (= (length scheduled) 20)) - (should (= (length cancelled) 19)) - (pcase-let ((`(,_timer ,delay ,function ,arguments) - (car scheduled))) - (should (= delay ebox-viewport-resize-delay)) - (apply function arguments)) - (should (equal calls - (list (list buffer 430 sampled-height)))))) + (should (= (length calls) 20)) + (should + (equal (mapcar #'cadr (nreverse (copy-sequence calls))) + (number-sequence 240 430 10))) + (should (cl-every (lambda (call) + (and (eq (car call) buffer) + (= (nth 2 call) sampled-height))) + calls)))) (set-window-buffer window old-buffer) - (when (boundp 'ebox--viewport-resize-pending-table) - (clrhash ebox--viewport-resize-pending-table)) (kill-buffer buffer)))) -(ert-deftest ebox-buffer-cleanup-cancels-pending-viewport-resize () - "A dead mounted buffer cannot retain a viewport timer or pending sample." - (let ((buffer (generate-new-buffer " *ebox-viewport-cleanup*")) - (timer 'ebox-test-viewport-cleanup-timer) - cancelled) +(ert-deftest ebox-window-size-change-rejects-reentrant-publication () + "A viewport commit cannot recursively enter the global size hook." + (let* ((buffer (generate-new-buffer " *ebox-reentrant-window-size*")) + (window (selected-window)) + (old-buffer (window-buffer window)) + (sampled-widths '(420 440)) + calls) (unwind-protect (progn - (puthash buffer (vector 1 (selected-window) 400 20 timer) - ebox--viewport-resize-pending-table) - (cl-letf (((symbol-function 'timerp) - (lambda (value) (eq value timer))) - ((symbol-function 'cancel-timer) - (lambda (value) (setq cancelled value)))) - (with-current-buffer buffer (ebox--cleanup-current-buffer))) - (should (eq cancelled timer)) - (should-not (gethash buffer ebox--viewport-resize-pending-table))) - (remhash buffer ebox--viewport-resize-pending-table) - (when (buffer-live-p buffer) (kill-buffer buffer))))) + (set-window-buffer window buffer) + (cl-letf (((symbol-function 'ebox--buffer-render-state) + (lambda (_buffer) + '(:viewport-width 100 :viewport-height 10))) + ((symbol-function 'ebox-surface-buffer-mounted-p) + (lambda (_buffer) t)) + ((symbol-function 'ebox-surface--window-content-width) + (lambda (_window) (pop sampled-widths))) + ((symbol-function 'window-body-height) + (lambda (&rest _) 20)) + ((symbol-function 'ebox-rerender-buffer-with-context) + (lambda (&rest arguments) + (push arguments calls) + (ebox--window-size-change (selected-frame)))) + (noninteractive nil)) + (ebox--window-size-change (selected-frame))) + (should (= (length calls) 1)) + (should (equal sampled-widths '(440)))) + (set-window-buffer window old-buffer) + (kill-buffer buffer)))) + +(ert-deftest ebox-window-size-change-restores-guard-after-error () + "A failed viewport update cannot leave future window events suppressed." + (let* ((buffer (generate-new-buffer " *ebox-window-size-error*")) + (window (selected-window)) + (old-buffer (window-buffer window)) + (fail t) + calls) + (unwind-protect + (progn + (set-window-buffer window buffer) + (cl-letf (((symbol-function 'ebox--buffer-render-state) + (lambda (_buffer) + '(:viewport-width 100 :viewport-height 10))) + ((symbol-function 'ebox-surface-buffer-mounted-p) + (lambda (_buffer) t)) + ((symbol-function 'ebox-surface--window-content-width) + (lambda (_window) 420)) + ((symbol-function 'window-body-height) + (lambda (&rest _) 20)) + ((symbol-function 'ebox-rerender-buffer-with-context) + (lambda (&rest arguments) + (push arguments calls) + (when fail (error "viewport update failed")))) + (noninteractive nil)) + (should-error (ebox--window-size-change (selected-frame))) + (should-not ebox--window-size-change-in-progress) + (setq fail nil) + (ebox--window-size-change (selected-frame))) + (should (= (length calls) 2))) + (set-window-buffer window old-buffer) + (kill-buffer buffer)))) + +(ert-deftest ebox-window-size-change-follows-canonical-display-frame () + "A stale frame cannot overwrite a surface owned by another live frame." + (let ((buffer (generate-new-buffer " *ebox-canonical-frame*")) + calls) + (unwind-protect + (cl-letf (((symbol-function 'frame-live-p) (lambda (_frame) t)) + ((symbol-function 'window-list) + (lambda (&rest _) '(event-window))) + ((symbol-function 'window-live-p) (lambda (_window) t)) + ((symbol-function 'window-buffer) (lambda (_window) buffer)) + ((symbol-function 'window-frame) + (lambda (_window) 'canonical-frame)) + ((symbol-function 'ebox-surface--buffer-display-window) + (lambda (_buffer) 'canonical-window)) + ((symbol-function 'ebox-surface-buffer-mounted-p) + (lambda (_buffer) t)) + ((symbol-function 'ebox--buffer-render-state) + (lambda (_buffer) + '(:viewport-width 100 :viewport-height 10))) + ((symbol-function 'ebox-surface--window-content-width) + (lambda (_window) 420)) + ((symbol-function 'window-body-height) + (lambda (&rest _) 20)) + ((symbol-function 'ebox-rerender-buffer-with-context) + (lambda (&rest arguments) (push arguments calls))) + (noninteractive nil)) + (ebox--window-size-change 'stale-frame) + (should-not calls) + (ebox--window-size-change 'canonical-frame) + (should (equal calls (list (list buffer 420 20))))) + (kill-buffer buffer)))) (defun ebox-surface-test--hash-fingerprint (table) "Return a stable content fingerprint for hash TABLE.