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

perf: avoid unused vertical padding materialization

Browse Source
This commit is contained in:
Kinneyzhang 2026-09-06 13:25:47 +08:00
parent 9e581aea2e
commit acb5afce82
3 changed files with 175 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Makefile
View File

@ -10,7 +10,7 @@ NATIVE_MANIFEST = native/Cargo.toml
NATIVE_TARGET ?= $(shell $(EMACS_BATCH) -l ebox-native-reflow.el --eval '(princ (ebox-native-reflow--rust-target))')
NATIVE_RELEASE_DIR = native/target/$(NATIVE_TARGET)/release
.PHONY: all check ci load compile test checkdoc source-tests font-tests core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests viewport-topology-tests m0a-tests state-contract-tests layout-boundary-tests layout-boundary-performance patch-plan-tests patch-plan-performance style-schema-tests style-schema-performance spi-tests spi-performance c1b-contract-tests docs-contract-tests ci-contract-tests performance-evaluator visual-check native-rust-tests native-build diff-check clean package-lint package-lint-install
.PHONY: all check ci load compile test checkdoc source-tests font-tests core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests viewport-topology-tests vertical-materialization-tests m0a-tests state-contract-tests layout-boundary-tests layout-boundary-performance patch-plan-tests patch-plan-performance style-schema-tests style-schema-performance spi-tests spi-performance c1b-contract-tests docs-contract-tests ci-contract-tests performance-evaluator visual-check native-rust-tests native-build diff-check clean package-lint package-lint-install
all: check
@ -25,7 +25,7 @@ compile:
rm -f *.elc tests/*.elc scripts/*.elc
$(EMACS_BATCH) --eval '(setq byte-compile-error-on-warn t byte-compile-warnings (quote (not obsolete)))' -l ebox.el --eval '(ebox-byte-compile)'
test: source-tests font-tests core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests viewport-topology-tests m0a-tests state-contract-tests layout-boundary-tests patch-plan-tests style-schema-tests spi-tests docs-contract-tests ci-contract-tests
test: source-tests font-tests core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests viewport-topology-tests vertical-materialization-tests m0a-tests state-contract-tests layout-boundary-tests patch-plan-tests style-schema-tests spi-tests docs-contract-tests ci-contract-tests
source-tests:
$(EMACS_BATCH) -l tests/ebox-source-tests.el -f ert-run-tests-batch-and-exit
@ -66,6 +66,9 @@ flex-tests:
viewport-topology-tests:
$(EMACS_TEST) -l tests/ebox-viewport-topology-tests.el -f ert-run-tests-batch-and-exit
vertical-materialization-tests:
$(EMACS_TEST) -l tests/ebox-vertical-materialization-tests.el -f ert-run-tests-batch-and-exit
m0a-tests:
$(EMACS_TEST) -l tests/ebox-m0a-inventory-fixture.el -l tests/ebox-m0a-inventory-tests.el -l tests/ebox-m0a-characterization-tests.el -f ert-run-tests-batch-and-exit

37
ebox.el
View File

@ -590,24 +590,27 @@ segments that incremental publication still needs."
ebox-content-owner ebox-content-owners)))))
(defun ebox--lines-pad-vertical (string height &optional offset padding-string)
"Extend STRING to HEIGHT lines.
"Pad or clip STRING to HEIGHT lines.
OFFSET controls content shift: positive (top), negative (bottom).
PADDING-STRING is used to fill empty lines, defaults to empty string."
(let* ((lines (ebox-string-lines string))
(line-count (length lines))
(padding-string (or padding-string
(ebox--pixel-blank
(ebox--string-pixel-width string) 1))))
(when (> height line-count)
(let* ((rest (- height line-count))
(offset (or offset 0))
(top-pad (cond ((>= offset 0) (min offset rest))
(t (max 0 (+ offset rest)))))
(bottom-pad (- rest top-pad))
(pad-lines (make-list top-pad padding-string))
(bottom-lines (make-list bottom-pad padding-string)))
(setq lines (append pad-lines lines bottom-lines))))
(ebox-lines-join (seq-take lines height))))
PADDING-STRING fills added lines; its default matches STRING's first-line width."
(if (and (stringp string) (integerp height) (= height 1)
(not (string-match-p "\n" string)))
(copy-sequence string)
(let* ((lines (ebox-string-lines string))
(line-count (length lines)))
(when (> height line-count)
(let* ((padding-string (or padding-string
(ebox--pixel-blank
(ebox--string-pixel-width string) 1)))
(rest (- height line-count))
(offset (or offset 0))
(top-pad (cond ((>= offset 0) (min offset rest))
(t (max 0 (+ offset rest)))))
(bottom-pad (- rest top-pad))
(pad-lines (make-list top-pad padding-string))
(bottom-lines (make-list bottom-pad padding-string)))
(setq lines (append pad-lines lines bottom-lines))))
(ebox-lines-join (seq-take lines height)))))
(defun ebox--lines-align-vertical (string height align)
"Align STRING to HEIGHT lines.

150
tests/ebox-vertical-materialization-tests.el Normal file
View File

@ -0,0 +1,150 @@
;;; ebox-vertical-materialization-tests.el --- Vertical padding contracts -*- lexical-binding: t; -*-
(require 'cl-lib)
(require 'ert)
(setq load-prefer-newer t)
(load-file (expand-file-name "../ebox.el"
(file-name-directory load-file-name)))
(defun ebox-vertical-test--previous-pad (string height &optional offset padding-string)
"Frozen previous helper for exact STRING/HEIGHT/OFFSET/PADDING-STRING parity."
(let* ((lines (ebox-string-lines string))
(line-count (length lines))
(padding-string (or padding-string
(ebox--pixel-blank
(ebox--string-pixel-width string) 1))))
(when (> height line-count)
(let* ((rest (- height line-count))
(offset (or offset 0))
(top-pad (cond ((>= offset 0) (min offset rest))
(t (max 0 (+ offset rest)))))
(bottom-pad (- rest top-pad))
(pad-lines (make-list top-pad padding-string))
(bottom-lines (make-list bottom-pad padding-string)))
(setq lines (append pad-lines lines bottom-lines))))
(ebox-lines-join (seq-take lines height))))
(ert-deftest ebox-vertical-materialization-skips-unused-default-padding ()
"No-padding and clipping paths do not measure or construct unused blanks."
(let ((measure (symbol-function 'ebox--string-pixel-width))
(blank (symbol-function 'ebox--pixel-blank)))
(dolist (case '(("A\nB" 2) ("A\nB" 1) ("A\nB" 0)
(nil 0) ("A" 1) ("" 1)))
(let ((expected (apply #'ebox-vertical-test--previous-pad case))
(measure-count 0) (blank-count 0) actual)
(cl-letf (((symbol-function 'ebox--string-pixel-width)
(lambda (&rest args)
(cl-incf measure-count)
(apply measure args)))
((symbol-function 'ebox--pixel-blank)
(lambda (&rest args)
(cl-incf blank-count)
(apply blank args))))
(setq actual (apply #'ebox--lines-pad-vertical case)))
(should (equal-including-properties actual expected))
(ert-info ((format "case=%S measurements=%d blanks=%d" case measure-count blank-count))
(should (= measure-count 0))
(should (= blank-count 0)))))))
(ert-deftest ebox-vertical-materialization-measures-only-needed-default-padding ()
"Actual padding measures its default once and never measures an explicit fill."
(let ((measure (symbol-function 'ebox--string-pixel-width))
(blank (symbol-function 'ebox--pixel-blank))
(input (propertize "A\nlonger" 'ebox-content-owner 17)))
(dolist (fill (list nil (propertize "_" 'ebox-content-owner 23)))
(let ((expected (ebox-vertical-test--previous-pad input 4 1 fill))
(measure-count 0) (blank-count 0) actual)
(cl-letf (((symbol-function 'ebox--string-pixel-width)
(lambda (&rest args)
(cl-incf measure-count)
(apply measure args)))
((symbol-function 'ebox--pixel-blank)
(lambda (&rest args)
(cl-incf blank-count)
(apply blank args))))
(setq actual (ebox--lines-pad-vertical input 4 1 fill)))
(should (equal-including-properties actual expected))
(should (= measure-count (if fill 0 1)))
(should (= blank-count (if fill 0 1)))))))
(ert-deftest ebox-vertical-materialization-single-line-does-not-split-or-join ()
"Single-line copies avoid actual substring and mapconcat materialization."
(let ((substring-function (symbol-function 'substring))
(join-function (symbol-function 'mapconcat)))
(dolist (input (list "" (propertize "Open" 'help-echo "kept" 'ebox-content-owner 17)))
(let ((split-count 0) (join-count 0) actual)
(cl-letf (((symbol-function 'substring)
(lambda (&rest args)
(cl-incf split-count)
(apply substring-function args)))
((symbol-function 'mapconcat)
(lambda (&rest args)
(cl-incf join-count)
(apply join-function args))))
(setq actual (ebox--lines-pad-vertical input 1)))
(should (equal-including-properties input actual))
(ert-info ((format "input=%S substrings=%d joins=%d" input split-count join-count))
(should (= split-count 0))
(should (= join-count 0)))))))
(ert-deftest ebox-vertical-materialization-preserves-properties-and-ownership ()
"Padding/clipping output matches the old helper and never aliases inputs."
(let* ((map (make-sparse-keymap))
(_key (define-key map [mouse-1] #'ignore))
(single (propertize "Open" 'keymap map 'mouse-face 'highlight
'help-echo "kept" 'face '(:foreground "#123456")
'ebox-content 17 'ebox-content-idx 0
'ebox-content-owner 18 'ebox-content-owners '(18 17)))
(newline (propertize "\n" 'help-echo "newline only" 'ebox-content-owner 99))
(multi (concat single newline (propertize "tail" 'ebox-content-owner 19)))
(padding (propertize "_" 'display '(space :width (13))
'ebox-content-owner 23 'help-echo "padding")))
(dolist (input (list nil "" single multi (concat multi newline) "\n" "\n\n"))
(dolist (height '(0 1 2 4))
(dolist (offset '(nil -9 -1 0 1 9))
(dolist (fill (list nil "" padding))
(let* ((before (and input (copy-sequence input)))
(before-fill (and fill (copy-sequence fill)))
(expected (ebox-vertical-test--previous-pad input height offset fill))
(actual (ebox--lines-pad-vertical input height offset fill)))
(ert-info ((format "input=%S height=%S offset=%S fill=%S"
input height offset fill))
(should (equal-including-properties actual expected))
(when (and (eq input single) (= height 1))
(should (eq (get-text-property 0 'keymap actual) map)))
(when (> (length actual) 0)
(put-text-property 0 1 'help-echo "output-only" actual)
(aset actual 0 ?Z))
(should (equal-including-properties input before))
(should (equal-including-properties fill before-fill))))))))))
(ert-deftest ebox-vertical-materialization-keeps-nil-and-newline-semantics ()
"Nil still needs a real line; joining multiline text drops newline props."
(let* ((input (concat "A" (propertize "\n" 'help-echo "newline") "B\n"))
(output (ebox--lines-pad-vertical input 3)))
(should (equal output "A\nB\n"))
(should-not (get-text-property 1 'help-echo output))
(should (equal (get-text-property 1 'help-echo input) "newline")))
(let ((blank (symbol-function 'ebox--pixel-blank))
(blank-count 0) actual)
(cl-letf (((symbol-function 'ebox--pixel-blank)
(lambda (&rest args)
(cl-incf blank-count)
(apply blank args))))
(setq actual (ebox--lines-pad-vertical nil 1)))
(should (= blank-count 1))
(should (equal-including-properties actual (ebox-vertical-test--previous-pad nil 1)))))
(ert-deftest ebox-vertical-materialization-preserves-alignment ()
"The existing alignment caller retains padding, offsets and clipping."
(dolist (input (list nil "" (propertize "A" 'ebox-content-owner 7) "A\nB\n"))
(dolist (height '(0 1 2 5))
(dolist (align '(top center bottom))
(let ((actual (ebox--lines-align-vertical input height align)) expected)
(cl-letf (((symbol-function 'ebox--lines-pad-vertical)
#'ebox-vertical-test--previous-pad))
(setq expected (ebox--lines-align-vertical input height align)))
(should (equal-including-properties actual expected)))))))
(provide 'ebox-vertical-materialization-tests)
;;; ebox-vertical-materialization-tests.el ends here