312 lines
12 KiB
EmacsLisp
312 lines
12 KiB
EmacsLisp
;;; ebox-fragment.el --- Layout fragments and snapshots for Ebox -*- lexical-binding: t; -*-
|
|
|
|
;;; Commentary:
|
|
;; Owns derived layout fragment and snapshot data used for diffing and
|
|
;; patchability checks. It does not own source identity or buffer edits.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'subr-x)
|
|
(require 'ebox-tree)
|
|
(require 'ebox-measure)
|
|
|
|
(declare-function ebox--current-display-signature "ebox-measure" ())
|
|
(declare-function ebox--ensure-node-id "ebox" (node))
|
|
(declare-function ebox-style--declaration-value-equal-p
|
|
"ebox-style" (left right))
|
|
(declare-function ebox--complete-layout-snapshot
|
|
"ebox-incremental"
|
|
(buffer node snapshot &optional copy))
|
|
|
|
(defvar ebox--layout-fragments-table nil
|
|
"Dynamic published-generation layout fragment retention table.")
|
|
|
|
(defvar ebox--layout-fragments-reuse-p nil
|
|
"Non-nil when the current candidate may reuse retained layout fragments.")
|
|
|
|
(defconst ebox-fragment-flex-retention-max-entries 512
|
|
"Maximum number of retained final-sized Flex fragments per generation.")
|
|
|
|
(defvar ebox-fragment-flex-retention-hit-count 0
|
|
"Diagnostic count of retained final-sized Flex child fragment hits.")
|
|
|
|
(defvar ebox-fragment-flex-retention-rerender-count 0
|
|
"Diagnostic count of final-sized Flex child fragment rerenders.")
|
|
|
|
(defvar ebox-fragment-flex-retention-store-count 0
|
|
"Diagnostic count of retained final-sized Flex child fragment stores.")
|
|
|
|
(defun ebox-fragment-flex-allocation-key
|
|
(source axis main cross align viewport &optional render-context)
|
|
"Return exact retained-fragment key for SOURCE in Flex allocation context.
|
|
RENDER-CONTEXT contains layout-mode inputs that affect the rendered child but
|
|
are not part of its final allocated geometry."
|
|
(when (and (hash-table-p ebox--layout-fragments-table)
|
|
(listp source)
|
|
(not (stringp source))
|
|
(numberp viewport))
|
|
(let ((height-key
|
|
(if (and (plist-member render-context
|
|
:viewport-height-dependent)
|
|
(null (plist-get render-context
|
|
:viewport-height-dependent)))
|
|
:viewport-height-independent
|
|
(and (boundp 'ebox-viewport-height) ebox-viewport-height))))
|
|
(list (ebox--ensure-node-id source)
|
|
(copy-sequence (ebox--node-all-region-ids source))
|
|
'flex-final-sized
|
|
axis main cross align viewport
|
|
height-key
|
|
render-context
|
|
(and (fboundp 'ebox--current-display-signature)
|
|
(ebox--current-display-signature))))))
|
|
|
|
(defun ebox-fragment-flex-retained-side-effects-reusable-p (metadata)
|
|
"Return non-nil when retained fragment METADATA has no scroll effects.
|
|
Even a clear action is generation-sensitive: replaying or skipping it can
|
|
leave a stale scroll state after an A-to-B-to-A candidate sequence."
|
|
(and (listp metadata)
|
|
(not (plist-get metadata :stateful-p))
|
|
(plist-member metadata :scroll-actions)
|
|
(null (plist-get metadata :scroll-actions))))
|
|
|
|
(defun ebox-fragment-flex-retention-lookup (key)
|
|
"Return retained Flex fragment entry for KEY, or nil."
|
|
(when (and key (hash-table-p ebox--layout-fragments-table))
|
|
(let ((entry (gethash key ebox--layout-fragments-table)))
|
|
(when (and entry
|
|
ebox--layout-fragments-reuse-p
|
|
(ebox-fragment-flex-retained-side-effects-reusable-p
|
|
(plist-get entry :side-effects)))
|
|
(cl-incf ebox-fragment-flex-retention-hit-count)
|
|
(plist-get entry :entry)))))
|
|
|
|
(defun ebox-fragment-flex-retention-store (key entry side-effects)
|
|
"Store retained Flex fragment ENTRY under KEY with SIDE-EFFECTS."
|
|
(when (and key entry
|
|
(ebox-fragment-flex-retained-side-effects-reusable-p
|
|
side-effects)
|
|
(hash-table-p ebox--layout-fragments-table))
|
|
(when (and (not (gethash key ebox--layout-fragments-table))
|
|
(>= (hash-table-count ebox--layout-fragments-table)
|
|
ebox-fragment-flex-retention-max-entries))
|
|
(let (old-key)
|
|
(maphash
|
|
(lambda (candidate-key _old-entry)
|
|
(setq old-key candidate-key))
|
|
ebox--layout-fragments-table)
|
|
(when old-key
|
|
(remhash old-key ebox--layout-fragments-table))))
|
|
(puthash key
|
|
(list :entry entry :side-effects side-effects)
|
|
ebox--layout-fragments-table)
|
|
(cl-incf ebox-fragment-flex-retention-store-count))
|
|
entry)
|
|
|
|
(cl-defstruct (ebox-fragment
|
|
(:constructor ebox-fragment-create))
|
|
node-id type display region-ids child-ids style-signature size
|
|
line-signature span-footprint-signature external-footprint-signature
|
|
parent-slot-signature role-topology-signature overflow-signature
|
|
buffer-span buffer-spans)
|
|
|
|
(defun ebox-fragment-layout-signature (fragment)
|
|
"Return layout-significant fields from FRAGMENT.
|
|
Backend marker and buffer span data are intentionally excluded."
|
|
(let (signature)
|
|
(dolist (field '(:node-id :type :display :region-ids :child-ids
|
|
:style-signature :size :line-signature))
|
|
(let* ((name (intern (substring (symbol-name field) 1)))
|
|
(accessor (intern (format "ebox-fragment-%s" name)))
|
|
(value (and (fboundp accessor) (funcall accessor fragment))))
|
|
(when value
|
|
(setq signature (plist-put signature field value)))))
|
|
signature))
|
|
|
|
(defconst ebox--paint-style-signature-keys
|
|
'(:color :bgcolor :visibility
|
|
:text-decoration-line :text-decoration-color :text-decoration-style
|
|
:border-left-color :border-right-color
|
|
:border-top-color :border-bottom-color)
|
|
"Box properties that affect paint without changing layout geometry.")
|
|
|
|
(defconst ebox--typography-style-signature-keys
|
|
'(:ebox-font-fact)
|
|
"Typography properties whose resolved metrics may change geometry.")
|
|
|
|
(defconst ebox--geometry-style-signature-keys
|
|
(append
|
|
'(:box-sizing
|
|
:width :min-width :max-width
|
|
:height :min-height :max-height)
|
|
ebox--typography-style-signature-keys
|
|
'(:padding-left-pixel :padding-right-pixel
|
|
:padding-top-height :padding-bottom-height
|
|
:margin-left-pixel :margin-right-pixel
|
|
:margin-top-height :margin-bottom-height
|
|
:border-left-pixel :border-left-style
|
|
:border-right-pixel :border-right-style
|
|
:border-top-pixel :border-top-style
|
|
:border-bottom-pixel :border-bottom-style
|
|
:text-align :vertical-align
|
|
:overflow :wrap-mode
|
|
:flex-props :flex-participation))
|
|
"Style signature keys that require layout or owner rerender work.")
|
|
|
|
(defconst ebox--structure-style-signature-keys
|
|
'(:display)
|
|
"Style signature keys that change tree or formatting-context structure.")
|
|
|
|
(defconst ebox--style-signature-keys
|
|
(append ebox--paint-style-signature-keys
|
|
ebox--geometry-style-signature-keys)
|
|
"Box properties included in layout snapshot style signatures.")
|
|
|
|
(defun ebox-fragment-style-source-node (node)
|
|
"Return the box-like node carrying visual style for NODE."
|
|
(pcase (and (listp node) (plist-get node :ebox-type))
|
|
('box node)
|
|
('flex (plist-get node :box))
|
|
('grid (plist-get node :box))
|
|
(_ nil)))
|
|
|
|
(defun ebox-fragment-node-style-signature (node)
|
|
"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)))
|
|
(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)))
|
|
(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)))
|
|
(setq signature
|
|
(plist-put signature :flex-participation participation)))
|
|
signature)))
|
|
|
|
(defun ebox-fragment-plist-keys (plist)
|
|
"Return the keyword keys present in PLIST."
|
|
(let (keys)
|
|
(while plist
|
|
(push (pop plist) keys)
|
|
(pop plist))
|
|
(nreverse keys)))
|
|
|
|
(defun ebox-fragment-plist-changed-keys (old new)
|
|
"Return keys whose plist values differ between OLD and NEW."
|
|
(let (changed keys)
|
|
(dolist (key (append (ebox-fragment-plist-keys old)
|
|
(ebox-fragment-plist-keys new)))
|
|
(cl-pushnew key keys))
|
|
(dolist (key keys)
|
|
(unless (ebox-style--declaration-value-equal-p
|
|
(plist-get old key) (plist-get new key))
|
|
(push key changed)))
|
|
changed))
|
|
|
|
(defun ebox-fragment-style-signature-dirty-kind (old new)
|
|
"Return dirty kind implied by OLD and NEW style signatures."
|
|
(let ((changed (ebox-fragment-plist-changed-keys old new)))
|
|
(cond
|
|
((null changed) nil)
|
|
((cl-some (lambda (key)
|
|
(memq key ebox--structure-style-signature-keys))
|
|
changed)
|
|
'structure)
|
|
((cl-some (lambda (key)
|
|
(memq key ebox--geometry-style-signature-keys))
|
|
changed)
|
|
'geometry)
|
|
(t 'paint))))
|
|
|
|
(defun ebox-fragment-layout-snapshot-detailed-p (snapshot)
|
|
"Return non-nil when SNAPSHOT already has expensive detail fields."
|
|
(and (plist-member snapshot :buffer-spans)
|
|
(plist-member snapshot :line-signature)
|
|
(plist-member snapshot :span-footprint-signature)
|
|
(plist-member snapshot :external-footprint-signature)
|
|
(plist-member snapshot :parent-slot-signature)
|
|
(plist-member snapshot :role-topology-signature)
|
|
(plist-member snapshot :overflow-signature)))
|
|
|
|
(defun ebox-fragment-layout-snapshot-spans-p (snapshot)
|
|
"Return non-nil when SNAPSHOT already has buffer span details."
|
|
(plist-member snapshot :buffer-spans))
|
|
|
|
(defun ebox-fragment-node-layout-snapshot (buffer node &optional details)
|
|
"Return a derived layout snapshot for NODE in BUFFER.
|
|
The default snapshot is intentionally lightweight; when DETAILS is non-nil,
|
|
include buffer spans and line signatures."
|
|
(let* ((node-id (ebox--ensure-node-id node))
|
|
(region-ids (ebox--node-all-region-ids node))
|
|
(snapshot
|
|
(list :node-id node-id
|
|
:type (plist-get node :ebox-type)
|
|
:display (ebox--computed-display node)
|
|
:region-ids region-ids
|
|
:style-signature (ebox--node-style-signature node)
|
|
:child-ids
|
|
(mapcar #'ebox--ensure-node-id
|
|
(ebox--node-children node)))))
|
|
(if details
|
|
(ebox--complete-layout-snapshot buffer node snapshot)
|
|
snapshot)))
|
|
|
|
(defun ebox-fragment-layout-snapshot-dirty-kind (old new)
|
|
"Return the dirty kind between OLD and NEW layout snapshots."
|
|
(cond
|
|
((or (null old) (null new)) 'structure)
|
|
((not (eq (plist-get old :type)
|
|
(plist-get new :type)))
|
|
'structure)
|
|
((not (equal (plist-get old :display)
|
|
(plist-get new :display)))
|
|
'structure)
|
|
((not (equal (plist-get old :child-ids)
|
|
(plist-get new :child-ids)))
|
|
'structure)
|
|
((not (equal (plist-get old :line-signature)
|
|
(plist-get new :line-signature)))
|
|
'geometry)
|
|
((not (equal (plist-get old :buffer-spans)
|
|
(plist-get new :buffer-spans)))
|
|
'placement)
|
|
((not (equal (plist-get old :style-signature)
|
|
(plist-get new :style-signature)))
|
|
(ebox-fragment-style-signature-dirty-kind
|
|
(plist-get old :style-signature)
|
|
(plist-get new :style-signature)))))
|
|
|
|
(defalias 'ebox--style-source-node #'ebox-fragment-style-source-node)
|
|
(defalias 'ebox--node-style-signature #'ebox-fragment-node-style-signature)
|
|
(defalias 'ebox--plist-keys #'ebox-fragment-plist-keys)
|
|
(defalias 'ebox--plist-changed-keys #'ebox-fragment-plist-changed-keys)
|
|
(defalias 'ebox--style-signature-dirty-kind
|
|
#'ebox-fragment-style-signature-dirty-kind)
|
|
(defalias 'ebox--layout-snapshot-detailed-p
|
|
#'ebox-fragment-layout-snapshot-detailed-p)
|
|
(defalias 'ebox--layout-snapshot-spans-p
|
|
#'ebox-fragment-layout-snapshot-spans-p)
|
|
(defalias 'ebox--node-layout-snapshot
|
|
#'ebox-fragment-node-layout-snapshot)
|
|
(defalias 'ebox--layout-snapshot-dirty-kind
|
|
#'ebox-fragment-layout-snapshot-dirty-kind)
|
|
(defalias 'ebox--flex-fragment-allocation-key
|
|
#'ebox-fragment-flex-allocation-key)
|
|
(defalias 'ebox--flex-fragment-retention-lookup
|
|
#'ebox-fragment-flex-retention-lookup)
|
|
(defalias 'ebox--flex-fragment-retention-store
|
|
#'ebox-fragment-flex-retention-store)
|
|
|
|
(provide 'ebox-fragment)
|
|
|
|
;;; ebox-fragment.el ends here
|