From: F. Jason Park Date: Mon, 20 Nov 2023 01:18:29 +0000 (-0800) Subject: Add merged-message indicator option for erc-fill-wrap X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7cbe6ae7124cade32bce1268212e2279dcb6df20;p=emacs.git Add merged-message indicator option for erc-fill-wrap * lisp/erc/erc-fill.el (erc-fill): Use `when-let' instead of `when-let*'. (erc-fill-wrap-merge): Mention companion options in doc string. (erc-fill-wrap-merge-indicator): New option to display a distinguishing "indicator" in the form of a one-character string between messages from the same speaker. (erc-fill-wrap-mode, erc-fill-wrap-disable): Mention `erc-fill-wrap-merge-indicator' in doc string and kill related local variables. (erc-fill--wrap-merge-indicator-pre, erc-fill--wrap-merge-indicator-post): New internal variables for caching merge indicator. (erc-fill--wrap-insert-merged-post, erc-fill--wrap-insert-merged-pre): New functions for adding merge indicators either before or after a message. (erc-fill-wrap): Add logic for deferring to merge-indicator helpers when needed. * test/lisp/erc/erc-fill-tests.el (erc-fill-wrap-tests--merge-action, erc-fill-wrap--merge-action): Move body of latter test into former, a new fixture function. (erc-fill-wrap--merge-action/indicator-pre, erc-fill-wrap--merge-action/indicator-post): New tests. * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld: New test data file. * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld: New test data file. (Bug#60936) --- diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 50b5aefd27a..83f60fd3162 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -173,8 +173,8 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'." (save-restriction (narrow-to-region (point) (point-max)) (funcall (or erc-fill--function erc-fill-function)) - (when-let* ((erc-fill-line-spacing) - (p (point-min))) + (when-let ((erc-fill-line-spacing) + (p (point-min))) (widen) (when (or (erc--check-msg-prop 'erc-msg 'msg) (and-let* ((m (save-excursion @@ -258,12 +258,41 @@ the value of `erc-fill-wrap-visual-keys'." :type '(set (const nil) (const non-input))) (defcustom erc-fill-wrap-merge t - "Whether to consolidate messages from the same speaker. -This tells ERC to omit redundant speaker labels for subsequent -messages less than a day apart." + "Whether to consolidate consecutive messages from the same speaker. +When non-nil, ERC omits redundant speaker labels for subsequent +messages less than a day apart. To help distinguish between +merged messages, see related options `erc-fill-line-spacing', for +graphical displays, and `erc-fill-wrap-merge-indicator' for text +terminals." :package-version '(ERC . "5.6") :type 'boolean) +(defcustom erc-fill-wrap-merge-indicator nil + "Indicator to help distinguish between merged messages. +Only matters when the option `erc-fill-wrap-merge' is enabled. +If the first element is the symbol `pre', ERC uses this option to +generate a replacement for the speaker's name tag. If the first +element is `post', ERC affixes a short string to the end of the +previous message. (Note that the latter variant nullifies any +intervening padding supplied by `erc-fill-line-spacing' and is +meant to supplant that option in text terminals.) In either +case, the second element should be a character, like ?>, and the +last element a valid face. When in doubt, try the first prefab +choice, (pre #xb7 shadow), which replaces a continued speaker's +name with a nondescript dot-product-like glyph in `shadow' face. +This option is currently experimental, and changing its value +mid-session is not supported." + :package-version '(ERC . "5.6") + :type '(choice (const nil) + (const :tag "Leading MIDDLE DOT as speaker (U+00B7)" + (pre #xb7 shadow)) + (const :tag "Trailing PARAGRAPH SIGN (U+00B6)" + (post #xb6 shadow)) + (const :tag "Leading > as speaker" (pre ?> shadow)) + (const :tag "Trailing ~" (post ?~ shadow)) + (list :tag "User-provided" + (choice (const pre) (const post)) character face))) + (defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args) (apply (pcase erc-fill--wrap-visual-keys ('non-input @@ -417,7 +446,8 @@ cycling between logical- and screen-line oriented command 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'. +`erc-fill-line-spacing', `erc-fill-wrap-merge', and +`erc-fill-wrap-merge-indicator'. This module imposes various restrictions on the appearance of timestamps. Most notably, it insists on displaying them in the @@ -471,6 +501,8 @@ is not recommended." (kill-local-variable 'erc-fill--wrap-visual-keys) (kill-local-variable 'erc-fill--wrap-last-msg) (kill-local-variable 'erc--inhibit-prompt-display-property-p) + (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) + (kill-local-variable 'erc-fill--wrap-merge-indicator-post) (remove-hook 'erc--refresh-prompt-hook #'erc-fill--wrap-indent-prompt) (remove-hook 'erc-button--prev-next-predicate-functions @@ -550,6 +582,49 @@ to be disabled." (defvar erc-fill--wrap-action-dedent-p t "Whether to dedent speakers in CTCP \"ACTION\" lines.") +(defvar-local erc-fill--wrap-merge-indicator-pre nil) +(defvar-local erc-fill--wrap-merge-indicator-post nil) + +;; To support `erc-fill-line-spacing' with the "post" variant, we'd +;; need to use a new "replacing" `display' spec value for each +;; insertion, and add a sentinel property alongside it atop every +;; affected newline, e.g., (erc-fill-eol-display START-POS), where +;; START-POS is the position of the newline in the replacing string. +;; Then, upon spotting this sentinel in `erc-fill' (and maybe +;; `erc-fill-wrap-refill-buffer'), we'd add `line-spacing' to the +;; corresponding `display' replacement, starting at START-POS. +(defun erc-fill--wrap-insert-merged-post () + "Add `display' property at end of previous line." + (save-excursion + (goto-char (point-min)) + (save-restriction + (widen) + (cl-assert (= ?\n (char-before (point)))) + (unless erc-fill--wrap-merge-indicator-pre + (let ((option erc-fill-wrap-merge-indicator)) + (setq erc-fill--wrap-merge-indicator-pre + (propertize (concat (string (nth 1 option)) "\n") + 'font-lock-face (nth 2 option))))) + (unless (eq (field-at-pos (- (point) 2)) 'erc-timestamp) + (put-text-property (1- (point)) (point) + 'display erc-fill--wrap-merge-indicator-pre))) + 0)) + +(defun erc-fill--wrap-insert-merged-pre () + "Add `display' property in lieu of speaker." + (if erc-fill--wrap-merge-indicator-post + (progn + (put-text-property (point-min) (point) 'display + (car erc-fill--wrap-merge-indicator-post)) + (cdr erc-fill--wrap-merge-indicator-post)) + (let* ((option erc-fill-wrap-merge-indicator) + (s (concat (propertize (string (nth 1 option)) + 'font-lock-face (nth 2 option)) + " "))) + (put-text-property (point-min) (point) 'display s) + (cdr (setq erc-fill--wrap-merge-indicator-post + (cons s (erc-fill--wrap-measure (point-min) (point)))))))) + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." @@ -583,7 +658,11 @@ See `erc-fill-wrap-mode' for details." (erc-fill--wrap-continued-message-p)) (put-text-property (point-min) (point) 'display "") - 0) + (if erc-fill-wrap-merge-indicator + (pcase (car erc-fill-wrap-merge-indicator) + ('pre (erc-fill--wrap-insert-merged-pre)) + ('post (erc-fill--wrap-insert-merged-post))) + 0)) (t (erc-fill--wrap-measure (point-min) (point)))))))) (add-text-properties diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index c21f3935503..bfdf8cd7320 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -294,8 +294,7 @@ (erc-fill-tests--simulate-refill) ; idempotent (erc-fill-tests--compare "merge-02-right")))))) -(ert-deftest erc-fill-wrap--merge-action () - :tags '(:unstable) +(defun erc-fill-wrap-tests--merge-action (compare-file) (unless (>= emacs-major-version 29) (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) @@ -336,7 +335,23 @@ (should (= erc-fill--wrap-value 27)) (erc-fill-tests--wrap-check-prefixes "*** " " " " " " " "* bob " " " "* " " ") - (erc-fill-tests--compare "merge-wrap-01")))) + (erc-fill-tests--compare compare-file)))) + +(ert-deftest erc-fill-wrap--merge-action () + :tags '(:unstable) + (erc-fill-wrap-tests--merge-action "merge-wrap-01")) + +(ert-deftest erc-fill-wrap--merge-action/indicator-pre () + :tags '(:unstable) + (let ((erc-fill-wrap-merge-indicator '(pre ?> shadow))) + (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-pre-01"))) + +;; One crucial thing this test asserts is that the indicator is +;; omitted when the previous line ends in a stamp. +(ert-deftest erc-fill-wrap--merge-action/indicator-post () + :tags '(:unstable) + (let ((erc-fill-wrap-merge-indicator '(post ?~ shadow))) + (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-post-01"))) (ert-deftest erc-fill-line-spacing () :tags '(:unstable) diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld new file mode 100644 index 00000000000..893588c028f --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc-msg datestamp erc-ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld new file mode 100644 index 00000000000..2b67cbbf90e --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero.[07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc-msg datestamp erc-ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file