79f5bc23d1
Normalize size units and intrinsic sizing across Elisp and native layout. Add help, pointer, hover-style and keymap support with reusable interaction adapters. Keep content updates local, preserve scroll caches and hover borders, and avoid rebuilding retained plans and ownership metadata for stable geometry. Validation: make check and native-rust-tests passed; targeted native interaction and scroll publication regressions passed.
152 lines
8.1 KiB
EmacsLisp
152 lines
8.1 KiB
EmacsLisp
;;; 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) ("" 0)))
|
|
(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 (ebox-lines-join '(""))
|
|
(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
|