diff --git a/ekp-region.el b/ekp-region.el index 83b38c7..895720a 100644 --- a/ekp-region.el +++ b/ekp-region.el @@ -71,9 +71,15 @@ rest follows in idle background chunks." :type 'natnum) (defcustom ekp-auto-justify-chunk-size 10 - "Paragraphs re-justified per background tick in lazy re-flows." + "Paragraphs re-justified per background chunk in lazy re-flows." :type 'natnum) +(defcustom ekp-auto-justify-tick-budget 0.005 + "Seconds of work per background tick in lazy re-flows. +Each tick processes chunks until the budget is exhausted (at least +one), then yields back to the command loop." + :type 'number) + (defconst ekp-region-org-skip-faces '(org-block org-block-begin-line org-block-end-line org-code org-verbatim org-table org-meta-line) @@ -609,15 +615,75 @@ composition the user is still typing." (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)) + (mapcar #'ekp-region--para-bounds pairs)))) + (total (cl-reduce #'+ regions + :key (lambda (r) (- (cdr r) (car r))) + :initial-value 0))) + (if (> total ekp-auto-justify-lazy-threshold) + ;; A huge dirty area (big paste, revert): chunk it like + ;; a lazy re-flow instead of freezing the command loop. + (progn + (ekp-region--enqueue-chunks + (mapcan (lambda (r) + (prog1 (ekp-region--make-chunks (car r) (cdr r)) + (set-marker (car r) nil) + (set-marker (cdr r) nil))) + regions)) + (ekp-region--prioritize-visible)) + (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--enqueue-chunks (chunks) + "Queue CHUNKS for background processing at the current auto width. +Prepends to an existing queue at the same width (edits win over the +tail of a resize re-flow); anything queued for a stale width was +already superseded and is dropped." + (when chunks + (if (and ekp-region--pending + (eql (car ekp-region--pending) ekp-region--auto-width)) + (setcdr ekp-region--pending + (nconc chunks (cdr ekp-region--pending))) + (ekp-region--cancel-pending) + (setq ekp-region--pending (cons ekp-region--auto-width chunks))) + (unless (timerp ekp-region--chunk-timer) + (setq ekp-region--chunk-timer + (run-with-timer 0.02 nil #'ekp-region--process-chunk + (current-buffer)))))) + +(defun ekp-region--prioritize-visible () + "Move queued chunks that intersect the visible span to the front. +Scrolling into an unprocessed area should not have to wait for the +whole queue." + (when (cdr ekp-region--pending) + (pcase-let ((`(,vbeg . ,vend) (ekp-region--visible-span))) + (let* ((chunks (cdr ekp-region--pending)) + (vis (cl-remove-if-not + (lambda (c) (and (< (car c) vend) (> (cdr c) vbeg))) + chunks)) + (rest (cl-remove-if + (lambda (c) (memq c vis)) + chunks))) + (setcdr ekp-region--pending (nconc vis rest)))))) + +(defun ekp-region--on-scroll (window _start) + "Re-prioritize the lazy queue after WINDOW scrolled. +Runs off a zero timer: inside `window-scroll-functions' the window's +final extent is not known yet." + (let ((buf (window-buffer window))) + (when (buffer-live-p buf) + (run-with-timer + 0 nil + (lambda () + (when (buffer-live-p buf) + (with-current-buffer buf + (when (and ekp-auto-justify-mode ekp-region--pending) + (ekp-region--prioritize-visible))))))))) + (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 @@ -699,17 +765,27 @@ window splits, and deletions of the narrowest window." ;; a newer re-flow superseded this queue ((not (eql (car ekp-region--pending) ekp-region--auto-width)) (ekp-region--cancel-pending)) - ;; be polite: yield to pending input, try again shortly - ((input-pending-p) + ;; be polite: yield to pending input and live compositions + ((or (input-pending-p) (ekp-region--composing-p)) (setq ekp-region--chunk-timer (run-with-timer 0.1 nil #'ekp-region--process-chunk buffer))) (t - (let* ((width (car ekp-region--pending)) - (chunk (pop (cdr ekp-region--pending)))) - (when chunk - (ekp-justify-region (car chunk) (cdr chunk) width) - (set-marker (car chunk) nil) - (set-marker (cdr chunk) nil)) + (let ((width (car ekp-region--pending)) + (deadline (+ (float-time) ekp-auto-justify-tick-budget)) + (first t)) + ;; Work until the tick budget runs out — at least one chunk, + ;; never with input waiting. Peek-then-pop: an abort inside + ;; justification must not lose the chunk. + (while (and (cdr ekp-region--pending) + (or first + (and (< (float-time) deadline) + (not (input-pending-p))))) + (setq first nil) + (let ((chunk (cadr ekp-region--pending))) + (ekp-justify-region (car chunk) (cdr chunk) width) + (setcdr ekp-region--pending (cddr ekp-region--pending)) + (set-marker (car chunk) nil) + (set-marker (cdr chunk) nil))) (if (cdr ekp-region--pending) (setq ekp-region--chunk-timer (run-with-timer 0.02 nil @@ -778,6 +854,7 @@ the buffer text is restored exactly when the mode is turned off." (add-hook 'window-size-change-functions #'ekp-region--on-resize nil t) (add-hook 'window-configuration-change-hook #'ekp-region--on-window-change nil t) + (add-hook 'window-scroll-functions #'ekp-region--on-scroll nil t) (add-hook 'after-change-functions #'ekp-region--after-change nil t) (ekp-region--install-integrations) ;; Turning the major mode off/over kills local hooks silently; @@ -786,6 +863,7 @@ the buffer text is restored exactly when the mode is turned off." (remove-hook 'window-size-change-functions #'ekp-region--on-resize t) (remove-hook 'window-configuration-change-hook #'ekp-region--on-window-change t) + (remove-hook 'window-scroll-functions #'ekp-region--on-scroll t) (remove-hook 'after-change-functions #'ekp-region--after-change t) (remove-hook 'change-major-mode-hook #'ekp-region--teardown t) (ekp-region--teardown) diff --git a/tests/ekp-region-tests.el b/tests/ekp-region-tests.el index a2e8d08..e21c304 100644 --- a/tests/ekp-region-tests.el +++ b/tests/ekp-region-tests.el @@ -506,6 +506,97 @@ they must not travel with a kill/yank." (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