fd1210e557
Complete task002 through task016 across cache correctness, editor lifecycle, C boundaries, build and release governance, dictionary provenance, performance, interactive workflows, tests, documentation, and final cleanup.
832 lines
38 KiB
EmacsLisp
832 lines
38 KiB
EmacsLisp
;;; ekp-region-tests.el --- Tests for ekp-region.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-region)
|
|
|
|
(defconst ekp-region-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-region-test--widths '(30 80 200 400)
|
|
"Pixel widths from emergency-narrow to comfortable.")
|
|
|
|
(defmacro ekp-region-test--with-text (text &rest body)
|
|
"Run BODY in a temp buffer containing TEXT."
|
|
(declare (indent 1))
|
|
`(with-temp-buffer
|
|
(insert ,text)
|
|
,@body))
|
|
|
|
;;;; Roundtrip exactness
|
|
|
|
(ert-deftest ekp-region-test-roundtrip-exact ()
|
|
"justify + unjustify restores text and properties exactly."
|
|
(dolist (text ekp-region-test--samples)
|
|
(dolist (w ekp-region-test--widths)
|
|
(ekp-region-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-region-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-region-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-region-test-hard-newlines-preserved ()
|
|
"Hard newline count survives justification."
|
|
(ekp-region-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-region-test-justified-marked ()
|
|
"Justified region carries the ekp-justified width property."
|
|
(ekp-region-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-region-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-region-test--with-text text
|
|
(ekp-justify-region (point-min) (point-max) 150)
|
|
(setq fresh (buffer-string)))
|
|
(ekp-region-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-region-test-edit-then-unjustify ()
|
|
"Text typed into a justified buffer survives unjustification."
|
|
(ekp-region-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-region-test-point-stable ()
|
|
"Point returns to its logical position after a roundtrip."
|
|
(ekp-region-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)))))
|
|
|
|
;;;; Auto-justify mode
|
|
|
|
(defmacro ekp-region-test--with-mode (text width &rest body)
|
|
"Enable `ekp-auto-justify-mode' on TEXT at WIDTH, run BODY, disable."
|
|
(declare (indent 2))
|
|
`(ekp-region-test--with-text ,text
|
|
(cl-letf (((symbol-function 'ekp-region--window-pixel)
|
|
(lambda (&optional _) ,width)))
|
|
(ekp-auto-justify-mode 1)
|
|
(unwind-protect
|
|
(progn ,@body)
|
|
(ekp-auto-justify-mode -1)))))
|
|
|
|
(ert-deftest ekp-region-test-mode-roundtrip ()
|
|
"Enabling then disabling the mode restores the buffer exactly."
|
|
(let ((text "first paragraph 内容 aaa bbb ccc\nsecond paragraph 内容 ddd"))
|
|
(ekp-region-test--with-mode text 150
|
|
(should ekp-region--auto-width)
|
|
(should (get-text-property (point-min) 'ekp-justified)))
|
|
;; body ran; with-mode disabled the mode on exit — verify restore
|
|
(ekp-region-test--with-text text
|
|
(cl-letf (((symbol-function 'ekp-region--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-region-test-mode-incremental-edit ()
|
|
"Edits re-justify only the touched paragraph, content stays correct."
|
|
(let ((text "aaa bbb ccc ddd eee fff\nggg hhh iii jjj kkk lll")
|
|
(calls nil))
|
|
(ekp-region-test--with-mode text 100
|
|
(let ((orig (symbol-function 'ekp-justify-region)))
|
|
(cl-letf (((symbol-function 'ekp-justify-region)
|
|
(lambda (b e &optional px)
|
|
(push (cons (marker-position (copy-marker b))
|
|
(marker-position (copy-marker e)))
|
|
calls)
|
|
(funcall orig b e px))))
|
|
;; Edit inside paragraph 1.
|
|
(goto-char (+ (point-min) 4))
|
|
(insert "zz")
|
|
(should ekp-region--dirty)
|
|
(ekp-region--flush-dirty (current-buffer))
|
|
;; Exactly one incremental call, confined before the hard \n.
|
|
(should (= (length calls) 1))
|
|
(let ((hard-nl (save-excursion
|
|
(goto-char (point-min))
|
|
(catch 'nl
|
|
(while (search-forward "\n" nil t)
|
|
(unless (get-text-property (match-beginning 0)
|
|
'ekp-soft-break)
|
|
(throw 'nl (match-beginning 0))))))))
|
|
(should (<= (cdar calls) hard-nl)))))
|
|
;; Logical text after disable = original with the edit applied.
|
|
(ekp-auto-justify-mode -1)
|
|
(should (equal (buffer-string)
|
|
"aaa zzbbb ccc ddd eee fff\nggg hhh iii jjj kkk lll"))
|
|
;; re-enable so with-mode's cleanup disable is a no-op state-wise
|
|
(ekp-auto-justify-mode 1))))
|
|
|
|
(ert-deftest ekp-region-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-region-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 got justified (soft breaks appeared)
|
|
(should (text-property-not-all (point-min) (point-max)
|
|
'ekp-soft-break nil))
|
|
(ekp-unjustify-region (point-min) (point-max))
|
|
(should (equal-including-properties (buffer-string) text)))))
|
|
|
|
(ert-deftest ekp-region-test-skip-faces ()
|
|
"Paragraphs wearing a skip face stay verbatim."
|
|
(let* ((ekp-region-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-region-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-region-test-skip-predicate ()
|
|
"The paragraph predicate is the general escape hatch."
|
|
(let ((text "keepme raw spacing\nnormal prose that wraps around"))
|
|
(ekp-region-test--with-text text
|
|
(setq-local ekp-region-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-region-test-indent-roundtrip ()
|
|
"First-line indent spacers vanish exactly on unjustify."
|
|
(let ((ekp-first-line-indent 6)
|
|
(text "首行缩进往返检查内容足够长断行几次"))
|
|
(ekp-region-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-region-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-region-test--with-mode text 200
|
|
(let ((buf (current-buffer))
|
|
(win (selected-window)))
|
|
(set-window-buffer win buf)
|
|
(cl-letf (((symbol-function 'ekp-region--window-pixel)
|
|
(lambda (&optional _) 120)))
|
|
;; simulate redisplay: window argument, unrelated buffer current
|
|
(with-temp-buffer
|
|
(ekp-region--on-resize win)))
|
|
(with-current-buffer buf
|
|
(should (timerp ekp-region--resize-timer))
|
|
(cancel-timer ekp-region--resize-timer)
|
|
;; run what the timer would have run
|
|
(ekp-region--reflow buf 120)
|
|
(should (= ekp-region--auto-width 120)))))))
|
|
|
|
(ert-deftest ekp-region-test-mode-reflow-width ()
|
|
"Reflow to a new width matches a fresh justification at that width."
|
|
(let ((text "reflow 检查 aaa bbb ccc ddd eee fff ggg hhh")
|
|
fresh)
|
|
(ekp-region-test--with-text text
|
|
(ekp-justify-region (point-min) (point-max) 90)
|
|
(setq fresh (buffer-substring (point-min) (point-max))))
|
|
(ekp-region-test--with-mode text 200
|
|
(ekp-region--reflow (current-buffer) 90)
|
|
(should (= ekp-region--auto-width 90))
|
|
(let ((got (buffer-substring (point-min) (point-max))))
|
|
;; 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))))))
|
|
|
|
|
|
(ert-deftest ekp-region-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-region-test--with-text text
|
|
(cl-letf (((symbol-function 'ekp-region--window-pixel)
|
|
(lambda (&optional _) 60))
|
|
((symbol-function 'ekp-region--visible-span)
|
|
(lambda () (cons (point-min) (min (point-max) 80)))))
|
|
(ekp-auto-justify-mode 1)
|
|
(ekp-region--reflow (current-buffer) 50)
|
|
(should ekp-region--pending)
|
|
;; drain the background queue synchronously
|
|
(let ((guard 0))
|
|
(while (and ekp-region--pending (< guard 100))
|
|
(when (timerp ekp-region--chunk-timer)
|
|
(cancel-timer ekp-region--chunk-timer)
|
|
(setq ekp-region--chunk-timer nil))
|
|
(ekp-region--process-chunk (current-buffer))
|
|
(setq guard (1+ guard))))
|
|
(should-not ekp-region--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)))))))
|
|
|
|
;;;; Editor-state integrity (save / modified / undo / stickiness)
|
|
|
|
(ert-deftest ekp-region-test-typed-char-inherits-no-marker ()
|
|
"Text typed right after a glue must not inherit renderer markers.
|
|
Regression: `self-insert-command' uses insert-and-inherit; a char
|
|
inheriting `ekp-glue' was deleted as a synthesized space by the next
|
|
unjustification."
|
|
(ekp-region-test--with-text "aaa bbb 中文 ccc"
|
|
(ekp-justify-region (point-min) (point-max) 200)
|
|
(let ((glue-pos (text-property-not-all (point-min) (point-max)
|
|
'ekp-glue nil)))
|
|
(should glue-pos)
|
|
(goto-char (1+ glue-pos))
|
|
(insert-and-inherit "X")
|
|
(let ((x (1+ glue-pos)))
|
|
(should-not (get-text-property x 'ekp-glue))
|
|
(should-not (get-text-property x 'display))
|
|
(should-not (get-text-property x 'ekp-soft-break))))
|
|
(ekp-unjustify-region (point-min) (point-max))
|
|
(should (= 1 (cl-count ?X (buffer-string))))))
|
|
|
|
(ert-deftest ekp-region-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 (> (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-region-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-region-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-region-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-not (buffer-live-p ekp-region--write-buffer))
|
|
(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-region-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-region-test-undo-changes-not-redirtied ()
|
|
"Changes applied by undo must not schedule a re-flow."
|
|
(ekp-region-test--with-mode "undo guard 检查内容 aaa bbb ccc" 100
|
|
(setq ekp-region--dirty nil)
|
|
(let ((undo-in-progress t))
|
|
(ekp-region--after-change (point-min) (1+ (point-min)) 0))
|
|
(should-not ekp-region--dirty)
|
|
(let ((undo-in-progress nil))
|
|
(ekp-region--after-change (point-min) (1+ (point-min)) 0))
|
|
(should ekp-region--dirty)
|
|
(dolist (p ekp-region--dirty)
|
|
(set-marker (car p) nil)
|
|
(set-marker (cdr p) nil))
|
|
(setq ekp-region--dirty nil)
|
|
(when (timerp ekp-region--edit-timer)
|
|
(cancel-timer ekp-region--edit-timer))))
|
|
|
|
(ert-deftest ekp-region-test-major-mode-change-restores ()
|
|
"Switching major mode tears the justified state down cleanly."
|
|
(let ((text "major mode 切换检查 aaa bbb ccc ddd"))
|
|
(ekp-region-test--with-text text
|
|
(cl-letf (((symbol-function 'ekp-region--window-pixel)
|
|
(lambda (&optional _) 80)))
|
|
(ekp-auto-justify-mode 1)
|
|
(should (get-text-property (point-min) 'ekp-justified))
|
|
(fundamental-mode)
|
|
(should (equal (buffer-string) text))
|
|
(should-not ekp-auto-justify-mode)))))
|
|
|
|
;;;; Ecosystem compatibility (kill ring / isearch / fields / read-only)
|
|
|
|
(ert-deftest ekp-region-test-kill-ring-gets-logical-text ()
|
|
"Copying justified text extracts the logical text.
|
|
CJK justification injects real space characters between glyphs;
|
|
they must not travel with a kill/yank."
|
|
(let ((text "中文复制检查内容足够长会断行 with some latin"))
|
|
(ekp-region-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-region-test-copy-filter-composes-and-restores ()
|
|
"EKP must preserve an existing buffer-local substring filter."
|
|
(let ((text "组合复制过滤器必须保留 logical text and prefix"))
|
|
(ekp-region-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-region-test-kill-filter-composes-delete ()
|
|
"Composed filtering must preserve DELETE and prior-filter semantics."
|
|
(let ((text "组合 kill 过滤器删除源文本但返回 logical text"))
|
|
(ekp-region-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-region-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-region-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-region-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-region-test--with-text "关闭 mode 恢复已有 copy filter"
|
|
(setq-local filter-buffer-substring-function prior)
|
|
(cl-letf (((symbol-function 'ekp-region--window-pixel)
|
|
(lambda (&optional _) 20)))
|
|
(ekp-auto-justify-mode 1)
|
|
(ekp-auto-justify-mode -1))
|
|
(should (local-variable-p 'filter-buffer-substring-function))
|
|
(should (eq filter-buffer-substring-function prior)))))
|
|
|
|
(ert-deftest ekp-region-test-final-unjustify-removes-integrations ()
|
|
"Removing the final layout span must remove unused integrations."
|
|
(ekp-region-test--with-text "最后一个排版区间移除后清理集成 hooks"
|
|
(ekp-justify-region (point-min) (point-max) 20)
|
|
(should (memq #'ekp-region--write-logical-buffer
|
|
write-region-annotate-functions))
|
|
(should (memq #'ekp-region--isearch-begin isearch-mode-hook))
|
|
(ekp-unjustify-region (point-min) (point-max))
|
|
(should-not (local-variable-p 'filter-buffer-substring-function))
|
|
(should-not (memq #'ekp-region--write-logical-buffer
|
|
write-region-annotate-functions))
|
|
(should-not (memq #'ekp-region--isearch-begin isearch-mode-hook))))
|
|
|
|
(ert-deftest ekp-region-test-isearch-sees-logical-text ()
|
|
"The isearch hooks expose the logical text, then restore the layout."
|
|
(let ((text "跨行搜索的目标短语必须能找到 internationalization word"))
|
|
(ekp-region-test--with-text text
|
|
(ekp-justify-region (point-min) (point-max) 20)
|
|
(let ((justified (buffer-string)))
|
|
;; Sanity: layout breaks the phrase apart.
|
|
(should (> (cl-count ?\n justified) 0))
|
|
(ekp-region--isearch-begin)
|
|
;; Logical view: the full phrase and the long word are findable.
|
|
(goto-char (point-min))
|
|
(should (search-forward "目标短语必须能找到" nil t))
|
|
(goto-char (point-min))
|
|
(should (search-forward "internationalization" nil t))
|
|
(ekp-region--isearch-end)
|
|
;; Layout restored byte-identically.
|
|
(should (equal-including-properties (buffer-string) justified))))))
|
|
|
|
(ert-deftest ekp-region-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-region-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-region-test-read-only-command-barfs ()
|
|
"Interactive justify on a read-only buffer signals, not corrupts."
|
|
(ekp-region-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)))
|
|
|
|
;;;; Commands and mode integration
|
|
|
|
(ert-deftest ekp-region-test-no-break-public-commands ()
|
|
"Interactive no-break commands affect the public formatter and report scope."
|
|
(ekp-region-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-region-test-verbatim-public-commands ()
|
|
"Interactive verbatim commands protect the real region formatter."
|
|
(ekp-region-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-region-test-protection-workflows-discoverable ()
|
|
"Mode help and menu expose the existing protection workflows."
|
|
(should (string-match-p
|
|
"current buffer 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-region-test-justify-buffer-roundtrip ()
|
|
"ekp-justify-buffer / ekp-unjustify-buffer cover the whole buffer."
|
|
(let ((text "第一段内容足够长断行\n\n第二段 also long enough to wrap"))
|
|
(ekp-region-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-region-test-justify-dwim-paragraph ()
|
|
"Without an active region, the commands act on the paragraph at point."
|
|
(ekp-region-test--with-text
|
|
"para one short\npara two 目标段落内容足够长会断行几次\npara three"
|
|
(goto-char (point-min))
|
|
(search-forward "目标")
|
|
(cl-letf (((symbol-function 'ekp-region--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-region-test-refill-paragraph ()
|
|
"`ekp-refill-paragraph' re-justifies the paragraph at point."
|
|
(ekp-region-test--with-text "refill 检查内容足够长会断行几次的样子\nsecond para"
|
|
(goto-char (point-min))
|
|
(cl-letf (((symbol-function 'ekp-region--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-region-test-markdown-setup ()
|
|
"ekp-markdown-setup stops font-lock from managing `display'."
|
|
(with-temp-buffer
|
|
(setq-local font-lock-extra-managed-props '(display composition))
|
|
(ekp-markdown-setup)
|
|
(should (equal font-lock-extra-managed-props '(composition)))
|
|
(should (equal ekp-region-skip-faces ekp-region-markdown-skip-faces))))
|
|
|
|
(ert-deftest ekp-region-test-org-auto-preset ()
|
|
"Enabling the mode in an Org buffer applies the Org skip preset."
|
|
(with-temp-buffer
|
|
(org-mode)
|
|
(insert "普通正文段落内容足够长断行几次的样子")
|
|
(cl-letf (((symbol-function 'ekp-region--window-pixel)
|
|
(lambda (&optional _) 100)))
|
|
(ekp-auto-justify-mode 1)
|
|
(unwind-protect
|
|
(should (equal ekp-region-skip-faces ekp-region-org-skip-faces))
|
|
(ekp-auto-justify-mode -1)))))
|
|
|
|
;;;; Lazy re-flow scheduling
|
|
|
|
(ert-deftest ekp-region-test-huge-edit-goes-lazy ()
|
|
"A dirty region larger than the lazy threshold is chunked, not sync."
|
|
(let ((ekp-auto-justify-lazy-threshold 50)
|
|
(ekp-auto-justify-chunk-size 2)
|
|
(text (mapconcat #'identity
|
|
(make-list 10 "大量粘贴模拟内容足够长会断行")
|
|
"\n")))
|
|
(ekp-region-test--with-text text
|
|
(cl-letf (((symbol-function 'ekp-region--window-pixel)
|
|
(lambda (&optional _) 60)))
|
|
(ekp-auto-justify-mode 1)
|
|
(unwind-protect
|
|
(progn
|
|
;; drain the enable-time lazy queue first
|
|
(let ((ekp-auto-justify-tick-budget 10.0) (guard 0))
|
|
(while (and ekp-region--pending (< guard 100))
|
|
(when (timerp ekp-region--chunk-timer)
|
|
(cancel-timer ekp-region--chunk-timer)
|
|
(setq ekp-region--chunk-timer nil))
|
|
(ekp-region--process-chunk (current-buffer))
|
|
(setq guard (1+ guard))))
|
|
;; simulate a huge edit: whole buffer marked dirty
|
|
(push (cons (copy-marker (point-min))
|
|
(copy-marker (point-max)))
|
|
ekp-region--dirty)
|
|
(when (timerp ekp-region--edit-timer)
|
|
(cancel-timer ekp-region--edit-timer))
|
|
(ekp-region--flush-dirty (current-buffer))
|
|
;; not processed synchronously: a queue exists
|
|
(should ekp-region--pending)
|
|
;; drain and verify convergence to the one-shot result
|
|
(let ((ekp-auto-justify-tick-budget 10.0) (guard 0))
|
|
(while (and ekp-region--pending (< guard 100))
|
|
(when (timerp ekp-region--chunk-timer)
|
|
(cancel-timer ekp-region--chunk-timer)
|
|
(setq ekp-region--chunk-timer nil))
|
|
(ekp-region--process-chunk (current-buffer))
|
|
(setq guard (1+ guard))))
|
|
(should-not ekp-region--pending)
|
|
(let ((lazy (buffer-string)))
|
|
(ekp-auto-justify-mode -1)
|
|
(ekp-justify-region (point-min) (point-max) 60)
|
|
(should (equal-including-properties (buffer-string) lazy))
|
|
(ekp-auto-justify-mode 1)))
|
|
(ekp-auto-justify-mode -1))))))
|
|
|
|
(ert-deftest ekp-region-test-prioritize-visible-chunks ()
|
|
"Chunks intersecting the visible span move to the queue front."
|
|
(ekp-region-test--with-text "abc"
|
|
(setq ekp-region--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-region--pending (cons 100 (list c1 c2 c3)))
|
|
(cl-letf (((symbol-function 'ekp-region--visible-span)
|
|
(lambda () (cons 3 4))))
|
|
(ekp-region--prioritize-visible))
|
|
(should (eq (cadr ekp-region--pending) c3))
|
|
(ekp-region--cancel-pending))))
|
|
|
|
(ert-deftest ekp-region-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-region-test--with-text text
|
|
(setq ekp-region--auto-width 40)
|
|
(setq ekp-region--pending
|
|
(cons 40 (ekp-region--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-region--pending))))
|
|
(cl-letf (((symbol-function 'input-pending-p) #'ignore))
|
|
(let ((ekp-auto-justify-mode t))
|
|
(ekp-region--process-chunk (current-buffer))))
|
|
(should (= (length (cdr ekp-region--pending)) (1- before))))
|
|
(when (timerp ekp-region--chunk-timer)
|
|
(cancel-timer ekp-region--chunk-timer)
|
|
(setq ekp-region--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-region--process-chunk (current-buffer)))))
|
|
(should-not ekp-region--pending))))
|
|
|
|
(provide 'ekp-region-tests)
|
|
|
|
;;; ekp-region-tests.el ends here
|