From: F. Jason Park Date: Thu, 21 Sep 2023 13:54:27 +0000 (-0700) Subject: Add command to refill buffer in erc-fill-wrap-mode X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=52af0a5fb97bd80f8c683f1286cdb33b319add2e;p=emacs.git Add command to refill buffer in erc-fill-wrap-mode * lisp/erc/erc-fill.el (erc-fill-function, erc-fill-wrap-mode): Mention new command `erc-fill-wrap-refill-buffer' in doc string. (erc-fill--wrap-rejigger-last-message): New internal variable. (erc-fill--wrap-rejigger-region, erc-fill-wrap-refill-buffer): New command and helper function for fixing alignment issues that arise, for example, from adjusting pixel-display widths of buffer text during a session. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--simulate-refill): New function for approximating `erc-fill-wrap-refill-buffer'. (erc-fill-wrap--merge): Assert refilling is idempotent. (Bug#60936) --- diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 3f5c8377868..58aab176b66 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -86,10 +86,12 @@ function is called. A third style resembles static filling but \"wraps\" instead of fills, thanks to `visual-line-mode' mode, which ERC automatically -enables when this option is `erc-fill-wrap' or when -`erc-fill-wrap-mode' is active. Set `erc-fill-static-center' to -your preferred initial \"prefix\" width. For adjusting the width -during a session, see the command `erc-fill-wrap-nudge'." +enables when this option is `erc-fill-wrap' or when the module +`fill-wrap' is active. Use `erc-fill-static-center' to specify +an initial \"prefix\" width and `erc-fill-wrap-margin-width' +instead of `erc-fill-column' for influencing initial message +width. For adjusting these during a session, see the commands +`erc-fill-wrap-nudge' and `erc-fill-wrap-refill-buffer'." :type '(choice (const :tag "Variable Filling" erc-fill-variable) (const :tag "Static Filling" erc-fill-static) (const :tag "Dynamic word-wrap" erc-fill-wrap) @@ -403,15 +405,19 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. This module displays nicks overhanging leftward to a common -offset, as determined by the option `erc-fill-static-center'. To -use it, either include `fill-wrap' in `erc-modules' or set -`erc-fill-function' to `erc-fill-wrap'. Most users will want to -enable the `scrolltobottom' module as well. Once active, use +offset, as determined by the option `erc-fill-static-center'. +And it \"wraps\" messages at a common margin width, as determined +by the option `erc-fill-wrap-margin-width'. To use it, either +include `fill-wrap' in `erc-modules' or set `erc-fill-function' +to `erc-fill-wrap'. Most users will want to enable the +`scrolltobottom' module as well. Once active, use \\[erc-fill-wrap-nudge] to adjust the width of the indent and the stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for cycling between logical- and screen-line oriented command -movement. Also see related options `erc-fill-line-spacing' and -`erc-fill-wrap-merge'. +movement. Similarly, use \\[erc-fill-wrap-refill-buffer] to fix +alignment problems after running certain commands, like +`text-scale-adjust'. Also see related stylistic options +`erc-fill-line-spacing' and `erc-fill-wrap-merge'. This module imposes various restrictions on the appearance of timestamps. Most notably, it insists on displaying them in the @@ -565,6 +571,78 @@ See `erc-fill-wrap-mode' for details." 'erc-fill--wrap-value)) wrap-prefix (space :width erc-fill--wrap-value)))))) +(defvar erc-fill--wrap-rejigger-last-message nil + "Temporary working instance of `erc-fill--wrap-last-msg'.") + +(defun erc-fill--wrap-rejigger-region (start finish on-next repairp) + "Recalculate `line-prefix' from START to FINISH. +After refilling each message, call ON-NEXT with no args. But +stash and restore `erc-fill--wrap-last-msg' before doing so, in +case this module's insert hooks run by way of the process filter. +With REPAIRP, destructively fill gaps and re-merge speakers." + (goto-char start) + (cl-assert (null erc-fill--wrap-rejigger-last-message)) + (let (erc-fill--wrap-rejigger-last-message) + (while-let + (((< (point) finish)) + (beg (if (get-text-property (point) 'line-prefix) + (point) + (next-single-property-change (point) 'line-prefix))) + (val (get-text-property beg 'line-prefix)) + (end (text-property-not-all beg finish 'line-prefix val))) + ;; If this is a left-side stamp on its own line. + (remove-text-properties beg (1+ end) '(line-prefix nil wrap-prefix nil)) + (when-let ((repairp) + (dbeg (text-property-not-all beg end 'display nil)) + ((get-text-property (1+ dbeg) 'erc-speaker)) + (dval (get-text-property dbeg 'display)) + ((equal "" dval))) + (remove-text-properties + dbeg (text-property-not-all dbeg end 'display dval) '(display))) + (let* ((pos (if (eq 'date-left (get-text-property beg 'erc-stamp-type)) + (field-beginning beg) + beg)) + (erc--msg-props (map-into (text-properties-at pos) 'hash-table)) + (erc-stamp--current-time (gethash 'erc-ts erc--msg-props))) + (save-restriction + (narrow-to-region beg (1+ end)) + (let ((erc-fill--wrap-last-msg erc-fill--wrap-rejigger-last-message)) + (erc-fill-wrap) + (setq erc-fill--wrap-rejigger-last-message + erc-fill--wrap-last-msg)))) + (when on-next + (funcall on-next)) + ;; Skip to end of message upon encountering accidental gaps + ;; introduced by third parties (or bugs). + (if-let (((/= ?\n (char-after end))) + (next (erc--get-inserted-msg-bounds 'end beg))) + (progn + (cl-assert (= ?\n (char-after next))) + (when repairp ; eol <= next + (put-text-property end (pos-eol) 'line-prefix val)) + (goto-char next)) + (goto-char end))))) + +(defun erc-fill-wrap-refill-buffer (repair) + "Recalculate all `fill-wrap' prefixes in the current buffer. +With REPAIR, attempt to refresh \"speaker merges\", which may be +necessary after revealing previously hidden text with commands +like `erc-match-toggle-hidden-fools'." + (interactive "P") + (unless erc-fill-wrap-mode + (user-error "Module `fill-wrap' not active in current buffer.")) + (save-excursion + (with-silent-modifications + (let* ((rep (make-progress-reporter + "Rewrap" 0 (line-number-at-pos erc-insert-marker) 1)) + (seen 0) + (callback (lambda () + (progress-reporter-update rep (cl-incf seen)) + (accept-process-output nil 0.000001)))) + (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker + callback repair) + (progress-reporter-done rep))))) + ;; FIXME use own text property to avoid false positives. (defun erc-fill--wrap-merged-button-p (point) (equal "" (get-text-property point 'display))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 8f0c8f9ccf4..f6c4c268017 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -234,6 +234,13 @@ (erc-fill-tests--wrap-check-prefixes "*** " " " " ") (erc-fill-tests--compare "monospace-04-reset"))))) +(defun erc-fill-tests--simulate-refill () + ;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without + ;; a progress reporter. + (save-excursion + (with-silent-modifications + (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker nil nil)))) + (ert-deftest erc-fill-wrap--merge () :tags '(:unstable) (unless (>= emacs-major-version 29) @@ -245,7 +252,9 @@ (erc-update-channel-member "#chan" "Dummy" "Dummy" t nil nil nil nil nil "fake" "~u" nil nil t) - ;; Set this here so that the first few messages are from 1970 + ;; Set this here so that the first few messages are from 1970. + ;; Following the current date stamp, the speaker isn't merged + ;; even though it's continued: " zero." (let ((erc-fill-tests--time-vals (lambda () 1680332400))) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "alice" "one.") @@ -267,7 +276,12 @@ (erc-fill-tests--wrap-check-prefixes "*** " " " " " " " " " " " " " " " " " " ") - (erc-fill-tests--compare "merge-02-right"))))) + (erc-fill-tests--compare "merge-02-right") + + (ert-info ("Command `erc-fill-wrap-refill-buffer' is idempotent") + (kill-buffer (pop erc-fill-tests--buffers)) + (erc-fill-tests--simulate-refill) ; idempotent + (erc-fill-tests--compare "merge-02-right")))))) (ert-deftest erc-fill-wrap--merge-action () :tags '(:unstable)