procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add merged-message indicator option for erc-fill-wrap

Browse source 
* 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)
This commit is contained in:
F. Jason Park 2023-11-19 17:18:29 -08:00
parent 8bb68a522f
commit 7cbe6ae712
4 changed files with 106 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

93
lisp/erc/erc-fill.el
View file

@ -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

21
test/lisp/erc/erc-fill-tests.el
View file

@ -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
"*** " "<alice> " "<bob> " "<bob> " "* bob " "<bob> " "* " "<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)

1
test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld Normal file
View file

@ -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<alice> 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<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> 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#))

1
test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld Normal file
View file

@ -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<alice> 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<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> 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#))