;;; ekp-buffer-tests.el --- Tests for ekp-buffer.el -*- lexical-binding: t; -*- ;;; Commentary: ;; Batch-safe ERT tests for the buffer-level justification layer. ;; Widths are always passed explicitly, so no window is required. ;;; Code: (require 'ert) (require 'ekp-buffer) (require 'ekp-showcase) (defconst ekp-buffer-test--samples (list "简单的中文段落测试内容,排版效果应当良好稳定。" "The quick brown fox jumps over the lazy dog several times today." "Mixed 中英文 paragraph with double spaces inside and a tail " "para one\n\npara two 混排 content here\nthird para" " leading indent 段落内容 preserved intact" "短\n\n\n多个空段落之间的内容") "Logical texts covering CJK, Latin, mixed, blanks, indent, tails.") (defconst ekp-buffer-test--widths '(30 80 200 400) "Pixel widths from emergency-narrow to comfortable.") (defmacro ekp-buffer-test--with-text (text &rest body) "Run BODY in a temp buffer containing TEXT." (declare (indent 1)) `(with-temp-buffer (insert ,text) ,@body)) ;;;; Text-property projection invariants (defun ekp-buffer-test--display-spec-p (name value) "Return non-nil when display VALUE contains a NAME specification." (or (and (consp value) (eq (car value) name)) (and (listp value) (seq-some (lambda (item) (and (consp item) (eq (car item) name))) value)))) (defun ekp-buffer-test--strings-in-tree (tree) "Return all strings contained anywhere in TREE." (let (strings) (cl-labels ((walk (value) (cond ((stringp value) (push value strings)) ((consp value) (walk (car value)) (walk (cdr value))) ((vectorp value) (dotimes (i (length value)) (walk (aref value i))))))) (walk tree)) (nreverse strings))) (ert-deftest ekp-buffer-test-layout-never-changes-source-characters () "Layout changes display properties, never the logical character stream." (let ((text "中文排版 mixed words with spaces and extraordinary wrapping")) (ekp-buffer-test--with-text text (buffer-enable-undo) (set-buffer-modified-p nil) (setq buffer-undo-list nil) (goto-char (+ (point-min) 7)) (let ((point-before (point)) (size-before (buffer-size)) (chars-tick (buffer-chars-modified-tick)) (undo-before buffer-undo-list)) (ekp-justify-region (point-min) (point-max) 24) (should (equal (substring-no-properties (buffer-string)) text)) (should (= (buffer-size) size-before)) (should (= (point) point-before)) (should (= (buffer-chars-modified-tick) chars-tick)) (should (eq buffer-undo-list undo-before)) (should-not (buffer-modified-p)) (should-not (overlays-in (point-min) (point-max))))))) (ert-deftest ekp-buffer-test-overlong-no-break-preserves-atom () "A rigid overflow atom remains intact in the public projection." (let* ((prefix "行内原子演示:代码片段 ") (atom (propertize (concat (make-string 48 ?a) " b") 'ekp-no-break t)) (text (concat prefix atom " 后文继续。")) (ekp-use-c-module nil)) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 40) (let* ((breaks (ekp-buffer-test--display-newline-positions)) (atom-beg (+ (point-min) (length prefix))) (atom-end (+ atom-beg (length atom)))) (should breaks) (should-not (seq-some (lambda (position) (and (> position atom-beg) (< position atom-end))) breaks))) (should (equal (substring-no-properties (buffer-string)) (substring-no-properties text))) (should (get-text-property (+ (point-min) (length prefix)) 'ekp-no-break))))) (ert-deftest ekp-buffer-test-projection-fires-no-external-change-hooks () "Projection installation and removal are silent to external change hooks." (ekp-buffer-test--with-text "silent projection hooks 中文 mixed paragraph long enough" (let ((before 0) (after 0)) (add-hook 'before-change-functions (lambda (&rest _) (setq before (1+ before))) nil t) (add-hook 'after-change-functions (lambda (&rest _) (setq after (1+ after))) nil t) (ekp-justify-region (point-min) (point-max) 20) (ekp-unjustify-region (point-min) (point-max)) (should (= before 0)) (should (= after 0)) (goto-char (point-max)) (insert "x") (should (= before 1)) (should (= after 1))))) (ert-deftest ekp-buffer-test-owned-property-publishes-once () "A projection value and its owner marker are one property mutation." (ekp-buffer-test--with-text "owned" (let ((mutations 0) (put (symbol-function 'put-text-property)) (add (symbol-function 'add-text-properties)) (value '(space :width (4)))) (cl-letf (((symbol-function 'put-text-property) (lambda (beg end property new-value &optional object) (setq mutations (1+ mutations)) (funcall put beg end property new-value object))) ((symbol-function 'add-text-properties) (lambda (beg end properties &optional object) (setq mutations (1+ mutations)) (funcall add beg end properties object)))) (ekp-buffer--put-owned (point-min) (point-max) 'display 'ekp-buffer--display value)) (should (= mutations 1)) (should (equal (get-text-property (point-min) 'display) value)) (should (equal (get-text-property (point-min) 'ekp-buffer--display) value))))) (ert-deftest ekp-buffer-test-prepared-plan-installs-without-measuring () "Projection must consume gap geometry already prepared by the plan." (let ((text "中文 mixed paragraph with several spaces and CJK gaps")) (ekp-buffer-test--with-text text (let ((plan (ekp-layout-plan (buffer-substring (point-min) (point-max)) 18))) (cl-letf (((symbol-function 'ekp--measured-width) (lambda (&rest _) (error "projection measured prepared geometry")))) (should (ekp-buffer--projectable-p plan (point-min) (point-min) (point-max))) (ekp-buffer--install-plan (point-min) (point-max) 18 plan)))))) (ert-deftest ekp-buffer-test-justify-accepts-reversed-bounds () "A reversed region receives the same projection as an ordered region." (let ((text "中文排版 mixed words need several visual lines")) (ekp-buffer-test--with-text text (ekp-justify-region (point-max) (point-min) 24) (should ekp-buffer--spans) (should (equal (substring-no-properties (buffer-string)) text)) (should-not (text-property-not-all (point-min) (point-max) 'ekp-justified 24))))) (ert-deftest ekp-buffer-test-ascii-glue-combines-space-and-min-width () "Existing ASCII spaces use `space-width' plus an exact `min-width' floor." (ekp-buffer-test--with-text "aa bb cc dd ee ff" (ekp-justify-region (point-min) (point-max) 12) (goto-char (point-min)) (should (search-forward " " nil t)) (let ((display (get-text-property (1- (point)) 'display))) (pcase display (`((space-width ,factor) (min-width ((,target)))) (should (numberp factor)) (should (> factor 0)) (should (integerp target)) (should (> target 0))) (_ (ert-fail (format "Unexpected ASCII glue display: %S" display))))))) (ert-deftest ekp-buffer-test-cjk-zero-source-glue-uses-min-width () "CJK glue pads an existing grapheme and inserts no source space." (let ((text "中文排版测试内容足够长")) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 11) (should (equal (substring-no-properties (buffer-string)) text)) (should (seq-some (lambda (pos) (pcase (get-text-property pos 'display) (`(min-width ((,target))) (and (integerp target) (> target 0))))) (number-sequence (point-min) (1- (point-max)))))))) (ert-deftest ekp-buffer-test-hyphen-and-break-are-display-only () "A discretionary hyphen and newline live in `display', not source text." (let ((text "extraordinary hyphenation demonstration paragraph")) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 16) (should (equal (substring-no-properties (buffer-string)) text)) (should (= (cl-count ?\n (buffer-string)) 0)) (should-not (string-match-p "-" (substring-no-properties (buffer-string)))) (should (seq-some (lambda (pos) (let ((display (get-text-property pos 'display))) (and (stringp display) (string-match-p "-\n" (substring-no-properties display))))) (number-sequence (point-min) (1- (point-max)))))))) (ert-deftest ekp-buffer-test-indentation-uses-line-prefix () "First-line indentation is a `line-prefix' projection." (let ((ekp-first-line-indent 6)) (ekp-buffer-test--with-text "首行缩进测试内容足够长会形成多行" (ekp-justify-region (point-min) (point-max) 18) (let ((prefix (get-text-property (point-min) 'line-prefix))) (should (stringp prefix)) (should (equal (get-text-property 0 'display prefix) '(space :width (6))))) (should (equal (substring-no-properties (buffer-string)) "首行缩进测试内容足够长会形成多行"))))) (ert-deftest ekp-buffer-test-foreign-display-conflict-is-preserved () "EKP keeps a paragraph verbatim instead of stealing foreign display state." (ekp-buffer-test--with-text "foreign display paragraph must stay intact" (put-text-property 9 16 'display "VISIBLE") (let ((before (buffer-substring (point-min) (point-max)))) (ekp-justify-region (point-min) (point-max) 12) (should (equal-including-properties (buffer-substring (point-min) (point-max)) before)) (should ekp-buffer--conflicts)))) (ert-deftest ekp-buffer-test-foreign-projection-owners-stay-verbatim () "Every uncomposable foreign projection owner remains exact." (dolist (entry '((line-prefix . "P") (wrap-prefix . "W") (composition . ((1))) (invisible . foreign))) (ekp-buffer-test--with-text "foreign owner paragraph must stay property-identical" (put-text-property 4 8 (car entry) (cdr entry)) (let ((before (buffer-substring (point-min) (point-max)))) (ekp-justify-region (point-min) (point-max) 12) (should-not ekp-buffer--spans) (should (equal-including-properties (buffer-substring (point-min) (point-max)) before)) (should (string-match-p (format "foreign `%s' property" (car entry)) (caddr (car ekp-buffer--conflicts)))))))) ;;;; Roundtrip exactness (ert-deftest ekp-buffer-test-roundtrip-exact () "justify + unjustify restores text and properties exactly." (dolist (text ekp-buffer-test--samples) (dolist (w ekp-buffer-test--widths) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) w) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text)))))) (ert-deftest ekp-buffer-test-roundtrip-propertized () "Roundtrip preserves user text properties." (let ((text (concat (propertize "加粗的中文开头内容" 'face 'bold) " plain middle part " (propertize "italic tail words" 'face 'italic)))) (dolist (w '(60 250)) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) w) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text)))))) (ert-deftest ekp-buffer-test-hard-newlines-preserved () "Hard newline count survives justification." (ekp-buffer-test--with-text "a 段落 one\n\nb 段落 two\nc 段落 three" (ekp-justify-region (point-min) (point-max) 100) (let ((hard 0)) (goto-char (point-min)) (while (search-forward "\n" nil t) (unless (get-text-property (match-beginning 0) 'ekp-soft-break) (setq hard (1+ hard)))) (should (= hard 3))))) ;;;; Justified-state invariants (ert-deftest ekp-buffer-test-justified-marked () "Justified region carries the ekp-justified width property." (ekp-buffer-test--with-text "中文内容需要标记属性验证正确性" (ekp-justify-region (point-min) (point-max) 120) (should (eq (get-text-property (point-min) 'ekp-justified) 120)) (should-not (text-property-not-all (point-min) (point-max) 'ekp-justified 120)))) (ert-deftest ekp-buffer-test-rejustify-idempotent () "Justifying at a new width equals a fresh justification at that width." (let ((text "The idempotence check 中英混排 must hold across widths.")) (let (fresh) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 150) (setq fresh (buffer-string))) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 300) (ekp-justify-region (point-min) (point-max) 150) (should (equal-including-properties (buffer-string) fresh)))))) ;;;; Edit robustness (ert-deftest ekp-buffer-test-edit-then-unjustify () "Text typed into a justified buffer survives unjustification." (ekp-buffer-test--with-text "abcdef ghijkl 中文内容 mnopqr stuvwx" (ekp-justify-region (point-min) (point-max) 80) ;; Insert inside the first word: physical == logical there. (goto-char (+ (point-min) 2)) (insert "XY") (ekp-unjustify-region (point-min) (point-max)) (should (equal (buffer-string) "abXYcdef ghijkl 中文内容 mnopqr stuvwx")))) (ert-deftest ekp-buffer-test-point-stable () "Point returns to its logical position after a roundtrip." (ekp-buffer-test--with-text "abcdef ghijkl mnopqr stuvwx yzabcd" (goto-char (+ (point-min) 9)) ; inside "ghijkl" (ekp-justify-region (point-min) (point-max) 60) (ekp-unjustify-region (point-min) (point-max)) (should (= (point) (+ (point-min) 9))))) (ert-deftest ekp-buffer-test-inactive-mark-stays-inactive () "Reprojection preserves an existing inactive mark without selecting text." (ekp-buffer-test--with-text "showcase width changes must not activate an old mark" (goto-char (+ (point-min) 12)) (set-marker (mark-marker) (+ (point-min) 3)) (setq mark-active nil) (let ((point-before (point)) (mark-before (mark t))) (ekp-justify-region (point-min) (point-max) 40) (should (= (point) point-before)) (should (= (mark t) mark-before)) (should-not mark-active)))) (ert-deftest ekp-buffer-test-active-region-stays-active () "Reprojection preserves an intentional active region." (ekp-buffer-test--with-text "an intentional region remains active across width changes" (set-mark (+ (point-min) 3)) (goto-char (+ (point-min) 18)) (activate-mark) (let ((point-before (point)) (mark-before (mark t))) (ekp-justify-region (point-min) (point-max) 40) (should (= (point) point-before)) (should (= (mark t) mark-before)) (should mark-active) (should (use-region-p))))) ;;;; Auto-justify mode (defmacro ekp-buffer-test--with-mode (text width &rest body) "Enable `ekp-auto-justify-mode' on TEXT at WIDTH, run BODY, disable." (declare (indent 2)) `(ekp-buffer-test--with-text ,text (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) ,width))) (ekp-auto-justify-mode 1) (unwind-protect (progn ,@body) (ekp-auto-justify-mode -1))))) (defun ekp-buffer-test--display-newline-positions () "Return positions whose EKP-owned display value contains a newline." (let ((pos (point-min)) positions) (while (< pos (point-max)) (let* ((display (get-text-property pos 'ekp-buffer--display)) (next (or (next-single-property-change pos 'ekp-buffer--display nil (point-max)) (point-max)))) (when (and (stringp display) (string-match-p "\n" (substring-no-properties display))) (push pos positions)) (setq pos next))) (nreverse positions))) (defun ekp-buffer-test--display-lines () "Return source slices separated by EKP-owned display newlines." (let ((beg (point-min)) (pos (point-min)) lines) (while (< pos (point-max)) (let ((display (get-text-property pos 'ekp-buffer--display))) (when (and (stringp display) (string-match-p "\n" (substring-no-properties display))) (push (buffer-substring-no-properties beg (1+ pos)) lines) (setq beg (1+ pos)))) (setq pos (1+ pos))) (push (buffer-substring-no-properties beg (point-max)) lines) (nreverse lines))) (defun ekp-buffer-test--single-cjk-line-p (line) "Return non-nil when LINE is exactly one CJK source character." (let ((trimmed (replace-regexp-in-string "\\`[[:space:]\n\r\t]+\\|[[:space:]\n\r\t]+\\'" "" line))) (and (= (length trimmed) 1) (let ((char (aref trimmed 0))) (and (<= #x4E00 char) (<= char #x9FFF)))))) (defun ekp-buffer-test--display-hyphen-p () "Return non-nil when an EKP-owned display break publishes a hyphen." (let ((pos (point-min)) hit) (while (and (< pos (point-max)) (not hit)) (let ((display (get-text-property pos 'ekp-buffer--display))) (setq hit (and (stringp display) (string-match-p "-\n" (substring-no-properties display))))) (setq pos (1+ pos))) hit)) (defun ekp-buffer-test--type-string (string) "Insert STRING through the public self-insert command path." (mapc (lambda (character) (let ((last-command-event character)) (call-interactively #'self-insert-command))) (string-to-list string))) (defun ekp-buffer-test--semantic-plan (text width min-lines) "Return TEXT's plan at WIDTH, requiring at least MIN-LINES lines." (let* ((plan (ekp-layout-plan text width)) (lines (ekp-layout-plan-lines plan))) (should (>= (length lines) min-lines)) plan)) (defun ekp-buffer-test--line-at (plan index) "Return semantic line INDEX from PLAN." (aref (ekp-layout-plan-lines plan) index)) (defun ekp-buffer-test--any-owned-layout-p (beg end) "Return non-nil when BEG through END has EKP-owned projection." (and (< beg end) (or (text-property-not-all beg end 'ekp-justified nil) (text-property-not-all beg end 'ekp-buffer--display nil) (text-property-not-all beg end 'ekp-buffer--line-prefix nil)))) (defun ekp-buffer-test--assert-natural-range (beg end) "Assert BEG through END carries no EKP live projection properties." (when (< beg end) (dolist (property '(ekp-justified ekp-buffer--display ekp-buffer--line-prefix)) (should-not (text-property-not-all beg end property nil))))) (defun ekp-buffer-test--live-active-beg () "Return the source beginning of the current natural semantic line." (let* ((state ekp-buffer--live-state) (plan (ekp-buffer--live-state-plan state)) (active (ekp-buffer--live-state-active-index state)) (base (marker-position (ekp-buffer--live-state-beg state))) (line (ekp-buffer-test--line-at plan active))) (+ base (ekp-layout-line-source-start line)))) (defun ekp-buffer-test--first-space-break-line (plan) "Return the first semantic line in PLAN whose break consumes spaces." (let ((lines (ekp-layout-plan-lines plan)) found) (dotimes (index (length lines)) (let ((line (aref lines index))) (when (and (not found) (eq (ekp-layout-line-break-kind line) 'space) (< (ekp-layout-line-break-source-start line) (ekp-layout-line-break-source-end line))) (setq found line)))) (should found) found)) (ert-deftest ekp-buffer-test-live-edge-whitespace-is-immediately-visible () "One self-inserted edge whitespace stays natural on the active line." (dolist (case '(("alpha beta gamma" end ?\s) ("alpha beta gamma" beginning ?\s) ("alpha beta gamma" end ?\t) ("中文排版测试" end ?\s))) (pcase-let ((`(,text ,where ,character) case)) (ekp-buffer-test--with-mode text 16 (goto-char (if (eq where 'end) (point-max) (point-min))) (let ((last-command-event character)) (call-interactively #'self-insert-command)) (should (= (char-before) character)) (should-not (get-text-property (1- (point)) 'ekp-buffer--display)) (should-not (get-text-property (1- (point)) 'display)))))) (ert-deftest ekp-buffer-test-live-deletion-exposes-trailing-space () "Deleting the final glyph leaves the preceding source space visible." (ekp-buffer-test--with-mode "alpha beta x" 16 (goto-char (point-max)) (delete-char -1) (should (eq (char-before) ?\s)) (should-not (get-text-property (1- (point)) 'ekp-buffer--display)) (should-not (get-text-property (1- (point)) 'display)) (should ekp-buffer--live-edit))) (ert-deftest ekp-buffer-test-live-consecutive-spaces-survive-backspace () "Backspacing a following glyph leaves both typed spaces visible." (ekp-buffer-test--with-mode "alpha beta" 16 (goto-char (point-max)) (dolist (character '(?\s ?\s ?x)) (let ((last-command-event character)) (call-interactively #'self-insert-command))) (call-interactively #'delete-backward-char) (should (string-suffix-p " " (buffer-string))) (dolist (position (list (- (point) 2) (1- (point)))) (should-not (get-text-property position 'ekp-buffer--display)) (should-not (get-text-property position 'display))) (should ekp-buffer--live-edit) (should-not (overlays-in (point-min) (point-max))))) (ert-deftest ekp-buffer-test-live-yank-trailing-space-is-natural () "Yanking text with a trailing space publishes it without hiding it." (let ((kill-ring nil) kill-ring-yank-pointer) (ekp-buffer-test--with-mode "alpha beta" 16 (goto-char (point-max)) (kill-new " pasted ") (call-interactively #'yank) (should (equal (substring-no-properties (buffer-string)) "alpha beta pasted ")) (should-not (get-text-property (1- (point)) 'ekp-buffer--display)) (should-not (get-text-property (1- (point)) 'display)) (should-not ekp-buffer--live-edit)))) (ert-deftest ekp-buffer-test-live-newline-then-space-is-natural () "A space on a newly created hard line is visible immediately." (ekp-buffer-test--with-mode "alpha beta" 16 (goto-char (point-max)) (call-interactively #'newline) (let ((last-command-event ?\s)) (call-interactively #'self-insert-command)) (should (string-suffix-p "\n " (buffer-string))) (should-not (get-text-property (1- (point)) 'ekp-buffer--display)) (should-not (get-text-property (1- (point)) 'display)) (should ekp-buffer--live-edit))) (ert-deftest ekp-buffer-test-live-single-space-undo-restores-breaks () "Undoing one edge space restores source and prior visual breaks." (ekp-buffer-test--with-mode "alpha beta gamma delta" 16 (buffer-enable-undo) (setq buffer-undo-list nil) (let ((text (substring-no-properties (buffer-string))) (breaks (ekp-buffer-test--display-newline-positions))) (goto-char (point-max)) (undo-boundary) (let ((last-command-event ?\s)) (call-interactively #'self-insert-command)) (undo-boundary) (undo-only 1) (should (equal (substring-no-properties (buffer-string)) text)) (should (equal (ekp-buffer-test--display-newline-positions) breaks)) (should-not ekp-buffer--live-edit) (should-not (overlays-in (point-min) (point-max)))))) (ert-deftest ekp-buffer-test-live-single-line-quick-proof-does-no-layout-work () "Typing a provably single semantic line neither plans nor projects." (ekp-buffer-test--with-mode "" 1000 (let ((calls 0) (original (symbol-function 'ekp-layout-plan))) (cl-letf (((symbol-function 'ekp-layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments)))) (mapc (lambda (character) (let ((last-command-event character)) (call-interactively #'self-insert-command))) (string-to-list "natural mixed 中文 editing")) (should (= calls 0)))) (dolist (property '(ekp-justified ekp-buffer--display ekp-buffer--line-prefix)) (should-not (text-property-not-all (point-min) (point-max) property nil))) (should-not (overlays-in (point-min) (point-max))))) (ert-deftest ekp-buffer-test-live-projects-prefix-before-last-plan-line () "Point in the last semantic line projects only earlier plan lines." (let* ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (width 20) (plan (ekp-buffer-test--semantic-plan text width 3)) (lines (ekp-layout-plan-lines plan)) (last-line (ekp-buffer-test--line-at plan (1- (length lines)))) (active-beg (+ (point-min) (ekp-layout-line-source-start last-line)))) (ekp-buffer-test--with-mode "" width (ekp-buffer-test--type-string text) (should (ekp-buffer-test--any-owned-layout-p (point-min) active-beg)) (ekp-buffer-test--assert-natural-range active-beg (point-max)) (should-not (overlays-in (point-min) (point-max))) (should (equal (substring-no-properties (buffer-string)) text))))) (ert-deftest ekp-buffer-test-live-middle-edit-preserves-unaffected-anchors () "A middle-line edit naturalizes one island without clearing later anchors." (let* ((text (concat "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu " "nu xi omicron pi rho sigma tau upsilon phi chi psi omega")) (width 20) (plan (ekp-buffer-test--semantic-plan text width 4)) (middle (ekp-buffer-test--line-at plan 1)) (point-offset (1+ (ekp-layout-line-source-start middle))) (expected (concat (substring text 0 point-offset) "X" (substring text point-offset))) (calls 0) (original (symbol-function 'ekp-layout-plan))) (ekp-buffer-test--with-mode "" width (ekp-buffer-test--type-string text) (ekp-buffer--commit-live-paragraph) (let* ((spans (ekp-buffer--live-state-spans ekp-buffer--live-state)) (dirty (nth 1 spans)) (later (nth 2 spans)) (later-beg (copy-marker (marker-position (ekp-buffer--span-beg later)))) (later-end (copy-marker (marker-position (ekp-buffer--span-end (car (last spans)))) t)) (later-projection (buffer-substring later-beg later-end))) (unwind-protect (cl-letf (((symbol-function 'ekp-layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments)))) (goto-char (+ (point-min) point-offset)) (let ((last-command-event ?X)) (call-interactively #'self-insert-command)) (should (= calls 0)) (ekp-buffer-test--assert-natural-range (marker-position (ekp-buffer--span-beg dirty)) (marker-position (ekp-buffer--span-end dirty))) (should (equal-including-properties (buffer-substring later-beg later-end) later-projection))) (set-marker later-beg nil) (set-marker later-end nil))) (should (equal (substring-no-properties (buffer-string)) expected))))) (ert-deftest ekp-buffer-test-live-break-space-belongs-to-previous-owner-line () "Editing break whitespace makes its semantic owner line natural." (let* ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (width 20) (plan (ekp-buffer-test--semantic-plan text width 3)) (line (ekp-buffer-test--first-space-break-line plan)) (offset (ekp-layout-line-break-source-start line)) (expected (concat (substring text 0 offset) "X" (substring text offset)))) (ekp-buffer-test--with-mode "" width (ekp-buffer-test--type-string text) (should (ekp-buffer-test--any-owned-layout-p (point-min) (point-max))) (goto-char (+ (point-min) offset)) (let ((last-command-event ?X)) (call-interactively #'self-insert-command)) (ekp-buffer-test--assert-natural-range (ekp-buffer-test--live-active-beg) (point-max)) (should (equal (substring-no-properties (buffer-string)) expected))))) (ert-deftest ekp-buffer-test-live-leading-space-belongs-to-first-line () "Editing leading space naturalizes its row and keeps later anchors." (let ((text " alpha beta gamma delta epsilon zeta eta theta iota kappa lambda") (width 20)) (ekp-buffer-test--semantic-plan text width 3) (ekp-buffer-test--with-mode "" width (ekp-buffer-test--type-string text) (ekp-buffer--commit-live-paragraph) (should (ekp-buffer-test--any-owned-layout-p (point-min) (point-max))) (let* ((spans (ekp-buffer--live-state-spans ekp-buffer--live-state)) (first (car spans)) (later (cadr spans))) (goto-char (point-min)) (let ((last-command-event ?X)) (call-interactively #'self-insert-command)) (should ekp-buffer--live-edit) (ekp-buffer-test--assert-natural-range (marker-position (ekp-buffer--span-beg first)) (marker-position (ekp-buffer--span-end first))) (should (get-text-property (marker-position (ekp-buffer--span-beg later)) 'ekp-justified))) (should (equal (substring-no-properties (buffer-string)) (concat "X" text)))))) (ert-deftest ekp-buffer-test-live-earlier-breaks-are-not-frozen () "Later edits can invalidate an earlier semantic line signature." (let* ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (prefix "extraordinarysuperlong ") (width 20) (old-plan (ekp-buffer-test--semantic-plan text width 3)) (new-plan (ekp-buffer-test--semantic-plan (concat prefix text) width 3)) (old-signature (ekp-layout-line-signature (ekp-buffer-test--line-at old-plan 0))) (new-signature (ekp-layout-line-signature (ekp-buffer-test--line-at new-plan 0)))) (should-not (equal old-signature new-signature)) (ekp-buffer-test--with-mode "" width (ekp-buffer-test--type-string text) (should (ekp-buffer-test--any-owned-layout-p (point-min) (point-max))) (let ((old-breaks (ekp-buffer-test--display-newline-positions))) (goto-char (point-min)) (ekp-buffer-test--type-string prefix) (goto-char (point-max)) (run-hooks 'post-command-hook) (should-not (equal old-breaks (ekp-buffer-test--display-newline-positions))) (should (equal (substring-no-properties (buffer-string)) (concat prefix text))))))) (ert-deftest ekp-buffer-test-live-same-plan-does-not-rewrite-properties () "Posting the same plan/prefix boundary performs zero owned writes." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (width 20) (writes 0) (put (symbol-function 'put-text-property)) (remove (symbol-function 'remove-text-properties))) (ekp-buffer-test--semantic-plan text width 3) (ekp-buffer-test--with-mode "" width (ekp-buffer-test--type-string text) (should (ekp-buffer-test--any-owned-layout-p (point-min) (point-max))) (buffer-enable-undo) (setq buffer-undo-list nil) (set-buffer-modified-p nil) (let ((chars-tick (buffer-chars-modified-tick)) (undo-before buffer-undo-list)) (cl-letf (((symbol-function 'put-text-property) (lambda (beg end property value &optional object) (when (memq property '(ekp-justified display line-prefix)) (setq writes (1+ writes))) (funcall put beg end property value object))) ((symbol-function 'remove-text-properties) (lambda (beg end properties &optional object) (when (seq-some (lambda (property) (memq property '(ekp-justified display line-prefix))) properties) (setq writes (1+ writes))) (funcall remove beg end properties object)))) (run-hooks 'post-command-hook)) (should (= writes 0)) (should (= (buffer-chars-modified-tick) chars-tick)) (should-not (buffer-modified-p)) (should (eq buffer-undo-list undo-before)))))) (ert-deftest ekp-buffer-test-live-same-row-edit-keeps-committed-projection () "Ordinary same-row input neither replans nor rewrites the committed prefix." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (width 20) (calls 0) (original (symbol-function 'ekp-layout-plan))) (ekp-buffer-test--with-mode text width (let* ((state ekp-buffer--live-state) (prefix-end (copy-marker (marker-position (ekp-buffer--live-state-prefix-end state)))) (projection (buffer-substring (point-min) prefix-end))) (unwind-protect (cl-letf (((symbol-function 'ekp-layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments)))) (goto-char (1+ (marker-position (ekp-buffer--live-state-prefix-end state)))) (let ((last-command-event ?x)) (call-interactively #'self-insert-command)) (should (= calls 0)) (should (eq ekp-buffer--live-state state)) (should ekp-buffer--live-edit) (should (equal-including-properties (buffer-substring (point-min) prefix-end) projection))) (set-marker prefix-end nil)))))) (ert-deftest ekp-buffer-test-live-wrap-crossing-is-one-atomic-commit () "Typing across one native row boundary plans once, not after every key." (let ((calls 0) (original (symbol-function 'ekp-layout-plan))) (ekp-buffer-test--with-mode "" 20 (cl-letf (((symbol-function 'ekp-layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments)))) (ekp-buffer-test--type-string "alpha beta gamma delt") (should (= calls 1)) (should (ekp-buffer-test--any-owned-layout-p (point-min) (point-max))) (ekp-buffer-test--type-string "a") (should (= calls 1)) (should-not (get-text-property (1- (point)) 'ekp-buffer--display)))))) (ert-deftest ekp-buffer-test-live-native-append-bridge-respects-setting () "Native live append is optional and falls back to the Elisp engine." (skip-unless (and (fboundp #'ekp-c-module-load) (ignore-errors (ekp-c-module-load)) (bound-and-true-p ekp-c-module-loaded))) (let (disabled-lines enabled-lines) (dolist (enabled '(nil t)) (let ((ekp-use-c-module nil) (ekp-auto-justify-native-append enabled) (calls 0)) (ekp-buffer-test--with-mode "alpha beta gamma delt" 20 (let ((original (symbol-function 'ekp-c-break-with-arrays))) (cl-letf (((symbol-function 'ekp-c-break-with-arrays) (lambda (&rest arguments) (cl-incf calls) (apply original arguments)))) (goto-char (point-max)) (ekp-buffer-test--type-string "a long continuation with more words"))) (if enabled (progn (should (> calls 0)) (setq enabled-lines (ekp-buffer-test--display-lines))) (should (= calls 0)) (setq disabled-lines (ekp-buffer-test--display-lines)))))) (should (equal enabled-lines disabled-lines)))) (ert-deftest ekp-buffer-test-live-backward-wrap-crossing-stays-local () "Deleting into the previous native row keeps the live transaction local." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (calls 0) (original (symbol-function 'ekp-layout-plan))) (ekp-buffer-test--with-mode text 20 (goto-char (point-max)) (insert " xyz") (ekp-buffer--commit-live-paragraph) (let ((size-before (buffer-size))) (cl-letf (((symbol-function 'ekp-buffer--native-row-start) (lambda (_) (if (= (buffer-size) size-before) 40 20))) ((symbol-function 'ekp-layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments)))) (call-interactively #'delete-backward-char) (should (= calls 0)) (should ekp-buffer--live-edit) (should (equal (substring-no-properties (buffer-string)) (concat text " xy")))))))) (ert-deftest ekp-buffer-test-live-reversible-edit-restores-exact-baseline () "Deleting and reinserting one space restores the exact committed state." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu")) (ekp-buffer-test--with-mode text 20 (let* ((state ekp-buffer--live-state) (spans (ekp-buffer--live-state-spans state)) (middle (nth 1 spans)) (beg (marker-position (ekp-buffer--span-beg middle))) (end (marker-position (ekp-buffer--span-end middle))) (space (save-excursion (goto-char beg) (search-forward " " end t))) (baseline (buffer-substring (point-min) (point-max))) (plan (ekp-buffer--live-state-plan state)) (signatures (ekp-buffer--live-state-signatures state))) (should space) (goto-char (1- space)) (delete-char 1) (should ekp-buffer--live-edit) (should (equal-including-properties (ekp-buffer--live-edit-baseline-source ekp-buffer--live-edit) baseline)) (should (eq (ekp-buffer--live-edit-baseline-plan ekp-buffer--live-edit) plan)) (should (eq (ekp-buffer--live-edit-baseline-signatures ekp-buffer--live-edit) signatures)) (should (eq (ekp-buffer--live-edit-baseline-spans ekp-buffer--live-edit) spans)) (let ((last-command-event ?\s)) (call-interactively #'self-insert-command)) (should-not ekp-buffer--live-edit) (should (eq ekp-buffer--live-state state)) (should (eq (ekp-buffer--live-state-plan state) plan)) (should (eq (ekp-buffer--live-state-signatures state) signatures)) (should (eq (ekp-buffer--live-state-spans state) spans)) (should (equal-including-properties (buffer-substring (point-min) (point-max)) baseline)))))) (ert-deftest ekp-buffer-test-live-source-rebuilds-only-dirty-island () "A live source rebuild must not rescan the projected paragraph." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu")) (ekp-buffer-test--with-mode text 20 (let* ((middle (nth 1 (ekp-buffer--live-state-spans ekp-buffer--live-state))) (beg (marker-position (ekp-buffer--span-beg middle))) (end (marker-position (ekp-buffer--span-end middle))) (space (save-excursion (goto-char beg) (search-forward " " end t))) (logical-substring (symbol-function 'ekp-buffer--logical-substring)) (rescans 0)) (should space) (goto-char (1- space)) (delete-char 1) (should ekp-buffer--live-edit) (cl-letf (((symbol-function 'ekp-buffer--logical-substring) (lambda (&rest arguments) (setq rescans (1+ rescans)) (apply logical-substring arguments)))) (should (equal-including-properties (ekp-buffer--current-live-source) (ekp-buffer--logical-substring (point-min) (point-max))))) (should (= rescans 1)))))) (ert-deftest ekp-buffer-test-point-leaving-paragraph-is-zero-work () "Cursor motion across hard lines cannot commit or rewrite live state." (let ((text (concat "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu" "\nsecond paragraph")) (calls 0) (writes 0) (original (symbol-function 'ekp-layout-plan)) (put (symbol-function 'put-text-property)) (remove (symbol-function 'remove-text-properties))) (ekp-buffer-test--with-mode text 20 (goto-char (point-min)) (let ((last-command-event ?x)) (call-interactively #'self-insert-command)) (let ((state ekp-buffer--live-state) (transaction ekp-buffer--live-edit) (projection (buffer-substring (point-min) (point-max)))) (cl-letf (((symbol-function 'ekp-layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments))) ((symbol-function 'put-text-property) (lambda (beg end property value &optional object) (when (memq property '(ekp-justified display line-prefix)) (setq writes (1+ writes))) (funcall put beg end property value object))) ((symbol-function 'remove-text-properties) (lambda (beg end properties &optional object) (when (seq-some (lambda (property) (memq property '(ekp-justified display line-prefix))) properties) (setq writes (1+ writes))) (funcall remove beg end properties object)))) (goto-char (point-max)) (run-hooks 'post-command-hook) (should (= calls 0)) (should (= writes 0)) (should (eq ekp-buffer--live-state state)) (should (eq ekp-buffer--live-edit transaction)) (should (equal-including-properties (buffer-substring (point-min) (point-max)) projection))))))) (ert-deftest ekp-buffer-test-live-point-motion-preserves-projection () "Moving point within one hard line changes no live layout state." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (width 20) (calls 0) (key-calls 0) (cache-gets 0) (writes 0) (original (symbol-function 'ekp-layout-plan)) (original-key (symbol-function 'ekp--para-key)) (original-get (symbol-function 'ekp-buffer--live-cache-get)) (put (symbol-function 'put-text-property)) (remove (symbol-function 'remove-text-properties))) (let* ((plan (ekp-buffer-test--semantic-plan text width 3)) (line (ekp-buffer-test--line-at plan 1)) (target-offset (1+ (ekp-layout-line-source-start line)))) (ekp-buffer-test--with-mode text width (goto-char (1+ (marker-position (ekp-buffer--live-state-prefix-end ekp-buffer--live-state)))) (cl-letf (((symbol-function 'ekp-layout-plan) (lambda (&rest args) (setq calls (1+ calls)) (apply original args))) ((symbol-function 'ekp--para-key) (lambda (&rest args) (setq key-calls (1+ key-calls)) (apply original-key args))) ((symbol-function 'ekp-buffer--live-cache-get) (lambda (key) (setq cache-gets (1+ cache-gets)) (funcall original-get key))) ((symbol-function 'put-text-property) (lambda (beg end property value &optional object) (when (memq property '(ekp-justified display line-prefix)) (setq writes (1+ writes))) (funcall put beg end property value object))) ((symbol-function 'remove-text-properties) (lambda (beg end properties &optional object) (when (seq-some (lambda (property) (memq property '(ekp-justified display line-prefix))) properties) (setq writes (1+ writes))) (funcall remove beg end properties object)))) (insert "x") (should (= calls 0)) (run-hooks 'post-command-hook) (let* ((state ekp-buffer--live-state) (transaction ekp-buffer--live-edit) (projection (buffer-substring (point-min) (point-max))) (active (ekp-buffer--live-state-active-index state)) (signatures (ekp-buffer--live-state-signatures state)) (spans (ekp-buffer--live-state-spans state)) (edit-end (ekp-buffer--live-edit-edit-end transaction)) (edit-position (marker-position edit-end)) (prefix-end (marker-position (ekp-buffer--live-state-prefix-end state))) (chars-tick (buffer-chars-modified-tick)) (undo-before buffer-undo-list)) (setq calls 0 key-calls 0 cache-gets 0 writes 0) (dolist (position (list (+ (point-min) target-offset) (point-max))) (goto-char position) (run-hooks 'post-command-hook) (should (eq ekp-buffer--live-state state)) (should (equal-including-properties (buffer-substring (point-min) (point-max)) projection)) (should (= (ekp-buffer--live-state-active-index state) active)) (should (eq (ekp-buffer--live-state-signatures state) signatures)) (should (eq (ekp-buffer--live-state-spans state) spans)) (should (eq ekp-buffer--live-edit transaction)) (should (eq (ekp-buffer--live-edit-edit-end transaction) edit-end)) (should (= (marker-position edit-end) edit-position)) (should (= (marker-position (ekp-buffer--live-state-prefix-end state)) prefix-end))) (should (= calls 0)) (should (= key-calls 0)) (should (= cache-gets 0)) (should (= writes 0)) (should (= (buffer-chars-modified-tick) chars-tick)) (should (eq buffer-undo-list undo-before)) (should (= (length (substring-no-properties (buffer-string))) (1+ (length text)))))))))) (ert-deftest ekp-buffer-test-live-reflow-commits-latest-edit-boundary () "Width reflow commits the edit boundary, never transient point." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu")) (ekp-buffer-test--with-mode text 20 (goto-char (1+ (marker-position (ekp-buffer--live-state-prefix-end ekp-buffer--live-state)))) (insert "x") (let ((edit-position (marker-position (ekp-buffer--live-edit-edit-end ekp-buffer--live-edit)))) (goto-char (point-min)) (run-hooks 'post-command-hook) (ekp-buffer--reflow (current-buffer) 16) (let* ((state ekp-buffer--live-state) (plan (ekp-buffer--live-state-plan state)) (line-count (length (ekp-layout-plan-lines plan)))) (should-not ekp-buffer--live-edit) (should (= (ekp-buffer--live-state-active-index state) line-count)) (should (= (marker-position (ekp-buffer--live-state-prefix-end state)) (marker-position (ekp-buffer--live-state-end state)))) (should (ekp-buffer--live-state-contains-p edit-position)) (should (= (point) (point-min)))))))) (ert-deftest ekp-buffer-test-live-plan-cache-is-bounded-and-contextual () "Historical live plans reuse equal keys and bound retained history." (ekp-buffer-test--with-text "" (let ((calls 0) (original (symbol-function 'ekp-layout-plan)) first) (setq ekp-buffer--live-plan-cache nil) (cl-letf (((symbol-function 'ekp-layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments)))) (setq first (ekp-buffer--live-plan-entry "alpha beta gamma" 40)) (should (eq (cdr first) (cdr (ekp-buffer--live-plan-entry "alpha beta gamma" 40)))) (should (= calls 1)) (ekp-buffer--live-plan-entry "alpha beta gamma" 41) (let ((styled (copy-sequence "alpha beta gamma"))) (put-text-property 0 5 'face 'bold styled) (ekp-buffer--live-plan-entry styled 40)) (should (= calls 3)) (let ((ekp-alignment 'center)) (ekp-buffer--live-plan-entry "alpha beta gamma" 40)) (should (= calls 4)) (dotimes (index 20) (ekp-buffer--live-plan-entry (format "cache paragraph %02d alpha beta" index) 40)) (should (= (length ekp-buffer--live-plan-cache) 16)) (should-not (seq-find (lambda (entry) (equal-including-properties (caar entry) "alpha beta gamma")) ekp-buffer--live-plan-cache)))))) (ert-deftest ekp-buffer-test-live-yank-projects-semantic-prefix-only () "One public yank projects completed semantic lines and keeps tail natural." (let* ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (width 20) (plan (ekp-buffer-test--semantic-plan text width 3)) (lines (ekp-layout-plan-lines plan)) (active (aref lines (1- (length lines)))) (active-beg (+ (point-min) (ekp-layout-line-source-start active))) (kill-ring nil) kill-ring-yank-pointer) (ekp-buffer-test--with-mode "" width (kill-new text) (call-interactively #'yank) (should (ekp-buffer-test--any-owned-layout-p (point-min) active-beg)) (ekp-buffer-test--assert-natural-range active-beg (point-max)) (should (equal (substring-no-properties (buffer-string)) text)) (should-not (overlays-in (point-min) (point-max)))))) (ert-deftest ekp-buffer-test-explicit-refill-survives-post-command () "Explicit full refill is not downgraded until the next source edit." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (width 20)) (ekp-buffer-test--with-mode text width (ekp-refill-paragraph) (should-not ekp-buffer--live-state) (let ((full-layout (buffer-substring (point-min) (point-max)))) (run-hooks 'post-command-hook) (should-not ekp-buffer--live-state) (should (equal-including-properties (buffer-substring (point-min) (point-max)) full-layout))) (goto-char (point-max)) (insert "x") (should ekp-buffer--live-state)))) (ert-deftest ekp-buffer-test-live-conflict-pulls-whole-hard-line-native () "A live foreign owner removes the entire affected hard-line prefix." (let ((text "first alpha beta gamma\nsecond delta epsilon zeta eta theta")) (ekp-buffer-test--with-mode text 20 (goto-char (point-min)) (search-forward "\n") (let* ((second-beg (point)) (foreign (+ second-beg 7)) (first-before (buffer-substring (point-min) (1- second-beg)))) (let ((ekp-buffer--inhibit t)) (with-silent-modifications (put-text-property foreign (1+ foreign) 'display "VISIBLE"))) (goto-char (point-max)) (insert "x") (ekp-buffer--commit-live-paragraph) (should (equal (get-text-property foreign 'display) "VISIBLE")) (ekp-buffer-test--assert-natural-range second-beg (point-max)) (should (equal-including-properties (buffer-substring (point-min) (1- second-beg)) first-before)) (should ekp-buffer--conflicts))))) (ert-deftest ekp-buffer-test-live-span-end-does-not-absorb-active-input () "A live semantic span ends before text inserted at its boundary." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu")) (ekp-buffer-test--with-mode "" 20 (ekp-buffer-test--type-string text) (let* ((span (car (ekp-buffer--live-state-spans ekp-buffer--live-state))) (end (ekp-buffer--span-end span))) (should (markerp end)) (should-not (marker-insertion-type end)))))) (ert-deftest ekp-buffer-test-live-install-error-rolls-back-all-spans () "A partial live install leaves no property or orphan span and re-signals." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") (calls 0) (original (symbol-function 'ekp-buffer--project-line))) (ekp-buffer-test--with-mode "" 20 (ekp-buffer-test--type-string text) (ekp-buffer--clear-live-projection (point-min) (point-max)) (setf (ekp-buffer--live-state-signatures ekp-buffer--live-state) nil (ekp-buffer--live-state-active-index ekp-buffer--live-state) nil) (cl-letf (((symbol-function 'ekp-buffer--project-line) (lambda (&rest arguments) (setq calls (1+ calls)) (when (= calls 2) (error "forced live install failure")) (apply original arguments)))) (should-error (ekp-buffer--publish-live-prefix) :type 'error)) (should (= calls 2)) (should-not ekp-buffer--spans) (should-not (ekp-buffer--live-state-spans ekp-buffer--live-state)) (ekp-buffer-test--assert-natural-range (point-min) (point-max))))) (ert-deftest ekp-buffer-test-live-crossing-size-limit-records-conflict () "A hard line that grows past the live limit fails closed with diagnosis." (let ((ekp-auto-justify-paragraph-limit 20)) (ekp-buffer-test--with-mode "" 1000 (ekp-buffer-test--type-string (make-string 21 ?a)) (ekp-buffer--commit-live-paragraph) (should-not ekp-buffer--spans) (ekp-buffer-test--assert-natural-range (point-min) (point-max)) (should (string-match-p "automatic paragraph limit" (caddr (car ekp-buffer--conflicts))))))) (ert-deftest ekp-buffer-test-live-teardown-releases-cache-and-markers () "Disabling live mode detaches its markers, cache, and projection." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu") markers) (ekp-buffer-test--with-text text (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 20)) ((symbol-function 'ekp-buffer--native-row-start) (lambda (_) (point-min)))) (ekp-auto-justify-mode 1) (goto-char (point-max)) (insert "x") (setq markers (append (list (ekp-buffer--live-state-beg ekp-buffer--live-state) (ekp-buffer--live-state-end ekp-buffer--live-state) (ekp-buffer--live-state-prefix-end ekp-buffer--live-state)) (list (ekp-buffer--live-edit-old-beg ekp-buffer--live-edit) (ekp-buffer--live-edit-dirty-beg ekp-buffer--live-edit) (ekp-buffer--live-edit-dirty-end ekp-buffer--live-edit) (ekp-buffer--live-edit-row-start ekp-buffer--live-edit) (ekp-buffer--live-edit-edit-end ekp-buffer--live-edit)))) (should ekp-buffer--live-plan-cache) (ekp-auto-justify-mode -1)) (should-not ekp-buffer--live-state) (should-not ekp-buffer--live-plan-cache) (dolist (marker markers) (should-not (marker-buffer marker))) (ekp-buffer-test--assert-natural-range (point-min) (point-max)) (should (equal (substring-no-properties (buffer-string)) (concat text "x")))))) (ert-deftest ekp-buffer-test-live-hard-newline-finalizes-previous-paragraph () "A hard newline permits full KP only for the completed paragraph." (ekp-buffer-test--with-mode "alpha beta gamma" 80 (goto-char (point-max)) (call-interactively #'newline) (let ((newline (1- (point)))) (should (get-text-property (point-min) 'ekp-justified)) (should-not (text-property-not-all (1+ newline) (point-max) 'ekp-justified nil)) (should-not (overlays-in (point-min) (point-max)))))) (ert-deftest ekp-buffer-test-live-edit-never-calls-whole-paragraph-command () "An ordinary live edit must not dispatch through `ekp-justify-region'." (ekp-buffer-test--with-mode "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda" 20 (let ((called nil) (original (symbol-function 'ekp-justify-region))) (cl-letf (((symbol-function 'ekp-justify-region) (lambda (&rest args) (setq called args) (apply original args)))) (goto-char (point-max)) (insert " x") (should-not called) (should ekp-buffer--live-edit))))) (ert-deftest ekp-buffer-test-live-composition-defers-and-cancels-stale-generation () "IME preedit defers projection and an older retry cannot publish." (let ((text "alpha beta gamma delta epsilon")) (ekp-buffer-test--with-mode text 16 (let ((buffer (current-buffer)) first-generation second-generation first-beg first-end second-beg second-end edit-end-marker) (cl-letf (((symbol-function 'ekp-buffer--composing-p) (lambda () t))) (goto-char (point-max)) (insert " x") (setq first-generation ekp-buffer--generation) (setq first-end (point) first-beg (- first-end 2)) (should ekp-buffer--live-edit) (should (timerp ekp-buffer--composition-timer)) (insert " y") (setq second-generation ekp-buffer--generation) (setq second-end (point) second-beg (- second-end 2) edit-end-marker (ekp-buffer--live-edit-edit-end ekp-buffer--live-edit)) (should (> second-generation first-generation)) (should (= (marker-position edit-end-marker) second-end)) (when (timerp ekp-buffer--composition-timer) (cancel-timer ekp-buffer--composition-timer) (setq ekp-buffer--composition-timer nil))) (goto-char (point-min)) (ekp-buffer--retry-composition buffer first-generation first-beg first-end) (should ekp-buffer--live-edit) (should (= (marker-position edit-end-marker) second-end)) (ekp-buffer--retry-composition buffer second-generation second-beg second-end) (should-not ekp-buffer--live-edit) (should-not (marker-buffer edit-end-marker)) (should (> (ekp-buffer--live-state-active-index ekp-buffer--live-state) 0)) (should (equal (substring-no-properties (buffer-string)) (concat text " x y"))))))) (ert-deftest ekp-buffer-test-live-next-edit-elsewhere-commits-quality-layout () "The next source edit elsewhere commits and detaches the prior hard line." (let ((text "alpha beta gamma delta epsilon\nsecond paragraph stays here")) (ekp-buffer-test--with-mode text 16 (cl-letf (((symbol-function 'ekp-buffer--native-row-start) (lambda (_) (line-beginning-position)))) (goto-char (1+ (point-min))) (insert "x") (let ((first-state ekp-buffer--live-state) (first-beg (ekp-buffer--live-state-beg ekp-buffer--live-state))) (forward-line 1) (run-hooks 'post-command-hook) (should (eq ekp-buffer--live-state first-state)) (insert "y") (should-not (eq ekp-buffer--live-state first-state)) (should-not (marker-buffer first-beg)) (should (ekp-buffer--live-state-contains-p (point))) (should (get-text-property (point-min) 'ekp-justified))))))) (ert-deftest ekp-buffer-test-live-foreign-display-abandons-only-its-paragraph () "A live conflict keeps foreign display and leaves other paragraphs stable." (let ((text "first paragraph alpha beta gamma\nsecond paragraph delta epsilon")) (ekp-buffer-test--with-mode text 16 (goto-char (point-min)) (search-forward "\n") (let* ((second-beg (point)) (first (buffer-substring (point-min) (1- second-beg))) (foreign (+ second-beg 7))) (let ((ekp-buffer--inhibit t)) (with-silent-modifications (put-text-property foreign (1+ foreign) 'display "VISIBLE"))) (goto-char (point-max)) (insert " x") (should (equal (get-text-property foreign 'display) "VISIBLE")) (should (equal-including-properties (buffer-substring (point-min) (1- second-beg)) first)) (ekp-buffer--commit-live-paragraph) (should ekp-buffer--conflicts) (should-not (get-text-property second-beg 'ekp-justified)))))) (ert-deftest ekp-buffer-test-live-uses-one-narrowest-window-width () "Every live span follows the buffer's narrowest displayed window." (ekp-buffer-test--with-text "alpha beta gamma delta epsilon zeta eta theta" (cl-letf (((symbol-function 'get-buffer-window-list) (lambda (&rest _) '(wide narrow))) ((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional window) (if (eq window 'wide) 40 16)))) (ekp-auto-justify-mode 1) (unwind-protect (progn (should (= ekp-buffer--auto-width 16)) (goto-char (point-max)) (insert " x") (should (cl-every (lambda (span) (= (ekp-buffer--span-width span) 16)) ekp-buffer--spans))) (ekp-auto-justify-mode -1))))) (ert-deftest ekp-buffer-test-live-narrowing-preserves-outside-source () "A narrowed edit preserves outside source while committing prior live rows." (let ((text "first paragraph alpha beta\nmiddle paragraph gamma delta\nlast paragraph epsilon zeta")) (ekp-buffer-test--with-mode text 16 (goto-char (point-min)) (let* ((first-end (progn (search-forward "\n") (1- (point)))) (middle-beg (point)) (middle-end (progn (search-forward "\n") (1- (point)))) (last-beg (point)) (first-before (buffer-substring (point-min) first-end)) (last-start (copy-marker last-beg)) (last-end (copy-marker (point-max) t)) (last-before (buffer-substring last-beg (point-max)))) (narrow-to-region middle-beg middle-end) (goto-char (point-min)) (search-forward "gamma") (insert "x") (save-restriction (widen) (should (equal-including-properties (buffer-substring (point-min) first-end) first-before)) (should (equal (substring-no-properties (buffer-substring (marker-position last-start) (marker-position last-end))) (substring-no-properties last-before))) (should (get-text-property (marker-position last-start) 'ekp-justified))) (set-marker last-start nil) (set-marker last-end nil))))) (ert-deftest ekp-buffer-test-narrowed-reflow-reprojects-whole-buffer () "A resize reflow preserves narrowing while updating outside paragraphs." (let ((text (concat "first alpha beta gamma delta epsilon\n" "middle zeta eta theta iota kappa lambda\n" "last mu nu xi omicron pi rho sigma"))) (ekp-buffer-test--with-mode text 20 (goto-char (point-min)) (let* ((first (copy-marker (point-min))) (middle-beg (progn (forward-line 1) (point))) (middle-end (line-end-position)) (last (progn (forward-line 1) (copy-marker (point))))) (narrow-to-region middle-beg middle-end) (ekp-buffer--reflow (current-buffer) 16) (should (= (point-min) middle-beg)) (should (= (point-max) middle-end)) (save-restriction (widen) (should (= (get-text-property first 'ekp-justified) 16)) (should (= (get-text-property last 'ekp-justified) 16)) (should (equal (substring-no-properties (buffer-string)) text))) (set-marker first nil) (set-marker last nil))))) (ert-deftest ekp-buffer-test-live-resize-keeps-latest-effective-width () "A stale resize callback cannot permanently lose the latest width." (let ((text "alpha beta gamma delta epsilon zeta")) (ekp-buffer-test--with-mode text 40 (goto-char (point-max)) (let ((scheduled-generation ekp-buffer--generation)) (insert " x") (cl-letf (((symbol-function 'ekp-buffer--effective-width) (lambda (&optional _) 12))) (ekp-buffer--reflow (current-buffer) 12 scheduled-generation)) (should (= ekp-buffer--auto-width 12)) (should (equal (substring-no-properties (buffer-string)) (concat text " x"))))))) (ert-deftest ekp-buffer-test-live-resize-publishes-active-paragraph-once () "Resize must not install then replace a static active-paragraph plan." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda") (static-installs 0) (live-installs 0) (install-plan (symbol-function 'ekp-buffer--install-plan)) (install-live (symbol-function 'ekp-buffer--install-live-prefix))) (ekp-buffer-test--with-mode text 40 (cl-letf (((symbol-function 'ekp-buffer--install-plan) (lambda (&rest arguments) (setq static-installs (1+ static-installs)) (apply install-plan arguments))) ((symbol-function 'ekp-buffer--install-live-prefix) (lambda (&rest arguments) (setq live-installs (1+ live-installs)) (apply install-live arguments)))) (ekp-buffer--reflow (current-buffer) 20)) (should (= static-installs 0)) (should (= live-installs 1)) (should (equal (substring-no-properties (buffer-string)) text))))) (ert-deftest ekp-buffer-test-font-context-change-invalidates-live-plan () "Theme and frame-font changes rebuild every displayed auto buffer." (let ((text "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda") (calls 0) (original (symbol-function 'ekp-layout-plan))) (should (memq #'ekp-buffer--on-font-context-change enable-theme-functions)) (should (memq #'ekp-buffer--on-font-context-change disable-theme-functions)) (should (memq #'ekp-buffer--on-font-context-change after-setting-font-hook)) (ekp-buffer-test--with-mode text 20 (goto-char (point-max)) (insert "x") (let ((old-plan (ekp-buffer--live-state-plan ekp-buffer--live-state))) (cl-letf (((symbol-function 'ekp-layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments)))) (run-hook-with-args 'enable-theme-functions 'ekp-test-theme)) (should (> calls 0)) (should-not (eq old-plan (ekp-buffer--live-state-plan ekp-buffer--live-state))) (should (equal (substring-no-properties (buffer-string)) (concat text "x"))))))) (ert-deftest ekp-buffer-test-mode-owns-and-restores-native-soft-wrap () "Auto mode soft-wraps narrow windows and restores prior ownership." (ekp-buffer-test--with-text "alpha beta gamma delta" (let ((partial-default (default-value 'truncate-partial-width-windows))) (setq-local truncate-lines t) (kill-local-variable 'truncate-partial-width-windows) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 80))) (ekp-auto-justify-mode 1) (unwind-protect (progn (should (local-variable-p 'truncate-lines)) (should-not truncate-lines) (should (local-variable-p 'truncate-partial-width-windows)) (should-not truncate-partial-width-windows)) (ekp-auto-justify-mode -1))) (should (local-variable-p 'truncate-lines)) (should truncate-lines) (should-not (local-variable-p 'truncate-partial-width-windows)) (should (equal truncate-partial-width-windows partial-default))))) (ert-deftest ekp-buffer-test-mode-enable-failure-restores-native-soft-wrap () "A failed enable restores soft-wrap values, ownership, and mode state." (ekp-buffer-test--with-text "alpha beta gamma delta" (let ((partial-default (default-value 'truncate-partial-width-windows))) (setq-local truncate-lines t) (kill-local-variable 'truncate-partial-width-windows) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 80)) ((symbol-function 'ekp-buffer--reflow) (lambda (&rest _) (error "forced reflow failure")))) (should-error (ekp-auto-justify-mode 1) :type 'error)) (should-not ekp-auto-justify-mode) (should-not ekp-buffer--wrap-state) (should (local-variable-p 'truncate-lines)) (should truncate-lines) (should-not (local-variable-p 'truncate-partial-width-windows)) (should (equal truncate-partial-width-windows partial-default))))) (ert-deftest ekp-buffer-test-mode-roundtrip () "Enabling then disabling the mode restores the buffer exactly." (let ((text "first paragraph 内容 aaa bbb ccc\nsecond paragraph 内容 ddd")) (ekp-buffer-test--with-mode text 150 (should ekp-buffer--auto-width) (should (get-text-property (point-min) 'ekp-justified))) ;; body ran; with-mode disabled the mode on exit — verify restore (ekp-buffer-test--with-text text (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 150))) (ekp-auto-justify-mode 1) (ekp-auto-justify-mode -1) (should (equal-including-properties (buffer-string) text)))))) (ert-deftest ekp-buffer-test-mode-incremental-edit () "A same-line live edit preserves the other hard line byte-for-byte." (let ((text "aaa bbb ccc ddd eee fff\nggg hhh iii jjj kkk lll") (calls nil)) (ekp-buffer-test--with-text text (goto-char (point-min)) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 100))) (ekp-auto-justify-mode 1) (unwind-protect (let* ((hard-nl (line-end-position)) (second (buffer-substring (1+ hard-nl) (point-max))) (orig (symbol-function 'ekp-justify-region))) (cl-letf (((symbol-function 'ekp-justify-region) (lambda (beg end &optional width) (push (list beg end width) calls) (funcall orig beg end width)))) (goto-char (+ (point-min) 4)) (insert "zz") (should-not calls) (should ekp-buffer--live-edit) (should-not (get-text-property (point-min) 'ekp-justified)) (should (equal-including-properties (buffer-substring (+ hard-nl 3) (point-max)) second)))) (ekp-auto-justify-mode -1))) (should (equal (buffer-string) "aaa zzbbb ccc ddd eee fff\nggg hhh iii jjj kkk lll"))))) (ert-deftest ekp-buffer-test-verbatim-paragraph-skipped () "A code-block paragraph stays byte-identical; prose around it justifies." (let* ((code (propertize "(defun foo (x) (list 1 2))" 'ekp-verbatim t 'face 'font-lock-keyword-face)) (text (concat "prose before with words enough to wrap lines\n" code "\nprose after also long enough to wrap lines"))) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 20) ;; the code line is still there, character-exact, spacing intact (goto-char (point-min)) (should (search-forward "(defun foo (x) (list 1 2))" nil t)) ;; prose received a projection while the code paragraph did not (should (get-text-property (point-min) 'ekp-justified)) (goto-char (point-min)) (search-forward "(defun") (should-not (get-text-property (match-beginning 0) 'ekp-justified)) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text))))) (ert-deftest ekp-buffer-test-skip-faces () "Paragraphs wearing a skip face stay verbatim." (let* ((ekp-buffer-skip-faces '(font-lock-comment-face)) (code (propertize ";; a comment line kept as-is" 'face 'font-lock-comment-face)) (text (concat "prose paragraph long enough to wrap\n" code))) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 15) (goto-char (point-min)) (should (search-forward ";; a comment line kept as-is" nil t)) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text))))) (ert-deftest ekp-buffer-test-org-inline-code-face-does-not-skip-paragraph () "An Org inline-code face must not make prose stay native-wrapped." (let* ((code (propertize "(ekp-pixel-justify STR W)" 'face 'org-code)) (text (concat "行内原子演示: 代码片段 " code " 之后的正文仍然需要由 EKP 负责断行。"))) (ekp-buffer-test--with-text text (ekp-org-setup) (buffer-enable-undo) (setq buffer-undo-list nil) (set-buffer-modified-p nil) (goto-char (+ (point-min) 7)) (set-mark (+ (point-min) 2)) (let ((point-before (point)) (mark-before (mark t)) (chars-tick (buffer-chars-modified-tick)) (undo-before buffer-undo-list) (overlays-before (length (overlays-in (point-min) (point-max))))) (ekp-justify-region (point-min) (point-max) 20) (should (get-text-property (point-min) 'ekp-justified)) (should (equal (substring-no-properties (buffer-string)) (substring-no-properties text))) (should (= (point) point-before)) (should (= (mark t) mark-before)) (should (= (buffer-chars-modified-tick) chars-tick)) (should (eq buffer-undo-list undo-before)) (should-not (buffer-modified-p)) (should (= (length (overlays-in (point-min) (point-max))) overlays-before)) (save-excursion (goto-char (point-min)) (should (search-forward "(ekp-pixel-justify STR W)" nil t)) (should (eq (get-text-property (match-beginning 0) 'face) 'org-code))) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text)))))) (ert-deftest ekp-buffer-test-org-block-face-stays-verbatim () "An Org block face still protects its own paragraph verbatim." (let* ((block (propertize "#+begin_src emacs-lisp\n(+ 1 2)\n#+end_src" 'face 'org-block)) (text (concat "prose before wraps with EKP projection\n" block "\nprose after wraps with EKP projection"))) (ekp-buffer-test--with-text text (ekp-org-setup) (ekp-justify-region (point-min) (point-max) 20) (goto-char (point-min)) (should (get-text-property (point) 'ekp-justified)) (search-forward "(+ 1 2)") (should-not (get-text-property (match-beginning 0) 'ekp-justified)) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text))))) (ert-deftest ekp-buffer-test-inline-protection-has-no-single-cjk-lines () "A narrow public layout must not publish isolated CJK rows near inline code." (let* ((atom (propertize "(ekp-pixel-justify STR W)" 'face 'org-code 'ekp-no-break t)) (text (concat "行内原子演示: 代码片段 " atom " 永不拆散、空格保持字面宽度;不间断空格让 " "100_000 与 3.14 MB 这类数字单位锁在同一行。"))) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 11) (let ((lines (ekp-buffer-test--display-lines))) (should (> (length lines) 1)) (should-not (seq-find #'ekp-buffer-test--single-cjk-line-p lines))) (should (equal (substring-no-properties (buffer-string)) (substring-no-properties text))) (should-not (overlays-in (point-min) (point-max))) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text))))) (ert-deftest ekp-buffer-test-showcase-1d-publishes-no-single-cjk-lines () "The exact public 168px showcase sample must not publish isolated CJK rows." (let ((text (ekp-showcase--sample)) (ekp-use-c-module nil)) (ekp-buffer-test--with-text text (ekp-showcase-mode) (ekp-justify-region (point-min) (point-max) 168) (let* ((lines (ekp-buffer-test--display-lines)) (single-cjk-lines (seq-filter #'ekp-buffer-test--single-cjk-line-p lines))) (should (> (length lines) 1)) (should-not single-cjk-lines)) (should (equal (substring-no-properties (buffer-string)) (substring-no-properties text))) (should-not (overlays-in (point-min) (point-max)))))) (ert-deftest ekp-buffer-test-showcase-parshape-publishes-no-single-cjk-lines () "The exact parshape 280px showcase must not publish isolated CJK rows." (let ((text (ekp-showcase--sample)) (ekp-use-c-module nil) (ekp-looseness 1)) (ekp-buffer-test--with-text text (ekp-showcase-mode) (setq-local ekp-showcase--width 280 ekp-showcase--parshape-on t) (ekp-showcase--apply-parshape) (ekp-justify-region (point-min) (point-max) 280) (let* ((lines (ekp-buffer-test--display-lines)) (single-cjk-lines (seq-filter #'ekp-buffer-test--single-cjk-line-p lines))) (should (> (length lines) 1)) (should-not single-cjk-lines)) (should (equal (substring-no-properties (buffer-string)) (substring-no-properties text))) (should-not (overlays-in (point-min) (point-max)))))) (ert-deftest ekp-buffer-test-break-policy-precedence-public-path () "Public policy resolution is region, local, mode, then global." (dolist (option '(ekp-hyphenation ekp-inline-code-policy ekp-buffer-mode-policy-alist ekp-buffer-inline-faces ekp-overlong-token-policy)) (should (boundp option))) (let ((original-hyphenation (default-value 'ekp-hyphenation)) (original-inline-policy (default-value 'ekp-inline-code-policy)) (original-inline-faces (default-value 'ekp-buffer-inline-faces)) (original-mode-policy (default-value 'ekp-buffer-mode-policy-alist)) (original-overlong (default-value 'ekp-overlong-token-policy))) (unwind-protect (let* ((word "internationalization") (auto-atom (propertize "auto inline atom" 'face 'org-code)) (explicit-atom (propertize "manual no break atom with spaces" 'face 'org-code 'ekp-no-break t)) (text (concat word " " word " " auto-atom " " explicit-atom)) captures (original-layout (symbol-function 'ekp-buffer--layout-plan))) (set-default-toplevel-value 'ekp-hyphenation 'off) (set-default-toplevel-value 'ekp-inline-code-policy 'normal) (set-default-toplevel-value 'ekp-buffer-inline-faces nil) (set-default-toplevel-value 'ekp-overlong-token-policy 'emergency) (set-default-toplevel-value 'ekp-buffer-mode-policy-alist '((text-mode . ((ekp-hyphenation . on) (ekp-inline-code-policy . no-break) (ekp-buffer-inline-faces . (org-code)) (ekp-overlong-token-policy . natural))))) (ekp-buffer-test--with-text text (text-mode) (let ((region-beg (save-excursion (goto-char (point-min)) (search-forward word) (search-forward word) (match-beginning 0))) (explicit-beg (save-excursion (goto-char (point-min)) (search-forward explicit-atom) (match-beginning 0))) (explicit-end (save-excursion (goto-char (point-min)) (search-forward explicit-atom) (match-end 0)))) (cl-letf (((symbol-function 'ekp-buffer--layout-plan) (lambda (source width context) (push (list :source (copy-sequence source) :width width :context (copy-tree context)) captures) (funcall original-layout source width context)))) ;; Mode profile beats real global defaults; no profile value is ;; copied into a buffer-local variable. (ekp-justify-region (point-min) (point-max) 80) (let ((context (plist-get (car captures) :context))) (should (eq (plist-get context :hyphenation) 'on)) (should (eq (plist-get context :inline-code-policy) 'no-break)) (should (equal (plist-get context :inline-faces) '(org-code))) (should (eq (plist-get context :overlong-token-policy) 'natural))) (should-not (local-variable-p 'ekp-hyphenation)) (should-not (local-variable-p 'ekp-inline-code-policy)) (should-not (local-variable-p 'ekp-buffer-inline-faces)) (ekp-unjustify-region (point-min) (point-max)) (setq captures nil) ;; Explicit buffer/file/dir-local values use the same public ;; variables and outrank the matching mode profile. (setq-local ekp-hyphenation 'off) (setq-local ekp-inline-code-policy 'normal) (setq-local ekp-buffer-inline-faces nil) (ekp-justify-region (point-min) (point-max) 80) (let ((context (plist-get (car captures) :context))) (should (eq (plist-get context :hyphenation) 'off)) (should (eq (plist-get context :inline-code-policy) 'normal)) (should-not (plist-get context :inline-faces))) (ekp-unjustify-region (point-min) (point-max)) (setq captures nil) ;; Exact region policy is passed only on the annotated source ;; range and outranks explicit locals in the core planner. (setq-local ekp-overlong-token-policy 'emergency) (put-text-property region-beg (+ region-beg (length word)) 'ekp-break-policy 'hyphenate) (put-text-property explicit-beg explicit-end 'ekp-break-policy 'hyphenate) (ekp-justify-region (point-min) (point-max) 40) (should (get-text-property (point-min) 'ekp-justified)) (let* ((source (plist-get (car captures) :source)) (region-offset (- region-beg (point-min))) (region-end (+ region-offset (length word))) (before-explicit (- explicit-beg (point-min))) (explicit-offset before-explicit) (explicit-finish (- explicit-end (point-min)))) (should (eq (get-text-property region-offset 'ekp-break-policy source) 'hyphenate)) (should-not (get-text-property (1- region-offset) 'ekp-break-policy source)) (should-not (get-text-property region-end 'ekp-break-policy source)) (should (eq (get-text-property explicit-offset 'ekp-break-policy source) 'hyphenate)) (should (get-text-property explicit-offset 'ekp-no-break source)) (should-not (seq-some (lambda (pos) (and (>= pos explicit-beg) (< pos explicit-end))) (ekp-buffer-test--display-newline-positions))) (should (< before-explicit explicit-finish))) (should (equal (substring-no-properties (buffer-string)) (substring-no-properties text))) (ekp-unjustify-region (point-min) (point-max)) (should (equal (substring-no-properties (buffer-string)) (substring-no-properties text))))))) (set-default-toplevel-value 'ekp-hyphenation original-hyphenation) (set-default-toplevel-value 'ekp-inline-code-policy original-inline-policy) (set-default-toplevel-value 'ekp-buffer-inline-faces original-inline-faces) (set-default-toplevel-value 'ekp-buffer-mode-policy-alist original-mode-policy) (set-default-toplevel-value 'ekp-overlong-token-policy original-overlong)))) (ert-deftest ekp-buffer-test-skip-predicate () "The paragraph predicate is the general escape hatch." (let ((text "keepme raw spacing\nnormal prose that wraps around")) (ekp-buffer-test--with-text text (setq-local ekp-buffer-skip-predicate (lambda (p) (string-prefix-p "keepme" p))) (ekp-justify-region (point-min) (point-max) 12) (goto-char (point-min)) (should (looking-at-p "keepme raw spacing$")) (ekp-unjustify-region (point-min) (point-max)) (should (equal (buffer-string) text))))) (ert-deftest ekp-buffer-test-indent-roundtrip () "First-line indent spacers vanish exactly on unjustify." (let ((ekp-first-line-indent 6) (text "首行缩进往返检查内容足够长断行几次")) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 30) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text))))) (ert-deftest ekp-buffer-test-resize-hook-window-arg () "The resize hook handles its WINDOW argument and foreign current buffer. Regression: buffer-local `window-size-change-functions' members get the displaying WINDOW, with an arbitrary buffer current." (let ((text "resize hook 检查 aaa bbb ccc ddd eee fff")) (ekp-buffer-test--with-mode text 200 (let ((buf (current-buffer)) (win (selected-window))) (set-window-buffer win buf) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 120))) ;; simulate redisplay: window argument, unrelated buffer current (with-temp-buffer (ekp-buffer--on-resize win))) (with-current-buffer buf (should (timerp ekp-buffer--resize-timer)) (cancel-timer ekp-buffer--resize-timer) ;; run what the timer would have run (ekp-buffer--reflow buf 120) (should (= ekp-buffer--auto-width 120))))))) (ert-deftest ekp-buffer-test-mode-reflow-width () "Reflow updates completed paragraphs and commits the active paragraph." (let ((text (concat "reflow 检查 aaa bbb ccc ddd eee fff ggg hhh\n" "active tail remains natural while editing")) fresh) (ekp-buffer-test--with-text "reflow 检查 aaa bbb ccc ddd eee fff ggg hhh" (ekp-justify-region (point-min) (point-max) 90) (setq fresh (buffer-substring (point-min) (point-max)))) (ekp-buffer-test--with-mode text 200 (ekp-buffer--reflow (current-buffer) 90) (should (= ekp-buffer--auto-width 90)) (let* ((newline (save-excursion (goto-char (point-min)) (search-forward "\n") (1- (point)))) (got (buffer-substring (point-min) newline))) ;; ekp-justified was written at two widths; ignore that prop (remove-text-properties 0 (length got) '(ekp-justified nil) got) (remove-text-properties 0 (length fresh) '(ekp-justified nil) fresh) (should (equal-including-properties got fresh)) (should-not (text-property-not-all (1+ newline) (point-max) 'ekp-justified 90)))))) (ert-deftest ekp-buffer-test-lazy-reflow-equals-oneshot () "Visible-first chunked re-flow converges to the one-shot result." (let ((ekp-auto-justify-lazy-threshold 100) (ekp-auto-justify-chunk-size 3) (text (mapconcat #'identity (make-list 12 "段落内容 some words 足够长会换行的样子") "\n"))) (ekp-buffer-test--with-text text (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 60)) ((symbol-function 'ekp-buffer--visible-span) (lambda () (cons (point-min) (min (point-max) 80))))) (ekp-auto-justify-mode 1) (ekp-buffer--reflow (current-buffer) 50) (should ekp-buffer--pending) ;; drain the background queue synchronously (let ((guard 0)) (while (and ekp-buffer--pending (< guard 100)) (when (timerp ekp-buffer--chunk-timer) (cancel-timer ekp-buffer--chunk-timer) (setq ekp-buffer--chunk-timer nil)) (ekp-buffer--process-chunk (current-buffer)) (setq guard (1+ guard)))) (should-not ekp-buffer--pending) (let ((lazy (buffer-string))) (ekp-auto-justify-mode -1) (ekp-justify-region (point-min) (point-max) 50) (should (equal-including-properties (buffer-string) lazy))))))) (ert-deftest ekp-buffer-test-lazy-reflow-preserves-active-live-spans () "Pending lazy chunks never detach spans owned by the active paragraph." (let ((ekp-auto-justify-lazy-threshold 1) (ekp-auto-justify-chunk-size 1) (text (mapconcat (lambda (index) (format "para%02d alpha beta gamma delta epsilon zeta eta theta" index)) (number-sequence 1 8) "\n"))) (ekp-buffer-test--with-text text (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 20)) ((symbol-function 'ekp-buffer--visible-span) (lambda () (cons (point-min) (save-excursion (goto-char (point-min)) (line-end-position)))))) (ekp-auto-justify-mode 1) (unwind-protect (progn (goto-char (point-max)) (insert " x") (ekp-buffer--reflow (current-buffer) 16) (while (cdr ekp-buffer--pending) (ekp-buffer--process-one-chunk)) (should-not (seq-find (lambda (span) (not (marker-buffer (ekp-buffer--span-beg span)))) (ekp-buffer--live-state-spans ekp-buffer--live-state))) (goto-char (point-max)) (insert " y")) (ekp-auto-justify-mode -1)))))) ;;;; Editor-state integrity (save / modified / undo / stickiness) (ert-deftest ekp-buffer-test-typed-char-inherits-no-marker () "Text typed beside a projection never inherits stale layout properties." (ekp-buffer-test--with-text "aaa bbb 中文 ccc" (ekp-justify-region (point-min) (point-max) 200) (let ((display-pos (text-property-not-all (point-min) (point-max) 'ekp-buffer--display nil))) (should display-pos) (goto-char (1+ display-pos)) (insert-and-inherit "X") (let ((x (1+ display-pos))) (should-not (get-text-property x 'ekp-justified)) (should-not (get-text-property x 'ekp-buffer--display)) (should-not (get-text-property x 'display)) (should-not (get-text-property x 'line-prefix)))) (ekp-unjustify-region (point-min) (point-max)) (should (= 1 (cl-count ?X (buffer-string)))))) (ert-deftest ekp-buffer-test-save-writes-logical-text () "Saving a justified file buffer writes the logical text to disk, keeps the buffer justified, and leaves it unmodified." (let* ((file (make-temp-file "ekp-save-test")) (text "中文保存测试内容足够长会断行的样子,再加一句凑长度。") (make-backup-files nil) (create-lockfiles nil)) (unwind-protect (with-current-buffer (find-file-noselect file) (insert text) (ekp-justify-region (point-min) (point-max) 20) (should (text-property-not-all (point-min) (point-max) 'ekp-buffer--display nil)) (should (= (cl-count ?\n (buffer-string)) 0)) (save-buffer) ;; Disk: logical text only, no layout newlines. (should (equal (with-temp-buffer (insert-file-contents file) (buffer-string)) text)) ;; Buffer: still justified, and not "modified" vs its file. (should (get-text-property (point-min) 'ekp-justified)) (should-not (buffer-modified-p)) ;; And a second save still works (state was reset). (insert "x") (goto-char (point-min)) (save-buffer) (should (equal (with-temp-buffer (insert-file-contents file) (buffer-string)) (concat text "x"))) (let ((kill-buffer-query-functions nil)) (kill-buffer))) (delete-file file)))) (ert-deftest ekp-buffer-test-failed-save-preserves-layout () "A filesystem save failure must not leave the buffer unformatted." (let* ((dir (make-temp-file "ekp-save-fail-" t)) (file (expand-file-name "file.txt" dir)) (text "保存失败以后屏幕仍然保持排版状态 and remains editable") (make-backup-files nil) (create-lockfiles nil)) (unwind-protect (with-current-buffer (find-file-noselect file) (setq-local require-final-newline nil) (insert text) (ekp-justify-region (point-min) (point-max) 20) (let ((layout (buffer-substring (point-min) (point-max)))) (delete-directory dir t) (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) nil))) (should-error (save-buffer))) (should (equal-including-properties (buffer-substring (point-min) (point-max)) layout)) (should (get-text-property (point-min) 'ekp-justified)) (should (buffer-modified-p))) (let ((kill-buffer-query-functions nil)) (set-buffer-modified-p nil) (kill-buffer))) (when (file-directory-p dir) (delete-directory dir t))))) (ert-deftest ekp-buffer-test-interrupted-save-preserves-layout () "A quit during writing must not leave the buffer unformatted." (let* ((file (make-temp-file "ekp-save-quit-")) (text "保存中断以后屏幕排版状态必须原样保留 with logical text") (make-backup-files nil) (create-lockfiles nil)) (unwind-protect (with-current-buffer (find-file-noselect file) (setq-local require-final-newline nil) (insert text) (ekp-justify-region (point-min) (point-max) 20) (let ((layout (buffer-substring (point-min) (point-max)))) (cl-letf (((symbol-function 'write-region) (lambda (&rest _) (signal 'quit nil)))) (should (condition-case nil (progn (save-buffer) nil) (quit t)))) (should (equal-including-properties (buffer-substring (point-min) (point-max)) layout)) (should (buffer-modified-p))) (let ((kill-buffer-query-functions nil)) (set-buffer-modified-p nil) (kill-buffer))) (delete-file file)))) (ert-deftest ekp-buffer-test-encoding-save-failure-is-retryable () "An encoding failure must preserve layout and allow a clean retry." (let* ((file (make-temp-file "ekp-save-encoding-")) (text "编码失败以后仍然保持排版,重试写入 logical text") (make-backup-files nil) (create-lockfiles nil)) (unwind-protect (with-current-buffer (find-file-noselect file) (setq-local require-final-newline nil) (insert text) (ekp-justify-region (point-min) (point-max) 20) (let ((layout (buffer-substring (point-min) (point-max)))) (set-buffer-file-coding-system 'us-ascii-unix) (cl-letf (((symbol-function 'select-safe-coding-system) (lambda (&rest _) (error "Forced encoding failure")))) (should-error (save-buffer))) (should (equal-including-properties (buffer-substring (point-min) (point-max)) layout)) (should (buffer-modified-p)) (set-buffer-file-coding-system 'utf-8-unix) (save-buffer) (should (equal-including-properties (buffer-substring (point-min) (point-max)) layout)) (should (equal (with-temp-buffer (insert-file-contents file) (buffer-string)) text))) (let ((kill-buffer-query-functions nil)) (kill-buffer))) (delete-file file)))) (ert-deftest ekp-buffer-test-justify-preserves-unmodified () "Pure re-layout must not flip `buffer-modified-p'." (let* ((file (make-temp-file "ekp-mod-test")) (make-backup-files nil) (create-lockfiles nil)) (unwind-protect (with-current-buffer (find-file-noselect file) (insert "modified 标志保持检查内容足够长断行") (save-buffer) (should-not (buffer-modified-p)) (ekp-justify-region (point-min) (point-max) 30) (should-not (buffer-modified-p)) (ekp-unjustify-region (point-min) (point-max)) (should-not (buffer-modified-p)) ;; A real edit still marks the buffer modified. (insert "y") (should (buffer-modified-p)) (let ((kill-buffer-query-functions nil)) (set-buffer-modified-p nil) (kill-buffer))) (delete-file file)))) (ert-deftest ekp-buffer-test-live-undo-restores-without-pending-layout () "Real undo restores logical text and finishes its live transaction." (let ((text "undo guard 检查内容 aaa bbb ccc")) (ekp-buffer-test--with-mode text 100 (buffer-enable-undo) (undo-boundary) (goto-char (point-max)) (insert " x") (undo-boundary) (undo-only 1) (should (equal (substring-no-properties (buffer-string)) text)) (should-not ekp-buffer--live-edit) (should-not (timerp ekp-buffer--composition-timer)) (should-not (overlays-in (point-min) (point-max)))))) (ert-deftest ekp-buffer-test-live-kill-region-reflows-through-public-path () "A real `kill-region' keeps live layout and copies no projection." (let ((text "alpha beta gamma delta epsilon zeta") (kill-ring nil) kill-ring-yank-pointer) (ekp-buffer-test--with-mode text 16 (goto-char (point-min)) (search-forward "gamma ") (kill-region (match-beginning 0) (match-end 0)) (should (equal (substring-no-properties (buffer-string)) "alpha beta delta epsilon zeta")) (should (equal (current-kill 0 t) "gamma ")) (should-not (text-property-not-all 0 (length (current-kill 0 t)) 'ekp-buffer--display nil (current-kill 0 t))) (should ekp-buffer--live-state) (should ekp-buffer--live-edit) (ekp-buffer-test--assert-natural-range (marker-position (ekp-buffer--live-edit-dirty-beg ekp-buffer--live-edit)) (marker-position (ekp-buffer--live-edit-dirty-end ekp-buffer--live-edit)))))) (ert-deftest ekp-buffer-test-live-newline-keeps-new-point-line-natural () "A user hard break commits neighbors but keeps the new point line active." (let ((text "alpha beta gamma delta epsilon zeta")) (ekp-buffer-test--with-mode text 16 (goto-char (point-min)) (search-forward "gamma ") (insert "\n") (should (get-text-property (point-min) 'ekp-justified)) (should ekp-buffer--live-state) (should (ekp-buffer--live-state-contains-p (point))) (should-not (get-text-property (point) 'ekp-justified)) (should (equal (substring-no-properties (buffer-string)) "alpha beta gamma \ndelta epsilon zeta")) (should-not ekp-buffer--live-edit)))) (ert-deftest ekp-buffer-test-major-mode-change-restores () "Switching major mode tears the justified state down cleanly." (let ((text "major mode 切换检查 aaa bbb ccc ddd")) (ekp-buffer-test--with-text text (let ((partial-default (default-value 'truncate-partial-width-windows)) observed-wrap-state) (setq-local truncate-lines t) (kill-local-variable 'truncate-partial-width-windows) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 80))) (ekp-auto-justify-mode 1) (should ekp-buffer--live-state) (add-hook 'change-major-mode-hook (lambda () (setq observed-wrap-state (list (local-variable-p 'truncate-lines) truncate-lines (local-variable-p 'truncate-partial-width-windows) truncate-partial-width-windows))) t t) (fundamental-mode) (should (equal observed-wrap-state (list t t nil partial-default))) (should (equal (buffer-string) text)) (should-not ekp-auto-justify-mode) (should (local-variable-p 'truncate-lines)) (should truncate-lines) (should-not (local-variable-p 'truncate-partial-width-windows))))))) ;;;; Ecosystem compatibility (kill ring / isearch / fields / read-only) (ert-deftest ekp-buffer-test-kill-ring-gets-logical-text () "Copying projected text strips EKP properties from logical characters." (let ((text "中文复制检查内容足够长会断行 with some latin")) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 20) (should (local-variable-p 'filter-buffer-substring-function)) (should (equal (filter-buffer-substring (point-min) (point-max)) text))))) (ert-deftest ekp-buffer-test-copy-filter-composes-and-restores () "EKP must preserve an existing buffer-local substring filter." (let ((text "组合复制过滤器必须保留 logical text and prefix")) (ekp-buffer-test--with-text text (let ((prior (lambda (beg end &optional delete) (let ((text (buffer-substring beg end))) (when delete (delete-region beg end)) (concat "PRE:" text))))) (setq-local filter-buffer-substring-function prior) (ekp-justify-region (point-min) (point-max) 20) (should (equal (filter-buffer-substring (point-min) (point-max)) (concat "PRE:" text))) (ekp-unjustify-region (point-min) (point-max)) (should (local-variable-p 'filter-buffer-substring-function)) (should (eq filter-buffer-substring-function prior)))))) (ert-deftest ekp-buffer-test-kill-filter-composes-delete () "Composed filtering must preserve DELETE and prior-filter semantics." (let ((text "组合 kill 过滤器删除源文本但返回 logical text")) (ekp-buffer-test--with-text text (let ((prior (lambda (beg end &optional delete) (let ((text (buffer-substring beg end))) (when delete (delete-region beg end)) (concat "PRE:" text))))) (setq-local filter-buffer-substring-function prior) (ekp-justify-region (point-min) (point-max) 20) (should (equal (filter-buffer-substring (point-min) (point-max) t) (concat "PRE:" text))) (should (= (point-min) (point-max))) (should (eq filter-buffer-substring-function prior)))))) (ert-deftest ekp-buffer-test-restores-inherited-copy-filter () "Final unjustify must reveal an inherited substring filter again." (let ((prior (lambda (beg end &optional delete) (prog1 (buffer-substring beg end) (when delete (delete-region beg end)))))) (let ((filter-buffer-substring-function prior)) (ekp-buffer-test--with-text "继承 filter 恢复检查内容" (ekp-justify-region (point-min) (point-max) 20) (ekp-unjustify-region (point-min) (point-max)) (should-not (local-variable-p 'filter-buffer-substring-function)) (should (eq filter-buffer-substring-function prior)))))) (ert-deftest ekp-buffer-test-mode-disable-restores-copy-filter () "Disabling auto mode must restore the previous local copy filter." (let ((prior (lambda (beg end &optional delete) (prog1 (buffer-substring beg end) (when delete (delete-region beg end)))))) (ekp-buffer-test--with-text "关闭 mode 恢复已有 copy filter" (setq-local filter-buffer-substring-function prior) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 20))) (ekp-auto-justify-mode 1) (goto-char (point-max)) (insert " x") (let ((prefix-end (ekp-buffer--live-state-prefix-end ekp-buffer--live-state))) (should (markerp prefix-end)) (ekp-auto-justify-mode -1) (should-not (marker-buffer prefix-end)))) (should-not ekp-buffer--live-state) (should (local-variable-p 'filter-buffer-substring-function)) (should (eq filter-buffer-substring-function prior))))) (ert-deftest ekp-buffer-test-final-unjustify-removes-integrations () "Removing the final layout span must remove unused integrations." (ekp-buffer-test--with-text "最后一个排版区间移除后清理集成 hooks" (ekp-justify-region (point-min) (point-max) 20) (should (memq #'ekp-buffer--before-change before-change-functions)) (should (local-variable-p 'filter-buffer-substring-function)) (ekp-unjustify-region (point-min) (point-max)) (should-not (local-variable-p 'filter-buffer-substring-function)) (should-not (memq #'ekp-buffer--before-change before-change-functions)))) (ert-deftest ekp-buffer-test-isearch-sees-logical-text () "Search sees logical text directly without suspending the projection." (let ((text "跨行搜索的目标短语必须能找到 internationalization word")) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 20) (let ((justified (buffer-string))) (should (= (cl-count ?\n justified) 0)) (goto-char (point-min)) (should (search-forward "目标短语必须能找到" nil t)) (goto-char (point-min)) (should (search-forward "internationalization" nil t)) (should (equal-including-properties (buffer-string) justified)))))) (ert-deftest ekp-buffer-test-field-paragraph-skipped () "Paragraphs containing field or read-only text stay verbatim." (let* ((prompt (propertize "shell> " 'field 'output)) (text (concat prompt "command output here\n" "prose paragraph long enough to wrap around"))) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 15) (goto-char (point-min)) (should (search-forward "command output here" nil t))))) (ert-deftest ekp-buffer-test-read-only-command-barfs () "Interactive justify on a read-only buffer signals, not corrupts." (ekp-buffer-test--with-text "read only 检查内容" (set-mark (point-min)) (goto-char (point-max)) (activate-mark) (read-only-mode 1) (should-error (call-interactively #'ekp-justify-region) :type 'buffer-read-only))) (ert-deftest ekp-buffer-test-justify-invalid-width-preserves-projection () "Invalid manual widths signal before clearing an existing projection." (ekp-buffer-test--with-text "invalid width must preserve this projection" (ekp-justify-region (point-min) (point-max) 20) (let ((before (buffer-substring (point-min) (point-max))) (spans ekp-buffer--spans)) (dolist (width '(0 -1 1.5 "80")) (should-error (ekp-justify-region (point-min) (point-max) width) :type 'user-error) (should (equal-including-properties (buffer-substring (point-min) (point-max)) before)) (should (eq ekp-buffer--spans spans)))))) (ert-deftest ekp-buffer-test-justify-empty-removes-unused-integrations () "Manual justification does not retain hooks when no span was installed." (ekp-buffer-test--with-text "" (ekp-justify-region (point-min) (point-max) 20) (should-not ekp-buffer--spans) (should-not ekp-buffer--filter-installed) (should-not (memq #'ekp-buffer--before-change before-change-functions)) (should-not (memq #'ekp-buffer--after-layout-change after-change-functions)))) (ert-deftest ekp-buffer-test-justify-foreign-only-removes-unused-integrations () "A foreign-only paragraph does not retain manual EKP integrations." (ekp-buffer-test--with-text "foreign ownership keeps this paragraph natural" (put-text-property (point-min) (point-max) 'display "foreign") (ekp-justify-region (point-min) (point-max) 20) (should-not ekp-buffer--spans) (should-not ekp-buffer--filter-installed) (should-not (memq #'ekp-buffer--before-change before-change-functions)) (should-not (memq #'ekp-buffer--after-layout-change after-change-functions)))) ;;;; Commands and mode integration (ert-deftest ekp-buffer-test-no-break-public-commands () "Interactive no-break commands affect the public formatter and report scope." (ekp-buffer-test--with-text "prefix AA BB suffix words" (let (messages) (set-mark 8) (goto-char 13) (activate-mark) (cl-letf (((symbol-function 'message) (lambda (format-string &rest args) (push (apply #'format format-string args) messages)))) (call-interactively #'ekp-no-break-region)) (should (eq (get-text-property 8 'ekp-no-break) t)) (ekp-justify-region (point-min) (point-max) 4) (should (string-match-p "AA BB" (buffer-string))) (ekp-unjustify-region (point-min) (point-max)) (set-mark 8) (goto-char 13) (activate-mark) (cl-letf (((symbol-function 'message) (lambda (format-string &rest args) (push (apply #'format format-string args) messages)))) (call-interactively #'ekp-allow-break-region)) (should-not (get-text-property 8 'ekp-no-break)) (should (= (length messages) 2)) (should (cl-every (lambda (text) (string-match-p "current buffer session" text)) messages))))) (ert-deftest ekp-buffer-test-verbatim-public-commands () "Interactive verbatim commands protect the real region formatter." (ekp-buffer-test--with-text "literal block stays exactly here\nordinary prose wraps here" (goto-char (point-min)) (let ((first-end (line-end-position)) messages) (set-mark (point-min)) (goto-char first-end) (activate-mark) (cl-letf (((symbol-function 'message) (lambda (format-string &rest args) (push (apply #'format format-string args) messages)))) (call-interactively #'ekp-verbatim-region)) (ekp-justify-region (point-min) (point-max) 8) (should (equal (buffer-substring-no-properties (point-min) (line-end-position)) "literal block stays exactly here")) (ekp-unjustify-region (point-min) (point-max)) (set-mark (point-min)) (goto-char first-end) (activate-mark) (cl-letf (((symbol-function 'message) (lambda (format-string &rest args) (push (apply #'format format-string args) messages)))) (call-interactively #'ekp-clear-verbatim-region)) (ekp-justify-region (point-min) first-end 8) (should (get-text-property (point-min) 'ekp-justified)) (should (= (length messages) 2)) (should (cl-every (lambda (text) (string-match-p "current buffer session" text)) messages))))) (ert-deftest ekp-buffer-test-protection-workflows-discoverable () "Mode help and menu expose the existing protection workflows." (should (string-match-p "current buffer[[:space:]]+session" (documentation #'ekp-auto-justify-mode))) (let ((menu (lookup-key ekp-auto-justify-mode-map [menu-bar ekp]))) (should (keymapp menu)) (should (where-is-internal #'ekp-no-break-region ekp-auto-justify-mode-map)) (should (where-is-internal #'ekp-verbatim-region ekp-auto-justify-mode-map)))) (ert-deftest ekp-buffer-test-justify-buffer-roundtrip () "ekp-justify-buffer / ekp-unjustify-buffer cover the whole buffer." (let ((text "第一段内容足够长断行\n\n第二段 also long enough to wrap")) (ekp-buffer-test--with-text text (ekp-justify-buffer 25) (should (get-text-property (point-min) 'ekp-justified)) (ekp-unjustify-buffer) (should (equal-including-properties (buffer-string) text))))) (ert-deftest ekp-buffer-test-justify-dwim-paragraph () "Without an active region, the commands act on the paragraph at point." (ekp-buffer-test--with-text "para one short\npara two 目标段落内容足够长会断行几次\npara three" (goto-char (point-min)) (search-forward "目标") (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 20))) (call-interactively #'ekp-justify-region)) ;; Only paragraph two is justified. (goto-char (point-min)) (should-not (get-text-property (point) 'ekp-justified)) (search-forward "目标") (should (get-text-property (match-beginning 0) 'ekp-justified)) (goto-char (point-max)) (should-not (get-text-property (1- (point)) 'ekp-justified)) ;; And unjustify DWIM restores just as well. (goto-char (point-min)) (search-forward "目标") (call-interactively #'ekp-unjustify-region) (should (equal (buffer-string) "para one short\npara two 目标段落内容足够长会断行几次\npara three")))) (ert-deftest ekp-buffer-test-refill-paragraph () "`ekp-refill-paragraph' re-justifies the paragraph at point." (ekp-buffer-test--with-text "refill 检查内容足够长会断行几次的样子\nsecond para" (goto-char (point-min)) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 20))) (ekp-refill-paragraph)) (should (get-text-property (point-min) 'ekp-justified)) (goto-char (point-max)) (should-not (get-text-property (1- (point)) 'ekp-justified)))) (ert-deftest ekp-buffer-test-markdown-setup () "Markdown setup preserves the mode's display-property ownership." (with-temp-buffer (setq-local font-lock-extra-managed-props '(display composition)) (ekp-markdown-setup) (should (equal font-lock-extra-managed-props '(display composition))) (should (local-variable-p 'ekp-buffer-skip-faces)) (should (local-variable-p 'ekp-buffer-inline-faces)) (should (equal ekp-buffer-skip-faces ekp-buffer-markdown-block-faces)) (should (equal ekp-buffer-inline-faces ekp-buffer-markdown-inline-faces)))) (ert-deftest ekp-buffer-test-org-auto-preset () "Auto mode consults the Org profile without copying preset locals." (with-temp-buffer (org-mode) (insert "普通正文段落内容足够长断行几次的样子") (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 100))) (ekp-auto-justify-mode 1) (unwind-protect (let ((context (ekp-buffer--policy-context))) (should-not (local-variable-p 'ekp-buffer-skip-faces)) (should-not (local-variable-p 'ekp-buffer-inline-faces)) (should (equal (plist-get context :block-faces) ekp-buffer-org-block-faces)) (should (equal (plist-get context :inline-faces) ekp-buffer-org-inline-faces))) (ekp-auto-justify-mode -1))))) ;;;; Lazy re-flow scheduling (ert-deftest ekp-buffer-test-live-unsupported-gap-stays-verbatim () "Live layout stops instead of pretending to shrink non-ASCII whitespace." (let ((text "aa\tbb cc dd") (original (symbol-function 'ekp--measured-width))) (cl-letf (((symbol-function 'ekp--measured-width) (lambda (string) (if (equal (substring-no-properties string) "\t") 5 (funcall original string))))) (ekp-buffer-test--with-mode text 100 (setq ekp-buffer--conflicts nil) (goto-char (point-max)) (insert " x") (ekp-buffer--commit-live-paragraph) (should-not ekp-buffer--spans) (should-not (text-property-not-all (point-min) (point-max) 'ekp-justified nil)) (should (string-match-p "unsupported whitespace shrink" (caddr (car ekp-buffer--conflicts)))) (should (equal (substring-no-properties (buffer-string)) (concat text " x"))))))) (ert-deftest ekp-buffer-test-live-oversized-paragraph-never-blocks-on-planning () "Automatic layout leaves an oversized hard paragraph natural." (let ((ekp-auto-justify-paragraph-limit 20) (text (make-string 60 ?a)) calls) (ekp-buffer-test--with-text text (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 12)) ((symbol-function 'ekp-layout-plan) (lambda (&rest _) (setq calls (1+ (or calls 0))) (error "oversized paragraph reached the planner")))) (ekp-auto-justify-mode 1) (unwind-protect (progn (goto-char (point-max)) (insert "x") (should-not calls) (should-not ekp-buffer--spans) (should-not (text-property-not-all (point-min) (point-max) 'ekp-justified nil)) (should (string-match-p "automatic paragraph limit" (caddr (car ekp-buffer--conflicts)))) (should (equal (substring-no-properties (buffer-string)) (concat text "x")))) (ekp-auto-justify-mode -1)))))) (ert-deftest ekp-buffer-test-prioritize-visible-chunks () "Chunks intersecting the visible span move to the queue front." (ekp-buffer-test--with-text "abc" (setq ekp-buffer--auto-width 100) (let* ((mk (lambda (a b) (cons (copy-marker a) (copy-marker b)))) (c1 (funcall mk 1 2)) (c2 (funcall mk 2 3)) (c3 (funcall mk 3 4))) (setq ekp-buffer--pending (cons 100 (list c1 c2 c3))) (cl-letf (((symbol-function 'ekp-buffer--visible-span) (lambda () (cons 3 4)))) (ekp-buffer--prioritize-visible)) (should (eq (cadr ekp-buffer--pending) c3)) (ekp-buffer--cancel-pending)))) (ert-deftest ekp-buffer-test-tick-budget-batches-chunks () "A generous tick budget drains several chunks in one tick; a zero budget still makes progress (exactly one chunk)." (let ((text (mapconcat #'identity (make-list 6 "分块预算检查内容足够长") "\n"))) (ekp-buffer-test--with-text text (setq ekp-buffer--auto-width 40) (setq ekp-buffer--pending (cons 40 (ekp-buffer--make-chunks (point-min) (point-max)))) (setq-local ekp-auto-justify-chunk-size 1) ;; zero budget: one chunk per tick (let ((ekp-auto-justify-tick-budget 0) (before (length (cdr ekp-buffer--pending)))) (cl-letf (((symbol-function 'input-pending-p) #'ignore)) (let ((ekp-auto-justify-mode t)) (ekp-buffer--process-chunk (current-buffer)))) (should (= (length (cdr ekp-buffer--pending)) (1- before)))) (when (timerp ekp-buffer--chunk-timer) (cancel-timer ekp-buffer--chunk-timer) (setq ekp-buffer--chunk-timer nil)) ;; big budget: the rest drains in one tick (let ((ekp-auto-justify-tick-budget 10.0)) (cl-letf (((symbol-function 'input-pending-p) #'ignore)) (let ((ekp-auto-justify-mode t)) (ekp-buffer--process-chunk (current-buffer))))) (should-not ekp-buffer--pending)))) ;;;; G003 configurable buffer policy contracts (defun ekp-buffer-test--private-policy-property-present-p () "Return non-nil when any private policy property leaked to the buffer." (let ((properties '(ekp--break-policy ekp--hyphenation ekp--literal-spacing ekp--policy-provenance ekp--automatic-no-break ekp--resolved-policy ekp--no-hyphen ekp--token-category ekp--downgraded-no-break)) (pos (point-min)) hit) (while (and (< pos (point-max)) (not hit)) (setq hit (seq-some (lambda (property) (get-text-property pos property)) properties) pos (1+ pos))) hit)) (defun ekp-buffer-test--drain-policy-reflow () "Run the scheduled zero-delay policy reflow for the current buffer." (let* ((timer ekp-buffer--policy-reflow-timer) (callback (timer--function timer)) (arguments (timer--args timer))) (should (timerp timer)) (should (eq callback #'ekp-buffer--reflow-for-policy-change)) (apply callback arguments) (when (timerp ekp-buffer--policy-reflow-timer) (cancel-timer ekp-buffer--policy-reflow-timer) (setq ekp-buffer--policy-reflow-timer nil))) (should-not (timerp ekp-buffer--policy-reflow-timer))) (ert-deftest ekp-buffer-test-g003-inline-profile-is-exact-span-only () "Inline face lists affect exact spans; outside gaps remain breakable." (let* ((inline-text "aa bb cc") (inline (propertize inline-text 'face '(org-code bold))) (block (propertize "#+begin_src\n(+ 1 2)\n#+end_src" 'face 'org-block)) (text (concat "prefix prose wraps before " inline " after wraps more words with trailing prose\n" block "\n" "tail prose wraps normally"))) (ekp-buffer-test--with-text text (ekp-org-setup) (let ((before (buffer-string)) inline-beg inline-end) (goto-char (point-min)) (search-forward inline-text) (setq inline-beg (match-beginning 0) inline-end (match-end 0)) (ekp-justify-region (point-min) (point-max) 160) (should (get-text-property (point-min) 'ekp-justified)) (should (equal (buffer-substring-no-properties inline-beg inline-end) inline-text)) (let* ((span (seq-find (lambda (candidate) (and (= (marker-position (ekp-buffer--span-beg candidate)) (point-min)) (< inline-end (marker-position (ekp-buffer--span-end candidate))))) ekp-buffer--spans)) (plan (and span (ekp-buffer--span-plan span))) (source (and plan (ekp-layout-plan-string plan))) (base (and span (marker-position (ekp-buffer--span-beg span)))) (inline-start (- inline-beg base)) (inline-finish (- inline-end base)) literal-space-runs outside-gap-seen) (should span) (should (equal (substring source inline-start inline-finish) inline-text)) (cl-loop for box across (ekp-layout-plan-boxes plan) for offset across (ekp-layout-plan-offsets plan) when (and (<= inline-start (car offset)) (<= (cdr offset) inline-finish) (string-match-p "\\` +\\'" (substring-no-properties box))) do (push (substring-no-properties box) literal-space-runs)) (cl-loop for line across (ekp-layout-plan-lines plan) do (cl-loop for gap across (ekp-layout-line-gaps line) for start = (ekp-layout-gap-source-start gap) for finish = (ekp-layout-gap-source-end gap) when (and (or (<= finish inline-start) (<= inline-finish start)) (string-match-p "\\` +\\'" (substring source start finish))) do (setq outside-gap-seen t) when (and (<= inline-start start) (<= finish inline-finish) (string-match-p "\\` +\\'" (substring source start finish))) do (should (= (ekp-layout-gap-target-pixel gap) (ekp-layout-gap-natural-pixel gap))))) (should (member " " literal-space-runs)) (should (member " " literal-space-runs)) (should outside-gap-seen)) (should-not (cl-loop for pos from inline-beg below inline-end thereis (let ((display (get-text-property pos 'ekp-buffer--display))) (and (stringp display) (string-match-p "-\n" (substring-no-properties display)))))) (should-not (ekp-buffer-test--private-policy-property-present-p)) (goto-char (point-min)) (search-forward "(+ 1 2)") (should-not (get-text-property (match-beginning 0) 'ekp-justified)) (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) before)))))) (ert-deftest ekp-buffer-test-g004-inline-face-breaks-at-source-spaces () "Inline faces use the public policy path without becoming hard atoms." (let* ((face 'ekp-buffer-test-inline-code-face) (inline-text "(ekp pixel justify STR W) alpha beta gamma delta epsilon zeta") (text (propertize inline-text 'face face)) (ekp-buffer-inline-faces (list face)) (ekp-inline-code-policy 'no-hyphen) (ekp-hyphenation 'off) (ekp-use-c-module nil)) (ekp-buffer-test--with-text text (let ((before (buffer-string)) (inline-beg (point-min)) (inline-end (point-max))) (ekp-justify-region (point-min) (point-max) 20) (should-not (text-property-not-all inline-beg inline-end 'ekp-no-break nil)) (let* ((span (seq-find (lambda (candidate) (and (<= (marker-position (ekp-buffer--span-beg candidate)) inline-beg) (<= inline-end (marker-position (ekp-buffer--span-end candidate))))) ekp-buffer--spans)) (plan (and span (ekp-buffer--span-plan span))) (source (and plan (ekp-layout-plan-string plan))) (breaks-inside (and plan (cl-loop for line across (ekp-layout-plan-lines plan) for start = (ekp-layout-line-break-source-start line) for end = (ekp-layout-line-break-source-end line) when (and start end (< start end) (<= start (length inline-text)) (<= end (length inline-text))) collect (substring source start end)))) (hyphen-inside (and plan (seq-some #'ekp-layout-line-hyphen-p (append (ekp-layout-plan-lines plan) nil))))) (should span) (should plan) (should (> (length (ekp-layout-plan-lines plan)) 1)) (should breaks-inside) (dolist (break breaks-inside) (should (string-match-p "\\`[[:space:]\n\r\t]+\\'" break))) (should-not hyphen-inside) (should (equal (substring-no-properties source) inline-text)) (should (equal (get-text-property 0 'face source) face))) (should (equal (substring-no-properties (buffer-string)) (substring-no-properties before))) (should (eq (get-text-property inline-beg 'face) face)) (should-not (overlays-in (point-min) (point-max))))))) (ert-deftest ekp-buffer-test-g003-profile-precedence-and-auto-consult-only () "Auto profiles are consult-only; explicit locals and region policy win." (should (boundp 'ekp-buffer-mode-policy-alist)) (let ((original-hyphenation (default-value 'ekp-hyphenation)) (original-inline-policy (default-value 'ekp-inline-code-policy)) (original-mode-policy (default-value 'ekp-buffer-mode-policy-alist))) (unwind-protect (progn (set-default-toplevel-value 'ekp-hyphenation 'off) (set-default-toplevel-value 'ekp-inline-code-policy 'normal) (set-default-toplevel-value 'ekp-buffer-mode-policy-alist '((org-mode . ((ekp-hyphenation . on) (ekp-inline-code-policy . no-hyphen) (ekp-buffer-measure . 12))))) (with-temp-buffer (org-mode) (insert "internationalization internationalization internationalization") (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 100))) (ekp-auto-justify-mode 1) (unwind-protect (progn ;; Mode profiles must be consulted without copying values ;; into locals. File and dir locals use these same public ;; variables; no separate file/directory policy alists. (should-not (local-variable-p 'ekp-buffer-skip-faces)) (should-not (local-variable-p 'ekp-inline-code-policy)) (should-not (local-variable-p 'ekp-hyphenation)) (should-not (local-variable-p 'ekp-buffer-measure)) (should (ekp-buffer-test--display-hyphen-p)) (ekp-unjustify-region (point-min) (point-max)) ;; Explicit locals are the public file/dir/buffer-local ;; owner and outrank the mode profile without manual cache ;; clearing. (setq-local ekp-hyphenation 'off) (ekp-justify-region (point-min) (point-max) 12) (should-not (ekp-buffer-test--display-hyphen-p)) (ekp-unjustify-region (point-min) (point-max)) ;; Region policy is the final override over explicit ;; locals. (put-text-property (point-min) (+ (point-min) 20) 'ekp-break-policy 'hyphenate) (ekp-justify-region (point-min) (point-max) 12) (should (ekp-buffer-test--display-hyphen-p))) (ekp-auto-justify-mode -1))))) (set-default-toplevel-value 'ekp-hyphenation original-hyphenation) (set-default-toplevel-value 'ekp-inline-code-policy original-inline-policy) (set-default-toplevel-value 'ekp-buffer-mode-policy-alist original-mode-policy)))) (ert-deftest ekp-buffer-test-g003-safe-local-values-are-closed () "Documented locals are safe; malformed and executable values are rejected." (dolist (case '((ekp-inline-code-policy . normal) (ekp-inline-code-policy . no-hyphen) (ekp-inline-code-policy . no-break) (ekp-hyphenation . auto) (ekp-hyphenation . on) (ekp-hyphenation . off) (ekp-overlong-token-policy . emergency) (ekp-overlong-token-policy . overflow) (ekp-overlong-token-policy . natural) (ekp-buffer-measure . narrowest-window) (ekp-buffer-measure . (max . 24)) (ekp-buffer-measure . 30) (ekp-emergency-stretch-pixel . nil) (ekp-emergency-stretch-pixel . 0) (ekp-emergency-stretch-pixel . 7) (ekp-buffer-mode-policy-alist . ((text-mode . ((ekp-emergency-stretch-pixel . 7))))) (ekp-token-break-policies . ((identifier . normal) (path . no-hyphen))))) (should (safe-local-variable-p (car case) (cdr case)))) (dolist (case '((ekp-inline-code-policy . maybe) (ekp-buffer-measure . window) (ekp-buffer-measure . (max . "wide")) (ekp-buffer-measure . 0) (ekp-emergency-stretch-pixel . -1) (ekp-emergency-stretch-pixel . 1.5) (ekp-buffer-mode-policy-alist . ((text-mode . ((ekp-emergency-stretch-pixel . -1))))) (ekp-token-break-policies . ((identifier . execute))) (ekp-buffer-skip-faces . ((lambda () t))) (ekp-buffer-skip-predicate . ignore) (ekp-buffer-skip-predicate . (lambda (_) t)))) (should-not (safe-local-variable-p (car case) (cdr case))))) (ert-deftest ekp-buffer-test-emergency-stretch-policy-context-and-reflow () "Emergency stretch follows global/profile/local precedence and reflows once." (let ((original-stretch (default-value 'ekp-emergency-stretch-pixel)) (original-profile (default-value 'ekp-buffer-mode-policy-alist))) (unwind-protect (progn (should (memq #'ekp-buffer--policy-variable-changed (get-variable-watchers 'ekp-emergency-stretch-pixel))) (set-default-toplevel-value 'ekp-emergency-stretch-pixel 3) (set-default-toplevel-value 'ekp-buffer-mode-policy-alist '((text-mode . ((ekp-emergency-stretch-pixel . 7))))) (ekp-buffer-test--with-text "emergency stretch context alpha beta" (text-mode) (should (= (plist-get (ekp-buffer--policy-context) :emergency-stretch-pixel) 7)) (setq-local ekp-emergency-stretch-pixel 11) (should (= (plist-get (ekp-buffer--policy-context) :emergency-stretch-pixel) 11)) (kill-local-variable 'ekp-emergency-stretch-pixel) (should (= (plist-get (ekp-buffer--policy-context) :emergency-stretch-pixel) 7)) (setq-default ekp-buffer-mode-policy-alist nil) (should (= (plist-get (ekp-buffer--policy-context) :emergency-stretch-pixel) 3))) (ekp-buffer-test--with-text "emergency stretch watcher alpha beta" (text-mode) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 30))) (ekp-auto-justify-mode 1) (unwind-protect (let ((calls 0) contexts (original-layout (symbol-function 'ekp-buffer--layout-plan)) (original-reflow (symbol-function 'ekp-buffer--reflow))) (cl-letf (((symbol-function 'ekp-buffer--layout-plan) (lambda (source width context) (push (copy-tree context) contexts) (funcall original-layout source width context))) ((symbol-function 'ekp-buffer--reflow) (lambda (&rest args) (setq calls (1+ calls)) (apply original-reflow args)))) (setq-default ekp-emergency-stretch-pixel 9) (should (= calls 0)) (ekp-buffer-test--drain-policy-reflow) (should (= calls 1)) (should (= (plist-get (car contexts) :emergency-stretch-pixel) 9)))) (ekp-auto-justify-mode -1))))) (set-default-toplevel-value 'ekp-emergency-stretch-pixel original-stretch) (set-default-toplevel-value 'ekp-buffer-mode-policy-alist original-profile)))) (ert-deftest ekp-buffer-test-g003-break-policy-region-commands () "Region commands write exact break-policy values and fail read-only first." (dolist (command '(ekp-normal-break-region ekp-enable-hyphenation-region ekp-disable-hyphenation-region ekp-clear-break-policy-region)) (should (fboundp command))) (ekp-buffer-test--with-text "alpha beta gamma" (let ((commands '((ekp-normal-break-region . normal) (ekp-enable-hyphenation-region . hyphenate) (ekp-disable-hyphenation-region . no-hyphen) (ekp-clear-break-policy-region . nil))) messages) (dolist (entry commands) (set-mark (point-min)) (goto-char (+ (point-min) 5)) (activate-mark) (cl-letf (((symbol-function 'message) (lambda (format-string &rest args) (push (apply #'format format-string args) messages)))) (call-interactively (car entry))) (should (eq (get-text-property (point-min) 'ekp-break-policy) (cdr entry)))) (should (cl-every (lambda (text) (string-match-p "current buffer session" text)) messages)))) (ekp-buffer-test--with-text "read only" (set-mark (point-min)) (goto-char (point-max)) (activate-mark) (read-only-mode 1) (should-error (call-interactively #'ekp-enable-hyphenation-region) :type 'buffer-read-only))) (defun ekp-buffer-test--manual-policy-command-clears-projection (command property expected) "Assert COMMAND invalidates a manual projection for PROPERTY." (ekp-buffer-test--with-text "alpha beta gamma delta epsilon zeta eta theta" (let ((region-beg (+ (point-min) 6)) (region-end (+ (point-min) 16))) (ekp-justify-region (point-min) (point-max) 20) (should (= (length ekp-buffer--spans) 1)) (should ekp-buffer--filter-installed) (let* ((span (car ekp-buffer--spans)) (source (ekp-layout-plan-string (ekp-buffer--span-plan span))) (offset (- region-beg (marker-position (ekp-buffer--span-beg span))))) (should-not (get-text-property offset property source))) (set-mark region-beg) (goto-char region-end) (activate-mark) (cl-letf (((symbol-function 'message) #'ignore)) (call-interactively command)) (should (eq (get-text-property region-beg property) expected)) (when ekp-buffer--spans (let* ((span (car ekp-buffer--spans)) (source (ekp-layout-plan-string (ekp-buffer--span-plan span))) (offset (- region-beg (marker-position (ekp-buffer--span-beg span))))) (should (eq (get-text-property offset property source) expected)))) (should-not ekp-buffer--spans) (should-not ekp-buffer--filter-installed) (should-not (eq filter-buffer-substring-function #'ekp-buffer--filter-buffer-substring))))) (ert-deftest ekp-buffer-test-g003-manual-break-policy-invalidates-projection () "Manual break-policy changes clear intersecting stale projections." (ekp-buffer-test--manual-policy-command-clears-projection #'ekp-enable-hyphenation-region 'ekp-break-policy 'hyphenate)) (ert-deftest ekp-buffer-test-g003-manual-no-break-invalidates-projection () "Manual no-break changes clear intersecting stale projections." (ekp-buffer-test--manual-policy-command-clears-projection #'ekp-no-break-region 'ekp-no-break t)) (ert-deftest ekp-buffer-test-g003-measure-and-diagnose-contract () "Measure modes use mocked windows and diagnose exposes effective policy." (with-temp-buffer (let ((widths '((w1 . 16) (w2 . 40)))) (cl-letf (((symbol-function 'get-buffer-window-list) (lambda (&rest _) '(w1 w2))) ((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional window) (alist-get window widths)))) (dolist (case '((narrowest-window . 16) ((max . 12) . 12) ((max . 24) . 16) (30 . 30))) (let ((ekp-buffer-measure (car case))) (should (= (ekp-buffer--effective-width) (cdr case))))) (let* ((ekp-buffer-measure 30) (ekp-inline-code-policy 'no-hyphen) (ekp-hyphenation 'auto) (ekp-kinsoku-profile 'common) (ekp-overlong-token-policy 'emergency) diagnostic-message (report (cl-letf (((symbol-function 'message) (lambda (format-string &rest args) (setq diagnostic-message (apply #'format format-string args))))) (ekp-diagnose)))) (dolist (key '(:requested :narrowest :effective :policy :conflicts :overflow-risk)) (should (plist-member report key))) (should (equal (plist-get report :requested) 30)) (should (= (plist-get report :narrowest) 16)) (should (= (plist-get report :effective) 30)) (should (plist-get report :overflow-risk)) (should-not (plist-get report :conflicts)) (let ((policy (plist-get report :policy))) (should (eq (plist-get policy :inline-code-policy) 'no-hyphen)) (should (eq (plist-get policy :hyphenation) 'auto)) (should (eq (plist-get policy :kinsoku-profile) 'common)) (should (eq (plist-get policy :overlong-token-policy) 'emergency))) (dolist (fragment '("requested 30" "narrowest 16" "effective 30" "overflow risk" "0 conflicts" "inline-code no-hyphen" "hyphenation auto" "kinsoku common" "overlong emergency")) (should (string-match-p (regexp-quote fragment) diagnostic-message)))))))) (ert-deftest ekp-buffer-test-g003-policy-watchers-schedule-one-reflow () "Global and local policy changes trigger one reflow; let bindings do not." (let ((original-default (default-value 'ekp-inline-code-policy)) (original-profile (default-value 'ekp-buffer-mode-policy-alist))) (unwind-protect (progn (ekp-buffer-test--with-text "alpha beta gamma delta" (text-mode) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 30))) (ekp-auto-justify-mode 1) (unwind-protect (let ((calls 0) contexts (original-layout (symbol-function 'ekp-buffer--layout-plan)) (original-reflow (symbol-function 'ekp-buffer--reflow))) (goto-char (+ (point-min) 5)) (set-marker (mark-marker) (+ (point-min) 11)) (setq mark-active nil) (cl-letf (((symbol-function 'ekp-buffer--layout-plan) (lambda (source width context) (push (copy-tree context) contexts) (funcall original-layout source width context))) ((symbol-function 'ekp-buffer--reflow) (lambda (&rest args) (setq calls (1+ calls)) (apply original-reflow args)))) (let ((source-before (substring-no-properties (buffer-string))) (modified-before (buffer-modified-p)) (undo-before buffer-undo-list) (tick-before (buffer-chars-modified-tick)) (overlay-count-before (length (overlays-in (point-min) (point-max)))) (point-before (point)) (mark-before (marker-position (mark-marker))) (mark-active-before mark-active) (generation-before ekp-buffer--generation)) (setq-default ekp-inline-code-policy 'normal) (should (= calls 0)) (ekp-buffer-test--drain-policy-reflow) (should (= calls 1)) (should (> ekp-buffer--generation generation-before)) (should (equal (substring-no-properties (buffer-string)) source-before)) (should (eq (buffer-modified-p) modified-before)) (should (eq buffer-undo-list undo-before)) (should (equal buffer-undo-list undo-before)) (should (= (buffer-chars-modified-tick) tick-before)) (should (= (length (overlays-in (point-min) (point-max))) overlay-count-before)) (should (= (point) point-before)) (should (= (marker-position (mark-marker)) mark-before)) (should (eq mark-active mark-active-before)) (should (eq (plist-get (car contexts) :inline-code-policy) 'normal))) (let ((same-generation ekp-buffer--generation)) (setq-default ekp-inline-code-policy 'normal) (should-not (timerp ekp-buffer--policy-reflow-timer)) (should (= calls 1)) (should (= ekp-buffer--generation same-generation))) (setq contexts nil) (let ((local-generation ekp-buffer--generation)) (setq-local ekp-inline-code-policy 'no-hyphen) (should (= calls 1)) (ekp-buffer-test--drain-policy-reflow) (should (= calls 2)) (should (> ekp-buffer--generation local-generation)) (should (eq (plist-get (car contexts) :inline-code-policy) 'no-hyphen))) (let ((same-local-generation ekp-buffer--generation)) (setq-local ekp-inline-code-policy 'no-hyphen) (when (timerp ekp-buffer--policy-reflow-timer) (ekp-buffer-test--drain-policy-reflow)) (should-not (timerp ekp-buffer--policy-reflow-timer)) (should (= calls 2)) (should (= ekp-buffer--generation same-local-generation))) (setq contexts nil) (let ((local-shield-generation ekp-buffer--generation) (local-shield-cache ekp-buffer--live-plan-cache) (local-shield-context (copy-tree (ekp-buffer--policy-context)))) (setq-default ekp-inline-code-policy 'no-break) (when (timerp ekp-buffer--policy-reflow-timer) (ekp-buffer-test--drain-policy-reflow)) (should-not (timerp ekp-buffer--policy-reflow-timer)) (should (= calls 2)) (should (= ekp-buffer--generation local-shield-generation)) (should (eq ekp-buffer--live-plan-cache local-shield-cache)) (should (equal (ekp-buffer--policy-context) local-shield-context)) (should (eq (plist-get local-shield-context :inline-code-policy) 'no-hyphen))) (let ((let-generation ekp-buffer--generation)) (let ((ekp-inline-code-policy 'normal)) (ignore ekp-inline-code-policy)) (should-not (timerp ekp-buffer--policy-reflow-timer)) (should (= calls 2)) (should (= ekp-buffer--generation let-generation))))) (ekp-auto-justify-mode -1))))) (setq-default ekp-inline-code-policy 'normal) (setq-default ekp-buffer-mode-policy-alist '((text-mode . ((ekp-inline-code-policy . no-hyphen))))) (ekp-buffer-test--with-text "profile alpha beta gamma" (text-mode) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 30))) (ekp-auto-justify-mode 1) (unwind-protect (let ((calls 0) contexts (original-layout (symbol-function 'ekp-buffer--layout-plan)) (original-reflow (symbol-function 'ekp-buffer--reflow))) (cl-letf (((symbol-function 'ekp-buffer--layout-plan) (lambda (source width context) (push (copy-tree context) contexts) (funcall original-layout source width context))) ((symbol-function 'ekp-buffer--reflow) (lambda (&rest args) (setq calls (1+ calls)) (apply original-reflow args)))) (let ((generation-before ekp-buffer--generation) (cache-before ekp-buffer--live-plan-cache) (context-before (copy-tree (ekp-buffer--policy-context)))) (setq-default ekp-inline-code-policy 'no-break) (when (timerp ekp-buffer--policy-reflow-timer) (ekp-buffer-test--drain-policy-reflow)) (should-not (timerp ekp-buffer--policy-reflow-timer)) (should (= calls 0)) (should (= ekp-buffer--generation generation-before)) (should (eq ekp-buffer--live-plan-cache cache-before)) (should (equal (ekp-buffer--policy-context) context-before)) (should (eq (plist-get context-before :inline-code-policy) 'no-hyphen))))) (ekp-auto-justify-mode -1))))) (set-default-toplevel-value 'ekp-inline-code-policy original-default) (set-default-toplevel-value 'ekp-buffer-mode-policy-alist original-profile))) (ert-deftest ekp-buffer-test-g003-policy-watchers-local-profile-transitions () "Local/profile effective policy transitions schedule post-set reflow." (let ((original-default (default-value 'ekp-inline-code-policy)) (original-profile (default-value 'ekp-buffer-mode-policy-alist))) (unwind-protect (progn (setq-default ekp-inline-code-policy 'normal) (setq-default ekp-buffer-mode-policy-alist '((text-mode . ((ekp-inline-code-policy . no-hyphen))))) (ekp-buffer-test--with-text "profile transition alpha beta" (text-mode) (cl-letf (((symbol-function 'ekp-buffer--window-pixel) (lambda (&optional _) 30))) (ekp-auto-justify-mode 1) (unwind-protect (let ((calls 0) contexts (original-layout (symbol-function 'ekp-buffer--layout-plan)) (original-reflow (symbol-function 'ekp-buffer--reflow))) (cl-letf (((symbol-function 'ekp-buffer--layout-plan) (lambda (source width context) (push (copy-tree context) contexts) (funcall original-layout source width context))) ((symbol-function 'ekp-buffer--reflow) (lambda (&rest args) (setq calls (1+ calls)) (apply original-reflow args)))) (setq-local ekp-inline-code-policy 'normal) (should (timerp ekp-buffer--policy-reflow-timer)) (ekp-buffer-test--drain-policy-reflow) (should (= calls 1)) (should (eq (plist-get (car contexts) :inline-code-policy) 'normal)) (setq contexts nil) (kill-local-variable 'ekp-inline-code-policy) (should (timerp ekp-buffer--policy-reflow-timer)) (ekp-buffer-test--drain-policy-reflow) (should (= calls 2)) (should (eq (plist-get (car contexts) :inline-code-policy) 'no-hyphen)))) (ekp-auto-justify-mode -1))))) (set-default-toplevel-value 'ekp-inline-code-policy original-default) (set-default-toplevel-value 'ekp-buffer-mode-policy-alist original-profile)))) (ert-deftest ekp-buffer-test-g003-natural-overlong-conflict-is-paragraph-local () "Natural overlong paragraphs stay unprojected and clear after fitting." (let* ((ekp-overlong-token-policy 'natural) (long-token "supercalifragilisticexpialidocious") (text (concat long-token "\n汉字段落可以规划")) (original (symbol-function 'ekp--measured-width))) (cl-letf (((symbol-function 'ekp--measured-width) (lambda (string) (let ((plain (substring-no-properties string))) (if (equal plain long-token) 40 (funcall original string)))))) (ekp-buffer-test--with-text text (ekp-justify-region (point-min) (point-max) 8) (should-not (get-text-property (point-min) 'ekp-justified)) (should (seq-some (lambda (conflict) (string-match-p "overlong-token-natural" (caddr conflict))) ekp-buffer--conflicts)) (goto-char (point-max)) (should (get-text-property (1- (point)) 'ekp-justified)) (ekp-unjustify-region (point-min) (point-max)) (setq ekp-buffer--conflicts nil) (ekp-justify-region (point-min) (point-max) 80) (should-not ekp-buffer--conflicts) (should (equal (substring-no-properties (buffer-string)) text)))))) (ert-deftest ekp-buffer-test-g003-live-identity-includes-policy-and-properties () "Live history keys include policy, measure, profile, and source props." (dolist (symbol '(ekp-buffer-measure ekp-buffer-mode-policy-alist ekp-buffer-inline-faces)) (should (boundp symbol))) (ekp-buffer-test--with-text "" (text-mode) (let ((ekp-inline-code-policy 'normal) (ekp-buffer-measure 'narrowest-window) (ekp-buffer-mode-policy-alist nil)) (setq ekp-buffer--live-plan-cache nil) (let ((first (cdr (ekp-buffer--live-plan-entry "alpha beta gamma" 20)))) (should (eq first (cdr (ekp-buffer--live-plan-entry "alpha beta gamma" 20)))) (let ((ekp-inline-code-policy 'no-break)) (should-not (eq first (cdr (ekp-buffer--live-plan-entry "alpha beta gamma" 20))))) (let ((ekp-buffer-measure 24)) (should-not (eq first (cdr (ekp-buffer--live-plan-entry "alpha beta gamma" 20))))) (let ((ekp-buffer-mode-policy-alist '((text-mode . ((ekp-buffer-inline-faces . (font-lock-string-face))))))) (should-not (eq first (cdr (ekp-buffer--live-plan-entry "alpha beta gamma" 20))))) (let ((annotated (copy-sequence "alpha beta gamma"))) (put-text-property 6 10 'ekp-break-policy 'no-hyphen annotated) (should-not (eq first (cdr (ekp-buffer--live-plan-entry annotated 20))))) (dotimes (index 20) (ekp-buffer--live-plan-entry (format "history %02d alpha beta" index) 20)) (should (= (length ekp-buffer--live-plan-cache) 16)))))) (ert-deftest ekp-buffer-test-live-plan-key-owns-policy-strings () "Live plan keys must not retain mutable public policy strings." (ekp-buffer-test--with-text "" (text-mode) (let* ((ekp-use-c-module nil) (suffix (copy-sequence (string-as-multibyte "uX"))) (line-start-extra (copy-sequence "《X")) (ekp-number-unit-suffixes (list suffix)) (ekp-token-break-policies '((number-unit . no-break))) (ekp-kinsoku-profile 'custom) (ekp-cjk-no-line-start-extra line-start-extra) (text (copy-sequence "100uX alpha beta gamma delta")) (width 16) (calls 0) (original (symbol-function 'ekp-buffer--layout-plan)) first key) (setq ekp-buffer--live-plan-cache nil) (cl-letf (((symbol-function 'ekp-buffer--layout-plan) (lambda (&rest arguments) (setq calls (1+ calls)) (apply original arguments)))) (setq first (cdr (ekp-buffer--live-plan-entry text width))) (setq key (caar ekp-buffer--live-plan-cache)) (should (multibyte-string-p suffix)) (should (multibyte-string-p line-start-extra)) (should (seq-some (lambda (string) (equal string "uX")) (ekp-buffer-test--strings-in-tree key))) (should (seq-some (lambda (string) (equal string "《X")) (ekp-buffer-test--strings-in-tree key))) (store-substring suffix 1 "Y") (store-substring line-start-extra 1 "Y") (let ((changed (cdr (ekp-buffer--live-plan-entry text width)))) (should-not (eq changed first)) (should (= calls 2))) (should (seq-some (lambda (string) (equal string "uX")) (ekp-buffer-test--strings-in-tree key))) (should (seq-some (lambda (string) (equal string "《X")) (ekp-buffer-test--strings-in-tree key))))))) (provide 'ekp-buffer-tests) ;;; ekp-buffer-tests.el ends here