Optionally add spacing between ERC messages

* etc/ERC-NEWS: Mention option `erc-fill-line-spacing'.
* lisp/erc/erc-fill.el (erc-fill-line-spacing,
erc-fill-spaced-commands): Add options to allow for extra spacing
between messages.
(erc-fill--function): Internal var allowing modules to override user
option `erc-fill-function'.
(erc-fill): Add extra line-spacing on certain types of messages.
Prefer `erc-fill--function', when set, over `erc-fill-function'.
(erc-fill--make-module-dependency-msg,
erc-fill--wrap-ensure-dependencies): Rename former to latter and make
more useful.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable):
Refactor.
(erc-fill--wrap-fix): Remove unused function.
(erc-fill-wrap-nudge): Remove reference to nonexistent function in doc
string.
* test/lisp/erc/erc-fill-tests.el: (erc-fill-tests--graphic-dir): New
variable.
(erc-fill-tests--compare): Look in `erc-fill-tests--graphic-dir' for
graphical snapshots ignored by Git.
(erc-fill-line-spacing): New test.
* test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: New
file.  (Bug#60936)
This commit is contained in:
F. Jason Park 2023-05-07 07:28:56 -07:00
parent 38706abdf7
commit 75a412d78b
4 changed files with 110 additions and 85 deletions

View file

@ -90,6 +90,13 @@ from the same connection. This customization depends on the option
'frame'. If you find the name 'displayed' unhelpful, please suggest
an alternative by writing to the mailing list.
** Module 'fill' can add a bit of space between messages.
On graphical displays, it's now possible to add some breathing room
around certain messages via the new option 'erc-fill-line-spacing'.
This is especially handy when using the option 'erc-fill-wrap-merge'
to omit repeated speaker tags, which can make message boundaries less
detectable by tired eyes.
** Some keybindings are now set by modules rather than their libraries.
To put it another way, simply loading a built-in module's library no
longer modifies 'erc-mode-map'. Instead, modifications occur during

View file

@ -116,12 +116,30 @@ Set to nil to disable."
"The column at which a filled paragraph is broken."
:type 'integer)
(defcustom erc-fill-line-spacing nil
"Extra space between messages on graphical displays.
This may need adjusting depending on how your faces are
configured. Its value should be larger than that of the variable
`line-spacing', if set. If unsure, try 0.5."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) number))
(defcustom erc-fill-spaced-commands '(PRIVMSG NOTICE)
"Types of mesages to add space between on graphical displays.
Only considered when `erc-fill-line-spacing' is non-nil."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(set integer symbol))
(defvar-local erc-fill--function nil
"Internal copy of `erc-fill-function'.
Takes precedence over the latter when non-nil.")
;;;###autoload
(defun erc-fill ()
"Fill a region using the function referenced in `erc-fill-function'.
You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
(unless (erc-string-invisible-p (buffer-substring (point-min) (point-max)))
(when erc-fill-function
(when (or erc-fill--function erc-fill-function)
;; skip initial empty lines
(goto-char (point-min))
(save-match-data
@ -130,7 +148,19 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
(unless (eobp)
(save-restriction
(narrow-to-region (point) (point-max))
(funcall erc-fill-function))))))
(funcall (or erc-fill--function erc-fill-function))
(when-let* ((erc-fill-line-spacing)
(p (point-min)))
(widen)
(when (or (and-let* ((cmd (get-text-property p 'erc-command)))
(memq cmd erc-fill-spaced-commands))
(and-let* ((cmd (save-excursion
(forward-line -1)
(get-text-property (point)
'erc-command))))
(memq cmd erc-fill-spaced-commands)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
@ -264,71 +294,63 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
(defvar erc-button-mode)
(defvar erc-match--hide-fools-offset-bounds)
(defun erc-fill--make-module-dependency-msg (module)
(concat "Enabling default global module `" module "' needed by local"
" module `fill-wrap'. This will impact \C-]all\C-] ERC"
" sessions. Add `" module "' to `erc-modules' to avoid this"
" warning. See Info:\"(erc) Modules\" for more."))
(defun erc-fill--wrap-ensure-dependencies ()
(let (missing-deps)
(unless erc-fill-mode
(push 'fill missing-deps)
(erc-fill-mode +1))
(when erc-fill-wrap-merge
(require 'erc-button)
(unless erc-button-mode
(push 'button missing-deps)
(erc-button-mode +1))
(require 'erc-stamp)
(unless erc-stamp-mode
(push 'stamp missing-deps)
(erc-stamp-mode +1)))
(when missing-deps
(erc--warn-once-before-connect 'erc-fill-wrap-mode
"Enabling missing global modules %s needed by local"
" module `fill-wrap'. This will impact \C-]all\C-] ERC"
" sessions. Add them to `erc-modules' to avoid this"
" warning. See Info:\"(erc) Modules\" for more."
(mapcar (lambda (s) (format "`%s'" s)) missing-deps)))))
;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
This module displays nickname labels for speakers as overhanging
leftward (and thus right-aligned) to a common offset, as
determined by the option `erc-fill-static-center'. It depends on
the `fill' and `button' modules and assumes the option
This local module displays nicks overhanging leftward to a common
offset, as determined by the option `erc-fill-static-center'. It
depends on the `fill' and `button' modules and assumes the option
`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
or `erc-insert-timestamp-left-and-right' (recommended) so that it
or the default `erc-insert-timestamp-left-and-right', so that it
can display right-hand stamps in the right margin. A value of
`erc-insert-timestamp-left' is unsupported. This local module
depends on the global `fill' module. To use it, either include
`fill-wrap' in `erc-modules' or set `erc-fill-function' to
`erc-fill-wrap' (recommended). You can also manually invoke one
of the minor-mode toggles as usual."
((let (msg)
(unless erc-fill-mode
(unless (memq 'fill erc-modules)
(setq msg
;; FIXME use `erc-button--display-error-notice-with-keys'
;; when bug#60933 is ready.
(erc-fill--make-module-dependency-msg "fill")))
(erc-fill-mode +1))
(when erc-fill-wrap-merge
(require 'erc-button)
(unless erc-button-mode
(unless (memq 'button erc-modules)
(setq msg (concat msg (and msg " ")
(erc-fill--make-module-dependency-msg "button"))))
(erc-with-server-buffer
(erc-button-mode +1)))
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
;; Set local value of user option (can we avoid this somehow?)
(unless (eq erc-fill-function #'erc-fill-wrap)
(setq-local erc-fill-function #'erc-fill-wrap))
(when-let* ((vars (or erc--server-reconnecting erc--target-priors))
((alist-get 'erc-fill-wrap-mode vars)))
(setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys
vars)
erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
(add-function :filter-args (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
(when (or erc-stamp-mode (memq 'stamp erc-modules))
(erc-stamp--display-margin-mode +1))
(when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
(require 'erc-match)
(setq erc-match--hide-fools-offset-bounds t))
(setq erc-fill--wrap-value
(or erc-fill--wrap-value erc-fill-static-center))
(visual-line-mode +1)
(unless (local-variable-p 'erc-fill--wrap-visual-keys)
(setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
(when msg
(erc-display-error-notice nil msg))))
`erc-insert-timestamp-left' is unsupported. To use it, either
include `fill-wrap' in `erc-modules' or set `erc-fill-function'
to `erc-fill-wrap' (recommended). You can also manually invoke
one of the minor-mode toggles if really necessary."
((erc-fill--wrap-ensure-dependencies)
;; Restore or initialize local state variables.
(erc--restore-initialize-priors erc-fill-wrap-mode
erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys
erc-fill--wrap-value erc-fill-static-center)
(setq erc-fill--function #'erc-fill-wrap)
;; Internal integrations.
(add-function :filter-args (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
(when (or erc-stamp-mode (memq 'stamp erc-modules))
(erc-stamp--display-margin-mode +1))
(when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
(require 'erc-match)
(setq erc-match--hide-fools-offset-bounds t))
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
(visual-line-mode +1))
((when erc-stamp--display-margin-mode
(erc-stamp--display-margin-mode -1))
(kill-local-variable 'erc-fill--wrap-value)
(kill-local-variable 'erc-fill-function)
(kill-local-variable 'erc-fill--function)
(kill-local-variable 'erc-fill--wrap-visual-keys)
(remove-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p t)
@ -422,28 +444,6 @@ See `erc-fill-wrap-mode' for details."
(defun erc-fill--wrap-merged-button-p (point)
(equal "" (get-text-property point 'display)))
;; This is an experimental helper for third-party modules. You could,
;; for example, use this to automatically resize the prefix to a
;; fraction of the window's width on some event change. Another use
;; case would be to fix lines affected by toggling a display-oriented
;; mode, like `display-line-numbers-mode'.
(defun erc-fill--wrap-fix (&optional value)
"Re-wrap from `point-min' to `point-max'.
That is, recalculate the width of all accessible lines and reset
local prefix VALUE when non-nil."
(save-excursion
(when value
(setq erc-fill--wrap-value value))
(let ((inhibit-field-text-motion t)
(inhibit-read-only t))
(goto-char (point-min))
(while (and (zerop (forward-line))
(< (point) (min (point-max) erc-insert-marker)))
(save-restriction
(narrow-to-region (line-beginning-position) (line-end-position))
(erc-fill-wrap))))))
(defun erc-fill--wrap-nudge (arg)
(when (zerop arg)
(setq arg (- erc-fill-static-center erc-fill--wrap-value)))
@ -463,8 +463,7 @@ Offer to repeat command in a manner similar to
\\`)' Reset the right margin to the default
Note that misalignment may occur when messages contain
decorations applied by third-party modules. See
`erc-fill--wrap-fix' for a temporary workaround."
decorations applied by third-party modules."
(interactive "p")
(unless erc-fill--wrap-value
(cl-assert (not erc-fill-wrap-mode))

View file

@ -120,10 +120,14 @@
;; Obviously, only run one test at a time.
(defvar erc-fill-tests--save-p nil)
;; On graphical displays, echo .graphic >> .git/info/exclude
(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic")
(defun erc-fill-tests--compare (name)
(when (display-graphic-p)
(setq name (concat name "-graphic")))
(let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)))
(let* ((dir (expand-file-name (if (display-graphic-p)
erc-fill-tests--graphic-dir
"fill/snapshots/")
(ert-resource-directory)))
(expect-file (file-name-with-extension (expand-file-name name dir)
"eld"))
(erc--own-property-names
@ -232,6 +236,20 @@
"<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
(erc-fill-tests--compare "merge-02-right")))))
(ert-deftest erc-fill-line-spacing ()
:tags '(:unstable)
(unless (>= emacs-major-version 29)
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
(let ((erc-fill-line-spacing 0.5))
(erc-fill-tests--wrap-populate
(lambda ()
(erc-fill-tests--insert-privmsg "bob" "This buffer is for text.")
(erc-display-message nil 'notice (current-buffer) "one two three")
(erc-display-message nil 'notice (current-buffer) "four five six")
(erc-fill-tests--insert-privmsg "bob" "Somebody stop me")
(erc-fill-tests--compare "spacing-01-mono")))))
(ert-deftest erc-fill-wrap-visual-keys--body ()
:tags '(:unstable)
(erc-fill-tests--wrap-populate

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<bob> This buffer is for text.\n*** one two three\n*** four five six\n<bob> Somebody stop me\n" 2 21 (erc-timestamp 0 line-prefix (space :width (- 27 18)) field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (line-spacing 0.5 wrap-prefix #2# line-prefix #3#) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 27 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 348 349 (line-spacing 0.5 wrap-prefix #2# line-prefix #4#) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 27 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 435 436 (line-spacing 0.5 wrap-prefix #2# line-prefix #5#) 436 437 (erc-timestamp 0 wrap-prefix #2# line-prefix #6=(space :width (- 27 0)) display #7="" erc-command PRIVMSG) 437 440 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# display #7# erc-command PRIVMSG) 440 442 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# display #7# erc-command PRIVMSG) 442 466 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 467 (line-spacing 0.5 wrap-prefix #2# line-prefix #6#) 467 484 (erc-timestamp 0 wrap-prefix #2# line-prefix #8=(space :width (- 27 (4)))) 484 485 (wrap-prefix #2# line-prefix #8#) 485 502 (erc-timestamp 0 wrap-prefix #2# line-prefix #10=(space :width (- 27 (4)))) 502 503 (line-spacing 0.5 wrap-prefix #2# line-prefix #10#) 503 504 (erc-timestamp 0 wrap-prefix #2# line-prefix #9=(space :width (- 27 (6))) erc-command PRIVMSG) 504 507 (erc-timestamp 0 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 507 525 (erc-timestamp 0 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 525 526 (wrap-prefix #2# line-prefix #9#))