diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 1ac0719..2ce1345 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -26,7 +26,7 @@ jobs: run: | emacs -Q --batch -L . \ --eval '(setq byte-compile-error-on-warn t)' \ - -f batch-byte-compile ekp.el ekp-utils.el ekp-hyphen.el + -f batch-byte-compile ekp.el ekp-utils.el ekp-hyphen.el ekp-region.el - name: Run ERT suite (C-module tests auto-skip) run: tests/run-tests.sh emacs diff --git a/ekp-region.el b/ekp-region.el new file mode 100644 index 0000000..20109cf --- /dev/null +++ b/ekp-region.el @@ -0,0 +1,312 @@ +;;; ekp-region.el --- Buffer-level justification for ekp -*- lexical-binding: t; -*- + +;; Author: Kinney Zhang +;; Keywords: wp, convenience + +;;; Commentary: + +;; Interactive layer over the ekp string API. +;; +;; - `ekp-justify-region' / `ekp-unjustify-region': justify buffer text +;; in place. Unjustification is a pure structural transform driven by +;; the text properties the renderer leaves behind (`ekp-glue', +;; `ekp-soft-break', `ekp-soft-hyphen', `ekp-soft-trail'), so the +;; original text — including whitespace runs stripped at line breaks — +;; is recovered exactly, even after the justified text was edited. +;; +;; - `ekp-auto-justify-mode': keeps the whole buffer justified to the +;; window width. Re-flows (debounced) when the window width changes, +;; and incrementally re-justifies only the edited paragraphs after +;; edits, so large buffers stay responsive (unchanged paragraphs hit +;; the ekp paragraph cache). + +;;; Code: + +(require 'ekp) +(require 'cl-lib) + +(defvar ekp-auto-justify-mode) + +(defgroup ekp-region nil + "Buffer-level justification built on ekp." + :group 'text + :prefix "ekp-") + +(defcustom ekp-region-margin-pixel 2 + "Pixels subtracted from the window body width when justifying. +A small safety margin that keeps justified lines from being wrapped +by the display engine due to rounding." + :type 'natnum) + +(defcustom ekp-auto-justify-resize-delay 0.15 + "Seconds to debounce window-resize re-flows in `ekp-auto-justify-mode'." + :type 'number) + +(defcustom ekp-auto-justify-edit-delay 0.3 + "Idle seconds before edited paragraphs are re-justified." + :type 'number) + +(defvar ekp-region--inhibit nil + "Non-nil while ekp-region is modifying the buffer itself.") + +(defvar-local ekp-region--auto-width nil + "Pixel width the buffer is currently auto-justified to.") + +(defvar-local ekp-region--resize-timer nil) +(defvar-local ekp-region--edit-timer nil) +(defvar-local ekp-region--dirty nil + "Pending edited regions, as a list of (BEG-MARKER . END-MARKER).") + +;;;; Width + +(defun ekp-region--window-pixel (&optional window) + "Usable text width in pixels of WINDOW (default: selected window)." + (max 1 (- (window-body-width window t) ekp-region-margin-pixel))) + +;;;; Pure string transforms + +(defun ekp-region--split-hard (string) + "Split justified STRING on hard newlines (those without `ekp-soft-break')." + (let ((parts nil) (start 0) (i 0) (len (length string))) + (while (< i len) + (when (and (eq (aref string i) ?\n) + (not (get-text-property i 'ekp-soft-break string))) + (push (substring string start i) parts) + (setq start (1+ i))) + (setq i (1+ i))) + (push (substring string start) parts) + (nreverse parts))) + +(defun ekp-region--justify-string (text pixel) + "Return TEXT justified to PIXEL with exact-recovery markers. +Hard newlines are preserved one-to-one. Whitespace-only paragraphs +(which the string API would empty out) survive as hidden text." + (let* ((paras (split-string text "\n")) + (cores (cl-remove-if #'string-blank-p paras)) + (out (and cores + (ekp-region--split-hard + (ekp-pixel-justify (string-join cores "\n") pixel))))) + (unless (= (length out) (length cores)) + (error "ekp-region: paragraph count mismatch (%d vs %d)" + (length out) (length cores))) + (string-join + (mapcar (lambda (p) + (if (string-blank-p p) + (ekp--hide-string p) + (pop out))) + paras) + "\n"))) + +(defun ekp-region--pos-for-offset (string offset) + "Physical position in justified STRING for logical OFFSET. +Glue characters count for the length of the original text they +replaced (their `ekp-glue' value), soft breaks for their payload, +soft hyphens for nothing; everything else (including hidden text) +is one logical character." + (let ((i 0) (len (length string))) + (while (and (< i len) (> offset 0)) + (let ((glue (get-text-property i 'ekp-glue string))) + (cond + (glue + (setq offset (- offset (length glue)))) + ((get-text-property i 'ekp-soft-hyphen string)) + ((and (eq (aref string i) ?\n) + (get-text-property i 'ekp-soft-break string)) + (setq offset (- offset (length (get-text-property + i 'ekp-soft-break string))))) + (t (setq offset (1- offset))))) + (setq i (1+ i))) + i)) + +;;;; Commands + +;;;###autoload +(defun ekp-justify-region (beg end &optional pixel) + "Justify the text between BEG and END to PIXEL width. +PIXEL defaults to the window text width (see `ekp-region-margin-pixel'); +interactively, a numeric prefix argument supplies it explicitly. +Already-justified text is unjustified first, so the command is +idempotent and can re-flow to a new width." + (interactive + (list (region-beginning) (region-end) + (and current-prefix-arg (prefix-numeric-value current-prefix-arg)))) + (setq pixel (or pixel (ekp-region--window-pixel))) + (let ((beg (copy-marker (min beg end))) + (end (copy-marker (max beg end) t)) + (ekp-region--inhibit t) + (inhibit-read-only t)) + (unwind-protect + (atomic-change-group + ;; Re-flow support: strip previous justification first. + (when (text-property-not-all beg end 'ekp-justified nil) + (ekp-unjustify-region beg end)) + (let* ((text (buffer-substring beg end)) + (justified (ekp-region--justify-string text pixel)) + (point-offset (and (>= (point) beg) (< (point) end) + (- (point) beg)))) + (unless (equal-including-properties text justified) + (goto-char beg) + (delete-region beg end) + (insert justified) + (when point-offset + (goto-char (+ beg (ekp-region--pos-for-offset + justified point-offset))))) + (add-text-properties beg end (list 'ekp-justified pixel)))) + (set-marker beg nil) + (set-marker end nil)))) + +;;;###autoload +(defun ekp-unjustify-region (beg end) + "Restore the logical text between BEG and END. +Removes synthesized glue and soft hyphens, replaces soft line breaks +with the whitespace they swallowed, and re-exposes hidden paragraph +tails. Text the user typed into the justified region is preserved." + (interactive "r") + (let ((end-m (copy-marker (max beg end) t)) + (ekp-region--inhibit t) + (inhibit-read-only t)) + (unwind-protect + (save-excursion + (goto-char (min beg end)) + (while (< (point) end-m) + (let* ((pos (point)) + (glue (get-text-property pos 'ekp-glue))) + (cond + (glue + (delete-region pos (1+ pos)) + (when (stringp glue) (insert glue))) + ((get-text-property pos 'ekp-soft-hyphen) + (delete-region pos (1+ pos))) + ((and (eq (char-after pos) ?\n) + (get-text-property pos 'ekp-soft-break)) + (let ((payload (get-text-property pos 'ekp-soft-break))) + (delete-region pos (1+ pos)) + (insert payload))) + ((get-text-property pos 'ekp-hidden) + (remove-text-properties pos (1+ pos) + '(ekp-hidden nil display nil)) + (forward-char 1)) + (t (forward-char 1))))) + (remove-text-properties (min beg end) end-m '(ekp-justified nil))) + (set-marker end-m nil)))) + +;;;; Auto-justify minor mode + +(defun ekp-region--para-bounds (marker-pair) + "Hard-paragraph bounds containing MARKER-PAIR, as (BEG . END)." + (let ((b (marker-position (car marker-pair))) + (e (marker-position (cdr marker-pair)))) + (save-excursion + (goto-char (max (point-min) (min b (point-max)))) + (while (and (> (point) (point-min)) + (let ((prev (1- (point)))) + (not (and (eq (char-after prev) ?\n) + (not (get-text-property prev 'ekp-soft-break)))))) + (forward-char -1)) + (setq b (point)) + (goto-char (max (point-min) (min e (point-max)))) + (while (and (< (point) (point-max)) + (not (and (eq (char-after) ?\n) + (not (get-text-property (point) 'ekp-soft-break))))) + (forward-char 1)) + (cons b (point))))) + +(defun ekp-region--merge-regions (regions) + "Merge overlapping or adjacent (BEG . END) REGIONS." + (let ((sorted (sort regions (lambda (a b) (< (car a) (car b))))) + merged) + (dolist (r sorted) + (if (and merged (<= (car r) (cdr (car merged)))) + (setcdr (car merged) (max (cdr (car merged)) (cdr r))) + (push (cons (car r) (cdr r)) merged))) + (nreverse merged))) + +(defun ekp-region--after-change (beg end _len) + "Record the edit between BEG and END for incremental re-justification." + (when (and ekp-auto-justify-mode (not ekp-region--inhibit)) + (push (cons (copy-marker beg) (copy-marker end)) ekp-region--dirty) + (when (timerp ekp-region--edit-timer) + (cancel-timer ekp-region--edit-timer)) + (setq ekp-region--edit-timer + (run-with-idle-timer ekp-auto-justify-edit-delay nil + #'ekp-region--flush-dirty (current-buffer))))) + +(defun ekp-region--flush-dirty (buffer) + "Re-justify the paragraphs of BUFFER touched by recent edits." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (and ekp-auto-justify-mode ekp-region--dirty ekp-region--auto-width) + (let* ((pairs (prog1 ekp-region--dirty (setq ekp-region--dirty nil))) + ;; Convert all bounds to markers before the first + ;; re-justification shifts later positions. + (regions (mapcar (lambda (r) + (cons (copy-marker (car r)) + (copy-marker (cdr r) t))) + (ekp-region--merge-regions + (mapcar #'ekp-region--para-bounds pairs))))) + (dolist (r regions) + (ekp-justify-region (car r) (cdr r) ekp-region--auto-width) + (set-marker (car r) nil) + (set-marker (cdr r) nil)) + (dolist (p pairs) + (set-marker (car p) nil) + (set-marker (cdr p) nil))))))) + +(defun ekp-region--on-resize (window-or-frame) + "Debounced re-flow after WINDOW-OR-FRAME changed size. +Buffer-local members of `window-size-change-functions' receive the +window showing the buffer — and are not guaranteed to run with that +buffer current — so resolve both explicitly." + (let ((win (cond ((windowp window-or-frame) window-or-frame) + ((framep window-or-frame) + (get-buffer-window (current-buffer) window-or-frame)) + (t (get-buffer-window (current-buffer)))))) + (when (window-live-p win) + (with-current-buffer (window-buffer win) + (when ekp-auto-justify-mode + (let ((w (ekp-region--window-pixel win))) + (when (and ekp-region--auto-width (/= w ekp-region--auto-width)) + (when (timerp ekp-region--resize-timer) + (cancel-timer ekp-region--resize-timer)) + (setq ekp-region--resize-timer + (run-with-timer ekp-auto-justify-resize-delay nil + #'ekp-region--reflow + (current-buffer) w))))))))) + +(defun ekp-region--reflow (buffer width) + "Re-justify all of BUFFER to WIDTH." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when ekp-auto-justify-mode + (setq ekp-region--auto-width width) + (ekp-justify-region (point-min) (point-max) width))))) + +;;;###autoload +(define-minor-mode ekp-auto-justify-mode + "Keep the buffer pixel-justified to the window width. +Re-flows when the window width changes and re-justifies edited +paragraphs incrementally. Designed for reading and previewing; +the buffer text is restored exactly when the mode is turned off." + :lighter " EKP" + (if ekp-auto-justify-mode + (progn + (setq ekp-region--auto-width + (ekp-region--window-pixel (get-buffer-window))) + (ekp-justify-region (point-min) (point-max) ekp-region--auto-width) + (add-hook 'window-size-change-functions #'ekp-region--on-resize nil t) + (add-hook 'after-change-functions #'ekp-region--after-change nil t)) + (remove-hook 'window-size-change-functions #'ekp-region--on-resize t) + (remove-hook 'after-change-functions #'ekp-region--after-change t) + (when (timerp ekp-region--resize-timer) + (cancel-timer ekp-region--resize-timer)) + (when (timerp ekp-region--edit-timer) + (cancel-timer ekp-region--edit-timer)) + (setq ekp-region--resize-timer nil + ekp-region--edit-timer nil + ekp-region--dirty nil + ekp-region--auto-width nil) + (ekp-unjustify-region (point-min) (point-max)))) + +(provide 'ekp-region) + +;;; ekp-region.el ends here diff --git a/ekp.el b/ekp.el index 4dc83f6..bf53fc0 100644 --- a/ekp.el +++ b/ekp.el @@ -1425,41 +1425,25 @@ Each line's glues: [0 glue1 glue2 ... trailing-space]." (and box (not (string-empty-p box)) (or (string-blank-p box) (= (string-width box) 0)))) -(defun ekp--interleave (list1 list2) - "Interleave elements of LIST1 and LIST2." - (let (result) - (while (or list1 list2) - (when list1 (push (pop list1) result)) - (when list2 (push (pop list2) result))) - (nreverse result))) - -(defun ekp--combine-glues-and-boxes (glues boxes) - "Combine GLUES (n+1 elements) and BOXES (n elements) into string." - (let* ((glues (append glues nil)) - (last-glue (car (last glues))) - (glues (butlast glues)) - (boxes (append boxes nil))) - (if (= (length glues) (length boxes)) - (string-join (append (ekp--interleave glues boxes) - (list last-glue))) - (error "Glues count (%d) must equal boxes count (%d) + 1" - (1+ (length glues)) (length boxes))))) - (defun ekp--strip-line-spaces (line-boxes line-glues &optional strip-leading strip-trailing) "Strip leading/trailing space boxes from LINE-BOXES based on flags. STRIP-LEADING / STRIP-TRAILING: strip space boxes at that edge. -Returns (stripped-boxes . adjusted-glues). +LINE-GLUES is treated as an opaque list of n+1 glue values kept in +sync with the boxes. Returns (kept-boxes kept-glues nlead ntrail) +where NLEAD / NTRAIL count the boxes stripped at each edge. The stripped widths are NOT redistributed: the DP already excluded these space-box runs from its line metrics, so the remaining boxes plus distributed glues already fill the target width exactly." - (let* ((boxes (append line-boxes nil)) - (glues (append line-glues nil))) + (let ((boxes (append line-boxes nil)) + (glues (append line-glues nil)) + (nlead 0) (ntrail 0)) (when (> (length boxes) 0) ;; Strip trailing space boxes (if requested) (when strip-trailing (while (and boxes (ekp--box-space-p (car (last boxes)))) + (setq ntrail (1+ ntrail)) (setq boxes (butlast boxes)) ;; Remove second-to-last glue (the one before the trailing ;; space box); keep the last glue (line's trailing filler). @@ -1468,55 +1452,140 @@ plus distributed glues already fill the target width exactly." ;; Strip leading space boxes (if requested) (when strip-leading (while (and boxes (ekp--box-space-p (car boxes))) + (setq nlead (1+ nlead)) (setq boxes (cdr boxes)) ;; Remove the second glue (the one after the leading glue) (when (> (length glues) 1) (setq glues (cons (car glues) (cddr glues))))))) - (cons (vconcat boxes) glues))) + (list boxes glues nlead ntrail))) + +(defun ekp--box-offsets (string boxes) + "Locate each of BOXES in STRING; return a vector of (START . END). +Boxes are in order and separated only by characters the tokenizer +dropped (whitespace runs, zero-width breakers), so a sequential +leftmost scan aligns them unambiguously." + (let ((offsets (make-vector (length boxes) nil)) + (p 0) (i 0)) + (dolist (box boxes) + (let ((blen (length box))) + (while (not (eq t (compare-strings string p (+ p blen) box 0 blen))) + (setq p (1+ p))) + (aset offsets i (cons p (+ p blen))) + (setq p (+ p blen)) + (setq i (1+ i)))) + offsets)) + +(defun ekp--hide-string (string) + "Return STRING marked `ekp-hidden' and displayed as nothing." + (if (string-empty-p string) + string + (propertize string 'ekp-hidden t 'display ""))) + +(defun ekp--render-glue (pixel payload) + "Render a glue of PIXEL width that replaced original text PAYLOAD. +Zero-width glue renders as the hidden PAYLOAD itself, so no original +character is ever dropped." + (cond + ((> pixel 0) + (propertize " " 'display `(space :width (,pixel)) 'ekp-glue payload)) + (t (ekp--hide-string payload)))) (defun ekp--hyphen-for-box (box) - "Return a hyphen string styled like the end of BOX." + "Return a hyphen string styled like the end of BOX. +The `ekp-soft-hyphen' property marks it as synthesized, so +`ekp-unjustify-region' can strip it structurally." (let ((props (and (> (length box) 0) (text-properties-at (1- (length box)) box)))) - (if props (apply #'propertize "-" props) "-"))) + (apply #'propertize "-" 'ekp-soft-hyphen t props))) (defun ekp--pixel-justify (string line-pixel) - "Justify single-paragraph STRING to LINE-PIXEL." - (let* ((boxes (ekp--boxes string)) + "Justify single-paragraph STRING to LINE-PIXEL. + +The output is lossless with respect to STRING: +- synthesized spacing carries an `ekp-glue' property whose value is + the original text it replaced (usually a whitespace run), +- soft line breaks are newlines whose `ekp-soft-break' property holds + the original text swallowed around the break, +- original text outside any visible line (paragraph-edge whitespace) + survives as zero-display `ekp-hidden' text, +- break hyphens carry `ekp-soft-hyphen'. +`ekp-unjustify-region' inverts all four structurally." + (let* ((boxes (append (ekp--boxes string) nil)) + (offsets (ekp--box-offsets string boxes)) (breaks (ekp-line-breaks string line-pixel)) (num (length breaks)) (lines-glues (ekp-line-glues string line-pixel)) (hyphen-positions (ekp--hyphen-positions string)) - (start 0) strings) + (start 0) + ;; (rendered-text first-box-idx last-box-idx) per visible line + (lines nil)) (dotimes (i num) (let* ((end (nth i breaks)) (line-boxes (cl-subseq boxes start end)) - (line-glues-raw (mapcar #'ekp-pixel-spacing - (aref lines-glues i))) + (glue-pixels (append (aref lines-glues i) nil)) ;; Strip space boxes: ;; - First line (i=0): keep leading spaces (indentation) ;; - Other lines: strip leading spaces (break artifacts) ;; - All lines: strip trailing spaces (is-first-line (= i 0)) - (stripped (ekp--strip-line-spaces line-boxes line-glues-raw + (stripped (ekp--strip-line-spaces line-boxes glue-pixels (not is-first-line) t)) - (line-boxes (car stripped)) - (line-glues (cdr stripped)) + (kept (nth 0 stripped)) + (kept-glues (nth 1 stripped)) + (first-idx (+ start (nth 2 stripped))) ;; Check if last box of this line needs hyphen (need-hyphen (and (< i (1- num)) ; not last line (ekp--hyphenate-p hyphen-positions (1- end))))) - (when (and need-hyphen (> (length line-boxes) 0)) - (let ((last-idx (1- (length line-boxes)))) - (aset line-boxes last-idx - (concat (aref line-boxes last-idx) - (ekp--hyphen-for-box (aref line-boxes last-idx)))))) - (when (> (length line-boxes) 0) - (push (ekp--combine-glues-and-boxes line-glues line-boxes) - strings)) + (when kept + (let ((parts nil) (idx first-idx) (glues kept-glues) (n 0)) + (dolist (box kept) + (push (ekp--render-glue + (pop glues) + (if (> idx first-idx) + (substring string + (cdr (aref offsets (1- idx))) + (car (aref offsets idx))) + ;; leading glue of a line is always 0px and + ;; replaces nothing; edge text is handled by + ;; soft breaks / hidden runs below + "")) + parts) + (push box parts) + (setq idx (1+ idx) n (1+ n))) + (when need-hyphen + (push (ekp--hyphen-for-box (car (last kept))) parts)) + ;; trailing filler glue (synthesized, replaces nothing) + (push (ekp--render-glue (car glues) "") parts) + (push (list (apply #'concat (nreverse parts)) + first-idx (+ first-idx n -1)) + lines))) (setq start end))) - (mapconcat 'identity (nreverse strings) "\n"))) + (setq lines (nreverse lines)) + (if (null lines) + ;; Defensive: no visible box at all (blank paragraphs are + ;; filtered before this function). + (ekp--hide-string string) + (let* ((first-line (car lines)) + (last-line (car (last lines))) + (parts (list (ekp--hide-string + (substring string 0 + (car (aref offsets (nth 1 first-line))))))) + (prev nil)) + (dolist (line lines) + (when prev + (push (propertize "\n" 'ekp-soft-break + (substring string + (cdr (aref offsets (nth 2 prev))) + (car (aref offsets (nth 1 line))))) + parts)) + (push (nth 0 line) parts) + (setq prev line)) + (push (ekp--hide-string + (substring string (cdr (aref offsets (nth 2 last-line))))) + parts) + (apply #'concat (nreverse parts)))))) (defun ekp--validate-width (line-pixel) "Signal a user error unless LINE-PIXEL is a positive integer." diff --git a/readme.md b/readme.md index 81c2c61..8f19e22 100644 --- a/readme.md +++ b/readme.md @@ -64,6 +64,31 @@ engines produce **identical output**; Elisp is the always-available fallback. If the module on disk is older than the Elisp code expects, loading refuses with a message asking you to rebuild. +## Interactive Use (buffer & region) + +`ekp-region.el` turns the string API into buffer-level commands: + +```elisp +(require 'ekp-region) +``` + +- `M-x ekp-justify-region` — justify the region to the window text + width (with a numeric prefix argument, to that many pixels). +- `M-x ekp-unjustify-region` — restore the original text **exactly**, + including collapsed whitespace runs. Justification is lossless: every + synthesized space, soft line break, and soft hyphen carries the + original text it replaced, so restoring is a structural transform that + also works after you edited the justified text. +- `M-x ekp-auto-justify-mode` — keep the whole buffer justified to the + window width. Re-flows (debounced by + `ekp-auto-justify-resize-delay`) when the window width changes, and + after edits re-justifies only the touched paragraphs + (`ekp-auto-justify-edit-delay`), so unchanged paragraphs hit the + paragraph cache. Turning the mode off restores the buffer exactly. + +`ekp-region-margin-pixel` (default 2) is subtracted from the window +width as a rounding safety margin. + ## Configuration ### Hyphenation language diff --git a/readme_zh.md b/readme_zh.md index 6b5e4f1..ca7a421 100644 --- a/readme_zh.md +++ b/readme_zh.md @@ -57,6 +57,26 @@ cd ekp_c && make # 需要 C11 编译器,产出 ekp.dylib/.so/.dll Elisp 与 C 两个引擎的输出**完全一致**;Elisp 是永远可用的后备。若磁盘 上的模块版本旧于 Elisp 代码的要求,加载会拒绝并提示重新编译。 +## 交互使用(buffer 与 region) + +`ekp-region.el` 把字符串 API 变成 buffer 级命令: + +```elisp +(require 'ekp-region) +``` + +- `M-x ekp-justify-region` — 把选区排版到窗口文本宽度(数字前缀参数 + 可指定像素宽)。 +- `M-x ekp-unjustify-region` — **精确**还原原文,包括被折叠的连续空 + 格。排版是无损的:每个合成空隙、软换行、软连字符都携带它所替换的 + 原文,还原是纯结构变换,即使排版后又编辑过也能正确还原。 +- `M-x ekp-auto-justify-mode` — 让整个 buffer 保持按窗口宽度排版。 + 窗口宽度变化时自动重排(防抖延迟 `ekp-auto-justify-resize-delay`); + 编辑后只重排被改动的段落(空闲延迟 `ekp-auto-justify-edit-delay`), + 未变段落直接命中段落缓存。关闭 mode 时 buffer 精确恢复原状。 + +`ekp-region-margin-pixel`(默认 2)是从窗口宽度中扣除的取整安全边距。 + ## 配置 ### 断词语言 diff --git a/tests/ekp-region-tests.el b/tests/ekp-region-tests.el new file mode 100644 index 0000000..e80726d --- /dev/null +++ b/tests/ekp-region-tests.el @@ -0,0 +1,208 @@ +;;; 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-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)))))) + +(provide 'ekp-region-tests) + +;;; ekp-region-tests.el ends here diff --git a/tests/run-tests.sh b/tests/run-tests.sh index 10cbcd9..bb12abe 100755 --- a/tests/run-tests.sh +++ b/tests/run-tests.sh @@ -7,4 +7,5 @@ ROOT="$(cd "$(dirname "$0")/.." && pwd)" exec "$EMACS" -Q --batch -L "$ROOT" \ -l "$ROOT/tests/ekp-tests.el" \ + -l "$ROOT/tests/ekp-region-tests.el" \ -f ert-run-tests-batch-and-exit