* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
@ 2023-01-18 15:01 ` J.P.
2023-01-25 14:11 ` J.P.
` (24 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-01-18 15:01 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
Brief demo (video/webm):
https://debbugs.gnu.org/cgi/bugreport.cgi?filename=wrap_demo.webm;msg=6;bug=60936;att=1
^ permalink raw reply [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
2023-01-18 15:01 ` J.P.
@ 2023-01-25 14:11 ` J.P.
2023-01-27 14:31 ` J.P.
` (23 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-01-25 14:11 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 222 bytes --]
v3. Accommodate variable-pitch faces on graphical displays. Use
`defvar-keymap', now available in the latest Compat.
Screenshot:
https://debbugs.gnu.org/cgi/bugreport.cgi?msg=11;filename=fill-wrap-vp.png;bug=60936;att=1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 11902 bytes --]
From 19ddf027ab3cbfde020e43cdb2bcece828c6638f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 25 Jan 2023 05:51:53 -0800
Subject: [PATCH 0/4] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (4):
[5.6] Adjust some old text properties in ERC buffers
[5.6] Leverage display properties better in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-fill.el | 281 ++++++++++++++++++++++++++++---
lisp/erc/erc-stamp.el | 66 +++++++-
lisp/erc/erc.el | 3 +-
test/lisp/erc/erc-fill-tests.el | 162 ++++++++++++++++++
test/lisp/erc/erc-stamp-tests.el | 178 ++++++++++++++++++++
6 files changed, 656 insertions(+), 35 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
Interdiff:
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 6a461786be1..a05f2a558f8 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -228,20 +231,15 @@ erc-fill-wrap-cycle-visual-movement
('display nil))))
(message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement))
-;; We could just override `visual-line-mode-map' locally, but that
-;; seems pretty hacky.
-(defvar erc-fill-wrap-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map visual-line-mode-map)
- (define-key map [remap kill-line] #'erc-fill--wrap-kill-line)
- (define-key map [remap move-end-of-line] #'erc-fill--wrap-end-of-line)
- (define-key map [remap move-beginning-of-line]
- #'erc-fill--wrap-beginning-of-line)
- ;; This is redundant anyway (right?).
- (define-key map "\C-c\C-a" #'erc-fill-wrap-cycle-visual-movement)
- ;; Not sure if this is dumb because `erc-bol' takes no args.
- (define-key map [remap erc-bol] #'erc-fill--wrap-beginning-of-line)
- map))
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c c" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
@@ -295,6 +293,10 @@ erc-fill--wrap-length-function
nickname, including any enclosing brackets, or nil, to fall back
to the default behavior of taking the length from the first word.")
+(defvar erc-fill--wrap-use-pixels t)
+(declare-function buffer-text-pixel-size "xdisp"
+ (&optional buffer-or-name window x-limit y-limit))
+
(defun erc-fill-wrap ()
"Use text props to mimic the effect of `erc-fill-static'.
See `erc-fill-wrap-mode' for details."
@@ -302,13 +304,20 @@ erc-fill-wrap
(erc-fill-wrap-mode +1))
(save-excursion
(goto-char (point-min))
- (let ((len (or (and erc-fill--wrap-length-function
- (funcall erc-fill--wrap-length-function))
- (progn (skip-syntax-forward "^-")
- (- (point) (point-min))))))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill--wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
(erc-put-text-properties (point-min) (point-max)
'(line-prefix wrap-prefix) nil
- `((space :width ,(- erc-fill--wrap-value 1 len))
+ `((space :width (- ,erc-fill--wrap-value ,len))
,erc-fill--wrap-prefix)))))
;; This is an experimental helper for third-party modules. You could,
@@ -344,7 +353,7 @@ erc-fill--wrap-nudge
(cl-incf erc-fill--wrap-value arg)
(while (setq p (next-single-property-change p 'line-prefix))
(when-let ((v (get-text-property p 'line-prefix)))
- (cl-incf (caddr v) arg)
+ (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len))
(when-let
((e (text-property-not-all p (point-max) 'line-prefix v)))
(goto-char e)))))))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..cf243ef43c7
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,162 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+ (setq msg "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.")
+
+ (erc-display-message nil 'notice (current-buffer) msg)
+ (setq msg "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.")
+
+ (erc-display-message
+ nil nil (current-buffer)
+ (erc--format-privmsg "alice" msg nil t nil))
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+
+ (erc-display-message
+ nil nil (current-buffer)
+ (erc--format-privmsg "bob" msg nil t nil))
+
+ (funcall test)
+ (when noninteractive
+ (kill-buffer)))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (goto-char (point-min))
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 27 (,w)))
+ (should (= w (string-pixel-width "<alice> "))))))
+
+ (erc-fill--wrap-nudge 2)
+
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 29 (,w)))
+ (should (= w (string-pixel-width "<bob> ")))))))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (not noninteractive) (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (goto-char (point-min))
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 27 (,w)))
+ (should (> w (string-pixel-width "<alice> "))))))
+
+ (erc-fill--wrap-nudge 2)
+
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 29 (,w)))
+ (should (> w (string-pixel-width "<bob> "))))))
+
+ ;; FIXME figure out how to get rid of this "void variable
+ ;; `erc--results-ewoc'" error, which seems related to operating
+ ;; in this second frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+;;; erc-fill-tests.el ends here
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 1697 bytes --]
From 80dccfa483020177c3e705f3c59c4875a635a568 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 1/4] [5.6] Adjust some old text properties in ERC buffers
TODO: because these have been around forever, we should mention
their deletion in the misc-library section of ERC-NEWS for 5.6.
* lisp/erc/erc.el (erc-display-message): Remove the confusing
`rear-sticky' text property, which has been around since 2002.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
---
lisp/erc/erc.el | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ff1820cfaf2..4bc9fc20f8a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2867,7 +2867,6 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4296,7 +4295,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Leverage-display-properties-better-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 13826 bytes --]
From 5e9422dc39c61af03dd3ca24d419927f2f07c8bd Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 2/4] [5.6] Leverage display properties better in erc-stamp
(erc-timestamp-use-align-to): Enhance meaning of option to accept
numeric value for dynamically aligned right-side stamps. Use
`graphic-display-p' to determine default value even though, as stated
in the manual, terminal Emacs also supports the "space" display spec.
(erc-timestamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el: New file.
---
lisp/erc/erc-stamp.el | 66 ++++++++++--
test/lisp/erc/erc-stamp-tests.el | 178 +++++++++++++++++++++++++++++++
2 files changed, 236 insertions(+), 8 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..e9592448a33 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -217,14 +217,44 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
A side effect of enabling this is that there will only be one
space before a right timestamp in any saved logs."
- :type 'boolean)
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.4.1")) ; FIXME update when merging
+
+;; If people want to use this directly, we can offer an option to set
+;; the margin's width.
+(define-minor-mode erc-timestamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'."
+ :interactive nil
+ (if-let ((erc-timestamp--display-margin-mode)
+ (width (if erc-timestamp-last-inserted-right
+ (length erc-timestamp-last-inserted-right)
+ (1+ (length (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format-right))))))
+ (progn
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (unless noninteractive
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+ (kill-local-variable 'right-margin-width)
+ (unless noninteractive
+ (set-window-margins nil nil)
+ (set-window-fringes nil nil))))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -243,6 +273,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -253,6 +284,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -304,12 +337,29 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..4994feefd4e
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,178 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") " [") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-timestamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers stamp alone
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;;; erc-stamp-tests.el ends here
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2444 bytes --]
From 35d1b98e38a2848f3cef3297131a379b1690e6ea Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 3/4] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match data.
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 20685 bytes --]
From 19ddf027ab3cbfde020e43cdb2bcece828c6638f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 4/4] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill-wrap-mode, erc-fill--wrap-prefix, erc-fill--wrap-value,
erc-fill--wrap-movement): New minor mode and variables to support it.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file.
---
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-fill.el | 247 +++++++++++++++++++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 162 +++++++++++++++++++++
3 files changed, 408 insertions(+), 2 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 994555acecf..aae8280baa9 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -95,6 +95,7 @@ erc--features-to-modules
(erc-join autojoin)
(erc-page page ctcp-page)
(erc-sound sound ctcp-sound)
+ (erc-fill fill-wrap)
(erc-stamp stamp timestamp)
(erc-services services nickserv))
"Migration alist mapping a library feature to module names.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..a05f2a558f8 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,27 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+function is called.
+
+A third style resembles static filling but \"wraps\" instead of
+fills, courtesy of `visual-line-mode' mode, which ERC
+automatically enables when this option is `erc-fill-wrap' or
+`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'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
"Column around which all statically filled messages will be centered.
This column denotes the point where the ` ' character between
<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+names right and text left.
+
+Also used by the `erc-fill-function' variant `erc-fill-wrap' for
+its initial leading \"prefix\" width."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +169,235 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-prefix nil)
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-movement nil)
+
+(defcustom erc-fill-wrap-movement t
+ "Whether to override keys defined by `visual-line-mode'.
+A value of `display' means to favor default `erc-mode' keys when
+point is in the input area."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice boolean (const display :tag "Display area"
+ :doc "Use `erc-mode' keys in input area")))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but users
+ ;; still need to see the message.
+ (pcase erc-fill--wrap-movement
+ ('display (if (>= (point) erc-input-marker)
+ (kill-line arg)
+ (kill-visual-line arg)))
+ ('t (kill-visual-line arg))
+ (_ (kill-line arg))))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (pcase erc-fill--wrap-movement
+ ('display (if (>= (point) erc-input-marker)
+ (move-beginning-of-line arg)
+ (beginning-of-visual-line arg)))
+ ('t (beginning-of-visual-line arg))
+ (_ (move-beginning-of-line arg)))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (pcase erc-fill--wrap-movement
+ ('display (if (>= (point) erc-input-marker)
+ (move-end-of-line arg)
+ (end-of-visual-line arg)))
+ ('t (end-of-visual-line arg))
+ (_ (move-end-of-line arg))))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-movement' styles ARG times.
+Go from nil to t to `display' and back around, but set internal
+state instead of mutating `erc-fill-wrap-movement'. When ARG is
+0, reset to value of `erc-fill-wrap-movement'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-movement erc-fill-wrap-movement))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-movement (pcase erc-fill--wrap-movement
+ ('nil t)
+ ('t 'display)
+ ('display nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c c" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+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'. You can also manually
+invoke one of the minor-mode toggles."
+ ((let (msg)
+ (unless erc-fill-mode
+ (unless (memq 'fill erc-modules)
+ (setq msg
+ (concat "WARNING: enabling default global module `fill' needed "
+ " by local module `fill-wrap'. This will impact all"
+ " ERC sessions. Add `fill' to `erc-modules' to avoid "
+ " this warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; 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-movement (alist-get 'erc-fill--wrap-movement vars)
+ erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix vars)
+ erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
+ (when (eq erc-timestamp-use-align-to 'margin)
+ (erc-timestamp--display-margin-mode +1))
+ (setq erc-fill--wrap-value
+ (or erc-fill--wrap-value erc-fill-static-center)
+ ;;
+ erc-fill--wrap-prefix
+ (or erc-fill--wrap-prefix
+ (list 'space :width erc-fill--wrap-value)))
+ (visual-line-mode +1)
+ (unless (local-variable-p 'erc-fill--wrap-movement)
+ (setq erc-fill--wrap-movement erc-fill-wrap-movement))
+ (when msg
+ (erc-display-error-notice nil msg))))
+ ((when erc-timestamp--display-margin-mode
+ (erc-timestamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-prefix)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-movement)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of perceived nickname.
+It should return an integer representing the length of the
+nickname, including any enclosing brackets, or nil, to fall back
+to the default behavior of taking the length from the first word.")
+
+(defvar erc-fill--wrap-use-pixels t)
+(declare-function buffer-text-pixel-size "xdisp"
+ (&optional buffer-or-name window x-limit y-limit))
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill--wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- ,erc-fill--wrap-value ,len))
+ ,erc-fill--wrap-prefix)))))
+
+;; 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.
+
+(defun erc-fill--wrap-fix (&optional value)
+ "Re-wrap from `point-min' to `point-max'.
+Reset prefix to VALUE, when given."
+ (save-excursion
+ (when value
+ (setq erc-fill--wrap-value value
+ erc-fill--wrap-prefix (list 'space :width 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 (pos-bol) (pos-eol))
+ (erc-fill-wrap))))))
+
+(defun erc-fill--wrap-nudge (arg)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((inhibit-field-text-motion t)
+ (inhibit-read-only t) ; necessary?
+ (p (goto-char (point-min))))
+ (when (zerop arg)
+ (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+ (cl-incf (caddr erc-fill--wrap-prefix) arg)
+ (cl-incf erc-fill--wrap-value arg)
+ (while (setq p (next-single-property-change p 'line-prefix))
+ (when-let ((v (get-text-property p 'line-prefix)))
+ (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len))
+ (when-let
+ ((e (text-property-not-all p (point-max) 'line-prefix v)))
+ (goto-char e)))))))
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'. Note that misalignment may occur when
+messages contain decorations applied by third-party modules.
+See `erc-fill--wrap-fix' for a workaround."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (let ((total (erc-fill--wrap-nudge arg))
+ (start (window-start))
+ (marker (set-marker (make-marker) (point))))
+ (when (zerop arg)
+ (setq arg 1))
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (set-window-start (selected-window) start)
+ (goto-char marker)))))
+ map)
+ t
+ (lambda ()
+ (set-marker marker nil)
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (goto-char marker)
+ (set-window-start (selected-window) start)))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..cf243ef43c7
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,162 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+ (setq msg "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.")
+
+ (erc-display-message nil 'notice (current-buffer) msg)
+ (setq msg "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.")
+
+ (erc-display-message
+ nil nil (current-buffer)
+ (erc--format-privmsg "alice" msg nil t nil))
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+
+ (erc-display-message
+ nil nil (current-buffer)
+ (erc--format-privmsg "bob" msg nil t nil))
+
+ (funcall test)
+ (when noninteractive
+ (kill-buffer)))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (goto-char (point-min))
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 27 (,w)))
+ (should (= w (string-pixel-width "<alice> "))))))
+
+ (erc-fill--wrap-nudge 2)
+
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 29 (,w)))
+ (should (= w (string-pixel-width "<bob> ")))))))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (not noninteractive) (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (goto-char (point-min))
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 27 (,w)))
+ (should (> w (string-pixel-width "<alice> "))))))
+
+ (erc-fill--wrap-nudge 2)
+
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 29 (,w)))
+ (should (> w (string-pixel-width "<bob> "))))))
+
+ ;; FIXME figure out how to get rid of this "void variable
+ ;; `erc--results-ewoc'" error, which seems related to operating
+ ;; in this second frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+;;; erc-fill-tests.el ends here
--
2.38.1
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
2023-01-18 15:01 ` J.P.
2023-01-25 14:11 ` J.P.
@ 2023-01-27 14:31 ` J.P.
2023-01-31 15:28 ` J.P.
` (22 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-01-27 14:31 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 144 bytes --]
v4. Fix invisibility for fools and timestamps with wrapped filling.
Consolidate prompt setup in `erc-open'. Deprecate some items in
erc-stamp.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v3-v4.diff --]
[-- Type: text/x-patch, Size: 64881 bytes --]
From 8ff3d6905355e41bd91fd8e24577b68e762cfb0a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 06:28:37 -0800
Subject: [PATCH 0/8] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (8):
[5.6] Refactor marker initialization in erc-open
[5.6] Adjust some old text properties in ERC buffers
[5.6] Expose insertion time as text prop in erc-stamp
[5.6] Make some erc-stamp functions more limber
[5.6] Put display properties to better use in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add variant for erc-match invisibility spec
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-fill.el | 307 ++++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 166 ++++++++--
lisp/erc/erc.el | 136 +++++---
test/lisp/erc/erc-fill-tests.el | 172 ++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 261 +++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
10 files changed, 1248 insertions(+), 215 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
Interdiff:
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a05f2a558f8..ecd721f2f03 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -85,8 +85,8 @@ erc-fill-function
function is called.
A third style resembles static filling but \"wraps\" instead of
-fills, courtesy of `visual-line-mode' mode, which ERC
-automatically enables when this option is `erc-fill-wrap' or
+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'."
@@ -96,13 +96,15 @@ erc-fill-function
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left.
-
-Also used by the `erc-fill-function' variant `erc-fill-wrap' for
-its initial leading \"prefix\" width."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -171,65 +173,71 @@ erc-fill-variable
(defvar-local erc-fill--wrap-prefix nil)
(defvar-local erc-fill--wrap-value nil)
-(defvar-local erc-fill--wrap-movement nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
-(defcustom erc-fill-wrap-movement t
- "Whether to override keys defined by `visual-line-mode'.
-A value of `display' means to favor default `erc-mode' keys when
-point is in the input area."
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
:package-version '(ERC . "5.5") ; FIXME sync on release
- :type '(choice boolean (const display :tag "Display area"
- :doc "Use `erc-mode' keys in input area")))
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall
+ (pcase erc-fill--wrap-visual-keys
+ ('non-input (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
(defun erc-fill--wrap-kill-line (arg)
"Defer to `kill-line' or `kill-visual-line'."
(interactive "P")
- ;; ERC buffers are read-only outside of the input area, but users
- ;; still need to see the message.
- (pcase erc-fill--wrap-movement
- ('display (if (>= (point) erc-input-marker)
- (kill-line arg)
- (kill-visual-line arg)))
- ('t (kill-visual-line arg))
- (_ (kill-line arg))))
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
(defun erc-fill--wrap-beginning-of-line (arg)
"Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
(interactive "^p")
- (pcase erc-fill--wrap-movement
- ('display (if (>= (point) erc-input-marker)
- (move-beginning-of-line arg)
- (beginning-of-visual-line arg)))
- ('t (beginning-of-visual-line arg))
- (_ (move-beginning-of-line arg)))
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
(when (get-text-property (point) 'erc-prompt)
(goto-char erc-input-marker)))
(defun erc-fill--wrap-end-of-line (arg)
- "defer to `move-end-of-line' or `end-of-visual-line'."
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
(interactive "^p")
- (pcase erc-fill--wrap-movement
- ('display (if (>= (point) erc-input-marker)
- (move-end-of-line arg)
- (end-of-visual-line arg)))
- ('t (end-of-visual-line arg))
- (_ (move-end-of-line arg))))
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
(defun erc-fill-wrap-cycle-visual-movement (arg)
- "Cycle through `erc-fill-wrap-movement' styles ARG times.
-Go from nil to t to `display' and back around, but set internal
-state instead of mutating `erc-fill-wrap-movement'. When ARG is
-0, reset to value of `erc-fill-wrap-movement'."
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
(interactive "^p")
(when (zerop arg)
- (setq erc-fill--wrap-movement erc-fill-wrap-movement))
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
(while (not (zerop arg))
(cl-incf arg (- (abs arg)))
- (setq erc-fill--wrap-movement (pcase erc-fill--wrap-movement
- ('nil t)
- ('t 'display)
- ('display nil))))
- (message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
:doc "Keymap for ERC's `fill-wrap' module."
@@ -237,16 +245,22 @@ erc-fill-wrap-mode-map
"<remap> <kill-line>" #'erc-fill--wrap-kill-line
"<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
"<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
- "C-c c" #'erc-fill-wrap-cycle-visual-movement
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
;; Not sure if this is problematic because `erc-bol' takes no args.
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
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'. You can also manually
-invoke one of the minor-mode toggles."
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
((let (msg)
(unless erc-fill-mode
(unless (memq 'fill erc-modules)
@@ -261,11 +275,15 @@ 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-movement (alist-get 'erc-fill--wrap-movement vars)
+ (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys
+ vars)
erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix vars)
erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
- (when (eq erc-timestamp-use-align-to 'margin)
- (erc-timestamp--display-margin-mode +1))
+ (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)
;;
@@ -273,29 +291,30 @@ fill-wrap
(or erc-fill--wrap-prefix
(list 'space :width erc-fill--wrap-value)))
(visual-line-mode +1)
- (unless (local-variable-p 'erc-fill--wrap-movement)
- (setq erc-fill--wrap-movement erc-fill-wrap-movement))
+ (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))))
- ((when erc-timestamp--display-margin-mode
- (erc-timestamp--display-margin-mode -1))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
(kill-local-variable 'erc-button--add-nickname-face-function)
(kill-local-variable 'erc-fill--wrap-prefix)
(kill-local-variable 'erc-fill--wrap-value)
(kill-local-variable 'erc-fill-function)
- (kill-local-variable 'erc-fill--wrap-movement)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
(visual-line-mode -1))
'local)
(defvar-local erc-fill--wrap-length-function nil
- "Function to determine length of perceived nickname.
-It should return an integer representing the length of the
-nickname, including any enclosing brackets, or nil, to fall back
-to the default behavior of taking the length from the first word.")
-
-(defvar erc-fill--wrap-use-pixels t)
-(declare-function buffer-text-pixel-size "xdisp"
- (&optional buffer-or-name window x-limit y-limit))
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
(defun erc-fill-wrap ()
"Use text props to mimic the effect of `erc-fill-static'.
@@ -309,12 +328,13 @@ erc-fill-wrap
(progn
(skip-syntax-forward "^-")
(forward-char)
- (if (and erc-fill--wrap-use-pixels
+ (if (and erc-fill-wrap-use-pixels
(fboundp 'buffer-text-pixel-size))
(save-restriction
(narrow-to-region (point-min) (point))
(list (car (buffer-text-pixel-size))))
(- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
(erc-put-text-properties (point-min) (point-max)
'(line-prefix wrap-prefix) nil
`((space :width (- ,erc-fill--wrap-value ,len))
@@ -337,7 +357,7 @@ erc-fill--wrap-fix
(while (and (zerop (forward-line))
(< (point) (min (point-max) erc-insert-marker)))
(save-restriction
- (narrow-to-region (pos-bol) (pos-eol))
+ (narrow-to-region (line-beginning-position) (line-end-position))
(erc-fill-wrap))))))
(defun erc-fill--wrap-nudge (arg)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 499bcaf5724..87272f0b647 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer
(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
+
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +675,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index e9592448a33..21885f3a36f 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,29 +165,43 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (unless (get-text-property (point-min) 'invisible)
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -232,29 +254,53 @@ erc-timestamp-use-align-to
A side effect of enabling this is that there will only be one
space before a right timestamp in any saved logs."
:type '(choice boolean integer (const margin))
- :package-version '(ERC . "5.4.1")) ; FIXME update when merging
-
-;; If people want to use this directly, we can offer an option to set
-;; the margin's width.
-(define-minor-mode erc-timestamp--display-margin-mode
- "Internal minor mode for built-in modules integrating with `stamp'."
+ :package-version '(ERC . "5.5")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
:interactive nil
- (if-let ((erc-timestamp--display-margin-mode)
- (width (if erc-timestamp-last-inserted-right
- (length erc-timestamp-last-inserted-right)
- (1+ (length (erc-format-timestamp
- (current-time)
- erc-timestamp-format-right))))))
- (progn
+ (if erc-stamp--display-margin-mode
+ (let ((width (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))))
(setq right-margin-width width
right-fringe-width 0)
- (unless noninteractive
- (set-window-margins nil left-margin-width width)
- (set-window-fringes nil left-fringe-width 0)))
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
(kill-local-variable 'right-margin-width)
- (unless noninteractive
- (set-window-margins nil nil)
- (set-window-fringes nil nil))))
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins left-margin-width nil)
+ (set-window-fringes left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -365,14 +411,19 @@ erc-insert-timestamp-right
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
@@ -400,8 +451,9 @@ erc-format-timestamp
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
- (not erc-hide-timestamps) ; bug#11706
- (erc-put-text-property 0 (length ts) 'cursor-intangible t ts))
+ ;; (not erc-hide-timestamps) ; bug#11706
+ (erc-put-text-property 0 (1- (length ts))
+ 'cursor-intangible t ts))
ts)
""))
@@ -450,11 +502,15 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 4bc9fc20f8a..6b3d0b4af2f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1966,6 +1966,45 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Respect existing multiline input after prompt. Expect any
+ ;; text preceding it on the same line, including whitespace,
+ ;; to be part of the prompt itself.
+ (goto-char (point-max))
+ (forward-line 0)
+ (while (and (not (get-text-property (point) 'erc-prompt))
+ (zerop (forward-line -1))))
+ (cl-assert (not (= (point) (point-min))))
+ (set-marker erc-insert-marker (point))
+ ;; If the input area is clean, this search should fail and
+ ;; return point max. Otherwise, it should return the position
+ ;; after the last char with the `erc-prompt' property, as per
+ ;; the doc string for `next-single-property-change'.
+ (set-marker erc-input-marker
+ (next-single-property-change (point) 'erc-prompt nil
+ (point-max)))
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -1999,10 +2038,12 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2020,21 +2061,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2081,20 +2107,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
@@ -2867,6 +2880,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
+ (put-text-property
+ 0 (length string) 'erc-message
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4244,6 +4260,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -5667,7 +5707,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5677,14 +5717,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7278,10 +7313,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7301,6 +7337,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index cf243ef43c7..77d553bc3a2 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -36,6 +36,7 @@ erc-fill-tests--wrap-populate
(push 'erc-button-add-buttons erc-insert-modify-hook))
(erc-mode)
(setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
(with-current-buffer (get-buffer-create "#chan")
(erc-mode)
@@ -63,13 +64,13 @@ erc-fill-tests--wrap-populate
(erc-display-message
nil nil (current-buffer)
- (erc--format-privmsg "alice" msg nil t nil))
+ (erc-format-privmessage "alice" msg nil t))
(setq msg "alice: Either your unparagoned mistress is dead,\
or she's outprized by a trifle.")
(erc-display-message
nil nil (current-buffer)
- (erc--format-privmsg "bob" msg nil t nil))
+ (erc-format-privmessage "bob" msg nil t))
(funcall test)
(when noninteractive
@@ -92,9 +93,15 @@ erc-fill-wrap--monospace
'(space :width 27)))
(should (equal (get-text-property (pos-eol) 'wrap-prefix)
'(space :width 27)))
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
(should (pcase (get-text-property (point) 'line-prefix)
- (`(space :width (- 27 (,w)))
- (should (= w (string-pixel-width "<alice> "))))))
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- 27 (,w))))
+ (= w (string-pixel-width "<alice> ")))
+ (`(space :width (- 27 ,w))
+ (= w (length "<alice> ")))))
(erc-fill--wrap-nudge 2)
@@ -106,12 +113,17 @@ erc-fill-wrap--monospace
(should (equal (get-text-property (pos-eol) 'wrap-prefix)
'(space :width 29)))
(should (pcase (get-text-property (point) 'line-prefix)
- (`(space :width (- 29 (,w)))
- (should (= w (string-pixel-width "<bob> ")))))))))
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- 29 (,w))))
+ (= w (string-pixel-width "<bob> ")))
+ (`(space :width (- 29 ,w))
+ (= w (length "<bob> "))))))))
(ert-deftest erc-fill-wrap--variable-pitch ()
:tags '(:unstable)
- (unless (and (not noninteractive) (display-graphic-p))
+ (unless (and (fboundp 'string-pixel-width)
+ (not noninteractive)
+ (display-graphic-p))
(ert-skip "Test needs interactive graphical Emacs"))
(with-selected-frame (make-frame '((name . "other")))
@@ -124,8 +136,6 @@ erc-fill-wrap--variable-pitch
(lambda ()
- ;; Prefix props are applied properly and faces are accounted
- ;; for when determining widths.
(goto-char (point-min))
(should (search-forward "<a" nil t))
(should (get-text-property (pos-bol) 'line-prefix))
@@ -136,7 +146,7 @@ erc-fill-wrap--variable-pitch
'(space :width 27)))
(should (pcase (get-text-property (point) 'line-prefix)
(`(space :width (- 27 (,w)))
- (should (> w (string-pixel-width "<alice> "))))))
+ (> w (string-pixel-width "<alice> ")))))
(erc-fill--wrap-nudge 2)
@@ -149,7 +159,7 @@ erc-fill-wrap--variable-pitch
'(space :width 29)))
(should (pcase (get-text-property (point) 'line-prefix)
(`(space :width (- 29 (,w)))
- (should (> w (string-pixel-width "<bob> "))))))
+ (> w (string-pixel-width "<bob> ")))))
;; FIXME figure out how to get rid of this "void variable
;; `erc--results-ewoc'" error, which seems related to operating
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 916d105779a..990c971b4cd 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -81,105 +81,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 4994feefd4e..69523274812 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -20,7 +20,7 @@
;;; Commentary:
;;; Code:
-(require 'ert)
+(require 'ert-x)
(require 'erc-stamp)
(require 'erc-goodies) ; for `erc-make-read-only'
@@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") " [") nil t))
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@@ -112,9 +112,9 @@ erc-timestamp-use-align-to--t
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
(ert-deftest erc-timestamp-use-align-to--integer ()
@@ -146,7 +146,7 @@ erc-timestamp-use-align-to--integer
(ert-deftest erc-timestamp-use-align-to--margin ()
(erc-stamp-tests--insert-right
(lambda ()
- (erc-timestamp--display-margin-mode +1)
+ (erc-stamp--display-margin-mode +1)
(ert-info ("margin, normal")
(let ((erc-timestamp-use-align-to 'margin))
@@ -155,7 +155,7 @@ erc-timestamp-use-align-to--margin
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Space not added (treated as opaque string).
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one[" nil t))
;; Field covers stamp alone
(should (eql ?e (char-before (field-beginning (point)))))
;; Vanity props extended
@@ -170,9 +170,92 @@ erc-timestamp-use-align-to--margin
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; No hard wrap
- (should (search-forward "oooo [" nil t))
+ (should (search-forward "oooo[" nil t))
;; Field starts at leading space.
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
+;; This concerns the partial reversal of changes resulting from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also irreversible, which at least one user has complained
+;; about. Turning off `cursor-intangible-mode' does do the trick, but
+;; a better solution seems to be decrementing the end of the
+;; `cursor-intangible' interval so that, in addition to C-n working, a
+;; C-f from before the timestamp doesn't overshoot. This works
+;; whether `erc-hide-timestamps' is enabled or not.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
;;; erc-stamp-tests.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..c5a40d9bc72 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24873 bytes --]
From 4ab7539fa3f6b44e645b004438c6256feee3a5b2 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Jan 2023 20:48:24 -0800
Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open
* lisp/erc/erc.el (erc--initialize-markers): New helper to ensure
prompt and its associated markers are set up correctly.
(erc-open): When determining whether a session is a logical
continuation, leverage the work already performed by the
`erc-networks' library to that effect. Its verdicts are based on
network context and thus reliable even when a user dials anew from an
entry-point, which is not a simple reconnection because the user
expects a clean slate for everything except an existing buffer's
messages, meaning `erc--server-reconnecting' will be nil and
local-module state variables need resetting. Also remove the check
for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create'
always does the right thing in. Replace all code involving marker and
prompt setup by deferring to a new helper, `erc--initialize markers'.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): New test.
* test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file.
* test/lisp/erc/erc-scenarios-base-local-modules.el
(erc-scenarios-base-local-modules--mode-persistence): Move test to
separate file to help with parallel "-j" runs.
---
lisp/erc/erc.el | 79 ++++---
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 --------
test/lisp/erc/erc-tests.el | 79 ++++++-
4 files changed, 331 insertions(+), 137 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ff1820cfaf2..363fe30ee58 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1966,6 +1966,45 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Respect existing multiline input after prompt. Expect any
+ ;; text preceding it on the same line, including whitespace,
+ ;; to be part of the prompt itself.
+ (goto-char (point-max))
+ (forward-line 0)
+ (while (and (not (get-text-property (point) 'erc-prompt))
+ (zerop (forward-line -1))))
+ (cl-assert (not (= (point) (point-min))))
+ (set-marker erc-insert-marker (point))
+ ;; If the input area is clean, this search should fail and
+ ;; return point max. Otherwise, it should return the position
+ ;; after the last char with the `erc-prompt' property, as per
+ ;; the doc string for `next-single-property-change'.
+ (set-marker erc-input-marker
+ (next-single-property-change (point) 'erc-prompt nil
+ (point-max)))
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -1999,10 +2038,12 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2020,21 +2061,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2081,20 +2107,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 916d105779a..990c971b4cd 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -81,105 +81,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..c5a40d9bc72 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 5557 bytes --]
From 456f765ec19ecb7421093a887bdb22afac5ec631 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers
TODO: mention adjustment in ERC-NEWS for 5.6.
* lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text
property, which has been around since 2002, with more useful
`erc-message' property.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
(erc-put-text-property, erc-list): Alias these to built-in functions.
(erc--own-property-names, erc--remove-text-properties) Add internal
variable and helper function for filtering values returned by
`filter-buffer-substring-function'.
(erc-restore-text-properties): Don't forget tags when restoring.
(erc--get-eq-comparable-cmd): New function to extract commands for use
as easily searchable text-property values.
---
lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 43 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 363fe30ee58..6b3d0b4af2f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2880,7 +2880,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-message
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4258,6 +4260,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4309,7 +4335,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -5681,7 +5707,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5691,14 +5717,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7292,10 +7313,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7315,6 +7337,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 13386 bytes --]
From 9172c82d0e896d4129dd0c83624d282045c52c21 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:10:20 -0800
Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
`erc-timestamp' to store lisp time object formerly ensconced in a
closure. Instead of creating a new lambda for the cursor-sensor
function of each message in a buffer, leave a gap between messages to
trip the sensor function. The motivation behind this change is to
allow third parties access to valuable timestamp data already stored
by ERC anyway. Of secondary importance is discouraging the reliance
on those lambdas as a means of detecting message bounds. The gap now
serves a similar purpose. Basically, the final character in a
message, a newline, will not have a timestamp or a sensor function.
When the stamps module isn't loaded, the `erc-message' property can be
used instead. Also, instead of looking for the `invisible' text
property at point, which is normally `point-max' and thus outside the
accessible portion of the buffer, look at the beginning of the
inserted message. This allows hook members running before this
function to opt out of timestamps by marking a message as invisible.
(erc-format-timestamp): Don't omit the `cursor-intangible' property
when `erc-hide-timestamps' is non-nil. This reverts the changes from
bug#11706.
(erc-echo-timestamp): Make interactive and show timestamps even when
the variable `erc-echo-timestamps' is nil.
(erc--echo-ts-csf): Add new function to serve as value of
cursor-sensor function text properties.
* test/lisp/erc/erc-stamp-tests.el: New file.
---
lisp/erc/erc-stamp.el | 19 +--
test/lisp/erc/erc-stamp-tests.el | 203 +++++++++++++++++++++++++++++++
2 files changed, 215 insertions(+), 7 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..bf1b0c6952c 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -162,7 +162,7 @@ erc-add-timestamp
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
+ (unless (get-text-property (point-min) 'invisible)
(let ((ct (current-time)))
(if (fboundp erc-insert-timestamp-function)
(funcall erc-insert-timestamp-function
@@ -174,12 +174,12 @@ erc-add-timestamp
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -350,8 +350,9 @@ erc-format-timestamp
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
- (not erc-hide-timestamps) ; bug#11706
- (erc-put-text-property 0 (length ts) 'cursor-intangible t ts))
+ ;; (not erc-hide-timestamps) ; bug#11706
+ (erc-put-text-property 0 (1- (length ts))
+ 'cursor-intangible t ts))
ts)
""))
@@ -400,11 +401,15 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..c8e5d75d77d
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,203 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") " [") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;; This concerns the partial reversal of changes resulting from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also irreversible, which at least one user has complained
+;; about. Turning off `cursor-intangible-mode' does do the trick, but
+;; a better solution seems to be decrementing the end of the
+;; `cursor-intangible' interval so that, in addition to C-n working, a
+;; C-f from before the timestamp doesn't overshoot. This works
+;; whether `erc-hide-timestamps' is enabled or not.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;;; erc-stamp-tests.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 4437 bytes --]
From 3671227a2be6ac134279cd383bc18e952c196ef0 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber
TODO: update ERC-NEWS announcing deprecation.
* lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option
and change meaning of its nil value to fall through to
`erc-timestamp-format'. Do this to allow modules to predict what the
right-hand stamp's final width will be. This also saves
`erc-insert-timestamp-left-and-right' from calling
`erc-format-timestamp' again for no reason.
(erc-stamp--current-time): Add new generic function and method to
return current time. Default to calling `current-time'.
(erc-stamp--current-time): New internal variable to hold time value
used to construct time formatted stamp passed to
`erc-insert-timestamp-function'.
(erc-add-timestamp): Bind `erc-stamp--current-time' when calling
`erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Use STRING parameter and favor
it over the now deprecated `erc-timestamp-format-right' to avoid
formatting twice. Also extract current time from the variable
`erc-stamp--current-time' for similar reasons.
---
lisp/erc/erc-stamp.el | 36 +++++++++++++++++++++++++++++-------
1 file changed, 29 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index bf1b0c6952c..459d022338a 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,17 +165,31 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
(unless (get-text-property (point-min) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch --]
[-- Type: text/x-patch, Size: 14364 bytes --]
From 65833116b95cf7d21a3ed655387c28277d3f3e3a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-side
stamps. Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests.
---
lisp/erc/erc-stamp.el | 111 ++++++++++++++++++++++++++-----
test/lisp/erc/erc-stamp-tests.el | 70 +++++++++++++++++--
2 files changed, 159 insertions(+), 22 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 459d022338a..21885f3a36f 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,68 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
A side effect of enabling this is that there will only be one
space before a right timestamp in any saved logs."
- :type 'boolean)
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.5")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (let ((width (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins left-margin-width nil)
+ (set-window-fringes left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +319,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -275,6 +330,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -326,25 +383,47 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index c8e5d75d77d..69523274812 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") " [") nil t))
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-stamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo[" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns the partial reversal of changes resulting from:
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2444 bytes --]
From 23a185750d8e246dc517bc3ad0a11e491f2be2ef Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match data.
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch --]
[-- Type: text/x-patch, Size: 3181 bytes --]
From 563bd525a913e98efca9ce1e50b07924f4c1b689 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 05:34:56 -0800
Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec
* lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange
for possibly adding or removing `erc-match' from
`buffer-invisibility-spec'.
(erc-match--hide-fools-offset-bounds): Add new variable to serve as
switch for activating invisibility on a modified interval that's
offset toward `point-min' by one character.
(erc-hide-fools): Optionally offset start and end of invisible region
by minus one.
(erc-match--modify-invisibility-spec): New housekeeping function to
set up and tear down offset spec.
---
lisp/erc/erc-match.el | 31 +++++++++++++++++++++++++------
1 file changed, 25 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 499bcaf5724..87272f0b647 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer
(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
+
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +675,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #10: 0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 22653 bytes --]
From 8ff3d6905355e41bd91fd8e24577b68e762cfb0a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill-wrap-mode, erc-fill--wrap-prefix, erc-fill--wrap-value,
erc-fill--wrap-movement): New minor mode and variables to support it.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file.
---
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-fill.el | 273 +++++++++++++++++++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 172 ++++++++++++++++++++
3 files changed, 441 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 994555acecf..aae8280baa9 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -95,6 +95,7 @@ erc--features-to-modules
(erc-join autojoin)
(erc-page page ctcp-page)
(erc-sound sound ctcp-sound)
+ (erc-fill fill-wrap)
(erc-stamp stamp timestamp)
(erc-services services nickserv))
"Migration alist mapping a library feature to module names.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..ecd721f2f03 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,29 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+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'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,253 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-prefix nil)
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall
+ (pcase erc-fill--wrap-visual-keys
+ ('non-input (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+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'. You can also manually
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
+ ((let (msg)
+ (unless erc-fill-mode
+ (unless (memq 'fill erc-modules)
+ (setq msg
+ (concat "WARNING: enabling default global module `fill' needed "
+ " by local module `fill-wrap'. This will impact all"
+ " ERC sessions. Add `fill' to `erc-modules' to avoid "
+ " this warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; 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-prefix (alist-get 'erc-fill--wrap-prefix vars)
+ erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
+ (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)
+ ;;
+ erc-fill--wrap-prefix
+ (or erc-fill--wrap-prefix
+ (list 'space :width erc-fill--wrap-value)))
+ (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))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-prefix)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- ,erc-fill--wrap-value ,len))
+ ,erc-fill--wrap-prefix)))))
+
+;; 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.
+
+(defun erc-fill--wrap-fix (&optional value)
+ "Re-wrap from `point-min' to `point-max'.
+Reset prefix to VALUE, when given."
+ (save-excursion
+ (when value
+ (setq erc-fill--wrap-value value
+ erc-fill--wrap-prefix (list 'space :width 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)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((inhibit-field-text-motion t)
+ (inhibit-read-only t) ; necessary?
+ (p (goto-char (point-min))))
+ (when (zerop arg)
+ (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+ (cl-incf (caddr erc-fill--wrap-prefix) arg)
+ (cl-incf erc-fill--wrap-value arg)
+ (while (setq p (next-single-property-change p 'line-prefix))
+ (when-let ((v (get-text-property p 'line-prefix)))
+ (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len))
+ (when-let
+ ((e (text-property-not-all p (point-max) 'line-prefix v)))
+ (goto-char e)))))))
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'. Note that misalignment may occur when
+messages contain decorations applied by third-party modules.
+See `erc-fill--wrap-fix' for a workaround."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (let ((total (erc-fill--wrap-nudge arg))
+ (start (window-start))
+ (marker (set-marker (make-marker) (point))))
+ (when (zerop arg)
+ (setq arg 1))
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (set-window-start (selected-window) start)
+ (goto-char marker)))))
+ map)
+ t
+ (lambda ()
+ (set-marker marker nil)
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (goto-char marker)
+ (set-window-start (selected-window) start)))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..77d553bc3a2
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,172 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+ (setq msg "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.")
+
+ (erc-display-message nil 'notice (current-buffer) msg)
+ (setq msg "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.")
+
+ (erc-display-message
+ nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+
+ (erc-display-message
+ nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (funcall test)
+ (when noninteractive
+ (kill-buffer)))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (goto-char (point-min))
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 27)))
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- 27 (,w))))
+ (= w (string-pixel-width "<alice> ")))
+ (`(space :width (- 27 ,w))
+ (= w (length "<alice> ")))))
+
+ (erc-fill--wrap-nudge 2)
+
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- 29 (,w))))
+ (= w (string-pixel-width "<bob> ")))
+ (`(space :width (- 29 ,w))
+ (= w (length "<bob> "))))))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (fboundp 'string-pixel-width)
+ (not noninteractive)
+ (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+
+ (goto-char (point-min))
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 27)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 27 (,w)))
+ (> w (string-pixel-width "<alice> ")))))
+
+ (erc-fill--wrap-nudge 2)
+
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width 29)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ (`(space :width (- 29 (,w)))
+ (> w (string-pixel-width "<bob> ")))))
+
+ ;; FIXME figure out how to get rid of this "void variable
+ ;; `erc--results-ewoc'" error, which seems related to operating
+ ;; in this second frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+;;; erc-fill-tests.el ends here
--
2.39.1
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (2 preceding siblings ...)
2023-01-27 14:31 ` J.P.
@ 2023-01-31 15:28 ` J.P.
2023-02-01 14:27 ` J.P.
` (21 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-01-31 15:28 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 115 bytes --]
v5. Fix some sloppiness in nudge command. Add (temporary) compat
function for `set-transient-map'. Improve tests.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v4-v5.diff --]
[-- Type: text/x-patch, Size: 24303 bytes --]
From a3e7f1555a29b147688112b01e20057d595a8eac Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 31 Jan 2023 06:48:02 -0800
Subject: [PATCH 0/8] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (8):
[5.6] Refactor marker initialization in erc-open
[5.6] Adjust some old text properties in ERC buffers
[5.6] Expose insertion time as text prop in erc-stamp
[5.6] Make some erc-stamp functions more limber
[5.6] Put display properties to better use in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add variant for erc-match invisibility spec
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-compat.el | 56 +++
lisp/erc/erc-fill.el | 322 ++++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 174 ++++++++--
lisp/erc/erc.el | 136 +++++---
test/lisp/erc/erc-fill-tests.el | 198 +++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 265 ++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
11 files changed, 1359 insertions(+), 213 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
Interdiff:
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 5601ede27a5..a4367fe4ba5 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,62 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+(defvar erc-compat--29-set-transient-map-timer nil)
+
+(defun erc-compat--29-set-transient-map
+ (map &optional keep-pred on-exit message timeout)
+ (let* ((message
+ (when message
+ (let (keys)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+ (format-spec
+ (if (stringp message) message "Repeat with %k")
+ `((?k . ,(mapconcat
+ (lambda (key)
+ (substitute-command-keys
+ (format "\\`%s'" (key-description (vector key)))))
+ keys ", ")))))))
+ (clearfun (make-symbol "clear-transient-map"))
+ (exitfun (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when message (message ""))
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (when on-exit (funcall on-exit)))))
+ (fset clearfun
+ (lambda ()
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (if (cond
+ ((null keep-pred) nil)
+ ((and (not (eq map (cadr overriding-terminal-local-map)))
+ (memq map (cddr overriding-terminal-local-map)))
+ t)
+ ((eq t keep-pred)
+ (let ((mc (lookup-key map (this-command-keys-vector))))
+ (when (and mc (symbolp mc))
+ (setq mc (or (command-remapping mc) mc)))
+ (and mc (eq this-command mc))))
+ (t (funcall keep-pred)))
+ (when message (message "%s" message))
+ (funcall exitfun)))))
+ (add-hook 'pre-command-hook clearfun)
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ (when timeout
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (setq erc-compat--29-set-transient-map-timer
+ (run-with-idle-timer timeout nil exitfun)))
+ (when message (message "%s" message))
+ exitfun))
+
+(defmacro erc-compat--set-transient-map (&rest args)
+ (cons (if (>= emacs-major-version 29)
+ 'set-transient-map
+ 'erc-compat--29-set-transient-map)
+ args))
+
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index ecd721f2f03..13e95967bf8 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -366,35 +366,48 @@ erc-fill--wrap-nudge
(widen)
(let ((inhibit-field-text-motion t)
(inhibit-read-only t) ; necessary?
- (p (goto-char (point-min))))
+ (p (goto-char (point-min)))
+ v)
(when (zerop arg)
(setq arg (- erc-fill-static-center erc-fill--wrap-value)))
(cl-incf (caddr erc-fill--wrap-prefix) arg)
(cl-incf erc-fill--wrap-value arg)
(while (setq p (next-single-property-change p 'line-prefix))
- (when-let ((v (get-text-property p 'line-prefix)))
- (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len))
- (when-let
- ((e (text-property-not-all p (point-max) 'line-prefix v)))
- (goto-char e)))))))
+ (when-let* ((this-v (get-text-property p 'line-prefix))
+ ((not (eq this-v v))))
+ (setq v this-v)
+ (cl-incf (nth 1 (nth 2 v)) arg)))))) ; (space :width (- *i* len))
arg)
(defun erc-fill-wrap-nudge (arg)
"Adjust `erc-fill-wrap' by ARG columns.
Offer to repeat command in a manner similar to
-`text-scale-adjust'. Note that misalignment may occur when
-messages contain decorations applied by third-party modules.
-See `erc-fill--wrap-fix' for a workaround."
+`text-scale-adjust'.
+
+ \\`+', \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`C-+', \\`C-=' Shift right margin rightward (shrink it)
+ by one column
+ \\`C--' Shift right margin leftward (grow it) by one
+ column
+ \\`C-0' 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."
(interactive "p")
(unless erc-fill--wrap-value
(cl-assert (not erc-fill-wrap-mode))
(user-error "Minor mode `erc-fill-wrap-mode' disabled"))
- (let ((total (erc-fill--wrap-nudge arg))
- (start (window-start))
- (marker (set-marker (make-marker) (point))))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
(when (zerop arg)
(setq arg 1))
- (set-transient-map
+ (erc-compat--set-transient-map
(let ((map (make-sparse-keymap)))
(dolist (key '(?+ ?= ?- ?0))
(let ((a (pcase key
@@ -405,18 +418,20 @@ erc-fill-wrap-nudge
(lambda ()
(interactive)
(cl-incf total (erc-fill--wrap-nudge a))
- (set-window-start (selected-window) start)
- (goto-char marker)))))
+ (recenter (round (* win-ratio (window-height))))))
+ (define-key map (vector (list 'control key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
map)
t
(lambda ()
- (set-marker marker nil)
(message "Fill prefix: %d (%+d col%s)"
erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
"Use %k for further adjustment"
1)
- (goto-char marker)
- (set-window-start (selected-window) start)))
+ (recenter (round (* win-ratio (window-height))))))
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 21885f3a36f..8862b14b061 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -269,6 +269,24 @@ erc-stamp--display-margin-force
(let ((erc-timestamp-use-align-to 'margin))
(apply orig r)))
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
;; If people want to use this directly, we can convert it into
;; a local module.
(define-minor-mode erc-stamp--display-margin-mode
@@ -280,15 +298,8 @@ erc-stamp--display-margin-mode
message text so that stamps will be visible when yanked."
:interactive nil
(if erc-stamp--display-margin-mode
- (let ((width (or erc-stamp-right-margin-width
- (1+ (string-width (or erc-timestamp-last-inserted
- (erc-format-timestamp
- (current-time)
- erc-timestamp-format)))))))
- (setq right-margin-width width
- right-fringe-width 0)
- (set-window-margins nil left-margin-width width)
- (set-window-fringes nil left-fringe-width 0)
+ (progn
+ (erc-stamp--adjust-right-margin 0)
(add-function :filter-return (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
(add-function :around (local 'erc-insert-timestamp-function)
@@ -397,6 +408,8 @@ erc-insert-timestamp-right
(put-text-property from (point) 'display
`(space :align-to (- right ,s)))))
('margin
+ (unless (eq ?\s (aref string 0))
+ (insert-and-inherit " "))
(put-text-property 0 (length string)
'display `((margin right-margin) ,string)
string))
@@ -451,9 +464,8 @@ erc-format-timestamp
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
- ;; (not erc-hide-timestamps) ; bug#11706
- (erc-put-text-property 0 (1- (length ts))
- 'cursor-intangible t ts))
+ (not erc-hide-timestamps) ; bug#11706
+ (erc-put-text-property 0 (length ts) 'cursor-intangible t ts))
ts)
""))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 77d553bc3a2..04001ec6524 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -29,8 +29,12 @@ erc-fill-tests--wrap-populate
(erc-insert-modify-hook '(erc-fill erc-add-timestamp))
(erc-server-users (make-hash-table :test 'equal))
(erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
(erc-modules '(fill stamp))
(msg "Hello World")
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
(when (bound-and-true-p erc-button-mode)
(push 'erc-button-add-buttons erc-insert-modify-hook))
@@ -53,28 +57,89 @@ erc-fill-tests--wrap-populate
(erc-update-channel-member
"#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
(setq msg "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.")
-
(erc-display-message nil 'notice (current-buffer) msg)
+
(setq msg "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.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t)))
- (erc-display-message
- nil nil (current-buffer)
- (erc-format-privmessage "alice" msg nil t))
(setq msg "alice: Either your unparagoned mistress is dead,\
or she's outprized by a trifle.")
-
- (erc-display-message
- nil nil (current-buffer)
- (erc-format-privmessage "bob" msg nil t))
-
- (funcall test)
- (when noninteractive
- (kill-buffer)))))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (let ((original-window-buffer (window-buffer (selected-window))))
+ (set-window-buffer (selected-window) (current-buffer))
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (kill-buffer)))))))
+
+(defun erc-fill-tests--wrap-check-nudge (expected-width)
+ (save-excursion
+ (goto-char (point-min))
+ (should (search-forward "*** This server" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- ,n (,w))))
+ (and (= n expected-width)
+ (= w (string-pixel-width "<alice> "))))
+ (`(space :width (- ,n ,w))
+ (and (= n expected-width)
+ (= w (length "<alice> "))))))
+
+ ;; Ensure the loop is not visited twice due to the gap.
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- ,n (,w))))
+ (and (= n expected-width)
+ (= w (string-pixel-width "<bob> "))))
+ (`(space :width (- ,n ,w))
+ (and (= n expected-width)
+ (= w (length "<bob> "))))))))
(ert-deftest erc-fill-wrap--monospace ()
:tags '(:unstable)
@@ -82,42 +147,22 @@ erc-fill-wrap--monospace
(erc-fill-tests--wrap-populate
(lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (erc-fill-tests--wrap-check-nudge 27)
- ;; Prefix props are applied properly and faces are accounted
- ;; for when determining widths.
- (goto-char (point-min))
- (should (search-forward "<a" nil t))
- (should (get-text-property (pos-bol) 'line-prefix))
- (should (get-text-property (pos-eol) 'line-prefix))
- (should (equal (get-text-property (pos-bol) 'wrap-prefix)
- '(space :width 27)))
- (should (equal (get-text-property (pos-eol) 'wrap-prefix)
- '(space :width 27)))
- ;; The last elt in the `:width' value is a singleton (NUM) when
- ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
- ;; prod rules table under (info "(elisp) Pixel Specification").
- (should (pcase (get-text-property (point) 'line-prefix)
- ((and (guard (fboundp 'string-pixel-width))
- `(space :width (- 27 (,w))))
- (= w (string-pixel-width "<alice> ")))
- (`(space :width (- 27 ,w))
- (= w (length "<alice> ")))))
-
- (erc-fill--wrap-nudge 2)
-
- (should (search-forward "<b" nil t))
- (should (get-text-property (pos-bol) 'line-prefix))
- (should (get-text-property (pos-eol) 'line-prefix))
- (should (equal (get-text-property (pos-bol) 'wrap-prefix)
- '(space :width 29)))
- (should (equal (get-text-property (pos-eol) 'wrap-prefix)
- '(space :width 29)))
- (should (pcase (get-text-property (point) 'line-prefix)
- ((and (guard (fboundp 'string-pixel-width))
- `(space :width (- 29 (,w))))
- (= w (string-pixel-width "<bob> ")))
- (`(space :width (- 29 ,w))
- (= w (length "<bob> "))))))))
+ (ert-info ("Shift right by one")
+ (ert-with-message-capture messages
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
+ (should (string-match (rx "for further adjustment") messages)))
+ (erc-fill-tests--wrap-check-nudge 29))
+
+ (ert-info ("Shift left by five")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
+ (erc-fill-tests--wrap-check-nudge 25))
+
+ (ert-info ("Reset")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
+ (erc-fill-tests--wrap-check-nudge 27)))))
(ert-deftest erc-fill-wrap--variable-pitch ()
:tags '(:unstable)
@@ -133,37 +178,18 @@ erc-fill-wrap--variable-pitch
:font 'unspecified)
(erc-fill-tests--wrap-populate
-
(lambda ()
-
- (goto-char (point-min))
- (should (search-forward "<a" nil t))
- (should (get-text-property (pos-bol) 'line-prefix))
- (should (get-text-property (pos-eol) 'line-prefix))
- (should (equal (get-text-property (pos-bol) 'wrap-prefix)
- '(space :width 27)))
- (should (equal (get-text-property (pos-eol) 'wrap-prefix)
- '(space :width 27)))
- (should (pcase (get-text-property (point) 'line-prefix)
- (`(space :width (- 27 (,w)))
- (> w (string-pixel-width "<alice> ")))))
-
+ (erc-fill-tests--wrap-check-nudge 27)
(erc-fill--wrap-nudge 2)
-
- (should (search-forward "<b" nil t))
- (should (get-text-property (pos-bol) 'line-prefix))
- (should (get-text-property (pos-eol) 'line-prefix))
- (should (equal (get-text-property (pos-bol) 'wrap-prefix)
- '(space :width 29)))
- (should (equal (get-text-property (pos-eol) 'wrap-prefix)
- '(space :width 29)))
- (should (pcase (get-text-property (point) 'line-prefix)
- (`(space :width (- 29 (,w)))
- (> w (string-pixel-width "<bob> ")))))
-
- ;; FIXME figure out how to get rid of this "void variable
- ;; `erc--results-ewoc'" error, which seems related to operating
- ;; in this second frame.
+ (erc-fill-tests--wrap-check-nudge 29)
+ (erc-fill--wrap-nudge -6)
+ (erc-fill-tests--wrap-check-nudge 25)
+ (erc-fill--wrap-nudge 0)
+ (erc-fill-tests--wrap-check-nudge 27)
+
+ ;; FIXME get rid of this "void variable `erc--results-ewoc'"
+ ;; error, which seems related to operating in a non-default
+ ;; frame.
;;
;; As a kludge, checking if point made it to the prompt can
;; serve as visual confirmation that the test passed.
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 69523274812..73260ff126b 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -155,8 +155,8 @@ erc-timestamp-use-align-to--margin
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Space not added (treated as opaque string).
- (should (search-forward "msg one[" nil t))
- ;; Field covers stamp alone
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers stamp and leading space
(should (eql ?e (char-before (field-beginning (point)))))
;; Vanity props extended
(should (get-text-property (field-beginning (point)) 'wrap-prefix))
@@ -170,12 +170,13 @@ erc-timestamp-use-align-to--margin
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; No hard wrap
- (should (search-forward "oooo[" nil t))
+ (should (search-forward "oooo [" nil t))
;; Field starts at leading space.
- (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
-;; This concerns the partial reversal of changes resulting from:
+;; This concerns a proposed partial reversal of the changes resulting
+;; from:
;;
;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
;;
@@ -186,12 +187,15 @@ erc-timestamp-use-align-to--margin
;; C-n puts point one past the start of the message (i.e., two chars
;; beyond the timestamp's closing "]". Dropping the invisible
;; property when timestamps are hidden does indeed prevent this, but
-;; it's also irreversible, which at least one user has complained
-;; about. Turning off `cursor-intangible-mode' does do the trick, but
-;; a better solution seems to be decrementing the end of the
-;; `cursor-intangible' interval so that, in addition to C-n working, a
-;; C-f from before the timestamp doesn't overshoot. This works
-;; whether `erc-hide-timestamps' is enabled or not.
+;; it's also a lasting commitment. The docs mention that it's
+;; pointless to pair the old `intangible' property with `invisible'
+;; and suggest users look at `cursor-intangible-mode'. Turning off
+;; the latter does indeed do the trick as does decrementing the end of
+;; the `cursor-intangible' interval so that, in addition to C-n
+;; working, a C-f from before the timestamp doesn't overshoot. This
+;; appears to be the case whether `erc-hide-timestamps' is enabled or
+;; not, but it may be inadvisable for some reason (a hack) and
+;; therefore warrants further investigation.
;;
;; Note some striking omissions here:
;;
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24873 bytes --]
From 2f0595bcea827fd302c9c313fbf1d61e32b70210 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Jan 2023 20:48:24 -0800
Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open
* lisp/erc/erc.el (erc--initialize-markers): New helper to ensure
prompt and its associated markers are set up correctly.
(erc-open): When determining whether a session is a logical
continuation, leverage the work already performed by the
`erc-networks' library to that effect. Its verdicts are based on
network context and thus reliable even when a user dials anew from an
entry-point, which is not a simple reconnection because the user
expects a clean slate for everything except an existing buffer's
messages, meaning `erc--server-reconnecting' will be nil and
local-module state variables need resetting. Also remove the check
for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create'
always does the right thing in. Replace all code involving marker and
prompt setup by deferring to a new helper, `erc--initialize markers'.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): New test.
* test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file.
* test/lisp/erc/erc-scenarios-base-local-modules.el
(erc-scenarios-base-local-modules--mode-persistence): Move test to
separate file to help with parallel "-j" runs.
---
lisp/erc/erc.el | 79 ++++---
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 --------
test/lisp/erc/erc-tests.el | 79 ++++++-
4 files changed, 331 insertions(+), 137 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ff1820cfaf2..363fe30ee58 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1966,6 +1966,45 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Respect existing multiline input after prompt. Expect any
+ ;; text preceding it on the same line, including whitespace,
+ ;; to be part of the prompt itself.
+ (goto-char (point-max))
+ (forward-line 0)
+ (while (and (not (get-text-property (point) 'erc-prompt))
+ (zerop (forward-line -1))))
+ (cl-assert (not (= (point) (point-min))))
+ (set-marker erc-insert-marker (point))
+ ;; If the input area is clean, this search should fail and
+ ;; return point max. Otherwise, it should return the position
+ ;; after the last char with the `erc-prompt' property, as per
+ ;; the doc string for `next-single-property-change'.
+ (set-marker erc-input-marker
+ (next-single-property-change (point) 'erc-prompt nil
+ (point-max)))
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -1999,10 +2038,12 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2020,21 +2061,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2081,20 +2107,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 1318207a3bf..d6dbd87c8cc 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -82,105 +82,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..c5a40d9bc72 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 5557 bytes --]
From d7f122aa18fd5d94fbbe9f9cb4da80750d7de418 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers
TODO: mention adjustment in ERC-NEWS for 5.6.
* lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text
property, which has been around since 2002, with more useful
`erc-message' property.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
(erc-put-text-property, erc-list): Alias these to built-in functions.
(erc--own-property-names, erc--remove-text-properties) Add internal
variable and helper function for filtering values returned by
`filter-buffer-substring-function'.
(erc-restore-text-properties): Don't forget tags when restoring.
(erc--get-eq-comparable-cmd): New function to extract commands for use
as easily searchable text-property values.
---
lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 43 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 363fe30ee58..6b3d0b4af2f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2880,7 +2880,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-message
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4258,6 +4260,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4309,7 +4335,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -5681,7 +5707,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5691,14 +5717,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7292,10 +7313,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7315,6 +7337,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 12975 bytes --]
From 0119e887e11eb9d63a2502179355f918058d37f0 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:10:20 -0800
Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
`erc-timestamp' to store lisp time object formerly ensconced in a
closure. Instead of creating a new lambda for the cursor-sensor
function of each message in a buffer, leave a gap between messages to
trip the sensor function. The motivation behind this change is to
allow third parties access to valuable timestamp data already stored
by ERC anyway. Of secondary importance is discouraging the reliance
on those lambdas as a means of detecting message bounds. The gap now
serves a similar purpose. Basically, the final character in a
message, a newline, will not have a timestamp or a sensor function.
When the stamps module isn't loaded, the `erc-message' property can be
used instead. Also, instead of looking for the `invisible' text
property at point, which is normally `point-max' and thus outside the
accessible portion of the buffer, look at the beginning of the
inserted message. This allows hook members running before this
function to opt out of timestamps by marking a message as invisible.
(erc-echo-timestamp): Make interactive and show timestamps even when
the variable `erc-echo-timestamps' is nil.
(erc--echo-ts-csf): Add new function to serve as value of
cursor-sensor function text properties.
* test/lisp/erc/erc-stamp-tests.el: New file.
---
lisp/erc/erc-stamp.el | 14 ++-
test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++
2 files changed, 216 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..08cdc1c8518 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -162,7 +162,7 @@ erc-add-timestamp
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
+ (unless (get-text-property (point-min) 'invisible)
(let ((ct (current-time)))
(if (fboundp erc-insert-timestamp-function)
(funcall erc-insert-timestamp-function
@@ -174,12 +174,12 @@ erc-add-timestamp
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -400,11 +400,15 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..935b9e650b3
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,207 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") " [") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;; This concerns a proposed partial reversal of the changes resulting
+;; from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also a lasting commitment. The docs mention that it's
+;; pointless to pair the old `intangible' property with `invisible'
+;; and suggest users look at `cursor-intangible-mode'. Turning off
+;; the latter does indeed do the trick as does decrementing the end of
+;; the `cursor-intangible' interval so that, in addition to C-n
+;; working, a C-f from before the timestamp doesn't overshoot. This
+;; appears to be the case whether `erc-hide-timestamps' is enabled or
+;; not, but it may be inadvisable for some reason (a hack) and
+;; therefore warrants further investigation.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;;; erc-stamp-tests.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 4437 bytes --]
From 284d96b13dfb07a60315dc140a56e7cd58cf4b6f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber
TODO: update ERC-NEWS announcing deprecation.
* lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option
and change meaning of its nil value to fall through to
`erc-timestamp-format'. Do this to allow modules to predict what the
right-hand stamp's final width will be. This also saves
`erc-insert-timestamp-left-and-right' from calling
`erc-format-timestamp' again for no reason.
(erc-stamp--current-time): Add new generic function and method to
return current time. Default to calling `current-time'.
(erc-stamp--current-time): New internal variable to hold time value
used to construct time formatted stamp passed to
`erc-insert-timestamp-function'.
(erc-add-timestamp): Bind `erc-stamp--current-time' when calling
`erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Use STRING parameter and favor
it over the now deprecated `erc-timestamp-format-right' to avoid
formatting twice. Also extract current time from the variable
`erc-stamp--current-time' for similar reasons.
---
lisp/erc/erc-stamp.el | 36 +++++++++++++++++++++++++++++-------
1 file changed, 29 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 08cdc1c8518..b9ad61aaf3e 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,17 +165,31 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
(unless (get-text-property (point-min) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch --]
[-- Type: text/x-patch, Size: 14777 bytes --]
From d11132c81daa79a412ffe29e54dbefda07c1cc15 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-side
stamps. Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests.
---
lisp/erc/erc-stamp.el | 124 +++++++++++++++++++++++++++----
test/lisp/erc/erc-stamp-tests.el | 70 +++++++++++++++--
2 files changed, 172 insertions(+), 22 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index b9ad61aaf3e..8862b14b061 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,79 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
A side effect of enabling this is that there will only be one
space before a right timestamp in any saved logs."
- :type 'boolean)
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.5")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (progn
+ (erc-stamp--adjust-right-margin 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins left-margin-width nil)
+ (set-window-fringes left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +330,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -275,6 +341,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -326,25 +394,49 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (unless (eq ?\s (aref string 0))
+ (insert-and-inherit " "))
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 935b9e650b3..73260ff126b 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") " [") nil t))
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-stamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers stamp and leading space
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2444 bytes --]
From 2c71d2de411226c317680a5146d3f8a011265eaf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match data.
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch --]
[-- Type: text/x-patch, Size: 3181 bytes --]
From ba93c5adde0389eba5f5089591bd3f933a83d013 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 05:34:56 -0800
Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec
* lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange
for possibly adding or removing `erc-match' from
`buffer-invisibility-spec'.
(erc-match--hide-fools-offset-bounds): Add new variable to serve as
switch for activating invisibility on a modified interval that's
offset toward `point-min' by one character.
(erc-hide-fools): Optionally offset start and end of invisible region
by minus one.
(erc-match--modify-invisibility-spec): New housekeeping function to
set up and tear down offset spec.
---
lisp/erc/erc-match.el | 31 +++++++++++++++++++++++++------
1 file changed, 25 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 499bcaf5724..87272f0b647 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer
(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
+
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +675,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #10: 0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 27788 bytes --]
From a3e7f1555a29b147688112b01e20057d595a8eac Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-compat.el (erc-compat--29-set-transient-map-timer,
erc-compat--29-set-transient-map, erc-compat--set-transient-map):
Backport `set-transient-map' definition from Emacs 29.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill-wrap-mode, erc-fill--wrap-prefix, erc-fill--wrap-value,
erc-fill--wrap-movement): New minor mode and variables to support it.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file.
---
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-compat.el | 56 +++++++
lisp/erc/erc-fill.el | 288 +++++++++++++++++++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 198 ++++++++++++++++++++++
4 files changed, 538 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 994555acecf..aae8280baa9 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -95,6 +95,7 @@ erc--features-to-modules
(erc-join autojoin)
(erc-page page ctcp-page)
(erc-sound sound ctcp-sound)
+ (erc-fill fill-wrap)
(erc-stamp stamp timestamp)
(erc-services services nickserv))
"Migration alist mapping a library feature to module names.
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 5601ede27a5..a4367fe4ba5 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,62 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+(defvar erc-compat--29-set-transient-map-timer nil)
+
+(defun erc-compat--29-set-transient-map
+ (map &optional keep-pred on-exit message timeout)
+ (let* ((message
+ (when message
+ (let (keys)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+ (format-spec
+ (if (stringp message) message "Repeat with %k")
+ `((?k . ,(mapconcat
+ (lambda (key)
+ (substitute-command-keys
+ (format "\\`%s'" (key-description (vector key)))))
+ keys ", ")))))))
+ (clearfun (make-symbol "clear-transient-map"))
+ (exitfun (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when message (message ""))
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (when on-exit (funcall on-exit)))))
+ (fset clearfun
+ (lambda ()
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (if (cond
+ ((null keep-pred) nil)
+ ((and (not (eq map (cadr overriding-terminal-local-map)))
+ (memq map (cddr overriding-terminal-local-map)))
+ t)
+ ((eq t keep-pred)
+ (let ((mc (lookup-key map (this-command-keys-vector))))
+ (when (and mc (symbolp mc))
+ (setq mc (or (command-remapping mc) mc)))
+ (and mc (eq this-command mc))))
+ (t (funcall keep-pred)))
+ (when message (message "%s" message))
+ (funcall exitfun)))))
+ (add-hook 'pre-command-hook clearfun)
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ (when timeout
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (setq erc-compat--29-set-transient-map-timer
+ (run-with-idle-timer timeout nil exitfun)))
+ (when message (message "%s" message))
+ exitfun))
+
+(defmacro erc-compat--set-transient-map (&rest args)
+ (cons (if (>= emacs-major-version 29)
+ 'set-transient-map
+ 'erc-compat--29-set-transient-map)
+ args))
+
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..13e95967bf8 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,29 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+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'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,268 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-prefix nil)
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall
+ (pcase erc-fill--wrap-visual-keys
+ ('non-input (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+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'. You can also manually
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
+ ((let (msg)
+ (unless erc-fill-mode
+ (unless (memq 'fill erc-modules)
+ (setq msg
+ (concat "WARNING: enabling default global module `fill' needed "
+ " by local module `fill-wrap'. This will impact all"
+ " ERC sessions. Add `fill' to `erc-modules' to avoid "
+ " this warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; 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-prefix (alist-get 'erc-fill--wrap-prefix vars)
+ erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
+ (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)
+ ;;
+ erc-fill--wrap-prefix
+ (or erc-fill--wrap-prefix
+ (list 'space :width erc-fill--wrap-value)))
+ (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))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-prefix)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- ,erc-fill--wrap-value ,len))
+ ,erc-fill--wrap-prefix)))))
+
+;; 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.
+
+(defun erc-fill--wrap-fix (&optional value)
+ "Re-wrap from `point-min' to `point-max'.
+Reset prefix to VALUE, when given."
+ (save-excursion
+ (when value
+ (setq erc-fill--wrap-value value
+ erc-fill--wrap-prefix (list 'space :width 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)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((inhibit-field-text-motion t)
+ (inhibit-read-only t) ; necessary?
+ (p (goto-char (point-min)))
+ v)
+ (when (zerop arg)
+ (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+ (cl-incf (caddr erc-fill--wrap-prefix) arg)
+ (cl-incf erc-fill--wrap-value arg)
+ (while (setq p (next-single-property-change p 'line-prefix))
+ (when-let* ((this-v (get-text-property p 'line-prefix))
+ ((not (eq this-v v))))
+ (setq v this-v)
+ (cl-incf (nth 1 (nth 2 v)) arg)))))) ; (space :width (- *i* len))
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.
+
+ \\`+', \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`C-+', \\`C-=' Shift right margin rightward (shrink it)
+ by one column
+ \\`C--' Shift right margin leftward (grow it) by one
+ column
+ \\`C-0' 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."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
+ (when (zerop arg)
+ (setq arg 1))
+ (erc-compat--set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (recenter (round (* win-ratio (window-height))))))
+ (define-key map (vector (list 'control key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
+ map)
+ t
+ (lambda ()
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (recenter (round (* win-ratio (window-height))))))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..04001ec6524
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,198 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (setq msg "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.")
+ (erc-display-message nil 'notice (current-buffer) msg)
+
+ (setq msg "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.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t)))
+
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (let ((original-window-buffer (window-buffer (selected-window))))
+ (set-window-buffer (selected-window) (current-buffer))
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (kill-buffer)))))))
+
+(defun erc-fill-tests--wrap-check-nudge (expected-width)
+ (save-excursion
+ (goto-char (point-min))
+ (should (search-forward "*** This server" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- ,n (,w))))
+ (and (= n expected-width)
+ (= w (string-pixel-width "<alice> "))))
+ (`(space :width (- ,n ,w))
+ (and (= n expected-width)
+ (= w (length "<alice> "))))))
+
+ ;; Ensure the loop is not visited twice due to the gap.
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- ,n (,w))))
+ (and (= n expected-width)
+ (= w (string-pixel-width "<bob> "))))
+ (`(space :width (- ,n ,w))
+ (and (= n expected-width)
+ (= w (length "<bob> "))))))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (erc-fill-tests--wrap-check-nudge 27)
+
+ (ert-info ("Shift right by one")
+ (ert-with-message-capture messages
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
+ (should (string-match (rx "for further adjustment") messages)))
+ (erc-fill-tests--wrap-check-nudge 29))
+
+ (ert-info ("Shift left by five")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
+ (erc-fill-tests--wrap-check-nudge 25))
+
+ (ert-info ("Reset")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
+ (erc-fill-tests--wrap-check-nudge 27)))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (fboundp 'string-pixel-width)
+ (not noninteractive)
+ (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (erc-fill-tests--wrap-check-nudge 27)
+ (erc-fill--wrap-nudge 2)
+ (erc-fill-tests--wrap-check-nudge 29)
+ (erc-fill--wrap-nudge -6)
+ (erc-fill-tests--wrap-check-nudge 25)
+ (erc-fill--wrap-nudge 0)
+ (erc-fill-tests--wrap-check-nudge 27)
+
+ ;; FIXME get rid of this "void variable `erc--results-ewoc'"
+ ;; error, which seems related to operating in a non-default
+ ;; frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+;;; erc-fill-tests.el ends here
--
2.39.1
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (3 preceding siblings ...)
2023-01-31 15:28 ` J.P.
@ 2023-02-01 14:27 ` J.P.
2023-02-07 15:23 ` J.P.
` (20 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-02-01 14:27 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 279 bytes --]
v6. Revert addition of leading space for `margin' timestamps. Add
`erc-log-filter-function' tailored to new `erc-timestamp-use-align-to'
offerings.
(For now, this log style resembles those produced by the ZNC bouncer.
See attached sample and screenshot of originating buffer.)
[-- Attachment #2: #chan!tester@127.0.0.1:6667.txt --]
[-- Type: text/plain, Size: 663 bytes --]
[13:48:07]
[13:48:07] [Wed Feb 1 2023]
[13:48:07] *** You have joined channel #chan
[13:48:07] *** Users on #chan: @bob alice tester
[13:48:07] <alice> tester, welcome!
[13:48:07] <bob> tester, welcome!
[13:48:07] *** #chan modes: +nt
[13:48:07] *** #chan was created on 2023-02-01 12:58:04
[13:48:09] <bob> alice: An actor too perhaps, if I see cause.
[13:48:13] <alice> bob: Nay, but the devil take mocking: speak, sad brow and true maid.
[13:48:17] <bob> alice: My liege, your highness now may do me good.
[13:48:22] <alice> bob: Farewell! God knows when we shall meet again.
[13:48:27] <bob> alice: Well said, old mocker: I must needs be friends with thee.
[-- Attachment #3: fill-wrap-log-compare-chan.png --]
[-- Type: image/png, Size: 54453 bytes --]
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0000-v5-v6.diff --]
[-- Type: text/x-patch, Size: 5683 bytes --]
From 4dc8b4968313d3e99c680f25693a2a5ef7e301c5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 1 Feb 2023 05:59:21 -0800
Subject: [PATCH 0/8] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (8):
[5.6] Refactor marker initialization in erc-open
[5.6] Adjust some old text properties in ERC buffers
[5.6] Expose insertion time as text prop in erc-stamp
[5.6] Make some erc-stamp functions more limber
[5.6] Put display properties to better use in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add variant for erc-match invisibility spec
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-compat.el | 56 +++
lisp/erc/erc-fill.el | 322 ++++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 204 +++++++++--
lisp/erc/erc.el | 136 +++++---
test/lisp/erc/erc-fill-tests.el | 198 +++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 265 ++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
11 files changed, 1387 insertions(+), 215 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
Interdiff:
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 8862b14b061..d1c2f790bc8 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -251,8 +251,14 @@ erc-timestamp-use-align-to
right edge. If the value is `margin', the stamp appears in the
right margin when visible.
-A side effect of enabling this is that there will only be one
-space before a right timestamp in any saved logs."
+Enabling this option produces a side effect in that stamps aren't
+indented in saved logs. When its value is an integer, this
+option adds a space after the end of a message if the stamp
+doesn't already start with one. And when its value is t, it adds
+a single space, unconditionally. And while this option never
+adds a space when its value is `margin', ERC does offer a
+workaround in `erc-stamp-prefix-log-filter', which strips
+trailing stamps from messages and puts them before every line."
:type '(choice boolean integer (const margin))
:package-version '(ERC . "5.5")) ; FIXME sync on release
@@ -287,6 +293,28 @@ erc-stamp--adjust-right-margin
(set-window-margins nil left-margin-width width)
(set-window-fringes nil left-fringe-width 0)))
+(defun erc-stamp-prefix-log-filter (text)
+ "Prefix every message in the buffer with a stamp.
+Remove trailing stamps as well. For now, hard code the format to
+\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
+`erc-log-filter-function' when `erc-timestamp-use-align-to' is
+non-nil."
+ (insert text)
+ (goto-char (point-min))
+ (while
+ (progn
+ (when-let* (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
+ (delete-region beg (1+ end)))
+ (when-let (time (get-text-property (point) 'erc-timestamp))
+ (insert (format-time-string "[%H:%M:%S] " time)))
+ (zerop (forward-line))))
+ "")
+
;; If people want to use this directly, we can convert it into
;; a local module.
(define-minor-mode erc-stamp--display-margin-mode
@@ -408,8 +436,6 @@ erc-insert-timestamp-right
(put-text-property from (point) 'display
`(space :align-to (- right ,s)))))
('margin
- (unless (eq ?\s (aref string 0))
- (insert-and-inherit " "))
(put-text-property 0 (length string)
'display `((margin right-margin) ,string)
string))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 73260ff126b..01e71e348e0 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -155,8 +155,8 @@ erc-timestamp-use-align-to--margin
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Space not added (treated as opaque string).
- (should (search-forward "msg one [" nil t))
- ;; Field covers stamp and leading space
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
(should (eql ?e (char-before (field-beginning (point)))))
;; Vanity props extended
(should (get-text-property (field-beginning (point)) 'wrap-prefix))
@@ -170,9 +170,9 @@ erc-timestamp-use-align-to--margin
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; No hard wrap
- (should (search-forward "oooo [" nil t))
- ;; Field starts at leading space.
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (search-forward "oooo[" nil t))
+ ;; Field starts at format string (right bracket)
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24873 bytes --]
From e22e001fe0dfc53acc229a99ff2a4f761610861a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Jan 2023 20:48:24 -0800
Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open
* lisp/erc/erc.el (erc--initialize-markers): New helper to ensure
prompt and its associated markers are set up correctly.
(erc-open): When determining whether a session is a logical
continuation, leverage the work already performed by the
`erc-networks' library to that effect. Its verdicts are based on
network context and thus reliable even when a user dials anew from an
entry-point, which is not a simple reconnection because the user
expects a clean slate for everything except an existing buffer's
messages, meaning `erc--server-reconnecting' will be nil and
local-module state variables need resetting. Also remove the check
for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create'
always does the right thing in. Replace all code involving marker and
prompt setup by deferring to a new helper, `erc--initialize markers'.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): New test.
* test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file.
* test/lisp/erc/erc-scenarios-base-local-modules.el
(erc-scenarios-base-local-modules--mode-persistence): Move test to
separate file to help with parallel "-j" runs.
---
lisp/erc/erc.el | 79 ++++---
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 --------
test/lisp/erc/erc-tests.el | 79 ++++++-
4 files changed, 331 insertions(+), 137 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ff1820cfaf2..363fe30ee58 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1966,6 +1966,45 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Respect existing multiline input after prompt. Expect any
+ ;; text preceding it on the same line, including whitespace,
+ ;; to be part of the prompt itself.
+ (goto-char (point-max))
+ (forward-line 0)
+ (while (and (not (get-text-property (point) 'erc-prompt))
+ (zerop (forward-line -1))))
+ (cl-assert (not (= (point) (point-min))))
+ (set-marker erc-insert-marker (point))
+ ;; If the input area is clean, this search should fail and
+ ;; return point max. Otherwise, it should return the position
+ ;; after the last char with the `erc-prompt' property, as per
+ ;; the doc string for `next-single-property-change'.
+ (set-marker erc-input-marker
+ (next-single-property-change (point) 'erc-prompt nil
+ (point-max)))
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -1999,10 +2038,12 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2020,21 +2061,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2081,20 +2107,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 1318207a3bf..d6dbd87c8cc 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -82,105 +82,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..c5a40d9bc72 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 5557 bytes --]
From dd598dfae6dd975534ec289c180ff01264fe81e9 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers
TODO: mention adjustment in ERC-NEWS for 5.6.
* lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text
property, which has been around since 2002, with more useful
`erc-message' property.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
(erc-put-text-property, erc-list): Alias these to built-in functions.
(erc--own-property-names, erc--remove-text-properties) Add internal
variable and helper function for filtering values returned by
`filter-buffer-substring-function'.
(erc-restore-text-properties): Don't forget tags when restoring.
(erc--get-eq-comparable-cmd): New function to extract commands for use
as easily searchable text-property values.
---
lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 43 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 363fe30ee58..6b3d0b4af2f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2880,7 +2880,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-message
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4258,6 +4260,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4309,7 +4335,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -5681,7 +5707,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5691,14 +5717,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7292,10 +7313,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7315,6 +7337,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 12975 bytes --]
From b23671842178070026b6036e79a4a88848d8759a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:10:20 -0800
Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
`erc-timestamp' to store lisp time object formerly ensconced in a
closure. Instead of creating a new lambda for the cursor-sensor
function of each message in a buffer, leave a gap between messages to
trip the sensor function. The motivation behind this change is to
allow third parties access to valuable timestamp data already stored
by ERC anyway. Of secondary importance is discouraging the reliance
on those lambdas as a means of detecting message bounds. The gap now
serves a similar purpose. Basically, the final character in a
message, a newline, will not have a timestamp or a sensor function.
When the stamps module isn't loaded, the `erc-message' property can be
used instead. Also, instead of looking for the `invisible' text
property at point, which is normally `point-max' and thus outside the
accessible portion of the buffer, look at the beginning of the
inserted message. This allows hook members running before this
function to opt out of timestamps by marking a message as invisible.
(erc-echo-timestamp): Make interactive and show timestamps even when
the variable `erc-echo-timestamps' is nil.
(erc--echo-ts-csf): Add new function to serve as value of
cursor-sensor function text properties.
* test/lisp/erc/erc-stamp-tests.el: New file.
---
lisp/erc/erc-stamp.el | 14 ++-
test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++
2 files changed, 216 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..08cdc1c8518 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -162,7 +162,7 @@ erc-add-timestamp
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
+ (unless (get-text-property (point-min) 'invisible)
(let ((ct (current-time)))
(if (fboundp erc-insert-timestamp-function)
(funcall erc-insert-timestamp-function
@@ -174,12 +174,12 @@ erc-add-timestamp
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -400,11 +400,15 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..935b9e650b3
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,207 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") " [") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;; This concerns a proposed partial reversal of the changes resulting
+;; from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also a lasting commitment. The docs mention that it's
+;; pointless to pair the old `intangible' property with `invisible'
+;; and suggest users look at `cursor-intangible-mode'. Turning off
+;; the latter does indeed do the trick as does decrementing the end of
+;; the `cursor-intangible' interval so that, in addition to C-n
+;; working, a C-f from before the timestamp doesn't overshoot. This
+;; appears to be the case whether `erc-hide-timestamps' is enabled or
+;; not, but it may be inadvisable for some reason (a hack) and
+;; therefore warrants further investigation.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;;; erc-stamp-tests.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0004-5.6-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 4437 bytes --]
From eac909ce56cf8dba87750676e13c37c974f72cd8 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber
TODO: update ERC-NEWS announcing deprecation.
* lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option
and change meaning of its nil value to fall through to
`erc-timestamp-format'. Do this to allow modules to predict what the
right-hand stamp's final width will be. This also saves
`erc-insert-timestamp-left-and-right' from calling
`erc-format-timestamp' again for no reason.
(erc-stamp--current-time): Add new generic function and method to
return current time. Default to calling `current-time'.
(erc-stamp--current-time): New internal variable to hold time value
used to construct time formatted stamp passed to
`erc-insert-timestamp-function'.
(erc-add-timestamp): Bind `erc-stamp--current-time' when calling
`erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Use STRING parameter and favor
it over the now deprecated `erc-timestamp-format-right' to avoid
formatting twice. Also extract current time from the variable
`erc-stamp--current-time' for similar reasons.
---
lisp/erc/erc-stamp.el | 36 +++++++++++++++++++++++++++++-------
1 file changed, 29 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 08cdc1c8518..b9ad61aaf3e 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,17 +165,31 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
(unless (get-text-property (point-min) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch --]
[-- Type: text/x-patch, Size: 16081 bytes --]
From b88dfe1945b3f13507bdcbc438bf438d0bb2e8b1 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-side
stamps. Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests.
---
lisp/erc/erc-stamp.el | 154 +++++++++++++++++++++++++++----
test/lisp/erc/erc-stamp-tests.el | 70 ++++++++++++--
2 files changed, 200 insertions(+), 24 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index b9ad61aaf3e..d1c2f790bc8 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,107 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
-A side effect of enabling this is that there will only be one
-space before a right timestamp in any saved logs."
- :type 'boolean)
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
+Enabling this option produces a side effect in that stamps aren't
+indented in saved logs. When its value is an integer, this
+option adds a space after the end of a message if the stamp
+doesn't already start with one. And when its value is t, it adds
+a single space, unconditionally. And while this option never
+adds a space when its value is `margin', ERC does offer a
+workaround in `erc-stamp-prefix-log-filter', which strips
+trailing stamps from messages and puts them before every line."
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.5")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
+(defun erc-stamp-prefix-log-filter (text)
+ "Prefix every message in the buffer with a stamp.
+Remove trailing stamps as well. For now, hard code the format to
+\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
+`erc-log-filter-function' when `erc-timestamp-use-align-to' is
+non-nil."
+ (insert text)
+ (goto-char (point-min))
+ (while
+ (progn
+ (when-let* (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
+ (delete-region beg (1+ end)))
+ (when-let (time (get-text-property (point) 'erc-timestamp))
+ (insert (format-time-string "[%H:%M:%S] " time)))
+ (zerop (forward-line))))
+ "")
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (progn
+ (erc-stamp--adjust-right-margin 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins left-margin-width nil)
+ (set-window-fringes left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +358,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -275,6 +369,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -326,25 +422,47 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 935b9e650b3..01e71e348e0 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") " [") nil t))
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-stamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo[" nil t))
+ ;; Field starts at format string (right bracket)
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #10: 0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2444 bytes --]
From 4a5909b379c5d0393c6a9f46a41b8d45531e02be Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match data.
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #11: 0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch --]
[-- Type: text/x-patch, Size: 3181 bytes --]
From 3e6d4d199863f4c70404b90febc0e66ec9e45885 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 05:34:56 -0800
Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec
* lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange
for possibly adding or removing `erc-match' from
`buffer-invisibility-spec'.
(erc-match--hide-fools-offset-bounds): Add new variable to serve as
switch for activating invisibility on a modified interval that's
offset toward `point-min' by one character.
(erc-hide-fools): Optionally offset start and end of invisible region
by minus one.
(erc-match--modify-invisibility-spec): New housekeeping function to
set up and tear down offset spec.
---
lisp/erc/erc-match.el | 31 +++++++++++++++++++++++++------
1 file changed, 25 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 499bcaf5724..87272f0b647 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer
(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
+
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +675,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #12: 0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 27788 bytes --]
From 4dc8b4968313d3e99c680f25693a2a5ef7e301c5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-compat.el (erc-compat--29-set-transient-map-timer,
erc-compat--29-set-transient-map, erc-compat--set-transient-map):
Backport `set-transient-map' definition from Emacs 29.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill-wrap-mode, erc-fill--wrap-prefix, erc-fill--wrap-value,
erc-fill--wrap-movement): New minor mode and variables to support it.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file.
---
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-compat.el | 56 +++++++
lisp/erc/erc-fill.el | 288 +++++++++++++++++++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 198 ++++++++++++++++++++++
4 files changed, 538 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 994555acecf..aae8280baa9 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -95,6 +95,7 @@ erc--features-to-modules
(erc-join autojoin)
(erc-page page ctcp-page)
(erc-sound sound ctcp-sound)
+ (erc-fill fill-wrap)
(erc-stamp stamp timestamp)
(erc-services services nickserv))
"Migration alist mapping a library feature to module names.
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 5601ede27a5..a4367fe4ba5 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,62 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+(defvar erc-compat--29-set-transient-map-timer nil)
+
+(defun erc-compat--29-set-transient-map
+ (map &optional keep-pred on-exit message timeout)
+ (let* ((message
+ (when message
+ (let (keys)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+ (format-spec
+ (if (stringp message) message "Repeat with %k")
+ `((?k . ,(mapconcat
+ (lambda (key)
+ (substitute-command-keys
+ (format "\\`%s'" (key-description (vector key)))))
+ keys ", ")))))))
+ (clearfun (make-symbol "clear-transient-map"))
+ (exitfun (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when message (message ""))
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (when on-exit (funcall on-exit)))))
+ (fset clearfun
+ (lambda ()
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (if (cond
+ ((null keep-pred) nil)
+ ((and (not (eq map (cadr overriding-terminal-local-map)))
+ (memq map (cddr overriding-terminal-local-map)))
+ t)
+ ((eq t keep-pred)
+ (let ((mc (lookup-key map (this-command-keys-vector))))
+ (when (and mc (symbolp mc))
+ (setq mc (or (command-remapping mc) mc)))
+ (and mc (eq this-command mc))))
+ (t (funcall keep-pred)))
+ (when message (message "%s" message))
+ (funcall exitfun)))))
+ (add-hook 'pre-command-hook clearfun)
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ (when timeout
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (setq erc-compat--29-set-transient-map-timer
+ (run-with-idle-timer timeout nil exitfun)))
+ (when message (message "%s" message))
+ exitfun))
+
+(defmacro erc-compat--set-transient-map (&rest args)
+ (cons (if (>= emacs-major-version 29)
+ 'set-transient-map
+ 'erc-compat--29-set-transient-map)
+ args))
+
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..13e95967bf8 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,29 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+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'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,268 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-prefix nil)
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall
+ (pcase erc-fill--wrap-visual-keys
+ ('non-input (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+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'. You can also manually
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
+ ((let (msg)
+ (unless erc-fill-mode
+ (unless (memq 'fill erc-modules)
+ (setq msg
+ (concat "WARNING: enabling default global module `fill' needed "
+ " by local module `fill-wrap'. This will impact all"
+ " ERC sessions. Add `fill' to `erc-modules' to avoid "
+ " this warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; 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-prefix (alist-get 'erc-fill--wrap-prefix vars)
+ erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
+ (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)
+ ;;
+ erc-fill--wrap-prefix
+ (or erc-fill--wrap-prefix
+ (list 'space :width erc-fill--wrap-value)))
+ (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))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-prefix)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- ,erc-fill--wrap-value ,len))
+ ,erc-fill--wrap-prefix)))))
+
+;; 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.
+
+(defun erc-fill--wrap-fix (&optional value)
+ "Re-wrap from `point-min' to `point-max'.
+Reset prefix to VALUE, when given."
+ (save-excursion
+ (when value
+ (setq erc-fill--wrap-value value
+ erc-fill--wrap-prefix (list 'space :width 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)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((inhibit-field-text-motion t)
+ (inhibit-read-only t) ; necessary?
+ (p (goto-char (point-min)))
+ v)
+ (when (zerop arg)
+ (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+ (cl-incf (caddr erc-fill--wrap-prefix) arg)
+ (cl-incf erc-fill--wrap-value arg)
+ (while (setq p (next-single-property-change p 'line-prefix))
+ (when-let* ((this-v (get-text-property p 'line-prefix))
+ ((not (eq this-v v))))
+ (setq v this-v)
+ (cl-incf (nth 1 (nth 2 v)) arg)))))) ; (space :width (- *i* len))
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.
+
+ \\`+', \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`C-+', \\`C-=' Shift right margin rightward (shrink it)
+ by one column
+ \\`C--' Shift right margin leftward (grow it) by one
+ column
+ \\`C-0' 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."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
+ (when (zerop arg)
+ (setq arg 1))
+ (erc-compat--set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (recenter (round (* win-ratio (window-height))))))
+ (define-key map (vector (list 'control key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
+ map)
+ t
+ (lambda ()
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (recenter (round (* win-ratio (window-height))))))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..04001ec6524
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,198 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (setq msg "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.")
+ (erc-display-message nil 'notice (current-buffer) msg)
+
+ (setq msg "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.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t)))
+
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (let ((original-window-buffer (window-buffer (selected-window))))
+ (set-window-buffer (selected-window) (current-buffer))
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (kill-buffer)))))))
+
+(defun erc-fill-tests--wrap-check-nudge (expected-width)
+ (save-excursion
+ (goto-char (point-min))
+ (should (search-forward "*** This server" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (should (search-forward "<a" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- ,n (,w))))
+ (and (= n expected-width)
+ (= w (string-pixel-width "<alice> "))))
+ (`(space :width (- ,n ,w))
+ (and (= n expected-width)
+ (= w (length "<alice> "))))))
+
+ ;; Ensure the loop is not visited twice due to the gap.
+ (should (search-forward "<b" nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ `(space :width ,expected-width)))
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- ,n (,w))))
+ (and (= n expected-width)
+ (= w (string-pixel-width "<bob> "))))
+ (`(space :width (- ,n ,w))
+ (and (= n expected-width)
+ (= w (length "<bob> "))))))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (erc-fill-tests--wrap-check-nudge 27)
+
+ (ert-info ("Shift right by one")
+ (ert-with-message-capture messages
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
+ (should (string-match (rx "for further adjustment") messages)))
+ (erc-fill-tests--wrap-check-nudge 29))
+
+ (ert-info ("Shift left by five")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
+ (erc-fill-tests--wrap-check-nudge 25))
+
+ (ert-info ("Reset")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
+ (erc-fill-tests--wrap-check-nudge 27)))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (fboundp 'string-pixel-width)
+ (not noninteractive)
+ (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (erc-fill-tests--wrap-check-nudge 27)
+ (erc-fill--wrap-nudge 2)
+ (erc-fill-tests--wrap-check-nudge 29)
+ (erc-fill--wrap-nudge -6)
+ (erc-fill-tests--wrap-check-nudge 25)
+ (erc-fill--wrap-nudge 0)
+ (erc-fill-tests--wrap-check-nudge 27)
+
+ ;; FIXME get rid of this "void variable `erc--results-ewoc'"
+ ;; error, which seems related to operating in a non-default
+ ;; frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+;;; erc-fill-tests.el ends here
--
2.39.1
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (4 preceding siblings ...)
2023-02-01 14:27 ` J.P.
@ 2023-02-07 15:23 ` J.P.
2023-02-19 15:05 ` J.P.
` (19 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-02-07 15:23 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 89 bytes --]
v7. Remove unused variable. Get smarter about display props. Add test
for key bindings.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v6-v7.diff --]
[-- Type: text/x-patch, Size: 18868 bytes --]
From c514a426bef91674fc726816ff415183f4d1da0c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 7 Feb 2023 00:30:23 -0800
Subject: [PATCH 0/8] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (8):
[5.6] Refactor marker initialization in erc-open
[5.6] Adjust some old text properties in ERC buffers
[5.6] Expose insertion time as text prop in erc-stamp
[5.6] Make some erc-stamp functions more limber
[5.6] Put display properties to better use in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add variant for erc-match invisibility spec
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-compat.el | 56 ++++
lisp/erc/erc-fill.el | 307 ++++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 204 ++++++++++--
lisp/erc/erc.el | 136 +++++---
test/lisp/erc/erc-fill-tests.el | 278 ++++++++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 265 +++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
10 files changed, 1451 insertions(+), 215 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
Interdiff:
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index aae8280baa9..994555acecf 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -95,7 +95,6 @@ erc--features-to-modules
(erc-join autojoin)
(erc-page page ctcp-page)
(erc-sound sound ctcp-sound)
- (erc-fill fill-wrap)
(erc-stamp stamp timestamp)
(erc-services services nickserv))
"Migration alist mapping a library feature to module names.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 13e95967bf8..ba538a7c152 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -171,7 +171,6 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
-(defvar-local erc-fill--wrap-prefix nil)
(defvar-local erc-fill--wrap-value nil)
(defvar-local erc-fill--wrap-visual-keys nil)
@@ -195,12 +194,12 @@ erc-fill-wrap-visual-keys
:type '(choice (const nil) (const t) (const non-input)))
(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
- (funcall
- (pcase erc-fill--wrap-visual-keys
- ('non-input (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
- ('t visual-cmd)
- (_ normal-cmd))
- arg))
+ (funcall (pcase erc-fill--wrap-visual-keys
+ ('non-input
+ (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
(defun erc-fill--wrap-kill-line (arg)
"Defer to `kill-line' or `kill-visual-line'."
@@ -252,6 +251,7 @@ erc-fill-wrap-mode-map
(defvar erc-match-mode)
(defvar erc-match--hide-fools-offset-bounds)
+;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
This local module depends on the global `fill' module. To use
@@ -265,10 +265,12 @@ fill-wrap
(unless erc-fill-mode
(unless (memq 'fill erc-modules)
(setq msg
- (concat "WARNING: enabling default global module `fill' needed "
- " by local module `fill-wrap'. This will impact all"
- " ERC sessions. Add `fill' to `erc-modules' to avoid "
- " this warning. See Info:\"(erc) Modules\" for more.")))
+ ;; FIXME use `erc-button--display-error-notice-with-keys'
+ ;; when bug#60933 is ready.
+ (concat "Enabling default global module `fill' needed by local"
+ " module `fill-wrap'. This will impact \C-]all\C-] ERC"
+ " sessions. Add `fill' to `erc-modules' to avoid this"
+ " warning. See Info:\"(erc) Modules\" for more.")))
(erc-fill-mode +1))
;; Set local value of user option (can we avoid this somehow?)
(unless (eq erc-fill-function #'erc-fill-wrap)
@@ -277,7 +279,6 @@ fill-wrap
((alist-get 'erc-fill-wrap-mode vars)))
(setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys
vars)
- erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix vars)
erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
(when (or erc-stamp-mode (memq 'stamp erc-modules))
(erc-stamp--display-margin-mode +1))
@@ -285,11 +286,7 @@ fill-wrap
(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)
- ;;
- erc-fill--wrap-prefix
- (or erc-fill--wrap-prefix
- (list 'space :width 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))
@@ -298,7 +295,6 @@ fill-wrap
((when erc-stamp--display-margin-mode
(erc-stamp--display-margin-mode -1))
(kill-local-variable 'erc-button--add-nickname-face-function)
- (kill-local-variable 'erc-fill--wrap-prefix)
(kill-local-variable 'erc-fill--wrap-value)
(kill-local-variable 'erc-fill-function)
(kill-local-variable 'erc-fill--wrap-visual-keys)
@@ -307,7 +303,7 @@ fill-wrap
(defvar-local erc-fill--wrap-length-function nil
"Function to determine length of overhanging characters.
-It should return an EXPR as defined by the info node `(elisp)
+It should return an EXPR as defined by the Info node `(elisp)
Pixel Specification'. This value should represent the width of
the overhang with all faces applied, including any enclosing
brackets (which are not normally fontified) and a trailing space.
@@ -337,20 +333,22 @@ erc-fill-wrap
;; Leaving out the final newline doesn't seem to affect anything.
(erc-put-text-properties (point-min) (point-max)
'(line-prefix wrap-prefix) nil
- `((space :width (- ,erc-fill--wrap-value ,len))
- ,erc-fill--wrap-prefix)))))
+ `((space :width (- erc-fill--wrap-value ,len))
+ (space :width erc-fill--wrap-value))))))
;; 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.
+;; 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'.
-Reset prefix to VALUE, when given."
+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
- erc-fill--wrap-prefix (list 'space :width value)))
+ (setq erc-fill--wrap-value value))
(let ((inhibit-field-text-motion t)
(inhibit-read-only t))
(goto-char (point-min))
@@ -361,22 +359,9 @@ erc-fill--wrap-fix
(erc-fill-wrap))))))
(defun erc-fill--wrap-nudge (arg)
- (save-excursion
- (save-restriction
- (widen)
- (let ((inhibit-field-text-motion t)
- (inhibit-read-only t) ; necessary?
- (p (goto-char (point-min)))
- v)
- (when (zerop arg)
- (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
- (cl-incf (caddr erc-fill--wrap-prefix) arg)
- (cl-incf erc-fill--wrap-value arg)
- (while (setq p (next-single-property-change p 'line-prefix))
- (when-let* ((this-v (get-text-property p 'line-prefix))
- ((not (eq this-v v))))
- (setq v this-v)
- (cl-incf (nth 1 (nth 2 v)) arg)))))) ; (space :width (- *i* len))
+ (when (zerop arg)
+ (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+ (cl-incf erc-fill--wrap-value arg)
arg)
(defun erc-fill-wrap-nudge (arg)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 04001ec6524..8e8d585617a 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -19,6 +19,13 @@
;;; Commentary:
+;; FIXME these fixtures (and tests) are now largely useless. Due to
+;; the author's ignorance regarding display properties, the "space"
+;; specs of prefix props on different lines didn't initially leverage
+;; a common variable (`erc-fill--wrap-value'), so the column twiddling
+;; was more laborious. See decades-old comment above
+;; calc_pixel_width_or_height in in xdisp.c for examples.
+
;;; Code:
(require 'ert-x)
(require 'erc-fill)
@@ -91,55 +98,34 @@ erc-fill-tests--wrap-populate
(when noninteractive
(kill-buffer)))))))
-(defun erc-fill-tests--wrap-check-nudge (expected-width)
+(defun erc-fill-tests--wrap-check-props (speaker)
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (should (search-forward speaker nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- erc-fill--wrap-value (,w))))
+ (= w (string-pixel-width speaker)))
+ (`(space :width (- erc-fill--wrap-value ,w))
+ (= w (length speaker))))))
+
+(defun erc-fill-tests--wrap-check-prefixes ()
(save-excursion
(goto-char (point-min))
- (should (search-forward "*** This server" nil t))
- (should (get-text-property (pos-bol) 'line-prefix))
- (should (get-text-property (pos-eol) 'line-prefix))
- (should (equal (get-text-property (pos-bol) 'wrap-prefix)
- `(space :width ,expected-width)))
- (should (equal (get-text-property (pos-eol) 'wrap-prefix)
- `(space :width ,expected-width)))
-
- ;; Prefix props are applied properly and faces are accounted
- ;; for when determining widths.
- (should (search-forward "<a" nil t))
- (should (get-text-property (pos-bol) 'line-prefix))
- (should (get-text-property (pos-eol) 'line-prefix))
- (should (equal (get-text-property (pos-bol) 'wrap-prefix)
- `(space :width ,expected-width)))
- (should (equal (get-text-property (pos-eol) 'wrap-prefix)
- `(space :width ,expected-width)))
-
- ;; The last elt in the `:width' value is a singleton (NUM) when
- ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
- ;; prod rules table under (info "(elisp) Pixel Specification").
- (should (pcase (get-text-property (point) 'line-prefix)
- ((and (guard (fboundp 'string-pixel-width))
- `(space :width (- ,n (,w))))
- (and (= n expected-width)
- (= w (string-pixel-width "<alice> "))))
- (`(space :width (- ,n ,w))
- (and (= n expected-width)
- (= w (length "<alice> "))))))
-
+ (erc-fill-tests--wrap-check-props "*** ")
+ (erc-fill-tests--wrap-check-props "<alice> ")
;; Ensure the loop is not visited twice due to the gap.
- (should (search-forward "<b" nil t))
- (should (get-text-property (pos-bol) 'line-prefix))
- (should (get-text-property (pos-eol) 'line-prefix))
- (should (equal (get-text-property (pos-bol) 'wrap-prefix)
- `(space :width ,expected-width)))
- (should (equal (get-text-property (pos-eol) 'wrap-prefix)
- `(space :width ,expected-width)))
- (should (pcase (get-text-property (point) 'line-prefix)
- ((and (guard (fboundp 'string-pixel-width))
- `(space :width (- ,n (,w))))
- (and (= n expected-width)
- (= w (string-pixel-width "<bob> "))))
- (`(space :width (- ,n ,w))
- (and (= n expected-width)
- (= w (length "<bob> "))))))))
+ (erc-fill-tests--wrap-check-props "<bob> ")))
(ert-deftest erc-fill-wrap--monospace ()
:tags '(:unstable)
@@ -148,21 +134,25 @@ erc-fill-wrap--monospace
(lambda ()
(set-window-buffer (selected-window) (current-buffer))
- (erc-fill-tests--wrap-check-nudge 27)
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
- (ert-info ("Shift right by one")
+ (ert-info ("Shift right by one (plus)")
(ert-with-message-capture messages
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
(should (string-match (rx "for further adjustment") messages)))
- (erc-fill-tests--wrap-check-nudge 29))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes))
(ert-info ("Shift left by five")
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
- (erc-fill-tests--wrap-check-nudge 25))
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes))
(ert-info ("Reset")
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
- (erc-fill-tests--wrap-check-nudge 27)))))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)))))
(ert-deftest erc-fill-wrap--variable-pitch ()
:tags '(:unstable)
@@ -179,13 +169,17 @@ erc-fill-wrap--variable-pitch
(erc-fill-tests--wrap-populate
(lambda ()
- (erc-fill-tests--wrap-check-nudge 27)
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
(erc-fill--wrap-nudge 2)
- (erc-fill-tests--wrap-check-nudge 29)
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes)
(erc-fill--wrap-nudge -6)
- (erc-fill-tests--wrap-check-nudge 25)
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes)
(erc-fill--wrap-nudge 0)
- (erc-fill-tests--wrap-check-nudge 27)
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
;; FIXME get rid of this "void variable `erc--results-ewoc'"
;; error, which seems related to operating in a non-default
@@ -195,4 +189,90 @@ erc-fill-wrap--variable-pitch
;; serve as visual confirmation that the test passed.
(goto-char (point-max))))))
+(ert-deftest erc-fill-wrap-visual-keys--body ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (execute-kbd-macro "\C-e")
+ (should (search-backward "tedious fool" nil t))
+ (should-not (looking-back "done to her\\."))
+ (forward-char)
+ (execute-kbd-macro "\C-e")
+ (should (search-forward "done to her." nil t)))
+
+ (ert-info ("Value: nil")
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (goto-char (point-min))
+ (should (search-forward "in debug mode" nil t))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at (rx "*** ")))
+ (execute-kbd-macro "\C-e")
+ (should (eql ?\] (char-before (point)))))
+
+ (ert-info ("Value: t")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (should (search-backward "tedious fool" nil t))
+ (execute-kbd-macro "\C-e")
+ (should-not (looking-back (rx "done to her\\.")))
+ (should (search-forward "done to her." nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--prompt ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (goto-char erc-input-marker)
+ (insert "This buffer is for text that is not saved, and for Lisp "
+ "evaluation. To create a file, visit it with C-x C-f and "
+ "enter text in its buffer.")
+
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-e")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: nil") ; same
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (execute-kbd-macro "\C-y")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: non-input")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (execute-kbd-macro "\C-y")
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at "This buffer"))
+ (execute-kbd-macro "\C-p")
+ (should-not (looking-back "its buffer\\."))
+ (should (search-forward "its buffer." nil t))
+ (should (search-backward "ERC> " nil t))
+ (execute-kbd-macro "\C-a")))))
+
;;; erc-fill-tests.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24887 bytes --]
From e93e145a8ae792e5b07e15b24d2821b9c09e3432 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Jan 2023 20:48:24 -0800
Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open
* lisp/erc/erc.el (erc--initialize-markers): New helper to ensure
prompt and its associated markers are set up correctly.
(erc-open): When determining whether a session is a logical
continuation, leverage the work already performed by the
`erc-networks' library to that effect. Its verdicts are based on
network context and thus reliable even when a user dials anew from an
entry-point, which is not a simple reconnection because the user
expects a clean slate for everything except an existing buffer's
messages, meaning `erc--server-reconnecting' will be nil and
local-module state variables need resetting. Also remove the check
for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create'
always does the right thing in. Replace all code involving marker and
prompt setup by deferring to a new helper, `erc--initialize markers'.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): New test.
* test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file.
* test/lisp/erc/erc-scenarios-base-local-modules.el
(erc-scenarios-base-local-modules--mode-persistence): Move test to
separate file to help with parallel "-j" runs. (Bug#60936.)
---
lisp/erc/erc.el | 79 ++++---
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 --------
test/lisp/erc/erc-tests.el | 79 ++++++-
4 files changed, 331 insertions(+), 137 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ff1820cfaf2..363fe30ee58 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1966,6 +1966,45 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Respect existing multiline input after prompt. Expect any
+ ;; text preceding it on the same line, including whitespace,
+ ;; to be part of the prompt itself.
+ (goto-char (point-max))
+ (forward-line 0)
+ (while (and (not (get-text-property (point) 'erc-prompt))
+ (zerop (forward-line -1))))
+ (cl-assert (not (= (point) (point-min))))
+ (set-marker erc-insert-marker (point))
+ ;; If the input area is clean, this search should fail and
+ ;; return point max. Otherwise, it should return the position
+ ;; after the last char with the `erc-prompt' property, as per
+ ;; the doc string for `next-single-property-change'.
+ (set-marker erc-input-marker
+ (next-single-property-change (point) 'erc-prompt nil
+ (point-max)))
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -1999,10 +2038,12 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2020,21 +2061,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2081,20 +2107,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 1318207a3bf..d6dbd87c8cc 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -82,105 +82,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..c5a40d9bc72 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 5571 bytes --]
From e8876b407a4dffa0e7467856e7256506b60411b6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers
TODO: mention adjustment in ERC-NEWS for 5.6.
* lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text
property, which has been around since 2002, with more useful
`erc-message' property.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
(erc-put-text-property, erc-list): Alias these to built-in functions.
(erc--own-property-names, erc--remove-text-properties) Add internal
variable and helper function for filtering values returned by
`filter-buffer-substring-function'.
(erc-restore-text-properties): Don't forget tags when restoring.
(erc--get-eq-comparable-cmd): New function to extract commands for use
as easily searchable text-property values. (Bug#60936.)
---
lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 43 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 363fe30ee58..6b3d0b4af2f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2880,7 +2880,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-message
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4258,6 +4260,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4309,7 +4335,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -5681,7 +5707,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5691,14 +5717,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7292,10 +7313,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7315,6 +7337,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 12989 bytes --]
From fcc63e5d4ff4c5d3db48e15caee8b11680da9748 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:10:20 -0800
Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
`erc-timestamp' to store lisp time object formerly ensconced in a
closure. Instead of creating a new lambda for the cursor-sensor
function of each message in a buffer, leave a gap between messages to
trip the sensor function. The motivation behind this change is to
allow third parties access to valuable timestamp data already stored
by ERC anyway. Of secondary importance is discouraging the reliance
on those lambdas as a means of detecting message bounds. The gap now
serves a similar purpose. Basically, the final character in a
message, a newline, will not have a timestamp or a sensor function.
When the stamps module isn't loaded, the `erc-message' property can be
used instead. Also, instead of looking for the `invisible' text
property at point, which is normally `point-max' and thus outside the
accessible portion of the buffer, look at the beginning of the
inserted message. This allows hook members running before this
function to opt out of timestamps by marking a message as invisible.
(erc-echo-timestamp): Make interactive and show timestamps even when
the variable `erc-echo-timestamps' is nil.
(erc--echo-ts-csf): Add new function to serve as value of
cursor-sensor function text properties.
* test/lisp/erc/erc-stamp-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 14 ++-
test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++
2 files changed, 216 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..08cdc1c8518 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -162,7 +162,7 @@ erc-add-timestamp
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
+ (unless (get-text-property (point-min) 'invisible)
(let ((ct (current-time)))
(if (fboundp erc-insert-timestamp-function)
(funcall erc-insert-timestamp-function
@@ -174,12 +174,12 @@ erc-add-timestamp
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -400,11 +400,15 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..935b9e650b3
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,207 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") " [") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;; This concerns a proposed partial reversal of the changes resulting
+;; from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also a lasting commitment. The docs mention that it's
+;; pointless to pair the old `intangible' property with `invisible'
+;; and suggest users look at `cursor-intangible-mode'. Turning off
+;; the latter does indeed do the trick as does decrementing the end of
+;; the `cursor-intangible' interval so that, in addition to C-n
+;; working, a C-f from before the timestamp doesn't overshoot. This
+;; appears to be the case whether `erc-hide-timestamps' is enabled or
+;; not, but it may be inadvisable for some reason (a hack) and
+;; therefore warrants further investigation.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;;; erc-stamp-tests.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 4451 bytes --]
From 454023b0aaf43a68adc2709e57b1d647d5a96374 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber
TODO: update ERC-NEWS announcing deprecation.
* lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option
and change meaning of its nil value to fall through to
`erc-timestamp-format'. Do this to allow modules to predict what the
right-hand stamp's final width will be. This also saves
`erc-insert-timestamp-left-and-right' from calling
`erc-format-timestamp' again for no reason.
(erc-stamp--current-time): Add new generic function and method to
return current time. Default to calling `current-time'.
(erc-stamp--current-time): New internal variable to hold time value
used to construct time formatted stamp passed to
`erc-insert-timestamp-function'.
(erc-add-timestamp): Bind `erc-stamp--current-time' when calling
`erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Use STRING parameter and favor
it over the now deprecated `erc-timestamp-format-right' to avoid
formatting twice. Also extract current time from the variable
`erc-stamp--current-time' for similar reasons. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 36 +++++++++++++++++++++++++++++-------
1 file changed, 29 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 08cdc1c8518..b9ad61aaf3e 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,17 +165,31 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
(unless (get-text-property (point-min) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch --]
[-- Type: text/x-patch, Size: 16095 bytes --]
From 98ad3c2a93d59b9d3d0258a0a4c5b268bfcae409 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-side
stamps. Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 154 +++++++++++++++++++++++++++----
test/lisp/erc/erc-stamp-tests.el | 70 ++++++++++++--
2 files changed, 200 insertions(+), 24 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index b9ad61aaf3e..d1c2f790bc8 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,107 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
-A side effect of enabling this is that there will only be one
-space before a right timestamp in any saved logs."
- :type 'boolean)
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
+Enabling this option produces a side effect in that stamps aren't
+indented in saved logs. When its value is an integer, this
+option adds a space after the end of a message if the stamp
+doesn't already start with one. And when its value is t, it adds
+a single space, unconditionally. And while this option never
+adds a space when its value is `margin', ERC does offer a
+workaround in `erc-stamp-prefix-log-filter', which strips
+trailing stamps from messages and puts them before every line."
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.5")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
+(defun erc-stamp-prefix-log-filter (text)
+ "Prefix every message in the buffer with a stamp.
+Remove trailing stamps as well. For now, hard code the format to
+\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
+`erc-log-filter-function' when `erc-timestamp-use-align-to' is
+non-nil."
+ (insert text)
+ (goto-char (point-min))
+ (while
+ (progn
+ (when-let* (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
+ (delete-region beg (1+ end)))
+ (when-let (time (get-text-property (point) 'erc-timestamp))
+ (insert (format-time-string "[%H:%M:%S] " time)))
+ (zerop (forward-line))))
+ "")
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (progn
+ (erc-stamp--adjust-right-margin 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins left-margin-width nil)
+ (set-window-fringes left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +358,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -275,6 +369,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -326,25 +422,47 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 935b9e650b3..01e71e348e0 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") " [") nil t))
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-stamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo[" nil t))
+ ;; Field starts at format string (right bracket)
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2458 bytes --]
From c99c11e05bd8c1b7b4fa8e7db1943d02473b4308 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match
data. (Bug#60936.)
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch --]
[-- Type: text/x-patch, Size: 3195 bytes --]
From e713cb5d0def830da82921964a69e2a90a6dc810 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 05:34:56 -0800
Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec
* lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange
for possibly adding or removing `erc-match' from
`buffer-invisibility-spec'.
(erc-match--hide-fools-offset-bounds): Add new variable to serve as
switch for activating invisibility on a modified interval that's
offset toward `point-min' by one character.
(erc-hide-fools): Optionally offset start and end of invisible region
by minus one.
(erc-match--modify-invisibility-spec): New housekeeping function to
set up and tear down offset spec. (Bug#60936.)
---
lisp/erc/erc-match.el | 31 +++++++++++++++++++++++++------
1 file changed, 25 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 499bcaf5724..87272f0b647 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer
(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
+
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +675,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #10: 0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 29749 bytes --]
From c514a426bef91674fc726816ff415183f4d1da0c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-compat.el (erc-compat--29-set-transient-map-timer,
erc-compat--29-set-transient-map, erc-compat--set-transient-map):
Backport `set-transient-map' definition from Emacs 29.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill--wrap-value, erc-fill--wrap-movement): New variables to
support new local module.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): New
local module.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-compat.el | 56 +++++++
lisp/erc/erc-fill.el | 273 ++++++++++++++++++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 278 ++++++++++++++++++++++++++++++++
3 files changed, 602 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 5601ede27a5..a4367fe4ba5 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,62 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+(defvar erc-compat--29-set-transient-map-timer nil)
+
+(defun erc-compat--29-set-transient-map
+ (map &optional keep-pred on-exit message timeout)
+ (let* ((message
+ (when message
+ (let (keys)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+ (format-spec
+ (if (stringp message) message "Repeat with %k")
+ `((?k . ,(mapconcat
+ (lambda (key)
+ (substitute-command-keys
+ (format "\\`%s'" (key-description (vector key)))))
+ keys ", ")))))))
+ (clearfun (make-symbol "clear-transient-map"))
+ (exitfun (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when message (message ""))
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (when on-exit (funcall on-exit)))))
+ (fset clearfun
+ (lambda ()
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (if (cond
+ ((null keep-pred) nil)
+ ((and (not (eq map (cadr overriding-terminal-local-map)))
+ (memq map (cddr overriding-terminal-local-map)))
+ t)
+ ((eq t keep-pred)
+ (let ((mc (lookup-key map (this-command-keys-vector))))
+ (when (and mc (symbolp mc))
+ (setq mc (or (command-remapping mc) mc)))
+ (and mc (eq this-command mc))))
+ (t (funcall keep-pred)))
+ (when message (message "%s" message))
+ (funcall exitfun)))))
+ (add-hook 'pre-command-hook clearfun)
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ (when timeout
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (setq erc-compat--29-set-transient-map-timer
+ (run-with-idle-timer timeout nil exitfun)))
+ (when message (message "%s" message))
+ exitfun))
+
+(defmacro erc-compat--set-transient-map (&rest args)
+ (cons (if (>= emacs-major-version 29)
+ 'set-transient-map
+ 'erc-compat--29-set-transient-map)
+ args))
+
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..ba538a7c152 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,29 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+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'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,253 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.5") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall (pcase erc-fill--wrap-visual-keys
+ ('non-input
+ (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+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'. You can also manually
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
+ ((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.
+ (concat "Enabling default global module `fill' needed by local"
+ " module `fill-wrap'. This will impact \C-]all\C-] ERC"
+ " sessions. Add `fill' to `erc-modules' to avoid this"
+ " warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; 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)))
+ (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))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the Info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- erc-fill--wrap-value ,len))
+ (space :width erc-fill--wrap-value))))))
+
+;; 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)))
+ (cl-incf erc-fill--wrap-value arg)
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.
+
+ \\`+', \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`C-+', \\`C-=' Shift right margin rightward (shrink it)
+ by one column
+ \\`C--' Shift right margin leftward (grow it) by one
+ column
+ \\`C-0' 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."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
+ (when (zerop arg)
+ (setq arg 1))
+ (erc-compat--set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (recenter (round (* win-ratio (window-height))))))
+ (define-key map (vector (list 'control key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
+ map)
+ t
+ (lambda ()
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (recenter (round (* win-ratio (window-height))))))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..8e8d585617a
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,278 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; FIXME these fixtures (and tests) are now largely useless. Due to
+;; the author's ignorance regarding display properties, the "space"
+;; specs of prefix props on different lines didn't initially leverage
+;; a common variable (`erc-fill--wrap-value'), so the column twiddling
+;; was more laborious. See decades-old comment above
+;; calc_pixel_width_or_height in in xdisp.c for examples.
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (setq msg "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.")
+ (erc-display-message nil 'notice (current-buffer) msg)
+
+ (setq msg "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.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t)))
+
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (let ((original-window-buffer (window-buffer (selected-window))))
+ (set-window-buffer (selected-window) (current-buffer))
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (kill-buffer)))))))
+
+(defun erc-fill-tests--wrap-check-props (speaker)
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (should (search-forward speaker nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- erc-fill--wrap-value (,w))))
+ (= w (string-pixel-width speaker)))
+ (`(space :width (- erc-fill--wrap-value ,w))
+ (= w (length speaker))))))
+
+(defun erc-fill-tests--wrap-check-prefixes ()
+ (save-excursion
+ (goto-char (point-min))
+ (erc-fill-tests--wrap-check-props "*** ")
+ (erc-fill-tests--wrap-check-props "<alice> ")
+ ;; Ensure the loop is not visited twice due to the gap.
+ (erc-fill-tests--wrap-check-props "<bob> ")))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+
+ (ert-info ("Shift right by one (plus)")
+ (ert-with-message-capture messages
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
+ (should (string-match (rx "for further adjustment") messages)))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes))
+
+ (ert-info ("Shift left by five")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes))
+
+ (ert-info ("Reset")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (fboundp 'string-pixel-width)
+ (not noninteractive)
+ (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge 2)
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge -6)
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge 0)
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+
+ ;; FIXME get rid of this "void variable `erc--results-ewoc'"
+ ;; error, which seems related to operating in a non-default
+ ;; frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--body ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (execute-kbd-macro "\C-e")
+ (should (search-backward "tedious fool" nil t))
+ (should-not (looking-back "done to her\\."))
+ (forward-char)
+ (execute-kbd-macro "\C-e")
+ (should (search-forward "done to her." nil t)))
+
+ (ert-info ("Value: nil")
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (goto-char (point-min))
+ (should (search-forward "in debug mode" nil t))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at (rx "*** ")))
+ (execute-kbd-macro "\C-e")
+ (should (eql ?\] (char-before (point)))))
+
+ (ert-info ("Value: t")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (should (search-backward "tedious fool" nil t))
+ (execute-kbd-macro "\C-e")
+ (should-not (looking-back (rx "done to her\\.")))
+ (should (search-forward "done to her." nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--prompt ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (goto-char erc-input-marker)
+ (insert "This buffer is for text that is not saved, and for Lisp "
+ "evaluation. To create a file, visit it with C-x C-f and "
+ "enter text in its buffer.")
+
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-e")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: nil") ; same
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (execute-kbd-macro "\C-y")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: non-input")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (execute-kbd-macro "\C-y")
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at "This buffer"))
+ (execute-kbd-macro "\C-p")
+ (should-not (looking-back "its buffer\\."))
+ (should (search-forward "its buffer." nil t))
+ (should (search-backward "ERC> " nil t))
+ (execute-kbd-macro "\C-a")))))
+
+;;; erc-fill-tests.el ends here
--
2.39.1
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (5 preceding siblings ...)
2023-02-07 15:23 ` J.P.
@ 2023-02-19 15:05 ` J.P.
2023-02-20 15:31 ` J.P.
` (18 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-02-19 15:05 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 58 bytes --]
v8. Fix minor-mode teardown in erc-stamp. Improve tests.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v7-v8.diff --]
[-- Type: text/x-patch, Size: 23024 bytes --]
From 1162cf9dc8e1d6f6a99d99c4c49cae949d2d04d3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Feb 2023 22:34:26 -0800
Subject: [PATCH 0/8] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (8):
[5.6] Refactor marker initialization in erc-open
[5.6] Adjust some old text properties in ERC buffers
[5.6] Expose insertion time as text prop in erc-stamp
[5.6] Make some erc-stamp functions more limber
[5.6] Put display properties to better use in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add variant for erc-match invisibility spec
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-compat.el | 57 +++
lisp/erc/erc-fill.el | 307 +++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 210 ++++++++++--
lisp/erc/erc.el | 136 +++++---
test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 265 ++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
14 files changed, 1506 insertions(+), 217 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
Interdiff:
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index a4367fe4ba5..7d635e5b1af 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,7 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; FIXME remove these after bumping Compat version to 29
(defvar erc-compat--29-set-transient-map-timer nil)
(defun erc-compat--29-set-transient-map
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index ba538a7c152..032206b514a 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -179,7 +179,7 @@ erc-fill-wrap-use-pixels
A value of nil means ERC should use columns, which may happen
regardless, depending on the Emacs version. This option only
matters when `erc-fill-wrap-mode' is enabled."
- :package-version '(ERC . "5.5") ; FIXME sync on release
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type 'boolean)
(defcustom erc-fill-wrap-visual-keys 'non-input
@@ -190,7 +190,7 @@ erc-fill-wrap-visual-keys
never do so. A value of `non-input' tells ERC to act like the
value is nil in the input area and t elsewhere. This option only
plays a role when `erc-fill-wrap-mode' is enabled."
- :package-version '(ERC . "5.5") ; FIXME sync on release
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) (const t) (const non-input)))
(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index c8f6e7c195c..a5e9720bad4 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -650,8 +650,6 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
-
(defvar-local erc-match--hide-fools-offset-bounds nil)
(defun erc-hide-fools (match-type _nickuserhost _message)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index d1c2f790bc8..e689caf7b61 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -260,7 +260,7 @@ erc-timestamp-use-align-to
workaround in `erc-stamp-prefix-log-filter', which strips
trailing stamps from messages and puts them before every line."
:type '(choice boolean integer (const margin))
- :package-version '(ERC . "5.5")) ; FIXME sync on release
+ :package-version '(ERC . "5.6")) ; FIXME sync on release
(defcustom erc-stamp-right-margin-width nil
"Width in columns of the right margin.
@@ -268,7 +268,7 @@ erc-stamp-right-margin-width
than the `string-width' of the formatted `erc-timestamp-format'.
This option only matters when `erc-timestamp-use-align-to' is set
to `margin'."
- :package-version '(ERC . "5.5") ; FIXME sync on release
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) integer))
(defun erc-stamp--display-margin-force (orig &rest r)
@@ -315,6 +315,8 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
+(declare-function erc--remove-text-properties "erc" (string))
+
;; If people want to use this directly, we can convert it into
;; a local module.
(define-minor-mode erc-stamp--display-margin-mode
@@ -338,8 +340,8 @@ erc-stamp--display-margin-mode
#'erc-stamp--display-margin-force)
(kill-local-variable 'right-margin-width)
(kill-local-variable 'right-fringe-width)
- (set-window-margins left-margin-width nil)
- (set-window-fringes left-fringe-width nil)))
+ (set-window-margins nil left-margin-width nil)
+ (set-window-fringes nil left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -476,12 +478,13 @@ erc-insert-timestamp-left-and-right
(setq erc-timestamp-last-inserted-right ts-right))))
;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
+(defvar erc-stamp--tz nil)
(defun erc-format-timestamp (time format)
"Return TIME formatted as string according to FORMAT.
Return the empty string if FORMAT is nil."
(if format
- (let ((ts (format-time-string format time)))
+ (let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
@@ -540,6 +543,7 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
+ ;; Could also pass an &optional `zone' arg to `format-time-string'.
(interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
(when (eq 'entered dir)
(when stamp
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 8e8d585617a..a254d5bbc73 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -25,78 +25,87 @@
;; a common variable (`erc-fill--wrap-value'), so the column twiddling
;; was more laborious. See decades-old comment above
;; calc_pixel_width_or_height in in xdisp.c for examples.
+;;
+;; TODO maybe use erts files instead of own snapshots.
;;; Code:
(require 'ert-x)
(require 'erc-fill)
+(defvar erc-fill-tests--buffers nil)
+
(defun erc-fill-tests--wrap-populate (test)
- (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
- (id (erc-networks--id-create 'foonet))
- (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
- (erc-server-users (make-hash-table :test 'equal))
- (erc-fill-function 'erc-fill-wrap)
- (pre-command-hook pre-command-hook)
- (erc-modules '(fill stamp))
- (msg "Hello World")
- (inhibit-message noninteractive)
- erc-insert-post-hook
- extended-command-history
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (when (bound-and-true-p erc-button-mode)
- (push 'erc-button-add-buttons erc-insert-modify-hook))
- (erc-mode)
- (setq erc-server-process proc erc-networks--id id)
- (set-process-query-on-exit-flag erc-server-process nil)
-
- (with-current-buffer (get-buffer-create "#chan")
+ (cl-letf (((symbol-function 'erc-stamp--current-time)
+ (lambda () '(0 1))))
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (erc-stamp--tz t)
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
(erc-mode)
- (erc-munge-invisibility-spec)
- (setq erc-server-process proc
- erc-networks--id id
- erc-channel-users (make-hash-table :test 'equal)
- erc--target (erc--target-from-string "#chan")
- erc-default-recipients (list "#chan"))
- (erc--initialize-markers (point) nil)
-
- (erc-update-channel-member
- "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
-
- (erc-update-channel-member
- "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
-
- (setq msg "This server is in debug mode and is logging all user I/O.\
+ (setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (setq msg "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.")
- (erc-display-message nil 'notice (current-buffer) msg)
+ (erc-display-message nil 'notice (current-buffer) msg)
- (setq msg "bob: come, you are a tedious fool: to the purpose.\
+ (setq msg "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.")
- (erc-display-message nil nil (current-buffer)
- (erc-format-privmessage "alice" msg nil t))
-
- ;; Introduce an artificial gap in properties `line-prefix' and
- ;; `wrap-prefix' and later ensure they're not incremented twice.
- (save-excursion
- (forward-line -1)
- (search-forward "? ")
- (remove-text-properties (1- (point)) (point)
- '(line-prefix t wrap-prefix t)))
-
- (setq msg "alice: Either your unparagoned mistress is dead,\
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t)))
+
+ (setq msg "alice: Either your unparagoned mistress is dead,\
or she's outprized by a trifle.")
- (erc-display-message nil nil (current-buffer)
- (erc-format-privmessage "bob" msg nil t))
-
- (let ((original-window-buffer (window-buffer (selected-window))))
- (set-window-buffer (selected-window) (current-buffer))
- ;; Defend against non-local exits from `ert-skip'
- (unwind-protect
- (funcall test)
- (set-window-buffer (selected-window) original-window-buffer)
- (when noninteractive
- (kill-buffer)))))))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (let ((original-window-buffer (window-buffer (selected-window))))
+ (set-window-buffer (selected-window) (current-buffer))
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (while-let ((buf (pop erc-fill-tests--buffers)))
+ (kill-buffer buf))
+ (kill-buffer))))))))
(defun erc-fill-tests--wrap-check-props (speaker)
;; Prefix props are applied properly and faces are accounted
@@ -127,6 +136,39 @@ erc-fill-tests--wrap-check-prefixes
;; Ensure the loop is not visited twice due to the gap.
(erc-fill-tests--wrap-check-props "<bob> ")))
+;; Set this variable to t to generate new snapshots after carefully
+;; reviewing the output of each.
+(defvar erc-fill-tests--save-p nil)
+
+(defun erc-fill-tests--compare (name)
+ (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)))
+ (expect-file (file-name-with-extension (expand-file-name name dir)
+ "eld"))
+ (erc--own-property-names
+ (seq-difference `(erc-timestamp font-lock-face
+ ,@erc--own-property-names)
+ '(display wrap-prefix line-prefix)
+ #'eq))
+ (print-circle t)
+ (print-escape-newlines t)
+ (print-escape-nonascii t)
+ (got (erc--remove-text-properties
+ (buffer-substring (point-min) erc-insert-marker)))
+ (repr (string-replace "erc-fill--wrap-value"
+ (number-to-string erc-fill--wrap-value)
+ (prin1-to-string got))))
+ (with-current-buffer (generate-new-buffer name)
+ (push name erc-fill-tests--buffers)
+ (with-silent-modifications
+ (insert (setq got (read repr))))
+ (erc-mode))
+ (if erc-fill-tests--save-p
+ (with-temp-file expect-file
+ (insert repr))
+ (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (should (equal got (read (current-buffer))))))))
+
(ert-deftest erc-fill-wrap--monospace ()
:tags '(:unstable)
@@ -136,23 +178,27 @@ erc-fill-wrap--monospace
(set-window-buffer (selected-window) (current-buffer))
(should (= erc-fill--wrap-value 27))
(erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-01-start")
(ert-info ("Shift right by one (plus)")
(ert-with-message-capture messages
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
(should (string-match (rx "for further adjustment") messages)))
(should (= erc-fill--wrap-value 29))
- (erc-fill-tests--wrap-check-prefixes))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-02-right"))
(ert-info ("Shift left by five")
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
(should (= erc-fill--wrap-value 25))
- (erc-fill-tests--wrap-check-prefixes))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-03-left"))
(ert-info ("Reset")
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
(should (= erc-fill--wrap-value 27))
- (erc-fill-tests--wrap-check-prefixes)))))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-04-reset")))))
(ert-deftest erc-fill-wrap--variable-pitch ()
:tags '(:unstable)
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.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<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" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
new file mode 100644
index 00000000000..3f5f344cc64
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.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<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" 21 183 (wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 29 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 29 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
new file mode 100644
index 00000000000..3b215936c39
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.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<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" 21 183 (wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 25 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 25 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.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<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" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24887 bytes --]
From 29e533b873d1f061099562944122a31542572470 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Jan 2023 20:48:24 -0800
Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open
* lisp/erc/erc.el (erc--initialize-markers): New helper to ensure
prompt and its associated markers are set up correctly.
(erc-open): When determining whether a session is a logical
continuation, leverage the work already performed by the
`erc-networks' library to that effect. Its verdicts are based on
network context and thus reliable even when a user dials anew from an
entry-point, which is not a simple reconnection because the user
expects a clean slate for everything except an existing buffer's
messages, meaning `erc--server-reconnecting' will be nil and
local-module state variables need resetting. Also remove the check
for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create'
always does the right thing in. Replace all code involving marker and
prompt setup by deferring to a new helper, `erc--initialize markers'.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): New test.
* test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file.
* test/lisp/erc/erc-scenarios-base-local-modules.el
(erc-scenarios-base-local-modules--mode-persistence): Move test to
separate file to help with parallel "-j" runs. (Bug#60936.)
---
lisp/erc/erc.el | 79 ++++---
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 --------
test/lisp/erc/erc-tests.el | 79 ++++++-
4 files changed, 331 insertions(+), 137 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index d35907a1677..8261801ec0d 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1966,6 +1966,45 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Respect existing multiline input after prompt. Expect any
+ ;; text preceding it on the same line, including whitespace,
+ ;; to be part of the prompt itself.
+ (goto-char (point-max))
+ (forward-line 0)
+ (while (and (not (get-text-property (point) 'erc-prompt))
+ (zerop (forward-line -1))))
+ (cl-assert (not (= (point) (point-min))))
+ (set-marker erc-insert-marker (point))
+ ;; If the input area is clean, this search should fail and
+ ;; return point max. Otherwise, it should return the position
+ ;; after the last char with the `erc-prompt' property, as per
+ ;; the doc string for `next-single-property-change'.
+ (set-marker erc-input-marker
+ (next-single-property-change (point) 'erc-prompt nil
+ (point-max)))
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -1999,10 +2038,12 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2020,21 +2061,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2081,20 +2107,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 1318207a3bf..d6dbd87c8cc 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -82,105 +82,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..c5a40d9bc72 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 5571 bytes --]
From 8d61af8380bb1589d50434bcddaae14039139dd9 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers
TODO: mention adjustment in ERC-NEWS for 5.6.
* lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text
property, which has been around since 2002, with more useful
`erc-message' property.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
(erc-put-text-property, erc-list): Alias these to built-in functions.
(erc--own-property-names, erc--remove-text-properties) Add internal
variable and helper function for filtering values returned by
`filter-buffer-substring-function'.
(erc-restore-text-properties): Don't forget tags when restoring.
(erc--get-eq-comparable-cmd): New function to extract commands for use
as easily searchable text-property values. (Bug#60936.)
---
lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 43 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8261801ec0d..95d374b121e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2880,7 +2880,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-message
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4258,6 +4260,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4309,7 +4335,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -5681,7 +5707,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5691,14 +5717,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7292,10 +7313,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7315,6 +7337,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 13060 bytes --]
From d42790326b1ae2c3340113ff979dea309df5097f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:10:20 -0800
Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
`erc-timestamp' to store lisp time object formerly ensconced in a
closure. Instead of creating a new lambda for the cursor-sensor
function of each message in a buffer, leave a gap between messages to
trip the sensor function. The motivation behind this change is to
allow third parties access to valuable timestamp data already stored
by ERC anyway. Of secondary importance is discouraging the reliance
on those lambdas as a means of detecting message bounds. The gap now
serves a similar purpose. Basically, the final character in a
message, a newline, will not have a timestamp or a sensor function.
When the stamps module isn't loaded, the `erc-message' property can be
used instead. Also, instead of looking for the `invisible' text
property at point, which is normally `point-max' and thus outside the
accessible portion of the buffer, look at the beginning of the
inserted message. This allows hook members running before this
function to opt out of timestamps by marking a message as invisible.
(erc-echo-timestamp): Make interactive and show timestamps even when
the variable `erc-echo-timestamps' is nil.
(erc--echo-ts-csf): Add new function to serve as value of
cursor-sensor function text properties.
* test/lisp/erc/erc-stamp-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 15 ++-
test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++
2 files changed, 217 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..051d0702f06 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -162,7 +162,7 @@ erc-add-timestamp
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
+ (unless (get-text-property (point-min) 'invisible)
(let ((ct (current-time)))
(if (fboundp erc-insert-timestamp-function)
(funcall erc-insert-timestamp-function
@@ -174,12 +174,12 @@ erc-add-timestamp
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -400,11 +400,16 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ ;; Could also pass an &optional `zone' arg to `format-time-string'.
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..935b9e650b3
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,207 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") " [") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;; This concerns a proposed partial reversal of the changes resulting
+;; from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also a lasting commitment. The docs mention that it's
+;; pointless to pair the old `intangible' property with `invisible'
+;; and suggest users look at `cursor-intangible-mode'. Turning off
+;; the latter does indeed do the trick as does decrementing the end of
+;; the `cursor-intangible' interval so that, in addition to C-n
+;; working, a C-f from before the timestamp doesn't overshoot. This
+;; appears to be the case whether `erc-hide-timestamps' is enabled or
+;; not, but it may be inadvisable for some reason (a hack) and
+;; therefore warrants further investigation.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;;; erc-stamp-tests.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 5221 bytes --]
From 890945775a3b0aeb060a66d33590e6b85a25adb7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber
TODO: update ERC-NEWS announcing deprecation.
* lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option
and change meaning of its nil value to fall through to
`erc-timestamp-format'. Do this to allow modules to predict what the
right-hand stamp's final width will be. This also saves
`erc-insert-timestamp-left-and-right' from calling
`erc-format-timestamp' again for no reason.
(erc-stamp--current-time): Add new generic function and method to
return current time. Default to calling `current-time'.
(erc-stamp--current-time): New internal variable to hold time value
used to construct time formatted stamp passed to
`erc-insert-timestamp-function'.
(erc-add-timestamp): Bind `erc-stamp--current-time' when calling
`erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Use STRING parameter and favor
it over the now deprecated `erc-timestamp-format-right' to avoid
formatting twice. Also extract current time from the variable
`erc-stamp--current-time' for similar reasons. (Bug#60936.)
(erc-stamp--tz): New internal variable.
(erc-format-timestamp): Pass `erc-stamp--tz' as time-zone to
`format-time-string'.
---
lisp/erc/erc-stamp.el | 39 +++++++++++++++++++++++++++++++--------
1 file changed, 31 insertions(+), 8 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 051d0702f06..736aa498803 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,17 +165,31 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
(unless (get-text-property (point-min) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
@@ -336,12 +358,13 @@ erc-insert-timestamp-left-and-right
(setq erc-timestamp-last-inserted-right ts-right))))
;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
+(defvar erc-stamp--tz nil)
(defun erc-format-timestamp (time format)
"Return TIME formatted as string according to FORMAT.
Return the empty string if FORMAT is nil."
(if format
- (let ((ts (format-time-string format time)))
+ (let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch --]
[-- Type: text/x-patch, Size: 16168 bytes --]
From f3f15873c9e9c0ae90b34becf3f2db23ed11f8aa Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-side
stamps. Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 156 +++++++++++++++++++++++++++----
test/lisp/erc/erc-stamp-tests.el | 70 ++++++++++++--
2 files changed, 202 insertions(+), 24 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 736aa498803..e689caf7b61 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,109 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
-A side effect of enabling this is that there will only be one
-space before a right timestamp in any saved logs."
- :type 'boolean)
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
+Enabling this option produces a side effect in that stamps aren't
+indented in saved logs. When its value is an integer, this
+option adds a space after the end of a message if the stamp
+doesn't already start with one. And when its value is t, it adds
+a single space, unconditionally. And while this option never
+adds a space when its value is `margin', ERC does offer a
+workaround in `erc-stamp-prefix-log-filter', which strips
+trailing stamps from messages and puts them before every line."
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.6")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
+(defun erc-stamp-prefix-log-filter (text)
+ "Prefix every message in the buffer with a stamp.
+Remove trailing stamps as well. For now, hard code the format to
+\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
+`erc-log-filter-function' when `erc-timestamp-use-align-to' is
+non-nil."
+ (insert text)
+ (goto-char (point-min))
+ (while
+ (progn
+ (when-let* (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
+ (delete-region beg (1+ end)))
+ (when-let (time (get-text-property (point) 'erc-timestamp))
+ (insert (format-time-string "[%H:%M:%S] " time)))
+ (zerop (forward-line))))
+ "")
+
+(declare-function erc--remove-text-properties "erc" (string))
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (progn
+ (erc-stamp--adjust-right-margin 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins nil left-margin-width nil)
+ (set-window-fringes nil left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +360,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -275,6 +371,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -326,25 +424,47 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 935b9e650b3..01e71e348e0 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") " [") nil t))
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-stamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo[" nil t))
+ ;; Field starts at format string (right bracket)
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2458 bytes --]
From 5f414800a7f16d990bf2531f9a2dd97fd5c3ff07 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match
data. (Bug#60936.)
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch --]
[-- Type: text/x-patch, Size: 3272 bytes --]
From 89ad86dfc004f855344745fccd857edfd70f14cf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 05:34:56 -0800
Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec
* lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange
for possibly adding or removing `erc-match' from
`buffer-invisibility-spec'.
(erc-match--hide-fools-offset-bounds): Add new variable to serve as
switch for activating invisibility on a modified interval that's
offset toward `point-min' by one character.
(erc-hide-fools): Optionally offset start and end of invisible region
by minus one.
(erc-match--modify-invisibility-spec): New housekeeping function to
set up and tear down offset spec. (Bug#60936.)
---
lisp/erc/erc-match.el | 31 ++++++++++++++++++++++++-------
1 file changed, 24 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 52ee5c855f3..a5e9720bad4 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -647,15 +650,22 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +673,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #10: 0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 39308 bytes --]
From 1162cf9dc8e1d6f6a99d99c4c49cae949d2d04d3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-compat.el (erc-compat--29-set-transient-map-timer,
erc-compat--29-set-transient-map, erc-compat--set-transient-map):
Backport `set-transient-map' definition from Emacs 29.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill--wrap-value, erc-fill--wrap-movement): New variables to
support new local module.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): New
local module.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-compat.el | 57 +++
lisp/erc/erc-fill.el | 273 ++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
7 files changed, 653 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 5601ede27a5..7d635e5b1af 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,63 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; FIXME remove these after bumping Compat version to 29
+(defvar erc-compat--29-set-transient-map-timer nil)
+
+(defun erc-compat--29-set-transient-map
+ (map &optional keep-pred on-exit message timeout)
+ (let* ((message
+ (when message
+ (let (keys)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+ (format-spec
+ (if (stringp message) message "Repeat with %k")
+ `((?k . ,(mapconcat
+ (lambda (key)
+ (substitute-command-keys
+ (format "\\`%s'" (key-description (vector key)))))
+ keys ", ")))))))
+ (clearfun (make-symbol "clear-transient-map"))
+ (exitfun (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when message (message ""))
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (when on-exit (funcall on-exit)))))
+ (fset clearfun
+ (lambda ()
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (if (cond
+ ((null keep-pred) nil)
+ ((and (not (eq map (cadr overriding-terminal-local-map)))
+ (memq map (cddr overriding-terminal-local-map)))
+ t)
+ ((eq t keep-pred)
+ (let ((mc (lookup-key map (this-command-keys-vector))))
+ (when (and mc (symbolp mc))
+ (setq mc (or (command-remapping mc) mc)))
+ (and mc (eq this-command mc))))
+ (t (funcall keep-pred)))
+ (when message (message "%s" message))
+ (funcall exitfun)))))
+ (add-hook 'pre-command-hook clearfun)
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ (when timeout
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (setq erc-compat--29-set-transient-map-timer
+ (run-with-idle-timer timeout nil exitfun)))
+ (when message (message "%s" message))
+ exitfun))
+
+(defmacro erc-compat--set-transient-map (&rest args)
+ (cons (if (>= emacs-major-version 29)
+ 'set-transient-map
+ 'erc-compat--29-set-transient-map)
+ args))
+
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..032206b514a 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,29 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+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'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,253 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall (pcase erc-fill--wrap-visual-keys
+ ('non-input
+ (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+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'. You can also manually
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
+ ((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.
+ (concat "Enabling default global module `fill' needed by local"
+ " module `fill-wrap'. This will impact \C-]all\C-] ERC"
+ " sessions. Add `fill' to `erc-modules' to avoid this"
+ " warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; 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)))
+ (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))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the Info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- erc-fill--wrap-value ,len))
+ (space :width erc-fill--wrap-value))))))
+
+;; 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)))
+ (cl-incf erc-fill--wrap-value arg)
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.
+
+ \\`+', \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`C-+', \\`C-=' Shift right margin rightward (shrink it)
+ by one column
+ \\`C--' Shift right margin leftward (grow it) by one
+ column
+ \\`C-0' 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."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
+ (when (zerop arg)
+ (setq arg 1))
+ (erc-compat--set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (recenter (round (* win-ratio (window-height))))))
+ (define-key map (vector (list 'control key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
+ map)
+ t
+ (lambda ()
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (recenter (round (* win-ratio (window-height))))))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..a254d5bbc73
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,324 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; FIXME these fixtures (and tests) are now largely useless. Due to
+;; the author's ignorance regarding display properties, the "space"
+;; specs of prefix props on different lines didn't initially leverage
+;; a common variable (`erc-fill--wrap-value'), so the column twiddling
+;; was more laborious. See decades-old comment above
+;; calc_pixel_width_or_height in in xdisp.c for examples.
+;;
+;; TODO maybe use erts files instead of own snapshots.
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defvar erc-fill-tests--buffers nil)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (cl-letf (((symbol-function 'erc-stamp--current-time)
+ (lambda () '(0 1))))
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (erc-stamp--tz t)
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (setq msg "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.")
+ (erc-display-message nil 'notice (current-buffer) msg)
+
+ (setq msg "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.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t)))
+
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (let ((original-window-buffer (window-buffer (selected-window))))
+ (set-window-buffer (selected-window) (current-buffer))
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (while-let ((buf (pop erc-fill-tests--buffers)))
+ (kill-buffer buf))
+ (kill-buffer))))))))
+
+(defun erc-fill-tests--wrap-check-props (speaker)
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (should (search-forward speaker nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- erc-fill--wrap-value (,w))))
+ (= w (string-pixel-width speaker)))
+ (`(space :width (- erc-fill--wrap-value ,w))
+ (= w (length speaker))))))
+
+(defun erc-fill-tests--wrap-check-prefixes ()
+ (save-excursion
+ (goto-char (point-min))
+ (erc-fill-tests--wrap-check-props "*** ")
+ (erc-fill-tests--wrap-check-props "<alice> ")
+ ;; Ensure the loop is not visited twice due to the gap.
+ (erc-fill-tests--wrap-check-props "<bob> ")))
+
+;; Set this variable to t to generate new snapshots after carefully
+;; reviewing the output of each.
+(defvar erc-fill-tests--save-p nil)
+
+(defun erc-fill-tests--compare (name)
+ (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)))
+ (expect-file (file-name-with-extension (expand-file-name name dir)
+ "eld"))
+ (erc--own-property-names
+ (seq-difference `(erc-timestamp font-lock-face
+ ,@erc--own-property-names)
+ '(display wrap-prefix line-prefix)
+ #'eq))
+ (print-circle t)
+ (print-escape-newlines t)
+ (print-escape-nonascii t)
+ (got (erc--remove-text-properties
+ (buffer-substring (point-min) erc-insert-marker)))
+ (repr (string-replace "erc-fill--wrap-value"
+ (number-to-string erc-fill--wrap-value)
+ (prin1-to-string got))))
+ (with-current-buffer (generate-new-buffer name)
+ (push name erc-fill-tests--buffers)
+ (with-silent-modifications
+ (insert (setq got (read repr))))
+ (erc-mode))
+ (if erc-fill-tests--save-p
+ (with-temp-file expect-file
+ (insert repr))
+ (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (should (equal got (read (current-buffer))))))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-01-start")
+
+ (ert-info ("Shift right by one (plus)")
+ (ert-with-message-capture messages
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
+ (should (string-match (rx "for further adjustment") messages)))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-02-right"))
+
+ (ert-info ("Shift left by five")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-03-left"))
+
+ (ert-info ("Reset")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-04-reset")))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (fboundp 'string-pixel-width)
+ (not noninteractive)
+ (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge 2)
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge -6)
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge 0)
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+
+ ;; FIXME get rid of this "void variable `erc--results-ewoc'"
+ ;; error, which seems related to operating in a non-default
+ ;; frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--body ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (execute-kbd-macro "\C-e")
+ (should (search-backward "tedious fool" nil t))
+ (should-not (looking-back "done to her\\."))
+ (forward-char)
+ (execute-kbd-macro "\C-e")
+ (should (search-forward "done to her." nil t)))
+
+ (ert-info ("Value: nil")
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (goto-char (point-min))
+ (should (search-forward "in debug mode" nil t))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at (rx "*** ")))
+ (execute-kbd-macro "\C-e")
+ (should (eql ?\] (char-before (point)))))
+
+ (ert-info ("Value: t")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (should (search-backward "tedious fool" nil t))
+ (execute-kbd-macro "\C-e")
+ (should-not (looking-back (rx "done to her\\.")))
+ (should (search-forward "done to her." nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--prompt ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (goto-char erc-input-marker)
+ (insert "This buffer is for text that is not saved, and for Lisp "
+ "evaluation. To create a file, visit it with C-x C-f and "
+ "enter text in its buffer.")
+
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-e")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: nil") ; same
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (execute-kbd-macro "\C-y")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: non-input")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (execute-kbd-macro "\C-y")
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at "This buffer"))
+ (execute-kbd-macro "\C-p")
+ (should-not (looking-back "its buffer\\."))
+ (should (search-forward "its buffer." nil t))
+ (should (search-backward "ERC> " nil t))
+ (execute-kbd-macro "\C-a")))))
+
+;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.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<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" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
new file mode 100644
index 00000000000..3f5f344cc64
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.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<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" 21 183 (wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 29 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 29 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
new file mode 100644
index 00000000000..3b215936c39
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.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<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" 21 183 (wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 25 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 25 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.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<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" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
--
2.39.1
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (6 preceding siblings ...)
2023-02-19 15:05 ` J.P.
@ 2023-02-20 15:31 ` J.P.
2023-03-09 14:42 ` J.P.
` (17 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-02-20 15:31 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 54 bytes --]
v9. Trust previous values when initializing markers.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v8-v9.diff --]
[-- Type: text/x-patch, Size: 4216 bytes --]
From f2613f703f3e4fa49a0efb3e120b493bb0731c53 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 20 Feb 2023 00:05:34 -0800
Subject: [PATCH 0/8] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (8):
[5.6] Refactor marker initialization in erc-open
[5.6] Adjust some old text properties in ERC buffers
[5.6] Expose insertion time as text prop in erc-stamp
[5.6] Make some erc-stamp functions more limber
[5.6] Put display properties to better use in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add variant for erc-match invisibility spec
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-compat.el | 57 +++
lisp/erc/erc-fill.el | 307 +++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 210 ++++++++++--
lisp/erc/erc.el | 127 ++++---
test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 265 ++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
14 files changed, 1497 insertions(+), 217 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
Interdiff:
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 95d374b121e..b04386c6a3b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1976,22 +1976,12 @@ erc--initialize-markers
erc-input-marker (make-marker))
(if continued-session
(progn
- ;; Respect existing multiline input after prompt. Expect any
- ;; text preceding it on the same line, including whitespace,
- ;; to be part of the prompt itself.
- (goto-char (point-max))
- (forward-line 0)
- (while (and (not (get-text-property (point) 'erc-prompt))
- (zerop (forward-line -1))))
- (cl-assert (not (= (point) (point-min))))
- (set-marker erc-insert-marker (point))
- ;; If the input area is clean, this search should fail and
- ;; return point max. Otherwise, it should return the position
- ;; after the last char with the `erc-prompt' property, as per
- ;; the doc string for `next-single-property-change'.
+ ;; Trust existing markers.
+ (set-marker erc-insert-marker
+ (alist-get 'erc-insert-marker continued-session))
(set-marker erc-input-marker
- (next-single-property-change (point) 'erc-prompt nil
- (point-max)))
+ (alist-get 'erc-input-marker continued-session))
+ (goto-char erc-insert-marker)
(cl-assert (= (field-end) erc-input-marker))
(goto-char old-point)
(erc--unhide-prompt))
@@ -2043,7 +2033,8 @@ erc-open
(and-let* (((not target))
(m (buffer-local-value
'erc-input-marker buffer))
- ((marker-position m)))))))
+ ((marker-position m)))
+ (buffer-local-variables buffer)))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24337 bytes --]
From 342d6959d68015d596ffc12a65bb57bff942d6ec Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Jan 2023 20:48:24 -0800
Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open
* lisp/erc/erc.el (erc--initialize-markers): New helper to ensure
prompt and its associated markers are set up correctly.
(erc-open): When determining whether a session is a logical
continuation, leverage the work already performed by the
`erc-networks' library to that effect. Its verdicts are based on
network context and thus reliable even when a user dials anew from an
entry-point, which is not a simple reconnection because the user
expects a clean slate for everything except an existing buffer's
messages, meaning `erc--server-reconnecting' will be nil and
local-module state variables need resetting. Also remove the check
for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create'
always does the right thing in. Replace all code involving marker and
prompt setup by deferring to a new helper, `erc--initialize markers'.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): New test.
* test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file.
* test/lisp/erc/erc-scenarios-base-local-modules.el
(erc-scenarios-base-local-modules--mode-persistence): Move test to
separate file to help with parallel "-j" runs. (Bug#60936.)
---
lisp/erc/erc.el | 70 +++---
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 --------
test/lisp/erc/erc-tests.el | 79 ++++++-
4 files changed, 322 insertions(+), 137 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index d35907a1677..27e46e6681b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1966,6 +1966,35 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Trust existing markers.
+ (set-marker erc-insert-marker
+ (alist-get 'erc-insert-marker continued-session))
+ (set-marker erc-input-marker
+ (alist-get 'erc-input-marker continued-session))
+ (goto-char erc-insert-marker)
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -1999,10 +2028,13 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))
+ (buffer-local-variables buffer)))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2020,21 +2052,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2081,20 +2098,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 1318207a3bf..d6dbd87c8cc 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -82,105 +82,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..c5a40d9bc72 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 5524 bytes --]
From b38279a2e792015065bbf142a5a57e3539416763 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers
* lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text
property, which has been around since 2002, with more useful
`erc-message' property.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
(erc-put-text-property, erc-list): Alias these to built-in functions.
(erc--own-property-names, erc--remove-text-properties) Add internal
variable and helper function for filtering values returned by
`filter-buffer-substring-function'.
(erc-restore-text-properties): Don't forget tags when restoring.
(erc--get-eq-comparable-cmd): New function to extract commands for use
as easily searchable text-property values. (Bug#60936.)
---
lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 43 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 27e46e6681b..b04386c6a3b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2871,7 +2871,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-message
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4249,6 +4251,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4300,7 +4326,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -5672,7 +5698,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5682,14 +5708,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7283,10 +7304,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7306,6 +7328,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 13060 bytes --]
From 52e83b811bfa55ae1c4b46728e6724ab8573ba04 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:10:20 -0800
Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
`erc-timestamp' to store lisp time object formerly ensconced in a
closure. Instead of creating a new lambda for the cursor-sensor
function of each message in a buffer, leave a gap between messages to
trip the sensor function. The motivation behind this change is to
allow third parties access to valuable timestamp data already stored
by ERC anyway. Of secondary importance is discouraging the reliance
on those lambdas as a means of detecting message bounds. The gap now
serves a similar purpose. Basically, the final character in a
message, a newline, will not have a timestamp or a sensor function.
When the stamps module isn't loaded, the `erc-message' property can be
used instead. Also, instead of looking for the `invisible' text
property at point, which is normally `point-max' and thus outside the
accessible portion of the buffer, look at the beginning of the
inserted message. This allows hook members running before this
function to opt out of timestamps by marking a message as invisible.
(erc-echo-timestamp): Make interactive and show timestamps even when
the variable `erc-echo-timestamps' is nil.
(erc--echo-ts-csf): Add new function to serve as value of
cursor-sensor function text properties.
* test/lisp/erc/erc-stamp-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 15 ++-
test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++
2 files changed, 217 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..051d0702f06 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -162,7 +162,7 @@ erc-add-timestamp
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
+ (unless (get-text-property (point-min) 'invisible)
(let ((ct (current-time)))
(if (fboundp erc-insert-timestamp-function)
(funcall erc-insert-timestamp-function
@@ -174,12 +174,12 @@ erc-add-timestamp
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -400,11 +400,16 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ ;; Could also pass an &optional `zone' arg to `format-time-string'.
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..935b9e650b3
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,207 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") " [") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;; This concerns a proposed partial reversal of the changes resulting
+;; from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also a lasting commitment. The docs mention that it's
+;; pointless to pair the old `intangible' property with `invisible'
+;; and suggest users look at `cursor-intangible-mode'. Turning off
+;; the latter does indeed do the trick as does decrementing the end of
+;; the `cursor-intangible' interval so that, in addition to C-n
+;; working, a C-f from before the timestamp doesn't overshoot. This
+;; appears to be the case whether `erc-hide-timestamps' is enabled or
+;; not, but it may be inadvisable for some reason (a hack) and
+;; therefore warrants further investigation.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;;; erc-stamp-tests.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 5221 bytes --]
From 984bd396d31dbf1652e8230d03886614b6cde1b5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber
TODO: update ERC-NEWS announcing deprecation.
* lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option
and change meaning of its nil value to fall through to
`erc-timestamp-format'. Do this to allow modules to predict what the
right-hand stamp's final width will be. This also saves
`erc-insert-timestamp-left-and-right' from calling
`erc-format-timestamp' again for no reason.
(erc-stamp--current-time): Add new generic function and method to
return current time. Default to calling `current-time'.
(erc-stamp--current-time): New internal variable to hold time value
used to construct time formatted stamp passed to
`erc-insert-timestamp-function'.
(erc-add-timestamp): Bind `erc-stamp--current-time' when calling
`erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Use STRING parameter and favor
it over the now deprecated `erc-timestamp-format-right' to avoid
formatting twice. Also extract current time from the variable
`erc-stamp--current-time' for similar reasons. (Bug#60936.)
(erc-stamp--tz): New internal variable.
(erc-format-timestamp): Pass `erc-stamp--tz' as time-zone to
`format-time-string'.
---
lisp/erc/erc-stamp.el | 39 +++++++++++++++++++++++++++++++--------
1 file changed, 31 insertions(+), 8 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 051d0702f06..736aa498803 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,17 +165,31 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
(unless (get-text-property (point-min) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
@@ -336,12 +358,13 @@ erc-insert-timestamp-left-and-right
(setq erc-timestamp-last-inserted-right ts-right))))
;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
+(defvar erc-stamp--tz nil)
(defun erc-format-timestamp (time format)
"Return TIME formatted as string according to FORMAT.
Return the empty string if FORMAT is nil."
(if format
- (let ((ts (format-time-string format time)))
+ (let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch --]
[-- Type: text/x-patch, Size: 16168 bytes --]
From e68de4d0069a9a12f4884a93678e2e55fed9efbf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-side
stamps. Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 156 +++++++++++++++++++++++++++----
test/lisp/erc/erc-stamp-tests.el | 70 ++++++++++++--
2 files changed, 202 insertions(+), 24 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 736aa498803..e689caf7b61 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,109 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
-A side effect of enabling this is that there will only be one
-space before a right timestamp in any saved logs."
- :type 'boolean)
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
+Enabling this option produces a side effect in that stamps aren't
+indented in saved logs. When its value is an integer, this
+option adds a space after the end of a message if the stamp
+doesn't already start with one. And when its value is t, it adds
+a single space, unconditionally. And while this option never
+adds a space when its value is `margin', ERC does offer a
+workaround in `erc-stamp-prefix-log-filter', which strips
+trailing stamps from messages and puts them before every line."
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.6")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
+(defun erc-stamp-prefix-log-filter (text)
+ "Prefix every message in the buffer with a stamp.
+Remove trailing stamps as well. For now, hard code the format to
+\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
+`erc-log-filter-function' when `erc-timestamp-use-align-to' is
+non-nil."
+ (insert text)
+ (goto-char (point-min))
+ (while
+ (progn
+ (when-let* (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
+ (delete-region beg (1+ end)))
+ (when-let (time (get-text-property (point) 'erc-timestamp))
+ (insert (format-time-string "[%H:%M:%S] " time)))
+ (zerop (forward-line))))
+ "")
+
+(declare-function erc--remove-text-properties "erc" (string))
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (progn
+ (erc-stamp--adjust-right-margin 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins nil left-margin-width nil)
+ (set-window-fringes nil left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +360,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -275,6 +371,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -326,25 +424,47 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 935b9e650b3..01e71e348e0 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") " [") nil t))
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-stamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo[" nil t))
+ ;; Field starts at format string (right bracket)
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2458 bytes --]
From c7bdb4ff5f91e5abeb324b28d0bebade0ed3589d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match
data. (Bug#60936.)
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch --]
[-- Type: text/x-patch, Size: 3272 bytes --]
From 64fa7a93cd5bb249104180a9a6bea93a8fc5d956 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 05:34:56 -0800
Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec
* lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange
for possibly adding or removing `erc-match' from
`buffer-invisibility-spec'.
(erc-match--hide-fools-offset-bounds): Add new variable to serve as
switch for activating invisibility on a modified interval that's
offset toward `point-min' by one character.
(erc-hide-fools): Optionally offset start and end of invisible region
by minus one.
(erc-match--modify-invisibility-spec): New housekeeping function to
set up and tear down offset spec. (Bug#60936.)
---
lisp/erc/erc-match.el | 31 ++++++++++++++++++++++++-------
1 file changed, 24 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 52ee5c855f3..a5e9720bad4 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -647,15 +650,22 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +673,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #10: 0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 39308 bytes --]
From f2613f703f3e4fa49a0efb3e120b493bb0731c53 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-compat.el (erc-compat--29-set-transient-map-timer,
erc-compat--29-set-transient-map, erc-compat--set-transient-map):
Backport `set-transient-map' definition from Emacs 29.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill--wrap-value, erc-fill--wrap-movement): New variables to
support new local module.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): New
local module.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-compat.el | 57 +++
lisp/erc/erc-fill.el | 273 ++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
7 files changed, 653 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 5601ede27a5..7d635e5b1af 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,63 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; FIXME remove these after bumping Compat version to 29
+(defvar erc-compat--29-set-transient-map-timer nil)
+
+(defun erc-compat--29-set-transient-map
+ (map &optional keep-pred on-exit message timeout)
+ (let* ((message
+ (when message
+ (let (keys)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+ (format-spec
+ (if (stringp message) message "Repeat with %k")
+ `((?k . ,(mapconcat
+ (lambda (key)
+ (substitute-command-keys
+ (format "\\`%s'" (key-description (vector key)))))
+ keys ", ")))))))
+ (clearfun (make-symbol "clear-transient-map"))
+ (exitfun (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when message (message ""))
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (when on-exit (funcall on-exit)))))
+ (fset clearfun
+ (lambda ()
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (if (cond
+ ((null keep-pred) nil)
+ ((and (not (eq map (cadr overriding-terminal-local-map)))
+ (memq map (cddr overriding-terminal-local-map)))
+ t)
+ ((eq t keep-pred)
+ (let ((mc (lookup-key map (this-command-keys-vector))))
+ (when (and mc (symbolp mc))
+ (setq mc (or (command-remapping mc) mc)))
+ (and mc (eq this-command mc))))
+ (t (funcall keep-pred)))
+ (when message (message "%s" message))
+ (funcall exitfun)))))
+ (add-hook 'pre-command-hook clearfun)
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ (when timeout
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (setq erc-compat--29-set-transient-map-timer
+ (run-with-idle-timer timeout nil exitfun)))
+ (when message (message "%s" message))
+ exitfun))
+
+(defmacro erc-compat--set-transient-map (&rest args)
+ (cons (if (>= emacs-major-version 29)
+ 'set-transient-map
+ 'erc-compat--29-set-transient-map)
+ args))
+
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..032206b514a 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,29 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+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'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,253 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall (pcase erc-fill--wrap-visual-keys
+ ('non-input
+ (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+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'. You can also manually
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
+ ((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.
+ (concat "Enabling default global module `fill' needed by local"
+ " module `fill-wrap'. This will impact \C-]all\C-] ERC"
+ " sessions. Add `fill' to `erc-modules' to avoid this"
+ " warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; 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)))
+ (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))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the Info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- erc-fill--wrap-value ,len))
+ (space :width erc-fill--wrap-value))))))
+
+;; 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)))
+ (cl-incf erc-fill--wrap-value arg)
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.
+
+ \\`+', \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`C-+', \\`C-=' Shift right margin rightward (shrink it)
+ by one column
+ \\`C--' Shift right margin leftward (grow it) by one
+ column
+ \\`C-0' 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."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
+ (when (zerop arg)
+ (setq arg 1))
+ (erc-compat--set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (recenter (round (* win-ratio (window-height))))))
+ (define-key map (vector (list 'control key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
+ map)
+ t
+ (lambda ()
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (recenter (round (* win-ratio (window-height))))))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..a254d5bbc73
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,324 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; FIXME these fixtures (and tests) are now largely useless. Due to
+;; the author's ignorance regarding display properties, the "space"
+;; specs of prefix props on different lines didn't initially leverage
+;; a common variable (`erc-fill--wrap-value'), so the column twiddling
+;; was more laborious. See decades-old comment above
+;; calc_pixel_width_or_height in in xdisp.c for examples.
+;;
+;; TODO maybe use erts files instead of own snapshots.
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defvar erc-fill-tests--buffers nil)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (cl-letf (((symbol-function 'erc-stamp--current-time)
+ (lambda () '(0 1))))
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (erc-stamp--tz t)
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (setq msg "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.")
+ (erc-display-message nil 'notice (current-buffer) msg)
+
+ (setq msg "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.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t)))
+
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (let ((original-window-buffer (window-buffer (selected-window))))
+ (set-window-buffer (selected-window) (current-buffer))
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (while-let ((buf (pop erc-fill-tests--buffers)))
+ (kill-buffer buf))
+ (kill-buffer))))))))
+
+(defun erc-fill-tests--wrap-check-props (speaker)
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (should (search-forward speaker nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- erc-fill--wrap-value (,w))))
+ (= w (string-pixel-width speaker)))
+ (`(space :width (- erc-fill--wrap-value ,w))
+ (= w (length speaker))))))
+
+(defun erc-fill-tests--wrap-check-prefixes ()
+ (save-excursion
+ (goto-char (point-min))
+ (erc-fill-tests--wrap-check-props "*** ")
+ (erc-fill-tests--wrap-check-props "<alice> ")
+ ;; Ensure the loop is not visited twice due to the gap.
+ (erc-fill-tests--wrap-check-props "<bob> ")))
+
+;; Set this variable to t to generate new snapshots after carefully
+;; reviewing the output of each.
+(defvar erc-fill-tests--save-p nil)
+
+(defun erc-fill-tests--compare (name)
+ (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)))
+ (expect-file (file-name-with-extension (expand-file-name name dir)
+ "eld"))
+ (erc--own-property-names
+ (seq-difference `(erc-timestamp font-lock-face
+ ,@erc--own-property-names)
+ '(display wrap-prefix line-prefix)
+ #'eq))
+ (print-circle t)
+ (print-escape-newlines t)
+ (print-escape-nonascii t)
+ (got (erc--remove-text-properties
+ (buffer-substring (point-min) erc-insert-marker)))
+ (repr (string-replace "erc-fill--wrap-value"
+ (number-to-string erc-fill--wrap-value)
+ (prin1-to-string got))))
+ (with-current-buffer (generate-new-buffer name)
+ (push name erc-fill-tests--buffers)
+ (with-silent-modifications
+ (insert (setq got (read repr))))
+ (erc-mode))
+ (if erc-fill-tests--save-p
+ (with-temp-file expect-file
+ (insert repr))
+ (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (should (equal got (read (current-buffer))))))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-01-start")
+
+ (ert-info ("Shift right by one (plus)")
+ (ert-with-message-capture messages
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
+ (should (string-match (rx "for further adjustment") messages)))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-02-right"))
+
+ (ert-info ("Shift left by five")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-03-left"))
+
+ (ert-info ("Reset")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-04-reset")))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (fboundp 'string-pixel-width)
+ (not noninteractive)
+ (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge 2)
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge -6)
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge 0)
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+
+ ;; FIXME get rid of this "void variable `erc--results-ewoc'"
+ ;; error, which seems related to operating in a non-default
+ ;; frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--body ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (execute-kbd-macro "\C-e")
+ (should (search-backward "tedious fool" nil t))
+ (should-not (looking-back "done to her\\."))
+ (forward-char)
+ (execute-kbd-macro "\C-e")
+ (should (search-forward "done to her." nil t)))
+
+ (ert-info ("Value: nil")
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (goto-char (point-min))
+ (should (search-forward "in debug mode" nil t))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at (rx "*** ")))
+ (execute-kbd-macro "\C-e")
+ (should (eql ?\] (char-before (point)))))
+
+ (ert-info ("Value: t")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (should (search-backward "tedious fool" nil t))
+ (execute-kbd-macro "\C-e")
+ (should-not (looking-back (rx "done to her\\.")))
+ (should (search-forward "done to her." nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--prompt ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (goto-char erc-input-marker)
+ (insert "This buffer is for text that is not saved, and for Lisp "
+ "evaluation. To create a file, visit it with C-x C-f and "
+ "enter text in its buffer.")
+
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-e")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: nil") ; same
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (execute-kbd-macro "\C-y")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: non-input")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (execute-kbd-macro "\C-y")
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at "This buffer"))
+ (execute-kbd-macro "\C-p")
+ (should-not (looking-back "its buffer\\."))
+ (should (search-forward "its buffer." nil t))
+ (should (search-backward "ERC> " nil t))
+ (execute-kbd-macro "\C-a")))))
+
+;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.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<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" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
new file mode 100644
index 00000000000..3f5f344cc64
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.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<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" 21 183 (wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 29 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 29 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
new file mode 100644
index 00000000000..3b215936c39
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.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<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" 21 183 (wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 25 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 25 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.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<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" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
--
2.39.1
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (7 preceding siblings ...)
2023-02-20 15:31 ` J.P.
@ 2023-03-09 14:42 ` J.P.
[not found] ` <87edpykmud.fsf@neverwas.me>
` (16 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-03-09 14:42 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 158 bytes --]
v10. Redo some key bindings. Remove unneeded Compat functions. Rename
`erc-message' text prop to `erc-command'. Revive mistakenly deleted hunk
in erc-match.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v9-v10.diff --]
[-- Type: text/x-patch, Size: 8945 bytes --]
From f87741ad52ffebe378200ffcd74ad75be680d9a2 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 9 Mar 2023 06:25:15 -0800
Subject: [PATCH 0/8] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (8):
[5.6] Refactor marker initialization in erc-open
[5.6] Adjust some old text properties in ERC buffers
[5.6] Expose insertion time as text prop in erc-stamp
[5.6] Make some erc-stamp functions more limber
[5.6] Put display properties to better use in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add variant for erc-match invisibility spec
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-fill.el | 311 +++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 210 ++++++++++--
lisp/erc/erc.el | 127 ++++---
test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 265 ++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
13 files changed, 1445 insertions(+), 216 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
Interdiff:
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 7d635e5b1af..5601ede27a5 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,63 +409,6 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
-;; FIXME remove these after bumping Compat version to 29
-(defvar erc-compat--29-set-transient-map-timer nil)
-
-(defun erc-compat--29-set-transient-map
- (map &optional keep-pred on-exit message timeout)
- (let* ((message
- (when message
- (let (keys)
- (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
- (format-spec
- (if (stringp message) message "Repeat with %k")
- `((?k . ,(mapconcat
- (lambda (key)
- (substitute-command-keys
- (format "\\`%s'" (key-description (vector key)))))
- keys ", ")))))))
- (clearfun (make-symbol "clear-transient-map"))
- (exitfun (lambda ()
- (internal-pop-keymap map 'overriding-terminal-local-map)
- (remove-hook 'pre-command-hook clearfun)
- (when message (message ""))
- (when erc-compat--29-set-transient-map-timer
- (cancel-timer erc-compat--29-set-transient-map-timer))
- (when on-exit (funcall on-exit)))))
- (fset clearfun
- (lambda ()
- (with-demoted-errors "set-transient-map PCH: %S"
- (if (cond
- ((null keep-pred) nil)
- ((and (not (eq map (cadr overriding-terminal-local-map)))
- (memq map (cddr overriding-terminal-local-map)))
- t)
- ((eq t keep-pred)
- (let ((mc (lookup-key map (this-command-keys-vector))))
- (when (and mc (symbolp mc))
- (setq mc (or (command-remapping mc) mc)))
- (and mc (eq this-command mc))))
- (t (funcall keep-pred)))
- (when message (message "%s" message))
- (funcall exitfun)))))
- (add-hook 'pre-command-hook clearfun)
- (internal-push-keymap map 'overriding-terminal-local-map)
- (when timeout
- (when erc-compat--29-set-transient-map-timer
- (cancel-timer erc-compat--29-set-transient-map-timer))
- (setq erc-compat--29-set-transient-map-timer
- (run-with-idle-timer timeout nil exitfun)))
- (when message (message "%s" message))
- exitfun))
-
-(defmacro erc-compat--set-transient-map (&rest args)
- (cons (if (>= emacs-major-version 29)
- 'set-transient-map
- 'erc-compat--29-set-transient-map)
- args))
-
-
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 032206b514a..16791277723 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -369,14 +369,12 @@ erc-fill-wrap-nudge
Offer to repeat command in a manner similar to
`text-scale-adjust'.
- \\`+', \\`=' Increase indentation by one column
- \\`-' Decrease indentation by one column
- \\`0' Reset indentation to the default
- \\`C-+', \\`C-=' Shift right margin rightward (shrink it)
- by one column
- \\`C--' Shift right margin leftward (grow it) by one
- column
- \\`C-0' Reset the right margin to the default
+ \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`+' Shift right margin rightward (shrink) by one column
+ \\`_' Shift right margin leftward (grow) by one column
+ \\`)' Reset the right margin to the default
Note that misalignment may occur when messages contain
decorations applied by third-party modules. See
@@ -392,9 +390,10 @@ erc-fill-wrap-nudge
(- (window-end nil t) (window-start)))))
(when (zerop arg)
(setq arg 1))
- (erc-compat--set-transient-map
+ (erc-compat-call
+ set-transient-map
(let ((map (make-sparse-keymap)))
- (dolist (key '(?+ ?= ?- ?0))
+ (dolist (key '(?= ?- ?0))
(let ((a (pcase key
(?0 0)
(?- (- (abs arg)))
@@ -403,8 +402,13 @@ erc-fill-wrap-nudge
(lambda ()
(interactive)
(cl-incf total (erc-fill--wrap-nudge a))
- (recenter (round (* win-ratio (window-height))))))
- (define-key map (vector (list 'control key))
+ (recenter (round (* win-ratio (window-height))))))))
+ (dolist (key '(?\) ?_ ?+))
+ (let ((a (pcase key
+ (?\) 0)
+ (?_ (- (abs arg)))
+ (?+ (abs arg)))))
+ (define-key map (vector (list key))
(lambda ()
(interactive)
(erc-stamp--adjust-right-margin (- a))
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index a5e9720bad4..c8f6e7c195c 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -650,6 +650,8 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
+(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+
(defvar-local erc-match--hide-fools-offset-bounds nil)
(defun erc-hide-fools (match-type _nickuserhost _message)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f47cca3f109..3d63c927df3 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2873,7 +2873,7 @@ erc-display-message
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
(put-text-property
- 0 (length string) 'erc-message
+ 0 (length string) 'erc-command
(erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index a254d5bbc73..2a0abf5dc32 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -182,7 +182,7 @@ erc-fill-wrap--monospace
(ert-info ("Shift right by one (plus)")
(ert-with-message-capture messages
- (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET ="))
(should (string-match (rx "for further adjustment") messages)))
(should (= erc-fill--wrap-value 29))
(erc-fill-tests--wrap-check-prefixes)
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24337 bytes --]
From c84d3c5e6886722d975978cea93a893220be98c6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Jan 2023 20:48:24 -0800
Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open
* lisp/erc/erc.el (erc--initialize-markers): New helper to ensure
prompt and its associated markers are set up correctly.
(erc-open): When determining whether a session is a logical
continuation, leverage the work already performed by the
`erc-networks' library to that effect. Its verdicts are based on
network context and thus reliable even when a user dials anew from an
entry-point, which is not a simple reconnection because the user
expects a clean slate for everything except an existing buffer's
messages, meaning `erc--server-reconnecting' will be nil and
local-module state variables need resetting. Also remove the check
for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create'
always does the right thing in. Replace all code involving marker and
prompt setup by deferring to a new helper, `erc--initialize markers'.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): New test.
* test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file.
* test/lisp/erc/erc-scenarios-base-local-modules.el
(erc-scenarios-base-local-modules--mode-persistence): Move test to
separate file to help with parallel "-j" runs. (Bug#60936.)
---
lisp/erc/erc.el | 70 +++---
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 --------
test/lisp/erc/erc-tests.el | 79 ++++++-
4 files changed, 322 insertions(+), 137 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 69bdb5d71b1..5a85c5ad396 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1967,6 +1967,35 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Trust existing markers.
+ (set-marker erc-insert-marker
+ (alist-get 'erc-insert-marker continued-session))
+ (set-marker erc-input-marker
+ (alist-get 'erc-input-marker continued-session))
+ (goto-char erc-insert-marker)
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -2000,10 +2029,13 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))
+ (buffer-local-variables buffer)))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2021,21 +2053,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2082,20 +2099,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 1318207a3bf..d6dbd87c8cc 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -82,105 +82,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index d6c63934163..f7e90ec9082 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 5605 bytes --]
From 11684dc5ac17b75d7be31b2d945e47da54283fa0 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers
* lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text
property, which has been around since 2002, with more useful
`erc-command' property, which contains the IRC command as a symbol or
a number, in the case of numerics.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
(erc-put-text-property, erc-list): Alias these to built-in functions.
(erc--own-property-names, erc--remove-text-properties) Add internal
variable and helper function for filtering values returned by
`filter-buffer-substring-function'.
(erc-restore-text-properties): Don't forget tags when restoring.
(erc--get-eq-comparable-cmd): New function to extract commands for use
as easily searchable text-property values. (Bug#60936.)
---
lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 43 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5a85c5ad396..3d63c927df3 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2872,7 +2872,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-command
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4250,6 +4252,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4301,7 +4327,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -5673,7 +5699,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5683,14 +5709,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7284,10 +7305,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7307,6 +7329,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 13060 bytes --]
From c49fb6ff6c81105b2049980e6648251e3d603348 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:10:20 -0800
Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
`erc-timestamp' to store lisp time object formerly ensconced in a
closure. Instead of creating a new lambda for the cursor-sensor
function of each message in a buffer, leave a gap between messages to
trip the sensor function. The motivation behind this change is to
allow third parties access to valuable timestamp data already stored
by ERC anyway. Of secondary importance is discouraging the reliance
on those lambdas as a means of detecting message bounds. The gap now
serves a similar purpose. Basically, the final character in a
message, a newline, will not have a timestamp or a sensor function.
When the stamps module isn't loaded, the `erc-message' property can be
used instead. Also, instead of looking for the `invisible' text
property at point, which is normally `point-max' and thus outside the
accessible portion of the buffer, look at the beginning of the
inserted message. This allows hook members running before this
function to opt out of timestamps by marking a message as invisible.
(erc-echo-timestamp): Make interactive and show timestamps even when
the variable `erc-echo-timestamps' is nil.
(erc--echo-ts-csf): Add new function to serve as value of
cursor-sensor function text properties.
* test/lisp/erc/erc-stamp-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 15 ++-
test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++
2 files changed, 217 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..051d0702f06 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -162,7 +162,7 @@ erc-add-timestamp
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (unless (get-text-property (point) 'invisible)
+ (unless (get-text-property (point-min) 'invisible)
(let ((ct (current-time)))
(if (fboundp erc-insert-timestamp-function)
(funcall erc-insert-timestamp-function
@@ -174,12 +174,12 @@ erc-add-timestamp
(not erc-timestamp-format))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (point-max)
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
- (list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ ;; Regions are no longer contiguous ^
+ '(erc--echo-ts-csf) 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -400,11 +400,16 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
- (when (and erc-echo-timestamps (eq 'entered dir))
+ ;; Could also pass an &optional `zone' arg to `format-time-string'.
+ (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
+ (when (eq 'entered dir)
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
+(defun erc--echo-ts-csf (_window _before dir)
+ (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+
(provide 'erc-stamp)
;;; erc-stamp.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..935b9e650b3
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,207 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied. We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+ (let ((val (list 0 0))
+ (erc-insert-modify-hook '(erc-add-timestamp))
+ (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+ (erc-timestamp-only-if-changed-flag nil)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (advice-add 'erc-format-timestamp :filter-args
+ (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+ '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process (start-process "p" (current-buffer)
+ "sleep" "1")
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+
+ (funcall test)
+
+ (when noninteractive
+ (kill-buffer)))
+
+ (advice-remove 'erc-format-timestamp
+ 'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("nil, normal")
+ (let ((erc-timestamp-use-align-to nil))
+ (erc-display-message nil 'notice (current-buffer) "begin"))
+ (goto-char (point-min))
+ (should (search-forward-regexp
+ (rx "begin" (+ "\t") (* " ") " [") nil t))
+ ;; Field includes intervening spaces
+ (should (eql ?n (char-before (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ ;; The option `erc-timestamp-right-column' is normally nil by
+ ;; default, but it's a convenient stand in for a sufficiently
+ ;; small `erc-fill-column' (we can force a line break without
+ ;; involving that module).
+ (should-not erc-timestamp-right-column)
+
+ (ert-info ("nil, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to nil)
+ (erc-timestamp-right-column 20))
+ (erc-display-message nil 'notice (current-buffer)
+ "twenty characters"))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field excludes leading whitespace (arguably undesirable).
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ ;; Timestamp extends to the end of the line.
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("t, normal")
+ (let ((erc-timestamp-use-align-to t))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Exactly two spaces, one from format, one added by erc-stamp.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("t, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to t)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; Indented to pos (this is arguably a bug).
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ ;; Field starts *after* leading space (arguably bad).
+ (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+;; This concerns a proposed partial reversal of the changes resulting
+;; from:
+;;
+;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706)
+;;
+;; Perhaps core behavior has changed since this bug was reported, but
+;; C-e stopping one char short of EOL no longer seems a problem.
+;; However, invoking C-n (`next-line') exhibits a similar effect.
+;; When point is in a stamp or near the beginning of a line, issuing a
+;; C-n puts point one past the start of the message (i.e., two chars
+;; beyond the timestamp's closing "]". Dropping the invisible
+;; property when timestamps are hidden does indeed prevent this, but
+;; it's also a lasting commitment. The docs mention that it's
+;; pointless to pair the old `intangible' property with `invisible'
+;; and suggest users look at `cursor-intangible-mode'. Turning off
+;; the latter does indeed do the trick as does decrementing the end of
+;; the `cursor-intangible' interval so that, in addition to C-n
+;; working, a C-f from before the timestamp doesn't overshoot. This
+;; appears to be the case whether `erc-hide-timestamps' is enabled or
+;; not, but it may be inadvisable for some reason (a hack) and
+;; therefore warrants further investigation.
+;;
+;; Note some striking omissions here:
+;;
+;; 1. a lack of `fill' module integration (we simulate it by
+;; making lines short enough to not wrap)
+;; 2. functions like `line-move' behave differently when
+;; `noninteractive'
+;; 3. no actual test assertions involving `cursor-sensor' movement
+;; even though that's a huge ingredient
+
+(ert-deftest erc-timestamp-intangible--left ()
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-timestamp-intangible t) ; default changed to nil in 2014
+ (erc-hide-timestamps t)
+ (erc-insert-timestamp-function 'erc-insert-timestamp-left)
+ (erc-server-process (start-process "true" (current-buffer) "true"))
+ (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
+ msg
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (should (not cursor-sensor-inhibit))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-mode)
+ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ (erc-munge-invisibility-spec)
+ (erc-display-message nil 'notice (current-buffer) "Welcome")
+ ;;
+ ;; Pretend `fill' is active and that these lines are
+ ;; folded. Otherwise, there's an annoying issue on wrapped lines
+ ;; (when visual-line-mode is off and stamps are visible) where
+ ;; C-e sends you to the end of the previous line.
+ (setq msg "Lorem ipsum dolor sit amet")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alyssa" msg nil t))
+ (erc-display-message nil 'notice (current-buffer) "Home")
+ (goto-char (point-min))
+
+ ;; EOL is actually EOL (Bug#11706)
+
+ (ert-info ("Notice before stamp, C-e") ; first line/stamp
+ (should (search-forward "Welcome" nil t))
+ (ert-simulate-command '(erc-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol))) ; `line-end-position' fails because fields
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg before stamp, C-e")
+ (should (search-forward "Lorem" nil t))
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[")))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (ert-info ("Privmsg first line, C-e")
+ (goto-char (pos-bol))
+ (should (search-forward "ipsum" nil t))
+ (let ((end (pos-eol)))
+ (ert-simulate-command '(move-end-of-line 1))
+ (should (= end (point)))))
+
+ (when noninteractive
+ (kill-buffer)))))
+
+;;; erc-stamp-tests.el ends here
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 5221 bytes --]
From dd8c274ac4e526247df7df6ec9b9b223c6fa9d6d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber
TODO: update ERC-NEWS announcing deprecation.
* lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option
and change meaning of its nil value to fall through to
`erc-timestamp-format'. Do this to allow modules to predict what the
right-hand stamp's final width will be. This also saves
`erc-insert-timestamp-left-and-right' from calling
`erc-format-timestamp' again for no reason.
(erc-stamp--current-time): Add new generic function and method to
return current time. Default to calling `current-time'.
(erc-stamp--current-time): New internal variable to hold time value
used to construct time formatted stamp passed to
`erc-insert-timestamp-function'.
(erc-add-timestamp): Bind `erc-stamp--current-time' when calling
`erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Use STRING parameter and favor
it over the now deprecated `erc-timestamp-format-right' to avoid
formatting twice. Also extract current time from the variable
`erc-stamp--current-time' for similar reasons. (Bug#60936.)
(erc-stamp--tz): New internal variable.
(erc-format-timestamp): Pass `erc-stamp--tz' as time-zone to
`format-time-string'.
---
lisp/erc/erc-stamp.el | 39 +++++++++++++++++++++++++++++++--------
1 file changed, 31 insertions(+), 8 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 051d0702f06..736aa498803 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,17 +165,31 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
(unless (get-text-property (point-min) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
@@ -336,12 +358,13 @@ erc-insert-timestamp-left-and-right
(setq erc-timestamp-last-inserted-right ts-right))))
;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
+(defvar erc-stamp--tz nil)
(defun erc-format-timestamp (time format)
"Return TIME formatted as string according to FORMAT.
Return the empty string if FORMAT is nil."
(if format
- (let ((ts (format-time-string format time)))
+ (let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch --]
[-- Type: text/x-patch, Size: 16168 bytes --]
From e34189bd4f488cb36aac71f8748761d7054db652 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-side
stamps. Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 156 +++++++++++++++++++++++++++----
test/lisp/erc/erc-stamp-tests.el | 70 ++++++++++++--
2 files changed, 202 insertions(+), 24 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 736aa498803..e689caf7b61 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,109 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
-A side effect of enabling this is that there will only be one
-space before a right timestamp in any saved logs."
- :type 'boolean)
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
+Enabling this option produces a side effect in that stamps aren't
+indented in saved logs. When its value is an integer, this
+option adds a space after the end of a message if the stamp
+doesn't already start with one. And when its value is t, it adds
+a single space, unconditionally. And while this option never
+adds a space when its value is `margin', ERC does offer a
+workaround in `erc-stamp-prefix-log-filter', which strips
+trailing stamps from messages and puts them before every line."
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.6")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
+(defun erc-stamp-prefix-log-filter (text)
+ "Prefix every message in the buffer with a stamp.
+Remove trailing stamps as well. For now, hard code the format to
+\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
+`erc-log-filter-function' when `erc-timestamp-use-align-to' is
+non-nil."
+ (insert text)
+ (goto-char (point-min))
+ (while
+ (progn
+ (when-let* (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
+ (delete-region beg (1+ end)))
+ (when-let (time (get-text-property (point) 'erc-timestamp))
+ (insert (format-time-string "[%H:%M:%S] " time)))
+ (zerop (forward-line))))
+ "")
+
+(declare-function erc--remove-text-properties "erc" (string))
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (progn
+ (erc-stamp--adjust-right-margin 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins nil left-margin-width nil)
+ (set-window-fringes nil left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +360,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -275,6 +371,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -326,25 +424,47 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 935b9e650b3..01e71e348e0 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
- (rx "begin" (+ "\t") (* " ") " [") nil t))
+ (rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
- (should (search-forward "msg one [" nil t))
+ (should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
- (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+
+ (ert-info ("integer, normal")
+ (let ((erc-timestamp-use-align-to 1))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added because included in format string.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers space between.
+ (should (eql ?e (char-before (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("integer, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 1)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at leading space.
+ (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+ (erc-stamp-tests--insert-right
+ (lambda ()
+ (erc-stamp--display-margin-mode +1)
+
+ (ert-info ("margin, normal")
+ (let ((erc-timestamp-use-align-to 'margin))
+ (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+ (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+ (erc-display-message nil nil (current-buffer) msg)))
+ (goto-char (point-min))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
+ (should (eql ?e (char-before (field-beginning (point)))))
+ ;; Vanity props extended
+ (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+ (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+ (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+ (should (eql ?\n (char-after (field-end (point))))))
+
+ (ert-info ("margin, overlong (hard wrap)")
+ (let ((erc-timestamp-use-align-to 'margin)
+ (erc-timestamp-right-column 20))
+ (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+ ;; No hard wrap
+ (should (search-forward "oooo[" nil t))
+ ;; Field starts at format string (right bracket)
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2458 bytes --]
From aa4edc2f4b711ccc898073c65d76941188183cc8 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match
data. (Bug#60936.)
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch --]
[-- Type: text/x-patch, Size: 3195 bytes --]
From 93c5911b8c61e919bd90213dc04b6722c9505113 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 05:34:56 -0800
Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec
* lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange
for possibly adding or removing `erc-match' from
`buffer-invisibility-spec'.
(erc-match--hide-fools-offset-bounds): Add new variable to serve as
switch for activating invisibility on a modified interval that's
offset toward `point-min' by one character.
(erc-hide-fools): Optionally offset start and end of invisible region
by minus one.
(erc-match--modify-invisibility-spec): New housekeeping function to
set up and tear down offset spec. (Bug#60936.)
---
lisp/erc/erc-match.el | 31 +++++++++++++++++++++++++------
1 file changed, 25 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 52ee5c855f3..c8f6e7c195c 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer
(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
+
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +675,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #10: 0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 36144 bytes --]
From f87741ad52ffebe378200ffcd74ad75be680d9a2 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill--wrap-value, erc-fill--wrap-movement): New variables to
support new local module.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): New
local module.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-fill.el | 277 ++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
6 files changed, 600 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..16791277723 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,29 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+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'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,257 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall (pcase erc-fill--wrap-visual-keys
+ ('non-input
+ (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+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'. You can also manually
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
+ ((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.
+ (concat "Enabling default global module `fill' needed by local"
+ " module `fill-wrap'. This will impact \C-]all\C-] ERC"
+ " sessions. Add `fill' to `erc-modules' to avoid this"
+ " warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; 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)))
+ (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))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the Info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- erc-fill--wrap-value ,len))
+ (space :width erc-fill--wrap-value))))))
+
+;; 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)))
+ (cl-incf erc-fill--wrap-value arg)
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.
+
+ \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`+' Shift right margin rightward (shrink) by one column
+ \\`_' Shift right margin leftward (grow) by one column
+ \\`)' 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."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
+ (when (zerop arg)
+ (setq arg 1))
+ (erc-compat-call
+ set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (recenter (round (* win-ratio (window-height))))))))
+ (dolist (key '(?\) ?_ ?+))
+ (let ((a (pcase key
+ (?\) 0)
+ (?_ (- (abs arg)))
+ (?+ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
+ map)
+ t
+ (lambda ()
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (recenter (round (* win-ratio (window-height))))))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..2a0abf5dc32
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,324 @@
+;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; FIXME these fixtures (and tests) are now largely useless. Due to
+;; the author's ignorance regarding display properties, the "space"
+;; specs of prefix props on different lines didn't initially leverage
+;; a common variable (`erc-fill--wrap-value'), so the column twiddling
+;; was more laborious. See decades-old comment above
+;; calc_pixel_width_or_height in in xdisp.c for examples.
+;;
+;; TODO maybe use erts files instead of own snapshots.
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defvar erc-fill-tests--buffers nil)
+
+(defun erc-fill-tests--wrap-populate (test)
+ (cl-letf (((symbol-function 'erc-stamp--current-time)
+ (lambda () '(0 1))))
+ (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+ (erc-stamp--tz t)
+ (id (erc-networks--id-create 'foonet))
+ (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+ (erc-server-users (make-hash-table :test 'equal))
+ (erc-fill-function 'erc-fill-wrap)
+ (pre-command-hook pre-command-hook)
+ (erc-modules '(fill stamp))
+ (msg "Hello World")
+ (inhibit-message noninteractive)
+ erc-insert-post-hook
+ extended-command-history
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (when (bound-and-true-p erc-button-mode)
+ (push 'erc-button-add-buttons erc-insert-modify-hook))
+ (erc-mode)
+ (setq erc-server-process proc erc-networks--id id)
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (erc-munge-invisibility-spec)
+ (setq erc-server-process proc
+ erc-networks--id id
+ erc-channel-users (make-hash-table :test 'equal)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan"))
+ (erc--initialize-markers (point) nil)
+
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (setq msg "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.")
+ (erc-display-message nil 'notice (current-buffer) msg)
+
+ (setq msg "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.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" msg nil t))
+
+ ;; Introduce an artificial gap in properties `line-prefix' and
+ ;; `wrap-prefix' and later ensure they're not incremented twice.
+ (save-excursion
+ (forward-line -1)
+ (search-forward "? ")
+ (remove-text-properties (1- (point)) (point)
+ '(line-prefix t wrap-prefix t)))
+
+ (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" msg nil t))
+
+ (let ((original-window-buffer (window-buffer (selected-window))))
+ (set-window-buffer (selected-window) (current-buffer))
+ ;; Defend against non-local exits from `ert-skip'
+ (unwind-protect
+ (funcall test)
+ (set-window-buffer (selected-window) original-window-buffer)
+ (when noninteractive
+ (while-let ((buf (pop erc-fill-tests--buffers)))
+ (kill-buffer buf))
+ (kill-buffer))))))))
+
+(defun erc-fill-tests--wrap-check-props (speaker)
+ ;; Prefix props are applied properly and faces are accounted
+ ;; for when determining widths.
+ (should (search-forward speaker nil t))
+ (should (get-text-property (pos-bol) 'line-prefix))
+ (should (get-text-property (pos-eol) 'line-prefix))
+ (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+ (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+ '(space :width erc-fill--wrap-value)))
+
+ ;; The last elt in the `:width' value is a singleton (NUM) when
+ ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
+ ;; prod rules table under (info "(elisp) Pixel Specification").
+ (should (pcase (get-text-property (point) 'line-prefix)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- erc-fill--wrap-value (,w))))
+ (= w (string-pixel-width speaker)))
+ (`(space :width (- erc-fill--wrap-value ,w))
+ (= w (length speaker))))))
+
+(defun erc-fill-tests--wrap-check-prefixes ()
+ (save-excursion
+ (goto-char (point-min))
+ (erc-fill-tests--wrap-check-props "*** ")
+ (erc-fill-tests--wrap-check-props "<alice> ")
+ ;; Ensure the loop is not visited twice due to the gap.
+ (erc-fill-tests--wrap-check-props "<bob> ")))
+
+;; Set this variable to t to generate new snapshots after carefully
+;; reviewing the output of each.
+(defvar erc-fill-tests--save-p nil)
+
+(defun erc-fill-tests--compare (name)
+ (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)))
+ (expect-file (file-name-with-extension (expand-file-name name dir)
+ "eld"))
+ (erc--own-property-names
+ (seq-difference `(erc-timestamp font-lock-face
+ ,@erc--own-property-names)
+ '(display wrap-prefix line-prefix)
+ #'eq))
+ (print-circle t)
+ (print-escape-newlines t)
+ (print-escape-nonascii t)
+ (got (erc--remove-text-properties
+ (buffer-substring (point-min) erc-insert-marker)))
+ (repr (string-replace "erc-fill--wrap-value"
+ (number-to-string erc-fill--wrap-value)
+ (prin1-to-string got))))
+ (with-current-buffer (generate-new-buffer name)
+ (push name erc-fill-tests--buffers)
+ (with-silent-modifications
+ (insert (setq got (read repr))))
+ (erc-mode))
+ (if erc-fill-tests--save-p
+ (with-temp-file expect-file
+ (insert repr))
+ (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (should (equal got (read (current-buffer))))))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+ :tags '(:unstable)
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-01-start")
+
+ (ert-info ("Shift right by one (plus)")
+ (ert-with-message-capture messages
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET ="))
+ (should (string-match (rx "for further adjustment") messages)))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-02-right"))
+
+ (ert-info ("Shift left by five")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-03-left"))
+
+ (ert-info ("Reset")
+ (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-04-reset")))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+ :tags '(:unstable)
+ (unless (and (fboundp 'string-pixel-width)
+ (not noninteractive)
+ (display-graphic-p))
+ (ert-skip "Test needs interactive graphical Emacs"))
+
+ (with-selected-frame (make-frame '((name . "other")))
+ (set-face-attribute 'default (selected-frame)
+ :family "Sans Serif"
+ :foundry 'unspecified
+ :font 'unspecified)
+
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge 2)
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge -6)
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes)
+ (erc-fill--wrap-nudge 0)
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes)
+
+ ;; FIXME get rid of this "void variable `erc--results-ewoc'"
+ ;; error, which seems related to operating in a non-default
+ ;; frame.
+ ;;
+ ;; As a kludge, checking if point made it to the prompt can
+ ;; serve as visual confirmation that the test passed.
+ (goto-char (point-max))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--body ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (execute-kbd-macro "\C-e")
+ (should (search-backward "tedious fool" nil t))
+ (should-not (looking-back "done to her\\."))
+ (forward-char)
+ (execute-kbd-macro "\C-e")
+ (should (search-forward "done to her." nil t)))
+
+ (ert-info ("Value: nil")
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (goto-char (point-min))
+ (should (search-forward "in debug mode" nil t))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at (rx "*** ")))
+ (execute-kbd-macro "\C-e")
+ (should (eql ?\] (char-before (point)))))
+
+ (ert-info ("Value: t")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (goto-char (point-min))
+ (should (search-forward "that he hath" nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))
+ (should (search-backward "tedious fool" nil t))
+ (execute-kbd-macro "\C-e")
+ (should-not (looking-back (rx "done to her\\.")))
+ (should (search-forward "done to her." nil t))
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at (rx "<alice> ")))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--prompt ()
+ :tags '(:unstable)
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ (set-window-buffer (selected-window) (current-buffer))
+ (goto-char erc-input-marker)
+ (insert "This buffer is for text that is not saved, and for Lisp "
+ "evaluation. To create a file, visit it with C-x C-f and "
+ "enter text in its buffer.")
+
+ (ert-info ("Value: non-input")
+ (should (eq erc-fill--wrap-visual-keys 'non-input))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-e")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: nil") ; same
+ (execute-kbd-macro "\C-ca")
+ (should-not erc-fill--wrap-visual-keys)
+ (execute-kbd-macro "\C-y")
+ (should (looking-back "its buffer\\."))
+ (execute-kbd-macro "\C-a")
+ (should (looking-at "This buffer"))
+ (execute-kbd-macro "\C-k")
+ (should (eobp)))
+
+ (ert-info ("Value: non-input")
+ (execute-kbd-macro "\C-ca")
+ (should (eq erc-fill--wrap-visual-keys t))
+ (execute-kbd-macro "\C-y")
+ (execute-kbd-macro "\C-a")
+ (should-not (looking-at "This buffer"))
+ (execute-kbd-macro "\C-p")
+ (should-not (looking-back "its buffer\\."))
+ (should (search-forward "its buffer." nil t))
+ (should (search-backward "ERC> " nil t))
+ (execute-kbd-macro "\C-a")))))
+
+;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.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<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" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
new file mode 100644
index 00000000000..3f5f344cc64
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.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<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" 21 183 (wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 29 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 29 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
new file mode 100644
index 00000000000..3b215936c39
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.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<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" 21 183 (wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 25 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 25 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.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<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" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (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 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
--
2.39.2
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87edpykmud.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87edpykmud.fsf@neverwas.me>
@ 2023-04-10 20:49 ` J.P.
0 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-04-10 20:49 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> v10. Redo some key bindings. Remove unneeded Compat functions. Rename
> `erc-message' text prop to `erc-command'. Revive mistakenly deleted hunk
> in erc-match.
This module probably shouldn't be hiding fringes without good reason or
calling `set-window-margins' on whatever window happens to be selected.
The current behavior also carries the potential to pollute the test
suite.
I've gone ahead and installed a small fix that hopefully addresses these
concerns. Thanks.
^ permalink raw reply [flat|nested] 56+ messages in thread
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (9 preceding siblings ...)
[not found] ` <87edpykmud.fsf@neverwas.me>
@ 2023-05-09 20:46 ` J.P.
2023-05-22 4:20 ` J.P.
` (14 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-05-09 20:46 UTC (permalink / raw)
To: 60936
Related followup (caught by the archive filter):
https://lists.gnu.org/archive/html/emacs-erc/2023-05/msg00004.html
^ permalink raw reply [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (10 preceding siblings ...)
2023-05-09 20:46 ` J.P.
@ 2023-05-22 4:20 ` J.P.
[not found] ` <87fs7p3sk6.fsf@neverwas.me>
` (13 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-05-22 4:20 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1146 bytes --]
The following commit introduced a regression:
commit 05f6fdb9e7893329baff675bd31fb36ad64c756d
Author: F. Jason Park <jp@neverwas.me>
Preserve ERC prompt and its bounding markers
1 file changed, 27 insertions(+), 22 deletions(-)
lisp/erc/erc.el | 49 +++++++++++++++++++++++++++----------------------
To reproduce from emacs -Q:
1. Eval:
(require 'erc)
(setq erc-prompt (lambda () (format-time-string "%T>"))
erc-autojoin-channels-alist '((ErgoTestnet "#test")))
(erc-tls :server "testnet.ergo.chat")
2. In #test, note the timestamp in the prompt
3. Say "something" RET
4. Notice that the prompt doesn't change, whereas in ERC 5.5 and
earlier, it would change on every outgoing message
The attached patch fixes the regression and changes the behavior to
redraw the prompt on every incoming message as well, but only when
`erc-prompt' is a function. Doing this should bring us one step closer
to being able to look at
bug#51082 erc-prompt: support substitution patterns "%target" and "%network"
However, we'd still be missing user-mode tracking, which seems fairly
trivial to add.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Recompute-erc-prompt-when-inserting-messages.patch --]
[-- Type: text/x-patch, Size: 7488 bytes --]
From 292f741020f6dc39103803d6ca0cb8b7fb9e2b61 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 18 May 2023 23:47:27 -0700
Subject: [PATCH] [5.6] Recompute erc-prompt when inserting messages
* lisp/erc/erc.el (erc--refresh-prompt): New function for redrawing
the prompt in a couple select places.
(erc-display-line-1, erc-display-msg): Replace the prompt after
inserting messages.
* test/lisp/erc/erc-tests.el (erc--refresh-prompt): New
test. (Bug#60936)
---
lisp/erc/erc.el | 16 +++++-
test/lisp/erc/erc-tests.el | 99 ++++++++++++++++++++++++++++++++++++++
2 files changed, 113 insertions(+), 2 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 495e25212ce..16bb2c38b1b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2787,6 +2787,18 @@ erc--assert-input-bounds
(cl-assert (< erc-insert-marker erc-input-marker))
(cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
+(defun erc--refresh-prompt ()
+ "Re-render ERC's prompt when the option `erc-prompt' is a function."
+ (erc--assert-input-bounds)
+ (when (functionp erc-prompt)
+ (save-excursion
+ (goto-char erc-insert-marker)
+ ;; Avoid `erc-prompt' (the named function), which appends a
+ ;; space, and `erc-display-prompt', which propertizes all but
+ ;; that space.
+ (insert-and-inherit (funcall erc-prompt))
+ (delete-region (point) (1- erc-input-marker)))))
+
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
Auxiliary function used in `erc-display-line'. The line gets filtered to
@@ -2830,7 +2842,7 @@ erc-display-line-1
(when erc-remove-parsed-property
(remove-text-properties (point-min) (point-max)
'(erc-parsed nil))))
- (erc--assert-input-bounds)))))
+ (erc--refresh-prompt)))))
(run-hooks 'erc-insert-done-hook)
(erc-update-undo-list (- (or (marker-position erc-insert-marker)
(point-max))
@@ -6452,7 +6464,7 @@ erc-display-msg
(narrow-to-region insert-position (point))
(run-hooks 'erc-send-modify-hook)
(run-hooks 'erc-send-post-hook))
- (erc--assert-input-bounds)))))
+ (erc--refresh-prompt)))))
(defun erc-command-symbol (command)
"Return the ERC command symbol for COMMAND if it exists and is bound."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b624186d88d..1c75f35e1b5 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -269,6 +269,105 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--refresh-prompt ()
+ (let* ((counter 0)
+ (erc-prompt (lambda ()
+ (format "%s %d>"
+ (erc-format-target-and/or-network)
+ (cl-incf counter))))
+ erc-accidental-paste-threshold-seconds
+ erc-insert-modify-hook
+ erc--input-review-functions
+ erc-send-completed-hook)
+
+ (ert-info ("Server buffer")
+ (with-current-buffer (get-buffer-create "ServNet")
+ (erc-tests--send-prep)
+ (goto-char erc-insert-marker)
+ (should (looking-at-p "ServNet 3>"))
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (set-process-sentinel erc-server-process #'ignore)
+ (setq erc-network 'ServNet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)
+ erc-server-users (make-hash-table :test 'equal))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ ;; Incoming message redraws prompt
+ (erc-display-message nil 'notice nil "Welcome")
+ (should (looking-at-p "ServNet 4>"))
+ ;; Say something
+ (save-excursion (goto-char erc-input-marker)
+ (insert "Howdy")
+ (erc-send-current-line)
+ (forward-line -1)
+ (should (looking-at "No target"))
+ (forward-line -1)
+ (should (looking-at "<tester> Howdy")))
+ (should (looking-at-p "ServNet 6>"))
+ ;; Space after prompt is unpropertized
+ (should (get-text-property (1- erc-input-marker) 'erc-prompt))
+ (should-not (get-text-property erc-input-marker 'erc-prompt))
+ ;; No sign of old prompts
+ (save-excursion
+ (goto-char (point-min))
+ (should-not (search-forward (rx (any "3-5") ">") nil t)))))
+
+ (ert-info ("Channel buffer")
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-tests--send-prep)
+ (goto-char erc-insert-marker)
+ (should (looking-at-p "#chan 9>"))
+ (setq erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "ServNet"))
+ erc-networks--id (erc-with-server-buffer erc-networks--id)
+ erc--target (erc--target-from-string "#chan")
+ erc-default-recipients (list "#chan")
+ erc-channel-users (make-hash-table :test 'equal))
+ (erc-update-current-channel-member "alice" "alice")
+ (erc-update-current-channel-member "bob" "bob")
+ (erc-update-current-channel-member "tester" "tester")
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "alice" "Hi" nil t))
+ (should (looking-at-p "#chan@ServNet 10>"))
+ (save-excursion (goto-char erc-input-marker)
+ (insert "Howdy")
+ (erc-send-current-line)
+ (forward-line -1)
+ (should (looking-at "<tester> Howdy")))
+ (should (looking-at-p "#chan@ServNet 11>"))
+ (save-excursion (goto-char erc-input-marker)
+ (insert "/query bob")
+ (erc-send-current-line))
+ ;; Query does not redraw (nor /help, only message input)
+ (should (looking-at-p "#chan@ServNet 11>"))
+ ;; No sign of old prompts
+ (save-excursion
+ (goto-char (point-min))
+ (should-not (search-forward (rx (or "9" "10") ">") nil t)))))
+
+ (ert-info ("Query buffer")
+ (with-current-buffer (get-buffer "bob")
+ (goto-char erc-insert-marker)
+ (should (looking-at-p "bob@ServNet 14>"))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage "bob" "Hi" nil t))
+ (should (looking-at-p "bob@ServNet 15>"))
+ (save-excursion (goto-char erc-input-marker)
+ (insert "Howdy")
+ (erc-send-current-line)
+ (forward-line -1)
+ (should (looking-at "<tester> Howdy")))
+ (should (looking-at-p "bob@ServNet 16>"))
+ ;; No sign of old prompts
+ (save-excursion
+ (goto-char (point-min))
+ (should-not (search-forward (rx (or "14" "15") ">") nil t)))))
+
+ (when noninteractive
+ (kill-buffer "#chan")
+ (kill-buffer "bob")
+ (kill-buffer "ServNet"))))
+
(ert-deftest erc--initialize-markers ()
(let ((proc (start-process "true" (current-buffer) "true"))
erc-modules
--
2.40.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87fs7p3sk6.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87fs7p3sk6.fsf@neverwas.me>
@ 2023-05-30 14:14 ` J.P.
0 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-05-30 14:14 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> The following commit introduced a regression:
>
> commit 05f6fdb9e7893329baff675bd31fb36ad64c756d
> Author: F. Jason Park <jp@neverwas.me>
>
> [...]
>
> The attached patch fixes the regression and changes the behavior to
> redraw the prompt on every incoming message as well, but only when
> `erc-prompt' is a function.
I've added this as
commit 4f93c52f7fd1b7c5f75a0d049e5a1015a268265a
Recompute erc-prompt when inserting messages
lisp/erc/erc.el | 16 ++++++++++--
test/lisp/erc/erc-tests.el | 99 +++++++++++++++++++++++++++++++++++++++
2 files changed, 113 insertions(+), 2 deletions(-)
along with
commit 31a80f61ec03bcbb79720c0dc640272aba160865 (origin/master)
Preserve prompt in erc-cmd-CLEAR
etc/ERC-NEWS | 11 ++++
lisp/erc/erc-log.el | 17 ++++--
lisp/erc/erc-stamp.el | 16 +++++
lisp/erc/erc-truncate.el | 21 +++----
lisp/erc/erc.el | 9 ++-
test/lisp/erc/erc-scenarios-log.el | 207 ++++++++++++++++++++++++++++++
6 files changed, 264 insertions(+), 17 deletions(-)
which fixes a bug affecting the /CLEAR command. It was introduced by
05f6fdb9e78 "Preserve ERC prompt and its bounding markers"
and pointed out by incal on IRC. Some background:
For almost two decades, `erc-cmd-CLEAR' was simply defined as
(recenter 0)
However, in 2019, it was changed to destructively truncate the current
buffer, something traditionally (though perhaps inadequately) provided
by the command `erc-save-buffer-in-logs' in concert with the option
`erc-truncate-buffer-on-save'. It happens that 05f6fdb9e78 "Preserve"
also introduced a regression affecting the latter option, which has
always suffered from an awkward implementation and insufficient
documentation (and, consequently, poor discoverability). In addition to
restoring its functionality, I've also deprecated it because of the
inherent confusion surrounding its usage and, to a lesser degree,
because it's redundant (/CLEAR now does the exact same thing). If anyone
thinks this rash or unwarranted, please say so. Thanks.
^ permalink raw reply [flat|nested] 56+ messages in thread
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (12 preceding siblings ...)
[not found] ` <87fs7p3sk6.fsf@neverwas.me>
@ 2023-06-28 21:02 ` J.P.
[not found] ` <87jzvny7ez.fsf@neverwas.me>
` (11 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-06-28 21:02 UTC (permalink / raw)
To: 60936
Another one denied by the archive trap (mere minutes this time):
https://lists.gnu.org/archive/html/emacs-erc/2023-06/msg00021.html
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87jzvny7ez.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87jzvny7ez.fsf@neverwas.me>
@ 2023-07-03 13:14 ` J.P.
0 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-07-03 13:14 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 3203 bytes --]
"J.P." <jp@neverwas.me> writes:
> A commit associated with this bug
>
> d880a08f "Cement ordering of essential hook members in ERC"
>
> introduced a regression that basically nullifies the `match' module when
> a certain `erc-stamp' option is customized to a certain value. To
> reproduce from Emacs -Q:
>
> - Set `erc-insert-timestamp-function' to `erc-insert-timestamp-left'
>
> - Connect to any server
>
> - Find the first mention of your nickname in the text of some early
> numeric (often something like "Welcome to FooNet <nick>")
>
> - Notice that it appears in plain `erc-notice-face' rather than
> `erc-current-nick-face' (a "match" face)
>
> The attached patch should fix the issue. Thanks to Libera.Chat user jrm
> for reporting this bug.
Actually, the veracity of that claim is unclear and most likely bogus.
What is clear is that this approach is unsustainable because related
bugs are bound to crop up in the near future (if they haven't already).
Basically, in trying to code defensively around possibly encountering
unexpected text before inserted messages (such as leading stamps, white
space, decorations, etc.), my attempted solution traded superficial
robustness for a new dimension of complexity that's almost certainly
unsustainable. (This outcome was more or less predicted in the
justification for d880a08f "Cement ...", which this fix rather callously
contravened the spirit of.)
Anyway, to address all this, I think we should:
1. Revert the previous attempted fix, which now exists on HEAD as
commit 99d74dcd45938e2686d93eb5649800e14a88cd84
Author: F. Jason Park <jp@neverwas.me>
Date: Tue Jun 27 20:47:26 2023 -0700
Account for leading timestamps in erc-match
lisp/erc/erc-match.el | 41 ++++++++----
test/lisp/erc/erc-scenarios-match.el | 120 +++++++++++++++++++++++++
2 files changed, 149 insertions(+), 12 deletions(-)
2. Undo the change of ordering for `erc-add-timestamp' and
`erc-match-message' in `erc-insert-modify-hook' (from d880a08f
"Cement ...").
3. Take an entirely different tack bent on including (rather than
omitting) time stamps from invisible messages. If not yet obvious,
the impetus for the poor decision (of mine) to switch the order of
those hook members was to improve the toggling of invisible
elements created by the `match' module (and potentially others),
and also to make logs less ragged when they feature invisible
messages.
I'll go ahead and install the first of the attached patches (reverting
the misguided fix) and continue to iterate on the second, which proposes
the more comprehensive solution described in 3. Thanks.
> While we're at it, I'm thinking the option `erc-fill-spaced-commands',
> which has been on HEAD for a few months now, should be demoted to a
> plain variable, maybe even an internal one, because there aren't any
> obvious use cases for non-default values. Unless someone has a good
> argument to the contrary, I will do this in an accompanying patch to be
> installed along with this one. Thanks.
I've decided to instead lump this in with bug#64301 (speaker labels).
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Revert-Account-for-leading-timestamps-in-erc-match.patch --]
[-- Type: text/x-patch, Size: 9159 bytes --]
From 226d4371e0d022f5080859736fa9161966049f4f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 2 Jul 2023 20:57:46 -0700
Subject: [PATCH 1/2] Revert "Account for leading timestamps in erc-match"
This reverts commit 99d74dcd45938e2686d93eb5649800e14a88cd84 but keeps
the test file test/lisp/erc/erc-scenarios-match.el. This also
implements a partial alternative solution by undoing the reordering of
insert hooks owned by the `stamp' and `match' modules. The reordering
was performed as part of d880a08f9592e51ada5749d10b472396683fb6ee
"Cement ordering of essential hook members in ERC". The intent was to
address the problem of timestamps not being hidden in matched "fool"
messages. However, a better approach is to incorporate timestamps
into hidden messages by merging `invisible' properties. This will be
handled by a future change, most likely lumped in with bug#64301.
* erc/ERC-NEWS: Fix erroneous claim about relative hook ordering
pre-5.6, which somewhat informs the confusion belying the original
wrongheaded change.
* lisp/erc/erc-match.el (erc-match-mode, erc-match-enable): Change
hook depth for `erc-insert-modify-hook' member from 60 to 50.
(erc-text-matched-hook): Retain portion of updated doc string instead
of reverting.
* lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable): Change
depth for insert and send-hook members from 50 to 60.
* test/lisp/erc/erc-scenarios-match.el
(erc-scenarios-match--stamp-left-current-nick
erc-scenarios-match--stamp-left-fools-invisible): Temporarily disable
the latter and fix expected hook ordering.
* test/lisp/erc/erc-tests.el (erc--essential-hook-ordering): Fix
expected order of default insert hooks. (Bug#60936)
---
etc/ERC-NEWS | 2 +-
lisp/erc/erc-match.el | 36 ++++++++--------------------
lisp/erc/erc-stamp.el | 4 ++--
test/lisp/erc/erc-scenarios-match.el | 11 +++++----
test/lisp/erc/erc-tests.el | 4 ++--
5 files changed, 22 insertions(+), 35 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 2f465e247d7..5665b760ea9 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -183,7 +183,7 @@ Luckily, ERC now leverages a feature introduced in Emacs 27, "hook
depth," to secure the positions of a few key members of
'erc-insert-modify-hook' and 'erc-send-modify-hook'. So far, this
includes the functions 'erc-button-add-buttons', 'erc-fill',
-'erc-add-timestamp', and 'erc-match-message', which now appear in that
+'erc-match-message', and 'erc-add-timestamp', which now appear in that
order, when present, at depths beginning at 20 and ending below 80.
Of most interest to module authors is the new relative positioning of
the first two, 'erc-button-add-buttons' and 'erc-fill', which have
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 204bf14a1cf..2b7fff87ff0 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,7 +52,7 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 60)
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 50)
(add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
(unless erc--updating-modules-p
(erc-buffer-do #'erc-match--modify-invisibility-spec))
@@ -237,10 +237,7 @@ erc-text-matched-hook
ERC calls members with the arguments (MATCH-TYPE NUH MESSAGE),
where MATCH-TYPE is one of the symbols `current-nick', `keyword',
`pal', `dangerous-host', `fool', and NUH is an `erc-response'
-sender, like bob!~bob@example.org. Users should keep in mind
-that MESSAGE may not include decorations, such as white space or
-time stamps, preceding the same text as inserted in the narrowed
-buffer."
+sender, like bob!~bob@example.org."
:options '(erc-log-matches erc-hide-fools erc-beep-on-match)
:type 'hook)
@@ -462,19 +459,8 @@ erc-match-directed-at-fool-p
(erc-list-match fools-end msg))))
(defun erc-match-message ()
- "Add faces to matching text in inserted message."
- ;; Exclude leading whitespace, stamps, etc.
- (let ((omin (point-min))
- (beg (or (and (not (get-text-property (point-min) 'erc-command))
- (next-single-property-change (point-min) 'erc-command))
- (point-min))))
- ;; FIXME when ERC no longer supports 28, use `with-restriction'
- ;; with `:label' here instead of passing `omin'.
- (save-restriction
- (narrow-to-region beg (point-max))
- (erc-match--message omin))))
-
-(defun erc-match--message (unrestricted-point-min)
+ "Mark certain keywords in a region.
+Use this defun with `erc-insert-modify-hook'."
;; This needs some refactoring.
(goto-char (point-min))
(let* ((to-match-nick-dep '("pal" "fool" "dangerous-host"))
@@ -576,14 +562,12 @@ erc-match--message
'font-lock-face match-face)))
;; Else twiddle your thumbs.
(t nil))
- ;; FIXME use `without-restriction' after dropping 28.
- (save-restriction
- (narrow-to-region unrestricted-point-min (point-max))
- (run-hook-with-args
- 'erc-text-matched-hook (intern match-type)
- (or nickuserhost
- (concat "Server:" (erc-get-parsed-vector-type vector)))
- message)))))
+ (run-hook-with-args
+ 'erc-text-matched-hook
+ (intern match-type)
+ (or nickuserhost
+ (concat "Server:" (erc-get-parsed-vector-type vector)))
+ message))))
(if nickuserhost
(append to-match-nick-dep to-match-nick-indep)
to-match-nick-indep)))))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index aac51135a07..5035e60a87d 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -163,8 +163,8 @@ erc-timestamp-face
(define-erc-module stamp timestamp
"This mode timestamps messages in the channel buffers."
((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
- (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 50)
- (add-hook 'erc-send-modify-hook #'erc-add-timestamp 50)
+ (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 60)
+ (add-hook 'erc-send-modify-hook #'erc-add-timestamp 60)
(add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
(add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
(unless erc--updating-modules-p
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index 49e6a3370fc..61368919d31 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -49,8 +49,9 @@ erc-scenarios-match--stamp-left-current-nick
:port port
:full-name "tester"
:nick "tester")
- (should (memq 'erc-match-message
- (memq 'erc-add-timestamp erc-insert-modify-hook)))
+ ;; Module `timestamp' precedes `match' in insertion hooks.
+ (should (memq 'erc-add-timestamp
+ (memq 'erc-match-message erc-insert-modify-hook)))
;; The "match type" is `current-nick'.
(funcall expect 5 "tester")
(should (eq (get-text-property (1- (point)) 'font-lock-face)
@@ -60,6 +61,7 @@ erc-scenarios-match--stamp-left-current-nick
;; some non-nil invisibility property spans the entire message.
(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
:tags '(:expensive-test)
+ (ert-skip "WIP: fix included in bug#64301")
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
(dumb-server (erc-d-run "localhost" t 'foonet))
@@ -84,8 +86,9 @@ erc-scenarios-match--stamp-left-fools-invisible
:full-name "tester"
:password "changeme"
:nick "tester")
- (should (memq 'erc-match-message
- (memq 'erc-add-timestamp erc-insert-modify-hook)))
+ ;; Module `timestamp' precedes `match' in insertion hooks.
+ (should (memq 'erc-add-timestamp
+ (memq 'erc-match-message erc-insert-modify-hook)))
(funcall expect 5 "This server is in debug mode")))
(ert-info ("Ensure lines featuring \"bob\" are invisible")
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b751ef50520..80c7c708fc5 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1851,8 +1851,8 @@ erc--essential-hook-ordering
'( :erc-insert-modify-hook (erc-controls-highlight ; 0
erc-button-add-buttons ; 30
erc-fill ; 40
- erc-add-timestamp ; 50
- erc-match-message) ; 60
+ erc-match-message ; 50
+ erc-add-timestamp) ; 60
:erc-send-modify-hook ( erc-controls-highlight ; 0
erc-button-add-buttons ; 30
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Respect-existing-invisibility-props-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 14943 bytes --]
From 2518e294112df689cbcbb3428bd43acc38fd1a5b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 2 Jul 2023 20:58:37 -0700
Subject: [PATCH 2/2] [5.6] Respect existing invisibility props in erc-stamp
* lisp/erc/erc-match.el (erc-hide-fools): change `invisible' property
to `erc-match' for all messages, not just those with offset bounds.
* lisp/erc/erc-stamp.el (erc-stamp--invisible-property):
Add new internal variable to hold existing `invisible' property merged
with the one registered by this module.
(erc-stamp--skip-when-invisible): Add new internal variable to act as
escape hatch for pre ERC-5.6 behavior in which timestamps were not
applied at all to invisible messages. This led to strange-looking,
uneven logs, and it prevented other modules from offering toggle
functionality for invisibility spec members registered to them.
(erc-add-timestamp): Merge with existing `invisible' property, when
present, instead of clobbering, but only when escape hatch
`erc-stamp--skip-when-invisible' is nil.
(erc-insert-timestamp-left, erc-format-timestamp): Use possibly merged
`invisible' prop value.
* test/lisp/erc/erc-scenarios-match.el
(erc-scenarios-match--invisible-stamp): Move setup and core assertions
for stamp-related tests into fixture.
(erc-scenarios-match--stamp-left-fools-invisible): Fix temporarily
disabled test and use fixture.
(erc-scenarios-match--stamp-right-fools-invisible,
erc-scenarios-match--stamp-right-invisible-fill-wrap): New test.
---
lisp/erc/erc-match.el | 7 +-
lisp/erc/erc-stamp.el | 18 ++-
test/lisp/erc/erc-scenarios-match.el | 160 +++++++++++++++++++++++----
3 files changed, 157 insertions(+), 28 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 2b7fff87ff0..468358536ae 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -669,10 +669,9 @@ erc-hide-fools
(save-restriction
(widen)
(put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
- ;; The docs say `intangible' is deprecated, but this has been
- ;; like this for ages. Should verify unneeded and remove if so.
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)))))
+ ;; Before ERC 5.6, this also used to add an `intangible'
+ ;; property, but the docs say it's now obsolete.
+ (put-text-property (point-min) (point-max) 'invisible 'erc-match))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 5035e60a87d..cc9e0e13083 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -179,6 +179,12 @@ stamp
(kill-local-variable 'erc-timestamp-last-inserted-left)
(kill-local-variable 'erc-timestamp-last-inserted-right))))
+(defvar erc-stamp--invisible-property nil
+ "Existing `invisible' property value and/or symbol `timestamp'.")
+
+(defvar erc-stamp--skip-when-invisible nil
+ "Escape hatch for omitting stamps when first char is invisible.")
+
(defun erc-stamp--recover-on-reconnect ()
(when-let ((priors (or erc--server-reconnecting erc--target-priors)))
(dolist (var '(erc-timestamp-last-inserted
@@ -209,8 +215,11 @@ erc-add-timestamp
(progn ; remove this `progn' on next major refactor
(let* ((ct (erc-stamp--current-time))
(invisible (get-text-property (point-min) 'invisible))
+ (erc-stamp--invisible-property
+ ;; FIXME on major version bump, make this `erc-' prefixed.
+ (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(erc-stamp--current-time ct))
- (unless invisible
+ (unless (setq invisible (and erc-stamp--skip-when-invisible invisible))
(funcall erc-insert-timestamp-function
(erc-format-timestamp ct erc-timestamp-format)))
;; FIXME this will error when advice has been applied.
@@ -380,7 +389,7 @@ erc-insert-timestamp-left
(s (if ignore-p (make-string len ? ) string)))
(unless ignore-p (setq erc-timestamp-last-inserted string))
(erc-put-text-property 0 len 'field 'erc-timestamp s)
- (erc-put-text-property 0 len 'invisible 'timestamp s)
+ (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
(defun erc-insert-aligned (string pos)
@@ -477,6 +486,8 @@ erc-insert-timestamp-right
(put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
+ (erc-put-text-property from (point) 'invisible
+ erc-stamp--invisible-property)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
@@ -520,7 +531,8 @@ erc-format-timestamp
(let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
- (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
+ (erc-put-text-property 0 (length ts) 'invisible
+ erc-stamp--invisible-property ts)
(erc-put-text-property 0 (length ts)
'isearch-open-invisible 'timestamp ts)
;; N.B. Later use categories instead of this harmless, but
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index 61368919d31..9fc744468f3 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -26,6 +26,7 @@
(require 'erc-stamp)
(require 'erc-match)
+(require 'erc-fill)
;; This defends against a regression in which all matching by the
;; `erc-match-message' fails when `erc-add-timestamp' precedes it in
@@ -57,28 +58,20 @@ erc-scenarios-match--stamp-left-current-nick
(should (eq (get-text-property (1- (point)) 'font-lock-face)
'erc-current-nick-face))))))
-;; This asserts that when stamps appear before a message,
-;; some non-nil invisibility property spans the entire message.
-(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
- :tags '(:expensive-test)
- (ert-skip "WIP: fix included in bug#64301")
+;; When hacking on tests that use this fixture, it's best to run it
+;; interactively, and check for wierdness before and after doing
+;; M-: (remove-from-invisibility-spec 'erc-match) RET.
+(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
(dumb-server (erc-d-run "localhost" t 'foonet))
(port (process-contact dumb-server :service))
(erc-server-flood-penalty 0.1)
- (erc-insert-timestamp-function 'erc-insert-timestamp-left)
(erc-timestamp-only-if-changed-flag nil)
(erc-fools '("bob"))
(erc-text-matched-hook '(erc-hide-fools))
(erc-autojoin-channels-alist '((FooNet "#chan")))
- (expect (erc-d-t-make-expecter))
- (hiddenp (lambda ()
- (and (eq (field-at-pos (pos-bol)) 'erc-timestamp)
- (get-text-property (pos-bol) 'invisible)
- (>= (next-single-property-change (pos-bol)
- 'invisible nil)
- (pos-eol))))))
+ (expect (erc-d-t-make-expecter)))
(ert-info ("Connect")
(with-current-buffer (erc :server "127.0.0.1"
@@ -94,30 +87,155 @@ erc-scenarios-match--stamp-left-fools-invisible
(ert-info ("Ensure lines featuring \"bob\" are invisible")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(should (funcall expect 10 "<bob> tester, welcome!"))
- (should (funcall hiddenp))
+ (ert-info ("<bob> tester, welcome!") (funcall hiddenp))
;; Alice's is the only one visible.
(should (funcall expect 10 "<alice> tester, welcome!"))
- (should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
- (should (get-text-property (pos-bol) 'invisible))
- (should-not (get-text-property (point) 'invisible))
+ (ert-info ("<alice> tester, welcome!") (funcall visiblep))
(should (funcall expect 10 "<bob> alice: But, as it seems"))
- (should (funcall hiddenp))
+ (ert-info ("<bob> alice: But, as it seems") (funcall hiddenp))
(should (funcall expect 10 "<alice> bob: Well, this is the forest"))
- (should (funcall hiddenp))
+ (ert-info ("<alice> bob: Well, this is the forest") (funcall hiddenp))
(should (funcall expect 10 "<alice> bob: And will you"))
- (should (funcall hiddenp))
+ (ert-info ("<alice> bob: And will you") (funcall hiddenp))
(should (funcall expect 10 "<bob> alice: Live, and be prosperous"))
- (should (funcall hiddenp))
+ (ert-info ("<bob> alice: Live, and be prosperous") (funcall hiddenp))
(should (funcall expect 10 "ERC>"))
(should-not (get-text-property (pos-bol) 'invisible))
(should-not (get-text-property (point) 'invisible))))))
+;; This asserts that when stamps appear before a message, registered
+;; invisibility properties owned by modules span the entire message.
+(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
+ :tags '(:expensive-test)
+ (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left))
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ ;; This is a time-stamped message.
+ (should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
+
+ ;; Leading stamp has combined `invisible' property value.
+ (should (equal (get-text-property (pos-bol) 'invisible)
+ '(timestamp erc-match)))
+
+ ;; Message proper has the `invisible' property `erc-match'.
+ (let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
+ (should (eq (get-text-property msg-beg 'invisible) 'erc-match))
+ (should (>= (next-single-property-change msg-beg 'invisible nil)
+ (pos-eol)))))
+
+ (lambda ()
+ ;; This is a time-stamped message.
+ (should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
+ (should (get-text-property (pos-bol) 'invisible))
+
+ ;; The entire message proper is visible.
+ (let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
+ (should
+ (= (next-single-property-change msg-beg 'invisible nil (pos-eol))
+ (pos-eol))))))))
+
+(defun erc-scenarios-match--find-eol ()
+ (save-excursion
+ (goto-char (next-single-property-change (point) 'erc-command))
+ (pos-eol)))
+
+;; In most cases, `erc-hide-fools' makes line endings invisible.
+(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
+ :tags '(:expensive-test)
+ (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (let ((end (erc-scenarios-match--find-eol)))
+ ;; The end of the message is a newline.
+ (should (= ?\n (char-after end)))
+
+ ;; Every message has a trailing time stamp.
+ (should (eq (field-at-pos (1- end)) 'erc-timestamp))
+
+ ;; Stamps have a combined `invisible' property value.
+ (should (equal (get-text-property (1- end) 'invisible)
+ '(timestamp erc-match)))
+
+ ;; The final newline is hidden by `match', not `stamps'
+ (should (equal (get-text-property end 'invisible) 'erc-match))
+
+ ;; The message proper has the `invisible' property `erc-match',
+ ;; and it starts after the preceding newline.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
+
+ ;; It ends just before the timestamp.
+ (let ((msg-end (next-single-property-change (pos-bol) 'invisible)))
+ (should (equal (get-text-property msg-end 'invisible)
+ '(timestamp erc-match)))
+
+ ;; Stamp's `invisible' property extends throughout the stamp
+ ;; and ends before the trailing newline.
+ (should (= (next-single-property-change msg-end 'invisible) end)))))
+
+ (lambda ()
+ (let ((end (erc-scenarios-match--find-eol)))
+ ;; This message has a time stamp like all the others.
+ (should (eq (field-at-pos (1- end)) 'erc-timestamp))
+
+ ;; The entire message proper is visible.
+ (should-not (get-text-property (pos-bol) 'invisible))
+ (let ((inv-beg (next-single-property-change (pos-bol) 'invisible)))
+ (should (eq (get-text-property inv-beg 'invisible)
+ 'timestamp))))))))
+
+;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides
+;; the preceding message's line ending.
+(ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap ()
+ :tags '(:expensive-test)
+ (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)
+ (erc-fill-function #'erc-fill-wrap))
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ ;; Every message has a trailing time stamp.
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+
+ ;; Stamps appear in the right margin.
+ (should (equal (car (get-text-property (1- (pos-eol)) 'display))
+ '(margin right-margin)))
+
+ ;; Stamps have a combined `invisible' property value.
+ (should (equal (get-text-property (1- (pos-eol)) 'invisible)
+ '(timestamp erc-match)))
+
+ ;; The message proper has the `invisible' property `erc-match',
+ ;; which starts at the preceding newline...
+ (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match))
+
+ ;; ... and ends just before the timestamp.
+ (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible)))
+ (should (equal (get-text-property msgend 'invisible)
+ '(timestamp erc-match)))
+
+ ;; The newline before `erc-insert-marker' is still visible.
+ (should-not (get-text-property (pos-eol) 'invisible))
+ (should (= (next-single-property-change msgend 'invisible)
+ (pos-eol)))))
+
+ (lambda ()
+ ;; This message has a time stamp like all the others.
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+
+ ;; Unlike hidden messages, the preceding newline is visible.
+ (should-not (get-text-property (1- (pos-bol)) 'invisible))
+
+ ;; The entire message proper is visible.
+ (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
+ (should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
+
(eval-when-compile (require 'erc-join))
;;; erc-scenarios-match.el ends here
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (14 preceding siblings ...)
[not found] ` <87jzvny7ez.fsf@neverwas.me>
@ 2023-07-18 13:33 ` J.P.
[not found] ` <87msztl4xu.fsf@neverwas.me>
` (9 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-07-18 13:33 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1576 bytes --]
This feature initially included a small omission in its lack of support
for left-sided time stamps. Apparently, they're popular enough to
warrant the additional complexity. The attached patch attempts to add
that support as well as fix a few related bugs.
It currently introduces two options:
`erc-fill-wrap-margin-width'
`erc-fill-wrap-margin-side'
Both are nil by default, but the second must be customized for users who
define their own `erc-insert-timestamp-function'.
Note that this variant behaves a little differently with regard to the
prompt, which appears in the left margin via `display' properties. The
option `erc-fill-wrap-width' controls the margin's starting width, which
defaults to either stamp width or prompt width: whichever's wider on
MOTD. The prompt is padded on the left and truncated on the right if
need be to conform to the margin. This look may take some getting used
to, but I think most will agree that it's preferable to the alternative,
which would see the prompt floating in no man's land, between the margin
and the "static center," where speaker labels are right-aligned.
As with the right margin, the left can also be adjusted in-session with
the command `erc-fill-wrap-nudge' and the keys `)', `_', and `+'.
On a related note, I'm also proposing we remove the `margin' Custom
:type choice for the option `erc-timestamp-align-to' (new in 5.6). It
was only ever tangentially related and doesn't really do much, and it
only really existed to service the needs of the internal minor mode
`erc-stamp--display-margin-mode'.
Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Make-erc-fill-wrap-work-with-left-hand-stamps.patch --]
[-- Type: text/x-patch, Size: 37477 bytes --]
From 9760eb1d16503f173f6ea952c41e5efcb2010a61 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 14 Jul 2023 06:12:30 -0700
Subject: [PATCH] [5.6] Make erc-fill-wrap work with left-hand stamps
* etc/ERC-NEWS: Remove all mention of option `erc-timestamp-align-to'
supporting a value of `margin', which has been removed.
* lisp/erc/erc-backend.el (erc--reveal-prompt, erc--conceal-prompt):
New generic functions with default implementations factored out from
`erc--unhide-prompt' and `erc--hide-prompt'.
(erc--prompt-hidden-p): New internal predicate function.
(erc--unhide-prompt): Defer to `erc--reveal-prompt' and set
`erc-prompt' text property to t.
(erc--hide-prompt): Defer to `erc--conceal-prompt' and set
`erc-prompt' text property to `hidden'.
* lisp/erc/erc-compat.el (erc-compat--29-browse-url-irc): Add FIXME
comment for likely insufficient test of function equality.
* lisp/erc/erc-fill.el (erc-fill-wrap-margin-width,
erc-fill-wrap-margin-side): New options to control side and initial
width of `fill-wrap' margin.
(erc-fill--wrap-beginning-of-line): Fix bug involving non-string
valued `display' props.
(erc-fill-wrap-mode, erc-fill-wrap-enable): Update doc string, persist
a few local vars, and conditionally set `erc-stamp--margin-left-p'.
(erc-fill-wrap-nudge): Update doc string and account for left-hand
stamps.
(erc-timestamp-offset): Add comment regarding conditional guard based
on function-valued option.
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Remove value
variant `margin', which was originally intended to be new in ERC 5.6.
This functionality was all but useless without the internal minor mode
`erc-stamp--display-margin-mode' active.
(erc-stamp-right-margin-width): Remove unused option new in 5.6.
(erc-stamp--display-margin-force): Remove unused function.
(erc-stamp--margin-width, erc-stamp--margin-left-p): New internal var.
(erc-stamp--margin-left-p, erc-stamp--init-margins-on-connect): New
functions for other modules that use `erc-stamp--display-margin-mode'.
(erc-stamp--adjust-right-margin, erc-stamp--adjust-margin): Rename
function to latter and accommodate left-hand stamps.
(erc-stamp--inherited-props): Relocate from lower down in file.
(erc-stamp--display-margin-mode): Update function name, and adjust
setup and teardown to accommodate left-handed stamps. Don't add
advice around `erc-insert-timestamp-function'.
(erc-stamp--last-prompt, erc-stamp--display-prompt-in-left-margin):
New function and helper var to convert a normal inserted prompt so
that it appears in the left margin.
(erc-stamp--refresh-left-margin-prompt): Helper for other modules to
quickly refresh prompt outside of insert hooks.
(erc--reveal-prompt, erc--conceal-prompt): New implementations for
when `erc-stamp--display-margin-mode' is active.
(erc-insert-timestamp-left): Convert to defmethod and provide
implementation for `erc-stamp--display-margin-mode'.
(erc-insert-timestamp-right): Don't expect `erc-timestamp-align-to' to
ever be the symbol `margin'. Move handling for that case to one
contingent on the internal minor mode `erc-stamp--display-margin-mode'
being active.
* lisp/erc/erc.el (erc--refresh-prompt-hook): New variable.
(erc--refresh-prompt): Fix bug in which user-defined prompt functions
failed to hide when quitting in server buffers. Run new hook
`erc--refresh-prompt-hook'.
(erc-display-prompt): Add comment noting that the text property
`erc-prompt' now actually matters. It's t while a session is running
and `hidden' when disconnected.
* test/lisp/erc/erc-fill-tests.el (erc-fill--left-hand-stamps): New
test.
* test/lisp/erc/erc-stamp-tests.el
(erc-timestamp-use-align-to--margin,
erc-stamp--display-margin-mode--right): Rename test to latter.
* test/lisp/erc/erc-tests.el (erc-hide-prompt): Add some assertions
for new possible value of `erc-prompt' text property.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: New test
data file. (Bug#60936)
---
etc/ERC-NEWS | 7 +-
lisp/erc/erc-backend.el | 23 +-
lisp/erc/erc-compat.el | 1 +
lisp/erc/erc-fill.el | 76 +++++--
lisp/erc/erc-stamp.el | 199 +++++++++++++-----
lisp/erc/erc.el | 26 ++-
test/lisp/erc/erc-fill-tests.el | 37 ++++
test/lisp/erc/erc-stamp-tests.el | 2 +-
test/lisp/erc/erc-tests.el | 6 +
.../fill/snapshots/stamps-left-01.eld | 1 +
10 files changed, 281 insertions(+), 97 deletions(-)
create mode 100644 test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index cd0b8e5f823..379d5eb2ad0 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -102,11 +102,8 @@ side window. Hit '<RET>' over a nick to spawn a "/QUERY" or a
** The option 'erc-timestamp-use-align-to' is more versatile.
While this option has always offered to right-align stamps via the
'display' text property, it's now more effective at doing so when set
-to a number indicating an offset from the right edge. And when set to
-the symbol 'margin', it displays stamps in the right margin, although,
-at the moment, this is mostly intended for use by other modules, such
-as 'fill-wrap', described above. For both these variants, users of
-the 'log' module may want to customize 'erc-log-filter-function' to
+to a number indicating an offset from the right edge. Users of the
+'log' module may want to customize 'erc-log-filter-function' to
'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps
appearing in their saved logs.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 363509d17fa..eb3ec39fedd 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1045,13 +1045,25 @@ erc-process-sentinel-1
;; unexpected disconnect
(erc-process-sentinel-2 event buffer))))
+(cl-defmethod erc--reveal-prompt ()
+ (remove-text-properties erc-insert-marker erc-input-marker
+ '(display nil)))
+
+(cl-defmethod erc--conceal-prompt ()
+ (add-text-properties erc-insert-marker (1- erc-input-marker)
+ `(display ,erc-prompt-hidden)))
+
+(defun erc--prompt-hidden-p ()
+ (and (marker-position erc-insert-marker)
+ (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)))
+
(defun erc--unhide-prompt ()
(remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t)
(when (and (marker-position erc-insert-marker)
(marker-position erc-input-marker))
(with-silent-modifications
- (remove-text-properties erc-insert-marker erc-input-marker
- '(display nil)))))
+ (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t)
+ (erc--reveal-prompt))))
(defun erc--unhide-prompt-on-self-insert ()
(when (and (eq this-command #'self-insert-command)
@@ -1059,6 +1071,8 @@ erc--unhide-prompt-on-self-insert
(erc--unhide-prompt)))
(defun erc--hide-prompt (proc)
+ "Hide prompt in all buffers of server.
+Change value of property `erc-prompt' from t to `hidden'."
(erc-with-all-buffers-of-server proc nil
(when (and erc-hide-prompt
(or (eq erc-hide-prompt t)
@@ -1072,8 +1086,9 @@ erc--hide-prompt
(marker-position erc-input-marker)
(get-text-property erc-insert-marker 'erc-prompt))
(with-silent-modifications
- (add-text-properties erc-insert-marker (1- erc-input-marker)
- `(display ,erc-prompt-hidden)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'erc-prompt 'hidden)
+ (erc--conceal-prompt))
(add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t))))
(defun erc-process-sentinel (cproc event)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index f451aaee754..912a4bc576c 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -418,6 +418,7 @@ erc-compat--29-browse-url-irc
(require 'url-irc)
(let* ((url (url-generic-parse-url string))
(url-irc-function
+ ;; FIXME this should probably use `symbol-function'.
(if (function-equal url-irc-function 'url-irc-erc)
(lambda (host port chan user pass)
(erc-handle-irc-url host port chan user pass (url-type url)))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a65c95f1d85..99035b35011 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -116,6 +116,25 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
+(defcustom erc-fill-wrap-margin-width nil
+ "Starting width in columns of dedicated stamp margin.
+When nil, ERC normally pretends its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+However, when `erc-fill-wrap-margin-side' is `left' or
+\"resolves\" to `left', ERC uses the width of the prompt if it's
+wider on MOTD's end, which really only matters when `erc-prompt'
+is a function."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice nil integer))
+
+(defcustom erc-fill-wrap-margin-side nil
+ "Margin side to use with `erc-fill-wrap-mode'.
+A value of nil means ERC should decide based on
+`erc-insert-timestamp-function', which obviously cannot work for
+user-defined functions."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (choice nil) (const left) (const right)))
+
(defcustom erc-fill-line-spacing nil
"Extra space between messages on graphical displays.
This may need adjusting depending on how your faces are
@@ -253,9 +272,9 @@ erc-fill--wrap-beginning-of-line
(goto-char erc-input-marker)
;; Mimic what `move-beginning-of-line' does with invisible text.
(when-let ((erc-fill-wrap-merge)
- (empty (get-text-property (point) 'display))
- ((string-empty-p empty)))
- (goto-char (text-property-not-all (point) (pos-eol) 'display empty)))))
+ (prop (get-text-property (point) 'display))
+ ((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
+ (goto-char (text-property-not-all (point) (pos-eol) 'display prop)))))
(defun erc-fill--wrap-end-of-line (arg)
"Defer to `move-end-of-line' or `end-of-visual-line'."
@@ -319,21 +338,33 @@ fill-wrap
"Fill style leveraging `visual-line-mode'.
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 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. 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."
+depends on the `fill' and `button' modules and assumes users
+who've defined their own `erc-insert-timestamp-function' have
+also customized the option `erc-fill-wrap-margin-side' to an
+explicit side. To use this module, 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.
+
+When stamps appear in the right margin, which they do by default,
+users may find that ERC actually appends them to copy-as-killed
+messages without an intervening space. This normally poses at
+most a minor nuisance, however users of the `log' module may
+prefer a workaround provided by `erc-stamp-prefix-log-filter',
+which strips trailing stamps from logged messages and instead
+prepends them to every line."
((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)
+ erc-fill--wrap-value erc-fill-static-center
+ erc-stamp--margin-width erc-fill-wrap-margin-width
+ left-margin-width 0
+ right-margin-width 0)
+ ;; Only give this a local binding if known for sure.
+ (pcase erc-fill-wrap-margin-side
+ ('right (setq erc-stamp--margin-left-p nil))
+ ('left (setq erc-stamp--margin-left-p t)))
(setq erc-fill--function #'erc-fill-wrap)
- ;; Internal integrations.
(add-function :after (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
(when (or erc-stamp-mode (memq 'stamp erc-modules))
@@ -476,8 +507,8 @@ erc-fill-wrap-nudge
\\`=' Increase indentation by one column
\\`-' Decrease indentation by one column
\\`0' Reset indentation to the default
- \\`+' Shift right margin rightward (shrink) by one column
- \\`_' Shift right margin leftward (grow) by one column
+ \\`+' Shift margin boundary rightward by one column
+ \\`_' Shift margin boundary leftward by one column
\\`)' Reset the right margin to the default
Note that misalignment may occur when messages contain
@@ -507,14 +538,16 @@ erc-fill-wrap-nudge
(cl-incf total (erc-fill--wrap-nudge a))
(recenter (round (* win-ratio (window-height))))))))
(dolist (key '(?\) ?_ ?+))
- (let ((a (pcase key
- (?\) 0)
- (?_ (- (abs arg)))
- (?+ (abs arg)))))
+ (let* ((leftp erc-stamp--margin-left-p)
+ (a (pcase key
+ (?\) 0)
+ (?_ (if leftp (abs arg) (- (abs arg))))
+ (?+ (if leftp (- (abs arg)) (abs arg))))))
(define-key map (vector (list key))
(lambda ()
(interactive)
- (erc-stamp--adjust-right-margin (- a))
+ (erc-stamp--adjust-margin (- a) (zerop a))
+ (when leftp (erc-stamp--refresh-left-margin-prompt))
(recenter (round (* win-ratio (window-height))))))))
map)
t
@@ -536,6 +569,7 @@ erc-timestamp-offset
"Get length of timestamp if inserted left."
(if (and (boundp 'erc-timestamp-format)
erc-timestamp-format
+ ;; FIXME use a more robust test than symbol equivalence.
(eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
(not erc-hide-timestamps))
(length (format-time-string erc-timestamp-format))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 83ee4a200ed..727d334f13b 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -281,49 +281,67 @@ erc-timestamp-use-align-to
set to `erc-insert-timestamp-right' or that option's default,
`erc-insert-timestamp-left-and-right'. If the value is a
positive integer, alignment occurs that many columns from the
-right edge. If the value is `margin', the stamp appears in the
-right margin when visible.
+right edge.
Enabling this option produces a side effect in that stamps aren't
indented in saved logs. When its value is an integer, this
option adds a space after the end of a message if the stamp
doesn't already start with one. And when its value is t, it adds
-a single space, unconditionally. And while this option never
-adds a space when its value is `margin', ERC does offer a
-workaround in `erc-stamp-prefix-log-filter', which strips
-trailing stamps from messages and puts them before every line."
- :type '(choice boolean integer (const margin))
+a single space, unconditionally."
+ :type '(choice boolean integer)
:package-version '(ERC . "5.6")) ; FIXME sync on release
-(defcustom erc-stamp-right-margin-width nil
- "Width in columns of the right margin.
-When this option is nil, pretend its value is one column greater
-than the `string-width' of the formatted `erc-timestamp-format'.
-This option only matters when `erc-timestamp-use-align-to' is set
-to `margin'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
- :type '(choice (const nil) integer))
-
-(defun erc-stamp--display-margin-force (orig &rest r)
- (let ((erc-timestamp-use-align-to 'margin))
- (apply orig r)))
-
-(defun erc-stamp--adjust-right-margin (cols)
- "Adjust right margin by COLS.
-When COLS is zero, reset width to `erc-stamp-right-margin-width'
-or one col more than the `string-width' of
-`erc-timestamp-format'."
- (let ((width
- (if (zerop cols)
- (or erc-stamp-right-margin-width
- (1+ (string-width (or erc-timestamp-last-inserted-right
- (erc-format-timestamp
- (current-time)
- erc-timestamp-format)))))
- (+ right-margin-width cols))))
- (setq right-margin-width width)
+(defvar-local erc-stamp--margin-width nil
+ "Width in columns of margin for `erc-stamp--display-margin-mode'.
+Only consulted when resetting or initializing margin.")
+
+(defvar-local erc-stamp--margin-left-p nil
+ "Whether `erc-stamp--display-margin-mode' uses the left margin.
+During initialization, the mode respects this variable's existing
+value if it already has a local binding. Otherwise, modules can
+bind this to any value while enabling the mode. If it's nil, ERC
+will check to see if `erc-insert-timestamp-function' is
+`erc-insert-timestamp-left', interpreting the latter as a non-nil
+value. It'll then coerce any non-nil value to t.")
+
+(defun erc-stamp--margin-left-p (&optional value)
+ (and (or value
+ (function-equal (symbol-function (default-value
+ 'erc-insert-timestamp-function))
+ (symbol-function 'erc-insert-timestamp-left)))
+ t))
+
+(defun erc-stamp--init-margins-on-connect (&rest _)
+ (let ((existing (if erc-stamp--margin-left-p
+ left-margin-width
+ right-margin-width)))
+ (erc-stamp--adjust-margin existing 'resetp)))
+
+(defun erc-stamp--adjust-margin (cols &optional resetp)
+ "Adjust managed margin by increment COLS.
+With RESETP, set margin's width to COLS. However, if COLS is
+zero, set the width to a non-nil `erc-stamp--margin-width'.
+Otherwise, go with the `string-width' of `erc-timestamp-format'.
+However, when `erc-stamp--margin-left-p' is non-nil and the
+prompt is wider, use its width instead."
+ (let* ((leftp erc-stamp--margin-left-p)
+ (width
+ (if resetp
+ (or (and (not (zerop cols)) cols)
+ erc-stamp--margin-width
+ (max (if leftp (string-width (erc-prompt)) 0)
+ (1+ (string-width
+ (or (if leftp
+ erc-timestamp-last-inserted
+ erc-timestamp-last-inserted-right)
+ (erc-format-timestamp
+ (current-time) erc-timestamp-format))))))
+ (+ (if leftp left-margin-width right-margin-width) cols))))
+ (set (if leftp 'left-margin-width 'right-margin-width) width)
(when (eq (current-buffer) (window-buffer))
- (set-window-margins nil left-margin-width width))))
+ (set-window-margins nil
+ (if leftp width left-margin-width)
+ (if leftp right-margin-width width)))))
;;;###autoload
(defun erc-stamp-prefix-log-filter (text)
@@ -348,39 +366,97 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(declare-function erc--remove-text-properties "erc" (string))
-;; If people want to use this directly, we can convert it into
-;; a local module.
+;; If people want to use this directly, we can convert it into a local
+;; module. Also, `erc-insert-timestamp-right' hard codes its display
+;; property to use `right-margin', and `erc-insert-timestamp-left'
+;; does the same for `left-margin'. However, there's no reason a
+;; trailing stamp couldn't be displayed on the left and vice versa.
+;; Note: this adds advice that breaks `erc-timestamp-offset' because
+;; the thinking is there's no use case in which that function would be
+;; called while this mode is active. See note below for more.
(define-minor-mode erc-stamp--display-margin-mode
"Internal minor mode for built-in modules integrating with `stamp'.
-It binds `erc-timestamp-use-align-to' to `margin' around calls to
-`erc-insert-timestamp-function' in the current buffer, and sets
-the right window margin to `erc-stamp-right-margin-width'. It
-also arranges to remove most text properties when a user kills
-message text so that stamps will be visible when yanked."
+Manages chosen window margin and arranges to remove `display'
+text properties in killed text to reveal stamps."
:interactive nil
(if erc-stamp--display-margin-mode
(progn
(setq fringes-outside-margins t)
(when (eq (current-buffer) (window-buffer))
(set-window-buffer (selected-window) (current-buffer)))
- (erc-stamp--adjust-right-margin 0)
+ (unless (local-variable-p 'erc-stamp--margin-left-p)
+ (setq erc-stamp--margin-left-p
+ (erc-stamp--margin-left-p erc-stamp--margin-left-p)))
+ (if (or erc-server-connected (not (functionp erc-prompt)))
+ (erc-stamp--init-margins-on-connect)
+ (add-hook 'erc-after-connect
+ #'erc-stamp--init-margins-on-connect nil t))
(add-function :filter-return (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (add-function :around (local 'erc-insert-timestamp-function)
- #'erc-stamp--display-margin-force))
+ (when erc-stamp--margin-left-p
+ (add-hook 'erc--refresh-prompt-hook
+ #'erc-stamp--display-prompt-in-left-margin nil t)))
(remove-function (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (remove-function (local 'erc-insert-timestamp-function)
- #'erc-stamp--display-margin-force)
- (kill-local-variable 'right-margin-width)
+ (add-hook 'erc-after-connect #'erc-stamp--init-margins-on-connect t)
+ (remove-hook 'erc--refresh-prompt-hook
+ #'erc-stamp--display-prompt-in-left-margin t)
+ (kill-local-variable (if erc-stamp--margin-left-p
+ 'left-margin-width
+ 'right-margin-width))
(kill-local-variable 'fringes-outside-margins)
+ (kill-local-variable 'erc-stamp--margin-prompt-width)
+ (kill-local-variable 'erc-stamp--margin-left-p)
+ (kill-local-variable 'erc-stamp--margin-width)
(when (eq (current-buffer) (window-buffer))
(set-window-margins nil left-margin-width nil)
(set-window-buffer (selected-window) (current-buffer)))))
-(defun erc-insert-timestamp-left (string)
+(defvar-local erc-stamp--last-prompt nil)
+
+(defun erc-stamp--display-prompt-in-left-margin ()
+ "Show prompt in the left margin with padding."
+ (when (or (not erc-stamp--last-prompt) (functionp erc-prompt)
+ (> (string-width erc-stamp--last-prompt) left-margin-width))
+ (let ((s (buffer-substring erc-insert-marker (1- erc-input-marker))))
+ ;; Prevent #("abc" n m (display ((...) #("abc" p q (display...))))
+ (remove-text-properties 0 (length s) '(display nil) s)
+ (when (and erc-stamp--last-prompt
+ (>= (string-width erc-stamp--last-prompt) left-margin-width))
+ (let ((sm (truncate-string-to-width s (1- left-margin-width) 0 nil t)))
+ ;; This papers over a subtle off-by-1 bug here.
+ (unless (equal sm s)
+ (setq s (concat sm (substring s -1))))))
+ (setq erc-stamp--last-prompt (string-pad s left-margin-width nil t))))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,erc-stamp--last-prompt))
+ erc-stamp--last-prompt)
+
+(defun erc-stamp--refresh-left-margin-prompt ()
+ "Forcefully-recompute display property of prompt in left margin."
+ (with-silent-modifications
+ (unless (functionp erc-prompt)
+ (setq erc-stamp--last-prompt nil))
+ (erc--refresh-prompt)))
+
+(cl-defmethod erc--reveal-prompt
+ (&context (erc-stamp--display-margin-mode (eql t))
+ (erc-stamp--margin-left-p (eql t)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,erc-stamp--last-prompt)))
+
+(cl-defmethod erc--conceal-prompt
+ (&context (erc-stamp--display-margin-mode (eql t))
+ (erc-stamp--margin-left-p (eql t)))
+ (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,prompt))))
+
+(cl-defmethod erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
(goto-char (point-min))
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
@@ -392,6 +468,22 @@ erc-insert-timestamp-left
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
+(cl-defmethod erc-insert-timestamp-left
+ (string &context (erc-stamp--display-margin-mode (eql t)))
+ (unless (and erc-timestamp-only-if-changed-flag
+ (string-equal string erc-timestamp-last-inserted))
+ (goto-char (point-min))
+ (insert-before-markers-and-inherit
+ (setq erc-timestamp-last-inserted string))
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (point) p)))
+ (put-text-property (point-min) (point) p v)))
+ (erc-put-text-property (point-min) (point) 'invisible
+ erc-stamp--invisible-property)
+ (put-text-property (point-min) (point) 'field 'erc-timestamp)
+ (put-text-property (point-min) (point)
+ 'display `((margin left-margin) ,string))))
+
(defun erc-insert-aligned (string pos)
"Insert STRING at the POSth column.
@@ -408,8 +500,6 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
-
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -465,6 +555,9 @@ erc-insert-timestamp-right
;; For compatibility reasons, the `erc-timestamp' field includes
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
+ ((guard erc-stamp--display-margin-mode)
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string) string))
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
@@ -475,10 +568,6 @@ erc-insert-timestamp-right
(let ((s (+ erc-timestamp-use-align-to (string-width string))))
(put-text-property from (point) 'display
`(space :align-to (- right ,s)))))
- ('margin
- (put-text-property 0 (length string)
- 'display `((margin right-margin) ,string)
- string))
((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
(_ (indent-to pos)))
(insert string)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 03c21059a92..c90f20cc9a4 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2879,19 +2879,23 @@ erc--assert-input-bounds
(cl-assert (< erc-insert-marker erc-input-marker))
(cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
+(defvar erc--refresh-prompt-hook nil)
+
(defun erc--refresh-prompt ()
"Re-render ERC's prompt when the option `erc-prompt' is a function."
(erc--assert-input-bounds)
- (when (functionp erc-prompt)
- (save-excursion
- (goto-char erc-insert-marker)
- (set-marker-insertion-type erc-insert-marker nil)
- ;; Avoid `erc-prompt' (the named function), which appends a
- ;; space, and `erc-display-prompt', which propertizes all but
- ;; that space.
- (insert-and-inherit (funcall erc-prompt))
- (set-marker-insertion-type erc-insert-marker t)
- (delete-region (point) (1- erc-input-marker)))))
+ (unless (erc--prompt-hidden-p)
+ (when (functionp erc-prompt)
+ (save-excursion
+ (goto-char erc-insert-marker)
+ (set-marker-insertion-type erc-insert-marker nil)
+ ;; Avoid `erc-prompt' (the named function), which appends a
+ ;; space, and `erc-display-prompt', which propertizes all but
+ ;; that space.
+ (insert-and-inherit (funcall erc-prompt))
+ (set-marker-insertion-type erc-insert-marker t)
+ (delete-region (point) (1- erc-input-marker))))
+ (run-hooks 'erc--refresh-prompt-hook)))
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
@@ -4804,7 +4808,7 @@ erc-display-prompt
;; shall remain part of the prompt.
(setq prompt (propertize prompt
'rear-nonsticky t
- 'erc-prompt t
+ 'erc-prompt t ; t or `hidden'
'field 'erc-prompt
'front-sticky t
'read-only t))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 99ec4a9635e..67622da9f3d 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -340,4 +340,41 @@ erc-fill-wrap-visual-keys--prompt
(should (search-backward "ERC> " nil t))
(execute-kbd-macro "\C-a")))))
+(ert-deftest erc-fill--left-hand-stamps ()
+ :tags '(:unstable)
+ (unless (>= emacs-major-version 29)
+ (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-insert-timestamp-function #'erc-insert-timestamp-left))
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (should (= 8 left-margin-width))
+ (pcase-let ((`((margin left-margin) ,displayed)
+ (get-text-property erc-insert-marker 'display)))
+ (should (equal-including-properties
+ displayed #(" ERC>" 4 8
+ ( read-only t
+ front-sticky t
+ field erc-prompt
+ erc-prompt t
+ rear-nonsticky t
+ font-lock-face erc-prompt-face)))))
+ (erc-fill-tests--compare "stamps-left-01")
+
+ (ert-info ("Shrink left margin by 1 col")
+ (erc-stamp--adjust-margin -1)
+ (with-silent-modifications (erc--refresh-prompt))
+ (should (= 7 left-margin-width))
+ (pcase-let ((`((margin left-margin) ,displayed)
+ (get-text-property erc-insert-marker 'display)))
+ (should (equal-including-properties
+ displayed #(" ERC>" 3 7
+ ( read-only t
+ front-sticky t
+ field erc-prompt
+ erc-prompt t
+ rear-nonsticky t
+ font-lock-face erc-prompt-face))))))))))
+
;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 6da7ed4503d..f6de087a09a 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -140,7 +140,7 @@ erc-timestamp-use-align-to--integer
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
-(ert-deftest erc-timestamp-use-align-to--margin ()
+(ert-deftest erc-stamp--display-margin-mode--right ()
(erc-stamp-tests--insert-right
(lambda ()
(erc-stamp--display-margin-mode +1)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b5db5fe8764..fff3c4cb704 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -219,6 +219,7 @@ erc-hide-prompt
(setq erc-hide-prompt '(server))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(should (string= ">" (get-text-property erc-insert-marker 'display))))
(with-current-buffer "#chan"
@@ -229,6 +230,7 @@ erc-hide-prompt
(with-current-buffer "ServNet"
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: channel")
@@ -242,7 +244,9 @@ erc-hide-prompt
(with-current-buffer "#chan"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: query")
@@ -253,7 +257,9 @@ erc-hide-prompt
(with-current-buffer "bob"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
new file mode 100644
index 00000000000..f62b65cd170
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -0,0 +1 @@
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG))
\ No newline at end of file
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87msztl4xu.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87msztl4xu.fsf@neverwas.me>
@ 2023-07-18 13:55 ` J.P.
2023-07-19 13:15 ` J.P.
[not found] ` <87a5vsjb3q.fsf@neverwas.me>
2 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-07-18 13:55 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 91 bytes --]
Quick fixup (misc/test-custom-opts just caught some sloppiness in my
Custom :type specs).
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Make-erc-fill-wrap-work-with-left-hand-stamps.patch --]
[-- Type: text/x-patch, Size: 37484 bytes --]
From 828db2d91b0f47f8a758e3011bb3cbf817168564 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 14 Jul 2023 06:12:30 -0700
Subject: [PATCH] [5.6] Make erc-fill-wrap work with left-hand stamps
* etc/ERC-NEWS: Remove all mention of option `erc-timestamp-align-to'
supporting a value of `margin', which has been removed.
* lisp/erc/erc-backend.el (erc--reveal-prompt, erc--conceal-prompt):
New generic functions with default implementations factored out from
`erc--unhide-prompt' and `erc--hide-prompt'.
(erc--prompt-hidden-p): New internal predicate function.
(erc--unhide-prompt): Defer to `erc--reveal-prompt' and set
`erc-prompt' text property to t.
(erc--hide-prompt): Defer to `erc--conceal-prompt' and set
`erc-prompt' text property to `hidden'.
* lisp/erc/erc-compat.el (erc-compat--29-browse-url-irc): Add FIXME
comment for likely insufficient test of function equality.
* lisp/erc/erc-fill.el (erc-fill-wrap-margin-width,
erc-fill-wrap-margin-side): New options to control side and initial
width of `fill-wrap' margin.
(erc-fill--wrap-beginning-of-line): Fix bug involving non-string
valued `display' props.
(erc-fill-wrap-mode, erc-fill-wrap-enable): Update doc string, persist
a few local vars, and conditionally set `erc-stamp--margin-left-p'.
(erc-fill-wrap-nudge): Update doc string and account for left-hand
stamps.
(erc-timestamp-offset): Add comment regarding conditional guard based
on function-valued option.
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Remove value
variant `margin', which was originally intended to be new in ERC 5.6.
This functionality was all but useless without the internal minor mode
`erc-stamp--display-margin-mode' active.
(erc-stamp-right-margin-width): Remove unused option new in 5.6.
(erc-stamp--display-margin-force): Remove unused function.
(erc-stamp--margin-width, erc-stamp--margin-left-p): New internal var.
(erc-stamp--margin-left-p, erc-stamp--init-margins-on-connect): New
functions for other modules that use `erc-stamp--display-margin-mode'.
(erc-stamp--adjust-right-margin, erc-stamp--adjust-margin): Rename
function to latter and accommodate left-hand stamps.
(erc-stamp--inherited-props): Relocate from lower down in file.
(erc-stamp--display-margin-mode): Update function name, and adjust
setup and teardown to accommodate left-handed stamps. Don't add
advice around `erc-insert-timestamp-function'.
(erc-stamp--last-prompt, erc-stamp--display-prompt-in-left-margin):
New function and helper var to convert a normal inserted prompt so
that it appears in the left margin.
(erc-stamp--refresh-left-margin-prompt): Helper for other modules to
quickly refresh prompt outside of insert hooks.
(erc--reveal-prompt, erc--conceal-prompt): New implementations for
when `erc-stamp--display-margin-mode' is active.
(erc-insert-timestamp-left): Convert to defmethod and provide
implementation for `erc-stamp--display-margin-mode'.
(erc-insert-timestamp-right): Don't expect `erc-timestamp-align-to' to
ever be the symbol `margin'. Move handling for that case to one
contingent on the internal minor mode `erc-stamp--display-margin-mode'
being active.
* lisp/erc/erc.el (erc--refresh-prompt-hook): New variable.
(erc--refresh-prompt): Fix bug in which user-defined prompt functions
failed to hide when quitting in server buffers. Run new hook
`erc--refresh-prompt-hook'.
(erc-display-prompt): Add comment noting that the text property
`erc-prompt' now actually matters. It's t while a session is running
and `hidden' when disconnected.
* test/lisp/erc/erc-fill-tests.el (erc-fill--left-hand-stamps): New
test.
* test/lisp/erc/erc-stamp-tests.el
(erc-timestamp-use-align-to--margin,
erc-stamp--display-margin-mode--right): Rename test to latter.
* test/lisp/erc/erc-tests.el (erc-hide-prompt): Add some assertions
for new possible value of `erc-prompt' text property.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: New test
data file. (Bug#60936)
---
etc/ERC-NEWS | 7 +-
lisp/erc/erc-backend.el | 23 +-
lisp/erc/erc-compat.el | 1 +
lisp/erc/erc-fill.el | 76 +++++--
lisp/erc/erc-stamp.el | 199 +++++++++++++-----
lisp/erc/erc.el | 26 ++-
test/lisp/erc/erc-fill-tests.el | 37 ++++
test/lisp/erc/erc-stamp-tests.el | 2 +-
test/lisp/erc/erc-tests.el | 6 +
.../fill/snapshots/stamps-left-01.eld | 1 +
10 files changed, 281 insertions(+), 97 deletions(-)
create mode 100644 test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index cd0b8e5f823..379d5eb2ad0 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -102,11 +102,8 @@ side window. Hit '<RET>' over a nick to spawn a "/QUERY" or a
** The option 'erc-timestamp-use-align-to' is more versatile.
While this option has always offered to right-align stamps via the
'display' text property, it's now more effective at doing so when set
-to a number indicating an offset from the right edge. And when set to
-the symbol 'margin', it displays stamps in the right margin, although,
-at the moment, this is mostly intended for use by other modules, such
-as 'fill-wrap', described above. For both these variants, users of
-the 'log' module may want to customize 'erc-log-filter-function' to
+to a number indicating an offset from the right edge. Users of the
+'log' module may want to customize 'erc-log-filter-function' to
'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps
appearing in their saved logs.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 363509d17fa..eb3ec39fedd 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1045,13 +1045,25 @@ erc-process-sentinel-1
;; unexpected disconnect
(erc-process-sentinel-2 event buffer))))
+(cl-defmethod erc--reveal-prompt ()
+ (remove-text-properties erc-insert-marker erc-input-marker
+ '(display nil)))
+
+(cl-defmethod erc--conceal-prompt ()
+ (add-text-properties erc-insert-marker (1- erc-input-marker)
+ `(display ,erc-prompt-hidden)))
+
+(defun erc--prompt-hidden-p ()
+ (and (marker-position erc-insert-marker)
+ (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)))
+
(defun erc--unhide-prompt ()
(remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t)
(when (and (marker-position erc-insert-marker)
(marker-position erc-input-marker))
(with-silent-modifications
- (remove-text-properties erc-insert-marker erc-input-marker
- '(display nil)))))
+ (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t)
+ (erc--reveal-prompt))))
(defun erc--unhide-prompt-on-self-insert ()
(when (and (eq this-command #'self-insert-command)
@@ -1059,6 +1071,8 @@ erc--unhide-prompt-on-self-insert
(erc--unhide-prompt)))
(defun erc--hide-prompt (proc)
+ "Hide prompt in all buffers of server.
+Change value of property `erc-prompt' from t to `hidden'."
(erc-with-all-buffers-of-server proc nil
(when (and erc-hide-prompt
(or (eq erc-hide-prompt t)
@@ -1072,8 +1086,9 @@ erc--hide-prompt
(marker-position erc-input-marker)
(get-text-property erc-insert-marker 'erc-prompt))
(with-silent-modifications
- (add-text-properties erc-insert-marker (1- erc-input-marker)
- `(display ,erc-prompt-hidden)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'erc-prompt 'hidden)
+ (erc--conceal-prompt))
(add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t))))
(defun erc-process-sentinel (cproc event)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index f451aaee754..912a4bc576c 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -418,6 +418,7 @@ erc-compat--29-browse-url-irc
(require 'url-irc)
(let* ((url (url-generic-parse-url string))
(url-irc-function
+ ;; FIXME this should probably use `symbol-function'.
(if (function-equal url-irc-function 'url-irc-erc)
(lambda (host port chan user pass)
(erc-handle-irc-url host port chan user pass (url-type url)))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a65c95f1d85..9f39f41133d 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -116,6 +116,25 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
+(defcustom erc-fill-wrap-margin-width nil
+ "Starting width in columns of dedicated stamp margin.
+When nil, ERC normally pretends its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+However, when `erc-fill-wrap-margin-side' is `left' or
+\"resolves\" to `left', ERC uses the width of the prompt if it's
+wider on MOTD's end, which really only matters when `erc-prompt'
+is a function."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defcustom erc-fill-wrap-margin-side nil
+ "Margin side to use with `erc-fill-wrap-mode'.
+A value of nil means ERC should decide based on
+`erc-insert-timestamp-function', which obviously cannot work for
+user-defined functions."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) (const left) (const right)))
+
(defcustom erc-fill-line-spacing nil
"Extra space between messages on graphical displays.
This may need adjusting depending on how your faces are
@@ -253,9 +272,9 @@ erc-fill--wrap-beginning-of-line
(goto-char erc-input-marker)
;; Mimic what `move-beginning-of-line' does with invisible text.
(when-let ((erc-fill-wrap-merge)
- (empty (get-text-property (point) 'display))
- ((string-empty-p empty)))
- (goto-char (text-property-not-all (point) (pos-eol) 'display empty)))))
+ (prop (get-text-property (point) 'display))
+ ((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
+ (goto-char (text-property-not-all (point) (pos-eol) 'display prop)))))
(defun erc-fill--wrap-end-of-line (arg)
"Defer to `move-end-of-line' or `end-of-visual-line'."
@@ -319,21 +338,33 @@ fill-wrap
"Fill style leveraging `visual-line-mode'.
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 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. 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."
+depends on the `fill' and `button' modules and assumes users
+who've defined their own `erc-insert-timestamp-function' have
+also customized the option `erc-fill-wrap-margin-side' to an
+explicit side. To use this module, 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.
+
+When stamps appear in the right margin, which they do by default,
+users may find that ERC actually appends them to copy-as-killed
+messages without an intervening space. This normally poses at
+most a minor nuisance, however users of the `log' module may
+prefer a workaround provided by `erc-stamp-prefix-log-filter',
+which strips trailing stamps from logged messages and instead
+prepends them to every line."
((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)
+ erc-fill--wrap-value erc-fill-static-center
+ erc-stamp--margin-width erc-fill-wrap-margin-width
+ left-margin-width 0
+ right-margin-width 0)
+ ;; Only give this a local binding if known for sure.
+ (pcase erc-fill-wrap-margin-side
+ ('right (setq erc-stamp--margin-left-p nil))
+ ('left (setq erc-stamp--margin-left-p t)))
(setq erc-fill--function #'erc-fill-wrap)
- ;; Internal integrations.
(add-function :after (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
(when (or erc-stamp-mode (memq 'stamp erc-modules))
@@ -476,8 +507,8 @@ erc-fill-wrap-nudge
\\`=' Increase indentation by one column
\\`-' Decrease indentation by one column
\\`0' Reset indentation to the default
- \\`+' Shift right margin rightward (shrink) by one column
- \\`_' Shift right margin leftward (grow) by one column
+ \\`+' Shift margin boundary rightward by one column
+ \\`_' Shift margin boundary leftward by one column
\\`)' Reset the right margin to the default
Note that misalignment may occur when messages contain
@@ -507,14 +538,16 @@ erc-fill-wrap-nudge
(cl-incf total (erc-fill--wrap-nudge a))
(recenter (round (* win-ratio (window-height))))))))
(dolist (key '(?\) ?_ ?+))
- (let ((a (pcase key
- (?\) 0)
- (?_ (- (abs arg)))
- (?+ (abs arg)))))
+ (let* ((leftp erc-stamp--margin-left-p)
+ (a (pcase key
+ (?\) 0)
+ (?_ (if leftp (abs arg) (- (abs arg))))
+ (?+ (if leftp (- (abs arg)) (abs arg))))))
(define-key map (vector (list key))
(lambda ()
(interactive)
- (erc-stamp--adjust-right-margin (- a))
+ (erc-stamp--adjust-margin (- a) (zerop a))
+ (when leftp (erc-stamp--refresh-left-margin-prompt))
(recenter (round (* win-ratio (window-height))))))))
map)
t
@@ -536,6 +569,7 @@ erc-timestamp-offset
"Get length of timestamp if inserted left."
(if (and (boundp 'erc-timestamp-format)
erc-timestamp-format
+ ;; FIXME use a more robust test than symbol equivalence.
(eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
(not erc-hide-timestamps))
(length (format-time-string erc-timestamp-format))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 83ee4a200ed..727d334f13b 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -281,49 +281,67 @@ erc-timestamp-use-align-to
set to `erc-insert-timestamp-right' or that option's default,
`erc-insert-timestamp-left-and-right'. If the value is a
positive integer, alignment occurs that many columns from the
-right edge. If the value is `margin', the stamp appears in the
-right margin when visible.
+right edge.
Enabling this option produces a side effect in that stamps aren't
indented in saved logs. When its value is an integer, this
option adds a space after the end of a message if the stamp
doesn't already start with one. And when its value is t, it adds
-a single space, unconditionally. And while this option never
-adds a space when its value is `margin', ERC does offer a
-workaround in `erc-stamp-prefix-log-filter', which strips
-trailing stamps from messages and puts them before every line."
- :type '(choice boolean integer (const margin))
+a single space, unconditionally."
+ :type '(choice boolean integer)
:package-version '(ERC . "5.6")) ; FIXME sync on release
-(defcustom erc-stamp-right-margin-width nil
- "Width in columns of the right margin.
-When this option is nil, pretend its value is one column greater
-than the `string-width' of the formatted `erc-timestamp-format'.
-This option only matters when `erc-timestamp-use-align-to' is set
-to `margin'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
- :type '(choice (const nil) integer))
-
-(defun erc-stamp--display-margin-force (orig &rest r)
- (let ((erc-timestamp-use-align-to 'margin))
- (apply orig r)))
-
-(defun erc-stamp--adjust-right-margin (cols)
- "Adjust right margin by COLS.
-When COLS is zero, reset width to `erc-stamp-right-margin-width'
-or one col more than the `string-width' of
-`erc-timestamp-format'."
- (let ((width
- (if (zerop cols)
- (or erc-stamp-right-margin-width
- (1+ (string-width (or erc-timestamp-last-inserted-right
- (erc-format-timestamp
- (current-time)
- erc-timestamp-format)))))
- (+ right-margin-width cols))))
- (setq right-margin-width width)
+(defvar-local erc-stamp--margin-width nil
+ "Width in columns of margin for `erc-stamp--display-margin-mode'.
+Only consulted when resetting or initializing margin.")
+
+(defvar-local erc-stamp--margin-left-p nil
+ "Whether `erc-stamp--display-margin-mode' uses the left margin.
+During initialization, the mode respects this variable's existing
+value if it already has a local binding. Otherwise, modules can
+bind this to any value while enabling the mode. If it's nil, ERC
+will check to see if `erc-insert-timestamp-function' is
+`erc-insert-timestamp-left', interpreting the latter as a non-nil
+value. It'll then coerce any non-nil value to t.")
+
+(defun erc-stamp--margin-left-p (&optional value)
+ (and (or value
+ (function-equal (symbol-function (default-value
+ 'erc-insert-timestamp-function))
+ (symbol-function 'erc-insert-timestamp-left)))
+ t))
+
+(defun erc-stamp--init-margins-on-connect (&rest _)
+ (let ((existing (if erc-stamp--margin-left-p
+ left-margin-width
+ right-margin-width)))
+ (erc-stamp--adjust-margin existing 'resetp)))
+
+(defun erc-stamp--adjust-margin (cols &optional resetp)
+ "Adjust managed margin by increment COLS.
+With RESETP, set margin's width to COLS. However, if COLS is
+zero, set the width to a non-nil `erc-stamp--margin-width'.
+Otherwise, go with the `string-width' of `erc-timestamp-format'.
+However, when `erc-stamp--margin-left-p' is non-nil and the
+prompt is wider, use its width instead."
+ (let* ((leftp erc-stamp--margin-left-p)
+ (width
+ (if resetp
+ (or (and (not (zerop cols)) cols)
+ erc-stamp--margin-width
+ (max (if leftp (string-width (erc-prompt)) 0)
+ (1+ (string-width
+ (or (if leftp
+ erc-timestamp-last-inserted
+ erc-timestamp-last-inserted-right)
+ (erc-format-timestamp
+ (current-time) erc-timestamp-format))))))
+ (+ (if leftp left-margin-width right-margin-width) cols))))
+ (set (if leftp 'left-margin-width 'right-margin-width) width)
(when (eq (current-buffer) (window-buffer))
- (set-window-margins nil left-margin-width width))))
+ (set-window-margins nil
+ (if leftp width left-margin-width)
+ (if leftp right-margin-width width)))))
;;;###autoload
(defun erc-stamp-prefix-log-filter (text)
@@ -348,39 +366,97 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(declare-function erc--remove-text-properties "erc" (string))
-;; If people want to use this directly, we can convert it into
-;; a local module.
+;; If people want to use this directly, we can convert it into a local
+;; module. Also, `erc-insert-timestamp-right' hard codes its display
+;; property to use `right-margin', and `erc-insert-timestamp-left'
+;; does the same for `left-margin'. However, there's no reason a
+;; trailing stamp couldn't be displayed on the left and vice versa.
+;; Note: this adds advice that breaks `erc-timestamp-offset' because
+;; the thinking is there's no use case in which that function would be
+;; called while this mode is active. See note below for more.
(define-minor-mode erc-stamp--display-margin-mode
"Internal minor mode for built-in modules integrating with `stamp'.
-It binds `erc-timestamp-use-align-to' to `margin' around calls to
-`erc-insert-timestamp-function' in the current buffer, and sets
-the right window margin to `erc-stamp-right-margin-width'. It
-also arranges to remove most text properties when a user kills
-message text so that stamps will be visible when yanked."
+Manages chosen window margin and arranges to remove `display'
+text properties in killed text to reveal stamps."
:interactive nil
(if erc-stamp--display-margin-mode
(progn
(setq fringes-outside-margins t)
(when (eq (current-buffer) (window-buffer))
(set-window-buffer (selected-window) (current-buffer)))
- (erc-stamp--adjust-right-margin 0)
+ (unless (local-variable-p 'erc-stamp--margin-left-p)
+ (setq erc-stamp--margin-left-p
+ (erc-stamp--margin-left-p erc-stamp--margin-left-p)))
+ (if (or erc-server-connected (not (functionp erc-prompt)))
+ (erc-stamp--init-margins-on-connect)
+ (add-hook 'erc-after-connect
+ #'erc-stamp--init-margins-on-connect nil t))
(add-function :filter-return (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (add-function :around (local 'erc-insert-timestamp-function)
- #'erc-stamp--display-margin-force))
+ (when erc-stamp--margin-left-p
+ (add-hook 'erc--refresh-prompt-hook
+ #'erc-stamp--display-prompt-in-left-margin nil t)))
(remove-function (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (remove-function (local 'erc-insert-timestamp-function)
- #'erc-stamp--display-margin-force)
- (kill-local-variable 'right-margin-width)
+ (add-hook 'erc-after-connect #'erc-stamp--init-margins-on-connect t)
+ (remove-hook 'erc--refresh-prompt-hook
+ #'erc-stamp--display-prompt-in-left-margin t)
+ (kill-local-variable (if erc-stamp--margin-left-p
+ 'left-margin-width
+ 'right-margin-width))
(kill-local-variable 'fringes-outside-margins)
+ (kill-local-variable 'erc-stamp--margin-prompt-width)
+ (kill-local-variable 'erc-stamp--margin-left-p)
+ (kill-local-variable 'erc-stamp--margin-width)
(when (eq (current-buffer) (window-buffer))
(set-window-margins nil left-margin-width nil)
(set-window-buffer (selected-window) (current-buffer)))))
-(defun erc-insert-timestamp-left (string)
+(defvar-local erc-stamp--last-prompt nil)
+
+(defun erc-stamp--display-prompt-in-left-margin ()
+ "Show prompt in the left margin with padding."
+ (when (or (not erc-stamp--last-prompt) (functionp erc-prompt)
+ (> (string-width erc-stamp--last-prompt) left-margin-width))
+ (let ((s (buffer-substring erc-insert-marker (1- erc-input-marker))))
+ ;; Prevent #("abc" n m (display ((...) #("abc" p q (display...))))
+ (remove-text-properties 0 (length s) '(display nil) s)
+ (when (and erc-stamp--last-prompt
+ (>= (string-width erc-stamp--last-prompt) left-margin-width))
+ (let ((sm (truncate-string-to-width s (1- left-margin-width) 0 nil t)))
+ ;; This papers over a subtle off-by-1 bug here.
+ (unless (equal sm s)
+ (setq s (concat sm (substring s -1))))))
+ (setq erc-stamp--last-prompt (string-pad s left-margin-width nil t))))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,erc-stamp--last-prompt))
+ erc-stamp--last-prompt)
+
+(defun erc-stamp--refresh-left-margin-prompt ()
+ "Forcefully-recompute display property of prompt in left margin."
+ (with-silent-modifications
+ (unless (functionp erc-prompt)
+ (setq erc-stamp--last-prompt nil))
+ (erc--refresh-prompt)))
+
+(cl-defmethod erc--reveal-prompt
+ (&context (erc-stamp--display-margin-mode (eql t))
+ (erc-stamp--margin-left-p (eql t)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,erc-stamp--last-prompt)))
+
+(cl-defmethod erc--conceal-prompt
+ (&context (erc-stamp--display-margin-mode (eql t))
+ (erc-stamp--margin-left-p (eql t)))
+ (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,prompt))))
+
+(cl-defmethod erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
(goto-char (point-min))
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
@@ -392,6 +468,22 @@ erc-insert-timestamp-left
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
+(cl-defmethod erc-insert-timestamp-left
+ (string &context (erc-stamp--display-margin-mode (eql t)))
+ (unless (and erc-timestamp-only-if-changed-flag
+ (string-equal string erc-timestamp-last-inserted))
+ (goto-char (point-min))
+ (insert-before-markers-and-inherit
+ (setq erc-timestamp-last-inserted string))
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (point) p)))
+ (put-text-property (point-min) (point) p v)))
+ (erc-put-text-property (point-min) (point) 'invisible
+ erc-stamp--invisible-property)
+ (put-text-property (point-min) (point) 'field 'erc-timestamp)
+ (put-text-property (point-min) (point)
+ 'display `((margin left-margin) ,string))))
+
(defun erc-insert-aligned (string pos)
"Insert STRING at the POSth column.
@@ -408,8 +500,6 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
-
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -465,6 +555,9 @@ erc-insert-timestamp-right
;; For compatibility reasons, the `erc-timestamp' field includes
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
+ ((guard erc-stamp--display-margin-mode)
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string) string))
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
@@ -475,10 +568,6 @@ erc-insert-timestamp-right
(let ((s (+ erc-timestamp-use-align-to (string-width string))))
(put-text-property from (point) 'display
`(space :align-to (- right ,s)))))
- ('margin
- (put-text-property 0 (length string)
- 'display `((margin right-margin) ,string)
- string))
((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
(_ (indent-to pos)))
(insert string)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 03c21059a92..c90f20cc9a4 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2879,19 +2879,23 @@ erc--assert-input-bounds
(cl-assert (< erc-insert-marker erc-input-marker))
(cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
+(defvar erc--refresh-prompt-hook nil)
+
(defun erc--refresh-prompt ()
"Re-render ERC's prompt when the option `erc-prompt' is a function."
(erc--assert-input-bounds)
- (when (functionp erc-prompt)
- (save-excursion
- (goto-char erc-insert-marker)
- (set-marker-insertion-type erc-insert-marker nil)
- ;; Avoid `erc-prompt' (the named function), which appends a
- ;; space, and `erc-display-prompt', which propertizes all but
- ;; that space.
- (insert-and-inherit (funcall erc-prompt))
- (set-marker-insertion-type erc-insert-marker t)
- (delete-region (point) (1- erc-input-marker)))))
+ (unless (erc--prompt-hidden-p)
+ (when (functionp erc-prompt)
+ (save-excursion
+ (goto-char erc-insert-marker)
+ (set-marker-insertion-type erc-insert-marker nil)
+ ;; Avoid `erc-prompt' (the named function), which appends a
+ ;; space, and `erc-display-prompt', which propertizes all but
+ ;; that space.
+ (insert-and-inherit (funcall erc-prompt))
+ (set-marker-insertion-type erc-insert-marker t)
+ (delete-region (point) (1- erc-input-marker))))
+ (run-hooks 'erc--refresh-prompt-hook)))
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
@@ -4804,7 +4808,7 @@ erc-display-prompt
;; shall remain part of the prompt.
(setq prompt (propertize prompt
'rear-nonsticky t
- 'erc-prompt t
+ 'erc-prompt t ; t or `hidden'
'field 'erc-prompt
'front-sticky t
'read-only t))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 99ec4a9635e..67622da9f3d 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -340,4 +340,41 @@ erc-fill-wrap-visual-keys--prompt
(should (search-backward "ERC> " nil t))
(execute-kbd-macro "\C-a")))))
+(ert-deftest erc-fill--left-hand-stamps ()
+ :tags '(:unstable)
+ (unless (>= emacs-major-version 29)
+ (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-insert-timestamp-function #'erc-insert-timestamp-left))
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (should (= 8 left-margin-width))
+ (pcase-let ((`((margin left-margin) ,displayed)
+ (get-text-property erc-insert-marker 'display)))
+ (should (equal-including-properties
+ displayed #(" ERC>" 4 8
+ ( read-only t
+ front-sticky t
+ field erc-prompt
+ erc-prompt t
+ rear-nonsticky t
+ font-lock-face erc-prompt-face)))))
+ (erc-fill-tests--compare "stamps-left-01")
+
+ (ert-info ("Shrink left margin by 1 col")
+ (erc-stamp--adjust-margin -1)
+ (with-silent-modifications (erc--refresh-prompt))
+ (should (= 7 left-margin-width))
+ (pcase-let ((`((margin left-margin) ,displayed)
+ (get-text-property erc-insert-marker 'display)))
+ (should (equal-including-properties
+ displayed #(" ERC>" 3 7
+ ( read-only t
+ front-sticky t
+ field erc-prompt
+ erc-prompt t
+ rear-nonsticky t
+ font-lock-face erc-prompt-face))))))))))
+
;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 6da7ed4503d..f6de087a09a 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -140,7 +140,7 @@ erc-timestamp-use-align-to--integer
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
-(ert-deftest erc-timestamp-use-align-to--margin ()
+(ert-deftest erc-stamp--display-margin-mode--right ()
(erc-stamp-tests--insert-right
(lambda ()
(erc-stamp--display-margin-mode +1)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b5db5fe8764..fff3c4cb704 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -219,6 +219,7 @@ erc-hide-prompt
(setq erc-hide-prompt '(server))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(should (string= ">" (get-text-property erc-insert-marker 'display))))
(with-current-buffer "#chan"
@@ -229,6 +230,7 @@ erc-hide-prompt
(with-current-buffer "ServNet"
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: channel")
@@ -242,7 +244,9 @@ erc-hide-prompt
(with-current-buffer "#chan"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: query")
@@ -253,7 +257,9 @@ erc-hide-prompt
(with-current-buffer "bob"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
new file mode 100644
index 00000000000..f62b65cd170
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -0,0 +1 @@
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG))
\ No newline at end of file
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87msztl4xu.fsf@neverwas.me>
2023-07-18 13:55 ` J.P.
@ 2023-07-19 13:15 ` J.P.
[not found] ` <87a5vsjb3q.fsf@neverwas.me>
2 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-07-19 13:15 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 266 bytes --]
v2 (left-margin enhancement). Merge subsequent messages from a
status-prefixed speaker. Fix prompt not appearing in left margin on
/QUERY. Fix `visual-line-mode' not being restored after toggling off
`truncate-lines'. Have `erc-fill-wrap-nudge' print margin width.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 8159 bytes --]
From a6ad80553d5ef1d332de3a1e4bbdf85eaf36b1fc Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 19 Jul 2023 06:00:55 -0700
Subject: [PATCH 0/1] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (1):
[5.6] Make erc-fill-wrap work with left-hand stamps
etc/ERC-NEWS | 7 +-
lisp/erc/erc-backend.el | 23 +-
lisp/erc/erc-compat.el | 1 +
lisp/erc/erc-fill.el | 111 +++++++---
lisp/erc/erc-stamp.el | 203 +++++++++++++-----
lisp/erc/erc.el | 26 ++-
test/lisp/erc/erc-fill-tests.el | 37 ++++
test/lisp/erc/erc-stamp-tests.el | 2 +-
test/lisp/erc/erc-tests.el | 6 +
.../fill/snapshots/stamps-left-01.eld | 1 +
10 files changed, 313 insertions(+), 104 deletions(-)
create mode 100644 test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
Interdiff:
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 9f39f41133d..6c2228f6337 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -129,8 +129,8 @@ erc-fill-wrap-margin-width
(defcustom erc-fill-wrap-margin-side nil
"Margin side to use with `erc-fill-wrap-mode'.
-A value of nil means ERC should decide based on
-`erc-insert-timestamp-function', which obviously cannot work for
+A value of nil means ERC should decide based on the value of
+`erc-insert-timestamp-function', which does not work for
user-defined functions."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) (const left) (const right)))
@@ -297,12 +297,29 @@ erc-fill-wrap-cycle-visual-movement
('non-input nil))))
(message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys))
+(defun erc-fill-wrap-toggle-truncate-lines (arg)
+ "Toggle `truncate-lines' and maybe reinstate `visual-line-mode'."
+ (interactive "P")
+ (let ((wantp (if arg
+ (natnump (prefix-numeric-value arg))
+ (not truncate-lines)))
+ (buffer (current-buffer)))
+ (if wantp
+ (setq truncate-lines t)
+ (walk-windows (lambda (window)
+ (when (eq buffer (window-buffer window))
+ (set-window-hscroll window 0)))
+ nil t)
+ (visual-line-mode +1)))
+ (force-mode-line-update))
+
(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
:doc "Keymap for ERC's `fill-wrap' module."
:parent visual-line-mode-map
"<remap> <kill-line>" #'erc-fill--wrap-kill-line
"<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
"<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "<remap> <toggle-truncate-lines>" #'erc-fill-wrap-toggle-truncate-lines
"C-c a" #'erc-fill-wrap-cycle-visual-movement
;; Not sure if this is problematic because `erc-bol' takes no args.
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
@@ -361,9 +378,9 @@ fill-wrap
left-margin-width 0
right-margin-width 0)
;; Only give this a local binding if known for sure.
- (pcase erc-fill-wrap-margin-side
- ('right (setq erc-stamp--margin-left-p nil))
- ('left (setq erc-stamp--margin-left-p t)))
+ (when erc-fill-wrap-margin-side
+ (setq erc-stamp--margin-left-p
+ (pcase erc-fill-wrap-margin-side ('right nil) ('left t))))
(setq erc-fill--function #'erc-fill-wrap)
(add-function :after (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
@@ -412,18 +429,21 @@ erc-fill--wrap-continued-message-p
(widen)
(when (eq 'erc-timestamp (field-at-pos m))
(set-marker m (field-end m)))
- (and (eq 'PRIVMSG (get-text-property m 'erc-command))
- (not (eq (get-text-property m 'erc-ctcp) 'ACTION))
- (cons (get-text-property m 'erc-timestamp)
- (get-text-property (1+ m) 'erc-data)))))
+ (and-let*
+ (((eq 'PRIVMSG (get-text-property m 'erc-command)))
+ ((not (eq (get-text-property m 'erc-ctcp)
+ 'ACTION)))
+ (spr (next-single-property-change m 'erc-speaker)))
+ (cons (get-text-property m 'erc-timestamp)
+ (get-text-property spr 'erc-speaker)))))
(ts (pop props))
((not (time-less-p (erc-stamp--current-time) ts)))
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
- (nick (buffer-substring-no-properties
- (1+ (point-min)) (- (point) 2)))
+ (speaker (next-single-property-change (point-min) 'erc-speaker))
+ (nick (get-text-property speaker 'erc-speaker))
(props)
- ((erc-nick-equal-p (car props) nick))))
+ ((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
@@ -520,6 +540,7 @@ erc-fill-wrap-nudge
(unless (get-buffer-window)
(user-error "Command called in an undisplayed buffer"))
(let* ((total (erc-fill--wrap-nudge arg))
+ (leftp erc-stamp--margin-left-p)
(win-ratio (/ (float (- (window-point) (window-start)))
(- (window-end nil t) (window-start)))))
(when (zerop arg)
@@ -538,11 +559,10 @@ erc-fill-wrap-nudge
(cl-incf total (erc-fill--wrap-nudge a))
(recenter (round (* win-ratio (window-height))))))))
(dolist (key '(?\) ?_ ?+))
- (let* ((leftp erc-stamp--margin-left-p)
- (a (pcase key
- (?\) 0)
- (?_ (if leftp (abs arg) (- (abs arg))))
- (?+ (if leftp (- (abs arg)) (abs arg))))))
+ (let ((a (pcase key
+ (?\) 0)
+ (?_ (if leftp (abs arg) (- (abs arg))))
+ (?+ (if leftp (- (abs arg)) (abs arg))))))
(define-key map (vector (list key))
(lambda ()
(interactive)
@@ -552,8 +572,9 @@ erc-fill-wrap-nudge
map)
t
(lambda ()
- (message "Fill prefix: %d (%+d col%s)"
- erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ (message "Fill prefix: %d (%+d col%s); Margin: %d"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")
+ (if leftp left-margin-width right-margin-width)))
"Use %k for further adjustment"
1)
(recenter (round (* win-ratio (window-height))))))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 727d334f13b..eff99766d81 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -397,6 +397,8 @@ erc-stamp--display-margin-mode
#'erc-stamp--init-margins-on-connect nil t))
(add-function :filter-return (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
+ (add-hook 'erc--setup-buffer-hook
+ #'erc-stamp--refresh-left-margin-prompt nil t)
(when erc-stamp--margin-left-p
(add-hook 'erc--refresh-prompt-hook
#'erc-stamp--display-prompt-in-left-margin nil t)))
@@ -405,6 +407,8 @@ erc-stamp--display-margin-mode
(add-hook 'erc-after-connect #'erc-stamp--init-margins-on-connect t)
(remove-hook 'erc--refresh-prompt-hook
#'erc-stamp--display-prompt-in-left-margin t)
+ (remove-hook 'erc--setup-buffer-hook
+ #'erc-stamp--refresh-left-margin-prompt t)
(kill-local-variable (if erc-stamp--margin-left-p
'left-margin-width
'right-margin-width))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Make-erc-fill-wrap-work-with-left-hand-stamps.patch --]
[-- Type: text/x-patch, Size: 41530 bytes --]
From a6ad80553d5ef1d332de3a1e4bbdf85eaf36b1fc Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 14 Jul 2023 06:12:30 -0700
Subject: [PATCH 1/1] [5.6] Make erc-fill-wrap work with left-hand stamps
* etc/ERC-NEWS: Remove all mention of option `erc-timestamp-align-to'
supporting a value of `margin', which has been removed.
* lisp/erc/erc-backend.el (erc--reveal-prompt, erc--conceal-prompt):
New generic functions with default implementations factored out from
`erc--unhide-prompt' and `erc--hide-prompt'.
(erc--prompt-hidden-p): New internal predicate function.
(erc--unhide-prompt): Defer to `erc--reveal-prompt' and set
`erc-prompt' text property to t.
(erc--hide-prompt): Defer to `erc--conceal-prompt' and set
`erc-prompt' text property to `hidden'.
* lisp/erc/erc-compat.el (erc-compat--29-browse-url-irc): Add FIXME
comment for likely insufficient test of function equality.
* lisp/erc/erc-fill.el (erc-fill-wrap-margin-width,
erc-fill-wrap-margin-side): New options to control side and initial
width of `fill-wrap' margin.
(erc-fill--wrap-beginning-of-line): Fix bug involving non-string
valued `display' props.
(erc-fill-wrap-toggle-truncate-lines): New command to re-enable
`visual-line-mode' when toggling off `truncate-lines'.
(erc-fill-wrap-mode, erc-fill-wrap-enable): Update doc string, persist
a few local vars, and conditionally set `erc-stamp--margin-left-p'.
(erc-fill-wrap-nudge): Update doc string and account for left-hand
stamps.
(erc-timestamp-offset): Add comment regarding conditional guard based
on function-valued option.
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Remove value
variant `margin', which was originally intended to be new in ERC 5.6.
This functionality was all but useless without the internal minor mode
`erc-stamp--display-margin-mode' active.
(erc-stamp-right-margin-width): Remove unused option new in 5.6.
(erc-stamp--display-margin-force): Remove unused function.
(erc-stamp--margin-width, erc-stamp--margin-left-p): New internal var.
(erc-stamp--margin-left-p, erc-stamp--init-margins-on-connect): New
functions for other modules that use `erc-stamp--display-margin-mode'.
(erc-stamp--adjust-right-margin, erc-stamp--adjust-margin): Rename
function to latter and accommodate left-hand stamps.
(erc-stamp--inherited-props): Relocate from lower down in file.
(erc-stamp--display-margin-mode): Update function name, and adjust
setup and teardown to accommodate left-handed stamps. Don't add
advice around `erc-insert-timestamp-function'.
(erc-stamp--last-prompt, erc-stamp--display-prompt-in-left-margin):
New function and helper var to convert a normal inserted prompt so
that it appears in the left margin.
(erc-stamp--refresh-left-margin-prompt): Helper for other modules to
quickly refresh prompt outside of insert hooks.
(erc--reveal-prompt, erc--conceal-prompt): New implementations for
when `erc-stamp--display-margin-mode' is active.
(erc-insert-timestamp-left): Convert to defmethod and provide
implementation for `erc-stamp--display-margin-mode'.
(erc-insert-timestamp-right): Don't expect `erc-timestamp-align-to' to
ever be the symbol `margin'. Move handling for that case to one
contingent on the internal minor mode `erc-stamp--display-margin-mode'
being active.
* lisp/erc/erc.el (erc--refresh-prompt-hook): New variable.
(erc--refresh-prompt): Fix bug in which user-defined prompt functions
failed to hide when quitting in server buffers. Run new hook
`erc--refresh-prompt-hook'.
(erc-display-prompt): Add comment noting that the text property
`erc-prompt' now actually matters. It's t while a session is running
and `hidden' when disconnected.
* test/lisp/erc/erc-fill-tests.el (erc-fill--left-hand-stamps): New
test.
* test/lisp/erc/erc-stamp-tests.el
(erc-timestamp-use-align-to--margin,
erc-stamp--display-margin-mode--right): Rename test to latter.
* test/lisp/erc/erc-tests.el (erc-hide-prompt): Add some assertions
for new possible value of `erc-prompt' text property.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: New test
data file. (Bug#60936)
---
etc/ERC-NEWS | 7 +-
lisp/erc/erc-backend.el | 23 +-
lisp/erc/erc-compat.el | 1 +
lisp/erc/erc-fill.el | 111 +++++++---
lisp/erc/erc-stamp.el | 203 +++++++++++++-----
lisp/erc/erc.el | 26 ++-
test/lisp/erc/erc-fill-tests.el | 37 ++++
test/lisp/erc/erc-stamp-tests.el | 2 +-
test/lisp/erc/erc-tests.el | 6 +
.../fill/snapshots/stamps-left-01.eld | 1 +
10 files changed, 313 insertions(+), 104 deletions(-)
create mode 100644 test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index cd0b8e5f823..379d5eb2ad0 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -102,11 +102,8 @@ side window. Hit '<RET>' over a nick to spawn a "/QUERY" or a
** The option 'erc-timestamp-use-align-to' is more versatile.
While this option has always offered to right-align stamps via the
'display' text property, it's now more effective at doing so when set
-to a number indicating an offset from the right edge. And when set to
-the symbol 'margin', it displays stamps in the right margin, although,
-at the moment, this is mostly intended for use by other modules, such
-as 'fill-wrap', described above. For both these variants, users of
-the 'log' module may want to customize 'erc-log-filter-function' to
+to a number indicating an offset from the right edge. Users of the
+'log' module may want to customize 'erc-log-filter-function' to
'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps
appearing in their saved logs.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 363509d17fa..eb3ec39fedd 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1045,13 +1045,25 @@ erc-process-sentinel-1
;; unexpected disconnect
(erc-process-sentinel-2 event buffer))))
+(cl-defmethod erc--reveal-prompt ()
+ (remove-text-properties erc-insert-marker erc-input-marker
+ '(display nil)))
+
+(cl-defmethod erc--conceal-prompt ()
+ (add-text-properties erc-insert-marker (1- erc-input-marker)
+ `(display ,erc-prompt-hidden)))
+
+(defun erc--prompt-hidden-p ()
+ (and (marker-position erc-insert-marker)
+ (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)))
+
(defun erc--unhide-prompt ()
(remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t)
(when (and (marker-position erc-insert-marker)
(marker-position erc-input-marker))
(with-silent-modifications
- (remove-text-properties erc-insert-marker erc-input-marker
- '(display nil)))))
+ (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t)
+ (erc--reveal-prompt))))
(defun erc--unhide-prompt-on-self-insert ()
(when (and (eq this-command #'self-insert-command)
@@ -1059,6 +1071,8 @@ erc--unhide-prompt-on-self-insert
(erc--unhide-prompt)))
(defun erc--hide-prompt (proc)
+ "Hide prompt in all buffers of server.
+Change value of property `erc-prompt' from t to `hidden'."
(erc-with-all-buffers-of-server proc nil
(when (and erc-hide-prompt
(or (eq erc-hide-prompt t)
@@ -1072,8 +1086,9 @@ erc--hide-prompt
(marker-position erc-input-marker)
(get-text-property erc-insert-marker 'erc-prompt))
(with-silent-modifications
- (add-text-properties erc-insert-marker (1- erc-input-marker)
- `(display ,erc-prompt-hidden)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'erc-prompt 'hidden)
+ (erc--conceal-prompt))
(add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t))))
(defun erc-process-sentinel (cproc event)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index f451aaee754..912a4bc576c 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -418,6 +418,7 @@ erc-compat--29-browse-url-irc
(require 'url-irc)
(let* ((url (url-generic-parse-url string))
(url-irc-function
+ ;; FIXME this should probably use `symbol-function'.
(if (function-equal url-irc-function 'url-irc-erc)
(lambda (host port chan user pass)
(erc-handle-irc-url host port chan user pass (url-type url)))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a65c95f1d85..6c2228f6337 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -116,6 +116,25 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
+(defcustom erc-fill-wrap-margin-width nil
+ "Starting width in columns of dedicated stamp margin.
+When nil, ERC normally pretends its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+However, when `erc-fill-wrap-margin-side' is `left' or
+\"resolves\" to `left', ERC uses the width of the prompt if it's
+wider on MOTD's end, which really only matters when `erc-prompt'
+is a function."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defcustom erc-fill-wrap-margin-side nil
+ "Margin side to use with `erc-fill-wrap-mode'.
+A value of nil means ERC should decide based on the value of
+`erc-insert-timestamp-function', which does not work for
+user-defined functions."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) (const left) (const right)))
+
(defcustom erc-fill-line-spacing nil
"Extra space between messages on graphical displays.
This may need adjusting depending on how your faces are
@@ -253,9 +272,9 @@ erc-fill--wrap-beginning-of-line
(goto-char erc-input-marker)
;; Mimic what `move-beginning-of-line' does with invisible text.
(when-let ((erc-fill-wrap-merge)
- (empty (get-text-property (point) 'display))
- ((string-empty-p empty)))
- (goto-char (text-property-not-all (point) (pos-eol) 'display empty)))))
+ (prop (get-text-property (point) 'display))
+ ((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
+ (goto-char (text-property-not-all (point) (pos-eol) 'display prop)))))
(defun erc-fill--wrap-end-of-line (arg)
"Defer to `move-end-of-line' or `end-of-visual-line'."
@@ -278,12 +297,29 @@ erc-fill-wrap-cycle-visual-movement
('non-input nil))))
(message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys))
+(defun erc-fill-wrap-toggle-truncate-lines (arg)
+ "Toggle `truncate-lines' and maybe reinstate `visual-line-mode'."
+ (interactive "P")
+ (let ((wantp (if arg
+ (natnump (prefix-numeric-value arg))
+ (not truncate-lines)))
+ (buffer (current-buffer)))
+ (if wantp
+ (setq truncate-lines t)
+ (walk-windows (lambda (window)
+ (when (eq buffer (window-buffer window))
+ (set-window-hscroll window 0)))
+ nil t)
+ (visual-line-mode +1)))
+ (force-mode-line-update))
+
(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
:doc "Keymap for ERC's `fill-wrap' module."
:parent visual-line-mode-map
"<remap> <kill-line>" #'erc-fill--wrap-kill-line
"<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
"<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "<remap> <toggle-truncate-lines>" #'erc-fill-wrap-toggle-truncate-lines
"C-c a" #'erc-fill-wrap-cycle-visual-movement
;; Not sure if this is problematic because `erc-bol' takes no args.
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
@@ -319,21 +355,33 @@ fill-wrap
"Fill style leveraging `visual-line-mode'.
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 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. 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."
+depends on the `fill' and `button' modules and assumes users
+who've defined their own `erc-insert-timestamp-function' have
+also customized the option `erc-fill-wrap-margin-side' to an
+explicit side. To use this module, 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.
+
+When stamps appear in the right margin, which they do by default,
+users may find that ERC actually appends them to copy-as-killed
+messages without an intervening space. This normally poses at
+most a minor nuisance, however users of the `log' module may
+prefer a workaround provided by `erc-stamp-prefix-log-filter',
+which strips trailing stamps from logged messages and instead
+prepends them to every line."
((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)
+ erc-fill--wrap-value erc-fill-static-center
+ erc-stamp--margin-width erc-fill-wrap-margin-width
+ left-margin-width 0
+ right-margin-width 0)
+ ;; Only give this a local binding if known for sure.
+ (when erc-fill-wrap-margin-side
+ (setq erc-stamp--margin-left-p
+ (pcase erc-fill-wrap-margin-side ('right nil) ('left t))))
(setq erc-fill--function #'erc-fill-wrap)
- ;; Internal integrations.
(add-function :after (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
(when (or erc-stamp-mode (memq 'stamp erc-modules))
@@ -381,18 +429,21 @@ erc-fill--wrap-continued-message-p
(widen)
(when (eq 'erc-timestamp (field-at-pos m))
(set-marker m (field-end m)))
- (and (eq 'PRIVMSG (get-text-property m 'erc-command))
- (not (eq (get-text-property m 'erc-ctcp) 'ACTION))
- (cons (get-text-property m 'erc-timestamp)
- (get-text-property (1+ m) 'erc-data)))))
+ (and-let*
+ (((eq 'PRIVMSG (get-text-property m 'erc-command)))
+ ((not (eq (get-text-property m 'erc-ctcp)
+ 'ACTION)))
+ (spr (next-single-property-change m 'erc-speaker)))
+ (cons (get-text-property m 'erc-timestamp)
+ (get-text-property spr 'erc-speaker)))))
(ts (pop props))
((not (time-less-p (erc-stamp--current-time) ts)))
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
- (nick (buffer-substring-no-properties
- (1+ (point-min)) (- (point) 2)))
+ (speaker (next-single-property-change (point-min) 'erc-speaker))
+ (nick (get-text-property speaker 'erc-speaker))
(props)
- ((erc-nick-equal-p (car props) nick))))
+ ((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
@@ -476,8 +527,8 @@ erc-fill-wrap-nudge
\\`=' Increase indentation by one column
\\`-' Decrease indentation by one column
\\`0' Reset indentation to the default
- \\`+' Shift right margin rightward (shrink) by one column
- \\`_' Shift right margin leftward (grow) by one column
+ \\`+' Shift margin boundary rightward by one column
+ \\`_' Shift margin boundary leftward by one column
\\`)' Reset the right margin to the default
Note that misalignment may occur when messages contain
@@ -489,6 +540,7 @@ erc-fill-wrap-nudge
(unless (get-buffer-window)
(user-error "Command called in an undisplayed buffer"))
(let* ((total (erc-fill--wrap-nudge arg))
+ (leftp erc-stamp--margin-left-p)
(win-ratio (/ (float (- (window-point) (window-start)))
(- (window-end nil t) (window-start)))))
(when (zerop arg)
@@ -509,18 +561,20 @@ erc-fill-wrap-nudge
(dolist (key '(?\) ?_ ?+))
(let ((a (pcase key
(?\) 0)
- (?_ (- (abs arg)))
- (?+ (abs arg)))))
+ (?_ (if leftp (abs arg) (- (abs arg))))
+ (?+ (if leftp (- (abs arg)) (abs arg))))))
(define-key map (vector (list key))
(lambda ()
(interactive)
- (erc-stamp--adjust-right-margin (- a))
+ (erc-stamp--adjust-margin (- a) (zerop a))
+ (when leftp (erc-stamp--refresh-left-margin-prompt))
(recenter (round (* win-ratio (window-height))))))))
map)
t
(lambda ()
- (message "Fill prefix: %d (%+d col%s)"
- erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ (message "Fill prefix: %d (%+d col%s); Margin: %d"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")
+ (if leftp left-margin-width right-margin-width)))
"Use %k for further adjustment"
1)
(recenter (round (* win-ratio (window-height))))))
@@ -536,6 +590,7 @@ erc-timestamp-offset
"Get length of timestamp if inserted left."
(if (and (boundp 'erc-timestamp-format)
erc-timestamp-format
+ ;; FIXME use a more robust test than symbol equivalence.
(eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
(not erc-hide-timestamps))
(length (format-time-string erc-timestamp-format))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 83ee4a200ed..eff99766d81 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -281,49 +281,67 @@ erc-timestamp-use-align-to
set to `erc-insert-timestamp-right' or that option's default,
`erc-insert-timestamp-left-and-right'. If the value is a
positive integer, alignment occurs that many columns from the
-right edge. If the value is `margin', the stamp appears in the
-right margin when visible.
+right edge.
Enabling this option produces a side effect in that stamps aren't
indented in saved logs. When its value is an integer, this
option adds a space after the end of a message if the stamp
doesn't already start with one. And when its value is t, it adds
-a single space, unconditionally. And while this option never
-adds a space when its value is `margin', ERC does offer a
-workaround in `erc-stamp-prefix-log-filter', which strips
-trailing stamps from messages and puts them before every line."
- :type '(choice boolean integer (const margin))
+a single space, unconditionally."
+ :type '(choice boolean integer)
:package-version '(ERC . "5.6")) ; FIXME sync on release
-(defcustom erc-stamp-right-margin-width nil
- "Width in columns of the right margin.
-When this option is nil, pretend its value is one column greater
-than the `string-width' of the formatted `erc-timestamp-format'.
-This option only matters when `erc-timestamp-use-align-to' is set
-to `margin'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
- :type '(choice (const nil) integer))
-
-(defun erc-stamp--display-margin-force (orig &rest r)
- (let ((erc-timestamp-use-align-to 'margin))
- (apply orig r)))
-
-(defun erc-stamp--adjust-right-margin (cols)
- "Adjust right margin by COLS.
-When COLS is zero, reset width to `erc-stamp-right-margin-width'
-or one col more than the `string-width' of
-`erc-timestamp-format'."
- (let ((width
- (if (zerop cols)
- (or erc-stamp-right-margin-width
- (1+ (string-width (or erc-timestamp-last-inserted-right
- (erc-format-timestamp
- (current-time)
- erc-timestamp-format)))))
- (+ right-margin-width cols))))
- (setq right-margin-width width)
+(defvar-local erc-stamp--margin-width nil
+ "Width in columns of margin for `erc-stamp--display-margin-mode'.
+Only consulted when resetting or initializing margin.")
+
+(defvar-local erc-stamp--margin-left-p nil
+ "Whether `erc-stamp--display-margin-mode' uses the left margin.
+During initialization, the mode respects this variable's existing
+value if it already has a local binding. Otherwise, modules can
+bind this to any value while enabling the mode. If it's nil, ERC
+will check to see if `erc-insert-timestamp-function' is
+`erc-insert-timestamp-left', interpreting the latter as a non-nil
+value. It'll then coerce any non-nil value to t.")
+
+(defun erc-stamp--margin-left-p (&optional value)
+ (and (or value
+ (function-equal (symbol-function (default-value
+ 'erc-insert-timestamp-function))
+ (symbol-function 'erc-insert-timestamp-left)))
+ t))
+
+(defun erc-stamp--init-margins-on-connect (&rest _)
+ (let ((existing (if erc-stamp--margin-left-p
+ left-margin-width
+ right-margin-width)))
+ (erc-stamp--adjust-margin existing 'resetp)))
+
+(defun erc-stamp--adjust-margin (cols &optional resetp)
+ "Adjust managed margin by increment COLS.
+With RESETP, set margin's width to COLS. However, if COLS is
+zero, set the width to a non-nil `erc-stamp--margin-width'.
+Otherwise, go with the `string-width' of `erc-timestamp-format'.
+However, when `erc-stamp--margin-left-p' is non-nil and the
+prompt is wider, use its width instead."
+ (let* ((leftp erc-stamp--margin-left-p)
+ (width
+ (if resetp
+ (or (and (not (zerop cols)) cols)
+ erc-stamp--margin-width
+ (max (if leftp (string-width (erc-prompt)) 0)
+ (1+ (string-width
+ (or (if leftp
+ erc-timestamp-last-inserted
+ erc-timestamp-last-inserted-right)
+ (erc-format-timestamp
+ (current-time) erc-timestamp-format))))))
+ (+ (if leftp left-margin-width right-margin-width) cols))))
+ (set (if leftp 'left-margin-width 'right-margin-width) width)
(when (eq (current-buffer) (window-buffer))
- (set-window-margins nil left-margin-width width))))
+ (set-window-margins nil
+ (if leftp width left-margin-width)
+ (if leftp right-margin-width width)))))
;;;###autoload
(defun erc-stamp-prefix-log-filter (text)
@@ -348,39 +366,101 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(declare-function erc--remove-text-properties "erc" (string))
-;; If people want to use this directly, we can convert it into
-;; a local module.
+;; If people want to use this directly, we can convert it into a local
+;; module. Also, `erc-insert-timestamp-right' hard codes its display
+;; property to use `right-margin', and `erc-insert-timestamp-left'
+;; does the same for `left-margin'. However, there's no reason a
+;; trailing stamp couldn't be displayed on the left and vice versa.
+;; Note: this adds advice that breaks `erc-timestamp-offset' because
+;; the thinking is there's no use case in which that function would be
+;; called while this mode is active. See note below for more.
(define-minor-mode erc-stamp--display-margin-mode
"Internal minor mode for built-in modules integrating with `stamp'.
-It binds `erc-timestamp-use-align-to' to `margin' around calls to
-`erc-insert-timestamp-function' in the current buffer, and sets
-the right window margin to `erc-stamp-right-margin-width'. It
-also arranges to remove most text properties when a user kills
-message text so that stamps will be visible when yanked."
+Manages chosen window margin and arranges to remove `display'
+text properties in killed text to reveal stamps."
:interactive nil
(if erc-stamp--display-margin-mode
(progn
(setq fringes-outside-margins t)
(when (eq (current-buffer) (window-buffer))
(set-window-buffer (selected-window) (current-buffer)))
- (erc-stamp--adjust-right-margin 0)
+ (unless (local-variable-p 'erc-stamp--margin-left-p)
+ (setq erc-stamp--margin-left-p
+ (erc-stamp--margin-left-p erc-stamp--margin-left-p)))
+ (if (or erc-server-connected (not (functionp erc-prompt)))
+ (erc-stamp--init-margins-on-connect)
+ (add-hook 'erc-after-connect
+ #'erc-stamp--init-margins-on-connect nil t))
(add-function :filter-return (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (add-function :around (local 'erc-insert-timestamp-function)
- #'erc-stamp--display-margin-force))
+ (add-hook 'erc--setup-buffer-hook
+ #'erc-stamp--refresh-left-margin-prompt nil t)
+ (when erc-stamp--margin-left-p
+ (add-hook 'erc--refresh-prompt-hook
+ #'erc-stamp--display-prompt-in-left-margin nil t)))
(remove-function (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (remove-function (local 'erc-insert-timestamp-function)
- #'erc-stamp--display-margin-force)
- (kill-local-variable 'right-margin-width)
+ (add-hook 'erc-after-connect #'erc-stamp--init-margins-on-connect t)
+ (remove-hook 'erc--refresh-prompt-hook
+ #'erc-stamp--display-prompt-in-left-margin t)
+ (remove-hook 'erc--setup-buffer-hook
+ #'erc-stamp--refresh-left-margin-prompt t)
+ (kill-local-variable (if erc-stamp--margin-left-p
+ 'left-margin-width
+ 'right-margin-width))
(kill-local-variable 'fringes-outside-margins)
+ (kill-local-variable 'erc-stamp--margin-prompt-width)
+ (kill-local-variable 'erc-stamp--margin-left-p)
+ (kill-local-variable 'erc-stamp--margin-width)
(when (eq (current-buffer) (window-buffer))
(set-window-margins nil left-margin-width nil)
(set-window-buffer (selected-window) (current-buffer)))))
-(defun erc-insert-timestamp-left (string)
+(defvar-local erc-stamp--last-prompt nil)
+
+(defun erc-stamp--display-prompt-in-left-margin ()
+ "Show prompt in the left margin with padding."
+ (when (or (not erc-stamp--last-prompt) (functionp erc-prompt)
+ (> (string-width erc-stamp--last-prompt) left-margin-width))
+ (let ((s (buffer-substring erc-insert-marker (1- erc-input-marker))))
+ ;; Prevent #("abc" n m (display ((...) #("abc" p q (display...))))
+ (remove-text-properties 0 (length s) '(display nil) s)
+ (when (and erc-stamp--last-prompt
+ (>= (string-width erc-stamp--last-prompt) left-margin-width))
+ (let ((sm (truncate-string-to-width s (1- left-margin-width) 0 nil t)))
+ ;; This papers over a subtle off-by-1 bug here.
+ (unless (equal sm s)
+ (setq s (concat sm (substring s -1))))))
+ (setq erc-stamp--last-prompt (string-pad s left-margin-width nil t))))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,erc-stamp--last-prompt))
+ erc-stamp--last-prompt)
+
+(defun erc-stamp--refresh-left-margin-prompt ()
+ "Forcefully-recompute display property of prompt in left margin."
+ (with-silent-modifications
+ (unless (functionp erc-prompt)
+ (setq erc-stamp--last-prompt nil))
+ (erc--refresh-prompt)))
+
+(cl-defmethod erc--reveal-prompt
+ (&context (erc-stamp--display-margin-mode (eql t))
+ (erc-stamp--margin-left-p (eql t)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,erc-stamp--last-prompt)))
+
+(cl-defmethod erc--conceal-prompt
+ (&context (erc-stamp--display-margin-mode (eql t))
+ (erc-stamp--margin-left-p (eql t)))
+ (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,prompt))))
+
+(cl-defmethod erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
(goto-char (point-min))
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
@@ -392,6 +472,22 @@ erc-insert-timestamp-left
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
+(cl-defmethod erc-insert-timestamp-left
+ (string &context (erc-stamp--display-margin-mode (eql t)))
+ (unless (and erc-timestamp-only-if-changed-flag
+ (string-equal string erc-timestamp-last-inserted))
+ (goto-char (point-min))
+ (insert-before-markers-and-inherit
+ (setq erc-timestamp-last-inserted string))
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (point) p)))
+ (put-text-property (point-min) (point) p v)))
+ (erc-put-text-property (point-min) (point) 'invisible
+ erc-stamp--invisible-property)
+ (put-text-property (point-min) (point) 'field 'erc-timestamp)
+ (put-text-property (point-min) (point)
+ 'display `((margin left-margin) ,string))))
+
(defun erc-insert-aligned (string pos)
"Insert STRING at the POSth column.
@@ -408,8 +504,6 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
-
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -465,6 +559,9 @@ erc-insert-timestamp-right
;; For compatibility reasons, the `erc-timestamp' field includes
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
+ ((guard erc-stamp--display-margin-mode)
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string) string))
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
@@ -475,10 +572,6 @@ erc-insert-timestamp-right
(let ((s (+ erc-timestamp-use-align-to (string-width string))))
(put-text-property from (point) 'display
`(space :align-to (- right ,s)))))
- ('margin
- (put-text-property 0 (length string)
- 'display `((margin right-margin) ,string)
- string))
((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
(_ (indent-to pos)))
(insert string)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 03c21059a92..c90f20cc9a4 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2879,19 +2879,23 @@ erc--assert-input-bounds
(cl-assert (< erc-insert-marker erc-input-marker))
(cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
+(defvar erc--refresh-prompt-hook nil)
+
(defun erc--refresh-prompt ()
"Re-render ERC's prompt when the option `erc-prompt' is a function."
(erc--assert-input-bounds)
- (when (functionp erc-prompt)
- (save-excursion
- (goto-char erc-insert-marker)
- (set-marker-insertion-type erc-insert-marker nil)
- ;; Avoid `erc-prompt' (the named function), which appends a
- ;; space, and `erc-display-prompt', which propertizes all but
- ;; that space.
- (insert-and-inherit (funcall erc-prompt))
- (set-marker-insertion-type erc-insert-marker t)
- (delete-region (point) (1- erc-input-marker)))))
+ (unless (erc--prompt-hidden-p)
+ (when (functionp erc-prompt)
+ (save-excursion
+ (goto-char erc-insert-marker)
+ (set-marker-insertion-type erc-insert-marker nil)
+ ;; Avoid `erc-prompt' (the named function), which appends a
+ ;; space, and `erc-display-prompt', which propertizes all but
+ ;; that space.
+ (insert-and-inherit (funcall erc-prompt))
+ (set-marker-insertion-type erc-insert-marker t)
+ (delete-region (point) (1- erc-input-marker))))
+ (run-hooks 'erc--refresh-prompt-hook)))
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
@@ -4804,7 +4808,7 @@ erc-display-prompt
;; shall remain part of the prompt.
(setq prompt (propertize prompt
'rear-nonsticky t
- 'erc-prompt t
+ 'erc-prompt t ; t or `hidden'
'field 'erc-prompt
'front-sticky t
'read-only t))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 99ec4a9635e..67622da9f3d 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -340,4 +340,41 @@ erc-fill-wrap-visual-keys--prompt
(should (search-backward "ERC> " nil t))
(execute-kbd-macro "\C-a")))))
+(ert-deftest erc-fill--left-hand-stamps ()
+ :tags '(:unstable)
+ (unless (>= emacs-major-version 29)
+ (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-insert-timestamp-function #'erc-insert-timestamp-left))
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (should (= 8 left-margin-width))
+ (pcase-let ((`((margin left-margin) ,displayed)
+ (get-text-property erc-insert-marker 'display)))
+ (should (equal-including-properties
+ displayed #(" ERC>" 4 8
+ ( read-only t
+ front-sticky t
+ field erc-prompt
+ erc-prompt t
+ rear-nonsticky t
+ font-lock-face erc-prompt-face)))))
+ (erc-fill-tests--compare "stamps-left-01")
+
+ (ert-info ("Shrink left margin by 1 col")
+ (erc-stamp--adjust-margin -1)
+ (with-silent-modifications (erc--refresh-prompt))
+ (should (= 7 left-margin-width))
+ (pcase-let ((`((margin left-margin) ,displayed)
+ (get-text-property erc-insert-marker 'display)))
+ (should (equal-including-properties
+ displayed #(" ERC>" 3 7
+ ( read-only t
+ front-sticky t
+ field erc-prompt
+ erc-prompt t
+ rear-nonsticky t
+ font-lock-face erc-prompt-face))))))))))
+
;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 6da7ed4503d..f6de087a09a 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -140,7 +140,7 @@ erc-timestamp-use-align-to--integer
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
-(ert-deftest erc-timestamp-use-align-to--margin ()
+(ert-deftest erc-stamp--display-margin-mode--right ()
(erc-stamp-tests--insert-right
(lambda ()
(erc-stamp--display-margin-mode +1)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b5db5fe8764..fff3c4cb704 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -219,6 +219,7 @@ erc-hide-prompt
(setq erc-hide-prompt '(server))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(should (string= ">" (get-text-property erc-insert-marker 'display))))
(with-current-buffer "#chan"
@@ -229,6 +230,7 @@ erc-hide-prompt
(with-current-buffer "ServNet"
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: channel")
@@ -242,7 +244,9 @@ erc-hide-prompt
(with-current-buffer "#chan"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: query")
@@ -253,7 +257,9 @@ erc-hide-prompt
(with-current-buffer "bob"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
new file mode 100644
index 00000000000..f62b65cd170
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -0,0 +1 @@
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG))
\ No newline at end of file
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87a5vsjb3q.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87a5vsjb3q.fsf@neverwas.me>
@ 2023-07-20 13:28 ` J.P.
[not found] ` <87351iiueu.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-07-20 13:28 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 136 bytes --]
v3 (left-margin enhancement). Extend stamp-only text properties to
leading white space on right-sided stamps occupying their own line.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 11640 bytes --]
From 91fcae659fd6193475f5c92c95837072e8e717da Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 20 Jul 2023 05:39:13 -0700
Subject: [PATCH 0/1] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (1):
[5.6] Make erc-fill-wrap work with left-sided stamps
etc/ERC-NEWS | 20 +-
lisp/erc/erc-backend.el | 23 +-
lisp/erc/erc-compat.el | 1 +
lisp/erc/erc-fill.el | 126 ++++++++---
lisp/erc/erc-stamp.el | 210 +++++++++++++-----
lisp/erc/erc.el | 26 ++-
test/lisp/erc/erc-fill-tests.el | 37 +++
test/lisp/erc/erc-stamp-tests.el | 29 ++-
test/lisp/erc/erc-tests.el | 6 +
.../fill/snapshots/stamps-left-01.eld | 1 +
10 files changed, 362 insertions(+), 117 deletions(-)
create mode 100644 test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 2369aeeabc2..13e49a9123d 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -225,7 +225,8 @@ Chiefly, 'rear-sticky' has been replaced by 'erc-command', which
records the IRC command (or numeric) associated with a message. Less
impactfully, the value of the 'field' property for ERC's prompt has
changed from 't' to the more useful 'erc-prompt', although the
-property of the same name has been retained.
+property of the same name has been retained and now has a value of
+'hidden' when disconnected.
*** Members of insert- and send-related hooks have been reordered.
Built-in and third-party modules rely on certain hooks for adjusting
@@ -258,6 +259,16 @@ Additionally, the 'stamp' module now merges its 'invisible' property
with existing ones, when present, and it includes all white space
around stamps when doing so.
+Moreover, such "propertizing" of surrounding white space now extends
+to all 'stamp'-applied properties, like 'field', in all intervening
+space between message text and timestamps. This constitutes a
+breaking change from the perspective of detecting a timestamp's
+bounds. For example, ERC has always propertized leading space before
+right-sided stamps on the same line as message text but not those
+folded onto the next line. This inconsistency made stamp detection
+overly complex and produced uneven results when toggling stamp
+visibility.
+
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
features has improved. More specifically, a module's group now enjoys
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 6c2228f6337..2c5be590c60 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -355,28 +355,33 @@ fill-wrap
"Fill style leveraging `visual-line-mode'.
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 users
-who've defined their own `erc-insert-timestamp-function' have
-also customized the option `erc-fill-wrap-margin-side' to an
+depends on the `fill', `stamp', and `button' modules and assumes
+users who've defined their own `erc-insert-timestamp-function'
+have also customized the option `erc-fill-wrap-margin-side' to an
explicit side. To use this module, 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.
-
-When stamps appear in the right margin, which they do by default,
-users may find that ERC actually appends them to copy-as-killed
-messages without an intervening space. This normally poses at
-most a minor nuisance, however users of the `log' module may
-prefer a workaround provided by `erc-stamp-prefix-log-filter',
-which strips trailing stamps from logged messages and instead
-prepends them to every line."
+`erc-modules' or set `erc-fill-function' to `erc-fill-wrap'.
+Manually invoking one of the minor-mode toggles is not
+recommended.
+
+This module imposes various restrictions on the appearance of
+timestamps. Most notably, it insists on displaying them in the
+margins. Users preferring left-sided stamps may notice that ERC
+also displays the prompt in the left margin, possibly truncating
+or padding it to constrain it to the margin's width. When stamps
+appear in the right margin, which they do by default, users may
+find that ERC actually appends them to copy-as-killed messages
+without an intervening space. This normally poses at most a
+minor inconvenience, however users of the `log' module may prefer
+a workaround provided by `erc-stamp-prefix-log-filter', which
+strips trailing stamps from logged messages and instead prepends
+them to every line."
((erc-fill--wrap-ensure-dependencies)
(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
erc-stamp--margin-width erc-fill-wrap-margin-width
- left-margin-width 0
- right-margin-width 0)
+ left-margin-width left-margin-width
+ right-margin-width right-margin-width)
;; Only give this a local binding if known for sure.
(when erc-fill-wrap-margin-side
(setq erc-stamp--margin-left-p
@@ -384,8 +389,7 @@ fill-wrap
(setq erc-fill--function #'erc-fill-wrap)
(add-function :after (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))
+ (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))
@@ -393,16 +397,15 @@ fill-wrap
(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))
+ ((visual-line-mode -1)
+ (erc-stamp--display-margin-mode -1)
(kill-local-variable 'erc-fill--wrap-value)
(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)
(remove-function (local 'erc-stamp--insert-date-function)
- #'erc-fill--wrap-stamp-insert-prefixed-date)
- (visual-line-mode -1))
+ #'erc-fill--wrap-stamp-insert-prefixed-date))
'local)
(defvar-local erc-fill--wrap-length-function nil
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index eff99766d81..f98e0b04426 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -404,7 +404,8 @@ erc-stamp--display-margin-mode
#'erc-stamp--display-prompt-in-left-margin nil t)))
(remove-function (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (add-hook 'erc-after-connect #'erc-stamp--init-margins-on-connect t)
+ (remove-hook 'erc-after-connect
+ #'erc-stamp--init-margins-on-connect t)
(remove-hook 'erc--refresh-prompt-hook
#'erc-stamp--display-prompt-in-left-margin t)
(remove-hook 'erc--setup-buffer-hook
@@ -413,7 +414,6 @@ erc-stamp--display-margin-mode
'left-margin-width
'right-margin-width))
(kill-local-variable 'fringes-outside-margins)
- (kill-local-variable 'erc-stamp--margin-prompt-width)
(kill-local-variable 'erc-stamp--margin-left-p)
(kill-local-variable 'erc-stamp--margin-width)
(when (eq (current-buffer) (window-buffer))
@@ -504,6 +504,12 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--omit-properties-on-folded-lines nil
+ "Skip properties before right stamps occupying their own line.
+This escape hatch restores pre-5.6 behavior that left leading
+white space alone (unpropertized) for right-sided stamps folded
+onto their own line.")
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -572,7 +578,8 @@ erc-insert-timestamp-right
(let ((s (+ erc-timestamp-use-align-to (string-width string))))
(put-text-property from (point) 'display
`(space :align-to (- right ,s)))))
- ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ ((guard (>= col pos)) (newline) (indent-to pos)
+ (when erc-stamp--omit-properties-on-folded-lines (setq from (point))))
(_ (indent-to pos)))
(insert string)
(dolist (p erc-stamp--inherited-props)
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index f6de087a09a..c448416cd69 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -56,7 +56,7 @@ erc-stamp-tests--insert-right
(advice-remove 'erc-format-timestamp
'ert-deftest--erc-timestamp-use-align-to)))
-(ert-deftest erc-timestamp-use-align-to--nil ()
+(defun erc-stamp-tests--use-align-to--nil (compat)
(erc-stamp-tests--insert-right
(lambda ()
@@ -83,12 +83,20 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
(should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
- ;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\[ (char-after (field-beginning (point)))))
+ ;; Field includes leading whitespace.
+ (should (eql (if compat ?\[ ?\n)
+ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
-(ert-deftest erc-timestamp-use-align-to--t ()
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (ert-info ("Field starts on stamp text (compat)")
+ (let ((erc-stamp--omit-properties-on-folded-lines t))
+ (erc-stamp-tests--use-align-to--nil 'compat)))
+ (ert-info ("Field includes leaidng white space")
+ (erc-stamp-tests--use-align-to--nil nil)))
+
+(defun erc-stamp-tests--use-align-to--t (compat)
(erc-stamp-tests--insert-right
(lambda ()
@@ -110,10 +118,17 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
(should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
- ;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (field-beginning (point)))))
+ ;; Field includes leading space.
+ (should (eql (if compat ?\[ ?\n) (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (ert-info ("Field starts on stamp text (compat)")
+ (let ((erc-stamp--omit-properties-on-folded-lines t))
+ (erc-stamp-tests--use-align-to--t 'compat)))
+ (ert-info ("Field includes leaidng white space")
+ (erc-stamp-tests--use-align-to--t nil)))
+
(ert-deftest erc-timestamp-use-align-to--integer ()
(erc-stamp-tests--insert-right
(lambda ()
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Make-erc-fill-wrap-work-with-left-sided-stamps.patch --]
[-- Type: text/x-patch, Size: 48100 bytes --]
From 91fcae659fd6193475f5c92c95837072e8e717da Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 14 Jul 2023 06:12:30 -0700
Subject: [PATCH 1/1] [5.6] Make erc-fill-wrap work with left-sided stamps
* etc/ERC-NEWS: Remove all mention of option `erc-timestamp-align-to'
supporting a value of `margin', which has been abandoned. Mention
expanded area around time stamps exhibiting stamp-related properties.
* lisp/erc/erc-backend.el (erc--reveal-prompt, erc--conceal-prompt):
New generic functions with default implementations factored out from
`erc--unhide-prompt' and `erc--hide-prompt'.
(erc--prompt-hidden-p): New internal predicate function.
(erc--unhide-prompt): Defer to `erc--reveal-prompt' and set
`erc-prompt' text property to t.
(erc--hide-prompt): Defer to `erc--conceal-prompt' and set
`erc-prompt' text property to `hidden'.
* lisp/erc/erc-compat.el (erc-compat--29-browse-url-irc): Add FIXME
comment for likely insufficient test of function equality.
* lisp/erc/erc-fill.el (erc-fill-wrap-margin-width,
erc-fill-wrap-margin-side): New options to control side and initial
width of `fill-wrap' margin.
(erc-fill--wrap-beginning-of-line): Fix bug involving non-string
valued `display' props.
(erc-fill-wrap-toggle-truncate-lines): New command to re-enable
`visual-line-mode' when toggling off `truncate-lines'.
(erc-fill-wrap-mode, erc-fill-wrap-enable): Update doc string, persist
a few local vars, and conditionally set `erc-stamp--margin-left-p'.
(erc-fill-wrap-nudge): Update doc string and account for left-hand
stamps.
(erc-timestamp-offset): Add comment regarding conditional guard based
on function-valued option.
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Remove value
variant `margin', which was originally intended to be new in ERC 5.6.
This functionality was all but useless without the internal minor mode
`erc-stamp--display-margin-mode' active.
(erc-stamp-right-margin-width): Remove unused option new in 5.6.
(erc-stamp--display-margin-force): Remove unused function.
(erc-stamp--margin-width, erc-stamp--margin-left-p): New internal var.
(erc-stamp--margin-left-p, erc-stamp--init-margins-on-connect): New
functions for other modules that use `erc-stamp--display-margin-mode'.
(erc-stamp--adjust-right-margin, erc-stamp--adjust-margin): Rename
function to latter and accommodate left-hand stamps.
(erc-stamp--inherited-props): Relocate from lower down in file.
(erc-stamp--display-margin-mode): Update function name, and adjust
setup and teardown to accommodate left-handed stamps. Don't add
advice around `erc-insert-timestamp-function'.
(erc-stamp--last-prompt, erc-stamp--display-prompt-in-left-margin):
New function and helper var to convert a normal inserted prompt so
that it appears in the left margin.
(erc-stamp--refresh-left-margin-prompt): Helper for other modules to
quickly refresh prompt outside of insert hooks.
(erc--reveal-prompt, erc--conceal-prompt): New implementations for
when `erc-stamp--display-margin-mode' is active.
(erc-insert-timestamp-left): Convert to defmethod and provide
implementation for `erc-stamp--display-margin-mode'.
(erc-stamp--omit-properties-on-folded-lines): New variable, an escape
hatch for propertizing white space before right-side stamps folded
over onto another line.
(erc-insert-timestamp-right): Don't expect `erc-timestamp-align-to' to
ever be the symbol `margin'. Move handling for that case to one
contingent on the internal minor mode `erc-stamp--display-margin-mode'
being active. Add text properties preceding stamps folded over onto
another line. See related news entry for rationale. This is arguably
a breaking change.
* lisp/erc/erc.el (erc--refresh-prompt-hook): New variable.
(erc--refresh-prompt): Fix bug in which user-defined prompt functions
failed to hide when quitting in server buffers. Run new hook
`erc--refresh-prompt-hook'.
(erc-display-prompt): Add comment noting that the text property
`erc-prompt' now actually matters. It's t while a session is running
and `hidden' when disconnected.
* test/lisp/erc/erc-fill-tests.el (erc-fill--left-hand-stamps): New
test.
* test/lisp/erc/erc-stamp-tests.el
(erc-timestamp-use-align-to--margin,
erc-stamp--display-margin-mode--right): Rename test to latter.
(erc-stamp-tests--use-align-to--nil,
erc-stamp-tests--use-align-to--t): New functions to allow optionally
asserting pre-5.6 behavior regarding leading white space on right-hand
stamps that exist on their own line.
(erc-timestamp-use-align-to--nil, ert-deftest
erc-timestamp-use-align-to--t): Parameterize with compatibility flag.
* test/lisp/erc/erc-tests.el (erc-hide-prompt): Add some assertions
for new possible value of `erc-prompt' text property.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: New test
data file. (Bug#60936)
---
etc/ERC-NEWS | 20 +-
lisp/erc/erc-backend.el | 23 +-
lisp/erc/erc-compat.el | 1 +
lisp/erc/erc-fill.el | 126 ++++++++---
lisp/erc/erc-stamp.el | 210 +++++++++++++-----
lisp/erc/erc.el | 26 ++-
test/lisp/erc/erc-fill-tests.el | 37 +++
test/lisp/erc/erc-stamp-tests.el | 29 ++-
test/lisp/erc/erc-tests.el | 6 +
.../fill/snapshots/stamps-left-01.eld | 1 +
10 files changed, 362 insertions(+), 117 deletions(-)
create mode 100644 test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 4c881e32ab4..13e49a9123d 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -103,11 +103,8 @@ side window. Hit '<RET>' over a nick to spawn a "/QUERY" or a
** The option 'erc-timestamp-use-align-to' is more versatile.
While this option has always offered to right-align stamps via the
'display' text property, it's now more effective at doing so when set
-to a number indicating an offset from the right edge. And when set to
-the symbol 'margin', it displays stamps in the right margin, although,
-at the moment, this is mostly intended for use by other modules, such
-as 'fill-wrap', described above. For both these variants, users of
-the 'log' module may want to customize 'erc-log-filter-function' to
+to a number indicating an offset from the right edge. Users of the
+'log' module may want to customize 'erc-log-filter-function' to
'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps
appearing in their saved logs.
@@ -228,7 +225,8 @@ Chiefly, 'rear-sticky' has been replaced by 'erc-command', which
records the IRC command (or numeric) associated with a message. Less
impactfully, the value of the 'field' property for ERC's prompt has
changed from 't' to the more useful 'erc-prompt', although the
-property of the same name has been retained.
+property of the same name has been retained and now has a value of
+'hidden' when disconnected.
*** Members of insert- and send-related hooks have been reordered.
Built-in and third-party modules rely on certain hooks for adjusting
@@ -261,6 +259,16 @@ Additionally, the 'stamp' module now merges its 'invisible' property
with existing ones, when present, and it includes all white space
around stamps when doing so.
+Moreover, such "propertizing" of surrounding white space now extends
+to all 'stamp'-applied properties, like 'field', in all intervening
+space between message text and timestamps. This constitutes a
+breaking change from the perspective of detecting a timestamp's
+bounds. For example, ERC has always propertized leading space before
+right-sided stamps on the same line as message text but not those
+folded onto the next line. This inconsistency made stamp detection
+overly complex and produced uneven results when toggling stamp
+visibility.
+
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
features has improved. More specifically, a module's group now enjoys
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 363509d17fa..eb3ec39fedd 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1045,13 +1045,25 @@ erc-process-sentinel-1
;; unexpected disconnect
(erc-process-sentinel-2 event buffer))))
+(cl-defmethod erc--reveal-prompt ()
+ (remove-text-properties erc-insert-marker erc-input-marker
+ '(display nil)))
+
+(cl-defmethod erc--conceal-prompt ()
+ (add-text-properties erc-insert-marker (1- erc-input-marker)
+ `(display ,erc-prompt-hidden)))
+
+(defun erc--prompt-hidden-p ()
+ (and (marker-position erc-insert-marker)
+ (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)))
+
(defun erc--unhide-prompt ()
(remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t)
(when (and (marker-position erc-insert-marker)
(marker-position erc-input-marker))
(with-silent-modifications
- (remove-text-properties erc-insert-marker erc-input-marker
- '(display nil)))))
+ (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t)
+ (erc--reveal-prompt))))
(defun erc--unhide-prompt-on-self-insert ()
(when (and (eq this-command #'self-insert-command)
@@ -1059,6 +1071,8 @@ erc--unhide-prompt-on-self-insert
(erc--unhide-prompt)))
(defun erc--hide-prompt (proc)
+ "Hide prompt in all buffers of server.
+Change value of property `erc-prompt' from t to `hidden'."
(erc-with-all-buffers-of-server proc nil
(when (and erc-hide-prompt
(or (eq erc-hide-prompt t)
@@ -1072,8 +1086,9 @@ erc--hide-prompt
(marker-position erc-input-marker)
(get-text-property erc-insert-marker 'erc-prompt))
(with-silent-modifications
- (add-text-properties erc-insert-marker (1- erc-input-marker)
- `(display ,erc-prompt-hidden)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'erc-prompt 'hidden)
+ (erc--conceal-prompt))
(add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t))))
(defun erc-process-sentinel (cproc event)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index f451aaee754..912a4bc576c 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -418,6 +418,7 @@ erc-compat--29-browse-url-irc
(require 'url-irc)
(let* ((url (url-generic-parse-url string))
(url-irc-function
+ ;; FIXME this should probably use `symbol-function'.
(if (function-equal url-irc-function 'url-irc-erc)
(lambda (host port chan user pass)
(erc-handle-irc-url host port chan user pass (url-type url)))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a65c95f1d85..2c5be590c60 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -116,6 +116,25 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
+(defcustom erc-fill-wrap-margin-width nil
+ "Starting width in columns of dedicated stamp margin.
+When nil, ERC normally pretends its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+However, when `erc-fill-wrap-margin-side' is `left' or
+\"resolves\" to `left', ERC uses the width of the prompt if it's
+wider on MOTD's end, which really only matters when `erc-prompt'
+is a function."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defcustom erc-fill-wrap-margin-side nil
+ "Margin side to use with `erc-fill-wrap-mode'.
+A value of nil means ERC should decide based on the value of
+`erc-insert-timestamp-function', which does not work for
+user-defined functions."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) (const left) (const right)))
+
(defcustom erc-fill-line-spacing nil
"Extra space between messages on graphical displays.
This may need adjusting depending on how your faces are
@@ -253,9 +272,9 @@ erc-fill--wrap-beginning-of-line
(goto-char erc-input-marker)
;; Mimic what `move-beginning-of-line' does with invisible text.
(when-let ((erc-fill-wrap-merge)
- (empty (get-text-property (point) 'display))
- ((string-empty-p empty)))
- (goto-char (text-property-not-all (point) (pos-eol) 'display empty)))))
+ (prop (get-text-property (point) 'display))
+ ((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
+ (goto-char (text-property-not-all (point) (pos-eol) 'display prop)))))
(defun erc-fill--wrap-end-of-line (arg)
"Defer to `move-end-of-line' or `end-of-visual-line'."
@@ -278,12 +297,29 @@ erc-fill-wrap-cycle-visual-movement
('non-input nil))))
(message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys))
+(defun erc-fill-wrap-toggle-truncate-lines (arg)
+ "Toggle `truncate-lines' and maybe reinstate `visual-line-mode'."
+ (interactive "P")
+ (let ((wantp (if arg
+ (natnump (prefix-numeric-value arg))
+ (not truncate-lines)))
+ (buffer (current-buffer)))
+ (if wantp
+ (setq truncate-lines t)
+ (walk-windows (lambda (window)
+ (when (eq buffer (window-buffer window))
+ (set-window-hscroll window 0)))
+ nil t)
+ (visual-line-mode +1)))
+ (force-mode-line-update))
+
(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
:doc "Keymap for ERC's `fill-wrap' module."
:parent visual-line-mode-map
"<remap> <kill-line>" #'erc-fill--wrap-kill-line
"<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
"<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "<remap> <toggle-truncate-lines>" #'erc-fill-wrap-toggle-truncate-lines
"C-c a" #'erc-fill-wrap-cycle-visual-movement
;; Not sure if this is problematic because `erc-bol' takes no args.
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
@@ -319,25 +355,41 @@ fill-wrap
"Fill style leveraging `visual-line-mode'.
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 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. 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."
+depends on the `fill', `stamp', and `button' modules and assumes
+users who've defined their own `erc-insert-timestamp-function'
+have also customized the option `erc-fill-wrap-margin-side' to an
+explicit side. To use this module, either include `fill-wrap' in
+`erc-modules' or set `erc-fill-function' to `erc-fill-wrap'.
+Manually invoking one of the minor-mode toggles is not
+recommended.
+
+This module imposes various restrictions on the appearance of
+timestamps. Most notably, it insists on displaying them in the
+margins. Users preferring left-sided stamps may notice that ERC
+also displays the prompt in the left margin, possibly truncating
+or padding it to constrain it to the margin's width. When stamps
+appear in the right margin, which they do by default, users may
+find that ERC actually appends them to copy-as-killed messages
+without an intervening space. This normally poses at most a
+minor inconvenience, however users of the `log' module may prefer
+a workaround provided by `erc-stamp-prefix-log-filter', which
+strips trailing stamps from logged messages and instead prepends
+them to every line."
((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)
+ erc-fill--wrap-value erc-fill-static-center
+ erc-stamp--margin-width erc-fill-wrap-margin-width
+ left-margin-width left-margin-width
+ right-margin-width right-margin-width)
+ ;; Only give this a local binding if known for sure.
+ (when erc-fill-wrap-margin-side
+ (setq erc-stamp--margin-left-p
+ (pcase erc-fill-wrap-margin-side ('right nil) ('left t))))
(setq erc-fill--function #'erc-fill-wrap)
- ;; Internal integrations.
(add-function :after (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))
+ (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))
@@ -345,16 +397,15 @@ fill-wrap
(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))
+ ((visual-line-mode -1)
+ (erc-stamp--display-margin-mode -1)
(kill-local-variable 'erc-fill--wrap-value)
(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)
(remove-function (local 'erc-stamp--insert-date-function)
- #'erc-fill--wrap-stamp-insert-prefixed-date)
- (visual-line-mode -1))
+ #'erc-fill--wrap-stamp-insert-prefixed-date))
'local)
(defvar-local erc-fill--wrap-length-function nil
@@ -381,18 +432,21 @@ erc-fill--wrap-continued-message-p
(widen)
(when (eq 'erc-timestamp (field-at-pos m))
(set-marker m (field-end m)))
- (and (eq 'PRIVMSG (get-text-property m 'erc-command))
- (not (eq (get-text-property m 'erc-ctcp) 'ACTION))
- (cons (get-text-property m 'erc-timestamp)
- (get-text-property (1+ m) 'erc-data)))))
+ (and-let*
+ (((eq 'PRIVMSG (get-text-property m 'erc-command)))
+ ((not (eq (get-text-property m 'erc-ctcp)
+ 'ACTION)))
+ (spr (next-single-property-change m 'erc-speaker)))
+ (cons (get-text-property m 'erc-timestamp)
+ (get-text-property spr 'erc-speaker)))))
(ts (pop props))
((not (time-less-p (erc-stamp--current-time) ts)))
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
- (nick (buffer-substring-no-properties
- (1+ (point-min)) (- (point) 2)))
+ (speaker (next-single-property-change (point-min) 'erc-speaker))
+ (nick (get-text-property speaker 'erc-speaker))
(props)
- ((erc-nick-equal-p (car props) nick))))
+ ((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
@@ -476,8 +530,8 @@ erc-fill-wrap-nudge
\\`=' Increase indentation by one column
\\`-' Decrease indentation by one column
\\`0' Reset indentation to the default
- \\`+' Shift right margin rightward (shrink) by one column
- \\`_' Shift right margin leftward (grow) by one column
+ \\`+' Shift margin boundary rightward by one column
+ \\`_' Shift margin boundary leftward by one column
\\`)' Reset the right margin to the default
Note that misalignment may occur when messages contain
@@ -489,6 +543,7 @@ erc-fill-wrap-nudge
(unless (get-buffer-window)
(user-error "Command called in an undisplayed buffer"))
(let* ((total (erc-fill--wrap-nudge arg))
+ (leftp erc-stamp--margin-left-p)
(win-ratio (/ (float (- (window-point) (window-start)))
(- (window-end nil t) (window-start)))))
(when (zerop arg)
@@ -509,18 +564,20 @@ erc-fill-wrap-nudge
(dolist (key '(?\) ?_ ?+))
(let ((a (pcase key
(?\) 0)
- (?_ (- (abs arg)))
- (?+ (abs arg)))))
+ (?_ (if leftp (abs arg) (- (abs arg))))
+ (?+ (if leftp (- (abs arg)) (abs arg))))))
(define-key map (vector (list key))
(lambda ()
(interactive)
- (erc-stamp--adjust-right-margin (- a))
+ (erc-stamp--adjust-margin (- a) (zerop a))
+ (when leftp (erc-stamp--refresh-left-margin-prompt))
(recenter (round (* win-ratio (window-height))))))))
map)
t
(lambda ()
- (message "Fill prefix: %d (%+d col%s)"
- erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ (message "Fill prefix: %d (%+d col%s); Margin: %d"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")
+ (if leftp left-margin-width right-margin-width)))
"Use %k for further adjustment"
1)
(recenter (round (* win-ratio (window-height))))))
@@ -536,6 +593,7 @@ erc-timestamp-offset
"Get length of timestamp if inserted left."
(if (and (boundp 'erc-timestamp-format)
erc-timestamp-format
+ ;; FIXME use a more robust test than symbol equivalence.
(eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
(not erc-hide-timestamps))
(length (format-time-string erc-timestamp-format))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 83ee4a200ed..f98e0b04426 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -281,49 +281,67 @@ erc-timestamp-use-align-to
set to `erc-insert-timestamp-right' or that option's default,
`erc-insert-timestamp-left-and-right'. If the value is a
positive integer, alignment occurs that many columns from the
-right edge. If the value is `margin', the stamp appears in the
-right margin when visible.
+right edge.
Enabling this option produces a side effect in that stamps aren't
indented in saved logs. When its value is an integer, this
option adds a space after the end of a message if the stamp
doesn't already start with one. And when its value is t, it adds
-a single space, unconditionally. And while this option never
-adds a space when its value is `margin', ERC does offer a
-workaround in `erc-stamp-prefix-log-filter', which strips
-trailing stamps from messages and puts them before every line."
- :type '(choice boolean integer (const margin))
+a single space, unconditionally."
+ :type '(choice boolean integer)
:package-version '(ERC . "5.6")) ; FIXME sync on release
-(defcustom erc-stamp-right-margin-width nil
- "Width in columns of the right margin.
-When this option is nil, pretend its value is one column greater
-than the `string-width' of the formatted `erc-timestamp-format'.
-This option only matters when `erc-timestamp-use-align-to' is set
-to `margin'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
- :type '(choice (const nil) integer))
-
-(defun erc-stamp--display-margin-force (orig &rest r)
- (let ((erc-timestamp-use-align-to 'margin))
- (apply orig r)))
-
-(defun erc-stamp--adjust-right-margin (cols)
- "Adjust right margin by COLS.
-When COLS is zero, reset width to `erc-stamp-right-margin-width'
-or one col more than the `string-width' of
-`erc-timestamp-format'."
- (let ((width
- (if (zerop cols)
- (or erc-stamp-right-margin-width
- (1+ (string-width (or erc-timestamp-last-inserted-right
- (erc-format-timestamp
- (current-time)
- erc-timestamp-format)))))
- (+ right-margin-width cols))))
- (setq right-margin-width width)
+(defvar-local erc-stamp--margin-width nil
+ "Width in columns of margin for `erc-stamp--display-margin-mode'.
+Only consulted when resetting or initializing margin.")
+
+(defvar-local erc-stamp--margin-left-p nil
+ "Whether `erc-stamp--display-margin-mode' uses the left margin.
+During initialization, the mode respects this variable's existing
+value if it already has a local binding. Otherwise, modules can
+bind this to any value while enabling the mode. If it's nil, ERC
+will check to see if `erc-insert-timestamp-function' is
+`erc-insert-timestamp-left', interpreting the latter as a non-nil
+value. It'll then coerce any non-nil value to t.")
+
+(defun erc-stamp--margin-left-p (&optional value)
+ (and (or value
+ (function-equal (symbol-function (default-value
+ 'erc-insert-timestamp-function))
+ (symbol-function 'erc-insert-timestamp-left)))
+ t))
+
+(defun erc-stamp--init-margins-on-connect (&rest _)
+ (let ((existing (if erc-stamp--margin-left-p
+ left-margin-width
+ right-margin-width)))
+ (erc-stamp--adjust-margin existing 'resetp)))
+
+(defun erc-stamp--adjust-margin (cols &optional resetp)
+ "Adjust managed margin by increment COLS.
+With RESETP, set margin's width to COLS. However, if COLS is
+zero, set the width to a non-nil `erc-stamp--margin-width'.
+Otherwise, go with the `string-width' of `erc-timestamp-format'.
+However, when `erc-stamp--margin-left-p' is non-nil and the
+prompt is wider, use its width instead."
+ (let* ((leftp erc-stamp--margin-left-p)
+ (width
+ (if resetp
+ (or (and (not (zerop cols)) cols)
+ erc-stamp--margin-width
+ (max (if leftp (string-width (erc-prompt)) 0)
+ (1+ (string-width
+ (or (if leftp
+ erc-timestamp-last-inserted
+ erc-timestamp-last-inserted-right)
+ (erc-format-timestamp
+ (current-time) erc-timestamp-format))))))
+ (+ (if leftp left-margin-width right-margin-width) cols))))
+ (set (if leftp 'left-margin-width 'right-margin-width) width)
(when (eq (current-buffer) (window-buffer))
- (set-window-margins nil left-margin-width width))))
+ (set-window-margins nil
+ (if leftp width left-margin-width)
+ (if leftp right-margin-width width)))))
;;;###autoload
(defun erc-stamp-prefix-log-filter (text)
@@ -348,39 +366,101 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(declare-function erc--remove-text-properties "erc" (string))
-;; If people want to use this directly, we can convert it into
-;; a local module.
+;; If people want to use this directly, we can convert it into a local
+;; module. Also, `erc-insert-timestamp-right' hard codes its display
+;; property to use `right-margin', and `erc-insert-timestamp-left'
+;; does the same for `left-margin'. However, there's no reason a
+;; trailing stamp couldn't be displayed on the left and vice versa.
+;; Note: this adds advice that breaks `erc-timestamp-offset' because
+;; the thinking is there's no use case in which that function would be
+;; called while this mode is active. See note below for more.
(define-minor-mode erc-stamp--display-margin-mode
"Internal minor mode for built-in modules integrating with `stamp'.
-It binds `erc-timestamp-use-align-to' to `margin' around calls to
-`erc-insert-timestamp-function' in the current buffer, and sets
-the right window margin to `erc-stamp-right-margin-width'. It
-also arranges to remove most text properties when a user kills
-message text so that stamps will be visible when yanked."
+Manages chosen window margin and arranges to remove `display'
+text properties in killed text to reveal stamps."
:interactive nil
(if erc-stamp--display-margin-mode
(progn
(setq fringes-outside-margins t)
(when (eq (current-buffer) (window-buffer))
(set-window-buffer (selected-window) (current-buffer)))
- (erc-stamp--adjust-right-margin 0)
+ (unless (local-variable-p 'erc-stamp--margin-left-p)
+ (setq erc-stamp--margin-left-p
+ (erc-stamp--margin-left-p erc-stamp--margin-left-p)))
+ (if (or erc-server-connected (not (functionp erc-prompt)))
+ (erc-stamp--init-margins-on-connect)
+ (add-hook 'erc-after-connect
+ #'erc-stamp--init-margins-on-connect nil t))
(add-function :filter-return (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (add-function :around (local 'erc-insert-timestamp-function)
- #'erc-stamp--display-margin-force))
+ (add-hook 'erc--setup-buffer-hook
+ #'erc-stamp--refresh-left-margin-prompt nil t)
+ (when erc-stamp--margin-left-p
+ (add-hook 'erc--refresh-prompt-hook
+ #'erc-stamp--display-prompt-in-left-margin nil t)))
(remove-function (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
- (remove-function (local 'erc-insert-timestamp-function)
- #'erc-stamp--display-margin-force)
- (kill-local-variable 'right-margin-width)
+ (remove-hook 'erc-after-connect
+ #'erc-stamp--init-margins-on-connect t)
+ (remove-hook 'erc--refresh-prompt-hook
+ #'erc-stamp--display-prompt-in-left-margin t)
+ (remove-hook 'erc--setup-buffer-hook
+ #'erc-stamp--refresh-left-margin-prompt t)
+ (kill-local-variable (if erc-stamp--margin-left-p
+ 'left-margin-width
+ 'right-margin-width))
(kill-local-variable 'fringes-outside-margins)
+ (kill-local-variable 'erc-stamp--margin-left-p)
+ (kill-local-variable 'erc-stamp--margin-width)
(when (eq (current-buffer) (window-buffer))
(set-window-margins nil left-margin-width nil)
(set-window-buffer (selected-window) (current-buffer)))))
-(defun erc-insert-timestamp-left (string)
+(defvar-local erc-stamp--last-prompt nil)
+
+(defun erc-stamp--display-prompt-in-left-margin ()
+ "Show prompt in the left margin with padding."
+ (when (or (not erc-stamp--last-prompt) (functionp erc-prompt)
+ (> (string-width erc-stamp--last-prompt) left-margin-width))
+ (let ((s (buffer-substring erc-insert-marker (1- erc-input-marker))))
+ ;; Prevent #("abc" n m (display ((...) #("abc" p q (display...))))
+ (remove-text-properties 0 (length s) '(display nil) s)
+ (when (and erc-stamp--last-prompt
+ (>= (string-width erc-stamp--last-prompt) left-margin-width))
+ (let ((sm (truncate-string-to-width s (1- left-margin-width) 0 nil t)))
+ ;; This papers over a subtle off-by-1 bug here.
+ (unless (equal sm s)
+ (setq s (concat sm (substring s -1))))))
+ (setq erc-stamp--last-prompt (string-pad s left-margin-width nil t))))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,erc-stamp--last-prompt))
+ erc-stamp--last-prompt)
+
+(defun erc-stamp--refresh-left-margin-prompt ()
+ "Forcefully-recompute display property of prompt in left margin."
+ (with-silent-modifications
+ (unless (functionp erc-prompt)
+ (setq erc-stamp--last-prompt nil))
+ (erc--refresh-prompt)))
+
+(cl-defmethod erc--reveal-prompt
+ (&context (erc-stamp--display-margin-mode (eql t))
+ (erc-stamp--margin-left-p (eql t)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,erc-stamp--last-prompt)))
+
+(cl-defmethod erc--conceal-prompt
+ (&context (erc-stamp--display-margin-mode (eql t))
+ (erc-stamp--margin-left-p (eql t)))
+ (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)))
+ (put-text-property erc-insert-marker (1- erc-input-marker)
+ 'display `((margin left-margin) ,prompt))))
+
+(cl-defmethod erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
(goto-char (point-min))
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
@@ -392,6 +472,22 @@ erc-insert-timestamp-left
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
+(cl-defmethod erc-insert-timestamp-left
+ (string &context (erc-stamp--display-margin-mode (eql t)))
+ (unless (and erc-timestamp-only-if-changed-flag
+ (string-equal string erc-timestamp-last-inserted))
+ (goto-char (point-min))
+ (insert-before-markers-and-inherit
+ (setq erc-timestamp-last-inserted string))
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (point) p)))
+ (put-text-property (point-min) (point) p v)))
+ (erc-put-text-property (point-min) (point) 'invisible
+ erc-stamp--invisible-property)
+ (put-text-property (point-min) (point) 'field 'erc-timestamp)
+ (put-text-property (point-min) (point)
+ 'display `((margin left-margin) ,string))))
+
(defun erc-insert-aligned (string pos)
"Insert STRING at the POSth column.
@@ -408,7 +504,11 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+(defvar erc-stamp--omit-properties-on-folded-lines nil
+ "Skip properties before right stamps occupying their own line.
+This escape hatch restores pre-5.6 behavior that left leading
+white space alone (unpropertized) for right-sided stamps folded
+onto their own line.")
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
@@ -465,6 +565,9 @@ erc-insert-timestamp-right
;; For compatibility reasons, the `erc-timestamp' field includes
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
+ ((guard erc-stamp--display-margin-mode)
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string) string))
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
@@ -475,11 +578,8 @@ erc-insert-timestamp-right
(let ((s (+ erc-timestamp-use-align-to (string-width string))))
(put-text-property from (point) 'display
`(space :align-to (- right ,s)))))
- ('margin
- (put-text-property 0 (length string)
- 'display `((margin right-margin) ,string)
- string))
- ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ ((guard (>= col pos)) (newline) (indent-to pos)
+ (when erc-stamp--omit-properties-on-folded-lines (setq from (point))))
(_ (indent-to pos)))
(insert string)
(dolist (p erc-stamp--inherited-props)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index eca6a90d706..d519bf221b9 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2879,19 +2879,23 @@ erc--assert-input-bounds
(cl-assert (< erc-insert-marker erc-input-marker))
(cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
+(defvar erc--refresh-prompt-hook nil)
+
(defun erc--refresh-prompt ()
"Re-render ERC's prompt when the option `erc-prompt' is a function."
(erc--assert-input-bounds)
- (when (functionp erc-prompt)
- (save-excursion
- (goto-char erc-insert-marker)
- (set-marker-insertion-type erc-insert-marker nil)
- ;; Avoid `erc-prompt' (the named function), which appends a
- ;; space, and `erc-display-prompt', which propertizes all but
- ;; that space.
- (insert-and-inherit (funcall erc-prompt))
- (set-marker-insertion-type erc-insert-marker t)
- (delete-region (point) (1- erc-input-marker)))))
+ (unless (erc--prompt-hidden-p)
+ (when (functionp erc-prompt)
+ (save-excursion
+ (goto-char erc-insert-marker)
+ (set-marker-insertion-type erc-insert-marker nil)
+ ;; Avoid `erc-prompt' (the named function), which appends a
+ ;; space, and `erc-display-prompt', which propertizes all but
+ ;; that space.
+ (insert-and-inherit (funcall erc-prompt))
+ (set-marker-insertion-type erc-insert-marker t)
+ (delete-region (point) (1- erc-input-marker))))
+ (run-hooks 'erc--refresh-prompt-hook)))
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
@@ -4804,7 +4808,7 @@ erc-display-prompt
;; shall remain part of the prompt.
(setq prompt (propertize prompt
'rear-nonsticky t
- 'erc-prompt t
+ 'erc-prompt t ; t or `hidden'
'field 'erc-prompt
'front-sticky t
'read-only t))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 99ec4a9635e..67622da9f3d 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -340,4 +340,41 @@ erc-fill-wrap-visual-keys--prompt
(should (search-backward "ERC> " nil t))
(execute-kbd-macro "\C-a")))))
+(ert-deftest erc-fill--left-hand-stamps ()
+ :tags '(:unstable)
+ (unless (>= emacs-major-version 29)
+ (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+ (let ((erc-timestamp-only-if-changed-flag nil)
+ (erc-insert-timestamp-function #'erc-insert-timestamp-left))
+ (erc-fill-tests--wrap-populate
+ (lambda ()
+ (should (= 8 left-margin-width))
+ (pcase-let ((`((margin left-margin) ,displayed)
+ (get-text-property erc-insert-marker 'display)))
+ (should (equal-including-properties
+ displayed #(" ERC>" 4 8
+ ( read-only t
+ front-sticky t
+ field erc-prompt
+ erc-prompt t
+ rear-nonsticky t
+ font-lock-face erc-prompt-face)))))
+ (erc-fill-tests--compare "stamps-left-01")
+
+ (ert-info ("Shrink left margin by 1 col")
+ (erc-stamp--adjust-margin -1)
+ (with-silent-modifications (erc--refresh-prompt))
+ (should (= 7 left-margin-width))
+ (pcase-let ((`((margin left-margin) ,displayed)
+ (get-text-property erc-insert-marker 'display)))
+ (should (equal-including-properties
+ displayed #(" ERC>" 3 7
+ ( read-only t
+ front-sticky t
+ field erc-prompt
+ erc-prompt t
+ rear-nonsticky t
+ font-lock-face erc-prompt-face))))))))))
+
;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 6da7ed4503d..c448416cd69 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -56,7 +56,7 @@ erc-stamp-tests--insert-right
(advice-remove 'erc-format-timestamp
'ert-deftest--erc-timestamp-use-align-to)))
-(ert-deftest erc-timestamp-use-align-to--nil ()
+(defun erc-stamp-tests--use-align-to--nil (compat)
(erc-stamp-tests--insert-right
(lambda ()
@@ -83,12 +83,20 @@ erc-timestamp-use-align-to--nil
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
(should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
- ;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\[ (char-after (field-beginning (point)))))
+ ;; Field includes leading whitespace.
+ (should (eql (if compat ?\[ ?\n)
+ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
-(ert-deftest erc-timestamp-use-align-to--t ()
+(ert-deftest erc-timestamp-use-align-to--nil ()
+ (ert-info ("Field starts on stamp text (compat)")
+ (let ((erc-stamp--omit-properties-on-folded-lines t))
+ (erc-stamp-tests--use-align-to--nil 'compat)))
+ (ert-info ("Field includes leaidng white space")
+ (erc-stamp-tests--use-align-to--nil nil)))
+
+(defun erc-stamp-tests--use-align-to--t (compat)
(erc-stamp-tests--insert-right
(lambda ()
@@ -110,10 +118,17 @@ erc-timestamp-use-align-to--t
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
(should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
- ;; Field starts *after* leading space (arguably bad).
- (should (eql ?\[ (char-after (field-beginning (point)))))
+ ;; Field includes leading space.
+ (should (eql (if compat ?\[ ?\n) (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
+(ert-deftest erc-timestamp-use-align-to--t ()
+ (ert-info ("Field starts on stamp text (compat)")
+ (let ((erc-stamp--omit-properties-on-folded-lines t))
+ (erc-stamp-tests--use-align-to--t 'compat)))
+ (ert-info ("Field includes leaidng white space")
+ (erc-stamp-tests--use-align-to--t nil)))
+
(ert-deftest erc-timestamp-use-align-to--integer ()
(erc-stamp-tests--insert-right
(lambda ()
@@ -140,7 +155,7 @@ erc-timestamp-use-align-to--integer
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
-(ert-deftest erc-timestamp-use-align-to--margin ()
+(ert-deftest erc-stamp--display-margin-mode--right ()
(erc-stamp-tests--insert-right
(lambda ()
(erc-stamp--display-margin-mode +1)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b5db5fe8764..fff3c4cb704 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -219,6 +219,7 @@ erc-hide-prompt
(setq erc-hide-prompt '(server))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(should (string= ">" (get-text-property erc-insert-marker 'display))))
(with-current-buffer "#chan"
@@ -229,6 +230,7 @@ erc-hide-prompt
(with-current-buffer "ServNet"
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: channel")
@@ -242,7 +244,9 @@ erc-hide-prompt
(with-current-buffer "#chan"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: query")
@@ -253,7 +257,9 @@ erc-hide-prompt
(with-current-buffer "bob"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
+ (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
new file mode 100644
index 00000000000..f62b65cd170
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -0,0 +1 @@
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG))
\ No newline at end of file
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87351iiueu.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87351iiueu.fsf@neverwas.me>
@ 2023-07-23 14:00 ` J.P.
[not found] ` <87h6pug23c.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-07-23 14:00 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 653 bytes --]
"J.P." <jp@neverwas.me> writes:
> v3 (left-margin enhancement). Extend stamp-only text properties to
> leading white space on right-sided stamps occupying their own line.
This was installed as
* 63d8b2a59a4 Make erc-fill-wrap work with left-sided stamps
Unfortunately, it introduced a regression involving CTCP ACTIONs from
consecutive speakers. To reproduce, say something in a target buffer,
then do a "/me something" immediately afterward. You'll see that ERC
inserts
<nick> something
something
instead of
<nick> something
* nick something
or
<nick> something
* nick something
The attached patch should fix this.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Fix-CTCP-ACTION-regression-in-erc-fill-wrap.patch --]
[-- Type: text/x-patch, Size: 8046 bytes --]
From 0812d0b35e07d36d1747d5483e7da6ca5ac81c1d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 22 Jul 2023 14:07:38 -0700
Subject: [PATCH] [5.6] Fix CTCP ACTION regression in erc-fill-wrap
* lisp/erc/erc-fill.el (erc-fill--wrap-continued-message-p): Fail when
current message is a CTCP ACTION. This fixes a regression introduced
by 63d8b2a59a4 "Make erc-fill-wrap work with left-sided stamps".
* test/lisp/erc/erc-fill-tests.el: (erc-fill-wrap--merge-action):
New test.
* test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: New
test data file. (Bug#60936)
---
lisp/erc/erc-fill.el | 3 +-
test/lisp/erc/erc-fill-tests.el | 40 +++++++++++++++++++
.../fill/snapshots/merge-wrap-01.eld | 1 +
3 files changed, 43 insertions(+), 1 deletion(-)
create mode 100644 test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 17eb0002f08..e2a82582a3f 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -443,12 +443,13 @@ erc-fill--wrap-continued-message-p
(cons (get-text-property m 'erc-timestamp)
(get-text-property spr 'erc-speaker)))))
(ts (pop props))
+ (props)
((not (time-less-p (erc-stamp--current-time) ts)))
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
(speaker (next-single-property-change (point-min) 'erc-speaker))
+ ((not (eq (get-text-property speaker 'erc-ctcp) 'ACTION)))
(nick (get-text-property speaker 'erc-speaker))
- (props)
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 67622da9f3d..b81d0c15558 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -241,6 +241,46 @@ erc-fill-wrap--merge
"<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
(erc-fill-tests--compare "merge-02-right")))))
+(ert-deftest erc-fill-wrap--merge-action ()
+ :tags '(:unstable)
+ (unless (>= emacs-major-version 29)
+ (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+ (erc-fill-tests--wrap-populate
+
+ (lambda ()
+ ;; Set this here so that the first few messages are from 1970
+ (let ((erc-fill-tests--time-vals (lambda () 1680332400)))
+ (erc-fill-tests--insert-privmsg "bob" "zero.")
+
+ (erc-process-ctcp-query
+ erc-server-process
+ (make-erc-response
+ :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one\1"
+ :sender "bob!~u@fake" :command "PRIVMSG"
+ :command-args '("#chan" "\1ACTION one\1") :contents "\1ACTION one\1")
+ "bob" "~u" "fake")
+
+ (erc-fill-tests--insert-privmsg "bob" "two.")
+
+ ;; Compat switch to opt out of overhanging speaker.
+ (let (erc-fill--wrap-action-dedent-p)
+ (erc-process-ctcp-query
+ erc-server-process
+ (make-erc-response
+ :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1"
+ :sender "bob!~u@fake" :command "PRIVMSG"
+ :command-args '("#chan" "\1ACTION three\1")
+ :contents "\1ACTION three\1")
+ "bob" "~u" "fake"))
+
+ (erc-fill-tests--insert-privmsg "bob" "four."))
+
+ (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"))))
+
(ert-deftest erc-fill-line-spacing ()
:tags '(:unstable)
(unless (>= emacs-major-version 29)
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
new file mode 100644
index 00000000000..a3d533c87b5
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-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<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 one\n<bob> two.\n* bob three\n<bob> four.\n" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# invisible timestamp font-lock-face erc-timestamp-face)))) 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) 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) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 27 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 27 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# invisible timestamp font-lock-face erc-timestamp-face)))) 474 476 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 27 (6))) erc-ctcp ACTION erc-command PRIVMSG) 476 479 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-ctcp ACTION erc-command PRIVMSG) 479 483 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-ctcp ACTION erc-command PRIVMSG) 484 485 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 27 (6))) erc-command PRIVMSG) 485 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 488 494 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 495 497 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11=(space :width (- 27 (2))) erc-ctcp ACTION erc-command PRIVMSG) 497 500 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11# erc-ctcp ACTION erc-command PRIVMSG) 500 506 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11# erc-ctcp ACTION erc-command PRIVMSG) 507 508 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 27 (6))) erc-command PRIVMSG) 508 511 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 511 518 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG))
\ No newline at end of file
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87h6pug23c.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87h6pug23c.fsf@neverwas.me>
@ 2023-07-28 23:59 ` J.P.
0 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-07-28 23:59 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> Unfortunately, it introduced a regression involving CTCP ACTIONs from
> consecutive speakers. To reproduce, say something in a target buffer,
> then do a "/me something" immediately afterward. You'll see that ERC
> inserts
>
> <nick> something
> something
>
> instead of
>
> <nick> something
> * nick something
>
> or
>
> <nick> something
> * nick something
>
> The attached patch should fix this.
This has been installed as
8623159b Fix CTCP ACTION regression in erc-fill-wrap
Thanks.
^ permalink raw reply [flat|nested] 56+ messages in thread
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (16 preceding siblings ...)
[not found] ` <87msztl4xu.fsf@neverwas.me>
@ 2023-08-09 14:53 ` J.P.
2023-08-09 16:50 ` Michael Albinus
[not found] ` <87jzu4upl9.fsf@gmx.de>
2023-08-31 13:31 ` J.P.
` (7 subsequent siblings)
25 siblings, 2 replies; 56+ messages in thread
From: J.P. @ 2023-08-09 14:53 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1749 bytes --]
I'd like to add a minor improvement and some small bug fixes to this
feature (new in ERC 5.6). The improvement concerns the command
`erc-fill-wrap-cycle-visual-movement', which cycles through three
flavors of interactive movement: "logcial-line", "screen-line", and
"DWIM". In an unfortunate omission (by me), basic line-wise movement
commands weren't initially included. But now I'm thinking users would at
least appreciate being able to navigate by whole IRC message when the
logical-line variant (nil state) is active. That's what the third patch
does.
The second patch introduces a minor change involving the mostly
unrelated bug#60933, which did away with the oddball "nickname" entry in
`erc-button-alist' and introduced an escape hatch (in the
function-valued variable `erc-button-nickname-callback-function') for
those needing access to the excised entry's "on-click" callback. The
interface was initially defined to accommodate the nick-button's
"erc-data" object, in this case a list containing a lone arg, the
nickname, to pass to the callback. However, in this instance, we're not
really obliged to preserve compatibility because this is a new variable,
and the old hard-wired callback, `erc-nick-popup', remains untouched.
Therefore, I think we should take this opportunity to redefine this
interface to accept any number of TBD trailing args after the nickname.
This will make it easier to retain more informative data for rich UI
features without resorting to hacks, like hiding data in text-properties
of public strings, which can leak memory. I also think we ought to
deprecate this variable even though it's new in ERC 5.6 to stress the
fact that the default value is basically required when using ERC as an
interactive client.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Relax-timeouts-on-some-ERC-tests.patch --]
[-- Type: text/x-patch, Size: 15167 bytes --]
From 7056f29d1f604c1a52f905578f0a75e8b157bfb4 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 31 Jul 2023 22:20:01 -0700
Subject: [PATCH 1/3] ; Relax timeouts on some ERC tests
There have been three failures (all on native-comp-speed2-master) over
the last three weeks pointing to these tests, which haven't changed in
the year-plus they've existed in tree. No test appears in multiple
failures, and all continue to pass daily on commercial GitLab (GCP)
runners using the same EMBA container image. They also pass locally
with "make check" and "make -j -C test SELECTOR=t check-lisp-erc". If
these tweaks don't fix the problem, they can be branded :unstable.
* test/lisp/erc/erc-scenarios-base-renick.el: Extend timeouts.
* test/lisp/erc/resources/base/netid/bouncer/barnet.eld: Extend
timeouts.
* test/lisp/erc/resources/base/netid/bouncer/foonet.eld: Extend
timeouts.
* test/lisp/erc/resources/base/reconnect/options.eld: Extend timeouts.
* test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld:
Extend timeouts.
* test/lisp/erc/resources/base/renick/queries/bouncer-foonet.eld:
Extend timeouts.
* test/lisp/erc/resources/erc-scenarios-common.el: Extend timeout.
* test/lisp/erc/resources/services/auth-source/libera.eld: Extend
timeouts.
---
test/lisp/erc/erc-scenarios-base-renick.el | 4 ++--
.../erc/resources/base/netid/bouncer/barnet.eld | 12 ++++++------
.../erc/resources/base/netid/bouncer/foonet.eld | 12 ++++++------
test/lisp/erc/resources/base/reconnect/options.eld | 10 +++++-----
.../base/renick/queries/bouncer-barnet.eld | 14 +++++++-------
.../base/renick/queries/bouncer-foonet.eld | 12 ++++++------
test/lisp/erc/resources/erc-scenarios-common.el | 2 +-
.../erc/resources/services/auth-source/libera.eld | 10 +++++-----
8 files changed, 38 insertions(+), 38 deletions(-)
diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el
index f1723200533..2bf3ef46257 100644
--- a/test/lisp/erc/erc-scenarios-base-renick.el
+++ b/test/lisp/erc/erc-scenarios-base-renick.el
@@ -275,8 +275,8 @@ erc-scenarios-base-renick-queries-bouncer
(funcall expect 3 "I never saw her before")
(erc-scenarios-common-say "You aren't with Wage?")))
- (erc-d-t-wait-for 3 (get-buffer "frenemy@foonet"))
- (erc-d-t-wait-for 3 (get-buffer "frenemy@barnet"))
+ (erc-d-t-wait-for 10 (get-buffer "frenemy@foonet"))
+ (erc-d-t-wait-for 10 (get-buffer "frenemy@barnet"))
(should-not (get-buffer "rando@foonet"))
(should-not (get-buffer "rando@barnet"))
diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld
index d0fe3af8ea4..204d01fef77 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 3 "PASS :barnet:changeme"))
-((nick 3 "NICK tester"))
-((user 3 "USER user 0 * :tester")
+((pass 10 "PASS :barnet:changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
(0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.barnet.org 003 tester :This server was created Wed, 12 May 2021 07:41:08 UTC")
@@ -17,19 +17,19 @@
(0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-((mode-user 10.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
;; No mode answer ^
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-((join 1 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
(0 ":irc.barnet.org 353 tester = #chan :@joe mike tester")
(0 ":irc.barnet.org 366 tester #chan :End of NAMES list")
(0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!")
(0 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!"))
-((mode 3 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620805269")
(0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: But you have outfaced them all.")
diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld
index b0964fb9537..4445350ca0c 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 3 "PASS :foonet:changeme"))
-((nick 3 "NICK tester"))
-((user 3 "USER user 0 * :tester")
+((pass 10 "PASS :foonet:changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.foonet.org 003 tester :This server was created Wed, 12 May 2021 07:41:09 UTC")
@@ -17,19 +17,19 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 4.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
;; No mode answer ^
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-((join 1 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@ertp7idh9jtgi.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!")
(0 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!"))
-((mode 3 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620805271")
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: He cannot be heard of. Out of doubt he is transported.")
diff --git a/test/lisp/erc/resources/base/reconnect/options.eld b/test/lisp/erc/resources/base/reconnect/options.eld
index 3b305d85594..e0952a2aece 100644
--- a/test/lisp/erc/resources/base/reconnect/options.eld
+++ b/test/lisp/erc/resources/base/reconnect/options.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
@@ -18,7 +18,7 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 3.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.foonet.org 221 tester +i")
(0 ":irc.foonet.org NOTICE tester :This server is in debug mode.")
@@ -26,7 +26,7 @@
(0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-((mode-chan 4 "MODE #chan")
+((mode-chan 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620104779")
(0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
diff --git a/test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld b/test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld
index 0c8cdac0379..c9080cf39e9 100644
--- a/test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld
+++ b/test/lisp/erc/resources/base/renick/queries/bouncer-barnet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 3 "PASS :barnet:changeme"))
-((nick 3 "NICK tester"))
-((user 3 "USER user 0 * :tester")
+((pass 10 "PASS :barnet:changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
(0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.barnet.org 003 tester :This server was created Tue, 01 Jun 2021 07:49:23 UTC")
@@ -17,7 +17,7 @@
(0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-((mode-user 3.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
;; No mode answer
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":tester!~u@286u8jcpis84e.irc JOIN #chan")
@@ -32,18 +32,18 @@
(0 ":irc.barnet.org NOTICE tester :[09:13:24] 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.")
(0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-((mode 5 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1622538742")
(0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: By favors several which they did bestow.")
(0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: You, Roderigo! come, sir, I am for you."))
-((privmsg-a 5 "PRIVMSG rando :Linda said you were gonna kill me.")
+((privmsg-a 10 "PRIVMSG rando :Linda said you were gonna kill me.")
(0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: Play, music, then! Nay, you must do it soon.")
(0.1 ":rando!~u@95i756tt32ym8.irc PRIVMSG tester :Linda said? I never saw her before I came up here.")
(0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: Of arts inhibited and out of warrant."))
-((privmsg-b 3 "PRIVMSG rando :You aren't with Wage?")
+((privmsg-b 10 "PRIVMSG rando :You aren't with Wage?")
(0.1 ":joe!~u@286u8jcpis84e.irc PRIVMSG #chan :mike: But most of all, agreeing with the proclamation.")
(0.1 ":rando!~u@95i756tt32ym8.irc PRIVMSG tester :I think you screwed up, Case.")
(0.1 ":mike!~u@286u8jcpis84e.irc PRIVMSG #chan :joe: Good gentleman, go your gait, and let poor volk pass. An chud ha' bin zwaggered out of my life, 'twould not ha' bin zo long as 'tis by a vortnight. Nay, come not near th' old man; keep out, che vor ye, or ise try whether your costard or my ballow be the harder. Chill be plain with you.")
diff --git a/test/lisp/erc/resources/base/renick/queries/bouncer-foonet.eld b/test/lisp/erc/resources/base/renick/queries/bouncer-foonet.eld
index 162e8bf9655..2421651ebe8 100644
--- a/test/lisp/erc/resources/base/renick/queries/bouncer-foonet.eld
+++ b/test/lisp/erc/resources/base/renick/queries/bouncer-foonet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :foonet:changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.foonet.org 003 tester :This server was created Tue, 01 Jun 2021 07:49:22 UTC")
@@ -17,7 +17,7 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 5.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
;; No mode answer
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":tester!~u@u4mvbswyw8gbg.irc JOIN #chan")
@@ -38,12 +38,12 @@
(0.1 ":bob!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :alice: When there is nothing living but thee, thou shalt be welcome. I had rather be a beggar's dog than Apemantus.")
(0.1 ":alice!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :bob: You have simply misused our sex in your love-prate: we must have your doublot and hose plucked over your head, and show the world what the bird hath done to her own nest."))
-((privmsg-a 6 "PRIVMSG rando :I here")
+((privmsg-a 10 "PRIVMSG rando :I here")
(0.1 ":bob!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :alice: And I will make thee think thy swan a crow.")
(0.1 ":rando!~u@bivkhq8yav938.irc PRIVMSG tester :u are dumb")
(0.1 ":alice!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :bob: Lie not, to say mine eyes are murderers."))
-((privmsg-b 3 "PRIVMSG rando :not so")
+((privmsg-b 10 "PRIVMSG rando :not so")
(0.1 ":bob!~u@u4mvbswyw8gbg.irc PRIVMSG #chan :alice: Commit myself, my person, and the cause.")
;; Nick change
(0.1 ":rando!~u@bivkhq8yav938.irc NICK frenemy")
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 32e7556d602..972faa5c73f 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -288,7 +288,7 @@ erc-scenarios-common--base-network-id-bouncer
(erc-d-t-search-for 1 "<bob>")
(erc-d-t-absent-for 0.1 "<joe>")
(should (eq erc-server-process erc-server-process-foo))
- (erc-d-t-search-for 10 "ape is dead")
+ (erc-d-t-search-for 15 "ape is dead")
(erc-d-t-wait-for 5 (not (erc-server-process-alive)))))
(ert-info ("#chan@<esid> is exclusive to barnet")
diff --git a/test/lisp/erc/resources/services/auth-source/libera.eld b/test/lisp/erc/resources/services/auth-source/libera.eld
index c8dbc9d425a..dfc25221508 100644
--- a/test/lisp/erc/resources/services/auth-source/libera.eld
+++ b/test/lisp/erc/resources/services/auth-source/libera.eld
@@ -1,6 +1,6 @@
;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((nick 10 "NICK tester"))
+((user 5 "USER user 0 * :tester")
(0.26 ":zirconium.libera.chat NOTICE * :*** Checking Ident")
(0.01 ":zirconium.libera.chat NOTICE * :*** Looking up your hostname...")
(0.01 ":zirconium.libera.chat NOTICE * :*** No Ident response")
@@ -35,15 +35,15 @@
(0.01 ":zirconium.libera.chat 372 tester :- Email: support@libera.chat")
(0.00 ":zirconium.libera.chat 376 tester :End of /MOTD command."))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0.02 ":tester MODE tester :+Zi")
(0.02 ":NickServ!NickServ@services.libera.chat NOTICE tester :This nickname is registered. Please choose a different nickname, or identify via \2/msg NickServ IDENTIFY tester <password>\2"))
-((privmsg 2 "PRIVMSG NickServ :IDENTIFY changeme")
+((privmsg 10 "PRIVMSG NickServ :IDENTIFY changeme")
(0.96 ":NickServ!NickServ@services.libera.chat NOTICE tester :You are now identified for \2tester\2.")
(0.25 ":NickServ!NickServ@services.libera.chat NOTICE tester :Last login from: \2~tester@school.edu/tester\2 on Jun 18 01:15:56 2021 +0000."))
-((quit 5 "QUIT :\2ERC\2")
+((quit 10 "QUIT :\2ERC\2")
(0.19 ":tester!~user@static-198-54-131-100.cust.tzulo.com QUIT :Client Quit"))
((linger 1 LINGER))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Deprecate-erc-button-nickname-callback-function.patch --]
[-- Type: text/x-patch, Size: 2445 bytes --]
From f8982577fb61863d47497e86686ca20a932b71da Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 7 Aug 2023 03:35:56 -0700
Subject: [PATCH 2/3] [5.6] Deprecate erc-button-nickname-callback-function
* lisp/erc/erc-button.el (erc-button-nickname-callback-function):
Deprecate this function-valued variable, first introduced in ERC 5.6,
to dissuade consumers of the old `erc-button-alist' nickname interface
from meddling with the on-click callback of buttonized nicks. They
should instead add their own propertizing logic in something like
`erc-insert-modify-hook'. Also change default callback to a wrapper
that discards all but the first arg. This effectively declares that
`erc-data' values may contain more than one element in the near
future.
(erc-button--perform-nick-popup): New default nick-button callback
function that calls `erc-nick-popup' with the first argument and
ignores the rest. (Bug#60933)
---
lisp/erc/erc-button.el | 13 +++++++++++--
1 file changed, 11 insertions(+), 2 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 89a6cd131c0..bfaf4fa821a 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -279,8 +279,13 @@ erc-button-setup
" entries are deprecated. Either use a variable or a function"
" that conditionally calls `erc-button-add-button'.")))))
-(defvar erc-button-nickname-callback-function #'erc-nick-popup
- "Escape hatch for those needing a different nickname callback.")
+(defvar erc-button-nickname-callback-function #'erc-button--perform-nick-popup
+ "Escape hatch for users needing a non-standard nick-button callback.
+Value should be a function accepting a NICK and any number of
+trailing arguments that are as yet unspecified. Runs when
+clicking \\`<mouse-1>' or hitting \\`RET' atop a nickname button.")
+(make-obsolete-variable 'erc-button-nickname-callback-function
+ "default provides essential functionality" "30.1")
(defun erc-button-add-buttons ()
"Find external references in the current buffer and make buttons of them.
@@ -745,6 +750,10 @@ erc-nick-popup
(funcall code nick)
(eval code `((nick . ,nick)))))))
+(defun erc-button--perform-nick-popup (nick &rest _)
+ "Call `erc-nick-popup' with NICK."
+ (erc-nick-popup nick))
+
;;; Callback functions
(defun erc-button-describe-symbol (symbol-name)
"Describe SYMBOL-NAME.
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-5.6-Add-line-wise-movement-commands-for-erc-fill-wra.patch --]
[-- Type: text/x-patch, Size: 8228 bytes --]
From b6685530bd6fc8faba289df0672fe0be942f95bc Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 6 Aug 2023 22:05:26 -0700
Subject: [PATCH 3/3] [5.6] Add line-wise movement commands for erc-fill-wrap
* lisp/erc/erc-fill.el (erc-fill--wrap-escape-hidden-speaker): New
helper to move point to beginning of visible text.
(erc-fill--wrap-beginning-of-line): Factor out adjustment for hidden
speakers.
(erc-fill--wrap-previous-line, erc-fill--wrap-next-line): Add commands
for moving to previous and next line in a manner consistent with the
value of `erc-fill--wrap-visual-keys'.
(erc-fill-warp-mode-map): Add bindings for `next-line' and
`previous-line'.
(erc-fill-wrap-mode): Revise doc string.
(erc-fill-wrap-nudge): Fix vertical anchoring so that point's line
remains fixed throughout the adjustment. The previous approach
crudely approximated the current window line by betting that all
messages are roughly the same length. It also wrongly assumed that
`point-max' at least equaled `window-end'. That is, it did not
account for blank space between EOB and the bottom of the
window. (Bug#60936)
---
lisp/erc/erc-fill.el | 70 +++++++++++++++++++++++++++++++-------------
1 file changed, 50 insertions(+), 20 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e2a82582a3f..7eace924da7 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -262,6 +262,14 @@ erc-fill--wrap-kill-line
;; `kill-line' anyway so that users can see the error.
(erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+(defun erc-fill--wrap-escape-hidden-speaker ()
+ "Move to start of message text when left of speaker.
+Basically mimic what `move-beginning-of-line' does with invisible text."
+ (when-let ((erc-fill-wrap-merge)
+ (prop (get-text-property (point) 'display))
+ ((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
+ (goto-char (text-property-not-all (point) (pos-eol) 'display prop))))
+
(defun erc-fill--wrap-beginning-of-line (arg)
"Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
(interactive "^p")
@@ -271,10 +279,22 @@ erc-fill--wrap-beginning-of-line
(if (get-text-property (point) 'erc-prompt)
(goto-char erc-input-marker)
;; Mimic what `move-beginning-of-line' does with invisible text.
- (when-let ((erc-fill-wrap-merge)
- (prop (get-text-property (point) 'display))
- ((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
- (goto-char (text-property-not-all (point) (pos-eol) 'display prop)))))
+ (erc-fill--wrap-escape-hidden-speaker)))
+
+(defun erc-fill--wrap-previous-line (&optional arg try-vscroll)
+ "Move to ARGth previous screen or logical line."
+ (interactive "^p\np")
+ (if erc-fill--wrap-visual-keys
+ (with-no-warnings (previous-line arg try-vscroll))
+ (prog1 (previous-logical-line arg try-vscroll)
+ (erc-fill--wrap-escape-hidden-speaker))))
+
+(defun erc-fill--wrap-next-line (&optional arg try-vscroll)
+ "Move to ARGth next screen or logical line."
+ (interactive "^p\np")
+ (if erc-fill--wrap-visual-keys
+ (with-no-warnings (next-line arg try-vscroll))
+ (next-logical-line arg try-vscroll)))
(defun erc-fill--wrap-end-of-line (arg)
"Defer to `move-end-of-line' or `end-of-visual-line'."
@@ -320,6 +340,8 @@ erc-fill-wrap-mode-map
"<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
"<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
"<remap> <toggle-truncate-lines>" #'erc-fill-wrap-toggle-truncate-lines
+ "<remap> <next-line>" #'erc-fill--wrap-next-line
+ "<remap> <previous-line>" #'erc-fill--wrap-previous-line
"C-c a" #'erc-fill-wrap-cycle-visual-movement
;; Not sure if this is problematic because `erc-bol' takes no args.
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
@@ -359,28 +381,36 @@ erc-fill--wrap-ensure-dependencies
;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
-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', `stamp', and `button' modules and assumes
-users who've defined their own `erc-insert-timestamp-function'
-have also customized the option `erc-fill-wrap-margin-side' to an
-explicit side. To use this module, either include `fill-wrap' in
-`erc-modules' or set `erc-fill-function' to `erc-fill-wrap'.
-Manually invoking one of the minor-mode toggles is not
-recommended.
+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
+\\[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-oriented movement commands.
This module imposes various restrictions on the appearance of
timestamps. Most notably, it insists on displaying them in the
margins. Users preferring left-sided stamps may notice that ERC
also displays the prompt in the left margin, possibly truncating
-or padding it to constrain it to the margin's width. When stamps
+or padding it to constrain it to the margin's width.
+Additionally, this module assumes that users providing their own
+`erc-insert-timestamp-function' have also customized the option
+`erc-fill-wrap-margin-side' to an explicit side. When stamps
appear in the right margin, which they do by default, users may
find that ERC actually appends them to copy-as-killed messages
without an intervening space. This normally poses at most a
minor inconvenience, however users of the `log' module may prefer
a workaround provided by `erc-stamp-prefix-log-filter', which
strips trailing stamps from logged messages and instead prepends
-them to every line."
+them to every line.
+
+As a so-called \"local\" module, `fill-wrap' depends on the
+global modules `fill', `stamp', and `button'; it activates them
+as needed when initializing. Please note that enabling and
+disabling this module by invoking one of its minor-mode toggles
+is not recommended."
((erc-fill--wrap-ensure-dependencies)
(erc--restore-initialize-priors erc-fill-wrap-mode
erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys
@@ -548,8 +578,8 @@ erc-fill-wrap-nudge
(user-error "Command called in an undisplayed buffer"))
(let* ((total (erc-fill--wrap-nudge arg))
(leftp erc-stamp--margin-left-p)
- (win-ratio (/ (float (- (window-point) (window-start)))
- (- (window-end nil t) (window-start)))))
+ ;; Anchor current line vertically.
+ (line (count-screen-lines (window-start) (window-point))))
(when (zerop arg)
(setq arg 1))
(erc-compat-call
@@ -564,7 +594,7 @@ erc-fill-wrap-nudge
(lambda ()
(interactive)
(cl-incf total (erc-fill--wrap-nudge a))
- (recenter (round (* win-ratio (window-height))))))))
+ (recenter line)))))
(dolist (key '(?\) ?_ ?+))
(let ((a (pcase key
(?\) 0)
@@ -575,7 +605,7 @@ erc-fill-wrap-nudge
(interactive)
(erc-stamp--adjust-margin (- a) (zerop a))
(when leftp (erc-stamp--refresh-left-margin-prompt))
- (recenter (round (* win-ratio (window-height))))))))
+ (recenter line)))))
map)
t
(lambda ()
@@ -584,7 +614,7 @@ erc-fill-wrap-nudge
(if leftp left-margin-width right-margin-width)))
"Use %k for further adjustment"
1)
- (recenter (round (* win-ratio (window-height))))))
+ (recenter line)))
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-08-09 14:53 ` J.P.
@ 2023-08-09 16:50 ` Michael Albinus
[not found] ` <87jzu4upl9.fsf@gmx.de>
1 sibling, 0 replies; 56+ messages in thread
From: Michael Albinus @ 2023-08-09 16:50 UTC (permalink / raw)
To: J.P.; +Cc: 60936, emacs-erc
"J.P." <jp@neverwas.me> writes:
Hi,
> There have been three failures (all on native-comp-speed2-master) over
> the last three weeks pointing to these tests, which haven't changed in
> the year-plus they've existed in tree. No test appears in multiple
> failures, and all continue to pass daily on commercial GitLab (GCP)
> runners using the same EMBA container image. They also pass locally
> with "make check" and "make -j -C test SELECTOR=t check-lisp-erc". If
> these tweaks don't fix the problem, they can be branded :unstable.
If the problem happens only on emba, you can skip the tests with
--8<---------------cut here---------------start------------->8---
:tags (if (getenv "EMACS_EMBA_CI")
'(:expensive-test :unstable)
'(:expensive-test))
--8<---------------cut here---------------end--------------->8---
Best regards, Michael.
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87jzu4upl9.fsf@gmx.de>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87jzu4upl9.fsf@gmx.de>
@ 2023-08-15 14:01 ` J.P.
[not found] ` <87v8dgh0af.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-08-15 14:01 UTC (permalink / raw)
To: Michael Albinus; +Cc: 60936, emacs-erc
Michael Albinus <michael.albinus@gmx.de> writes:
> "J.P." <jp@neverwas.me> writes:
>
> Hi,
>
>> There have been three failures (all on native-comp-speed2-master) over
>> the last three weeks pointing to these tests, which haven't changed in
>> the year-plus they've existed in tree. No test appears in multiple
>> failures, and all continue to pass daily on commercial GitLab (GCP)
>> runners using the same EMBA container image. They also pass locally
>> with "make check" and "make -j -C test SELECTOR=t check-lisp-erc". If
>> these tweaks don't fix the problem, they can be branded :unstable.
>
> If the problem happens only on emba, you can skip the tests with
>
> :tags (if (getenv "EMACS_EMBA_CI")
> '(:expensive-test :unstable)
> '(:expensive-test))
>
> Best regards, Michael.
Thanks Michael. I guess checking for
(equal (get-env "CI_JOB_STAGE") "native-comp")
might also help unless that's inadvisable for some reason (though I'm
still hoping it doesn't come to this). And not that you should care, but
I've been waiting for
bug#65176: ~25 test failures from make check in the latest master
to wrap up before installing this or similar.
BTW, does EMBA expose any public /metrics endpoints? I ask because
perhaps investigating possible relationships between intermittent
EMBA-only job failures and something like node-exporter signals [1]
might prove fruitful. Just a thought.
[1] https://docs.gitlab.com/ee/administration/monitoring/prometheus/index.html#prometheus-as-a-grafana-data-source
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87v8dgh0af.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87v8dgh0af.fsf@neverwas.me>
@ 2023-08-15 16:12 ` Michael Albinus
[not found] ` <87sf8kuvxr.fsf@gmx.de>
1 sibling, 0 replies; 56+ messages in thread
From: Michael Albinus @ 2023-08-15 16:12 UTC (permalink / raw)
To: J.P.; +Cc: 60936, emacs-erc
"J.P." <jp@neverwas.me> writes:
Hi,
> Thanks Michael. I guess checking for
>
> (equal (get-env "CI_JOB_STAGE") "native-comp")
>
> might also help unless that's inadvisable for some reason (though I'm
> still hoping it doesn't come to this).
Should be OK. If you use `getenv'.
> And not that you should care, but I've been waiting for
>
> bug#65176: ~25 test failures from make check in the latest master
>
> to wrap up before installing this or similar.
This bug has been closed yesterday.
> BTW, does EMBA expose any public /metrics endpoints? I ask because
> perhaps investigating possible relationships between intermittent
> EMBA-only job failures and something like node-exporter signals [1]
> might prove fruitful. Just a thought.
>
> [1] https://docs.gitlab.com/ee/administration/monitoring/prometheus/index.html#prometheus-as-a-grafana-data-source
I've enabled the /metrics endpoint on emba. This requires a restart of
gitlab, which I haven't done. Should happen next time, when gitlab
patches are installed (which is not my responsibility).
Best regards, Michael.
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87sf8kuvxr.fsf@gmx.de>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87sf8kuvxr.fsf@gmx.de>
@ 2023-08-15 16:37 ` Michael Albinus
[not found] ` <87leecuuqu.fsf@gmx.de>
1 sibling, 0 replies; 56+ messages in thread
From: Michael Albinus @ 2023-08-15 16:37 UTC (permalink / raw)
To: J.P.; +Cc: 60936, emacs-erc
Michael Albinus <michael.albinus@gmx.de> writes:
Hi,
>> BTW, does EMBA expose any public /metrics endpoints? I ask because
>> perhaps investigating possible relationships between intermittent
>> EMBA-only job failures and something like node-exporter signals [1]
>> might prove fruitful. Just a thought.
>>
>> [1] https://docs.gitlab.com/ee/administration/monitoring/prometheus/index.html#prometheus-as-a-grafana-data-source
>
> I've enabled the /metrics endpoint on emba. This requires a restart of
> gitlab, which I haven't done. Should happen next time, when gitlab
> patches are installed (which is not my responsibility).
Hmm. I've just read <https://docs.gitlab.com/ee/operations/>. It tells us
--8<---------------cut here---------------start------------->8---
Measure reliability and stability with metrics (removed)
This feature was deprecated in GitLab 14.7 and removed in 16.0.
--8<---------------cut here---------------end--------------->8---
So it might work ATM (we're using GitLab CE 13.12.15), but it might
disappear in the future.
Best regards, Michael.
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87leecuuqu.fsf@gmx.de>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87leecuuqu.fsf@gmx.de>
@ 2023-08-16 14:28 ` J.P.
2023-08-16 17:38 ` Michael Albinus
0 siblings, 1 reply; 56+ messages in thread
From: J.P. @ 2023-08-16 14:28 UTC (permalink / raw)
To: Michael Albinus; +Cc: 60936, emacs-erc
Michael Albinus <michael.albinus@gmx.de> writes:
> Michael Albinus <michael.albinus@gmx.de> writes:
>
>> I've enabled the /metrics endpoint on emba. This requires a restart of
>> gitlab, which I haven't done. Should happen next time, when gitlab
>> patches are installed (which is not my responsibility).
>
> Hmm. I've just read <https://docs.gitlab.com/ee/operations/>. It tells us
>
> Measure reliability and stability with metrics (removed)
>
> This feature was deprecated in GitLab 14.7 and removed in 16.0.
>
> So it might work ATM (we're using GitLab CE 13.12.15), but it might
> disappear in the future.
Hi Michael. This deprecation notice appears to be about GitLab's metrics
feature, which they describe as a managed Prometheus instance and
integrated dashboard solution for their enterprise product. Apparently,
they're replacing that with a full observability offering. In case
you're curious, they also say [1]:
This deprecation does not include:
- Deprecating alerts for Prometheus
- Capabilities that GitLab comes with that allow operators of GitLab
to retrieve metrics from those instances [2]
It's the second bullet I was referring to initially, which allows
external Prometheus instances to poll the /-/metrics endpoint if
exposed. But to be of any use, those instances would need their IP
addresses whitelisted. Additionally, we'd need a "node exporter" [3]
process running on the same host to provide intel on system-resource
consumption. In the end, this is probably too involved to be worth
anyone's while. So, I guess you can probably just revert whatever change
you made to the configuration. Thanks anyway and please pardon the
distraction.
[1] https://gitlab.com/gitlab-org/gitlab/-/issues/346541
[2] https://docs.gitlab.com/ee/administration/monitoring/prometheus/gitlab_metrics.html
[3] https://prometheus.io/docs/guides/node-exporter/
^ permalink raw reply [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-08-16 14:28 ` J.P.
@ 2023-08-16 17:38 ` Michael Albinus
0 siblings, 0 replies; 56+ messages in thread
From: Michael Albinus @ 2023-08-16 17:38 UTC (permalink / raw)
To: J.P.; +Cc: 60936, emacs-erc
"J.P." <jp@neverwas.me> writes:
Hi,
> It's the second bullet I was referring to initially, which allows
> external Prometheus instances to poll the /-/metrics endpoint if
> exposed. But to be of any use, those instances would need their IP
> addresses whitelisted. Additionally, we'd need a "node exporter" [3]
> process running on the same host to provide intel on system-resource
> consumption. In the end, this is probably too involved to be worth
> anyone's while. So, I guess you can probably just revert whatever change
> you made to the configuration. Thanks anyway and please pardon the
> distraction.
No problem. I've disabled it on emba.
Best regards, Michael.
^ permalink raw reply [flat|nested] 56+ messages in thread
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (17 preceding siblings ...)
2023-08-09 14:53 ` J.P.
@ 2023-08-31 13:31 ` J.P.
[not found] ` <87il8vxrr1.fsf@neverwas.me>
` (6 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-08-31 13:31 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1318 bytes --]
One of my patches for this feature introduced a corner-case regression
involving the option `erc-echo-timestamps'. If `cursor-sensor-mode' is
somehow enabled outside of this module, then timestamps will still be
echoed even when `erc-echo-timestamps' is nil.
commit ad3dc74e074719a58226e23a45c4556cd54c0a48
Author: F. Jason Park <jp@neverwas.me>
Date: Wed Nov 24 03:10:20 2021 -0800
Expose insertion time as text prop in erc-stamp
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
[...]
(erc-echo-timestamp): Make interactive and show timestamps even when
the variable `erc-echo-timestamps' is nil.
(erc--echo-ts-csf): Add new function to serve as value of
cursor-sensor function text properties.
* test/lisp/erc/erc-stamp-tests.el: New file. (Bug#60936.)
lisp/erc/erc-stamp.el | 15 ++-
test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++++++++++
2 files changed, 217 insertions(+), 5 deletions(-)
In addition to addressing the above, the attached patch includes a new
optional parameter for the command `erc-echo-timestamp'. It allows for
specifying a timezone for the echoed stamp via prefix argument or a new
option, `erc-echo-timestamp-zone'.
These changes are intended for ERC 5.6.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Allow-alternate-ert-info-text-in-ERC-test-utilit.patch --]
[-- Type: text/x-patch, Size: 15332 bytes --]
From 1ca0862854ff5f926ed45b06cc494aa7f7f2b1b7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 25 Aug 2023 19:03:26 -0700
Subject: [PATCH 1/2] [5.6] ; Allow alternate ert-info text in ERC test utility
* test/lisp/erc/erc-tests.el
(erc-tests--assert-printed-in-subprocess): Don't insist that arguments
to the Emacs "-load" invocation option be actual disk files.
* test/lisp/erc/resources/base/assoc/bumped/again.eld: Adjust timeouts.
* test/lisp/erc/resources/base/assoc/bumped/foisted.eld: Adjust timeouts.
* test/lisp/erc/resources/base/assoc/bumped/refoisted.eld: Adjust timeouts.
* test/lisp/erc/resources/base/netid/bouncer/barnet.eld: Adjust timeouts.
* test/lisp/erc/resources/base/netid/bouncer/foonet.eld: Adjust
timeouts.
* test/lisp/erc/resources/base/renick/self/qual-chester.eld: Adjust
timeouts.
* test/lisp/erc/resources/base/renick/self/qual-tester.eld: Adjust
timeouts.
* test/lisp/erc/resources/erc-d/erc-d-t.el
(erc-d-t--wait-message-prefix, erc-d-t-wait-for, erc-d-t-ensure-for):
Add and use new variable to make `ert-info' message prefix adjustable.
The immediate use for this is to make it easier to distinguish between
consecutive assertions in which the first waits for a condition and
the second ensures it holds for some duration.
* test/lisp/erc/resources/erc-d/erc-d-u.el
(erc-d-u--read-exchange-default): Skip killed buffers.
* test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld: Adjust
timeout.
* test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld: Adjust
timeouts.
* test/lisp/erc/resources/erc-d/resources/linger.eld: Adjust timeouts.
---
test/lisp/erc/erc-tests.el | 3 +--
test/lisp/erc/resources/base/assoc/bumped/again.eld | 10 +++++-----
test/lisp/erc/resources/base/assoc/bumped/foisted.eld | 10 +++++-----
.../lisp/erc/resources/base/assoc/bumped/refoisted.eld | 8 ++++----
test/lisp/erc/resources/base/netid/bouncer/barnet.eld | 2 +-
test/lisp/erc/resources/base/netid/bouncer/foonet.eld | 2 +-
.../erc/resources/base/renick/self/qual-chester.eld | 2 +-
.../erc/resources/base/renick/self/qual-tester.eld | 2 +-
test/lisp/erc/resources/erc-d/erc-d-t.el | 7 +++++--
test/lisp/erc/resources/erc-d/erc-d-u.el | 1 +
.../erc/resources/erc-d/resources/dynamic-barnet.eld | 4 ++--
.../erc/resources/erc-d/resources/dynamic-foonet.eld | 2 +-
test/lisp/erc/resources/erc-d/resources/linger.eld | 4 ++--
13 files changed, 30 insertions(+), 27 deletions(-)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 9fdad823059..7e01efe95cf 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -2038,8 +2038,7 @@ erc-tests--assert-printed-in-subprocess
;; This is for integrations testing with managed configs
;; ("starter kits") that use a different package manager.
(init (and-let* ((found (getenv "ERC_TESTS_INIT"))
- (files (split-string found ","))
- ((seq-every-p #'file-exists-p files)))
+ (files (split-string found ",")))
(mapcan (lambda (f) (list "-l" f)) files)))
(prog
`(progn
diff --git a/test/lisp/erc/resources/base/assoc/bumped/again.eld b/test/lisp/erc/resources/base/assoc/bumped/again.eld
index ab3c7b06214..aef164b6237 100644
--- a/test/lisp/erc/resources/base/assoc/bumped/again.eld
+++ b/test/lisp/erc/resources/base/assoc/bumped/again.eld
@@ -1,10 +1,10 @@
;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0.0 ":irc.foonet.org 433 * tester :Nickname is reserved by a different account")
(0.0 ":irc.foonet.org FAIL NICK NICKNAME_RESERVED tester :Nickname is reserved by a different account"))
-((nick 3 "NICK tester`")
+((nick 10 "NICK tester`")
(0.1 ":irc.foonet.org 001 tester` :Welcome to the foonet IRC Network tester`")
(0.0 ":irc.foonet.org 002 tester` :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5")
(0.0 ":irc.foonet.org 003 tester` :This server was created Fri, 24 Sep 2021 01:38:36 UTC")
@@ -21,10 +21,10 @@
(0.2 ":irc.foonet.org 266 tester` 3 3 :Current global users 3, max 3")
(0.0 ":irc.foonet.org 422 tester` :MOTD File is missing"))
-((mode-user 3.2 "MODE tester` +i")
+((mode-user 10 "MODE tester` +i")
(0.0 ":irc.foonet.org 221 tester` +i")
(0.0 ":irc.foonet.org NOTICE tester` :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."))
-((privmsg 42.6 "PRIVMSG NickServ :IDENTIFY tester changeme")
+((privmsg 10 "PRIVMSG NickServ :IDENTIFY tester changeme")
(0.01 ":tester`!~u@rpaau95je67ci.irc NICK tester")
(0.0 ":NickServ!NickServ@localhost NOTICE tester :You're now logged in as tester"))
diff --git a/test/lisp/erc/resources/base/assoc/bumped/foisted.eld b/test/lisp/erc/resources/base/assoc/bumped/foisted.eld
index 5c36e58d9d3..0f7aadac564 100644
--- a/test/lisp/erc/resources/base/assoc/bumped/foisted.eld
+++ b/test/lisp/erc/resources/base/assoc/bumped/foisted.eld
@@ -1,6 +1,6 @@
;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5")
(0.0 ":irc.foonet.org 003 tester :This server was created Fri, 24 Sep 2021 01:38:36 UTC")
@@ -17,14 +17,14 @@
(0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0.0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0.0 ":irc.foonet.org 221 tester +i")
(0.0 ":irc.foonet.org NOTICE tester :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."))
-((privmsg 17.21 "PRIVMSG bob :hi")
+((privmsg 10 "PRIVMSG bob :hi")
(0.02 ":bob!~u@ecnnh95wr67pv.net PRIVMSG tester :hola")
(0.01 ":bob!~u@ecnnh95wr67pv.net PRIVMSG tester :how r u?"))
-((quit 18.19 "QUIT :" quit)
+((quit 10 "QUIT :" quit)
(0.01 ":tester!~u@rpaau95je67ci.irc QUIT :Quit: " quit))
((drop 1 DROP))
diff --git a/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld b/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld
index 33e4168ac46..63366d3f576 100644
--- a/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld
+++ b/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld
@@ -1,6 +1,6 @@
;; -*- mode: lisp-data; -*-
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0.1 ":irc.foonet.org 001 dummy :Welcome to the foonet IRC Network dummy")
(0.0 ":irc.foonet.org 002 dummy :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5")
(0.0 ":irc.foonet.org 003 dummy :This server was created Fri, 24 Sep 2021 01:38:36 UTC")
@@ -22,10 +22,10 @@
(0.01 ":bob!~u@ecnnh95wr67pv.net PRIVMSG dummy :back?")
)
-((mode-user 1.2 "MODE dummy +i")
+((mode-user 10 "MODE dummy +i")
(0.0 ":irc.foonet.org 221 dummy +i")
(0.0 ":irc.foonet.org NOTICE dummy :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."))
-((renick 42.6 "NICK tester")
+((renick 10 "NICK tester")
(0.01 ":dummy!~u@rpaau95je67ci.irc NICK tester")
(0.0 ":NickServ!NickServ@localhost NOTICE dummy :You're now logged in as tester"))
diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld
index 204d01fef77..596383c2699 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld
@@ -38,4 +38,4 @@
(0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: As he regards his aged father's life.")
(0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it."))
-((linger 1 LINGER))
+((linger 2 LINGER))
diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld
index 4445350ca0c..2e1a3ac27da 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld
@@ -43,4 +43,4 @@
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: Orlando, my liege; the youngest son of Sir Rowland de Boys.")
(0.1 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :alice: The ape is dead, and I must conjure him."))
-((linger 1 LINGER))
+((linger 2 LINGER))
diff --git a/test/lisp/erc/resources/base/renick/self/qual-chester.eld b/test/lisp/erc/resources/base/renick/self/qual-chester.eld
index 75b50fe68bd..a224e0451d7 100644
--- a/test/lisp/erc/resources/base/renick/self/qual-chester.eld
+++ b/test/lisp/erc/resources/base/renick/self/qual-chester.eld
@@ -18,7 +18,7 @@
(0 ":irc.foonet.org 266 chester 3 4 :Current global users 3, max 4")
(0 ":irc.foonet.org 422 chester :MOTD File is missing"))
-((mode-user 1.2 "MODE chester +i")
+((mode-user 10 "MODE chester +i")
(0 ":irc.foonet.org 221 chester +i")
(0 ":irc.foonet.org NOTICE chester :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."))
diff --git a/test/lisp/erc/resources/base/renick/self/qual-tester.eld b/test/lisp/erc/resources/base/renick/self/qual-tester.eld
index 25199226658..27061c65223 100644
--- a/test/lisp/erc/resources/base/renick/self/qual-tester.eld
+++ b/test/lisp/erc/resources/base/renick/self/qual-tester.eld
@@ -18,7 +18,7 @@
(0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.foonet.org 221 tester +i")
(0 ":irc.foonet.org NOTICE tester :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."))
diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el b/test/lisp/erc/resources/erc-d/erc-d-t.el
index 7b2adf4f07b..cf869fb3c70 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-t.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-t.el
@@ -83,6 +83,8 @@ erc-d-t-with-cleanup
(ignore-errors (kill-buffer buf)))))
(sleep-for erc-d-t-cleanup-sleep-secs)))))
+(defvar erc-d-t--wait-message-prefix "Awaiting: ")
+
(defmacro erc-d-t-wait-for (max-secs msg &rest body)
"Wait for BODY to become non-nil.
Or signal error with MSG after MAX-SECS. When MAX-SECS is negative,
@@ -99,7 +101,7 @@ erc-d-t-wait-for
(let ((inverted (make-symbol "inverted"))
(time-out (make-symbol "time-out"))
(result (make-symbol "result")))
- `(ert-info ((concat "Awaiting: " ,msg))
+ `(ert-info ((concat erc-d-t--wait-message-prefix ,msg))
(let ((,time-out (abs ,max-secs))
(,inverted (< ,max-secs 0))
(,result ',result))
@@ -120,7 +122,8 @@ erc-d-t-ensure-for
(unless (or (stringp msg) (memq (car-safe msg) '(format concat)))
(push msg body)
(setq msg (prin1-to-string body)))
- `(erc-d-t-wait-for (- (abs ,max-secs)) ,msg (not (progn ,@body))))
+ `(let ((erc-d-t--wait-message-prefix "Sustaining: "))
+ (erc-d-t-wait-for (- (abs ,max-secs)) ,msg (not (progn ,@body)))))
(defun erc-d-t-search-for (timeout text &optional from on-success)
"Wait for TEXT to appear in current buffer before TIMEOUT secs.
diff --git a/test/lisp/erc/resources/erc-d/erc-d-u.el b/test/lisp/erc/resources/erc-d/erc-d-u.el
index e26fa8b47dd..c7d6859e3e1 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-u.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-u.el
@@ -74,6 +74,7 @@ erc-d-u--read-exchange-default
(let ((hunks (erc-d-u-scan-e-sd info))
(pos (erc-d-u-scan-e-pos info)))
(or (and (erc-d-u-scan-d-hunks hunks)
+ (buffer-live-p (erc-d-u-scan-d-buf hunks))
(with-current-buffer (erc-d-u-scan-d-buf hunks)
(goto-char pos)
(condition-case _err
diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld
index 4994e9c5503..e8feb2e6fd8 100644
--- a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld
+++ b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld
@@ -18,14 +18,14 @@
(0. ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
(0. ":irc.barnet.org 422 tester :MOTD File is missing"))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 2 "MODE tester +i")
(0. ":irc.barnet.org 221 tester +Zi")
(0. ":irc.barnet.org 306 tester :You have been marked as being away")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
(0 ":irc.barnet.org 353 joe = #chan :+joe!~joe@example.com @%+mike!~mike@example.org")
(0 ":irc.barnet.org 366 joe #chan :End of NAMES list"))
-((mode 1 "MODE #chan")
+((mode 3 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620805269")
(0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: Yes, a dozen; and as many to the vantage, as would store the world they played for.")
diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
index a47998e7d32..4855c178861 100644
--- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
+++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
@@ -17,7 +17,7 @@
(0. ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0. ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 2 "MODE tester +i")
(0. ":irc.foonet.org 221 tester +Zi")
(0. ":irc.foonet.org 306 tester :You have been marked as being away")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
diff --git a/test/lisp/erc/resources/erc-d/resources/linger.eld b/test/lisp/erc/resources/erc-d/resources/linger.eld
index 36c81a3af4b..e456370a800 100644
--- a/test/lisp/erc/resources/erc-d/resources/linger.eld
+++ b/test/lisp/erc/resources/erc-d/resources/linger.eld
@@ -20,14 +20,14 @@
(0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.example.org 422 tester :MOTD File is missing"))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 2 "MODE tester +i")
(0 ":irc.example.org 221 tester +Zi")
(0 ":irc.example.org 306 tester :You have been marked as being away")
(0 ":tester!~tester@localhost JOIN #chan")
(0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
(0 ":irc.example.org 366 alice #chan :End of NAMES list"))
-((mode-chan 1.2 "MODE #chan")
+((mode-chan 2 "MODE #chan")
(0 ":bob!~bob@example.org PRIVMSG #chan :hey"))
((linger 1.0 LINGER))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Add-optional-timezone-param-to-erc-echo-timestam.patch --]
[-- Type: text/x-patch, Size: 10631 bytes --]
From 9a5b2bd7e9ce32bafbb3f204cc1b4a7d5069e9e5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 30 Aug 2023 23:15:22 -0700
Subject: [PATCH 2/2] [5.6] Add optional timezone param to erc-echo-timestamp
* etc/ERC-NEWS: Mention option `erc-echo-timestamp-zone'.
* lisp/erc/erc-stamp.el (erc-echo-timestamps): Mention that some
finagling is required if enabling this option after activating the
module.
(erc-echo-timestamp-format): Add additional Custom choice constants.
(erc-echo-timestamp-zone): New option to specify timezone for option
`erc-echo-timestamps' and function `erc-echo-timestamp'.
(erc-stamp-mode, erc-stamp-enable, erc-stamp-disable): Call
`erc-stamp--setup' instead of `erc-munge-invisibility-spec'.
(erc-munge-invisibility-spec): Perform teardown when boolean flag
options, like `erc-timestamp-intangible' and `erc-echo-timestamps' are
nil.
(erc-stamp--setup): Call `erc-munge-invisibility-spec).
(erc-stamp--last-stamp, erc-stamp--on-clear-message): New function and
helper state variable to tell Emacs not to clear the current timestamp
message when navigating within the same IRC message.
(erc-echo-timestamp): Add optional `zone' parameter, to be passed
directly to `format-time-string', when non-interactive, and massaged
sensibly otherwise. Set the local variable `erc-stamp--last-stamp'.
* test/lisp/erc/erc-stamp-tests.el (erc-echo-timestamp): New test.
(Bug#60936)
---
etc/ERC-NEWS | 13 +++--
lisp/erc/erc-stamp.el | 83 ++++++++++++++++++++++++++------
test/lisp/erc/erc-stamp-tests.el | 30 ++++++++++++
3 files changed, 107 insertions(+), 19 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 7ee55982b17..69088732c0d 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -203,11 +203,18 @@ continued integration. With the existing design, merely loading the
library 'erc-log' caused 'truncate' to start writing logs, possibly
against a user's wishes.
+** The function 'erc-echo-timestamp' is now a command.
+The option 'erc-echo-timestamps' (plural) enables the contextual
+echoing of timestamps to the echo area when moving between messages in
+an ERC buffer. This functionality is now available on demand by
+invoking the newly interactive function 'erc-echo-timestamp' atop any
+message. And the new companion option 'erc-echo-timestamp-zone'
+determines the default timezone when not specified with a prefix
+argument.
+
** Miscellaneous UX changes.
Some minor quality-of-life niceties have finally made their way to
-ERC. For example, the function 'erc-echo-timestamp' is now
-interactive and can be invoked on any message to view its timestamp in
-the echo area. Fool visibility has become togglable with the new
+ERC. For example, fool visibility has become togglable with the new
command 'erc-match-toggle-hidden-fools'. The 'button' module's
'erc-button-previous' now moves to the beginning instead of the end of
buttons. A new command, 'erc-news', can be invoked to visit this very
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index a021cd26607..be12d6080d2 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -136,14 +136,27 @@ erc-echo-timestamps
"If non-nil, print timestamp in the minibuffer when point is moved.
Using this variable, you can turn off normal timestamping,
and simply move point to an irc message to see its timestamp
-printed in the minibuffer."
+printed in the minibuffer. When attempting to enable this option
+after `erc-stamp-mode' is already active, you may need to run the
+command `erc-show-timestamps', `erc-hide-timestamps', or similar
+in the appropriate ERC buffer."
:type 'boolean)
(defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S"
"Format string to be used when `erc-echo-timestamps' is non-nil.
This string specifies the format of the timestamp being echoed in
the minibuffer."
- :type 'string)
+ :type '(choice (const "Timestamped %A, %H:%M:%S")
+ (const "%Y-%m-%d %H:%M:%S %Z")
+ string))
+
+(defcustom erc-echo-timestamp-zone nil
+ "Default timezone for the option `erc-echo-timestamps'.
+Also affects the command `erc-echo-timestamp' (singular). See
+the ZONE parameter of `format-time-string' for a description of
+acceptable value types."
+ :type '(choice boolean number (const wall) (list number string))
+ :package-version '(ERC . "5.6")) ; FIXME sync on release
(defcustom erc-timestamp-intangible nil
"Whether the timestamps should be intangible, i.e. prevent the point
@@ -167,14 +180,16 @@ stamp
(add-hook 'erc-send-modify-hook #'erc-add-timestamp 60)
(add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
(add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
- (unless erc--updating-modules-p
- (erc-buffer-do #'erc-munge-invisibility-spec)))
+ (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup)))
((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
(remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
(erc-with-all-buffers-of-server nil nil
+ (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible)
+ (erc-stamp--setup))
+ (kill-local-variable 'erc-stamp--last-stamp)
(kill-local-variable 'erc-timestamp-last-inserted)
(kill-local-variable 'erc-timestamp-last-inserted-left)
(kill-local-variable 'erc-timestamp-last-inserted-right))))
@@ -640,14 +655,31 @@ erc-format-timestamp
;; please modify this function and move it to a more appropriate
;; location.
(defun erc-munge-invisibility-spec ()
- (and erc-timestamp-intangible (not (bound-and-true-p cursor-intangible-mode))
- (cursor-intangible-mode 1))
- (and erc-echo-timestamps (not (bound-and-true-p cursor-sensor-mode))
- (cursor-sensor-mode 1))
+ (if erc-timestamp-intangible
+ (cursor-intangible-mode +1) ; idempotent
+ (when (bound-and-true-p cursor-intangible-mode)
+ (cursor-intangible-mode -1)))
+ (if erc-echo-timestamps
+ (progn
+ (cursor-sensor-mode +1) ; idempotent
+ (when (<= 29 emacs-major-version)
+ (add-function :before-until (local 'clear-message-function)
+ #'erc-stamp--on-clear-message)))
+ (when (bound-and-true-p cursor-sensor-mode)
+ (cursor-sensor-mode -1))
+ (remove-function (local 'clear-message-function)
+ #'erc-stamp--on-clear-message))
(if erc-hide-timestamps
(add-to-invisibility-spec 'timestamp)
(remove-from-invisibility-spec 'timestamp)))
+(defun erc-stamp--setup ()
+ "Enable or disable buffer-local `erc-stamp-mode' modifications."
+ (if erc-stamp-mode
+ (erc-munge-invisibility-spec)
+ (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible)
+ (erc-munge-invisibility-spec))))
+
(defun erc-hide-timestamps ()
"Hide timestamp information from display."
(interactive)
@@ -677,14 +709,33 @@ erc-toggle-timestamps
(erc-munge-invisibility-spec)))
(erc-buffer-list)))
-(defun erc-echo-timestamp (dir stamp)
- "Print timestamp text-property of an IRC message."
- ;; Could also pass an &optional `zone' arg to `format-time-string'.
- (interactive (list 'entered (get-text-property (point) 'erc-timestamp)))
- (when (eq 'entered dir)
- (when stamp
- (message "%s" (format-time-string erc-echo-timestamp-format
- stamp)))))
+(defvar-local erc-stamp--last-stamp nil)
+
+(defun erc-stamp--on-clear-message (&rest _)
+ "Return `dont-clear-message' when operating inside the same stamp."
+ (and erc-stamp--last-stamp erc-echo-timestamps
+ (eq (get-text-property (point) 'erc-timestamp) erc-stamp--last-stamp)
+ 'dont-clear-message))
+
+(defun erc-echo-timestamp (dir stamp &optional zone)
+ "Display timestamp of message at point in echo area.
+Interactively, interpret a numeric prefix as a ZONE offset in
+hours (or seconds, if its abs value is larger than 14), and
+interpret a \"raw\" prefix as UTC. To specify a zone for use
+with the option `erc-echo-timestamps', see the companion option
+`erc-echo-timestamp-zone'."
+ (interactive (list nil (get-text-property (point) 'erc-timestamp)
+ (pcase current-prefix-arg
+ ((and (pred numberp) v)
+ (if (<= (abs v) 14) (* v 3600) v))
+ (`(,_) t))))
+ (if (and stamp (or (null dir) (and erc-echo-timestamps (eq 'entered dir))))
+ (progn
+ (setq erc-stamp--last-stamp stamp)
+ (message (format-time-string erc-echo-timestamp-format
+ stamp (or zone erc-echo-timestamp-zone))))
+ (when (and erc-echo-timestamps (eq 'left dir))
+ (setq erc-stamp--last-stamp nil))))
(defun erc--echo-ts-csf (_window _before dir)
(erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index c448416cd69..b00aa6dcabf 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -274,4 +274,34 @@ erc-timestamp-intangible--left
(when noninteractive
(kill-buffer)))))
+(ert-deftest erc-echo-timestamp ()
+ (should-not erc-echo-timestamps)
+ (should-not erc-stamp--last-stamp)
+ (insert (propertize "abc" 'erc-timestamp 433483200))
+ (goto-char (point-min))
+ (let ((inhibit-message t)
+ (erc-echo-timestamp-format "%Y-%m-%d %H:%M:%S %Z")
+ (erc-echo-timestamp-zone (list (* 60 60 -4) "EDT")))
+
+ ;; No-op when non-interactive and option is nil
+ (should-not (erc--echo-ts-csf nil nil 'entered))
+ (should-not erc-stamp--last-stamp)
+
+ ;; Non-interactive (cursor sensor function)
+ (let ((erc-echo-timestamps t))
+ (should (equal (erc--echo-ts-csf nil nil 'entered)
+ "1983-09-27 00:00:00 EDT")))
+ (should (= 433483200 erc-stamp--last-stamp))
+
+ ;; Interactive
+ (should (equal (call-interactively #'erc-echo-timestamp)
+ "1983-09-27 00:00:00 EDT"))
+ ;; Interactive with zone
+ (let ((current-prefix-arg '(4)))
+ (should (equal (call-interactively #'erc-echo-timestamp)
+ "1983-09-27 04:00:00 GMT")))
+ (let ((current-prefix-arg -7))
+ (should (equal (call-interactively #'erc-echo-timestamp)
+ "1983-09-26 21:00:00 -07")))))
+
;;; erc-stamp-tests.el ends here
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87il8vxrr1.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87il8vxrr1.fsf@neverwas.me>
@ 2023-09-13 14:06 ` J.P.
2023-09-13 15:56 ` Stefan Kangas
[not found] ` <CADwFkmm3bfkXaOvDYXwKr+RsXird-X47rK=QW6M_cuD6YEm=zA@mail.gmail.com>
2 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-09-13 14:06 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> In addition to addressing the above, the attached patch includes a new
> optional parameter for the command `erc-echo-timestamp'. It allows for
> specifying a timezone for the echoed stamp via prefix argument or a new
> option, `erc-echo-timestamp-zone'.
>
> These changes are intended for ERC 5.6.
Added as
commit 7c932fa307851ccef1cf17a1d7eec689af82a0ef
Add optional timezone param to erc-echo-timestamp
This bug is already closed.
^ permalink raw reply [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87il8vxrr1.fsf@neverwas.me>
2023-09-13 14:06 ` J.P.
@ 2023-09-13 15:56 ` Stefan Kangas
[not found] ` <CADwFkmm3bfkXaOvDYXwKr+RsXird-X47rK=QW6M_cuD6YEm=zA@mail.gmail.com>
2 siblings, 0 replies; 56+ messages in thread
From: Stefan Kangas @ 2023-09-13 15:56 UTC (permalink / raw)
To: J.P., 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> One of my patches for this feature introduced a corner-case regression
> involving the option `erc-echo-timestamps'. If `cursor-sensor-mode' is
> somehow enabled outside of this module, then timestamps will still be
> echoed even when `erc-echo-timestamps' is nil.
>
> commit ad3dc74e074719a58226e23a45c4556cd54c0a48
> Author: F. Jason Park <jp@neverwas.me>
> Date: Wed Nov 24 03:10:20 2021 -0800
>
> Expose insertion time as text prop in erc-stamp
>
> * lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
> [...]
> (erc-echo-timestamp): Make interactive and show timestamps even when
> the variable `erc-echo-timestamps' is nil.
> (erc--echo-ts-csf): Add new function to serve as value of
> cursor-sensor function text properties.
> * test/lisp/erc/erc-stamp-tests.el: New file. (Bug#60936.)
I'm seeing new test failures with this file on master:
Running 6 tests (2023-09-13 16:45:56+0200, selector ‘(not (or (tag
:expensive-test) (tag :unstable) (tag :nativecomp)))’)
Test erc-echo-timestamp backtrace:
signal(ert-test-failed (((should (equal (call-interactively #'erc-ec
ert-fail(((should (equal (call-interactively #'erc-echo-timestamp) "
#f(compiled-function () #<bytecode -0x766a19e4460e6be>)()
ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
ert-run-test(#s(ert-test :name erc-echo-timestamp :documentation nil
ert-run-or-rerun-test(#s(ert--stats :selector (not (or ... ... ...))
ert-run-tests((not (or (tag :expensive-test) (tag :unstable) (tag :n
ert-run-tests-batch((not (or (tag :expensive-test) (tag :unstable) (
ert-run-tests-batch-and-exit((not (or (tag :expensive-test) (tag :un
eval((ert-run-tests-batch-and-exit '(not (or (tag :expensive-test) (
command-line-1(("-L" ":." "-l" "ert" "-l" "lisp/erc/erc-stamp-tests"
command-line()
normal-top-level()
Test erc-echo-timestamp condition:
(ert-test-failed
((should (equal (call-interactively ...) "1983-09-27 04:00:00 GMT"))
:form (equal "1983-09-27 04:00:00 UTC" "1983-09-27 04:00:00 GMT")
:value nil :explanation
(array-elt 20 (different-atoms (85 "#x55" "?U") (71 "#x47" "?G")))))
FAILED 1/6 erc-echo-timestamp (0.002433 sec) at
lisp/erc/erc-stamp-tests.el:277
passed 2/6 erc-stamp--display-margin-mode--right (0.009260 sec)
passed 3/6 erc-timestamp-intangible--left (0.012494 sec)
passed 4/6 erc-timestamp-use-align-to--integer (0.007917 sec)
passed 5/6 erc-timestamp-use-align-to--nil (0.015289 sec)
passed 6/6 erc-timestamp-use-align-to--t (0.024845 sec)
Ran 6 tests, 5 results as expected, 1 unexpected (2023-09-13
16:45:56+0200, 0.484120 sec)
1 unexpected results:
FAILED erc-echo-timestamp
GEN lisp/eshell/em-dirs-tests.log
make[3]: *** [lisp/erc/erc-stamp-tests.log] Error 1
In GNU Emacs 30.0.50 (build 3, x86_64-apple-darwin21.6.0, NS
appkit-2113.60 Version 12.6.9 (Build 21G726)) of 2023-09-13 built on
MY-MacBook-Pro
Repository revision: 1f7113e68988fa0bcbdeca5ae364cba8d6db3637
Repository branch: master
Windowing system distributor 'Apple', version 10.3.2113
System Description: macOS 12.6.9
Configured features:
ACL GIF GMP GNUTLS JPEG JSON LCMS2 LIBXML2 MODULES NOTIFY KQUEUE NS
PDUMPER PNG SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS TREE_SITTER WEBP
XIM ZLIB
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <CADwFkmm3bfkXaOvDYXwKr+RsXird-X47rK=QW6M_cuD6YEm=zA@mail.gmail.com>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (19 preceding siblings ...)
[not found] ` <87il8vxrr1.fsf@neverwas.me>
@ 2023-09-22 14:11 ` J.P.
[not found] ` <87a5te47sz.fsf@neverwas.me>
` (4 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-09-22 14:11 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 2285 bytes --]
A couple more bugs stemming from this feature's introduction have
surfaced. The first involves stamp hiding when `erc-fill-wrap-mode' is
enabled. To reproduce from emacs -Q:
- Connect and join a channel
- In the channel buffer, set `erc-timestamp-last-inserted-left' to nil
- Say something and notice a new date stamp inserted
- Run M-x erc-toggle-timestamps RET
- Notice that the message after the stamp is dedented incorrectly
This problem occurs because date stamps are not well defined and
straddle roles occupied by normal stamps and standalone messages. The
remedy I've chosen retains compatibility at the cost of kicking the can
down the road WRT defining the precise role and expected behavior of
date stamps. (If still unclear, I say "date stamp" to mean a left-sided
stamp inserted by the function `erc-insert-timestamp-left-and-right' and
formatted using the string `erc-timestamp-format-left'.) This issue is
closely related to the interplay between normal right-hand stamps and
non-`fill-wrap' fill functions because the latter hard-wrap (i.e.,
"fill") messages, which results in a stamp often residing on its own
line.
The second issue comes down to the lack of an integration with
`text-scale-mode'. To reproduce from emacs -Q:
- Connect from a graphical Emacs
- In the server buffer, hit C-x C-=, and notice misaligned speaker tags
among the upscaled text
- Run a command, like "/msg NickServ help", and notice the leading
`erc-notice-prefix' portion of new messages correctly dedented
- Hit C-x C-0 and observe the just-inserted messages now looking mangled
and the preexisting ones seemingly restored
The problem is that our `line-prefix' values use display specs with
pixel widths, which is needed for speakers with variable-width faces and
non-ascii chars. (Based on a cursory glance at relevant sections of the
manual, it doesn't look like there's an easy way to adjust these
automatically.) For now, I'm proposing we include a command to manually
traverse and refill target buffers. Luckily, this is much faster than
it'd be with some other `erc-fill-function' because no actual "filling"
takes place. We're just remeasuring speaker tags and replacing existing
display-spec values.
If you're affected by these bugs, please try these patches. Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Prefer-ticks-hz-pairs-for-erc-timestamp-values-o.patch --]
[-- Type: text/x-patch, Size: 1752 bytes --]
From c4d98ab82a9edac04abdde59df4055685f17b6cb Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 18 Sep 2023 22:50:28 -0700
Subject: [PATCH 1/3] [5.6] Prefer ticks/hz pairs for erc-timestamp values on
<29
* lisp/erc/erc-compat.el (erc-compat--current-lisp-time): New macro to
prefer ticks/hz pairs on older Emacs versions. They're easier to
compare at a glance when used as values for text properties.
* lisp/erc/erc-stamp.el (erc-stamp--current-time): Use compat macro.
(Bug#60936)
---
lisp/erc/erc-compat.el | 6 ++++++
lisp/erc/erc-stamp.el | 2 +-
2 files changed, 7 insertions(+), 1 deletion(-)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 109b5d245ab..4dae578de67 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -444,6 +444,12 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+(defmacro erc-compat--current-lisp-time ()
+ "Return `current-time' as a frequency pair."
+ (if (>= emacs-major-version 29)
+ '(let (current-time-list) (current-time))
+ '(time-convert nil t)))
+
(provide 'erc-compat)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index f159b6d226f..0f3163bf68d 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -215,7 +215,7 @@ erc-stamp--current-time
(cl-defgeneric erc-stamp--current-time ()
"Return a lisp time object to associate with an IRC message.
This becomes the message's `erc-timestamp' text property."
- (let (current-time-list) (current-time)))
+ (erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
(or erc-stamp--current-time (cl-call-next-method)))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Fix-date-stamp-invisibility-in-erc-fill-wrap.patch --]
[-- Type: text/x-patch, Size: 14131 bytes --]
From 0c2b76532490d85a5b622e57af5aa1320278a20c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 21 Sep 2023 23:54:31 -0700
Subject: [PATCH 2/3] [5.6] Fix date-stamp invisibility in erc-fill-wrap
* lisp/erc/erc-fill.el (erc-fill--wrap-measure): New helper function,
factored out from common code shared by `erc-fill-wrap' and
`erc-fill--wrap-stamp-insert-prefixed-date'.
(erc-fill--wrap-stamp-insert-prefixed-date): Refactor for more general
use and decrement `invisible' bounds, when applicable.
(erc-fill-wrap): Use helper `erc-fill--wrap-measure'.
* lisp/erc/erc-stamp.el (erc-insert-timestamp-left-and-right): Mention
intervals of relevant text props in doc string.
* lisp/erc/erc.el (erc--hide-message): Don't bother offsetting start
of first message in a buffer.
(erc--own-property-names): Add `erc-stamp-type'.
* test/lisp/erc/erc-scenarios-match.el
(erc-scenarios-match--fill-wrap-stamp-dedented-p): New function.
(erc-scenarios-match--stamp-both-invisible-fill-wrap) New test.
(Bug#60936)
---
lisp/erc/erc-fill.el | 54 ++++++++-----
lisp/erc/erc-stamp.el | 9 ++-
lisp/erc/erc.el | 9 ++-
test/lisp/erc/erc-scenarios-match.el | 112 ++++++++++++++++++++++++++-
4 files changed, 162 insertions(+), 22 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index f4835f71278..6d39bcb19b9 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -484,25 +484,45 @@ erc-fill--wrap-continued-message-p
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
-(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
- "Apply `line-prefix' property to args."
- (let* ((ts-left (car args))
- (start)
+(defun erc-fill--wrap-measure (beg end)
+ "Return display spec width for inserted region between BEG and END.
+Ignore any `invisible' props that may be present when figuring."
+ (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region beg end)
+ (let (buffer-invisibility-spec)
+ (list (car (buffer-text-pixel-size)))))
+ (- end beg)))
+
+(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest _)
+ "Apply `line-prefix' property to args.
+Expect a multi-line \"date\" stamp, similar to that provided by
+the default value of `erc-timestamp-format-left'. Add
+`erc-stamp-type' property with the symbol `date-left' as its
+value. Possibly adjust invisibility interval to begin at the
+previous newline and extend until the end of the last line of the
+stamp, not including its line ending."
+ (let* ((beg)
;; Insert " " to simulate gap between <speaker> and msg beg.
(end (save-excursion (skip-chars-backward "\n")
- (setq start (pos-bol))
+ (setq beg (pos-bol))
(insert " ")
(point)))
- (width (if (and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction (narrow-to-region start end)
- (list (car (buffer-text-pixel-size))))
- (length (string-trim-left ts-left)))))
+ (width (erc-fill--wrap-measure beg end)))
(delete-region (1- end) end)
- ;; Use `point-min' instead of `start' to cover leading newilnes.
+ ;; Offset existing invisibility bounds by decrementing. See
+ ;; `erc-legacy-invisible-bounds-p'.
+ (when-let ((invisible (get-text-property (point) 'invisible))
+ (min (point-min)))
+ (save-restriction
+ (widen)
+ (remove-text-properties (max 1 (1- min)) (1+ (point)) '(invisible nil))
+ (narrow-to-region min (1+ (point)))
+ (erc--hide-message invisible)))
+ (put-text-property (point-min) (point) 'erc-stamp-type 'date-left)
+ ;; Use `point-min' instead of `beg' to cover leading newilnes.
(put-text-property (point-min) (point) 'line-prefix
- `(space :width (- erc-fill--wrap-value ,width))))
- args)
+ `(space :width (- erc-fill--wrap-value ,width)))))
;; An escape hatch for third-party code expecting speakers of ACTION
;; messages to be exempt from `line-prefix'. This could be converted
@@ -536,12 +556,8 @@ erc-fill-wrap
(put-text-property (point-min) (point)
'display "")
0)
- ((and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (list (car (buffer-text-pixel-size)))))
- (t (- (point) (point-min))))))))
+ (t
+ (erc-fill--wrap-measure (point-min) (point))))))))
(erc-put-text-properties (point-min) (1- (point-max)) ; exclude "\n"
'(line-prefix wrap-prefix) nil
`((space :width (- erc-fill--wrap-value ,len))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0f3163bf68d..4e16906c550 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -609,7 +609,14 @@ erc-insert-timestamp-left-and-right
When the deprecated option `erc-timestamp-format-right' is nil,
use STRING, which originates from `erc-timestamp-format', for the
right-hand stamp. Use `erc-timestamp-format-left' for the
-left-hand stamp and expect it to change less frequently."
+left-hand stamp and expect it to change less frequently. Include
+line endings present in `erc-timestamp-format-left' as part of
+the `erc-timestamp' field, which extends to the start of the
+message proper. Do this so other code knows the stamp is part of
+the subsequent IRC message even though it may appear on its own
+line. However, allow the stamp's `invisible' property to span a
+different interval, in order to satisfy newer folding
+requirements related to `erc-legacy-invisible-bounds-p'."
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
(ts-left (erc-format-timestamp ct erc-timestamp-format-left))
(ts-right (with-suppressed-warnings
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ec4fae548c7..e4b0cd0ddbe 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3046,7 +3046,11 @@ erc-legacy-invisible-bounds-p
(defun erc--hide-message (value)
"Apply `invisible' text-property with VALUE to current message.
-Expect to run in a narrowed buffer during message insertion."
+Expect to run in a narrowed buffer during message insertion.
+Begin the invisible interval at the previous message's trailing
+newline and end before the current message's. If the preceding
+message ends in a double newline or there is no previous message,
+don't bother including the preceding newline."
(if erc-legacy-invisible-bounds-p
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
@@ -3055,6 +3059,8 @@ erc--hide-message
(end (point-max)))
(save-restriction
(widen)
+ (when (or (<= beg 4) (= ?\n (char-before (- beg 2))))
+ (cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
(defun erc-display-message-highlight (type string)
@@ -4770,6 +4776,7 @@ erc--own-property-names
rear-nonsticky erc-prompt field front-sticky read-only
;; stamp
cursor-intangible cursor-sensor-functions isearch-open-invisible
+ erc-stamp-type
;; match
invisible intangible
;; button
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index cd899fddb98..bf74806207d 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -167,7 +167,6 @@ erc-scenarios-match--find-eol
;; In most cases, `erc-hide-fools' makes line endings invisible.
(defun erc-scenarios-match--stamp-right-fools-invisible ()
- :tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
(erc-scenarios-match--invisible-stamp
@@ -271,6 +270,117 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap
(let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
+(defun erc-scenarios-match--fill-wrap-stamp-dedented-p (point)
+ (pcase (get-text-property point 'line-prefix)
+ (`(space :width (- erc-fill--wrap-value (,n)))
+ (if (display-graphic-p) (< 100 n 200) (< 10 n 30)))
+ (`(space :width (- erc-fill--wrap-value ,n))
+ (< 10 n 30))))
+
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-wrap ()
+
+ ;; Rewind the clock to known date artificially.
+ (let ((erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-fill-function #'erc-fill-wrap)
+ (bob-utterance-counter 0))
+
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (ert-info ("Baseline check")
+ ;; False date printed initially before anyone speaks.
+ (when (zerop bob-utterance-counter)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "[Wed Apr 29 1992]")
+ ;; First stamp in a buffer is not invisible from previous
+ ;; newline (before stamp's own leading newline).
+ (should (= 4 (match-beginning 0)))
+ (should (get-text-property 3 'invisible))
+ (should-not (get-text-property 2 'invisible))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p 4))
+ (search-forward "[23:59]"))))
+
+ (ert-info ("Line endings in Bob's messages are invisible")
+ ;; The message proper has the `invisible' property `match-fools'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
+ (let* ((mbeg (or (and (get-text-property (pos-bol) 'erc-command)
+ (pos-bol))
+ (next-single-property-change (pos-bol)
+ 'erc-command)))
+ (mend (text-property-not-all
+ mbeg (point-max) 'erc-command
+ (get-text-property mbeg 'erc-command))))
+
+ (if (/= 1 bob-utterance-counter)
+ (should-not (field-at-pos mend))
+ ;; For Bob's stamped message, check newline after stamp.
+ (should (eq (field-at-pos mend) 'erc-timestamp))
+ (setq mend (field-end mend)))
+
+ ;; The `erc-timestamp' property spans entire messages,
+ ;; including stamps and filled text, which makes for
+ ;; convenient traversal when `erc-stamp-mode' is enabled.
+ (should (get-text-property (pos-bol) 'erc-timestamp))
+ (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
+ mend))
+
+ ;; Line ending has the `invisible' property `match-fools'.
+ (should (= (char-after mend) ?\n))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (if erc-legacy-invisible-bounds-p
+ (should (eq (get-text-property mend 'invisible) 'match-fools))
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))))
+
+ ;; Only the message right after Alice speaks contains stamps.
+ (when (= 1 bob-utterance-counter)
+
+ (ert-info ("Date stamp occupying previous line is invisible")
+ (save-excursion
+ (forward-line -1)
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[Mon May 4 1992]")))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point)))
+ ;; Date stamp has a combined `invisible' property value
+ ;; that starts at the previous message's trailing newline
+ ;; and extends until the start of the message proper.
+ (should (equal ?\n (char-before (point))))
+ (should (equal ?\n (char-before (1- (point)))))
+ (let ((val (get-text-property (- (point) 2) 'invisible)))
+ (should (equal val '(timestamp match-fools)))
+ (should (= (text-property-not-all (- (point) 2) (point-max)
+ 'invisible val)
+ (pos-eol))))))
+
+ (ert-info ("Current message's RHS stamp is hidden")
+ ;; Right stamp has `match-fools' property.
+ (save-excursion
+ (should-not (field-at-pos (point)))
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
+
+ ;; Stamp invisibility starts where message's ends.
+ (let ((msgend (next-single-property-change (pos-bol) 'invisible)))
+ ;; Stamp has a combined `invisible' property value.
+ (should (equal (get-text-property msgend 'invisible)
+ '(timestamp match-fools)))
+
+ ;; Combined `invisible' property spans entire timestamp.
+ (should (= (next-single-property-change msgend 'invisible)
+ (pos-eol))))))
+
+ (cl-incf bob-utterance-counter))
+
+ ;; Alice.
+ (lambda ()
+ ;; Set clock ahead a week or so.
+ (setq erc-stamp--current-time 704962800)
+
+ ;; This message has no time stamp and is completely visible.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (should-not (next-single-property-change (pos-bol) 'invisible))))))
+
(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-5.6-Add-command-to-refill-buffer-with-erc-fill-wrap-.patch --]
[-- Type: text/x-patch, Size: 3381 bytes --]
From 2dd2c5c00e5a405f74ee0c7d61b35ba2f1e633e1 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 21 Sep 2023 06:54:27 -0700
Subject: [PATCH 3/3] [5.6] Add command to refill buffer with
erc-fill-wrap-mode
* lisp/erc/erc-fill.el (erc-fill--wrap-rejigger-last-message):
New internal variable.
(erc-fill--wrap-rejigger-region,
erc-fill-wrap-refill-buffer): New command and helper function.
(Bug#60936)
---
lisp/erc/erc-fill.el | 51 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 51 insertions(+)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 6d39bcb19b9..78b29b51cf7 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -563,6 +563,57 @@ erc-fill-wrap
`((space :width (- erc-fill--wrap-value ,len))
(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)
+ "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."
+ (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))
+ (save-restriction
+ (narrow-to-region beg (1+ end))
+ (if-let (((eq 'erc-timestamp (field-at-pos beg)))
+ ((eq 'date-left (get-text-property beg 'erc-stamp-type))))
+ (progn
+ (goto-char (field-end beg))
+ (erc-fill--wrap-stamp-insert-prefixed-date))
+ (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))
+ (goto-char end))))
+
+(defun erc-fill-wrap-refill-buffer ()
+ "Recalculate all `fill-wrap' prefixes in the current buffer."
+ (interactive)
+ (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)
+ (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)))
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87a5te47sz.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87a5te47sz.fsf@neverwas.me>
@ 2023-09-27 13:59 ` J.P.
[not found] ` <87pm23yawb.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-09-27 13:59 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 343 bytes --]
v2. Move massaging of `invisible' date-stamp intervals from `erc-fill'
to `erc-stamp'. Ensure `erc-timestamp-format-left' has a trailing
newline. Add helper for easily removing `invisible' prop members. Ensure
`erc-fill' extends the `erc-command' text prop to cover prepended
whitespace. Don't add inherited `invisible' props to date stamps.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 33668 bytes --]
From d8870a3dede52045518dc24a53143295df899943 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 27 Sep 2023 06:33:06 -0700
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
[5.6] Prefer ticks/hz pairs for some ERC timestamps on 29+
[5.6] Fix date-stamp invisibility in erc-fill-wrap
[5.6] Add command to refill buffer with erc-fill-wrap-mode
etc/ERC-NEWS | 12 +-
lisp/erc/erc-compat.el | 15 +++
lisp/erc/erc-fill.el | 96 +++++++++++----
lisp/erc/erc-stamp.el | 119 ++++++++++++++++---
lisp/erc/erc.el | 61 ++++++++--
test/lisp/erc/erc-scenarios-log.el | 1 +
test/lisp/erc/erc-scenarios-match.el | 163 ++++++++++++++++++++++++--
test/lisp/erc/erc-tests.el | 169 +++++++++++++++++++++++++++
8 files changed, 574 insertions(+), 62 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 05e933930e2..6743e49cfec 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -149,13 +149,17 @@ minor-mode maps, and new third-party modules should do the same.
** Option 'erc-timestamp-format-right' deprecated.
Having to account for this option prevented other ERC modules from
-easily determining what right-hand stamps would look like before
+easily determining what right-sided stamps would look like before
insertion, which is knowledge needed for certain UI decisions. The
way ERC has chosen to address this is imperfect and boils down to
asking users who've customized this option to switch to
-'erc-timestamp-format' instead. If you're affected by this and feel
-that some other solution, like automatic migration, is justified,
-please make that known on the bug list.
+'erc-timestamp-format' instead. Somewhat relatedly, the companion
+option 'erc-timestamp-format-left', which determines the look of date
+stamps, must now end in a newline. Although this has long been the
+case in practice, it's now been made official. As always, if you're
+affected by these changes and feel that other solutions, like
+automatic migration, are justified, please make that known on the bug
+list.
** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
It's no secret that the 'buttons' module treats potential nicknames
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 4dae578de67..4c376cfbc22 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -444,11 +444,20 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; We can't store (TICKS . HZ) style timestamps on 27 and 28 because
+;; `time-less-p' and friends do
+;;
+;; message("obsolete timestamp with cdr ...", ...)
+;; decode_lisp_time(_, WARN_OBSOLETE_TIMESTAMPS, ...)
+;; lisp_time_struct(...)
+;; time_cmp(...)
+;;
+;; which spams *Messages* (and stderr when running the test suite).
(defmacro erc-compat--current-lisp-time ()
- "Return `current-time' as a frequency pair."
+ "Return `current-time' as a (TICKS . HZ) pair on 29+."
(if (>= emacs-major-version 29)
'(let (current-time-list) (current-time))
- '(time-convert nil t)))
+ '(current-time)))
(provide 'erc-compat)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 78b29b51cf7..b419fb57bd4 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -488,20 +488,19 @@ erc-fill--wrap-measure
"Return display spec width for inserted region between BEG and END.
Ignore any `invisible' props that may be present when figuring."
(if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
- (save-restriction
- (narrow-to-region beg end)
- (let (buffer-invisibility-spec)
- (list (car (buffer-text-pixel-size)))))
+ ;; `buffer-text-pixel-size' can move point!
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (let (buffer-invisibility-spec)
+ (list (car (buffer-text-pixel-size))))))
(- end beg)))
(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest _)
"Apply `line-prefix' property to args.
-Expect a multi-line \"date\" stamp, similar to that provided by
-the default value of `erc-timestamp-format-left'. Add
-`erc-stamp-type' property with the symbol `date-left' as its
-value. Possibly adjust invisibility interval to begin at the
-previous newline and extend until the end of the last line of the
-stamp, not including its line ending."
+Expect a multiline \"date\" stamp ending in a newline, similar to
+the default value of `erc-timestamp-format-left'. Omit the
+`line-prefix' from any trailing newlines."
(let* ((beg)
;; Insert " " to simulate gap between <speaker> and msg beg.
(end (save-excursion (skip-chars-backward "\n")
@@ -510,18 +509,8 @@ erc-fill--wrap-stamp-insert-prefixed-date
(point)))
(width (erc-fill--wrap-measure beg end)))
(delete-region (1- end) end)
- ;; Offset existing invisibility bounds by decrementing. See
- ;; `erc-legacy-invisible-bounds-p'.
- (when-let ((invisible (get-text-property (point) 'invisible))
- (min (point-min)))
- (save-restriction
- (widen)
- (remove-text-properties (max 1 (1- min)) (1+ (point)) '(invisible nil))
- (narrow-to-region min (1+ (point)))
- (erc--hide-message invisible)))
- (put-text-property (point-min) (point) 'erc-stamp-type 'date-left)
;; Use `point-min' instead of `beg' to cover leading newilnes.
- (put-text-property (point-min) (point) 'line-prefix
+ (put-text-property (point-min) (1- end) 'line-prefix
`(space :width (- erc-fill--wrap-value ,width)))))
;; An escape hatch for third-party code expecting speakers of ACTION
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 4e16906c550..68dd1f287cf 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,21 +55,35 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
-;; FIXME remove surrounding whitespace from default value and have
-;; `erc-insert-timestamp-left-and-right' add it before insertion.
+(defun erc-stamp--custom-trailing-newline-p (_ value)
+ "Return non-nil if VALUE ends in a newline."
+ (string-suffix-p "\n" value))
-(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
- "If set to a string, messages will be timestamped.
-This string is processed using `format-time-string'.
-Good examples are \"%T\" and \"%H:%M\".
-
-This timestamp is used for timestamps on the left side of the
-screen when `erc-insert-timestamp-function' is set to
-`erc-insert-timestamp-left-and-right'.
+(defun erc-stamp--custom-validate-date-stamp (widget)
+ "Fail unless WIDGET's value ends in a newline."
+ (unless (string-suffix-p "\n" (widget-value widget))
+ (widget-put widget :error "Value lacks a trailing newline")
+ widget))
-If nil, timestamping is turned off."
- :type '(choice (const nil)
- (string)))
+(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
+ "Format recognized by `format-time-string' for date stamps.
+Only considered when `erc-insert-timestamp-function' is set to
+`erc-insert-timestamp-left-and-right'. Used for displaying date
+stamps on their own line, between messages. As of ERC 5.6, this
+module appends a trailing newline on insertion if needed. Any
+extra newlines, leading or trailing, become empty lines. For
+example, the default value results in an empty line after the
+previous message, followed by the timestamp on its own line,
+followed immediately by the next message on the next line. ERC
+expects to display these stamps less frequently, so the
+formatting specifiers should reflect that. To omit these stamps
+entirely, use a different `erc-insert-timestamp-function', such
+as `erc-timestamp-format-right'."
+ :type '(string :validate erc-stamp--custom-validate-date-stamp
+ :match erc-stamp--custom-trailing-newline-p)
+ :set (lambda (sym val)
+ (set-default sym
+ (if (string-suffix-p "\n" val) val (concat val "\n")))))
(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
@@ -374,7 +388,15 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+;; These are currently extended manually, but we could also bind
+;; `text-property-default-nonsticky' and call `insert-and-inherit'
+;; instead of `insert', but we'd have to pair the props with differing
+;; boolean values for left and right stamps. Also, since this hook
+;; runs last, we can't expect overriding sticky props to be absent,
+;; even though, as of 5.6, `front-sticky' is only added by the
+;; `readonly' module after hooks run.
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
+ "Extant properties at the start of a message inherited by the stamp.")
(declare-function erc--remove-text-properties "erc" (string))
@@ -604,21 +626,69 @@ erc-stamp--insert-date-function
A local module might use this to modify text properties,
`insert-before-markers' or renarrow the region after insertion.")
+(defun erc-stamp--decrement-date-invisibility-bounds ()
+ "Extend `invisible' prop to previous newline before date stamp.
+And apply original prop value from message body to any trailing
+newlines after date."
+ (let ((beg (point-min)))
+ (save-restriction
+ (widen)
+ (when (and (> beg 4) (= (char-before beg) ?\n))
+ (when-let ((this (get-text-property (point) 'invisible))
+ (prev (get-text-property (1- beg) 'invisible))
+ ((not (equal this prev))))
+ (put-text-property (1- beg) beg 'invisible
+ (seq-difference (ensure-list prev)
+ (ensure-list this))))
+ (put-text-property (1- beg) beg 'invisible 'timestamp)))
+ (cl-assert (= ?\n (char-before (point))))
+ ;; Only decrement bounds by one. Additional newlines in the
+ ;; timestamp must be hidden.
+ (if-let ((existing (remq 'timestamp
+ (ensure-list erc-stamp--invisible-property))))
+ (put-text-property (1- (point)) (point) 'invisible
+ (if (cdr existing) existing (car existing)))
+ (erc--remove-from-prop-value-list
+ (1- (point)) (point) 'invisible 'timestamp))))
+
+(defvar-local erc-stamp--checked-date-string-p nil
+ "Non-nil if date string has been validated for current buffer.")
+
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
When the deprecated option `erc-timestamp-format-right' is nil,
use STRING, which originates from `erc-timestamp-format', for the
right-hand stamp. Use `erc-timestamp-format-left' for the
left-hand stamp and expect it to change less frequently. Include
-line endings present in `erc-timestamp-format-left' as part of
-the `erc-timestamp' field, which extends to the start of the
-message proper. Do this so other code knows the stamp is part of
-the subsequent IRC message even though it may appear on its own
-line. However, allow the stamp's `invisible' property to span a
-different interval, in order to satisfy newer folding
-requirements related to `erc-legacy-invisible-bounds-p'."
+line endings found in `erc-timestamp-format-left' (or affixed by
+ERC) as part of the `erc-timestamp' field, which extends to the
+start of the message proper. Do this so other code knows the
+stamp is part of the subsequent IRC message even though it may
+appear on its own line. However, allow the stamp's `invisible'
+property to span a different interval, in order to satisfy newer
+folding requirements related to `erc-legacy-invisible-bounds-p'.
+Additionally, ensure every date stamp formatted with the option
+`erc-timestamp-format-left' has the property `erc-stamp-type' set
+to the symbol `date-left' so that modules can easily distinguish
+between other left-sided stamps and date stamps inserted by this
+function."
+ (unless erc-stamp--checked-date-string-p
+ (setq erc-stamp--checked-date-string-p t)
+ (unless (string-suffix-p "\n" erc-timestamp-format-left)
+ (setq erc-timestamp-format-left
+ (concat erc-timestamp-format-left "\n"))
+ (unless erc--target
+ (erc-button--display-error-notice-with-keys
+ (current-buffer)
+ "ERC only supports values of `%s' that end in a ?\\n."
+ " Changing value for current session to: %s."
+ " Update your config accordingly to silence this message."
+ 'erc-timestamp-format-left
+ (let ((print-escape-newlines t))
+ (prin1-to-string erc-timestamp-format-left))))))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-left (let ((erc-stamp--invisible-property 'timestamp))
+ (erc-format-timestamp ct erc-timestamp-format-left)))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
@@ -627,8 +697,14 @@ erc-insert-timestamp-left-and-right
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
- (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
+ (add-text-properties 0 (length ts-left)
+ '(field erc-timestamp erc-stamp-type date-left)
+ ts-left)
(funcall erc-stamp--insert-date-function ts-left)
+ (unless (with-suppressed-warnings
+ ((obsolete erc-legacy-invisible-bounds-p))
+ erc-legacy-invisible-bounds-p)
+ (erc-stamp--decrement-date-invisibility-bounds))
(setq erc-timestamp-last-inserted-left ts-left))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e4b0cd0ddbe..db2e20c800e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1128,9 +1128,13 @@ erc-insert-modify-hook
"Insertion hook for functions that will change the text's appearance.
This hook is called just after `erc-insert-pre-hook' when the value
of `erc-insert-this' is t.
-While this hook is run, narrowing is in effect and `current-buffer' is
-the buffer where the text got inserted. One possible value to add here
-is `erc-fill'."
+
+ERC runs this hook with the buffer narrowed to the bounds of the
+inserted message plus a trailing newline. Built-in modules place
+their hook members at depths between 20 and 80, with those from
+the stamp module always running last. Use the functions
+`erc-find-parsed-property' and `erc-get-parsed-vector' to locate
+and extract the `erc-response' object for the inserted message."
:group 'erc-hooks
:type 'hook)
@@ -3037,6 +3041,30 @@ erc--merge-prop
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
+(defun erc--remove-from-prop-value-list (from to prop val &optional object)
+ "Remove VAL from text prop value between FROM and TO.
+If current value is VAL itself, remove the property entirely.
+When VAL is a list, act as if this function were called
+repeatedly with VAL set to each of VAL's members."
+ (let ((old (get-text-property from prop object))
+ (pos from)
+ (end (next-single-property-change from prop object to))
+ new)
+ (while (< pos to)
+ (when old
+ (if (setq new (and (consp old) (if (consp val)
+ (seq-difference old val)
+ (remq val old))))
+ (put-text-property pos end prop
+ (if (cdr new) new (car new)) object)
+ (when (pcase val
+ ((pred consp) (or (consp old) (memq old val)))
+ (_ (if (consp old) (memq val old) (eq old val))))
+ (remove-text-properties pos end (list prop nil) object))))
+ (setq pos end
+ old (get-text-property pos prop object)
+ end (next-single-property-change pos prop object to)))))
+
(defvar erc-legacy-invisible-bounds-p nil
"Whether to hide trailing rather than preceding newlines.
Beginning in ERC 5.6, invisibility extends from a message's
@@ -8078,13 +8106,21 @@ erc-find-parsed-property
"Find the next occurrence of the `erc-parsed' text property."
(text-property-not-all (point-min) (point-max) 'erc-parsed nil))
+(defvar erc--persistent-message-properties '(erc-command))
+
(defun erc-restore-text-properties ()
- "Restore the property `erc-parsed' for the region."
- (when-let* ((parsed-posn (erc-find-parsed-property))
- (found (erc-get-parsed-vector parsed-posn)))
+ "Ensure the `erc-parsed' property covers the narrowed buffer.
+Do this for other properties added by `erc-display-message' and
+for those named in `erc--persistent-message-properties'."
+ (when-let ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
(put-text-property (point-min) (point-max) 'erc-parsed found)
(when-let ((tags (get-text-property parsed-posn 'tags)))
- (put-text-property (point-min) (point-max) 'tags tags))))
+ (put-text-property (point-min) (point-max) 'tags tags))
+ (let ((to (max (point-min) (1- (point-max)))))
+ (dolist (prop erc--persistent-message-properties)
+ (when-let ((val (get-text-property parsed-posn prop)))
+ (put-text-property (point-min) to prop val))))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -8109,7 +8145,7 @@ erc--get-eq-comparable-cmd
See also `erc-message-type'."
;; IRC numerics are three-digit numbers, possibly with leading 0s.
;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
- (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+ (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n))
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index fd030d90c2f..f7e7d61c92e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -81,6 +81,7 @@ erc-scenarios-log--kill-hook
(ert-deftest erc-scenarios-log--clear-stamp ()
:tags '(:expensive-test)
+ (require 'erc-stamp)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index bf74806207d..bc06d58c3e9 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -328,20 +328,25 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap
;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
- (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
- (if erc-legacy-invisible-bounds-p
- (should (eq (get-text-property mend 'invisible) 'match-fools))
- (should (eq (get-text-property mbeg 'invisible) 'match-fools))
- (should-not (get-text-property mend 'invisible))))))
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))
;; Only the message right after Alice speaks contains stamps.
(when (= 1 bob-utterance-counter)
(ert-info ("Date stamp occupying previous line is invisible")
+ (should (eq 'match-fools (get-text-property (point) 'invisible)))
(save-excursion
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
+ (ert-info ("Stamp's NL `invisible' as fool, not timestamp")
+ (let ((end (match-end 0)))
+ (should (eq (char-after end) ?\n))
+ (should (eq 'timestamp
+ (get-text-property (1- end) 'invisible)))
+ (should (eq 'match-fools
+ (get-text-property end 'invisible)))))
(should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point)))
;; Date stamp has a combined `invisible' property value
;; that starts at the previous message's trailing newline
@@ -349,7 +354,7 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap
(should (equal ?\n (char-before (point))))
(should (equal ?\n (char-before (1- (point)))))
(let ((val (get-text-property (- (point) 2) 'invisible)))
- (should (equal val '(timestamp match-fools)))
+ (should (equal val 'timestamp))
(should (= (text-property-not-all (- (point) 2) (point-max)
'invisible val)
(pos-eol))))))
@@ -381,7 +386,7 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(should-not (next-single-property-change (pos-bol) 'invisible))))))
-(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
+(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds)
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
@@ -405,7 +410,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `match-fools'.
(should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
+ (let* ((mbeg (and (get-text-property (pos-bol) 'erc-command)
+ (pos-bol)))
(mend (next-single-property-change mbeg 'erc-command)))
(if (/= 1 bob-utterance-counter)
@@ -437,12 +443,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
- ;; Date stamp has a combined `invisible' property value
- ;; that extends until the start of the message proper.
- (should (equal (get-text-property (point) 'invisible)
- '(timestamp match-fools)))
- (should (= (next-single-property-change (point) 'invisible)
- (1+ (pos-eol))))))
+ (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n
+ (funcall assert-ds))) ; "assert date stamp"
(ert-info ("Folding preserved despite invisibility")
;; Message has a trailing time stamp, but it's been folded
@@ -475,13 +477,42 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
:tags '(:expensive-test)
- (erc-scenarios-match--stamp-both-invisible-fill-static))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that starts from the
+ ;; newline delimiting the current and previous messages and
+ ;; extends until the stamp's final newline. It is not combined
+ ;; with the old value, `match-fools'.
+ (let ((delim-pos (- (point) 2)))
+ (should (equal 'timestamp (get-text-property delim-pos 'invisible)))
+ ;; Stamp-only invisibility ends before its last newline.
+ (should (= (text-property-not-all delim-pos (point-max)
+ 'invisible 'timestamp)
+ (match-end 0))))))) ; pos-eol
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
:tags '(:expensive-test)
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(should-not erc-legacy-invisible-bounds-p)
+
(let ((erc-legacy-invisible-bounds-p t))
- (erc-scenarios-match--stamp-both-invisible-fill-static))))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that covers its
+ ;; format string exactly. It is not combined with the old
+ ;; value, `match-fools'.
+ (let ((delim-prev (- (point) 2)))
+ (should-not (get-text-property delim-prev 'invisible))
+ (should (eq 'erc-timestamp (field-at-pos (point))))
+ (should (= (next-single-property-change delim-prev 'invisible)
+ (field-beginning (point))))
+ (should (equal 'timestamp
+ (get-text-property (1- (point)) 'invisible)))
+ ;; Stamp-only invisibility includes last newline.
+ (should (= (text-property-not-all (1- (point)) (point-max)
+ 'invisible 'timestamp)
+ (field-end (point))))))))))
;;; erc-scenarios-match.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 05d45b2d027..3fb96ae64d3 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1385,6 +1385,175 @@ erc--merge-prop
(when noninteractive
(kill-buffer))))
+(ert-deftest erc--remove-from-prop-value-list ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Non-list match.
+ (insert "abc\n")
+ (put-text-property 1 2 'erc-test 'a)
+ (put-text-property 2 3 'erc-test 'b)
+ (put-text-property 3 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 1 2 (erc-test b)
+ 2 3 (erc-test c))))
+
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'b)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "abc"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "def\n")
+ (put-text-property 1 2 'erc-test '(d x))
+ (put-text-property 2 3 'erc-test '(e y))
+ (put-text-property 3 4 'erc-test '(f z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x))
+ 1 2 (erc-test (e y))
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x))
+ 1 2 (erc-test e)
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'd)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'f)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test x)
+ 1 2 (erc-test e)
+ 2 3 (erc-test z))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'e)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'z)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "def"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (put-text-property 1 2 'erc-test '(g x))
+ (put-text-property 2 3 'erc-test '(h x))
+ (put-text-property 3 4 'erc-test '(i y))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test (g x))
+ 1 2 (erc-test (h x))
+ 2 3 (erc-test (i y)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test g)
+ 1 2 (erc-test h)
+ 2 3 (erc-test (i y)))))
+ (erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed
+ (erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 1 2 (erc-test h)
+ 2 3 (erc-test y))))
+
+ ;; Pathological (,c) case (hopefully not created by ERC)
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (put-text-property 1 2 'erc-test '(j x))
+ (put-text-property 2 3 'erc-test '(k))
+ (put-text-property 3 4 'erc-test '(k))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'k)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x)))))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest erc--remove-from-prop-value-list/many ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Non-list match.
+ (insert "abc\n")
+ (put-text-property 1 2 'erc-test 'a)
+ (put-text-property 2 3 'erc-test 'b)
+ (put-text-property 3 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 1 2 (erc-test b)
+ 2 3 (erc-test c))))
+
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(a b))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(c))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "abc"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "def\n")
+ (put-text-property 1 2 'erc-test '(d x y))
+ (put-text-property 2 3 'erc-test '(e y))
+ (put-text-property 3 4 'erc-test '(f z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x y))
+ 1 2 (erc-test (e y))
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(d y f))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test x)
+ 1 2 (erc-test e)
+ 2 3 (erc-test z))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(e z x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "def"))
+
+ ;; Narrowed beg.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (put-text-property 1 2 'erc-test '(g x))
+ (put-text-property 2 3 'erc-test '(h x))
+ (put-text-property 3 4 'erc-test '(i x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test (g x))
+ 1 2 (erc-test (h x))
+ 2 3 (erc-test (i x)))))
+ (erc--remove-from-prop-value-list 1 3 'erc-test '(x g i))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 1 2 (erc-test h)
+ 2 3 (erc-test (i x)))))
+
+ ;; Narrowed middle.
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (put-text-property 1 2 'erc-test '(j x))
+ (put-text-property 2 3 'erc-test '(k))
+ (put-text-property 3 4 'erc-test '(l y z))
+ (erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl"
+ 0 1 (erc-test (j x))
+ 1 2 (erc-test (k))
+ 2 3 (erc-test l))))
+
+ (when noninteractive
+ (kill-buffer))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Prefer-ticks-hz-pairs-for-some-ERC-timestamps-on.patch --]
[-- Type: text/x-patch, Size: 2172 bytes --]
From b56f6410aa1d6bc94b74671cabdcaf17b38b2574 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 18 Sep 2023 22:50:28 -0700
Subject: [PATCH 1/3] [5.6] Prefer ticks/hz pairs for some ERC timestamps on
29+
* lisp/erc/erc-compat.el (erc-compat--current-lisp-time): New macro to
prefer ticks/hz pairs on newer Emacs versions without producing a
compiler warning on 27 and 28. Stamps of this form are easier to
compare at a glance when used as values for text properties.
* lisp/erc/erc-stamp.el (erc-stamp--current-time): Use compat macro.
(Bug#60936)
---
lisp/erc/erc-compat.el | 15 +++++++++++++++
lisp/erc/erc-stamp.el | 2 +-
2 files changed, 16 insertions(+), 1 deletion(-)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 109b5d245ab..4c376cfbc22 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -444,6 +444,21 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; We can't store (TICKS . HZ) style timestamps on 27 and 28 because
+;; `time-less-p' and friends do
+;;
+;; message("obsolete timestamp with cdr ...", ...)
+;; decode_lisp_time(_, WARN_OBSOLETE_TIMESTAMPS, ...)
+;; lisp_time_struct(...)
+;; time_cmp(...)
+;;
+;; which spams *Messages* (and stderr when running the test suite).
+(defmacro erc-compat--current-lisp-time ()
+ "Return `current-time' as a (TICKS . HZ) pair on 29+."
+ (if (>= emacs-major-version 29)
+ '(let (current-time-list) (current-time))
+ '(current-time)))
+
(provide 'erc-compat)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index f159b6d226f..0f3163bf68d 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -215,7 +215,7 @@ erc-stamp--current-time
(cl-defgeneric erc-stamp--current-time ()
"Return a lisp time object to associate with an IRC message.
This becomes the message's `erc-timestamp' text property."
- (let (current-time-list) (current-time)))
+ (erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
(or erc-stamp--current-time (cl-call-next-method)))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Fix-date-stamp-invisibility-in-erc-fill-wrap.patch --]
[-- Type: text/x-patch, Size: 41674 bytes --]
From 4b16614f2e3ec9f9a376de54efa8f9ffe8dea7af Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 21 Sep 2023 23:54:31 -0700
Subject: [PATCH 2/3] [5.6] Fix date-stamp invisibility in erc-fill-wrap
* etc/ERC-NEWS: Mention that `erc-timestamp-format-left' now
officially requires a trailing newline to work correctly.
* lisp/erc/erc-fill.el (erc-fill--wrap-measure): New helper function,
factored out from common code shared by `erc-fill-wrap' and
`erc-fill--wrap-stamp-insert-prefixed-date'.
(erc-fill--wrap-stamp-insert-prefixed-date): Refactor for more general
use and decrement `invisible' bounds, when applicable.
(erc-fill-wrap): Use helper `erc-fill--wrap-measure'.
* lisp/erc/erc-stamp.el (erc-stamp--custom-trailing-newline-p,
erc-stamp--custom-validate-date-stamp): New Custom type validation
functions to avoid difficult-to-read closures appearing in `setopt'
warnings.
(erc-timestamp-format-left): Mention that value should contain a
trailing newline, and drop `nil' from Custom :type spec because
users who don't want date stamps should use
`erc-timestamp-format-right' instead.
(erc-stamp--inherited-props): Add doc string.
(erc-stamp--decrement-date-invisibility-bounds): New function
to implement expected `invisible' interval adjustments needed by
the flag `erc-legacy-invisible-bounds-p' when nil.
(erc-stamp--checked-date-string-p): New internal flag variable to
track whether users whose `erc-timestamp-format-left' value lacks a
trailing newline have been warned in the current session.
(erc-insert-timestamp-left-and-right): Mention intervals of relevant
text props in doc string. Add text property `erc-stamp-type' to
inserted date stamps to help folks distinguish between them and other
left-sided stamps. Shadow `erc-stamp--invisible-property' when
calling `erc-format-timestamp' in order to prevent date stamps from
inheriting other `invisible' props. These stamps are special in that
they have no business being hidden along with the current message.
Also, appeal to `erc-stamp--decrement-date-invisibility-bounds' in
offset the invisibility interval when `erc-legacy-invisible-bounds-p'
is nil.
* lisp/erc/erc.el (erc-insert-modify-hook): Mention reserved depth
ranges for built-in members in doc string.
(erc--remove-from-prop-value-list): New function for removing
`invisible' and `face' prop members cleanly.
(erc--hide-message): Don't bother offsetting start of first message in
a buffer.
(erc--own-property-names): Add `erc-stamp-type'.
(erc--persistent-message-properties): New variable.
(erc-restore-text-properties): Extend role to cover persistent as well
as ephemeral props that only exist during message insertion for the
benefit of hooks.
(erc--get-eq-comparable-cmd): Use `if-let' instead of `if-let*'.
* test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp):
Ensure `erc-stamp' is loaded.
* test/lisp/erc/erc-scenarios-match.el
(erc-scenarios-match--stamp-right-fools-invisible): Remove misplaced
ERT tag from function.
(erc-scenarios-match--fill-wrap-stamp-dedented-p): New assertion
utility function.
(erc-scenarios-match--stamp-both-invisible-fill-wrap) New test.
(erc-scenarios-match--stamp-both-invisible-fill-static): Expect
`erc-command' at beginning of inserted message's filled line, even if
it starts with whitespace. This is a consequence of the change above
to `erc-restore-text-properties'. Also, add new function parameter
`assert-ds', a callback to run when visiting the second date stamp,
which is followed by a hidden message. In the test of the same name,
expect the date stamp's invisibility interval to begin at the newline
after the previous message and to not contain any existing
invisibility props, namely, those belonging to the subsequent hidden
"fools" message.
(erc-scenarios-match--stamp-both-invisible-fill-static--nooffset):
Expect the date stamp's invisibility interval to match its field's
instead of starting and ending sooner.
* test/lisp/erc/erc-tests.el (erc--remove-from-prop-value-list,
erc--remove-from-prop-value-list/many): New tests. (Bug#60936)
---
etc/ERC-NEWS | 12 +-
lisp/erc/erc-fill.el | 45 +++----
lisp/erc/erc-stamp.el | 117 ++++++++++++++++---
lisp/erc/erc.el | 61 ++++++++--
test/lisp/erc/erc-scenarios-log.el | 1 +
test/lisp/erc/erc-scenarios-match.el | 163 ++++++++++++++++++++++++--
test/lisp/erc/erc-tests.el | 169 +++++++++++++++++++++++++++
7 files changed, 507 insertions(+), 61 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 05e933930e2..6743e49cfec 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -149,13 +149,17 @@ minor-mode maps, and new third-party modules should do the same.
** Option 'erc-timestamp-format-right' deprecated.
Having to account for this option prevented other ERC modules from
-easily determining what right-hand stamps would look like before
+easily determining what right-sided stamps would look like before
insertion, which is knowledge needed for certain UI decisions. The
way ERC has chosen to address this is imperfect and boils down to
asking users who've customized this option to switch to
-'erc-timestamp-format' instead. If you're affected by this and feel
-that some other solution, like automatic migration, is justified,
-please make that known on the bug list.
+'erc-timestamp-format' instead. Somewhat relatedly, the companion
+option 'erc-timestamp-format-left', which determines the look of date
+stamps, must now end in a newline. Although this has long been the
+case in practice, it's now been made official. As always, if you're
+affected by these changes and feel that other solutions, like
+automatic migration, are justified, please make that known on the bug
+list.
** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
It's no secret that the 'buttons' module treats potential nicknames
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index f4835f71278..d323682476d 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -484,25 +484,34 @@ erc-fill--wrap-continued-message-p
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
-(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
- "Apply `line-prefix' property to args."
- (let* ((ts-left (car args))
- (start)
+(defun erc-fill--wrap-measure (beg end)
+ "Return display spec width for inserted region between BEG and END.
+Ignore any `invisible' props that may be present when figuring."
+ (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
+ ;; `buffer-text-pixel-size' can move point!
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (let (buffer-invisibility-spec)
+ (list (car (buffer-text-pixel-size))))))
+ (- end beg)))
+
+(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest _)
+ "Apply `line-prefix' property to args.
+Expect a multiline \"date\" stamp ending in a newline, similar to
+the default value of `erc-timestamp-format-left'. Omit the
+`line-prefix' from any trailing newlines."
+ (let* ((beg)
;; Insert " " to simulate gap between <speaker> and msg beg.
(end (save-excursion (skip-chars-backward "\n")
- (setq start (pos-bol))
+ (setq beg (pos-bol))
(insert " ")
(point)))
- (width (if (and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction (narrow-to-region start end)
- (list (car (buffer-text-pixel-size))))
- (length (string-trim-left ts-left)))))
+ (width (erc-fill--wrap-measure beg end)))
(delete-region (1- end) end)
- ;; Use `point-min' instead of `start' to cover leading newilnes.
- (put-text-property (point-min) (point) 'line-prefix
- `(space :width (- erc-fill--wrap-value ,width))))
- args)
+ ;; Use `point-min' instead of `beg' to cover leading newilnes.
+ (put-text-property (point-min) (1- end) 'line-prefix
+ `(space :width (- erc-fill--wrap-value ,width)))))
;; An escape hatch for third-party code expecting speakers of ACTION
;; messages to be exempt from `line-prefix'. This could be converted
@@ -536,12 +545,8 @@ erc-fill-wrap
(put-text-property (point-min) (point)
'display "")
0)
- ((and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (list (car (buffer-text-pixel-size)))))
- (t (- (point) (point-min))))))))
+ (t
+ (erc-fill--wrap-measure (point-min) (point))))))))
(erc-put-text-properties (point-min) (1- (point-max)) ; exclude "\n"
'(line-prefix wrap-prefix) nil
`((space :width (- erc-fill--wrap-value ,len))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0f3163bf68d..68dd1f287cf 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,21 +55,35 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
-;; FIXME remove surrounding whitespace from default value and have
-;; `erc-insert-timestamp-left-and-right' add it before insertion.
+(defun erc-stamp--custom-trailing-newline-p (_ value)
+ "Return non-nil if VALUE ends in a newline."
+ (string-suffix-p "\n" value))
-(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
- "If set to a string, messages will be timestamped.
-This string is processed using `format-time-string'.
-Good examples are \"%T\" and \"%H:%M\".
-
-This timestamp is used for timestamps on the left side of the
-screen when `erc-insert-timestamp-function' is set to
-`erc-insert-timestamp-left-and-right'.
+(defun erc-stamp--custom-validate-date-stamp (widget)
+ "Fail unless WIDGET's value ends in a newline."
+ (unless (string-suffix-p "\n" (widget-value widget))
+ (widget-put widget :error "Value lacks a trailing newline")
+ widget))
-If nil, timestamping is turned off."
- :type '(choice (const nil)
- (string)))
+(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
+ "Format recognized by `format-time-string' for date stamps.
+Only considered when `erc-insert-timestamp-function' is set to
+`erc-insert-timestamp-left-and-right'. Used for displaying date
+stamps on their own line, between messages. As of ERC 5.6, this
+module appends a trailing newline on insertion if needed. Any
+extra newlines, leading or trailing, become empty lines. For
+example, the default value results in an empty line after the
+previous message, followed by the timestamp on its own line,
+followed immediately by the next message on the next line. ERC
+expects to display these stamps less frequently, so the
+formatting specifiers should reflect that. To omit these stamps
+entirely, use a different `erc-insert-timestamp-function', such
+as `erc-timestamp-format-right'."
+ :type '(string :validate erc-stamp--custom-validate-date-stamp
+ :match erc-stamp--custom-trailing-newline-p)
+ :set (lambda (sym val)
+ (set-default sym
+ (if (string-suffix-p "\n" val) val (concat val "\n")))))
(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
@@ -374,7 +388,15 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+;; These are currently extended manually, but we could also bind
+;; `text-property-default-nonsticky' and call `insert-and-inherit'
+;; instead of `insert', but we'd have to pair the props with differing
+;; boolean values for left and right stamps. Also, since this hook
+;; runs last, we can't expect overriding sticky props to be absent,
+;; even though, as of 5.6, `front-sticky' is only added by the
+;; `readonly' module after hooks run.
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
+ "Extant properties at the start of a message inherited by the stamp.")
(declare-function erc--remove-text-properties "erc" (string))
@@ -604,14 +626,69 @@ erc-stamp--insert-date-function
A local module might use this to modify text properties,
`insert-before-markers' or renarrow the region after insertion.")
+(defun erc-stamp--decrement-date-invisibility-bounds ()
+ "Extend `invisible' prop to previous newline before date stamp.
+And apply original prop value from message body to any trailing
+newlines after date."
+ (let ((beg (point-min)))
+ (save-restriction
+ (widen)
+ (when (and (> beg 4) (= (char-before beg) ?\n))
+ (when-let ((this (get-text-property (point) 'invisible))
+ (prev (get-text-property (1- beg) 'invisible))
+ ((not (equal this prev))))
+ (put-text-property (1- beg) beg 'invisible
+ (seq-difference (ensure-list prev)
+ (ensure-list this))))
+ (put-text-property (1- beg) beg 'invisible 'timestamp)))
+ (cl-assert (= ?\n (char-before (point))))
+ ;; Only decrement bounds by one. Additional newlines in the
+ ;; timestamp must be hidden.
+ (if-let ((existing (remq 'timestamp
+ (ensure-list erc-stamp--invisible-property))))
+ (put-text-property (1- (point)) (point) 'invisible
+ (if (cdr existing) existing (car existing)))
+ (erc--remove-from-prop-value-list
+ (1- (point)) (point) 'invisible 'timestamp))))
+
+(defvar-local erc-stamp--checked-date-string-p nil
+ "Non-nil if date string has been validated for current buffer.")
+
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
When the deprecated option `erc-timestamp-format-right' is nil,
use STRING, which originates from `erc-timestamp-format', for the
right-hand stamp. Use `erc-timestamp-format-left' for the
-left-hand stamp and expect it to change less frequently."
+left-hand stamp and expect it to change less frequently. Include
+line endings found in `erc-timestamp-format-left' (or affixed by
+ERC) as part of the `erc-timestamp' field, which extends to the
+start of the message proper. Do this so other code knows the
+stamp is part of the subsequent IRC message even though it may
+appear on its own line. However, allow the stamp's `invisible'
+property to span a different interval, in order to satisfy newer
+folding requirements related to `erc-legacy-invisible-bounds-p'.
+Additionally, ensure every date stamp formatted with the option
+`erc-timestamp-format-left' has the property `erc-stamp-type' set
+to the symbol `date-left' so that modules can easily distinguish
+between other left-sided stamps and date stamps inserted by this
+function."
+ (unless erc-stamp--checked-date-string-p
+ (setq erc-stamp--checked-date-string-p t)
+ (unless (string-suffix-p "\n" erc-timestamp-format-left)
+ (setq erc-timestamp-format-left
+ (concat erc-timestamp-format-left "\n"))
+ (unless erc--target
+ (erc-button--display-error-notice-with-keys
+ (current-buffer)
+ "ERC only supports values of `%s' that end in a ?\\n."
+ " Changing value for current session to: %s."
+ " Update your config accordingly to silence this message."
+ 'erc-timestamp-format-left
+ (let ((print-escape-newlines t))
+ (prin1-to-string erc-timestamp-format-left))))))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-left (let ((erc-stamp--invisible-property 'timestamp))
+ (erc-format-timestamp ct erc-timestamp-format-left)))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
@@ -620,8 +697,14 @@ erc-insert-timestamp-left-and-right
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
- (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
+ (add-text-properties 0 (length ts-left)
+ '(field erc-timestamp erc-stamp-type date-left)
+ ts-left)
(funcall erc-stamp--insert-date-function ts-left)
+ (unless (with-suppressed-warnings
+ ((obsolete erc-legacy-invisible-bounds-p))
+ erc-legacy-invisible-bounds-p)
+ (erc-stamp--decrement-date-invisibility-bounds))
(setq erc-timestamp-last-inserted-left ts-left))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ec4fae548c7..db2e20c800e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1128,9 +1128,13 @@ erc-insert-modify-hook
"Insertion hook for functions that will change the text's appearance.
This hook is called just after `erc-insert-pre-hook' when the value
of `erc-insert-this' is t.
-While this hook is run, narrowing is in effect and `current-buffer' is
-the buffer where the text got inserted. One possible value to add here
-is `erc-fill'."
+
+ERC runs this hook with the buffer narrowed to the bounds of the
+inserted message plus a trailing newline. Built-in modules place
+their hook members at depths between 20 and 80, with those from
+the stamp module always running last. Use the functions
+`erc-find-parsed-property' and `erc-get-parsed-vector' to locate
+and extract the `erc-response' object for the inserted message."
:group 'erc-hooks
:type 'hook)
@@ -3037,6 +3041,30 @@ erc--merge-prop
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
+(defun erc--remove-from-prop-value-list (from to prop val &optional object)
+ "Remove VAL from text prop value between FROM and TO.
+If current value is VAL itself, remove the property entirely.
+When VAL is a list, act as if this function were called
+repeatedly with VAL set to each of VAL's members."
+ (let ((old (get-text-property from prop object))
+ (pos from)
+ (end (next-single-property-change from prop object to))
+ new)
+ (while (< pos to)
+ (when old
+ (if (setq new (and (consp old) (if (consp val)
+ (seq-difference old val)
+ (remq val old))))
+ (put-text-property pos end prop
+ (if (cdr new) new (car new)) object)
+ (when (pcase val
+ ((pred consp) (or (consp old) (memq old val)))
+ (_ (if (consp old) (memq val old) (eq old val))))
+ (remove-text-properties pos end (list prop nil) object))))
+ (setq pos end
+ old (get-text-property pos prop object)
+ end (next-single-property-change pos prop object to)))))
+
(defvar erc-legacy-invisible-bounds-p nil
"Whether to hide trailing rather than preceding newlines.
Beginning in ERC 5.6, invisibility extends from a message's
@@ -3046,7 +3074,11 @@ erc-legacy-invisible-bounds-p
(defun erc--hide-message (value)
"Apply `invisible' text-property with VALUE to current message.
-Expect to run in a narrowed buffer during message insertion."
+Expect to run in a narrowed buffer during message insertion.
+Begin the invisible interval at the previous message's trailing
+newline and end before the current message's. If the preceding
+message ends in a double newline or there is no previous message,
+don't bother including the preceding newline."
(if erc-legacy-invisible-bounds-p
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
@@ -3055,6 +3087,8 @@ erc--hide-message
(end (point-max)))
(save-restriction
(widen)
+ (when (or (<= beg 4) (= ?\n (char-before (- beg 2))))
+ (cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
(defun erc-display-message-highlight (type string)
@@ -4770,6 +4804,7 @@ erc--own-property-names
rear-nonsticky erc-prompt field front-sticky read-only
;; stamp
cursor-intangible cursor-sensor-functions isearch-open-invisible
+ erc-stamp-type
;; match
invisible intangible
;; button
@@ -8071,13 +8106,21 @@ erc-find-parsed-property
"Find the next occurrence of the `erc-parsed' text property."
(text-property-not-all (point-min) (point-max) 'erc-parsed nil))
+(defvar erc--persistent-message-properties '(erc-command))
+
(defun erc-restore-text-properties ()
- "Restore the property `erc-parsed' for the region."
- (when-let* ((parsed-posn (erc-find-parsed-property))
- (found (erc-get-parsed-vector parsed-posn)))
+ "Ensure the `erc-parsed' property covers the narrowed buffer.
+Do this for other properties added by `erc-display-message' and
+for those named in `erc--persistent-message-properties'."
+ (when-let ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
(put-text-property (point-min) (point-max) 'erc-parsed found)
(when-let ((tags (get-text-property parsed-posn 'tags)))
- (put-text-property (point-min) (point-max) 'tags tags))))
+ (put-text-property (point-min) (point-max) 'tags tags))
+ (let ((to (max (point-min) (1- (point-max)))))
+ (dolist (prop erc--persistent-message-properties)
+ (when-let ((val (get-text-property parsed-posn prop)))
+ (put-text-property (point-min) to prop val))))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -8102,7 +8145,7 @@ erc--get-eq-comparable-cmd
See also `erc-message-type'."
;; IRC numerics are three-digit numbers, possibly with leading 0s.
;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
- (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+ (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n))
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index fd030d90c2f..f7e7d61c92e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -81,6 +81,7 @@ erc-scenarios-log--kill-hook
(ert-deftest erc-scenarios-log--clear-stamp ()
:tags '(:expensive-test)
+ (require 'erc-stamp)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index cd899fddb98..bc06d58c3e9 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -167,7 +167,6 @@ erc-scenarios-match--find-eol
;; In most cases, `erc-hide-fools' makes line endings invisible.
(defun erc-scenarios-match--stamp-right-fools-invisible ()
- :tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
(erc-scenarios-match--invisible-stamp
@@ -271,7 +270,123 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap
(let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
-(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
+(defun erc-scenarios-match--fill-wrap-stamp-dedented-p (point)
+ (pcase (get-text-property point 'line-prefix)
+ (`(space :width (- erc-fill--wrap-value (,n)))
+ (if (display-graphic-p) (< 100 n 200) (< 10 n 30)))
+ (`(space :width (- erc-fill--wrap-value ,n))
+ (< 10 n 30))))
+
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-wrap ()
+
+ ;; Rewind the clock to known date artificially.
+ (let ((erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-fill-function #'erc-fill-wrap)
+ (bob-utterance-counter 0))
+
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (ert-info ("Baseline check")
+ ;; False date printed initially before anyone speaks.
+ (when (zerop bob-utterance-counter)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "[Wed Apr 29 1992]")
+ ;; First stamp in a buffer is not invisible from previous
+ ;; newline (before stamp's own leading newline).
+ (should (= 4 (match-beginning 0)))
+ (should (get-text-property 3 'invisible))
+ (should-not (get-text-property 2 'invisible))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p 4))
+ (search-forward "[23:59]"))))
+
+ (ert-info ("Line endings in Bob's messages are invisible")
+ ;; The message proper has the `invisible' property `match-fools'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
+ (let* ((mbeg (or (and (get-text-property (pos-bol) 'erc-command)
+ (pos-bol))
+ (next-single-property-change (pos-bol)
+ 'erc-command)))
+ (mend (text-property-not-all
+ mbeg (point-max) 'erc-command
+ (get-text-property mbeg 'erc-command))))
+
+ (if (/= 1 bob-utterance-counter)
+ (should-not (field-at-pos mend))
+ ;; For Bob's stamped message, check newline after stamp.
+ (should (eq (field-at-pos mend) 'erc-timestamp))
+ (setq mend (field-end mend)))
+
+ ;; The `erc-timestamp' property spans entire messages,
+ ;; including stamps and filled text, which makes for
+ ;; convenient traversal when `erc-stamp-mode' is enabled.
+ (should (get-text-property (pos-bol) 'erc-timestamp))
+ (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
+ mend))
+
+ ;; Line ending has the `invisible' property `match-fools'.
+ (should (= (char-after mend) ?\n))
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))
+
+ ;; Only the message right after Alice speaks contains stamps.
+ (when (= 1 bob-utterance-counter)
+
+ (ert-info ("Date stamp occupying previous line is invisible")
+ (should (eq 'match-fools (get-text-property (point) 'invisible)))
+ (save-excursion
+ (forward-line -1)
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[Mon May 4 1992]")))
+ (ert-info ("Stamp's NL `invisible' as fool, not timestamp")
+ (let ((end (match-end 0)))
+ (should (eq (char-after end) ?\n))
+ (should (eq 'timestamp
+ (get-text-property (1- end) 'invisible)))
+ (should (eq 'match-fools
+ (get-text-property end 'invisible)))))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point)))
+ ;; Date stamp has a combined `invisible' property value
+ ;; that starts at the previous message's trailing newline
+ ;; and extends until the start of the message proper.
+ (should (equal ?\n (char-before (point))))
+ (should (equal ?\n (char-before (1- (point)))))
+ (let ((val (get-text-property (- (point) 2) 'invisible)))
+ (should (equal val 'timestamp))
+ (should (= (text-property-not-all (- (point) 2) (point-max)
+ 'invisible val)
+ (pos-eol))))))
+
+ (ert-info ("Current message's RHS stamp is hidden")
+ ;; Right stamp has `match-fools' property.
+ (save-excursion
+ (should-not (field-at-pos (point)))
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
+
+ ;; Stamp invisibility starts where message's ends.
+ (let ((msgend (next-single-property-change (pos-bol) 'invisible)))
+ ;; Stamp has a combined `invisible' property value.
+ (should (equal (get-text-property msgend 'invisible)
+ '(timestamp match-fools)))
+
+ ;; Combined `invisible' property spans entire timestamp.
+ (should (= (next-single-property-change msgend 'invisible)
+ (pos-eol))))))
+
+ (cl-incf bob-utterance-counter))
+
+ ;; Alice.
+ (lambda ()
+ ;; Set clock ahead a week or so.
+ (setq erc-stamp--current-time 704962800)
+
+ ;; This message has no time stamp and is completely visible.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (should-not (next-single-property-change (pos-bol) 'invisible))))))
+
+(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds)
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
@@ -295,7 +410,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `match-fools'.
(should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
+ (let* ((mbeg (and (get-text-property (pos-bol) 'erc-command)
+ (pos-bol)))
(mend (next-single-property-change mbeg 'erc-command)))
(if (/= 1 bob-utterance-counter)
@@ -327,12 +443,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
- ;; Date stamp has a combined `invisible' property value
- ;; that extends until the start of the message proper.
- (should (equal (get-text-property (point) 'invisible)
- '(timestamp match-fools)))
- (should (= (next-single-property-change (point) 'invisible)
- (1+ (pos-eol))))))
+ (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n
+ (funcall assert-ds))) ; "assert date stamp"
(ert-info ("Folding preserved despite invisibility")
;; Message has a trailing time stamp, but it's been folded
@@ -365,13 +477,42 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
:tags '(:expensive-test)
- (erc-scenarios-match--stamp-both-invisible-fill-static))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that starts from the
+ ;; newline delimiting the current and previous messages and
+ ;; extends until the stamp's final newline. It is not combined
+ ;; with the old value, `match-fools'.
+ (let ((delim-pos (- (point) 2)))
+ (should (equal 'timestamp (get-text-property delim-pos 'invisible)))
+ ;; Stamp-only invisibility ends before its last newline.
+ (should (= (text-property-not-all delim-pos (point-max)
+ 'invisible 'timestamp)
+ (match-end 0))))))) ; pos-eol
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
:tags '(:expensive-test)
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(should-not erc-legacy-invisible-bounds-p)
+
(let ((erc-legacy-invisible-bounds-p t))
- (erc-scenarios-match--stamp-both-invisible-fill-static))))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that covers its
+ ;; format string exactly. It is not combined with the old
+ ;; value, `match-fools'.
+ (let ((delim-prev (- (point) 2)))
+ (should-not (get-text-property delim-prev 'invisible))
+ (should (eq 'erc-timestamp (field-at-pos (point))))
+ (should (= (next-single-property-change delim-prev 'invisible)
+ (field-beginning (point))))
+ (should (equal 'timestamp
+ (get-text-property (1- (point)) 'invisible)))
+ ;; Stamp-only invisibility includes last newline.
+ (should (= (text-property-not-all (1- (point)) (point-max)
+ 'invisible 'timestamp)
+ (field-end (point))))))))))
;;; erc-scenarios-match.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 05d45b2d027..3fb96ae64d3 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1385,6 +1385,175 @@ erc--merge-prop
(when noninteractive
(kill-buffer))))
+(ert-deftest erc--remove-from-prop-value-list ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Non-list match.
+ (insert "abc\n")
+ (put-text-property 1 2 'erc-test 'a)
+ (put-text-property 2 3 'erc-test 'b)
+ (put-text-property 3 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 1 2 (erc-test b)
+ 2 3 (erc-test c))))
+
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'b)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "abc"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "def\n")
+ (put-text-property 1 2 'erc-test '(d x))
+ (put-text-property 2 3 'erc-test '(e y))
+ (put-text-property 3 4 'erc-test '(f z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x))
+ 1 2 (erc-test (e y))
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x))
+ 1 2 (erc-test e)
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'd)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'f)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test x)
+ 1 2 (erc-test e)
+ 2 3 (erc-test z))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'e)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'z)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "def"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (put-text-property 1 2 'erc-test '(g x))
+ (put-text-property 2 3 'erc-test '(h x))
+ (put-text-property 3 4 'erc-test '(i y))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test (g x))
+ 1 2 (erc-test (h x))
+ 2 3 (erc-test (i y)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test g)
+ 1 2 (erc-test h)
+ 2 3 (erc-test (i y)))))
+ (erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed
+ (erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 1 2 (erc-test h)
+ 2 3 (erc-test y))))
+
+ ;; Pathological (,c) case (hopefully not created by ERC)
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (put-text-property 1 2 'erc-test '(j x))
+ (put-text-property 2 3 'erc-test '(k))
+ (put-text-property 3 4 'erc-test '(k))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'k)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x)))))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest erc--remove-from-prop-value-list/many ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Non-list match.
+ (insert "abc\n")
+ (put-text-property 1 2 'erc-test 'a)
+ (put-text-property 2 3 'erc-test 'b)
+ (put-text-property 3 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 1 2 (erc-test b)
+ 2 3 (erc-test c))))
+
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(a b))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(c))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "abc"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "def\n")
+ (put-text-property 1 2 'erc-test '(d x y))
+ (put-text-property 2 3 'erc-test '(e y))
+ (put-text-property 3 4 'erc-test '(f z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x y))
+ 1 2 (erc-test (e y))
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(d y f))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test x)
+ 1 2 (erc-test e)
+ 2 3 (erc-test z))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(e z x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "def"))
+
+ ;; Narrowed beg.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (put-text-property 1 2 'erc-test '(g x))
+ (put-text-property 2 3 'erc-test '(h x))
+ (put-text-property 3 4 'erc-test '(i x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test (g x))
+ 1 2 (erc-test (h x))
+ 2 3 (erc-test (i x)))))
+ (erc--remove-from-prop-value-list 1 3 'erc-test '(x g i))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 1 2 (erc-test h)
+ 2 3 (erc-test (i x)))))
+
+ ;; Narrowed middle.
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (put-text-property 1 2 'erc-test '(j x))
+ (put-text-property 2 3 'erc-test '(k))
+ (put-text-property 3 4 'erc-test '(l y z))
+ (erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl"
+ 0 1 (erc-test (j x))
+ 1 2 (erc-test (k))
+ 2 3 (erc-test l))))
+
+ (when noninteractive
+ (kill-buffer))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Add-command-to-refill-buffer-with-erc-fill-wrap-.patch --]
[-- Type: text/x-patch, Size: 3381 bytes --]
From d8870a3dede52045518dc24a53143295df899943 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 21 Sep 2023 06:54:27 -0700
Subject: [PATCH 3/3] [5.6] Add command to refill buffer with
erc-fill-wrap-mode
* lisp/erc/erc-fill.el (erc-fill--wrap-rejigger-last-message):
New internal variable.
(erc-fill--wrap-rejigger-region,
erc-fill-wrap-refill-buffer): New command and helper function.
(Bug#60936)
---
lisp/erc/erc-fill.el | 51 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 51 insertions(+)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index d323682476d..b419fb57bd4 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -552,6 +552,57 @@ erc-fill-wrap
`((space :width (- erc-fill--wrap-value ,len))
(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)
+ "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."
+ (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))
+ (save-restriction
+ (narrow-to-region beg (1+ end))
+ (if-let (((eq 'erc-timestamp (field-at-pos beg)))
+ ((eq 'date-left (get-text-property beg 'erc-stamp-type))))
+ (progn
+ (goto-char (field-end beg))
+ (erc-fill--wrap-stamp-insert-prefixed-date))
+ (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))
+ (goto-char end))))
+
+(defun erc-fill-wrap-refill-buffer ()
+ "Recalculate all `fill-wrap' prefixes in the current buffer."
+ (interactive)
+ (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)
+ (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)))
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87pm23yawb.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87pm23yawb.fsf@neverwas.me>
@ 2023-10-06 15:17 ` J.P.
[not found] ` <874jj3ok58.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-06 15:17 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 2268 bytes --]
v3. Move new meta-data related text properties to a single-character
interval at the head of every message. Add facility for managing such
props on behalf of modification hooks. Add utilities for retrieving data
from message-delimiting props and for traversing inserted messages.
In an attempt to tamp down on the growing mound of complications
involved in wrangling text properties across modules, I'm proposing a
general facility for managing certain props going forward. It works as
follows:
1. confine meta-data related props to a one-char interval that, along
with a preceding newline, delimit all message boundaries [1]
2. apply nonessential message-spanning props, like
`cursor-sensor-functions', lazily and only as needed by their
controlling options [2]
3. offer a means of passing state between hook stages, optionally to
end up as properties in the meta-data interval
4. keep this mechanism internal for the time being, but have it manage
most props introduced in 5.6
In some ways, this amounts to a major reworking of how ERC handles
messages during and after insertion. Initially, I wanted to defer such
an endeavor to 5.7, but it's become clear to me that doing this now will
immensely fortify the implementation of various features shipping with
this release. If you're a module author or would-be contributor, it's in
your interest to keep an eye on how this unfolds. Happy to answer
questions or concerns, as always. Thanks.
[1] In an ideal world, a message's properties would live on its
preceding newline. However, ERC's hooks have always visited messages
along with their trailing newline. Obviously, having hooks see
properties for the message to follow (or having the current
message's props live on its trailing newline) would never work.
[2] Props whose intervals inform their role, such as buttons, faces, and
display/formatting attributes, can't easily conform to this system.
But, we can still benefit from formally declaring the hook stage
(and maybe specific depth range) at which such props should be
added. For example, message-spanning props ought to be applied no
earlier than post-modification (e.g., `erc-send-post-hook' and
`erc-insert-post-hook').
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 134146 bytes --]
From fcb34a45afd872361b0dbc8e6bd92ba53b910faa Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 6 Oct 2023 06:52:03 -0700
Subject: [PATCH 0/7] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (7):
[5.6] Allow spoofing process marker in erc-display-line-1
[5.6] Honor nil values in erc--restore-initialize-priors
[5.6] Preserve format-spec args in erc-server-JOIN
[5.6] Deprecate option erc-remove-parsed-property
[5.6] Add helper for removing list-valued text props in ERC
[5.6] Manage meta-data text props for ERC hook members
[5.6] Add command to refill buffer with erc-fill-wrap-mode
etc/ERC-NEWS | 36 ++-
lisp/erc/erc-backend.el | 11 +-
lisp/erc/erc-fill.el | 167 ++++++++----
lisp/erc/erc-goodies.el | 4 +-
lisp/erc/erc-stamp.el | 237 ++++++++++++++----
lisp/erc/erc-truncate.el | 2 +-
lisp/erc/erc.el | 223 +++++++++++++---
test/lisp/erc/erc-fill-tests.el | 78 ++++--
test/lisp/erc/erc-scenarios-log.el | 1 +
test/lisp/erc/erc-scenarios-match.el | 205 ++++++++++++---
test/lisp/erc/erc-stamp-tests.el | 2 +-
test/lisp/erc/erc-tests.el | 229 ++++++++++++++++-
.../resources/base/assoc/multi-net/barnet.eld | 12 +-
.../resources/base/assoc/multi-net/foonet.eld | 12 +-
.../base/netid/bouncer/barnet-drop.eld | 4 +-
.../base/netid/bouncer/foonet-drop.eld | 4 +-
.../fill/snapshots/merge-01-start.eld | 2 +-
.../fill/snapshots/merge-02-right.eld | 2 +-
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../fill/snapshots/spacing-01-mono.eld | 2 +-
.../fill/snapshots/stamps-left-01.eld | 2 +-
25 files changed, 992 insertions(+), 253 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index a8f7ee8a944..81c94467f25 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -153,13 +153,9 @@ easily determining what right-sided stamps would look like before
insertion, which is knowledge needed for certain UI decisions. The
way ERC has chosen to address this is imperfect and boils down to
asking users who've customized this option to switch to
-'erc-timestamp-format' instead. Somewhat relatedly, the companion
-option 'erc-timestamp-format-left', which determines the look of date
-stamps, must now end in a newline. Although this has long been the
-case in practice, it's now been made official. As always, if you're
-affected by these changes and feel that other solutions, like
-automatic migration, are justified, please make that known on the bug
-list.
+'erc-timestamp-format' instead. If you're affected by this and feel
+that some other solution, like automatic migration, is justified,
+please make that known on the bug list.
** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
It's no secret that the 'buttons' module treats potential nicknames
@@ -225,6 +221,14 @@ atop any message. The new companion option 'erc-echo-timestamp-zone'
determines the default timezone when not specified with a prefix
argument.
+** Option 'erc-remove-parsed-property' deprecated.
+This option's nil behavior serves no practical purpose yet has the
+potential to degrade the user experience by competing for space with
+forthcoming features powered by next generation extensions. Anyone
+with a legitimate use for this option likely also possesses the
+knowledge to rig up a suitable analog with minimal effort. That said,
+the road to removal is long.
+
** Option 'erc-warn-about-blank-lines' is more informative.
Enabled by default, this option now produces more useful feedback
whenever ERC rejects prompt input containing whitespace-only lines.
@@ -287,11 +291,13 @@ continue to modify non-ERC hooks locally whenever possible, especially
in new code.
*** ERC now manages timestamp-related properties a bit differently.
-For starters, the 'cursor-sensor-functions' property no longer
+For starters, the 'cursor-sensor-functions' text property is absent by
+default unless the option 'erc-echo-timestamps' is already enabled on
+module init. And when present, the property's value no longer
contains unique closures and thus no longer proves effective for
-traversing messages. To compensate, a new property, 'erc-timestamp',
-now spans message bodies but not the newlines delimiting them. Also
-affecting the 'stamp' module is the deprecation of the function
+traversing inserted messages. For now, ERC only provides an internal
+means of visiting messages, but a public interface is forthcoming.
+Also affecting the 'stamp' module is the deprecation of the function
'erc-insert-aligned' and its removal from client code. Additionally,
the module now merges its 'invisible' property with existing ones and
includes all white space around stamps when doing so.
@@ -306,6 +312,22 @@ folded onto the next line. Such inconsistency made stamp detection
overly complex and produced uneven results when toggling stamp
visibility.
+*** Date stamps are independent messages.
+ERC now inserts "date stamps" generated from the option
+'erc-timestamp-format-left' as separate, standalone messages. (This
+only matters if 'erc-insert-timestamp-function' is set to its default
+value of 'erc-insert-timestamp-left-and-right'.) ERC's near-term UI
+goals require exposing these stamps to existing code designed to
+operate on complete messages. For example, users likely expect date
+stamps to be togglable with 'erc-toggle-timestamps' while also being
+immune to hiding from commands like 'erc-match-toggle-hidden-fools'.
+Before this change, meeting such expectations demanded brittle
+heuristics that checked for the presence of these stamps in the
+leading portion of message bodies as well as special casing to act on
+these areas without inflicting collateral damage. From now on, third
+parties can instead use the function 'erc-stamp-date-left-p' to detect
+and reuse existing code to operate.
+
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
features has improved. More specifically, a module's group now enjoys
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index fb10ee31c78..bc42917375a 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1718,7 +1718,7 @@ erc--server-determine-join-display-context
(if (string-match "^\\(.*\\)\^g.*$" chnl)
(setq chnl (match-string 1 chnl)))
(save-excursion
- (let* ((str (cond
+ (let ((args (cond
;; If I have joined a channel
((erc-current-nick-p nick)
(let ((erc--display-context
@@ -1735,18 +1735,15 @@ erc--server-determine-join-display-context
(erc-channel-begin-receiving-names))
(erc-update-mode-line)
(run-hooks 'erc-join-hook)
- (erc-make-notice
- (erc-format-message 'JOIN-you ?c chnl)))
+ (list 'JOIN-you ?c chnl))
(t
(setq buffer (erc-get-buffer chnl proc))
- (erc-make-notice
- (erc-format-message
- 'JOIN ?n nick ?u login ?h host ?c chnl))))))
+ (list 'JOIN ?n nick ?u login ?h host ?c chnl)))))
(when buffer (set-buffer buffer))
(erc-update-channel-member chnl nick nick t nil nil nil nil nil host login)
;; on join, we want to stay in the new channel buffer
;;(set-buffer ob)
- (erc-display-message parsed nil buffer str))))))
+ (apply #'erc-display-message parsed 'notice buffer args))))))
(define-erc-response-handler (KICK)
"Handle kick messages received from the server." nil
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 608119c8d6e..8b86cf30bf4 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -158,6 +158,11 @@ erc-fill
(when (or erc-fill--function erc-fill-function)
;; skip initial empty lines
(goto-char (point-min))
+ ;; Note the following search pattern was altered in 5.6 to adapt
+ ;; to a change in Emacs regexp behavior that turned out to be a
+ ;; regression (which has since been fixed). The patterns appear
+ ;; to be equivalent in practice, so this was left as is (wasn't
+ ;; reverted) to avoid additional git-blame(1)-related churn.
(while (and (looking-at (rx bol (* (in " \t")) eol))
(zerop (forward-line 1))))
(unless (eobp)
@@ -167,12 +172,10 @@ erc-fill
(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))
+ (when (or (erc--check-msg-prop 'erc-cmd erc-fill--spaced-commands)
(and-let* ((cmd (save-excursion
(forward-line -1)
- (get-text-property (point)
- 'erc-command))))
+ (get-text-property (point) 'erc-cmd))))
(memq cmd erc-fill--spaced-commands)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
@@ -181,15 +184,17 @@ erc-fill-static
"Fills a text such that messages start at column `erc-fill-static-center'."
(save-restriction
(goto-char (point-min))
- (looking-at "^\\(\\S-+\\)")
- (let ((nick (match-string 1)))
+ (when-let (((looking-at "^\\(\\S-+\\)"))
+ ((not (erc--check-msg-prop 'erc-msg 'datestamp)))
+ (nick (match-string 1)))
+ (progn
(let ((fill-column (- erc-fill-column (erc-timestamp-offset)))
(fill-prefix (make-string erc-fill-static-center 32)))
(insert (make-string (max 0 (- erc-fill-static-center
(length nick) 1))
32))
(erc-fill-regarding-timestamp))
- (erc-restore-text-properties))))
+ (erc-restore-text-properties)))))
(defun erc-fill-variable ()
"Fill from `point-min' to `point-max'."
@@ -423,8 +428,6 @@ fill-wrap
(eq (default-value 'erc-insert-timestamp-function)
#'erc-insert-timestamp-left)))
(setq erc-fill--function #'erc-fill-wrap)
- (add-function :after (local 'erc-stamp--insert-date-function)
- #'erc-fill--wrap-stamp-insert-prefixed-date)
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
@@ -436,9 +439,7 @@ fill-wrap
(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)
- (remove-function (local 'erc-stamp--insert-date-function)
- #'erc-fill--wrap-stamp-insert-prefixed-date))
+ #'erc-fill--wrap-merged-button-p t))
'local)
(defvar-local erc-fill--wrap-length-function nil
@@ -456,6 +457,9 @@ erc-fill--wrap-last-msg
(defvar-local erc-fill--wrap-max-lull (* 24 60 60))
(defun erc-fill--wrap-continued-message-p ()
+ "Return non-nil when the current speaker hasn't changed.
+That is, indicate whether the text just inserted is from the same
+sender as that of the previous \"PRIVMSG\"."
(prog1 (and-let*
((m (or erc-fill--wrap-last-msg
(setq erc-fill--wrap-last-msg (point-min-marker))
@@ -463,14 +467,11 @@ erc-fill--wrap-continued-message-p
((< (1+ (point-min)) (- (point) 2)))
(props (save-restriction
(widen)
- (when (eq 'erc-timestamp (field-at-pos m))
- (set-marker m (field-end m)))
(and-let*
- (((eq 'PRIVMSG (get-text-property m 'erc-command)))
- ((not (eq (get-text-property m 'erc-ctcp)
- 'ACTION)))
+ (((eq 'PRIVMSG (get-text-property m 'erc-cmd)))
+ ((not (eq (get-text-property m 'erc-msg) 'ACTION)))
(spr (next-single-property-change m 'erc-speaker)))
- (cons (get-text-property m 'erc-timestamp)
+ (cons (get-text-property m 'erc-ts)
(get-text-property spr 'erc-speaker)))))
(ts (pop props))
(props)
@@ -478,7 +479,7 @@ erc-fill--wrap-continued-message-p
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
(speaker (next-single-property-change (point-min) 'erc-speaker))
- ((not (eq (get-text-property speaker 'erc-ctcp) 'ACTION)))
+ ((not (erc--check-msg-prop 'erc-ctcp 'ACTION)))
(nick (get-text-property speaker 'erc-speaker))
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
@@ -491,27 +492,11 @@ erc-fill--wrap-measure
(save-excursion
(save-restriction
(narrow-to-region beg end)
- (let (buffer-invisibility-spec)
- (list (car (buffer-text-pixel-size))))))
+ (let* ((buffer-invisibility-spec)
+ (rv (car (buffer-text-pixel-size))))
+ (if (zerop rv) 0 (list rv)))))
(- end beg)))
-(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest _)
- "Apply `line-prefix' property to args.
-Expect a multiline \"date\" stamp ending in a newline, similar to
-the default value of `erc-timestamp-format-left'. Omit the
-`line-prefix' from any trailing newlines."
- (let* ((beg)
- ;; Insert " " to simulate gap between <speaker> and msg beg.
- (end (save-excursion (skip-chars-backward "\n")
- (setq beg (pos-bol))
- (insert " ")
- (point)))
- (width (erc-fill--wrap-measure beg end)))
- (delete-region (1- end) end)
- ;; Use `point-min' instead of `beg' to cover leading newilnes.
- (put-text-property (point-min) (1- end) 'line-prefix
- `(space :width (- erc-fill--wrap-value ,width)))))
-
;; An escape hatch for third-party code expecting speakers of ACTION
;; messages to be exempt from `line-prefix'. This could be converted
;; into a user option if users feel similarly.
@@ -531,15 +516,22 @@ erc-fill-wrap
(when-let ((e (erc--get-speaker-bounds))
(b (pop e))
((or erc-fill--wrap-action-dedent-p
- (not (eq (get-text-property b 'erc-ctcp)
- 'ACTION)))))
+ (not (erc--check-msg-prop 'erc-ctcp
+ 'ACTION)))))
(goto-char e))
(skip-syntax-forward "^-")
(forward-char)
- ;; Using the `invisible' property might make more
- ;; sense, but that would require coordination
- ;; with other modules, like `erc-match'.
- (cond ((and erc-fill-wrap-merge
+ (cond ((erc--check-msg-prop 'erc-msg 'datestamp)
+ (when erc-fill--wrap-last-msg
+ (set-marker erc-fill--wrap-last-msg (point-min)))
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward "\n")
+ (let ((beg (pos-bol)))
+ (insert " ")
+ (prog1 (erc-fill--wrap-measure beg (point))
+ (delete-region (1- (point)) (point))))))
+ ((and erc-fill-wrap-merge
(erc-fill--wrap-continued-message-p))
(put-text-property (point-min) (point)
'display "")
@@ -554,11 +546,12 @@ erc-fill-wrap
(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)
+(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."
+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)
@@ -571,24 +564,41 @@ erc-fill--wrap-rejigger-region
(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))
- (save-restriction
- (narrow-to-region beg (1+ end))
- (if-let (((eq 'erc-timestamp (field-at-pos beg)))
- ((eq 'date-left (get-text-property beg 'erc-stamp-type))))
- (progn
- (goto-char (field-end beg))
- (erc-fill--wrap-stamp-insert-prefixed-date))
+ (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))
- (goto-char end))))
-
-(defun erc-fill-wrap-refill-buffer ()
- "Recalculate all `fill-wrap' prefixes in the current buffer."
- (interactive)
+ ;; 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 destructively fix merged properties."
+ (interactive "P")
(unless erc-fill-wrap-mode
(user-error "Module `fill-wrap' not active in current buffer."))
(save-excursion
@@ -599,7 +609,8 @@ erc-fill-wrap-refill-buffer
(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)
+ (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.
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index b77176d8ac7..d112e63c316 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -339,8 +339,8 @@ erc-scroll-to-bottom
;;;###autoload(autoload 'erc-readonly-mode "erc-goodies" nil t)
(define-erc-module readonly nil
"This mode causes all inserted text to be read-only."
- ((add-hook 'erc-insert-post-hook #'erc-make-read-only)
- (add-hook 'erc-send-post-hook #'erc-make-read-only))
+ ((add-hook 'erc-insert-post-hook #'erc-make-read-only 70)
+ (add-hook 'erc-send-post-hook #'erc-make-read-only 70))
((remove-hook 'erc-insert-post-hook #'erc-make-read-only)
(remove-hook 'erc-send-post-hook #'erc-make-read-only)))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 68dd1f287cf..7fc76eb2d73 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,23 +55,14 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
-(defun erc-stamp--custom-trailing-newline-p (_ value)
- "Return non-nil if VALUE ends in a newline."
- (string-suffix-p "\n" value))
-
-(defun erc-stamp--custom-validate-date-stamp (widget)
- "Fail unless WIDGET's value ends in a newline."
- (unless (string-suffix-p "\n" (widget-value widget))
- (widget-put widget :error "Value lacks a trailing newline")
- widget))
-
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"Format recognized by `format-time-string' for date stamps.
Only considered when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'. Used for displaying date
-stamps on their own line, between messages. As of ERC 5.6, this
-module appends a trailing newline on insertion if needed. Any
-extra newlines, leading or trailing, become empty lines. For
+stamps on their own line, between messages. ERC inserts this
+flavor of stamp as a separate \"psuedo message\", so a final
+newline isn't necessary. For compatibility, only additional
+trailing newlines beyond the first become empty lines. For
example, the default value results in an empty line after the
previous message, followed by the timestamp on its own line,
followed immediately by the next message on the next line. ERC
@@ -79,11 +70,7 @@ erc-timestamp-format-left
formatting specifiers should reflect that. To omit these stamps
entirely, use a different `erc-insert-timestamp-function', such
as `erc-timestamp-format-right'."
- :type '(string :validate erc-stamp--custom-validate-date-stamp
- :match erc-stamp--custom-trailing-newline-p)
- :set (lambda (sym val)
- (set-default sym
- (if (string-suffix-p "\n" val) val (concat val "\n")))))
+ :type 'string)
(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
@@ -189,9 +176,9 @@ erc-timestamp-face
;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t)
(define-erc-module stamp timestamp
"This mode timestamps messages in the channel buffers."
- ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
- (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 60)
- (add-hook 'erc-send-modify-hook #'erc-add-timestamp 60)
+ ((add-hook 'erc-mode-hook #'erc-stamp--setup)
+ (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 79)
+ (add-hook 'erc-send-modify-hook #'erc-add-timestamp 79)
(add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
(add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
(unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup)))
@@ -228,18 +215,27 @@ erc-stamp--current-time
(cl-defgeneric erc-stamp--current-time ()
"Return a lisp time object to associate with an IRC message.
-This becomes the message's `erc-timestamp' text property."
+This becomes the message's `erc-ts' text property."
(erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
(or erc-stamp--current-time (cl-call-next-method)))
+(defvar erc-stamp--skip nil
+ "Non-nil means inhibit `erc-add-timestamp' completely.")
+
+(defvar erc-stamp--allow-unmanaged nil
+ "Non-nil means `erc-add-timestamp' runs unconditionally.
+Escape hatch for third-parties using lower-level API functions,
+such as `erc-display-line', directly.")
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (progn ; remove this `progn' on next major refactor
+ (unless (or erc-stamp--skip (and erc-stamp--allow-unmanaged
+ (not erc--msg-props)))
(let* ((ct (erc-stamp--current-time))
(invisible (get-text-property (point-min) 'invisible))
(erc-stamp--invisible-property
@@ -247,6 +243,8 @@ erc-add-timestamp
(if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(skipp (and erc-stamp--skip-when-invisible invisible))
(erc-stamp--current-time ct))
+ (when erc--msg-props
+ (puthash 'erc-ts ct erc--msg-props))
(unless skipp
(funcall erc-insert-timestamp-function
(erc-format-timestamp ct erc-timestamp-format)))
@@ -258,12 +256,13 @@ erc-add-timestamp
(erc-away-time))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (1- (point-max))
+ (when erc-stamp--allow-unmanaged
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
;; Regions are no longer contiguous ^
- '(erc--echo-ts-csf) 'erc-timestamp ct)))))
+ '(erc--echo-ts-csf) 'erc-ts ct))))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -376,14 +375,14 @@ erc-stamp-prefix-log-filter
(goto-char (point-min))
(while
(progn
- (when-let* (((< (point) (pos-eol)))
- (end (1- (pos-eol)))
- ((eq 'erc-timestamp (field-at-pos end)))
- (beg (field-beginning end))
- ;; Skip a line that's just a timestamp.
- ((> beg (point))))
+ (when-let (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
(delete-region beg (1+ end)))
- (when-let (time (get-text-property (point) 'erc-timestamp))
+ (when-let (time (erc--get-inserted-msg-prop 'erc-ts))
(insert (format-time-string "[%H:%M:%S] " time)))
(zerop (forward-line))))
"")
@@ -595,8 +594,11 @@ erc-insert-timestamp-right
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
((guard erc-stamp--display-margin-mode)
- (put-text-property 0 (length string)
- 'display `((margin right-margin) ,string) string))
+ (let ((s (propertize (substring-no-properties string)
+ 'invisible erc-stamp--invisible-property)))
+ (put-text-property 0 (length string) 'display
+ `((margin right-margin) ,s)
+ string)))
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
@@ -621,38 +623,77 @@ erc-insert-timestamp-right
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defvar erc-stamp--insert-date-function #'insert
- "Function to insert left \"left-right date\" stamp.
-A local module might use this to modify text properties,
-`insert-before-markers' or renarrow the region after insertion.")
-
-(defun erc-stamp--decrement-date-invisibility-bounds ()
- "Extend `invisible' prop to previous newline before date stamp.
-And apply original prop value from message body to any trailing
-newlines after date."
- (let ((beg (point-min)))
+(defvar erc-stamp--insert-date-hook nil
+ "Functions appended to send and modify hooks when inserting date stamp.")
+
+(defvar-local erc-stamp--date-format-end nil
+ "Substring index marking usable portion of date stamp format.")
+
+(defun erc-stamp--propertize-left-date-stamp ()
+ (add-text-properties (point-min) (1- (point-max))
+ '(field erc-timestamp erc-stamp-type date-left))
+ (erc--hide-message 'timestamp))
+
+(defun erc-stamp-date-left-p (&optional point)
+ "Return non-nil if the current message is a \"date stamp\".
+Expect callers to know that such stamps originate from
+`erc-insert-timestamp-left-and-right' using the format string
+`erc-timestamp-format-left'. Expect POINT, when non-nil, to
+reside at some known or suspected time stamp. When POINT is nil,
+expect to be called from a member of `erc-insert-modify-hook' or
+similar."
+ (cond ((erc--check-msg-prop 'erc-msg 'datestamp))
+ (point (eq 'date-left (get-text-property point 'erc-stamp-type)))
+ (t (erc--with-inserted-msg
+ (and-let* ((p (text-property-not-all
+ (point-min) (point-max) 'field 'erc-timestamp)))
+ (eq 'date-left (get-text-property p 'erc-stamp-type)))))))
+
+;; A kludge to pass state from insert hook to nested insert hook.
+(defvar erc-stamp--current-datestamp-left nil)
+
+;; Calling `erc-display-message' from within a hook it's currently
+;; running is roundabout, but it's a definite means of ensuring hooks
+;; can act on the date stamp as a standalone message to do things like
+;; adjust invisibility props.
+(defun erc-stamp--insert-date-stamp-as-phony-message (string)
+ (cl-assert (string-empty-p string))
+ (setq string erc-stamp--current-datestamp-left)
+ (cl-assert string)
+ (let ((erc-stamp--skip t)
+ (erc--msg-props (map-into `((erc-msg . datestamp)
+ (erc-ts . ,erc-stamp--current-time))
+ 'hash-table))
+ (erc-send-modify-hook `(,@erc-send-modify-hook
+ erc-stamp--propertize-left-date-stamp
+ ,@erc-stamp--insert-date-hook))
+ (erc-insert-modify-hook `(,@erc-insert-modify-hook
+ erc-stamp--propertize-left-date-stamp
+ ,@erc-stamp--insert-date-hook)))
+ (erc-display-message nil nil (current-buffer) string)
+ (setq erc-timestamp-last-inserted-left string)))
+
+(defun erc-stamp--lr-date-on-pre-modify (_)
+ (unless erc-stamp--date-format-end
+ ;; Don't add text properties to the trailing newline.
+ (setq erc-stamp--date-format-end
+ (if (string-suffix-p "\n" erc-timestamp-format-left) -1 0)))
+ (when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ ;; Ignore existing prop value because date stamps should
+ ;; never be hideable except via `timestamp'.
+ (rendered (let (erc-stamp--invisible-property)
+ (erc-format-timestamp
+ ct (substring erc-timestamp-format-left
+ 0 erc-stamp--date-format-end))))
+ ((not (string-equal rendered erc-timestamp-last-inserted-left)))
+ (erc-stamp--current-datestamp-left rendered)
+ (erc-insert-timestamp-function
+ #'erc-stamp--insert-date-stamp-as-phony-message))
(save-restriction
- (widen)
- (when (and (> beg 4) (= (char-before beg) ?\n))
- (when-let ((this (get-text-property (point) 'invisible))
- (prev (get-text-property (1- beg) 'invisible))
- ((not (equal this prev))))
- (put-text-property (1- beg) beg 'invisible
- (seq-difference (ensure-list prev)
- (ensure-list this))))
- (put-text-property (1- beg) beg 'invisible 'timestamp)))
- (cl-assert (= ?\n (char-before (point))))
- ;; Only decrement bounds by one. Additional newlines in the
- ;; timestamp must be hidden.
- (if-let ((existing (remq 'timestamp
- (ensure-list erc-stamp--invisible-property))))
- (put-text-property (1- (point)) (point) 'invisible
- (if (cdr existing) existing (car existing)))
- (erc--remove-from-prop-value-list
- (1- (point)) (point) 'invisible 'timestamp))))
-
-(defvar-local erc-stamp--checked-date-string-p nil
- "Non-nil if date string has been validated for current buffer.")
+ (narrow-to-region (or erc--insert-marker erc-insert-marker)
+ (or erc--insert-marker erc-insert-marker))
+ (let (erc-timestamp-format erc-away-timestamp-format)
+ (erc-add-timestamp)))))
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
@@ -668,44 +709,23 @@ erc-insert-timestamp-left-and-right
property to span a different interval, in order to satisfy newer
folding requirements related to `erc-legacy-invisible-bounds-p'.
Additionally, ensure every date stamp formatted with the option
-`erc-timestamp-format-left' has the property `erc-stamp-type' set
-to the symbol `date-left' so that modules can easily distinguish
-between other left-sided stamps and date stamps inserted by this
-function."
- (unless erc-stamp--checked-date-string-p
- (setq erc-stamp--checked-date-string-p t)
- (unless (string-suffix-p "\n" erc-timestamp-format-left)
- (setq erc-timestamp-format-left
- (concat erc-timestamp-format-left "\n"))
- (unless erc--target
- (erc-button--display-error-notice-with-keys
- (current-buffer)
- "ERC only supports values of `%s' that end in a ?\\n."
- " Changing value for current session to: %s."
- " Update your config accordingly to silence this message."
- 'erc-timestamp-format-left
- (let ((print-escape-newlines t))
- (prin1-to-string erc-timestamp-format-left))))))
+`erc-timestamp-format-left' is marked as such so that modules can
+easily distinguish between other left-sided stamps and date
+stamps inserted by this function."
+ (unless erc-stamp--date-format-end
+ (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t)
+ (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t)
+ (let ((erc--insert-marker (point-min-marker)))
+ (set-marker-insertion-type erc--insert-marker t)
+ (erc-stamp--lr-date-on-pre-modify nil)
+ (narrow-to-region erc--insert-marker (point-max))
+ (set-marker erc--insert-marker nil)))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
- (ts-left (let ((erc-stamp--invisible-property 'timestamp))
- (erc-format-timestamp ct erc-timestamp-format-left)))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
(erc-format-timestamp ct erc-timestamp-format-right)
string))))
- ;; insert left timestamp
- (unless (string-equal ts-left erc-timestamp-last-inserted-left)
- (goto-char (point-min))
- (add-text-properties 0 (length ts-left)
- '(field erc-timestamp erc-stamp-type date-left)
- ts-left)
- (funcall erc-stamp--insert-date-function ts-left)
- (unless (with-suppressed-warnings
- ((obsolete erc-legacy-invisible-bounds-p))
- erc-legacy-invisible-bounds-p)
- (erc-stamp--decrement-date-invisibility-bounds))
- (setq erc-timestamp-last-inserted-left ts-left))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
(erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
@@ -722,8 +742,9 @@ erc-format-timestamp
(let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
- (erc-put-text-property 0 (length ts) 'invisible
- erc-stamp--invisible-property ts)
+ (when erc-stamp--invisible-property
+ (erc-put-text-property 0 (length ts) 'invisible
+ erc-stamp--invisible-property ts))
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
@@ -732,6 +753,8 @@ erc-format-timestamp
ts)
""))
+(defvar-local erc-stamp--csf-props-updated-p nil)
+
;; This function is used to munge `buffer-invisibility-spec' to an
;; appropriate value. Currently, it only handles timestamps, thus its
;; location. If you add other features which affect invisibility,
@@ -744,10 +767,23 @@ erc-munge-invisibility-spec
(cursor-intangible-mode -1)))
(if erc-echo-timestamps
(progn
+ (dolist (hook '(erc-insert-post-hook erc-send-post-hook))
+ (add-hook hook #'erc-stamp--add-csf-on-post-modify nil t))
+ (erc--restore-initialize-priors erc-stamp-mode
+ erc-stamp--csf-props-updated-p nil)
+ (unless (or erc-stamp--allow-unmanaged erc-stamp--csf-props-updated-p)
+ (setq erc-stamp--csf-props-updated-p t)
+ (let ((erc--msg-props (map-into '((erc-ts . t)) 'hash-table)))
+ (with-silent-modifications
+ (erc--traverse-inserted (point-min) erc-insert-marker
+ #'erc-stamp--add-csf-on-post-modify))))
(cursor-sensor-mode +1) ; idempotent
(when (>= emacs-major-version 29)
(add-function :before-until (local 'clear-message-function)
#'erc-stamp--on-clear-message)))
+ (dolist (hook '(erc-insert-post-hook erc-send-post-hook))
+ (remove-hook hook #'erc-stamp--add-csf-on-post-modify t))
+ (kill-local-variable 'erc-stamp--csf-props-updated-p)
(when (bound-and-true-p cursor-sensor-mode)
(cursor-sensor-mode -1))
(remove-function (local 'clear-message-function)
@@ -756,12 +792,22 @@ erc-munge-invisibility-spec
(add-to-invisibility-spec 'timestamp)
(remove-from-invisibility-spec 'timestamp)))
+(defun erc-stamp--add-csf-on-post-modify ()
+ "Add `cursor-sensor-functions' to narrowed buffer."
+ (when (erc--check-msg-prop 'erc-ts)
+ (put-text-property (point-min) (1- (point-max))
+ 'cursor-sensor-functions '(erc--echo-ts-csf))))
+
(defun erc-stamp--setup ()
"Enable or disable buffer-local `erc-stamp-mode' modifications."
(if erc-stamp-mode
(erc-munge-invisibility-spec)
(let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible)
- (erc-munge-invisibility-spec))))
+ (erc-munge-invisibility-spec))
+ ;; Undo local mods from `erc-insert-timestamp-left-and-right'.
+ (remove-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify t)
+ (remove-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify t)
+ (kill-local-variable 'erc-stamp--date-format-end)))
(defun erc-hide-timestamps ()
"Hide timestamp information from display."
@@ -797,7 +843,7 @@ erc-stamp--last-stamp
(defun erc-stamp--on-clear-message (&rest _)
"Return `dont-clear-message' when operating inside the same stamp."
(and erc-stamp--last-stamp erc-echo-timestamps
- (eq (get-text-property (point) 'erc-timestamp) erc-stamp--last-stamp)
+ (eq (erc--get-inserted-msg-prop 'erc-ts) erc-stamp--last-stamp)
'dont-clear-message))
(defun erc-echo-timestamp (dir stamp &optional zone)
@@ -807,7 +853,7 @@ erc-echo-timestamp
interpret a \"raw\" prefix as UTC. To specify a zone for use
with the option `erc-echo-timestamps', see the companion option
`erc-echo-timestamp-zone'."
- (interactive (list nil (get-text-property (point) 'erc-timestamp)
+ (interactive (list nil (erc--get-inserted-msg-prop 'erc-ts)
(pcase current-prefix-arg
((and (pred numberp) v)
(if (<= (abs v) 14) (* v 3600) v))
@@ -821,18 +867,18 @@ erc-echo-timestamp
(setq erc-stamp--last-stamp nil))))
(defun erc--echo-ts-csf (_window _before dir)
- (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+ (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc-ts)))
(defun erc-stamp--update-saved-position (&rest _)
- (remove-function (local 'erc-stamp--insert-date-function)
- #'erc-stamp--update-saved-position)
- (move-marker erc-last-saved-position (1- (point))))
+ (remove-hook 'erc-stamp--insert-date-hook
+ #'erc-stamp--update-saved-position t)
+ (move-marker erc-last-saved-position (1- (point-max))))
(defun erc-stamp--reset-on-clear (pos)
"Forget last-inserted stamps when POS is at insert marker."
(when (= pos (1- erc-insert-marker))
- (add-function :after (local 'erc-stamp--insert-date-function)
- #'erc-stamp--update-saved-position)
+ (add-hook 'erc-stamp--insert-date-hook
+ #'erc-stamp--update-saved-position 0 t)
(setq erc-timestamp-last-inserted nil
erc-timestamp-last-inserted-left nil
erc-timestamp-last-inserted-right nil)))
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 48d8408a85a..3350cbd13b7 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -102,7 +102,7 @@ erc-truncate-buffer-to-size
;; Truncate at message boundary (formerly line boundary
;; before 5.6).
(goto-char end)
- (goto-char (or (previous-single-property-change (point) 'erc-command)
+ (goto-char (or (erc--get-inserted-msg-bounds 'beg)
(pos-bol)))
(setq end (point))
;; try to save the current buffer using
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a3321d9aabe..891689d8faa 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -135,9 +135,11 @@ erc-scripts
"Running scripts at startup and with /LOAD."
:group 'erc)
-;; Forward declarations
-(defvar erc-message-parsed)
+(defvar erc-message-parsed) ; only known to this file
+(defvar erc--msg-props nil)
+(defvar erc--msg-prop-overrides nil)
+;; Forward declarations
(defvar tabbar--local-hlf)
(defvar motif-version-string)
(defvar gtk-version-string)
@@ -1370,16 +1372,15 @@ erc--target-priors
(defmacro erc--restore-initialize-priors (mode &rest vars)
"Restore local VARS for MODE from a previous session."
(declare (indent 1))
- (let ((existing (make-symbol "existing"))
+ (let ((priors (make-symbol "priors"))
+ (initp (make-symbol "initp"))
;;
- restore initialize)
- (while-let ((k (pop vars)) (v (pop vars)))
- (push `(,k (alist-get ',k ,existing)) restore)
- (push `(,k ,v) initialize))
- `(if-let* ((,existing (or erc--server-reconnecting erc--target-priors))
- ((alist-get ',mode ,existing)))
- (setq ,@(mapcan #'identity (nreverse restore)))
- (setq ,@(mapcan #'identity (nreverse initialize))))))
+ forms)
+ (while-let ((k (pop vars)))
+ (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms))
+ `(let* ((,priors (or erc--server-reconnecting erc--target-priors))
+ (,initp (and ,priors (alist-get ',mode ,priors))))
+ (setq ,@(mapcan #'identity (nreverse forms))))))
(defun erc--target-from-string (string)
"Construct an `erc--target' variant from STRING."
@@ -2859,11 +2860,10 @@ erc-toggle-debug-irc-protocol
(defun erc-send-action (tgt str &optional force)
"Send CTCP ACTION information described by STR to TGT."
(erc-send-ctcp-message tgt (format "ACTION %s" str) force)
- (let ((erc-insert-pre-hook
- (cons (lambda (s) ; Leave newline be.
- (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)
- (put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s))
- erc-insert-pre-hook))
+ ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us.
+ (let ((erc--msg-prop-overrides '((erc-msg . msg)
+ (erc-cmd . PRIVMSG)
+ (erc-ctcp . ACTION)))
(nick (erc-current-nick)))
(setq nick (propertize nick 'erc-speaker nick))
(erc-display-message nil '(t action input) (current-buffer)
@@ -2881,9 +2881,18 @@ erc-remove-parsed-property
The default is to remove it, since it causes ERC to take up extra
memory. If you have code that relies on this property, then set
-this option to nil."
+this option to nil.
+
+Note that this option is deprecated because a value of nil is
+impractical in prolonged sessions with more than a few channels.
+Use `erc-insert-post-hook' or similar and the helper function
+`erc-find-parsed-property' and friends to stash the current
+`erc-response' object as needed. And instead of using this for
+debugging purposes, try `erc-debug-irc-protocol'."
:type 'boolean
:group 'erc)
+(make-obsolete-variable 'erc-remove-parsed-property
+ "impractical when non-nil" "30.1")
(define-inline erc--assert-input-bounds ()
(inline-quote
@@ -2913,6 +2922,68 @@ erc--refresh-prompt
(delete-region (point) (1- erc-input-marker))))
(run-hooks 'erc--refresh-prompt-hook)))
+(define-inline erc--check-msg-prop (prop &optional val)
+ "Return value for PROP in `erc--msg-props' when populated.
+If VAL is a list, return non-nil if PROP appears in VAL. If VAL
+is otherwise non-nil, return non-nil if VAL compares `eq' to the
+stored value. Otherwise, return the stored value."
+ (inline-letevals (prop val)
+ (let ((v (make-symbol "v")))
+ `(and-let* ((erc--msg-props)
+ (,v (gethash ,prop erc--msg-props)))
+ (if (consp ,val) (memq ,v ,val) (if ,val (eq ,v ,val) ,v))))))
+
+(defmacro erc--get-inserted-msg-bounds (&optional only point)
+ `(let* ((point ,(or point '(point)))
+ (at-start-p (get-text-property point 'erc-msg)))
+ (and-let*
+ (,@(and (member only '(nil 'beg))
+ '((b (or (and at-start-p point)
+ (and-let*
+ ((p (previous-single-property-change point
+ 'erc-msg)))
+ (if (= p (1- point)) point (1- p)))))))
+ ,@(and (member only '(nil 'end))
+ '((e (1- (next-single-property-change
+ (if at-start-p (1+ point) point)
+ 'erc-msg nil erc-insert-marker))))))
+ ,(pcase only
+ ('(quote beg) 'b)
+ ('(quote end) 'e)
+ (_ '(cons b e))))))
+
+(defun erc--get-inserted-msg-prop (prop)
+ "Return the value of text property PROP for some message at point."
+ (and-let* ((stack-pos (erc--get-inserted-msg-bounds 'beg)))
+ (get-text-property stack-pos prop)))
+
+(defmacro erc--with-inserted-msg (&rest body)
+ "Simulate buffer narrowing of send insert hooks for BODY.
+Note that this does not wrap BODY in `with-silent-modifications'.
+Similarly, it does not bind a temporary `erc--msg-props' table."
+ `(when-let ((bounds (erc--get-inserted-msg-bounds)))
+ (save-restriction
+ (narrow-to-region (car bounds) (1+ (cdr bounds)))
+ ,@body)))
+
+(defun erc--traverse-inserted (beg end fn)
+ "Visit messages between BEG and END and run FN in narrowed buffer."
+ (setq end (min end (marker-position erc-insert-marker)))
+ (save-excursion
+ (goto-char beg)
+ (let ((b (if (get-text-property (point) 'erc-msg)
+ (point)
+ (next-single-property-change (point) 'erc-msg nil end))))
+ (while-let ((b)
+ ((< b end))
+ (e (next-single-property-change (1+ b) 'erc-msg nil end)))
+ (save-restriction
+ (narrow-to-region b e)
+ (funcall fn))
+ (setq b e)))))
+
+(defvar erc--insert-marker nil)
+
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
Auxiliary function used in `erc-display-line'. The line gets filtered to
@@ -2936,6 +3007,8 @@ erc-display-line-1
(format "%s" buffer)))
(setq erc-insert-this t)
(run-hook-with-args 'erc-insert-pre-hook string)
+ (setq insert-position (marker-position (or erc--insert-marker
+ erc-insert-marker)))
(if (null erc-insert-this)
;; Leave erc-insert-this set to t as much as possible. Fran
;; Litterio <franl> has seen erc-insert-this set to nil while
@@ -2955,10 +3028,17 @@ erc-display-line-1
(run-hooks 'erc-insert-post-hook)
(when erc-remove-parsed-property
(remove-text-properties (point-min) (point-max)
- '(erc-parsed nil))))
+ '(erc-parsed nil tags nil)))
+ (cl-assert (> (- (point-max) (point-min)) 1))
+ (let ((props (if erc--msg-props
+ (erc--order-text-properties-from-hash
+ erc--msg-props)
+ '(erc-msg unknown))))
+ (add-text-properties (point-min) (1+ (point-min)) props)))
(erc--refresh-prompt)))))
(run-hooks 'erc-insert-done-hook)
- (erc-update-undo-list (- (or (marker-position erc-insert-marker)
+ (erc-update-undo-list (- (or (marker-position (or erc--insert-marker
+ erc-insert-marker))
(point-max))
insert-position))))))
@@ -3102,6 +3182,21 @@ erc--hide-message
(cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+(defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd))
+
+(defun erc--order-text-properties-from-hash (table)
+ "Return a plist of text props from items in table.
+Ensure props in `erc--ranked-properties' appear last and in
+reverse order so that they end up sorted in buffer interval
+plists for retrieval by `text-properties-at' and friends."
+ (let (out)
+ (dolist (k erc--ranked-properties)
+ (when-let ((v (gethash k table)))
+ (remhash k table)
+ (setq out (nconc (list k v) out))))
+ (maphash (lambda (k v) (setq out (nconc (list k v) out))) table)
+ out))
+
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
@@ -3332,6 +3427,21 @@ erc-display-message
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
msg))
+ (erc--msg-props
+ (or erc--msg-props
+ (let* ((table (make-hash-table :size 5))
+ (cmd (and parsed (erc--get-eq-comparable-cmd
+ (erc-response.command parsed))))
+ (m (cond ((and msg (symbolp msg)) msg)
+ ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
+ (t 'unknown))))
+ (puthash 'erc-msg m table)
+ (when cmd
+ (puthash 'erc-cmd cmd table))
+ (and erc--msg-prop-overrides
+ (pcase-dolist (`(,k . ,v) erc--msg-prop-overrides)
+ (puthash k v table)))
+ table)))
(erc-message-parsed parsed))
(setq string
(cond
@@ -3350,9 +3460,6 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (put-text-property
- 0 (length string) 'erc-command
- (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -5303,7 +5410,7 @@ erc--get-speaker-bounds
Assume buffer is narrowed to the confines of an inserted message."
(inline-quote
(and-let*
- (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE)))
+ (((erc--check-msg-prop 'erc-msg 'msg))
(beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min))
(next-single-property-change (point-min) 'erc-speaker))))
(cons beg (next-single-property-change beg 'erc-speaker)))))
@@ -5628,11 +5735,8 @@ erc-process-ctcp-query
(while queries
(let* ((type (upcase (car (split-string (car queries)))))
(hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))
- (erc-insert-pre-hook
- (cons (lambda (s)
- (put-text-property 0 (1- (length s)) 'erc-ctcp
- (intern type) s))
- erc-insert-pre-hook)))
+ (erc--msg-prop-overrides `((erc-msg . msg)
+ (erc-ctcp . ,(intern type)))))
(if (and hook (boundp hook))
(if (string-equal type "ACTION")
(run-hook-with-args-until-success
@@ -6637,7 +6741,8 @@ erc-send-current-line
(when-let (((not (erc--input-split-abortp state)))
(inhibit-read-only t)
(old-buf (current-buffer)))
- (progn ; unprogn this during next major surgery
+ (let ((erc--msg-prop-overrides '((erc-cmd . PRIVMSG)
+ (erc-msg . msg))))
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
(delete-region erc-input-marker (erc-end-of-input-line))
@@ -6784,17 +6889,24 @@ erc-display-msg
(save-excursion
(erc--assert-input-bounds)
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
+ (erc--msg-props (or erc--msg-props
+ (map-into (cons '(erc-msg . self)
+ erc--msg-prop-overrides)
+ 'hash-table)))
beg)
(insert (erc-format-my-nick))
(setq beg (point))
(insert line)
(erc-put-text-property beg (point) 'font-lock-face 'erc-input-face)
- (erc-put-text-property insert-position (point) 'erc-command 'PRIVMSG)
(insert "\n")
(save-restriction
(narrow-to-region insert-position (point))
(run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook))
+ (run-hooks 'erc-send-post-hook)
+ (cl-assert (> (- (point-max) (point-min)) 1))
+ (add-text-properties (point-min) (1+ (point-min))
+ (erc--order-text-properties-from-hash
+ erc--msg-props)))
(erc--refresh-prompt)))))
(defun erc-command-symbol (command)
@@ -8181,21 +8293,13 @@ erc-find-parsed-property
"Find the next occurrence of the `erc-parsed' text property."
(text-property-not-all (point-min) (point-max) 'erc-parsed nil))
-(defvar erc--persistent-message-properties '(erc-command))
-
(defun erc-restore-text-properties ()
- "Ensure the `erc-parsed' property covers the narrowed buffer.
-Do this for other properties added by `erc-display-message' and
-for those named in `erc--persistent-message-properties'."
+ "Ensure the `erc-parsed' and `tags' props cover the entire message."
(when-let ((parsed-posn (erc-find-parsed-property))
- (found (erc-get-parsed-vector parsed-posn)))
+ (found (erc-get-parsed-vector parsed-posn)))
(put-text-property (point-min) (point-max) 'erc-parsed found)
(when-let ((tags (get-text-property parsed-posn 'tags)))
- (put-text-property (point-min) (point-max) 'tags tags))
- (let ((to (max (point-min) (1- (point-max)))))
- (dolist (prop erc--persistent-message-properties)
- (when-let ((val (get-text-property parsed-posn prop)))
- (put-text-property (point-min) to prop val))))))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index b81d0c15558..f6c4c268017 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -31,10 +31,14 @@ erc-fill-tests--time-vals
(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
(declare (indent 1))
- (let ((msg (erc-format-privmessage speaker
- (apply #'concat msg-parts) nil t)))
- (put-text-property 0 (length msg) 'erc-command 'PRIVMSG msg)
- (erc-display-message nil nil (current-buffer) msg)))
+ (let* ((msg (erc-format-privmessage speaker
+ (apply #'concat msg-parts) nil t))
+ ;; (erc--msg-prop-overrides '((erc-msg . msg) (erc-cmd . PRIVMSG)))
+ (parsed (make-erc-response :unparsed msg :sender speaker
+ :command "PRIVMSG"
+ :command-args (list "#chan" msg)
+ :contents msg)))
+ (erc-display-message parsed nil (current-buffer) msg)))
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
@@ -75,8 +79,8 @@ erc-fill-tests--wrap-populate
(erc-fill-tests--insert-privmsg "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.")
+ "What was done to Elbow's wife, that he hath cause to complain of?"
+ " Come me to what was done to her.")
;; Introduce an artificial gap in properties `line-prefix' and
;; `wrap-prefix' and later ensure they're not incremented twice.
@@ -111,6 +115,14 @@ erc-fill-tests--wrap-check-prefixes
(should (get-text-property (pos-bol) 'line-prefix))
(should (get-text-property (1- (pos-eol)) 'line-prefix))
(should-not (get-text-property (pos-eol) 'line-prefix))
+ ;; Spans entire line uninterrupted.
+ (let* ((val (get-text-property (pos-bol) 'line-prefix))
+ (end (text-property-not-all (pos-bol) (point-max)
+ 'line-prefix val)))
+ (when (and (/= end (pos-eol)) (= ?? (char-before end)))
+ (setq end (text-property-not-all (1+ end) (point-max)
+ 'line-prefix val)))
+ (should (eq end (pos-eol))))
(should (equal (get-text-property (pos-bol) 'wrap-prefix)
'(space :width erc-fill--wrap-value)))
(should-not (get-text-property (pos-eol) 'wrap-prefix))
@@ -145,7 +157,7 @@ erc-fill-tests--compare
(number-to-string erc-fill--wrap-value)
(prin1-to-string got))))
(with-current-buffer (generate-new-buffer name)
- (push name erc-fill-tests--buffers)
+ (push (current-buffer) erc-fill-tests--buffers)
(with-silent-modifications
(insert (setq got (read repr))))
(erc-mode))
@@ -153,15 +165,31 @@ erc-fill-tests--compare
(with-temp-file expect-file
(insert repr))
(if (file-exists-p expect-file)
- ;; Compare set-equal over intervals. This comparison is
- ;; less useful for messages treated by other modules because
- ;; it doesn't compare "nested" props belonging to
- ;; string-valued properties, like timestamps.
- (should (equal-including-properties
- (read repr)
- (read (with-temp-buffer
- (insert-file-contents-literally expect-file)
- (buffer-string)))))
+ ;; Ensure string-valued properties, like timestamps, aren't
+ ;; recursive (signals `max-lisp-eval-depth' exceeded).
+ (named-let assert-equal
+ ((latest (read repr))
+ (expect (read (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (buffer-string)))))
+ (pcase latest
+ ((or "" 'nil) t)
+ ((pred stringp)
+ (should (equal-including-properties latest expect))
+ (let ((latest-intervals (object-intervals latest))
+ (expect-intervals (object-intervals expect)))
+ (while-let ((l-iv (pop latest-intervals))
+ (x-iv (pop expect-intervals))
+ (l-tab (map-into (nth 2 l-iv) 'hash-table))
+ (x-tab (map-into (nth 2 x-iv) 'hash-table)))
+ (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab))
+ (assert-equal l-v (gethash l-k x-tab))
+ (remhash l-k x-tab))
+ (should (zerop (hash-table-count x-tab))))))
+ ((pred sequencep)
+ (assert-equal (seq-first latest) (seq-first expect))
+ (assert-equal (seq-rest latest) (seq-rest expect)))
+ (_ (should (equal latest expect)))))
(message "Snapshot file missing: %S" expect-file)))))
;; To inspect variable pitch, set `erc-mode-hook' to
@@ -206,6 +234,13 @@ erc-fill-wrap--monospace
(erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
(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)
@@ -217,7 +252,9 @@ erc-fill-wrap--merge
(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: "<bob> zero."
(let ((erc-fill-tests--time-vals (lambda () 1680332400)))
(erc-fill-tests--insert-privmsg "bob" "zero.")
(erc-fill-tests--insert-privmsg "alice" "one.")
@@ -239,7 +276,12 @@ erc-fill-wrap--merge
(erc-fill-tests--wrap-check-prefixes
"*** " "<alice> " "<bob> "
"<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
- (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)
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index bc06d58c3e9..864f3881ab1 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -55,7 +55,8 @@ erc-scenarios-match--stamp-left-current-nick
:nick "tester")
;; Module `timestamp' follows `match' in insertion hooks.
(should (memq 'erc-add-timestamp
- (memq 'erc-match-message erc-insert-modify-hook)))
+ (memq 'erc-match-message
+ (default-value 'erc-insert-modify-hook))))
;; The "match type" is `current-nick'.
(funcall expect 5 "tester")
(should (eq (get-text-property (1- (point)) 'font-lock-face)
@@ -91,7 +92,8 @@ erc-scenarios-match--invisible-stamp
:nick "tester")
;; Module `timestamp' follows `match' in insertion hooks.
(should (memq 'erc-add-timestamp
- (memq 'erc-match-message erc-insert-modify-hook)))
+ (memq 'erc-match-message
+ (default-value 'erc-insert-modify-hook))))
(funcall expect 5 "This server is in debug mode")))
(ert-info ("Ensure lines featuring \"bob\" are invisible")
@@ -151,28 +153,13 @@ erc-scenarios-match--stamp-left-fools-invisible
(= (next-single-property-change msg-beg 'invisible nil (pos-eol))
(pos-eol))))))))
-(defun erc-scenarios-match--find-bol ()
- (save-excursion
- (should (get-text-property (1- (point)) 'erc-command))
- (goto-char (should (previous-single-property-change (point) 'erc-command)))
- (pos-bol)))
-
-(defun erc-scenarios-match--find-eol ()
- (save-excursion
- (if-let ((next (next-single-property-change (point) 'erc-command)))
- (goto-char next)
- ;; We're already at the end of the message.
- (should (get-text-property (1- (point)) 'erc-command)))
- (pos-eol)))
-
;; In most cases, `erc-hide-fools' makes line endings invisible.
(defun erc-scenarios-match--stamp-right-fools-invisible ()
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
(erc-scenarios-match--invisible-stamp
(lambda ()
- (let ((beg (erc-scenarios-match--find-bol))
- (end (erc-scenarios-match--find-eol)))
+ (pcase-let ((`(,beg . ,end) (erc--get-inserted-msg-bounds)))
;; The end of the message is a newline.
(should (= ?\n (char-after end)))
@@ -204,7 +191,7 @@ erc-scenarios-match--stamp-right-fools-invisible
(should (= (next-single-property-change msg-end 'invisible) end)))))
(lambda ()
- (let ((end (erc-scenarios-match--find-eol)))
+ (let ((end (cdr (erc--get-inserted-msg-bounds))))
;; This message has a time stamp like all the others.
(should (eq (field-at-pos (1- end)) 'erc-timestamp))
@@ -279,7 +266,8 @@ erc-scenarios-match--fill-wrap-stamp-dedented-p
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-wrap ()
- ;; Rewind the clock to known date artificially.
+ ;; Rewind the clock to known date artificially. We should probably
+ ;; use a ticks/hz cons on 29+.
(let ((erc-stamp--current-time 704591940)
(erc-stamp--tz t)
(erc-fill-function #'erc-fill-wrap)
@@ -305,29 +293,22 @@ erc-scenarios-match--stamp-both-invisible-fill-wrap
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `match-fools'.
(should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (let* ((mbeg (or (and (get-text-property (pos-bol) 'erc-command)
- (pos-bol))
- (next-single-property-change (pos-bol)
- 'erc-command)))
- (mend (text-property-not-all
- mbeg (point-max) 'erc-command
- (get-text-property mbeg 'erc-command))))
-
- (if (/= 1 bob-utterance-counter)
- (should-not (field-at-pos mend))
- ;; For Bob's stamped message, check newline after stamp.
- (should (eq (field-at-pos mend) 'erc-timestamp))
- (setq mend (field-end mend)))
+ (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds)))
+ (should (= (char-after mend) ?\n))
+ (should-not (field-at-pos mend))
+ (should-not (field-at-pos mbeg))
+
+ (when (= bob-utterance-counter 1)
+ (let ((right-stamp (field-end mbeg)))
+ (should (eq 'erc-timestamp (field-at-pos right-stamp)))
+ (should (= mend (field-end right-stamp)))
+ (should (eq (field-at-pos (1- mend)) 'erc-timestamp))))
- ;; The `erc-timestamp' property spans entire messages,
- ;; including stamps and filled text, which makes for
- ;; convenient traversal when `erc-stamp-mode' is enabled.
- (should (get-text-property (pos-bol) 'erc-timestamp))
- (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
- mend))
+ ;; The `erc-ts' property is present in prop stack.
+ (should (get-text-property (pos-bol) 'erc-ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
;; Line ending has the `invisible' property `match-fools'.
- (should (= (char-after mend) ?\n))
(should (eq (get-text-property mbeg 'invisible) 'match-fools))
(should-not (get-text-property mend 'invisible))))
@@ -410,22 +391,20 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `match-fools'.
(should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (let* ((mbeg (and (get-text-property (pos-bol) 'erc-command)
- (pos-bol)))
- (mend (next-single-property-change mbeg 'erc-command)))
+ (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds)))
- (if (/= 1 bob-utterance-counter)
- (should-not (field-at-pos mend))
+ (should (= (char-after mend) ?\n))
+ (should-not (field-at-pos mbeg))
+ (should-not (field-at-pos mend))
+ (when (= 1 bob-utterance-counter)
;; For Bob's stamped message, check newline after stamp.
- (should (eq (field-at-pos mend) 'erc-timestamp))
- (setq mend (field-end mend)))
+ (should (eq (field-at-pos (field-end mbeg)) 'erc-timestamp))
+ (should (eq (field-at-pos (1- mend)) 'erc-timestamp)))
- ;; The `erc-timestamp' property spans entire messages,
- ;; including stamps and filled text, which makes for
- ;; convenient traversal when `erc-stamp-mode' is enabled.
- (should (get-text-property (pos-bol) 'erc-timestamp))
- (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
- mend))
+ ;; The `erc-ts' property is present in the message's
+ ;; width 1 prop collection at its first char.
+ (should (get-text-property (pos-bol) 'erc-ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
@@ -510,9 +489,12 @@ erc-scenarios-match--stamp-both-invisible-fill-static--nooffset
(field-beginning (point))))
(should (equal 'timestamp
(get-text-property (1- (point)) 'invisible)))
+ ;; Field stops before final newline because the date stamp
+ ;; is (now, as of ERC 5.6) its own standalone message.
+ (should (= ?\n (char-after (field-end (point)))))
;; Stamp-only invisibility includes last newline.
(should (= (text-property-not-all (1- (point)) (point-max)
'invisible 'timestamp)
- (field-end (point))))))))))
+ (1+ (field-end (point)))))))))))
;;; erc-scenarios-match.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 46a05729066..cc61d599387 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -279,7 +279,7 @@ erc-echo-timestamp
(should-not erc-echo-timestamps)
(should-not erc-stamp--last-stamp)
- (insert (propertize "abc" 'erc-timestamp 433483200))
+ (insert (propertize "a" 'erc-ts 433483200 'erc-msg 'msg) "bc")
(goto-char (point-min))
(let ((inhibit-message t)
(erc-echo-timestamp-format "%Y-%m-%d %H:%M:%S %Z")
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index bd2d656e8da..408cc4db10c 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -292,6 +292,8 @@ erc--refresh-prompt
(cl-incf counter))))
erc-accidental-paste-threshold-seconds
erc-insert-modify-hook
+ (erc-modules (remq 'stamp erc-modules))
+ (erc-send-input-line-function #'ignore)
(erc--input-review-functions erc--input-review-functions)
erc-send-completed-hook)
@@ -356,7 +358,8 @@ erc--refresh-prompt
(should (looking-back "#chan@ServNet 11> "))
(should (= (point) erc-input-marker))
(insert "/query bob")
- (erc-send-current-line)
+ (let (erc-modules)
+ (erc-send-current-line))
;; Last command not inserted
(save-excursion (forward-line -1)
(should (looking-at "<tester> Howdy")))
@@ -796,18 +799,15 @@ erc--valid-local-channel-p
(should (erc--valid-local-channel-p "&local")))))
(ert-deftest erc--restore-initialize-priors ()
- ;; This `pcase' expands to 100+k. Guess we could do something like
- ;; (and `(,_ ((,e . ,_) . ,_) . ,_) v) first and then return a
- ;; (equal `(if-let* ((,e ...)...)...) v) to cut it down to < 1k.
(should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode
foo (ignore 1 2 3)
- bar #'spam))
- (`(if-let* ((,e (or erc--server-reconnecting erc--target-priors))
- ((alist-get 'erc-my-mode ,e)))
- (setq foo (alist-get 'foo ,e)
- bar (alist-get 'bar ,e))
- (setq foo (ignore 1 2 3)
- bar #'spam))
+ bar #'spam
+ baz nil))
+ (`(let* ((,p (or erc--server-reconnecting erc--target-priors))
+ (,q (and ,p (alist-get 'erc-my-mode ,p))))
+ (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3))
+ bar (if ,q (alist-get 'bar ,p) #'spam)
+ baz (if ,q (alist-get 'baz ,p) nil)))
t))))
(ert-deftest erc--target-from-string ()
@@ -1434,6 +1434,44 @@ erc-process-input-line
(should-not calls))))))
+(ert-deftest erc--order-text-properties-from-hash ()
+ (let ((table (map-into '((a . 1)
+ (erc-ts . 0)
+ (erc-msg . s005)
+ (b . 2)
+ (erc-cmd . 5)
+ (c . 3))
+ 'hash-table)))
+ (with-temp-buffer
+ (erc-mode)
+ (insert "abc\n")
+ (add-text-properties 1 2 (erc--order-text-properties-from-hash table))
+ (should (equal '( erc-msg s005
+ erc-ts 0
+ erc-cmd 5
+ a 1
+ b 2
+ c 3)
+ (text-properties-at (point-min)))))))
+
+(ert-deftest erc--check-msg-prop ()
+ (let ((erc--msg-props (map-into '((a . 1) (b . x)) 'hash-table)))
+ (should (eq 1 (erc--check-msg-prop 'a)))
+ (should (erc--check-msg-prop 'a 1))
+ (should-not (erc--check-msg-prop 'a 2))
+
+ (should (eq 'x (erc--check-msg-prop 'b)))
+ (should (erc--check-msg-prop 'b 'x))
+ (should-not (erc--check-msg-prop 'b 1))
+
+ (should (erc--check-msg-prop 'a '(1 42)))
+ (should-not (erc--check-msg-prop 'a '(2 42)))
+
+ (let ((props '(42 x)))
+ (should (erc--check-msg-prop 'b props)))
+ (let ((v '(42 y)))
+ (should-not (erc--check-msg-prop 'b v)))))
+
(defmacro erc-tests--equal-including-properties (a b)
(list (if (< emacs-major-version 29)
'ert-equal-including-properties
diff --git a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
index c62a22a11c7..4c2b1d61e24 100644
--- a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
+++ b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
(0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC")
@@ -18,16 +18,16 @@
(0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-((mode-user 8 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.barnet.org 221 tester +i")
(0 ":irc.barnet.org NOTICE tester :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."))
-((join 2 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@jnu48g2wrycbw.irc JOIN #chan")
(0 ":irc.barnet.org 353 tester = #chan :@mike joe tester")
(0 ":irc.barnet.org 366 tester #chan :End of NAMES list"))
-((mode 2 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620104779")
(0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :tester, welcome!")
diff --git a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
index f30b7deca11..bfa324642ce 100644
--- a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
+++ b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
@@ -18,16 +18,16 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 8 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.foonet.org 221 tester +i")
(0 ":irc.foonet.org NOTICE tester :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."))
-((join 2 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-((mode 2 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620104779")
(0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
index 686a47f68a3..04959954c4f 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
@@ -22,14 +22,14 @@
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-((join 1 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
(0 ":irc.barnet.org 353 tester = #chan :@joe mike tester")
(0 ":irc.barnet.org 366 tester #chan :End of NAMES list")
(0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!")
(0 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620805269")
(0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: But you have outfaced them all.")
diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
index b99621cc311..7b9b3bdee6c 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
@@ -22,14 +22,14 @@
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-((join 1 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@ertp7idh9jtgi.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!")
(0 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620805271")
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: He cannot be heard of. Out of doubt he is transported.")
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 689bacc7012..238d8cc73c2 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 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) 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) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 27 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 27 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 474 475 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 27 (8))) erc-command PRIVMSG) 475 480 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 480 486 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 487 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 27 0)) display #11="" erc-command PRIVMSG) 488 493 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 493 495 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 495 499 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 500 501 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 27 (6))) erc-command PRIVMSG) 501 504 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 504 512 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 513 514 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13=(space :width (- 27 0)) display #11# erc-command PRIVMSG) 514 517 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 517 519 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 519 524 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# erc-command PRIVMSG) 525 526 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14=(space :width (- 27 (8))) erc-command PRIVMSG) 526 531 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 531 538 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 539 540 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15=(space :width (- 27 0)) display #11# erc-command PRIVMSG) 540 545 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 545 547 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 547 551 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# erc-command PRIVMSG))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index 9fa23a7d332..d1ce9198e69 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 20 (erc-timestamp 0 line-prefix (space :width (- 29 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 29 (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) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 29 (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) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 29 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 29 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 474 475 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 29 (8))) erc-command PRIVMSG) 475 480 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 480 486 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 487 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 29 0)) display #11="" erc-command PRIVMSG) 488 493 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 493 495 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 495 499 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 500 501 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 29 (6))) erc-command PRIVMSG) 501 504 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 504 512 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 513 514 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13=(space :width (- 29 0)) display #11# erc-command PRIVMSG) 514 517 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 517 519 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 519 524 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# erc-command PRIVMSG) 525 526 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14=(space :width (- 29 (8))) erc-command PRIVMSG) 526 531 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 531 538 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 539 540 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15=(space :width (- 29 0)) display #11# erc-command PRIVMSG) 540 545 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 545 547 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 547 551 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# erc-command PRIVMSG))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index a3d533c87b5..d70184724ba 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +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 one\n<bob> two.\n* bob three\n<bob> four.\n" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# invisible timestamp font-lock-face erc-timestamp-face)))) 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) 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) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 27 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 27 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# invisible timestamp font-lock-face erc-timestamp-face)))) 474 476 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 27 (6))) erc-ctcp ACTION erc-command PRIVMSG) 476 479 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-ctcp ACTION erc-command PRIVMSG) 479 483 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-ctcp ACTION erc-command PRIVMSG) 484 485 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 27 (6))) erc-command PRIVMSG) 485 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 488 494 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 495 497 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11=(space :width (- 27 (2))) erc-ctcp ACTION erc-command PRIVMSG) 497 500 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11# erc-ctcp ACTION erc-command PRIVMSG) 500 506 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11# erc-ctcp ACTION erc-command PRIVMSG) 507 508 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 27 (6))) erc-command PRIVMSG) 508 511 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 511 518 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG))
\ No newline at end of file
+#("\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 one\n<bob> two.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index 80c9e1d80f5..def97738ce6 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +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" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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)))) 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) 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))
\ No newline at end of file
+#("\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" 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 unknown 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 ((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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index e675695f660..be3e2b33cfd 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +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" 2 20 (erc-timestamp 0 line-prefix (space :width (- 29 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (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)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 29 (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) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 29 (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))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index a6070c2e3ff..098257d0b49 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +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" 2 20 (erc-timestamp 0 line-prefix (space :width (- 25 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (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)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 25 (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) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 25 (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))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index 80c9e1d80f5..def97738ce6 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +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" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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)))) 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) 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))
\ No newline at end of file
+#("\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" 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 unknown 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 ((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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 2b8766c27f4..360b3dafafd 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +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 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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) 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) 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) 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) 467 484 (erc-timestamp 0 wrap-prefix #2# line-prefix (space :width (- 27 (4)))) 485 502 (erc-timestamp 0 wrap-prefix #2# line-prefix (space :width (- 27 (4)))) 502 503 (line-spacing 0.5) 503 504 (erc-timestamp 0 wrap-prefix #2# line-prefix #8=(space :width (- 27 (6))) erc-command PRIVMSG) 504 507 (erc-timestamp 0 wrap-prefix #2# line-prefix #8# erc-command PRIVMSG) 507 525 (erc-timestamp 0 wrap-prefix #2# line-prefix #8# erc-command PRIVMSG))
\ No newline at end of file
+#("\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 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 unknown 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
index f62b65cd170..cd3537d3c94 100644
--- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -1 +1 @@
-#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG))
\ No newline at end of file
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg unknown erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
\ No newline at end of file
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Allow-spoofing-process-marker-in-erc-display-lin.patch --]
[-- Type: text/x-patch, Size: 8213 bytes --]
From 69aa1ebcac9044efc78c922dcb7805144cc237a7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 2 Oct 2023 22:59:22 -0700
Subject: [PATCH 1/7] [5.6] Allow spoofing process marker in erc-display-line-1
* lisp/erc/erc.el (erc--insert-marker): New internal variable for
overriding `erc-insert-marker' when displaying messages at a
non-default location in the buffer.
(erc-display-line-1): Favor `erc--insert-marker' over
`erc-insert-marker' when non-nil.
* test/lisp/erc/resources/base/assoc/multi-net/barnet.eld: Timeouts.
* test/lisp/erc/resources/base/assoc/multi-net/foonet.eld: Timeouts.
* test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld: Timeouts.
* test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld: Timeouts.
---
lisp/erc/erc.el | 7 ++++++-
.../erc/resources/base/assoc/multi-net/barnet.eld | 12 ++++++------
.../erc/resources/base/assoc/multi-net/foonet.eld | 12 ++++++------
.../erc/resources/base/netid/bouncer/barnet-drop.eld | 4 ++--
.../erc/resources/base/netid/bouncer/foonet-drop.eld | 4 ++--
5 files changed, 22 insertions(+), 17 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index fb236f1f189..b78f8bc6210 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2909,6 +2909,8 @@ erc--refresh-prompt
(delete-region (point) (1- erc-input-marker))))
(run-hooks 'erc--refresh-prompt-hook)))
+(defvar erc--insert-marker nil)
+
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
Auxiliary function used in `erc-display-line'. The line gets filtered to
@@ -2932,6 +2934,8 @@ erc-display-line-1
(format "%s" buffer)))
(setq erc-insert-this t)
(run-hook-with-args 'erc-insert-pre-hook string)
+ (setq insert-position (marker-position (or erc--insert-marker
+ erc-insert-marker)))
(if (null erc-insert-this)
;; Leave erc-insert-this set to t as much as possible. Fran
;; Litterio <franl> has seen erc-insert-this set to nil while
@@ -2954,7 +2958,8 @@ erc-display-line-1
'(erc-parsed nil))))
(erc--refresh-prompt)))))
(run-hooks 'erc-insert-done-hook)
- (erc-update-undo-list (- (or (marker-position erc-insert-marker)
+ (erc-update-undo-list (- (or (marker-position (or erc--insert-marker
+ erc-insert-marker))
(point-max))
insert-position))))))
diff --git a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
index c62a22a11c7..4c2b1d61e24 100644
--- a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
+++ b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
(0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC")
@@ -18,16 +18,16 @@
(0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-((mode-user 8 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.barnet.org 221 tester +i")
(0 ":irc.barnet.org NOTICE tester :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."))
-((join 2 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@jnu48g2wrycbw.irc JOIN #chan")
(0 ":irc.barnet.org 353 tester = #chan :@mike joe tester")
(0 ":irc.barnet.org 366 tester #chan :End of NAMES list"))
-((mode 2 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620104779")
(0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :tester, welcome!")
diff --git a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
index f30b7deca11..bfa324642ce 100644
--- a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
+++ b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC")
@@ -18,16 +18,16 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 8 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.foonet.org 221 tester +i")
(0 ":irc.foonet.org NOTICE tester :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."))
-((join 2 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-((mode 2 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620104779")
(0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
index 686a47f68a3..04959954c4f 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
@@ -22,14 +22,14 @@
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-((join 1 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
(0 ":irc.barnet.org 353 tester = #chan :@joe mike tester")
(0 ":irc.barnet.org 366 tester #chan :End of NAMES list")
(0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!")
(0 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620805269")
(0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: But you have outfaced them all.")
diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
index b99621cc311..7b9b3bdee6c 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
@@ -22,14 +22,14 @@
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-((join 1 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@ertp7idh9jtgi.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!")
(0 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620805271")
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: He cannot be heard of. Out of doubt he is transported.")
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Honor-nil-values-in-erc-restore-initialize-prior.patch --]
[-- Type: text/x-patch, Size: 3404 bytes --]
From ffcc811bdc69f089059ff907c4a265c406c965fc Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 5 Oct 2023 00:16:46 -0700
Subject: [PATCH 2/7] [5.6] Honor nil values in erc--restore-initialize-priors
* lisp/erc/erc.el (erc--restore-initialize-priors): Don't produce
invalid empty `setq' when given VARS that initialize to nil.
* test/lisp/erc/erc-tests.el (erc--restore-initialize-priors): Fix
expected expansion.
---
lisp/erc/erc.el | 17 ++++++++---------
test/lisp/erc/erc-tests.el | 17 +++++++----------
2 files changed, 15 insertions(+), 19 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index b78f8bc6210..a3ba1548084 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1366,16 +1366,15 @@ erc--target-priors
(defmacro erc--restore-initialize-priors (mode &rest vars)
"Restore local VARS for MODE from a previous session."
(declare (indent 1))
- (let ((existing (make-symbol "existing"))
+ (let ((priors (make-symbol "priors"))
+ (initp (make-symbol "initp"))
;;
- restore initialize)
- (while-let ((k (pop vars)) (v (pop vars)))
- (push `(,k (alist-get ',k ,existing)) restore)
- (push `(,k ,v) initialize))
- `(if-let* ((,existing (or erc--server-reconnecting erc--target-priors))
- ((alist-get ',mode ,existing)))
- (setq ,@(mapcan #'identity (nreverse restore)))
- (setq ,@(mapcan #'identity (nreverse initialize))))))
+ forms)
+ (while-let ((k (pop vars)))
+ (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms))
+ `(let* ((,priors (or erc--server-reconnecting erc--target-priors))
+ (,initp (and ,priors (alist-get ',mode ,priors))))
+ (setq ,@(mapcan #'identity (nreverse forms))))))
(defun erc--target-from-string (string)
"Construct an `erc--target' variant from STRING."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 8a68eca6196..64b503832f3 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -796,18 +796,15 @@ erc--valid-local-channel-p
(should (erc--valid-local-channel-p "&local")))))
(ert-deftest erc--restore-initialize-priors ()
- ;; This `pcase' expands to 100+k. Guess we could do something like
- ;; (and `(,_ ((,e . ,_) . ,_) . ,_) v) first and then return a
- ;; (equal `(if-let* ((,e ...)...)...) v) to cut it down to < 1k.
(should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode
foo (ignore 1 2 3)
- bar #'spam))
- (`(if-let* ((,e (or erc--server-reconnecting erc--target-priors))
- ((alist-get 'erc-my-mode ,e)))
- (setq foo (alist-get 'foo ,e)
- bar (alist-get 'bar ,e))
- (setq foo (ignore 1 2 3)
- bar #'spam))
+ bar #'spam
+ baz nil))
+ (`(let* ((,p (or erc--server-reconnecting erc--target-priors))
+ (,q (and ,p (alist-get 'erc-my-mode ,p))))
+ (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3))
+ bar (if ,q (alist-get 'bar ,p) #'spam)
+ baz (if ,q (alist-get 'baz ,p) nil)))
t))))
(ert-deftest erc--target-from-string ()
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Preserve-format-spec-args-in-erc-server-JOIN.patch --]
[-- Type: text/x-patch, Size: 2417 bytes --]
From 62c6585251a1d0a604499f103f87884a1b33de3b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 4 Oct 2023 20:39:03 -0700
Subject: [PATCH 3/7] [5.6] Preserve format-spec args in erc-server-JOIN
* lisp/erc/erc-backend.el (erc-server-JOIN): Let `erc-display-message'
handle formatting instead of baking out a string. The text ultimately
inserted remains unchanged, but forwarding the original `format-spec'
arguments now has the side effect of influencing text properties, which
conveys richer meaning for modules to act upon when doing things like
deciding whether to hide a message.
---
lisp/erc/erc-backend.el | 11 ++++-------
1 file changed, 4 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index fb10ee31c78..bc42917375a 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1718,7 +1718,7 @@ erc--server-determine-join-display-context
(if (string-match "^\\(.*\\)\^g.*$" chnl)
(setq chnl (match-string 1 chnl)))
(save-excursion
- (let* ((str (cond
+ (let ((args (cond
;; If I have joined a channel
((erc-current-nick-p nick)
(let ((erc--display-context
@@ -1735,18 +1735,15 @@ erc--server-determine-join-display-context
(erc-channel-begin-receiving-names))
(erc-update-mode-line)
(run-hooks 'erc-join-hook)
- (erc-make-notice
- (erc-format-message 'JOIN-you ?c chnl)))
+ (list 'JOIN-you ?c chnl))
(t
(setq buffer (erc-get-buffer chnl proc))
- (erc-make-notice
- (erc-format-message
- 'JOIN ?n nick ?u login ?h host ?c chnl))))))
+ (list 'JOIN ?n nick ?u login ?h host ?c chnl)))))
(when buffer (set-buffer buffer))
(erc-update-channel-member chnl nick nick t nil nil nil nil nil host login)
;; on join, we want to stay in the new channel buffer
;;(set-buffer ob)
- (erc-display-message parsed nil buffer str))))))
+ (apply #'erc-display-message parsed 'notice buffer args))))))
(define-erc-response-handler (KICK)
"Handle kick messages received from the server." nil
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Deprecate-option-erc-remove-parsed-property.patch --]
[-- Type: text/x-patch, Size: 3063 bytes --]
From 866a2681dacc4307d9f6b177dbab5beccc740f4c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 3 Oct 2023 00:00:19 -0700
Subject: [PATCH 4/7] [5.6] Deprecate option erc-remove-parsed-property
* etc/ERC-NEWS: Add entry for `erc-remove-parsed-property'.
* lisp/erc/erc.el (erc-remove-parsed-property): Deprecate option
because the potential for inadvertent self harm outweighs the
potential benefits. Additionally, replicating this functionality via
hooks is trivial.
(erc-display-line-1): Remove quasi-deprecated `tags' property.
---
etc/ERC-NEWS | 8 ++++++++
lisp/erc/erc.el | 13 +++++++++++--
2 files changed, 19 insertions(+), 2 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index fadd97b65df..284b91bb41f 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -221,6 +221,14 @@ atop any message. The new companion option 'erc-echo-timestamp-zone'
determines the default timezone when not specified with a prefix
argument.
+** Option 'erc-remove-parsed-property' deprecated.
+This option's nil behavior serves no practical purpose yet has the
+potential to degrade the user experience by competing for space with
+forthcoming features powered by next generation extensions. Anyone
+with a legitimate use for this option likely also possesses the
+knowledge to rig up a suitable analog with minimal effort. That said,
+the road to removal is long.
+
** Option 'erc-warn-about-blank-lines' is more informative.
Enabled by default, this option now produces more useful feedback
whenever ERC rejects prompt input containing whitespace-only lines.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a3ba1548084..aedec60321b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2876,9 +2876,18 @@ erc-remove-parsed-property
The default is to remove it, since it causes ERC to take up extra
memory. If you have code that relies on this property, then set
-this option to nil."
+this option to nil.
+
+Note that this option is deprecated because a value of nil is
+impractical in prolonged sessions with more than a few channels.
+Use `erc-insert-post-hook' or similar and the helper function
+`erc-find-parsed-property' and friends to stash the current
+`erc-response' object as needed. And instead of using this for
+debugging purposes, try `erc-debug-irc-protocol'."
:type 'boolean
:group 'erc)
+(make-obsolete-variable 'erc-remove-parsed-property
+ "impractical when non-nil" "30.1")
(define-inline erc--assert-input-bounds ()
(inline-quote
@@ -2954,7 +2963,7 @@ erc-display-line-1
(run-hooks 'erc-insert-post-hook)
(when erc-remove-parsed-property
(remove-text-properties (point-min) (point-max)
- '(erc-parsed nil))))
+ '(erc-parsed nil tags nil))))
(erc--refresh-prompt)))))
(run-hooks 'erc-insert-done-hook)
(erc-update-undo-list (- (or (marker-position (or erc--insert-marker
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Add-helper-for-removing-list-valued-text-props-i.patch --]
[-- Type: text/x-patch, Size: 10327 bytes --]
From a9638d22c67ffed2fd25f4ecf10f0d3a2aac5ea9 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 3 Oct 2023 23:15:40 -0700
Subject: [PATCH 5/7] [5.6] Add helper for removing list-valued text props in
ERC
* lisp/erc/erc.el (erc--remove-from-prop-value-list): New function for
removing `invisible' and `face' prop members cleanly.
* test/lisp/erc/erc-tests.el (erc--remove-from-prop-value-list,
erc--remove-from-prop-value-list/many): New tests. (Bug#60936)
---
lisp/erc/erc.el | 24 ++++++
test/lisp/erc/erc-tests.el | 169 +++++++++++++++++++++++++++++++++++++
2 files changed, 193 insertions(+)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index aedec60321b..f3c480f918b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3061,6 +3061,30 @@ erc--merge-prop
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
+(defun erc--remove-from-prop-value-list (from to prop val &optional object)
+ "Remove VAL from text prop value between FROM and TO.
+If current value is VAL itself, remove the property entirely.
+When VAL is a list, act as if this function were called
+repeatedly with VAL set to each of VAL's members."
+ (let ((old (get-text-property from prop object))
+ (pos from)
+ (end (next-single-property-change from prop object to))
+ new)
+ (while (< pos to)
+ (when old
+ (if (setq new (and (consp old) (if (consp val)
+ (seq-difference old val)
+ (remq val old))))
+ (put-text-property pos end prop
+ (if (cdr new) new (car new)) object)
+ (when (pcase val
+ ((pred consp) (or (consp old) (memq old val)))
+ (_ (if (consp old) (memq val old) (eq old val))))
+ (remove-text-properties pos end (list prop nil) object))))
+ (setq pos end
+ old (get-text-property pos prop object)
+ end (next-single-property-change pos prop object to)))))
+
(defvar erc-legacy-invisible-bounds-p nil
"Whether to hide trailing rather than preceding newlines.
Beginning in ERC 5.6, invisibility extends from a message's
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 64b503832f3..11717217eb2 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1475,6 +1475,175 @@ erc--merge-prop
(when noninteractive
(kill-buffer))))
+(ert-deftest erc--remove-from-prop-value-list ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Non-list match.
+ (insert "abc\n")
+ (put-text-property 1 2 'erc-test 'a)
+ (put-text-property 2 3 'erc-test 'b)
+ (put-text-property 3 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 1 2 (erc-test b)
+ 2 3 (erc-test c))))
+
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'b)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "abc"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "def\n")
+ (put-text-property 1 2 'erc-test '(d x))
+ (put-text-property 2 3 'erc-test '(e y))
+ (put-text-property 3 4 'erc-test '(f z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x))
+ 1 2 (erc-test (e y))
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x))
+ 1 2 (erc-test e)
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'd)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'f)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test x)
+ 1 2 (erc-test e)
+ 2 3 (erc-test z))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'e)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'z)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "def"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (put-text-property 1 2 'erc-test '(g x))
+ (put-text-property 2 3 'erc-test '(h x))
+ (put-text-property 3 4 'erc-test '(i y))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test (g x))
+ 1 2 (erc-test (h x))
+ 2 3 (erc-test (i y)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test g)
+ 1 2 (erc-test h)
+ 2 3 (erc-test (i y)))))
+ (erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed
+ (erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 1 2 (erc-test h)
+ 2 3 (erc-test y))))
+
+ ;; Pathological (,c) case (hopefully not created by ERC)
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (put-text-property 1 2 'erc-test '(j x))
+ (put-text-property 2 3 'erc-test '(k))
+ (put-text-property 3 4 'erc-test '(k))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'k)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x)))))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest erc--remove-from-prop-value-list/many ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Non-list match.
+ (insert "abc\n")
+ (put-text-property 1 2 'erc-test 'a)
+ (put-text-property 2 3 'erc-test 'b)
+ (put-text-property 3 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 1 2 (erc-test b)
+ 2 3 (erc-test c))))
+
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(a b))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(c))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "abc"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "def\n")
+ (put-text-property 1 2 'erc-test '(d x y))
+ (put-text-property 2 3 'erc-test '(e y))
+ (put-text-property 3 4 'erc-test '(f z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x y))
+ 1 2 (erc-test (e y))
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(d y f))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test x)
+ 1 2 (erc-test e)
+ 2 3 (erc-test z))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(e z x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "def"))
+
+ ;; Narrowed beg.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (put-text-property 1 2 'erc-test '(g x))
+ (put-text-property 2 3 'erc-test '(h x))
+ (put-text-property 3 4 'erc-test '(i x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test (g x))
+ 1 2 (erc-test (h x))
+ 2 3 (erc-test (i x)))))
+ (erc--remove-from-prop-value-list 1 3 'erc-test '(x g i))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 1 2 (erc-test h)
+ 2 3 (erc-test (i x)))))
+
+ ;; Narrowed middle.
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (put-text-property 1 2 'erc-test '(j x))
+ (put-text-property 2 3 'erc-test '(k))
+ (put-text-property 3 4 'erc-test '(l y z))
+ (erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl"
+ 0 1 (erc-test (j x))
+ 1 2 (erc-test (k))
+ 2 3 (erc-test l))))
+
+ (when noninteractive
+ (kill-buffer))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6-Manage-meta-data-text-props-for-ERC-hook-members.patch --]
[-- Type: text/x-patch, Size: 131285 bytes --]
From ef4974d8e232b0d5e5df31a30f2fd904f970c60f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 21 Sep 2023 23:54:31 -0700
Subject: [PATCH 6/7] [5.6] Manage meta-data text props for ERC hook members
* etc/ERC-NEWS: Mention that `cursor-sensor-functions' is only added
when `erc-echo-timestamps' is enabled, and mention that date stamps
are now inserted as separate messages.
* lisp/erc/erc-fill.el (erc-fill): Look for `erc-cmd' instead of
`erc-command' text prop.
(erc-fill-static): Skip date stamps.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable):
Don't use removed hook `erc-stamp--insert-date-function' because date
stamps are now separate messages.
(erc-fill--wrap-continued-message-p): Restore accidentally excised doc
string. Derive context about current message from text props at
`point-min', and use updated names and utility functions.
(erc-fill--wrap-stamp-insert-prefixed-date): Remove function,
originally meant to be new in ERC 5.6, and move logic for date-stamp
measuring directly to `erc-fill-wrap' itself.
(erc-fill--wrap-measure): New helper function.
(erc-fill-wrap): Use helper `erc-fill--wrap-measure' and incorporate
date-stamp detection and width measuring from removed helper.
* lisp/erc/erc-goodies.el (erc-readonly-mode, erc-readonly-enable):
Set hook depth to an explicit 70.
* lisp/erc/erc-stamp.el (erc-timestamp-format-left): Mention that a
trailing newline is implicit if not provided and that users who don't
want date stamps should use `erc-timestamp-format-right' instead.
(erc-stamp-mode, erc-stamp-enable): Call `erc-stamp--setup' instead
of `erc-munge-invisibility-spec', and bump hook depth for
`erc-add-timestamp' to 79.
(erc-stamp--skip): New internal variable.
(erc-stamp--allow-unmanaged): New variable for legacy code to force
`erc-add-timestamps' to run when `erc--msg-props' is nil.
(erc-add-timestamp): Gate on new flags `erc-stamp--skip' and
`erc-stamp--allow-unmanaged'. Don't add `erc-ts' text prop directly.
Instead, use `erc--msg-props' facility to defer until after
modification hooks. Don't add `cursor-senor-functions' directly
either unless compatibility flag is enabled. Instead, expect this to
be handled by a post-modify hook.
(erc-stamp-prefix-log-filter): Use updated name for timestamp
property.
(erc-stamp--inherited-props): Add doc string.
(erc-insert-timestamp-right): Fix bug involving object cycle where
the time-stamp string would appear in its own `display' property.
(erc-stamp--insert-date-function, erc-stamp--insert-date-hook): Remove
unused internal function-valued interface variable and replace with
the latter, a normal hook.
(erc-stamp--date-format-end, erc-stamp--propertize-left-date-stamp):
New function and auxiliary variable to apply date stamp properties at
the post-modify stage. Add text property `erc-stamp-type' to inserted
date stamps to help folks distinguish between them and other
left-sided stamps.
(erc-stamp-date-left-p): New public function for third-party code to
detect whether a message is a date stamp.
(erc-stamp--current-datestamp-left,
erc-stamp--insert-date-stamp-as-phony-message,
erc-stamp--lr-date-on-pre-modify): New functions and state variable to
help ERC treat date stamps as separate messages while working within
the established mechanism for processing inserted messages. Shadow
`erc-stamp--invisible-property' when calling `erc-format-timestamp' in
order to prevent date stamps from inheriting other `invisible' props.
These date stamps are special in that they have no business being
hidden along with the current message.
(erc-insert-timestamp-left-and-right): On initial run in any buffer,
record whether date stamp needs massaging on insertion. Move all
business for inserting date stamps to post-modify hooks, but run them
forcibly if this is the very first date stamp in the current buffer.
Also mention intervals of relevant text props in doc string.
(erc-format-timestamp): Don't add `invisible' prop to stamp unless
`erc-stamp--invisible-property' is non-nil.
(erc-stamp--csf-props-updated-p): New local variable.
(erc-munge-invisibility-spec): Restore `cursor-sensor-functions' text
property for existing messages when a user enables the option
mid-session. Add and remove hooks for use with automatic timestamp
echoing.
(erc-stamp--add-csf-on-post-modify): New function to add
`cursor-sensor-functions' property on post-modify hooks.
(erc-stamp--setup): Perform some additional teardown.
(erc-stamp--on-clear-message): Update timestamp text-property name to
`erc-ts'.
(erc-echo-timestamp, erc--echo-ts-csf): Use utility to find time-stamp
text prop in current message.
(erc-stamp--update-saved-position, erc-stamp--reset-on-clear): Use
hook `erc-stamp--insert-date-hook' instead of excised variable
`erc-stamp--insert-date-function'.
* lisp/erc/erc-truncate.el (erc-truncate-buffer-to-size): Use internal
utility to find beginning of message.
* lisp/erc/erc.el (erc--msg-props, erc--msg-props-overrides): New
internal variables for initializing and conveying message meta-data
text properties among insert and send hooks.
(erc-insert-modify-hook): Mention reserved depth ranges for built-in
members in doc string.
(erc-send-action): Use convenience variable to modifying text props
instead of overriding `erc-insert-pre-hook'.
(erc--check-msg-prop, erc--get-inserted-msg-bounds,
erc--get-inserted-msg-prop, erc--with-inserted-msg,
erc--traverse-inserted): New utility functions and macros to help
modules find meta-data and message-delimiting text props.
(erc-display-line-1): Ensure the first character of every message in
an ERC buffer has the `erc-msg' property.
(erc--hide-message): Don't bother offsetting start of first message in
a buffer.
(erc--ranked-properties, erc--order-text-properties-from-hash): New
variable and function to convert `erc--msg-props' into a plist
suitable for `add-text-properties'.
(erc-display-message): Bind `erc--msg-props' for use by all hooks.
Respect `erc--msg-prop-overrides' when non-nil. Don't add
`erc-command' property.
(erc--own-property-names): Add `erc-stamp-type'.
(erc--get-speaker-bounds): Use helper to find message start.
(erc-process-ctcp-query, erc-send-current-line): Use convenience
variable to leverage framework for manipulating message meta-data
instead of overriding `erc-insert-pre-hook'.
(erc-display-msg): Bind `erc--msg-props' for use by all send-related
hooks. Add text props from table after `erc-send-post-hook'.
(erc-restore-text-properties): Improve doc string.
(erc--get-eq-comparable-cmd): Use `if-let' instead of `if-let*'.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--insert-privmsg):
Make fake message more realistic.
(erc-fill-tests--wrap-populate): Shorten overlong line.
(erc-fill-tests--wrap-check-prefixes): Make test utility more vigilant
in asserting no gaps exist in `line-prefix' property interval.
(erc-fill-tests--compare): Compare text props on text prop values that
are themselves strings.
* test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp):
Ensure `erc-stamp' is loaded.
* test/lisp/erc/erc-scenarios-match.el
(erc-scenarios-match--stamp-left-current-nick,
erc-scenarios-match--invisible-stamp): Use `default-value' for
`erc-insert-modify-hook' in ordering assertion.
(erc-scenarios-match--find-bol, erc-scenarios-match--find-eol): Remove
unused assertion helper functions.
(erc-scenarios-match--stamp-right-fools-invisible): Remove misplaced
ERT tag from function and use utility to find message bounds.
(erc-scenarios-match--stamp-right-fools-invisible): Use utility to
find message end.
(erc-scenarios-match--fill-wrap-stamp-dedented-p): New assertion
utility function.
(erc-scenarios-match--stamp-both-invisible-fill-wrap) New test.
(erc-scenarios-match--stamp-both-invisible-fill-static): Expect
`erc-cmd' at beginning of inserted message's filled line, even if it
starts with whitespace. Also, add new function parameter `assert-ds',
a callback to run when visiting the second date stamp, which is
followed by a hidden message. In the test of the same name, expect
the date stamp's invisibility interval to begin at the newline after
the previous message and to not contain any existing invisibility
props, namely, those belonging to the subsequent hidden "fools"
message. Also use unified meta-data text prop names.
(erc-scenarios-match--stamp-both-invisible-fill-static--nooffset):
Expect the date stamp's invisibility interval to match its field's
instead of starting and ending sooner.
* test/lisp/erc/erc-stamp-tests.el: Put well-known meta-data prop at
the start of the message.
* test/lisp/erc/erc-tests.el (erc--refresh-prompt): Prevent modules
from mutating hooks.
(erc--order-text-properties-from-hash, erc--check-msg-props): New
tests.
* test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update
test data.
* test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update
test data.
* test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld:
Update.
* test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld:
Update.
* test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld:
Update.
* test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld:
Update.
* test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: Update.
(Bug#60936)
---
etc/ERC-NEWS | 28 ++-
lisp/erc/erc-fill.el | 97 ++++---
lisp/erc/erc-goodies.el | 4 +-
lisp/erc/erc-stamp.el | 237 ++++++++++++++----
lisp/erc/erc-truncate.el | 2 +-
lisp/erc/erc.el | 164 ++++++++++--
test/lisp/erc/erc-fill-tests.el | 60 +++--
test/lisp/erc/erc-scenarios-log.el | 1 +
test/lisp/erc/erc-scenarios-match.el | 205 ++++++++++++---
test/lisp/erc/erc-stamp-tests.el | 2 +-
test/lisp/erc/erc-tests.el | 43 +++-
.../fill/snapshots/merge-01-start.eld | 2 +-
.../fill/snapshots/merge-02-right.eld | 2 +-
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../fill/snapshots/spacing-01-mono.eld | 2 +-
.../fill/snapshots/stamps-left-01.eld | 2 +-
20 files changed, 654 insertions(+), 207 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 284b91bb41f..81c94467f25 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -149,7 +149,7 @@ minor-mode maps, and new third-party modules should do the same.
** Option 'erc-timestamp-format-right' deprecated.
Having to account for this option prevented other ERC modules from
-easily determining what right-hand stamps would look like before
+easily determining what right-sided stamps would look like before
insertion, which is knowledge needed for certain UI decisions. The
way ERC has chosen to address this is imperfect and boils down to
asking users who've customized this option to switch to
@@ -291,11 +291,13 @@ continue to modify non-ERC hooks locally whenever possible, especially
in new code.
*** ERC now manages timestamp-related properties a bit differently.
-For starters, the 'cursor-sensor-functions' property no longer
+For starters, the 'cursor-sensor-functions' text property is absent by
+default unless the option 'erc-echo-timestamps' is already enabled on
+module init. And when present, the property's value no longer
contains unique closures and thus no longer proves effective for
-traversing messages. To compensate, a new property, 'erc-timestamp',
-now spans message bodies but not the newlines delimiting them. Also
-affecting the 'stamp' module is the deprecation of the function
+traversing inserted messages. For now, ERC only provides an internal
+means of visiting messages, but a public interface is forthcoming.
+Also affecting the 'stamp' module is the deprecation of the function
'erc-insert-aligned' and its removal from client code. Additionally,
the module now merges its 'invisible' property with existing ones and
includes all white space around stamps when doing so.
@@ -310,6 +312,22 @@ folded onto the next line. Such inconsistency made stamp detection
overly complex and produced uneven results when toggling stamp
visibility.
+*** Date stamps are independent messages.
+ERC now inserts "date stamps" generated from the option
+'erc-timestamp-format-left' as separate, standalone messages. (This
+only matters if 'erc-insert-timestamp-function' is set to its default
+value of 'erc-insert-timestamp-left-and-right'.) ERC's near-term UI
+goals require exposing these stamps to existing code designed to
+operate on complete messages. For example, users likely expect date
+stamps to be togglable with 'erc-toggle-timestamps' while also being
+immune to hiding from commands like 'erc-match-toggle-hidden-fools'.
+Before this change, meeting such expectations demanded brittle
+heuristics that checked for the presence of these stamps in the
+leading portion of message bodies as well as special casing to act on
+these areas without inflicting collateral damage. From now on, third
+parties can instead use the function 'erc-stamp-date-left-p' to detect
+and reuse existing code to operate.
+
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
features has improved. More specifically, a module's group now enjoys
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 0e6b5a3efb8..62a9597d481 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -158,6 +158,11 @@ erc-fill
(when (or erc-fill--function erc-fill-function)
;; skip initial empty lines
(goto-char (point-min))
+ ;; Note the following search pattern was altered in 5.6 to adapt
+ ;; to a change in Emacs regexp behavior that turned out to be a
+ ;; regression (which has since been fixed). The patterns appear
+ ;; to be equivalent in practice, so this was left as is (wasn't
+ ;; reverted) to avoid additional git-blame(1)-related churn.
(while (and (looking-at (rx bol (* (in " \t")) eol))
(zerop (forward-line 1))))
(unless (eobp)
@@ -167,12 +172,10 @@ erc-fill
(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))
+ (when (or (erc--check-msg-prop 'erc-cmd erc-fill--spaced-commands)
(and-let* ((cmd (save-excursion
(forward-line -1)
- (get-text-property (point)
- 'erc-command))))
+ (get-text-property (point) 'erc-cmd))))
(memq cmd erc-fill--spaced-commands)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
@@ -181,15 +184,17 @@ erc-fill-static
"Fills a text such that messages start at column `erc-fill-static-center'."
(save-restriction
(goto-char (point-min))
- (looking-at "^\\(\\S-+\\)")
- (let ((nick (match-string 1)))
+ (when-let (((looking-at "^\\(\\S-+\\)"))
+ ((not (erc--check-msg-prop 'erc-msg 'datestamp)))
+ (nick (match-string 1)))
+ (progn
(let ((fill-column (- erc-fill-column (erc-timestamp-offset)))
(fill-prefix (make-string erc-fill-static-center 32)))
(insert (make-string (max 0 (- erc-fill-static-center
(length nick) 1))
32))
(erc-fill-regarding-timestamp))
- (erc-restore-text-properties))))
+ (erc-restore-text-properties)))))
(defun erc-fill-variable ()
"Fill from `point-min' to `point-max'."
@@ -423,8 +428,6 @@ fill-wrap
(eq (default-value 'erc-insert-timestamp-function)
#'erc-insert-timestamp-left)))
(setq erc-fill--function #'erc-fill-wrap)
- (add-function :after (local 'erc-stamp--insert-date-function)
- #'erc-fill--wrap-stamp-insert-prefixed-date)
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
@@ -436,9 +439,7 @@ fill-wrap
(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)
- (remove-function (local 'erc-stamp--insert-date-function)
- #'erc-fill--wrap-stamp-insert-prefixed-date))
+ #'erc-fill--wrap-merged-button-p t))
'local)
(defvar-local erc-fill--wrap-length-function nil
@@ -456,6 +457,9 @@ erc-fill--wrap-last-msg
(defvar-local erc-fill--wrap-max-lull (* 24 60 60))
(defun erc-fill--wrap-continued-message-p ()
+ "Return non-nil when the current speaker hasn't changed.
+That is, indicate whether the text just inserted is from the same
+sender as that of the previous \"PRIVMSG\"."
(prog1 (and-let*
((m (or erc-fill--wrap-last-msg
(setq erc-fill--wrap-last-msg (point-min-marker))
@@ -463,14 +467,11 @@ erc-fill--wrap-continued-message-p
((< (1+ (point-min)) (- (point) 2)))
(props (save-restriction
(widen)
- (when (eq 'erc-timestamp (field-at-pos m))
- (set-marker m (field-end m)))
(and-let*
- (((eq 'PRIVMSG (get-text-property m 'erc-command)))
- ((not (eq (get-text-property m 'erc-ctcp)
- 'ACTION)))
+ (((eq 'PRIVMSG (get-text-property m 'erc-cmd)))
+ ((not (eq (get-text-property m 'erc-msg) 'ACTION)))
(spr (next-single-property-change m 'erc-speaker)))
- (cons (get-text-property m 'erc-timestamp)
+ (cons (get-text-property m 'erc-ts)
(get-text-property spr 'erc-speaker)))))
(ts (pop props))
(props)
@@ -478,30 +479,23 @@ erc-fill--wrap-continued-message-p
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
(speaker (next-single-property-change (point-min) 'erc-speaker))
- ((not (eq (get-text-property speaker 'erc-ctcp) 'ACTION)))
+ ((not (erc--check-msg-prop 'erc-ctcp 'ACTION)))
(nick (get-text-property speaker 'erc-speaker))
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
-(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
- "Apply `line-prefix' property to args."
- (let* ((ts-left (car args))
- (start)
- ;; Insert " " to simulate gap between <speaker> and msg beg.
- (end (save-excursion (skip-chars-backward "\n")
- (setq start (pos-bol))
- (insert " ")
- (point)))
- (width (if (and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction (narrow-to-region start end)
- (list (car (buffer-text-pixel-size))))
- (length (string-trim-left ts-left)))))
- (delete-region (1- end) end)
- ;; Use `point-min' instead of `start' to cover leading newilnes.
- (put-text-property (point-min) (point) 'line-prefix
- `(space :width (- erc-fill--wrap-value ,width))))
- args)
+(defun erc-fill--wrap-measure (beg end)
+ "Return display spec width for inserted region between BEG and END.
+Ignore any `invisible' props that may be present when figuring."
+ (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
+ ;; `buffer-text-pixel-size' can move point!
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (let* ((buffer-invisibility-spec)
+ (rv (car (buffer-text-pixel-size))))
+ (if (zerop rv) 0 (list rv)))))
+ (- end beg)))
;; An escape hatch for third-party code expecting speakers of ACTION
;; messages to be exempt from `line-prefix'. This could be converted
@@ -522,25 +516,28 @@ erc-fill-wrap
(when-let ((e (erc--get-speaker-bounds))
(b (pop e))
((or erc-fill--wrap-action-dedent-p
- (not (eq (get-text-property b 'erc-ctcp)
- 'ACTION)))))
+ (not (erc--check-msg-prop 'erc-ctcp
+ 'ACTION)))))
(goto-char e))
(skip-syntax-forward "^-")
(forward-char)
- ;; Using the `invisible' property might make more
- ;; sense, but that would require coordination
- ;; with other modules, like `erc-match'.
- (cond ((and erc-fill-wrap-merge
+ (cond ((erc--check-msg-prop 'erc-msg 'datestamp)
+ (when erc-fill--wrap-last-msg
+ (set-marker erc-fill--wrap-last-msg (point-min)))
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward "\n")
+ (let ((beg (pos-bol)))
+ (insert " ")
+ (prog1 (erc-fill--wrap-measure beg (point))
+ (delete-region (1- (point)) (point))))))
+ ((and erc-fill-wrap-merge
(erc-fill--wrap-continued-message-p))
(put-text-property (point-min) (point)
'display "")
0)
- ((and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (list (car (buffer-text-pixel-size)))))
- (t (- (point) (point-min))))))))
+ (t
+ (erc-fill--wrap-measure (point-min) (point))))))))
(erc-put-text-properties (point-min) (1- (point-max)) ; exclude "\n"
'(line-prefix wrap-prefix) nil
`((space :width (- erc-fill--wrap-value ,len))
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index b77176d8ac7..d112e63c316 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -339,8 +339,8 @@ erc-scroll-to-bottom
;;;###autoload(autoload 'erc-readonly-mode "erc-goodies" nil t)
(define-erc-module readonly nil
"This mode causes all inserted text to be read-only."
- ((add-hook 'erc-insert-post-hook #'erc-make-read-only)
- (add-hook 'erc-send-post-hook #'erc-make-read-only))
+ ((add-hook 'erc-insert-post-hook #'erc-make-read-only 70)
+ (add-hook 'erc-send-post-hook #'erc-make-read-only 70))
((remove-hook 'erc-insert-post-hook #'erc-make-read-only)
(remove-hook 'erc-send-post-hook #'erc-make-read-only)))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0f3163bf68d..7fc76eb2d73 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,21 +55,22 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
-;; FIXME remove surrounding whitespace from default value and have
-;; `erc-insert-timestamp-left-and-right' add it before insertion.
-
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
- "If set to a string, messages will be timestamped.
-This string is processed using `format-time-string'.
-Good examples are \"%T\" and \"%H:%M\".
-
-This timestamp is used for timestamps on the left side of the
-screen when `erc-insert-timestamp-function' is set to
-`erc-insert-timestamp-left-and-right'.
-
-If nil, timestamping is turned off."
- :type '(choice (const nil)
- (string)))
+ "Format recognized by `format-time-string' for date stamps.
+Only considered when `erc-insert-timestamp-function' is set to
+`erc-insert-timestamp-left-and-right'. Used for displaying date
+stamps on their own line, between messages. ERC inserts this
+flavor of stamp as a separate \"psuedo message\", so a final
+newline isn't necessary. For compatibility, only additional
+trailing newlines beyond the first become empty lines. For
+example, the default value results in an empty line after the
+previous message, followed by the timestamp on its own line,
+followed immediately by the next message on the next line. ERC
+expects to display these stamps less frequently, so the
+formatting specifiers should reflect that. To omit these stamps
+entirely, use a different `erc-insert-timestamp-function', such
+as `erc-timestamp-format-right'."
+ :type 'string)
(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
@@ -175,9 +176,9 @@ erc-timestamp-face
;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t)
(define-erc-module stamp timestamp
"This mode timestamps messages in the channel buffers."
- ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
- (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 60)
- (add-hook 'erc-send-modify-hook #'erc-add-timestamp 60)
+ ((add-hook 'erc-mode-hook #'erc-stamp--setup)
+ (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 79)
+ (add-hook 'erc-send-modify-hook #'erc-add-timestamp 79)
(add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
(add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
(unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup)))
@@ -214,18 +215,27 @@ erc-stamp--current-time
(cl-defgeneric erc-stamp--current-time ()
"Return a lisp time object to associate with an IRC message.
-This becomes the message's `erc-timestamp' text property."
+This becomes the message's `erc-ts' text property."
(erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
(or erc-stamp--current-time (cl-call-next-method)))
+(defvar erc-stamp--skip nil
+ "Non-nil means inhibit `erc-add-timestamp' completely.")
+
+(defvar erc-stamp--allow-unmanaged nil
+ "Non-nil means `erc-add-timestamp' runs unconditionally.
+Escape hatch for third-parties using lower-level API functions,
+such as `erc-display-line', directly.")
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (progn ; remove this `progn' on next major refactor
+ (unless (or erc-stamp--skip (and erc-stamp--allow-unmanaged
+ (not erc--msg-props)))
(let* ((ct (erc-stamp--current-time))
(invisible (get-text-property (point-min) 'invisible))
(erc-stamp--invisible-property
@@ -233,6 +243,8 @@ erc-add-timestamp
(if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(skipp (and erc-stamp--skip-when-invisible invisible))
(erc-stamp--current-time ct))
+ (when erc--msg-props
+ (puthash 'erc-ts ct erc--msg-props))
(unless skipp
(funcall erc-insert-timestamp-function
(erc-format-timestamp ct erc-timestamp-format)))
@@ -244,12 +256,13 @@ erc-add-timestamp
(erc-away-time))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (1- (point-max))
+ (when erc-stamp--allow-unmanaged
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
;; Regions are no longer contiguous ^
- '(erc--echo-ts-csf) 'erc-timestamp ct)))))
+ '(erc--echo-ts-csf) 'erc-ts ct))))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -362,19 +375,27 @@ erc-stamp-prefix-log-filter
(goto-char (point-min))
(while
(progn
- (when-let* (((< (point) (pos-eol)))
- (end (1- (pos-eol)))
- ((eq 'erc-timestamp (field-at-pos end)))
- (beg (field-beginning end))
- ;; Skip a line that's just a timestamp.
- ((> beg (point))))
+ (when-let (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
(delete-region beg (1+ end)))
- (when-let (time (get-text-property (point) 'erc-timestamp))
+ (when-let (time (erc--get-inserted-msg-prop 'erc-ts))
(insert (format-time-string "[%H:%M:%S] " time)))
(zerop (forward-line))))
"")
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+;; These are currently extended manually, but we could also bind
+;; `text-property-default-nonsticky' and call `insert-and-inherit'
+;; instead of `insert', but we'd have to pair the props with differing
+;; boolean values for left and right stamps. Also, since this hook
+;; runs last, we can't expect overriding sticky props to be absent,
+;; even though, as of 5.6, `front-sticky' is only added by the
+;; `readonly' module after hooks run.
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
+ "Extant properties at the start of a message inherited by the stamp.")
(declare-function erc--remove-text-properties "erc" (string))
@@ -573,8 +594,11 @@ erc-insert-timestamp-right
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
((guard erc-stamp--display-margin-mode)
- (put-text-property 0 (length string)
- 'display `((margin right-margin) ,string) string))
+ (let ((s (propertize (substring-no-properties string)
+ 'invisible erc-stamp--invisible-property)))
+ (put-text-property 0 (length string) 'display
+ `((margin right-margin) ,s)
+ string)))
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
@@ -599,30 +623,109 @@ erc-insert-timestamp-right
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defvar erc-stamp--insert-date-function #'insert
- "Function to insert left \"left-right date\" stamp.
-A local module might use this to modify text properties,
-`insert-before-markers' or renarrow the region after insertion.")
+(defvar erc-stamp--insert-date-hook nil
+ "Functions appended to send and modify hooks when inserting date stamp.")
+
+(defvar-local erc-stamp--date-format-end nil
+ "Substring index marking usable portion of date stamp format.")
+
+(defun erc-stamp--propertize-left-date-stamp ()
+ (add-text-properties (point-min) (1- (point-max))
+ '(field erc-timestamp erc-stamp-type date-left))
+ (erc--hide-message 'timestamp))
+
+(defun erc-stamp-date-left-p (&optional point)
+ "Return non-nil if the current message is a \"date stamp\".
+Expect callers to know that such stamps originate from
+`erc-insert-timestamp-left-and-right' using the format string
+`erc-timestamp-format-left'. Expect POINT, when non-nil, to
+reside at some known or suspected time stamp. When POINT is nil,
+expect to be called from a member of `erc-insert-modify-hook' or
+similar."
+ (cond ((erc--check-msg-prop 'erc-msg 'datestamp))
+ (point (eq 'date-left (get-text-property point 'erc-stamp-type)))
+ (t (erc--with-inserted-msg
+ (and-let* ((p (text-property-not-all
+ (point-min) (point-max) 'field 'erc-timestamp)))
+ (eq 'date-left (get-text-property p 'erc-stamp-type)))))))
+
+;; A kludge to pass state from insert hook to nested insert hook.
+(defvar erc-stamp--current-datestamp-left nil)
+
+;; Calling `erc-display-message' from within a hook it's currently
+;; running is roundabout, but it's a definite means of ensuring hooks
+;; can act on the date stamp as a standalone message to do things like
+;; adjust invisibility props.
+(defun erc-stamp--insert-date-stamp-as-phony-message (string)
+ (cl-assert (string-empty-p string))
+ (setq string erc-stamp--current-datestamp-left)
+ (cl-assert string)
+ (let ((erc-stamp--skip t)
+ (erc--msg-props (map-into `((erc-msg . datestamp)
+ (erc-ts . ,erc-stamp--current-time))
+ 'hash-table))
+ (erc-send-modify-hook `(,@erc-send-modify-hook
+ erc-stamp--propertize-left-date-stamp
+ ,@erc-stamp--insert-date-hook))
+ (erc-insert-modify-hook `(,@erc-insert-modify-hook
+ erc-stamp--propertize-left-date-stamp
+ ,@erc-stamp--insert-date-hook)))
+ (erc-display-message nil nil (current-buffer) string)
+ (setq erc-timestamp-last-inserted-left string)))
+
+(defun erc-stamp--lr-date-on-pre-modify (_)
+ (unless erc-stamp--date-format-end
+ ;; Don't add text properties to the trailing newline.
+ (setq erc-stamp--date-format-end
+ (if (string-suffix-p "\n" erc-timestamp-format-left) -1 0)))
+ (when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ ;; Ignore existing prop value because date stamps should
+ ;; never be hideable except via `timestamp'.
+ (rendered (let (erc-stamp--invisible-property)
+ (erc-format-timestamp
+ ct (substring erc-timestamp-format-left
+ 0 erc-stamp--date-format-end))))
+ ((not (string-equal rendered erc-timestamp-last-inserted-left)))
+ (erc-stamp--current-datestamp-left rendered)
+ (erc-insert-timestamp-function
+ #'erc-stamp--insert-date-stamp-as-phony-message))
+ (save-restriction
+ (narrow-to-region (or erc--insert-marker erc-insert-marker)
+ (or erc--insert-marker erc-insert-marker))
+ (let (erc-timestamp-format erc-away-timestamp-format)
+ (erc-add-timestamp)))))
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
When the deprecated option `erc-timestamp-format-right' is nil,
use STRING, which originates from `erc-timestamp-format', for the
right-hand stamp. Use `erc-timestamp-format-left' for the
-left-hand stamp and expect it to change less frequently."
+left-hand stamp and expect it to change less frequently. Include
+line endings found in `erc-timestamp-format-left' (or affixed by
+ERC) as part of the `erc-timestamp' field, which extends to the
+start of the message proper. Do this so other code knows the
+stamp is part of the subsequent IRC message even though it may
+appear on its own line. However, allow the stamp's `invisible'
+property to span a different interval, in order to satisfy newer
+folding requirements related to `erc-legacy-invisible-bounds-p'.
+Additionally, ensure every date stamp formatted with the option
+`erc-timestamp-format-left' is marked as such so that modules can
+easily distinguish between other left-sided stamps and date
+stamps inserted by this function."
+ (unless erc-stamp--date-format-end
+ (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t)
+ (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t)
+ (let ((erc--insert-marker (point-min-marker)))
+ (set-marker-insertion-type erc--insert-marker t)
+ (erc-stamp--lr-date-on-pre-modify nil)
+ (narrow-to-region erc--insert-marker (point-max))
+ (set-marker erc--insert-marker nil)))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
(erc-format-timestamp ct erc-timestamp-format-right)
string))))
- ;; insert left timestamp
- (unless (string-equal ts-left erc-timestamp-last-inserted-left)
- (goto-char (point-min))
- (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
- (funcall erc-stamp--insert-date-function ts-left)
- (setq erc-timestamp-last-inserted-left ts-left))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
(erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
@@ -639,8 +742,9 @@ erc-format-timestamp
(let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
- (erc-put-text-property 0 (length ts) 'invisible
- erc-stamp--invisible-property ts)
+ (when erc-stamp--invisible-property
+ (erc-put-text-property 0 (length ts) 'invisible
+ erc-stamp--invisible-property ts))
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
@@ -649,6 +753,8 @@ erc-format-timestamp
ts)
""))
+(defvar-local erc-stamp--csf-props-updated-p nil)
+
;; This function is used to munge `buffer-invisibility-spec' to an
;; appropriate value. Currently, it only handles timestamps, thus its
;; location. If you add other features which affect invisibility,
@@ -661,10 +767,23 @@ erc-munge-invisibility-spec
(cursor-intangible-mode -1)))
(if erc-echo-timestamps
(progn
+ (dolist (hook '(erc-insert-post-hook erc-send-post-hook))
+ (add-hook hook #'erc-stamp--add-csf-on-post-modify nil t))
+ (erc--restore-initialize-priors erc-stamp-mode
+ erc-stamp--csf-props-updated-p nil)
+ (unless (or erc-stamp--allow-unmanaged erc-stamp--csf-props-updated-p)
+ (setq erc-stamp--csf-props-updated-p t)
+ (let ((erc--msg-props (map-into '((erc-ts . t)) 'hash-table)))
+ (with-silent-modifications
+ (erc--traverse-inserted (point-min) erc-insert-marker
+ #'erc-stamp--add-csf-on-post-modify))))
(cursor-sensor-mode +1) ; idempotent
(when (>= emacs-major-version 29)
(add-function :before-until (local 'clear-message-function)
#'erc-stamp--on-clear-message)))
+ (dolist (hook '(erc-insert-post-hook erc-send-post-hook))
+ (remove-hook hook #'erc-stamp--add-csf-on-post-modify t))
+ (kill-local-variable 'erc-stamp--csf-props-updated-p)
(when (bound-and-true-p cursor-sensor-mode)
(cursor-sensor-mode -1))
(remove-function (local 'clear-message-function)
@@ -673,12 +792,22 @@ erc-munge-invisibility-spec
(add-to-invisibility-spec 'timestamp)
(remove-from-invisibility-spec 'timestamp)))
+(defun erc-stamp--add-csf-on-post-modify ()
+ "Add `cursor-sensor-functions' to narrowed buffer."
+ (when (erc--check-msg-prop 'erc-ts)
+ (put-text-property (point-min) (1- (point-max))
+ 'cursor-sensor-functions '(erc--echo-ts-csf))))
+
(defun erc-stamp--setup ()
"Enable or disable buffer-local `erc-stamp-mode' modifications."
(if erc-stamp-mode
(erc-munge-invisibility-spec)
(let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible)
- (erc-munge-invisibility-spec))))
+ (erc-munge-invisibility-spec))
+ ;; Undo local mods from `erc-insert-timestamp-left-and-right'.
+ (remove-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify t)
+ (remove-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify t)
+ (kill-local-variable 'erc-stamp--date-format-end)))
(defun erc-hide-timestamps ()
"Hide timestamp information from display."
@@ -714,7 +843,7 @@ erc-stamp--last-stamp
(defun erc-stamp--on-clear-message (&rest _)
"Return `dont-clear-message' when operating inside the same stamp."
(and erc-stamp--last-stamp erc-echo-timestamps
- (eq (get-text-property (point) 'erc-timestamp) erc-stamp--last-stamp)
+ (eq (erc--get-inserted-msg-prop 'erc-ts) erc-stamp--last-stamp)
'dont-clear-message))
(defun erc-echo-timestamp (dir stamp &optional zone)
@@ -724,7 +853,7 @@ erc-echo-timestamp
interpret a \"raw\" prefix as UTC. To specify a zone for use
with the option `erc-echo-timestamps', see the companion option
`erc-echo-timestamp-zone'."
- (interactive (list nil (get-text-property (point) 'erc-timestamp)
+ (interactive (list nil (erc--get-inserted-msg-prop 'erc-ts)
(pcase current-prefix-arg
((and (pred numberp) v)
(if (<= (abs v) 14) (* v 3600) v))
@@ -738,18 +867,18 @@ erc-echo-timestamp
(setq erc-stamp--last-stamp nil))))
(defun erc--echo-ts-csf (_window _before dir)
- (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+ (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc-ts)))
(defun erc-stamp--update-saved-position (&rest _)
- (remove-function (local 'erc-stamp--insert-date-function)
- #'erc-stamp--update-saved-position)
- (move-marker erc-last-saved-position (1- (point))))
+ (remove-hook 'erc-stamp--insert-date-hook
+ #'erc-stamp--update-saved-position t)
+ (move-marker erc-last-saved-position (1- (point-max))))
(defun erc-stamp--reset-on-clear (pos)
"Forget last-inserted stamps when POS is at insert marker."
(when (= pos (1- erc-insert-marker))
- (add-function :after (local 'erc-stamp--insert-date-function)
- #'erc-stamp--update-saved-position)
+ (add-hook 'erc-stamp--insert-date-hook
+ #'erc-stamp--update-saved-position 0 t)
(setq erc-timestamp-last-inserted nil
erc-timestamp-last-inserted-left nil
erc-timestamp-last-inserted-right nil)))
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 48d8408a85a..3350cbd13b7 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -102,7 +102,7 @@ erc-truncate-buffer-to-size
;; Truncate at message boundary (formerly line boundary
;; before 5.6).
(goto-char end)
- (goto-char (or (previous-single-property-change (point) 'erc-command)
+ (goto-char (or (erc--get-inserted-msg-bounds 'beg)
(pos-bol)))
(setq end (point))
;; try to save the current buffer using
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f3c480f918b..891689d8faa 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -135,9 +135,11 @@ erc-scripts
"Running scripts at startup and with /LOAD."
:group 'erc)
-;; Forward declarations
-(defvar erc-message-parsed)
+(defvar erc-message-parsed) ; only known to this file
+(defvar erc--msg-props nil)
+(defvar erc--msg-prop-overrides nil)
+;; Forward declarations
(defvar tabbar--local-hlf)
(defvar motif-version-string)
(defvar gtk-version-string)
@@ -1139,9 +1141,13 @@ erc-insert-modify-hook
"Insertion hook for functions that will change the text's appearance.
This hook is called just after `erc-insert-pre-hook' when the value
of `erc-insert-this' is t.
-While this hook is run, narrowing is in effect and `current-buffer' is
-the buffer where the text got inserted. One possible value to add here
-is `erc-fill'."
+
+ERC runs this hook with the buffer narrowed to the bounds of the
+inserted message plus a trailing newline. Built-in modules place
+their hook members at depths between 20 and 80, with those from
+the stamp module always running last. Use the functions
+`erc-find-parsed-property' and `erc-get-parsed-vector' to locate
+and extract the `erc-response' object for the inserted message."
:group 'erc-hooks
:type 'hook)
@@ -2854,11 +2860,10 @@ erc-toggle-debug-irc-protocol
(defun erc-send-action (tgt str &optional force)
"Send CTCP ACTION information described by STR to TGT."
(erc-send-ctcp-message tgt (format "ACTION %s" str) force)
- (let ((erc-insert-pre-hook
- (cons (lambda (s) ; Leave newline be.
- (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)
- (put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s))
- erc-insert-pre-hook))
+ ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us.
+ (let ((erc--msg-prop-overrides '((erc-msg . msg)
+ (erc-cmd . PRIVMSG)
+ (erc-ctcp . ACTION)))
(nick (erc-current-nick)))
(setq nick (propertize nick 'erc-speaker nick))
(erc-display-message nil '(t action input) (current-buffer)
@@ -2917,6 +2922,66 @@ erc--refresh-prompt
(delete-region (point) (1- erc-input-marker))))
(run-hooks 'erc--refresh-prompt-hook)))
+(define-inline erc--check-msg-prop (prop &optional val)
+ "Return value for PROP in `erc--msg-props' when populated.
+If VAL is a list, return non-nil if PROP appears in VAL. If VAL
+is otherwise non-nil, return non-nil if VAL compares `eq' to the
+stored value. Otherwise, return the stored value."
+ (inline-letevals (prop val)
+ (let ((v (make-symbol "v")))
+ `(and-let* ((erc--msg-props)
+ (,v (gethash ,prop erc--msg-props)))
+ (if (consp ,val) (memq ,v ,val) (if ,val (eq ,v ,val) ,v))))))
+
+(defmacro erc--get-inserted-msg-bounds (&optional only point)
+ `(let* ((point ,(or point '(point)))
+ (at-start-p (get-text-property point 'erc-msg)))
+ (and-let*
+ (,@(and (member only '(nil 'beg))
+ '((b (or (and at-start-p point)
+ (and-let*
+ ((p (previous-single-property-change point
+ 'erc-msg)))
+ (if (= p (1- point)) point (1- p)))))))
+ ,@(and (member only '(nil 'end))
+ '((e (1- (next-single-property-change
+ (if at-start-p (1+ point) point)
+ 'erc-msg nil erc-insert-marker))))))
+ ,(pcase only
+ ('(quote beg) 'b)
+ ('(quote end) 'e)
+ (_ '(cons b e))))))
+
+(defun erc--get-inserted-msg-prop (prop)
+ "Return the value of text property PROP for some message at point."
+ (and-let* ((stack-pos (erc--get-inserted-msg-bounds 'beg)))
+ (get-text-property stack-pos prop)))
+
+(defmacro erc--with-inserted-msg (&rest body)
+ "Simulate buffer narrowing of send insert hooks for BODY.
+Note that this does not wrap BODY in `with-silent-modifications'.
+Similarly, it does not bind a temporary `erc--msg-props' table."
+ `(when-let ((bounds (erc--get-inserted-msg-bounds)))
+ (save-restriction
+ (narrow-to-region (car bounds) (1+ (cdr bounds)))
+ ,@body)))
+
+(defun erc--traverse-inserted (beg end fn)
+ "Visit messages between BEG and END and run FN in narrowed buffer."
+ (setq end (min end (marker-position erc-insert-marker)))
+ (save-excursion
+ (goto-char beg)
+ (let ((b (if (get-text-property (point) 'erc-msg)
+ (point)
+ (next-single-property-change (point) 'erc-msg nil end))))
+ (while-let ((b)
+ ((< b end))
+ (e (next-single-property-change (1+ b) 'erc-msg nil end)))
+ (save-restriction
+ (narrow-to-region b e)
+ (funcall fn))
+ (setq b e)))))
+
(defvar erc--insert-marker nil)
(defun erc-display-line-1 (string buffer)
@@ -2963,7 +3028,13 @@ erc-display-line-1
(run-hooks 'erc-insert-post-hook)
(when erc-remove-parsed-property
(remove-text-properties (point-min) (point-max)
- '(erc-parsed nil tags nil))))
+ '(erc-parsed nil tags nil)))
+ (cl-assert (> (- (point-max) (point-min)) 1))
+ (let ((props (if erc--msg-props
+ (erc--order-text-properties-from-hash
+ erc--msg-props)
+ '(erc-msg unknown))))
+ (add-text-properties (point-min) (1+ (point-min)) props)))
(erc--refresh-prompt)))))
(run-hooks 'erc-insert-done-hook)
(erc-update-undo-list (- (or (marker-position (or erc--insert-marker
@@ -3094,7 +3165,11 @@ erc-legacy-invisible-bounds-p
(defun erc--hide-message (value)
"Apply `invisible' text-property with VALUE to current message.
-Expect to run in a narrowed buffer during message insertion."
+Expect to run in a narrowed buffer during message insertion.
+Begin the invisible interval at the previous message's trailing
+newline and end before the current message's. If the preceding
+message ends in a double newline or there is no previous message,
+don't bother including the preceding newline."
(if erc-legacy-invisible-bounds-p
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
@@ -3103,8 +3178,25 @@ erc--hide-message
(end (point-max)))
(save-restriction
(widen)
+ (when (or (<= beg 4) (= ?\n (char-before (- beg 2))))
+ (cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+(defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd))
+
+(defun erc--order-text-properties-from-hash (table)
+ "Return a plist of text props from items in table.
+Ensure props in `erc--ranked-properties' appear last and in
+reverse order so that they end up sorted in buffer interval
+plists for retrieval by `text-properties-at' and friends."
+ (let (out)
+ (dolist (k erc--ranked-properties)
+ (when-let ((v (gethash k table)))
+ (remhash k table)
+ (setq out (nconc (list k v) out))))
+ (maphash (lambda (k v) (setq out (nconc (list k v) out))) table)
+ out))
+
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
@@ -3335,6 +3427,21 @@ erc-display-message
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
msg))
+ (erc--msg-props
+ (or erc--msg-props
+ (let* ((table (make-hash-table :size 5))
+ (cmd (and parsed (erc--get-eq-comparable-cmd
+ (erc-response.command parsed))))
+ (m (cond ((and msg (symbolp msg)) msg)
+ ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
+ (t 'unknown))))
+ (puthash 'erc-msg m table)
+ (when cmd
+ (puthash 'erc-cmd cmd table))
+ (and erc--msg-prop-overrides
+ (pcase-dolist (`(,k . ,v) erc--msg-prop-overrides)
+ (puthash k v table)))
+ table)))
(erc-message-parsed parsed))
(setq string
(cond
@@ -3353,9 +3460,6 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (put-text-property
- 0 (length string) 'erc-command
- (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4818,6 +4922,7 @@ erc--own-property-names
rear-nonsticky erc-prompt field front-sticky read-only
;; stamp
cursor-intangible cursor-sensor-functions isearch-open-invisible
+ erc-stamp-type
;; match
invisible intangible
;; button
@@ -5305,7 +5410,7 @@ erc--get-speaker-bounds
Assume buffer is narrowed to the confines of an inserted message."
(inline-quote
(and-let*
- (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE)))
+ (((erc--check-msg-prop 'erc-msg 'msg))
(beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min))
(next-single-property-change (point-min) 'erc-speaker))))
(cons beg (next-single-property-change beg 'erc-speaker)))))
@@ -5630,11 +5735,8 @@ erc-process-ctcp-query
(while queries
(let* ((type (upcase (car (split-string (car queries)))))
(hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))
- (erc-insert-pre-hook
- (cons (lambda (s)
- (put-text-property 0 (1- (length s)) 'erc-ctcp
- (intern type) s))
- erc-insert-pre-hook)))
+ (erc--msg-prop-overrides `((erc-msg . msg)
+ (erc-ctcp . ,(intern type)))))
(if (and hook (boundp hook))
(if (string-equal type "ACTION")
(run-hook-with-args-until-success
@@ -6639,7 +6741,8 @@ erc-send-current-line
(when-let (((not (erc--input-split-abortp state)))
(inhibit-read-only t)
(old-buf (current-buffer)))
- (progn ; unprogn this during next major surgery
+ (let ((erc--msg-prop-overrides '((erc-cmd . PRIVMSG)
+ (erc-msg . msg))))
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
(delete-region erc-input-marker (erc-end-of-input-line))
@@ -6786,17 +6889,24 @@ erc-display-msg
(save-excursion
(erc--assert-input-bounds)
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
+ (erc--msg-props (or erc--msg-props
+ (map-into (cons '(erc-msg . self)
+ erc--msg-prop-overrides)
+ 'hash-table)))
beg)
(insert (erc-format-my-nick))
(setq beg (point))
(insert line)
(erc-put-text-property beg (point) 'font-lock-face 'erc-input-face)
- (erc-put-text-property insert-position (point) 'erc-command 'PRIVMSG)
(insert "\n")
(save-restriction
(narrow-to-region insert-position (point))
(run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook))
+ (run-hooks 'erc-send-post-hook)
+ (cl-assert (> (- (point-max) (point-min)) 1))
+ (add-text-properties (point-min) (1+ (point-min))
+ (erc--order-text-properties-from-hash
+ erc--msg-props)))
(erc--refresh-prompt)))))
(defun erc-command-symbol (command)
@@ -8184,8 +8294,8 @@ erc-find-parsed-property
(text-property-not-all (point-min) (point-max) 'erc-parsed nil))
(defun erc-restore-text-properties ()
- "Restore the property `erc-parsed' for the region."
- (when-let* ((parsed-posn (erc-find-parsed-property))
+ "Ensure the `erc-parsed' and `tags' props cover the entire message."
+ (when-let ((parsed-posn (erc-find-parsed-property))
(found (erc-get-parsed-vector parsed-posn)))
(put-text-property (point-min) (point-max) 'erc-parsed found)
(when-let ((tags (get-text-property parsed-posn 'tags)))
@@ -8214,7 +8324,7 @@ erc--get-eq-comparable-cmd
See also `erc-message-type'."
;; IRC numerics are three-digit numbers, possibly with leading 0s.
;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
- (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+ (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n))
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index b81d0c15558..8f0c8f9ccf4 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -31,10 +31,14 @@ erc-fill-tests--time-vals
(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
(declare (indent 1))
- (let ((msg (erc-format-privmessage speaker
- (apply #'concat msg-parts) nil t)))
- (put-text-property 0 (length msg) 'erc-command 'PRIVMSG msg)
- (erc-display-message nil nil (current-buffer) msg)))
+ (let* ((msg (erc-format-privmessage speaker
+ (apply #'concat msg-parts) nil t))
+ ;; (erc--msg-prop-overrides '((erc-msg . msg) (erc-cmd . PRIVMSG)))
+ (parsed (make-erc-response :unparsed msg :sender speaker
+ :command "PRIVMSG"
+ :command-args (list "#chan" msg)
+ :contents msg)))
+ (erc-display-message parsed nil (current-buffer) msg)))
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
@@ -75,8 +79,8 @@ erc-fill-tests--wrap-populate
(erc-fill-tests--insert-privmsg "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.")
+ "What was done to Elbow's wife, that he hath cause to complain of?"
+ " Come me to what was done to her.")
;; Introduce an artificial gap in properties `line-prefix' and
;; `wrap-prefix' and later ensure they're not incremented twice.
@@ -111,6 +115,14 @@ erc-fill-tests--wrap-check-prefixes
(should (get-text-property (pos-bol) 'line-prefix))
(should (get-text-property (1- (pos-eol)) 'line-prefix))
(should-not (get-text-property (pos-eol) 'line-prefix))
+ ;; Spans entire line uninterrupted.
+ (let* ((val (get-text-property (pos-bol) 'line-prefix))
+ (end (text-property-not-all (pos-bol) (point-max)
+ 'line-prefix val)))
+ (when (and (/= end (pos-eol)) (= ?? (char-before end)))
+ (setq end (text-property-not-all (1+ end) (point-max)
+ 'line-prefix val)))
+ (should (eq end (pos-eol))))
(should (equal (get-text-property (pos-bol) 'wrap-prefix)
'(space :width erc-fill--wrap-value)))
(should-not (get-text-property (pos-eol) 'wrap-prefix))
@@ -145,7 +157,7 @@ erc-fill-tests--compare
(number-to-string erc-fill--wrap-value)
(prin1-to-string got))))
(with-current-buffer (generate-new-buffer name)
- (push name erc-fill-tests--buffers)
+ (push (current-buffer) erc-fill-tests--buffers)
(with-silent-modifications
(insert (setq got (read repr))))
(erc-mode))
@@ -153,15 +165,31 @@ erc-fill-tests--compare
(with-temp-file expect-file
(insert repr))
(if (file-exists-p expect-file)
- ;; Compare set-equal over intervals. This comparison is
- ;; less useful for messages treated by other modules because
- ;; it doesn't compare "nested" props belonging to
- ;; string-valued properties, like timestamps.
- (should (equal-including-properties
- (read repr)
- (read (with-temp-buffer
- (insert-file-contents-literally expect-file)
- (buffer-string)))))
+ ;; Ensure string-valued properties, like timestamps, aren't
+ ;; recursive (signals `max-lisp-eval-depth' exceeded).
+ (named-let assert-equal
+ ((latest (read repr))
+ (expect (read (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (buffer-string)))))
+ (pcase latest
+ ((or "" 'nil) t)
+ ((pred stringp)
+ (should (equal-including-properties latest expect))
+ (let ((latest-intervals (object-intervals latest))
+ (expect-intervals (object-intervals expect)))
+ (while-let ((l-iv (pop latest-intervals))
+ (x-iv (pop expect-intervals))
+ (l-tab (map-into (nth 2 l-iv) 'hash-table))
+ (x-tab (map-into (nth 2 x-iv) 'hash-table)))
+ (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab))
+ (assert-equal l-v (gethash l-k x-tab))
+ (remhash l-k x-tab))
+ (should (zerop (hash-table-count x-tab))))))
+ ((pred sequencep)
+ (assert-equal (seq-first latest) (seq-first expect))
+ (assert-equal (seq-rest latest) (seq-rest expect)))
+ (_ (should (equal latest expect)))))
(message "Snapshot file missing: %S" expect-file)))))
;; To inspect variable pitch, set `erc-mode-hook' to
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index fd030d90c2f..f7e7d61c92e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -81,6 +81,7 @@ erc-scenarios-log--kill-hook
(ert-deftest erc-scenarios-log--clear-stamp ()
:tags '(:expensive-test)
+ (require 'erc-stamp)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index cd899fddb98..864f3881ab1 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -55,7 +55,8 @@ erc-scenarios-match--stamp-left-current-nick
:nick "tester")
;; Module `timestamp' follows `match' in insertion hooks.
(should (memq 'erc-add-timestamp
- (memq 'erc-match-message erc-insert-modify-hook)))
+ (memq 'erc-match-message
+ (default-value 'erc-insert-modify-hook))))
;; The "match type" is `current-nick'.
(funcall expect 5 "tester")
(should (eq (get-text-property (1- (point)) 'font-lock-face)
@@ -91,7 +92,8 @@ erc-scenarios-match--invisible-stamp
:nick "tester")
;; Module `timestamp' follows `match' in insertion hooks.
(should (memq 'erc-add-timestamp
- (memq 'erc-match-message erc-insert-modify-hook)))
+ (memq 'erc-match-message
+ (default-value 'erc-insert-modify-hook))))
(funcall expect 5 "This server is in debug mode")))
(ert-info ("Ensure lines featuring \"bob\" are invisible")
@@ -151,29 +153,13 @@ erc-scenarios-match--stamp-left-fools-invisible
(= (next-single-property-change msg-beg 'invisible nil (pos-eol))
(pos-eol))))))))
-(defun erc-scenarios-match--find-bol ()
- (save-excursion
- (should (get-text-property (1- (point)) 'erc-command))
- (goto-char (should (previous-single-property-change (point) 'erc-command)))
- (pos-bol)))
-
-(defun erc-scenarios-match--find-eol ()
- (save-excursion
- (if-let ((next (next-single-property-change (point) 'erc-command)))
- (goto-char next)
- ;; We're already at the end of the message.
- (should (get-text-property (1- (point)) 'erc-command)))
- (pos-eol)))
-
;; In most cases, `erc-hide-fools' makes line endings invisible.
(defun erc-scenarios-match--stamp-right-fools-invisible ()
- :tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
(erc-scenarios-match--invisible-stamp
(lambda ()
- (let ((beg (erc-scenarios-match--find-bol))
- (end (erc-scenarios-match--find-eol)))
+ (pcase-let ((`(,beg . ,end) (erc--get-inserted-msg-bounds)))
;; The end of the message is a newline.
(should (= ?\n (char-after end)))
@@ -205,7 +191,7 @@ erc-scenarios-match--stamp-right-fools-invisible
(should (= (next-single-property-change msg-end 'invisible) end)))))
(lambda ()
- (let ((end (erc-scenarios-match--find-eol)))
+ (let ((end (cdr (erc--get-inserted-msg-bounds))))
;; This message has a time stamp like all the others.
(should (eq (field-at-pos (1- end)) 'erc-timestamp))
@@ -271,7 +257,117 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap
(let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
-(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
+(defun erc-scenarios-match--fill-wrap-stamp-dedented-p (point)
+ (pcase (get-text-property point 'line-prefix)
+ (`(space :width (- erc-fill--wrap-value (,n)))
+ (if (display-graphic-p) (< 100 n 200) (< 10 n 30)))
+ (`(space :width (- erc-fill--wrap-value ,n))
+ (< 10 n 30))))
+
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-wrap ()
+
+ ;; Rewind the clock to known date artificially. We should probably
+ ;; use a ticks/hz cons on 29+.
+ (let ((erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-fill-function #'erc-fill-wrap)
+ (bob-utterance-counter 0))
+
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (ert-info ("Baseline check")
+ ;; False date printed initially before anyone speaks.
+ (when (zerop bob-utterance-counter)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "[Wed Apr 29 1992]")
+ ;; First stamp in a buffer is not invisible from previous
+ ;; newline (before stamp's own leading newline).
+ (should (= 4 (match-beginning 0)))
+ (should (get-text-property 3 'invisible))
+ (should-not (get-text-property 2 'invisible))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p 4))
+ (search-forward "[23:59]"))))
+
+ (ert-info ("Line endings in Bob's messages are invisible")
+ ;; The message proper has the `invisible' property `match-fools'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
+ (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds)))
+ (should (= (char-after mend) ?\n))
+ (should-not (field-at-pos mend))
+ (should-not (field-at-pos mbeg))
+
+ (when (= bob-utterance-counter 1)
+ (let ((right-stamp (field-end mbeg)))
+ (should (eq 'erc-timestamp (field-at-pos right-stamp)))
+ (should (= mend (field-end right-stamp)))
+ (should (eq (field-at-pos (1- mend)) 'erc-timestamp))))
+
+ ;; The `erc-ts' property is present in prop stack.
+ (should (get-text-property (pos-bol) 'erc-ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
+
+ ;; Line ending has the `invisible' property `match-fools'.
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))
+
+ ;; Only the message right after Alice speaks contains stamps.
+ (when (= 1 bob-utterance-counter)
+
+ (ert-info ("Date stamp occupying previous line is invisible")
+ (should (eq 'match-fools (get-text-property (point) 'invisible)))
+ (save-excursion
+ (forward-line -1)
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[Mon May 4 1992]")))
+ (ert-info ("Stamp's NL `invisible' as fool, not timestamp")
+ (let ((end (match-end 0)))
+ (should (eq (char-after end) ?\n))
+ (should (eq 'timestamp
+ (get-text-property (1- end) 'invisible)))
+ (should (eq 'match-fools
+ (get-text-property end 'invisible)))))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point)))
+ ;; Date stamp has a combined `invisible' property value
+ ;; that starts at the previous message's trailing newline
+ ;; and extends until the start of the message proper.
+ (should (equal ?\n (char-before (point))))
+ (should (equal ?\n (char-before (1- (point)))))
+ (let ((val (get-text-property (- (point) 2) 'invisible)))
+ (should (equal val 'timestamp))
+ (should (= (text-property-not-all (- (point) 2) (point-max)
+ 'invisible val)
+ (pos-eol))))))
+
+ (ert-info ("Current message's RHS stamp is hidden")
+ ;; Right stamp has `match-fools' property.
+ (save-excursion
+ (should-not (field-at-pos (point)))
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
+
+ ;; Stamp invisibility starts where message's ends.
+ (let ((msgend (next-single-property-change (pos-bol) 'invisible)))
+ ;; Stamp has a combined `invisible' property value.
+ (should (equal (get-text-property msgend 'invisible)
+ '(timestamp match-fools)))
+
+ ;; Combined `invisible' property spans entire timestamp.
+ (should (= (next-single-property-change msgend 'invisible)
+ (pos-eol))))))
+
+ (cl-incf bob-utterance-counter))
+
+ ;; Alice.
+ (lambda ()
+ ;; Set clock ahead a week or so.
+ (setq erc-stamp--current-time 704962800)
+
+ ;; This message has no time stamp and is completely visible.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (should-not (next-single-property-change (pos-bol) 'invisible))))))
+
+(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds)
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
@@ -295,21 +391,20 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `match-fools'.
(should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
- (mend (next-single-property-change mbeg 'erc-command)))
+ (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds)))
- (if (/= 1 bob-utterance-counter)
- (should-not (field-at-pos mend))
+ (should (= (char-after mend) ?\n))
+ (should-not (field-at-pos mbeg))
+ (should-not (field-at-pos mend))
+ (when (= 1 bob-utterance-counter)
;; For Bob's stamped message, check newline after stamp.
- (should (eq (field-at-pos mend) 'erc-timestamp))
- (setq mend (field-end mend)))
+ (should (eq (field-at-pos (field-end mbeg)) 'erc-timestamp))
+ (should (eq (field-at-pos (1- mend)) 'erc-timestamp)))
- ;; The `erc-timestamp' property spans entire messages,
- ;; including stamps and filled text, which makes for
- ;; convenient traversal when `erc-stamp-mode' is enabled.
- (should (get-text-property (pos-bol) 'erc-timestamp))
- (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
- mend))
+ ;; The `erc-ts' property is present in the message's
+ ;; width 1 prop collection at its first char.
+ (should (get-text-property (pos-bol) 'erc-ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
@@ -327,12 +422,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
- ;; Date stamp has a combined `invisible' property value
- ;; that extends until the start of the message proper.
- (should (equal (get-text-property (point) 'invisible)
- '(timestamp match-fools)))
- (should (= (next-single-property-change (point) 'invisible)
- (1+ (pos-eol))))))
+ (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n
+ (funcall assert-ds))) ; "assert date stamp"
(ert-info ("Folding preserved despite invisibility")
;; Message has a trailing time stamp, but it's been folded
@@ -365,13 +456,45 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
:tags '(:expensive-test)
- (erc-scenarios-match--stamp-both-invisible-fill-static))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that starts from the
+ ;; newline delimiting the current and previous messages and
+ ;; extends until the stamp's final newline. It is not combined
+ ;; with the old value, `match-fools'.
+ (let ((delim-pos (- (point) 2)))
+ (should (equal 'timestamp (get-text-property delim-pos 'invisible)))
+ ;; Stamp-only invisibility ends before its last newline.
+ (should (= (text-property-not-all delim-pos (point-max)
+ 'invisible 'timestamp)
+ (match-end 0))))))) ; pos-eol
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
:tags '(:expensive-test)
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(should-not erc-legacy-invisible-bounds-p)
+
(let ((erc-legacy-invisible-bounds-p t))
- (erc-scenarios-match--stamp-both-invisible-fill-static))))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that covers its
+ ;; format string exactly. It is not combined with the old
+ ;; value, `match-fools'.
+ (let ((delim-prev (- (point) 2)))
+ (should-not (get-text-property delim-prev 'invisible))
+ (should (eq 'erc-timestamp (field-at-pos (point))))
+ (should (= (next-single-property-change delim-prev 'invisible)
+ (field-beginning (point))))
+ (should (equal 'timestamp
+ (get-text-property (1- (point)) 'invisible)))
+ ;; Field stops before final newline because the date stamp
+ ;; is (now, as of ERC 5.6) its own standalone message.
+ (should (= ?\n (char-after (field-end (point)))))
+ ;; Stamp-only invisibility includes last newline.
+ (should (= (text-property-not-all (1- (point)) (point-max)
+ 'invisible 'timestamp)
+ (1+ (field-end (point)))))))))))
;;; erc-scenarios-match.el ends here
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 46a05729066..cc61d599387 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -279,7 +279,7 @@ erc-echo-timestamp
(should-not erc-echo-timestamps)
(should-not erc-stamp--last-stamp)
- (insert (propertize "abc" 'erc-timestamp 433483200))
+ (insert (propertize "a" 'erc-ts 433483200 'erc-msg 'msg) "bc")
(goto-char (point-min))
(let ((inhibit-message t)
(erc-echo-timestamp-format "%Y-%m-%d %H:%M:%S %Z")
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 11717217eb2..408cc4db10c 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -292,6 +292,8 @@ erc--refresh-prompt
(cl-incf counter))))
erc-accidental-paste-threshold-seconds
erc-insert-modify-hook
+ (erc-modules (remq 'stamp erc-modules))
+ (erc-send-input-line-function #'ignore)
(erc--input-review-functions erc--input-review-functions)
erc-send-completed-hook)
@@ -356,7 +358,8 @@ erc--refresh-prompt
(should (looking-back "#chan@ServNet 11> "))
(should (= (point) erc-input-marker))
(insert "/query bob")
- (erc-send-current-line)
+ (let (erc-modules)
+ (erc-send-current-line))
;; Last command not inserted
(save-excursion (forward-line -1)
(should (looking-at "<tester> Howdy")))
@@ -1431,6 +1434,44 @@ erc-process-input-line
(should-not calls))))))
+(ert-deftest erc--order-text-properties-from-hash ()
+ (let ((table (map-into '((a . 1)
+ (erc-ts . 0)
+ (erc-msg . s005)
+ (b . 2)
+ (erc-cmd . 5)
+ (c . 3))
+ 'hash-table)))
+ (with-temp-buffer
+ (erc-mode)
+ (insert "abc\n")
+ (add-text-properties 1 2 (erc--order-text-properties-from-hash table))
+ (should (equal '( erc-msg s005
+ erc-ts 0
+ erc-cmd 5
+ a 1
+ b 2
+ c 3)
+ (text-properties-at (point-min)))))))
+
+(ert-deftest erc--check-msg-prop ()
+ (let ((erc--msg-props (map-into '((a . 1) (b . x)) 'hash-table)))
+ (should (eq 1 (erc--check-msg-prop 'a)))
+ (should (erc--check-msg-prop 'a 1))
+ (should-not (erc--check-msg-prop 'a 2))
+
+ (should (eq 'x (erc--check-msg-prop 'b)))
+ (should (erc--check-msg-prop 'b 'x))
+ (should-not (erc--check-msg-prop 'b 1))
+
+ (should (erc--check-msg-prop 'a '(1 42)))
+ (should-not (erc--check-msg-prop 'a '(2 42)))
+
+ (let ((props '(42 x)))
+ (should (erc--check-msg-prop 'b props)))
+ (let ((v '(42 y)))
+ (should-not (erc--check-msg-prop 'b v)))))
+
(defmacro erc-tests--equal-including-properties (a b)
(list (if (< emacs-major-version 29)
'ert-equal-including-properties
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 689bacc7012..238d8cc73c2 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 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) 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) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 27 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 27 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 474 475 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 27 (8))) erc-command PRIVMSG) 475 480 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 480 486 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 487 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 27 0)) display #11="" erc-command PRIVMSG) 488 493 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 493 495 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 495 499 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 500 501 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 27 (6))) erc-command PRIVMSG) 501 504 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 504 512 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 513 514 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13=(space :width (- 27 0)) display #11# erc-command PRIVMSG) 514 517 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 517 519 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 519 524 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# erc-command PRIVMSG) 525 526 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14=(space :width (- 27 (8))) erc-command PRIVMSG) 526 531 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 531 538 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 539 540 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15=(space :width (- 27 0)) display #11# erc-command PRIVMSG) 540 545 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 545 547 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 547 551 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# erc-command PRIVMSG))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index 9fa23a7d332..d1ce9198e69 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 20 (erc-timestamp 0 line-prefix (space :width (- 29 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 29 (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) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 29 (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) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 29 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 29 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 474 475 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 29 (8))) erc-command PRIVMSG) 475 480 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 480 486 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 487 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 29 0)) display #11="" erc-command PRIVMSG) 488 493 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 493 495 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# display #11# erc-command PRIVMSG) 495 499 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 500 501 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 29 (6))) erc-command PRIVMSG) 501 504 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 504 512 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 513 514 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13=(space :width (- 29 0)) display #11# erc-command PRIVMSG) 514 517 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 517 519 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# display #11# erc-command PRIVMSG) 519 524 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #13# erc-command PRIVMSG) 525 526 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14=(space :width (- 29 (8))) erc-command PRIVMSG) 526 531 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 531 538 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #14# erc-command PRIVMSG) 539 540 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15=(space :width (- 29 0)) display #11# erc-command PRIVMSG) 540 545 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 545 547 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# display #11# erc-command PRIVMSG) 547 551 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #15# erc-command PRIVMSG))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index a3d533c87b5..d70184724ba 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +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 one\n<bob> two.\n* bob three\n<bob> four.\n" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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=(#7=(margin right-margin) #("[00:00]" 0 7 (display #1# invisible timestamp font-lock-face erc-timestamp-face)))) 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) 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) 436 454 (erc-timestamp 1680332400 line-prefix (space :width (- 27 (18))) field erc-timestamp) 454 455 (erc-timestamp 1680332400 field erc-timestamp) 455 456 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6=(space :width (- 27 (6))) erc-command PRIVMSG) 456 459 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 459 466 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 473 (erc-timestamp 1680332400 field erc-timestamp wrap-prefix #2# line-prefix #6# display #8=(#7# #("[07:00]" 0 7 (display #8# invisible timestamp font-lock-face erc-timestamp-face)))) 474 476 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9=(space :width (- 27 (6))) erc-ctcp ACTION erc-command PRIVMSG) 476 479 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-ctcp ACTION erc-command PRIVMSG) 479 483 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #9# erc-ctcp ACTION erc-command PRIVMSG) 484 485 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10=(space :width (- 27 (6))) erc-command PRIVMSG) 485 488 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 488 494 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #10# erc-command PRIVMSG) 495 497 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11=(space :width (- 27 (2))) erc-ctcp ACTION erc-command PRIVMSG) 497 500 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11# erc-ctcp ACTION erc-command PRIVMSG) 500 506 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #11# erc-ctcp ACTION erc-command PRIVMSG) 507 508 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12=(space :width (- 27 (6))) erc-command PRIVMSG) 508 511 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG) 511 518 (erc-timestamp 1680332400 wrap-prefix #2# line-prefix #12# erc-command PRIVMSG))
\ No newline at end of file
+#("\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 one\n<bob> two.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index 80c9e1d80f5..def97738ce6 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +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" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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)))) 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) 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))
\ No newline at end of file
+#("\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" 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 unknown 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 ((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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index e675695f660..be3e2b33cfd 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +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" 2 20 (erc-timestamp 0 line-prefix (space :width (- 29 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (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)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 29 (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) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 29 (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))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index a6070c2e3ff..098257d0b49 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +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" 2 20 (erc-timestamp 0 line-prefix (space :width (- 25 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (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)))) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 25 (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) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 25 (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))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index 80c9e1d80f5..def97738ce6 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +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" 2 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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)))) 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) 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))
\ No newline at end of file
+#("\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" 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 unknown 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 ((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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 2b8766c27f4..360b3dafafd 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +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 20 (erc-timestamp 0 line-prefix (space :width (- 27 (18))) field erc-timestamp) 20 21 (erc-timestamp 0 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) 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) 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) 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) 467 484 (erc-timestamp 0 wrap-prefix #2# line-prefix (space :width (- 27 (4)))) 485 502 (erc-timestamp 0 wrap-prefix #2# line-prefix (space :width (- 27 (4)))) 502 503 (line-spacing 0.5) 503 504 (erc-timestamp 0 wrap-prefix #2# line-prefix #8=(space :width (- 27 (6))) erc-command PRIVMSG) 504 507 (erc-timestamp 0 wrap-prefix #2# line-prefix #8# erc-command PRIVMSG) 507 525 (erc-timestamp 0 wrap-prefix #2# line-prefix #8# erc-command PRIVMSG))
\ No newline at end of file
+#("\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 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 unknown 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
index f62b65cd170..cd3537d3c94 100644
--- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -1 +1 @@
-#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG))
\ No newline at end of file
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg unknown erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
\ No newline at end of file
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0007-5.6-Add-command-to-refill-buffer-with-erc-fill-wrap-.patch --]
[-- Type: text/x-patch, Size: 6667 bytes --]
From fcb34a45afd872361b0dbc8e6bd92ba53b910faa Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 21 Sep 2023 06:54:27 -0700
Subject: [PATCH 7/7] [5.6] Add command to refill buffer with
erc-fill-wrap-mode
* lisp/erc/erc-fill.el (erc-fill--wrap-rejigger-last-message):
New internal variable.
(erc-fill--wrap-rejigger-region,
erc-fill-wrap-refill-buffer): New command and helper function.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--simulate-refill):
New function for approximating `erc-fill-wrap-refill-buffer' without
pauses to accept process output.
(erc-fill-wrap--merge): Assert refilling is idempotent. (Bug#60936)
---
lisp/erc/erc-fill.el | 70 +++++++++++++++++++++++++++++++++
test/lisp/erc/erc-fill-tests.el | 18 ++++++++-
2 files changed, 86 insertions(+), 2 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 62a9597d481..8b86cf30bf4 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -543,6 +543,76 @@ erc-fill-wrap
`((space :width (- erc-fill--wrap-value ,len))
(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 destructively fix merged properties."
+ (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-wrap--monospace
(erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
(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-fill-wrap--merge
(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: "<bob> 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-wrap--merge
(erc-fill-tests--wrap-check-prefixes
"*** " "<alice> " "<bob> "
"<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
- (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)
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <874jj3ok58.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <874jj3ok58.fsf@neverwas.me>
@ 2023-10-14 0:24 ` J.P.
[not found] ` <87cyxi9hlc.fsf@neverwas.me>
2024-04-09 18:19 ` J.P.
2 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-14 0:24 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
I've added these changes as
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=c68dc778
Although I've done so with zero discussion, as usual, others can perhaps
take some comfort in knowing that this semi-major overhaul only reaches
as far back as the latest release (but not into it). Thanks.
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87cyxi9hlc.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87cyxi9hlc.fsf@neverwas.me>
@ 2023-10-14 17:04 ` J.P.
[not found] ` <87h6mt87al.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-14 17:04 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> I've added these changes as
>
> https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=c68dc778
>
> Although I've done so with zero discussion, as usual, others can perhaps
> take some comfort in knowing that this semi-major overhaul only reaches
> as far back as the latest release (but not into it). Thanks.
These changes introduced a(t least one) bug. To reproduce, call
`erc-display-line' with a list of buffers, and notice only the first
sees its message inserted with the correct text properties. A quick way
to simulate this is by having two clients join the same two channels
and then having one quit. The expected text props will be missing from
one of the inserted
*** someuser (n!~u@h) has quit
messages. Verify by going to the first asterisk and doing C-u C-x =.
Fix forthcoming.
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87h6mt87al.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87h6mt87al.fsf@neverwas.me>
@ 2023-10-16 14:07 ` J.P.
[not found] ` <8734yak6dr.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-16 14:07 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 609 bytes --]
"J.P." <jp@neverwas.me> writes:
> These changes introduced a(t least one) bug. To reproduce, call
> `erc-display-line' with a list of buffers, and notice only the first
> sees its message inserted with the correct text properties. A quick way
> to simulate this is by having two clients join the same two channels
> and then having one quit. The expected text props will be missing from
> one of the inserted
>
> *** someuser (n!~u@h) has quit
>
> messages. Verify by going to the first asterisk and doing C-u C-x =.
>
> Fix forthcoming.
The second of the attached patches should hopefully do the trick.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Try-waiting-for-assertion-in-erc-scenarios-log.patch --]
[-- Type: text/x-patch, Size: 5006 bytes --]
From 86efc480407711c4cf196eb497a0cf595ef1b5b7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 15 Oct 2023 13:43:12 -0700
Subject: [PATCH 1/2] ; Try waiting for assertion in erc-scenarios-log
* test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--truncate):
Attempt to fix intermittent test failure.
* test/lisp/erc/resources/base/renick/queries/solo.eld: Timeouts.
* test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld: Timeouts.
* test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld: Timeouts.
* test/lisp/erc/resources/erc-scenarios-common.el: Timeouts.
---
test/lisp/erc/erc-scenarios-log.el | 2 +-
test/lisp/erc/resources/base/renick/queries/solo.eld | 2 +-
test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld | 2 +-
test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld | 2 +-
test/lisp/erc/resources/erc-scenarios-common.el | 4 ++--
5 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index f7e7d61c92e..9d3116d3db3 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -180,7 +180,7 @@ erc-scenarios-log--truncate
(should-not (file-exists-p logserv))
(should-not (file-exists-p logchan))
(funcall expect 10 "*** MAXLIST=beI:60")
- (should (= (pos-bol) (point-min)))
+ (erc-d-t-wait-for 5 (= (pos-bol) (point-min)))
(should (file-exists-p logserv))))
(ert-info ("Log file ahead of truncation point")
diff --git a/test/lisp/erc/resources/base/renick/queries/solo.eld b/test/lisp/erc/resources/base/renick/queries/solo.eld
index 12fa7d264e9..fa4c075adac 100644
--- a/test/lisp/erc/resources/base/renick/queries/solo.eld
+++ b/test/lisp/erc/resources/base/renick/queries/solo.eld
@@ -30,7 +30,7 @@
(0 ":irc.foonet.org NOTICE tester :[09:56:57] 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.")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-((mode 1 "MODE #foo")
+((mode 10 "MODE #foo")
(0 ":irc.foonet.org 324 tester #foo +nt")
(0 ":irc.foonet.org 329 tester #foo 1622454985")
(0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.")
diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
index efc2506fd6f..d106a45cf66 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
@@ -56,7 +56,7 @@
(0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!")
(0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620205534")
(0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Chi non te vede, non te pretia.")
diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
index a11cfac2e73..603afa2fc3e 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
@@ -52,7 +52,7 @@
(0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!")
(0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620205534")
(0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Thou desirest me to stop in my tale against the hair.")
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 5354b300b47..9e134e6932f 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -574,7 +574,7 @@ erc-scenarios-common--upstream-reconnect
:password "changeme"
:full-name "tester")
(erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 3 (eq (erc-network) 'foonet))
+ (erc-d-t-wait-for 6 (eq (erc-network) 'foonet))
(erc-d-t-wait-for 3 (string= (buffer-name) "foonet"))
(funcall expect 5 "foonet")))
@@ -713,7 +713,7 @@ erc-scenarios-common--join-network-id
(erc-d-t-wait-for 3 (eq erc-server-process erc-server-process-foo))
(funcall expect 3 "<bob>")
(erc-d-t-absent-for 0.1 "<joe>")
- (funcall expect 10 "not given me")))
+ (funcall expect 20 "not given me")))
(ert-info ("All #chan@barnet output received")
(with-current-buffer chan-buf-bar
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Restore-missing-metadata-props-in-erc-display-li.patch --]
[-- Type: text/x-patch, Size: 18480 bytes --]
From 5c3a1e966876d8d25e3916c0cde21d387e995014 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 15 Oct 2023 17:22:22 -0700
Subject: [PATCH 2/2] [5.6] Restore missing metadata props in erc-display-line
* etc/ERC-NEWS: Mention `erc-display-message' as favored means of
inserting messages.
* lisp/erc/erc-stamp.el (erc-stamp--current-time): Use an existing
`erc-ts' text property, when present, for the current message time.
* lisp/erc/erc.el (erc-display-line): Update doc string. Copy
`erc--msg-props' hash table when inserting a message in multiple
buffers. At present, only `erc-server-QUIT' uses this facility.
Also, improve readability with at most one recursive call for the
fall-through case.
(erc-display-message): Update doc string.
* test/lisp/erc/erc-scenarios-display-message.el: New file.
* test/lisp/erc/erc-tests.el (erc-display-line): New test.
* test/lisp/erc/resources/base/display-message/multibuf.eld: New test
data. (Bug#60936)
---
etc/ERC-NEWS | 11 +++
lisp/erc/erc-stamp.el | 4 +-
lisp/erc/erc.el | 67 +++++++++++--------
.../lisp/erc/erc-scenarios-display-message.el | 64 ++++++++++++++++++
test/lisp/erc/erc-tests.el | 62 +++++++++++++++++
.../base/display-message/multibuf.eld | 45 +++++++++++++
6 files changed, 224 insertions(+), 29 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-display-message.el
create mode 100644 test/lisp/erc/resources/base/display-message/multibuf.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 2e56539f210..404d735b9f6 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -288,6 +288,17 @@ ERC also provisionally reserves the same depth interval for
continue to modify non-ERC hooks locally whenever possible, especially
in new code.
+*** ERC strongly favors 'erc-display-message' for message insertion.
+Although less common these days, folks still sometimes resort to using
+the insertion function 'erc-display-line' because it's admittedly less
+awkward than the supposedly higher level 'erc-display-message'. Thus,
+ancient patterns, like preformatting text with 'erc-make-notice',
+still occasionally appear in newer code. However, beginning in ERC
+5.6, certain preparatory business necessary for the eventual move to a
+richer UI has taken up residence in 'erc-display-message'. If you
+find this development disturbing, by all means voice your concerns on
+the tracker. (Patches for user-friendly wrappers are most welcome.)
+
*** ERC now manages timestamp-related properties a bit differently.
For starters, the 'cursor-sensor-functions' text property is absent by
default unless the option 'erc-echo-timestamps' is already enabled on
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 394643c03cb..57fd7f39e50 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -219,7 +219,9 @@ erc-stamp--current-time
(erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
- (or erc-stamp--current-time (cl-call-next-method)))
+ (or erc-stamp--current-time
+ (and erc--msg-props (gethash 'erc-ts erc--msg-props))
+ (cl-call-next-method)))
(defvar erc-stamp--skip nil
"Non-nil means inhibit `erc-add-timestamp' completely.")
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5bf6496e926..7edf735eb43 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3092,36 +3092,46 @@ erc-is-valid-nick-p
(string-match (concat "\\`" erc-valid-nick-regexp "\\'") nick))
(defun erc-display-line (string &optional buffer)
- "Display STRING in the ERC BUFFER.
-All screen output must be done through this function. If BUFFER is nil
-or omitted, the default ERC buffer for the `erc-session-server' is used.
-The BUFFER can be an actual buffer, a list of buffers, `all' or `active'.
-If BUFFER = `all', the string is displayed in all the ERC buffers for the
-current session. `active' means the current active buffer
-\(`erc-active-buffer'). If the buffer can't be resolved, the current
-buffer is used. `erc-display-line-1' is used to display STRING.
-
-If STRING is nil, the function does nothing."
- (let (new-bufs)
+ "Insert STRING in BUFFER.
+Expect BUFFER to be a live `erc-mode' buffer, a list of such
+buffers, or the symbols `all' or `active'. If `all', insert
+STRING in all buffers for the current session. If `active',
+defer to the function `erc-active-buffer', which may return the
+session's server buffer if the previously active buffer has been
+killed. If BUFFER is nil or a network process, pretend it's set
+to the appropriate server buffer. Otherwise, use the current
+buffer.
+
+In most cases, expect to be called from a higher-level insertion
+function, like `erc-display-message', especially when modules
+should consider STRING as a candidate for formatting with
+indentation, fontification, timestamping, etc. Otherwise, allow
+built-in modules to ignore STRING, which may make it appear
+incongruous in situ (unless anticipated by third-party hook
+members or otherwise preformatted)."
+ (let (seen msg-props)
(dolist (buf (cond
((bufferp buffer) (list buffer))
- ((listp buffer) buffer)
+ ((consp buffer)
+ (setq msg-props erc--msg-props)
+ buffer)
((processp buffer) (list (process-buffer buffer)))
((eq 'all buffer)
;; Hmm, or all of the same session server?
(erc-buffer-list nil erc-server-process))
- ((and (eq 'active buffer) (erc-active-buffer))
- (list (erc-active-buffer)))
+ ((and-let* (((eq 'active buffer))
+ (b (erc-active-buffer)))
+ (list b)))
((erc-server-buffer-live-p)
(list (process-buffer erc-server-process)))
(t (list (current-buffer)))))
(when (buffer-live-p buf)
+ (when msg-props
+ (setq erc--msg-props (copy-hash-table msg-props)))
(erc-display-line-1 string buf)
- (push buf new-bufs)))
- (when (null new-bufs)
- (erc-display-line-1 string (if (erc-server-buffer-live-p)
- (process-buffer erc-server-process)
- (current-buffer))))))
+ (setq seen t)))
+ (unless (or seen (null buffer))
+ (erc-display-line string nil))))
(defvar erc--compose-text-properties nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
@@ -3432,14 +3442,15 @@ erc-display-message
Insert MSG or text derived from MSG into an ERC buffer, possibly
after applying formatting by way of either a `format-spec' known
to a message-catalog entry or a TYPE known to a specialized
-string handler. Additionally, derive internal metadata, faces,
-and other text properties from the various overloaded parameters,
-such as PARSED, when it's an `erc-response' object, and MSG, when
-it's a key (symbol) for a \"message catalog\" entry. Expect
-ARGS, when applicable, to be `format-spec' args known to such an
-entry, and TYPE, when non-nil, to be a symbol handled by
+string handler. Additionally, derive metadata, faces, and other
+text properties from the various overloaded parameters, such as
+PARSED, when it's an `erc-response' object, and MSG, when it's a
+key (symbol) for a \"message catalog\" entry. Expect ARGS, when
+applicable, to be `format-spec' args known to such an entry, and
+TYPE, when non-nil, to be a symbol handled by
`erc-display-message-highlight' (necessarily accompanied by a
-string MSG).
+string MSG). Expect BUFFER to be among the sort accepted by the
+function `erc-display-line'.
When TYPE is a list of symbols, call handlers from left to right
without influencing how they behave when encountering existing
@@ -3455,8 +3466,8 @@ erc-display-message
`erc-display-line' when it's important that insert hooks treat
MSG in a manner befitting messages received from a server. That
is, expect to process most nontrivial informational messages, for
-which PARSED is typically nil, when the caller desires
-buttonizing and other effects."
+which PARSED is typically nil, when the caller desires the
+inserted message to feature buttonizing and other effects."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
msg))
diff --git a/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el
new file mode 100644
index 00000000000..51bdf305ad5
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-display-message.el
@@ -0,0 +1,64 @@
+;;; erc-scenarios-display-message.el --- erc-display-message -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(ert-deftest erc-scenarios-display-message--multibuf ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/display-message")
+ (dumb-server (erc-d-run "localhost" t 'multibuf))
+ (port (process-contact dumb-server :service))
+ (erc-server-flood-penalty 0.1)
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-autojoin-channels-alist '((foonet "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 10 "debug mode")))
+
+ (ert-info ("User dummy is a member of #chan")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (funcall expect 10 "dummy")))
+
+ (ert-info ("Dummy's QUIT notice in query contains metadata props")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "dummy"))
+ (funcall expect 10 "<dummy> hi")
+ (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
+ (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
+
+ (ert-info ("Dummy's QUIT notice in #chan contains metadata props")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
+ (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
+
+ (erc-cmd-QUIT "")))
+
+(eval-when-compile (require 'erc-join))
+
+;;; erc-scenarios-display-message.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 4f4662f5075..b35afaa552f 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1938,6 +1938,68 @@ erc-format-privmessage
2 5 (erc-speaker "Bob" font-lock-face erc-nick-default-face)
5 12 (font-lock-face erc-default-face))))))
+(ert-deftest erc-display-line ()
+ (erc-tests--send-prep)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (setq erc-networks--id (erc-networks--id-create 'foonet))
+
+ (let ((server-buffer (current-buffer))
+ (spam-buffer (save-excursion (erc--open-target "#spam")))
+ (chan-buffer (save-excursion (erc--open-target "#chan")))
+ calls)
+ (cl-letf (((symbol-function 'erc-display-line-1)
+ (lambda (&rest r) (push (cons 'line-1 r) calls))))
+
+ (with-current-buffer chan-buffer
+
+ (ert-info ("Null `buffer' routes to live server-buffer")
+ (erc-display-line "null" nil)
+ (should (equal (pop calls) `(line-1 "null" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Cons `buffer' routes to live members")
+ ;; Copies a let-bound `erc--msg-props' before mutating.
+ (let* ((table (map-into '(erc-msg msg) 'hash-table))
+ (erc--msg-props table))
+ (erc-display-line "cons" (list server-buffer spam-buffer))
+ (should-not (eq table erc--msg-props)))
+ (should (equal (pop calls) `(line-1 "cons" ,spam-buffer)))
+ (should (equal (pop calls) `(line-1 "cons" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Variant `all' inserts in all session buffers")
+ (erc-display-line "all" 'all)
+ (should (equal (pop calls) `(line-1 "all" ,chan-buffer)))
+ (should (equal (pop calls) `(line-1 "all" ,spam-buffer)))
+ (should (equal (pop calls) `(line-1 "all" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Variant `active' routes to active buffer if alive")
+ (should (eq chan-buffer (erc-with-server-buffer erc-active-buffer)))
+ (erc-set-active-buffer spam-buffer)
+ (erc-display-line "act" 'active)
+ (should (equal (pop calls) `(line-1 "act" ,spam-buffer)))
+ (should (eq (erc-active-buffer) spam-buffer))
+ (should-not calls))
+
+ (ert-info ("Variant `active' falls back to current buffer")
+ (should (eq spam-buffer (erc-active-buffer)))
+ (kill-buffer "#spam")
+ (erc-display-line "nact" 'active)
+ (should (equal (pop calls) `(line-1 "nact" ,server-buffer)))
+ (should (eq (erc-with-server-buffer erc-active-buffer)
+ server-buffer))
+ (should-not calls))
+
+ (ert-info ("Dead single buffer defaults to live server-buffer")
+ (should-not (get-buffer "#spam"))
+ (erc-display-line "dead" 'spam-buffer)
+ (should (equal (pop calls) `(line-1 "dead" ,server-buffer)))
+ (should-not calls))))
+
+ (should-not (buffer-live-p spam-buffer))
+ (kill-buffer chan-buffer)))
+
(defvar erc-tests--ipv6-examples
'("1:2:3:4:5:6:7:8"
"::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0"
diff --git a/test/lisp/erc/resources/base/display-message/multibuf.eld b/test/lisp/erc/resources/base/display-message/multibuf.eld
new file mode 100644
index 00000000000..e49a654cd06
--- /dev/null
+++ b/test/lisp/erc/resources/base/display-message/multibuf.eld
@@ -0,0 +1,45 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
+ (0.01 ":irc.foonet.org 003 tester :This server was created Sat, 14 Oct 2023 16:08:20 UTC")
+ (0.02 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
+ (0.00 ":irc.foonet.org 251 tester :There are 0 users and 5 invisible on 1 server(s)")
+ (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0.00 ":irc.foonet.org 254 tester 2 :channels formed")
+ (0.00 ":irc.foonet.org 255 tester :I have 5 clients and 0 servers")
+ (0.00 ":irc.foonet.org 265 tester 5 5 :Current local users 5, max 5")
+ (0.02 ":irc.foonet.org 266 tester 5 5 :Current global users 5, max 5")
+ (0.01 ":irc.foonet.org 422 tester :MOTD File is missing")
+ (0.00 ":irc.foonet.org 221 tester +i")
+ (0.01 ":irc.foonet.org NOTICE tester :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."))
+
+((mode 10 "MODE tester +i")
+ (0.00 ":irc.foonet.org 221 tester +i"))
+
+((join 10 "JOIN #chan")
+ (0.03 ":tester!~u@rdjcgiwfuwqmc.irc JOIN #chan")
+ (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice dummy tester")
+ (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (0.00 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!")
+ (0.01 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!"))
+
+((mode 10 "MODE #chan")
+ (0.01 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: Persuade this rude wretch willingly to die.")
+ (0.01 ":irc.foonet.org 324 tester #chan +Cnt")
+ (0.01 ":irc.foonet.org 329 tester #chan 1697299707")
+ (0.03 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :bob: It might be yours or hers, for aught I know.")
+ (0.07 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :Would all themselves laugh mortal.")
+ (0.04 ":dummy!~u@rdjcgiwfuwqmc.irc PRIVMSG tester :hi")
+ (0.06 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: It hath pleased the devil drunkenness to give place to the devil wrath; one unperfectness shows me another, to make me frankly despise myself.")
+ (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)")
+ (0.08 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :You speak of him when he was less furnished than now he is with that which makes him both without and within."))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.04 ":tester!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)")
+ (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)"))
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <8734yak6dr.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <8734yak6dr.fsf@neverwas.me>
@ 2023-10-17 13:48 ` J.P.
2023-10-19 14:02 ` J.P.
[not found] ` <877cniaewr.fsf@neverwas.me>
0 siblings, 2 replies; 56+ messages in thread
From: J.P. @ 2023-10-17 13:48 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1544 bytes --]
v2 (erc-display-line redux). Fix initial bug involving missing text
props on multi-buffer calls to `erc-display-line'. Convert latter to
internal function and reimplement interface as high-level wrapper around
`erc-display-message'.
"J.P." <jp@neverwas.me> writes:
> "J.P." <jp@neverwas.me> writes:
>
>> These changes introduced a(t least one) bug. To reproduce, call
>> `erc-display-line' with a list of buffers, and notice only the first
>> sees its message inserted with the correct text properties. A quick way
>> to simulate this is by having two clients join the same two channels
>> and then having one quit. The expected text props will be missing from
>> one of the inserted
>>
>> *** someuser (n!~u@h) has quit
>>
>> messages. Verify by going to the first asterisk and doing C-u C-x =.
>>
>> Fix forthcoming.
>
> The second of the attached patches should hopefully do the trick.
Actually, merely hoping folks will use `erc-display-message' instead of
`erc-display-line' is surely delusional. There's likely far too much
code out there doing stuff like:
(erc-display-line (erc-make-notice "foo") my-buffer)
So I've instead converted `erc-display-line' into a high-level insertion
function more aligned with the manner in which it's used in practice.
It's now more or less a thin wrapper around `erc-display-message' with a
bit of special casing to intercept instances of the `erc-make-notice'
pattern above for rewriting as:
(erc-display-message nil 'notice my-buffer "foo")
Hopefully, this is an acceptable compromise.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 63626 bytes --]
From 2288132d2ae82bf6f1af44734306193e86bd90e5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 17 Oct 2023 06:44:50 -0700
Subject: [PATCH 0/2] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (2):
; Mark erc-log test as :unstable
[5.6] Restore missing metadata props in erc-display-line
etc/ERC-NEWS | 23 +++
lisp/erc/erc-fill.el | 3 +-
lisp/erc/erc-stamp.el | 4 +-
lisp/erc/erc.el | 146 +++++++++++-------
test/lisp/erc/erc-networks-tests.el | 2 +-
.../lisp/erc/erc-scenarios-display-message.el | 64 ++++++++
test/lisp/erc/erc-scenarios-log.el | 2 +-
test/lisp/erc/erc-tests.el | 63 ++++++++
.../base/display-message/multibuf.eld | 45 ++++++
.../resources/base/renick/queries/solo.eld | 2 +-
.../base/reuse-buffers/channel/barnet.eld | 2 +-
.../base/reuse-buffers/channel/foonet.eld | 2 +-
.../erc/resources/erc-scenarios-common.el | 4 +-
.../fill/snapshots/merge-01-start.eld | 2 +-
.../fill/snapshots/merge-02-right.eld | 2 +-
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../fill/snapshots/spacing-01-mono.eld | 2 +-
.../fill/snapshots/stamps-left-01.eld | 2 +-
22 files changed, 307 insertions(+), 73 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-display-message.el
create mode 100644 test/lisp/erc/resources/base/display-message/multibuf.eld
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 404d735b9f6..282a538e04d 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -288,16 +288,28 @@ ERC also provisionally reserves the same depth interval for
continue to modify non-ERC hooks locally whenever possible, especially
in new code.
-*** ERC strongly favors 'erc-display-message' for message insertion.
-Although less common these days, folks still sometimes resort to using
-the insertion function 'erc-display-line' because it's admittedly less
-awkward than the supposedly higher level 'erc-display-message'. Thus,
-ancient patterns, like preformatting text with 'erc-make-notice',
-still occasionally appear in newer code. However, beginning in ERC
-5.6, certain preparatory business necessary for the eventual move to a
-richer UI has taken up residence in 'erc-display-message'. If you
-find this development disturbing, by all means voice your concerns on
-the tracker. (Patches for user-friendly wrappers are most welcome.)
+*** Message insertion function 'erc-display-message' heavily favored.
+Displaying "local" messages, like help text and interactive-command
+feedback, in ERC buffers has never been straightforward. As such,
+ancient patterns, like the pairing of preformatted "notice" text with
+ERC's oldest insertion function, 'erc-display-line', still appear
+quite frequently in the wild despite having been largely phased out of
+ERC's own code base in 2002. That this specific example has endured
+makes some sense because it's probably seen as less cumbersome than
+fiddling with the more powerful and complicated 'erc-display-message'.
+
+The latest twist in this saga comes with this release, in which a
+healthy dose of \"pre-insertion business\" has been invited to take up
+residence in 'erc-display-message'. While this would seem to put
+antiquated patterns, like the above mentioned 'erc-make-notice' combo,
+at risk of having messages ignored or subject to degraded treatment by
+built-in modules, a prophylactic measure has been erected to recast
+'erc-display-line' as a thin wrapper around 'erc-display-message'.
+And though nothing of the sort has been done for the lower-level
+'erc-display-line-1' (now an obsolete alias for 'erc-insert-line'),
+some fallback code has been put in place to ensure baseline
+functionality. As always, if you find these developments disturbing,
+please say so on the tracker.
*** ERC now manages timestamp-related properties a bit differently.
For starters, the 'cursor-sensor-functions' text property is absent by
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 0048956e075..e28c3563ebf 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -539,7 +539,8 @@ erc-fill-wrap
(goto-char (point-min))
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
- (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg)))
+ (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg))
+ ((not (eq msg-prop 'unknown))))
(when-let ((e (erc--get-speaker-bounds))
(b (pop e))
((or erc-fill--wrap-action-dedent-p
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7edf735eb43..0513a5c785c 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3003,13 +3003,26 @@ erc--traverse-inserted
(defvar erc--insert-marker nil
"Internal override for `erc-insert-marker'.")
-(defun erc-display-line-1 (string buffer)
- "Display STRING in `erc-mode' BUFFER.
-Auxiliary function used in `erc-display-line'. The line gets filtered to
-interpret the control characters. Then, `erc-insert-pre-hook' gets called.
-If `erc-insert-this' is still t, STRING gets inserted into the buffer.
-Afterwards, `erc-insert-modify' and `erc-insert-post-hook' get called.
-If STRING is nil, the function does nothing."
+(define-obsolete-function-alias 'erc-display-line-1 'erc-insert-line "30.1")
+(defun erc-insert-line (string buffer)
+ "Insert STRING in an `erc-mode' BUFFER.
+When STRING is nil, do nothing. Otherwise, start off by running
+`erc-insert-pre-hook' in BUFFER with `erc-insert-this' bound to
+t. If the latter remains non-nil afterward, insert STRING into
+BUFFER, ensuring a trailing newline. After that, narrow BUFFER
+around STRING, along with its final line ending, and run
+`erc-insert-modify' and `erc-insert-post-hook', respectively. In
+all cases, run `erc-insert-done-hook' unnarrowed before exiting,
+and update positions in `buffer-undo-list'.
+
+In general, expect to be called from a higher-level insertion
+function, like `erc-display-message', especially when modules
+should consider STRING as a candidate for formatting with
+enhancements like indentation, fontification, timestamping, etc.
+Otherwise, when called directly, allow built-in modules to ignore
+STRING, which may make it appear incongruous in situ (unless
+preformatted or anticipated by third-party members of the various
+modification hooks)."
(when string
(with-current-buffer (or buffer (process-buffer erc-server-process))
(let ((insert-position (marker-position erc-insert-marker)))
@@ -3021,7 +3034,7 @@ erc-display-line-1
(when (erc-string-invisible-p string)
(erc-put-text-properties 0 (length string)
'(invisible intangible) string)))
- (erc-log (concat "erc-display-line: " string
+ (erc-log (concat "erc-display-message: " string
(format "(%S)" string) " in buffer "
(format "%s" buffer)))
(setq erc-insert-this t)
@@ -3091,24 +3104,9 @@ erc-is-valid-nick-p
"Check if NICK is a valid IRC nickname."
(string-match (concat "\\`" erc-valid-nick-regexp "\\'") nick))
-(defun erc-display-line (string &optional buffer)
+(defun erc--route-insertion (string buffer)
"Insert STRING in BUFFER.
-Expect BUFFER to be a live `erc-mode' buffer, a list of such
-buffers, or the symbols `all' or `active'. If `all', insert
-STRING in all buffers for the current session. If `active',
-defer to the function `erc-active-buffer', which may return the
-session's server buffer if the previously active buffer has been
-killed. If BUFFER is nil or a network process, pretend it's set
-to the appropriate server buffer. Otherwise, use the current
-buffer.
-
-In most cases, expect to be called from a higher-level insertion
-function, like `erc-display-message', especially when modules
-should consider STRING as a candidate for formatting with
-indentation, fontification, timestamping, etc. Otherwise, allow
-built-in modules to ignore STRING, which may make it appear
-incongruous in situ (unless anticipated by third-party hook
-members or otherwise preformatted)."
+See `erc-display-message' for acceptable BUFFER types."
(let (seen msg-props)
(dolist (buf (cond
((bufferp buffer) (list buffer))
@@ -3128,12 +3126,23 @@ erc-display-line
(when (buffer-live-p buf)
(when msg-props
(setq erc--msg-props (copy-hash-table msg-props)))
- (erc-display-line-1 string buf)
+ (erc-insert-line string buf)
(setq seen t)))
(unless (or seen (null buffer))
- (erc-display-line string nil))))
+ (erc--route-insertion string nil))))
-(defvar erc--compose-text-properties nil
+(defun erc-display-line (string &optional buffer)
+ "Insert STRING in BUFFER as a plain \"local\" message.
+Take pains to ensure modification hooks see messages created by
+the old pattern (erc-display-line (erc-make-notice) my-buffer) as
+being equivalent to a `erc-display-message' TYPE of `notice'."
+ (let ((erc--msg-prop-overrides erc--msg-prop-overrides))
+ (when (eq 'erc-notice-face (get-text-property 0 'font-lock-face string))
+ (unless (assq 'erc-msg erc--msg-prop-overrides)
+ (push '(erc-msg . notice) erc--msg-prop-overrides)))
+ (erc-display-message nil nil buffer string)))
+
+(defvar erc--merge-text-properties-p nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
;; To save space, we could maintain a map of all readable property
@@ -3452,6 +3461,15 @@ erc-display-message
string MSG). Expect BUFFER to be among the sort accepted by the
function `erc-display-line'.
+Expect BUFFER to be a live `erc-mode' buffer, a list of such
+buffers, or the symbols `all' or `active'. If `all', insert
+STRING in all buffers for the current session. If `active',
+defer to the function `erc-active-buffer', which may return the
+session's server buffer if the previously active buffer has been
+killed. If BUFFER is nil or a network process, pretend it's set
+to the appropriate server buffer. Otherwise, use the current
+buffer.
+
When TYPE is a list of symbols, call handlers from left to right
without influencing how they behave when encountering existing
faces. As of ERC 5.6, expect a TYPE of (notice error) to insert
@@ -3462,24 +3480,31 @@ erc-display-message
being (erc-error-face erc-notice-face) throughout MSG when
`erc-notice-highlight-type' is left at its default, `all'.
-As of ERC 5.6, assume user code will use this function instead of
-`erc-display-line' when it's important that insert hooks treat
-MSG in a manner befitting messages received from a server. That
-is, expect to process most nontrivial informational messages, for
-which PARSED is typically nil, when the caller desires the
-inserted message to feature buttonizing and other effects."
+As of ERC 5.6, assume third-party code will use this function
+instead of lower-level ones, like `erc-insert-line', when needing
+ERC to process arbitrary informative messages as if they'd been
+sent from a server. That is, guarantee \"local\" messages, for
+which PARSED is typically nil, will be subject to buttonizing,
+filling, and other effects."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
msg))
(erc--msg-props
(or erc--msg-props
- (let* ((table (make-hash-table :size 5))
- (cmd (and parsed (erc--get-eq-comparable-cmd
- (erc-response.command parsed))))
- (m (cond ((and msg (symbolp msg)) msg)
- ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
- (t 'unknown))))
- (puthash 'erc-msg m table)
+ (let ((table (make-hash-table :size 5))
+ (cmd (and parsed (erc--get-eq-comparable-cmd
+ (erc-response.command parsed)))))
+ (puthash 'erc-msg
+ (cond ((and msg (symbolp msg)) msg)
+ ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
+ (type (pcase type
+ ((pred symbolp) type)
+ ((pred listp)
+ (intern (mapconcat #'prin1-to-string
+ type "-")))
+ (_ 'unknown)))
+ (t 'unknown))
+ table)
(when cmd
(puthash 'erc-cmd cmd table))
(and erc--msg-prop-overrides
@@ -3492,7 +3517,7 @@ erc-display-message
((null type)
string)
((listp type)
- (let ((erc--compose-text-properties
+ (let ((erc--merge-text-properties-p
(and (eq (car type) t) (setq type (cdr type)))))
(dolist (type type)
(setq string (erc-display-message-highlight type string))))
@@ -3501,13 +3526,13 @@ erc-display-message
(erc-display-message-highlight type string))))
(if (not (erc-response-p parsed))
- (erc-display-line string buffer)
+ (erc--route-insertion string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
- (erc-display-line string buffer)))))
+ (erc--route-insertion string buffer)))))
(defun erc-message-type-member (position list)
"Return non-nil if the erc-parsed text-property at POSITION is in LIST.
@@ -6492,7 +6517,7 @@ erc-put-text-property
You can redefine or `defadvice' this function in order to add
EmacsSpeak support."
- (if erc--compose-text-properties
+ (if erc--merge-text-properties-p
(erc--merge-prop start end property value object)
(put-text-property start end property value object)))
diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el
index e95d99c128f..45ef0d10a6e 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -1206,7 +1206,7 @@ erc-networks--set-name
calls)
(erc-mode)
- (cl-letf (((symbol-function 'erc-display-line)
+ (cl-letf (((symbol-function 'erc--route-insertion)
(lambda (&rest r) (push r calls))))
(ert-info ("Signals when `erc-server-announced-name' unset")
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index 9d3116d3db3..cd28ea54b2e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -149,7 +149,7 @@ erc-scenarios-log--clear-stamp
(when noninteractive (delete-directory tempdir :recursive))))
(ert-deftest erc-scenarios-log--truncate ()
- :tags '(:expensive-test)
+ :tags '(:expensive-test :unstable)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
@@ -180,7 +180,7 @@ erc-scenarios-log--truncate
(should-not (file-exists-p logserv))
(should-not (file-exists-p logchan))
(funcall expect 10 "*** MAXLIST=beI:60")
- (erc-d-t-wait-for 5 (= (pos-bol) (point-min)))
+ (should (= (pos-bol) (point-min)))
(should (file-exists-p logserv))))
(ert-info ("Log file ahead of truncation point")
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b35afaa552f..02dfc55b6d5 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1938,22 +1938,23 @@ erc-format-privmessage
2 5 (erc-speaker "Bob" font-lock-face erc-nick-default-face)
5 12 (font-lock-face erc-default-face))))))
-(ert-deftest erc-display-line ()
+(ert-deftest erc--route-insertion ()
(erc-tests--send-prep)
(erc-tests--set-fake-server-process "sleep" "1")
(setq erc-networks--id (erc-networks--id-create 'foonet))
- (let ((server-buffer (current-buffer))
- (spam-buffer (save-excursion (erc--open-target "#spam")))
- (chan-buffer (save-excursion (erc--open-target "#chan")))
- calls)
- (cl-letf (((symbol-function 'erc-display-line-1)
+ (let* ((erc-modules) ; for `erc--open-target'
+ (server-buffer (current-buffer))
+ (spam-buffer (save-excursion (erc--open-target "#spam")))
+ (chan-buffer (save-excursion (erc--open-target "#chan")))
+ calls)
+ (cl-letf (((symbol-function 'erc-insert-line)
(lambda (&rest r) (push (cons 'line-1 r) calls))))
(with-current-buffer chan-buffer
(ert-info ("Null `buffer' routes to live server-buffer")
- (erc-display-line "null" nil)
+ (erc--route-insertion "null" nil)
(should (equal (pop calls) `(line-1 "null" ,server-buffer)))
(should-not calls))
@@ -1961,14 +1962,14 @@ erc-display-line
;; Copies a let-bound `erc--msg-props' before mutating.
(let* ((table (map-into '(erc-msg msg) 'hash-table))
(erc--msg-props table))
- (erc-display-line "cons" (list server-buffer spam-buffer))
+ (erc--route-insertion "cons" (list server-buffer spam-buffer))
(should-not (eq table erc--msg-props)))
(should (equal (pop calls) `(line-1 "cons" ,spam-buffer)))
(should (equal (pop calls) `(line-1 "cons" ,server-buffer)))
(should-not calls))
(ert-info ("Variant `all' inserts in all session buffers")
- (erc-display-line "all" 'all)
+ (erc--route-insertion "all" 'all)
(should (equal (pop calls) `(line-1 "all" ,chan-buffer)))
(should (equal (pop calls) `(line-1 "all" ,spam-buffer)))
(should (equal (pop calls) `(line-1 "all" ,server-buffer)))
@@ -1977,7 +1978,7 @@ erc-display-line
(ert-info ("Variant `active' routes to active buffer if alive")
(should (eq chan-buffer (erc-with-server-buffer erc-active-buffer)))
(erc-set-active-buffer spam-buffer)
- (erc-display-line "act" 'active)
+ (erc--route-insertion "act" 'active)
(should (equal (pop calls) `(line-1 "act" ,spam-buffer)))
(should (eq (erc-active-buffer) spam-buffer))
(should-not calls))
@@ -1985,7 +1986,7 @@ erc-display-line
(ert-info ("Variant `active' falls back to current buffer")
(should (eq spam-buffer (erc-active-buffer)))
(kill-buffer "#spam")
- (erc-display-line "nact" 'active)
+ (erc--route-insertion "nact" 'active)
(should (equal (pop calls) `(line-1 "nact" ,server-buffer)))
(should (eq (erc-with-server-buffer erc-active-buffer)
server-buffer))
@@ -1993,7 +1994,7 @@ erc-display-line
(ert-info ("Dead single buffer defaults to live server-buffer")
(should-not (get-buffer "#spam"))
- (erc-display-line "dead" 'spam-buffer)
+ (erc--route-insertion "dead" 'spam-buffer)
(should (equal (pop calls) `(line-1 "dead" ,server-buffer)))
(should-not calls))))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 238d8cc73c2..8a6f2289f5d 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index d1ce9198e69..3eb4be4919b 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index d70184724ba..82c6d52cf7c 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +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 one\n<bob> two.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#))
\ No newline at end of file
+#("\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 one\n<bob> two.\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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index def97738ce6..84a1e34670c 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +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" 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 unknown 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 ((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#))
\ No newline at end of file
+#("\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" 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 ((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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index be3e2b33cfd..83394f2f639 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index 098257d0b49..1605628b29f 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index def97738ce6..84a1e34670c 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +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" 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 unknown 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 ((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#))
\ No newline at end of file
+#("\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" 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 ((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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 360b3dafafd..7a7e01de49d 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +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 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 unknown 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
+#("\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 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
index cd3537d3c94..bb248ffb28e 100644
--- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -1 +1 @@
-#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg unknown erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
\ No newline at end of file
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg notice erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Mark-erc-log-test-as-unstable.patch --]
[-- Type: text/x-patch, Size: 4974 bytes --]
From e655a058018d953988608adeed658a854ecdf7e6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 15 Oct 2023 13:43:12 -0700
Subject: [PATCH 1/2] ; Mark erc-log test as :unstable
* test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--truncate):
Mark :unstable for now.
* test/lisp/erc/resources/base/renick/queries/solo.eld: Timeouts.
* test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld: Timeouts.
* test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld: Timeouts.
* test/lisp/erc/resources/erc-scenarios-common.el: Timeouts.
---
test/lisp/erc/erc-scenarios-log.el | 2 +-
test/lisp/erc/resources/base/renick/queries/solo.eld | 2 +-
test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld | 2 +-
test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld | 2 +-
test/lisp/erc/resources/erc-scenarios-common.el | 4 ++--
5 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index f7e7d61c92e..cd28ea54b2e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -149,7 +149,7 @@ erc-scenarios-log--clear-stamp
(when noninteractive (delete-directory tempdir :recursive))))
(ert-deftest erc-scenarios-log--truncate ()
- :tags '(:expensive-test)
+ :tags '(:expensive-test :unstable)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
diff --git a/test/lisp/erc/resources/base/renick/queries/solo.eld b/test/lisp/erc/resources/base/renick/queries/solo.eld
index 12fa7d264e9..fa4c075adac 100644
--- a/test/lisp/erc/resources/base/renick/queries/solo.eld
+++ b/test/lisp/erc/resources/base/renick/queries/solo.eld
@@ -30,7 +30,7 @@
(0 ":irc.foonet.org NOTICE tester :[09:56:57] 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.")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-((mode 1 "MODE #foo")
+((mode 10 "MODE #foo")
(0 ":irc.foonet.org 324 tester #foo +nt")
(0 ":irc.foonet.org 329 tester #foo 1622454985")
(0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.")
diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
index efc2506fd6f..d106a45cf66 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
@@ -56,7 +56,7 @@
(0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!")
(0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620205534")
(0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Chi non te vede, non te pretia.")
diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
index a11cfac2e73..603afa2fc3e 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
@@ -52,7 +52,7 @@
(0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!")
(0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620205534")
(0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Thou desirest me to stop in my tale against the hair.")
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 5354b300b47..9e134e6932f 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -574,7 +574,7 @@ erc-scenarios-common--upstream-reconnect
:password "changeme"
:full-name "tester")
(erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 3 (eq (erc-network) 'foonet))
+ (erc-d-t-wait-for 6 (eq (erc-network) 'foonet))
(erc-d-t-wait-for 3 (string= (buffer-name) "foonet"))
(funcall expect 5 "foonet")))
@@ -713,7 +713,7 @@ erc-scenarios-common--join-network-id
(erc-d-t-wait-for 3 (eq erc-server-process erc-server-process-foo))
(funcall expect 3 "<bob>")
(erc-d-t-absent-for 0.1 "<joe>")
- (funcall expect 10 "not given me")))
+ (funcall expect 20 "not given me")))
(ert-info ("All #chan@barnet output received")
(with-current-buffer chan-buf-bar
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Restore-missing-metadata-props-in-erc-display-li.patch --]
[-- Type: text/x-patch, Size: 72552 bytes --]
From 2288132d2ae82bf6f1af44734306193e86bd90e5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 15 Oct 2023 17:22:22 -0700
Subject: [PATCH 2/2] [5.6] Restore missing metadata props in erc-display-line
* etc/ERC-NEWS: Designate `erc-display-message' as the favored means
of inserting messages.
* lisp/erc/erc-fill.el (erc-fill-wrap): Skip any `unknown' `erc-msg'.
* lisp/erc/erc-stamp.el (erc-stamp--current-time): Use an existing
`erc-ts' text property, when present, for the current message time.
* lisp/erc/erc.el (erc-display-line-1): Update doc string.
(erc-display-line): Convert to a thin wrapper around
`erc-display-message', and move its existing body to a new function,
`erc--route-insertion'.
(erc--route-insertion): Adopt former body of `erc-display-line'. Copy
`erc--msg-props' hash table when inserting a message in multiple
buffers. At present, only `erc-server-QUIT' uses this facility.
Also, improve readability with at most one recursive call for the
fall-through case.
(erc--compose-text-properties, erc--merge-text-properties-p): Rename
former to latter to avoid confusion with `composition' property.
(erc-display-message): Update doc string. Attempt to adapt a non-nil
TYPE parameter for use as the value of the `erc-msg' text property
before resorting to a value of `unknown'. But only do this when
PARSED is nil, and MSG is a string. Call `erc--route-insertion'
instead of `erc-display-line'. Use new name for
`erc--compose-text-properties'.
(erc-put-text-property): Update name of variable
`erc--compose-text-properties'.
* test/lisp/erc-networks-tests.el (erc-networks--set-name): Mock
`erc--route-insertion' instead of `erc-display-line'.
* test/lisp/erc/erc-scenarios-display-message.el: New file.
* test/lisp/erc/erc-tests.el (erc--route-insertion): New test.
* test/lisp/erc/resources/base/display-message/multibuf.eld: New test
data.
* test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update.
* test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update.
* test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: Update.
* test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: Update.
(Bug#60936)
---
etc/ERC-NEWS | 23 +++
lisp/erc/erc-fill.el | 3 +-
lisp/erc/erc-stamp.el | 4 +-
lisp/erc/erc.el | 146 +++++++++++-------
test/lisp/erc/erc-networks-tests.el | 2 +-
.../lisp/erc/erc-scenarios-display-message.el | 64 ++++++++
test/lisp/erc/erc-tests.el | 63 ++++++++
.../base/display-message/multibuf.eld | 45 ++++++
.../fill/snapshots/merge-01-start.eld | 2 +-
.../fill/snapshots/merge-02-right.eld | 2 +-
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../fill/snapshots/spacing-01-mono.eld | 2 +-
.../fill/snapshots/stamps-left-01.eld | 2 +-
17 files changed, 301 insertions(+), 67 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-display-message.el
create mode 100644 test/lisp/erc/resources/base/display-message/multibuf.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 2e56539f210..282a538e04d 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -288,6 +288,29 @@ ERC also provisionally reserves the same depth interval for
continue to modify non-ERC hooks locally whenever possible, especially
in new code.
+*** Message insertion function 'erc-display-message' heavily favored.
+Displaying "local" messages, like help text and interactive-command
+feedback, in ERC buffers has never been straightforward. As such,
+ancient patterns, like the pairing of preformatted "notice" text with
+ERC's oldest insertion function, 'erc-display-line', still appear
+quite frequently in the wild despite having been largely phased out of
+ERC's own code base in 2002. That this specific example has endured
+makes some sense because it's probably seen as less cumbersome than
+fiddling with the more powerful and complicated 'erc-display-message'.
+
+The latest twist in this saga comes with this release, in which a
+healthy dose of \"pre-insertion business\" has been invited to take up
+residence in 'erc-display-message'. While this would seem to put
+antiquated patterns, like the above mentioned 'erc-make-notice' combo,
+at risk of having messages ignored or subject to degraded treatment by
+built-in modules, a prophylactic measure has been erected to recast
+'erc-display-line' as a thin wrapper around 'erc-display-message'.
+And though nothing of the sort has been done for the lower-level
+'erc-display-line-1' (now an obsolete alias for 'erc-insert-line'),
+some fallback code has been put in place to ensure baseline
+functionality. As always, if you find these developments disturbing,
+please say so on the tracker.
+
*** ERC now manages timestamp-related properties a bit differently.
For starters, the 'cursor-sensor-functions' text property is absent by
default unless the option 'erc-echo-timestamps' is already enabled on
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 0048956e075..e28c3563ebf 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -539,7 +539,8 @@ erc-fill-wrap
(goto-char (point-min))
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
- (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg)))
+ (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg))
+ ((not (eq msg-prop 'unknown))))
(when-let ((e (erc--get-speaker-bounds))
(b (pop e))
((or erc-fill--wrap-action-dedent-p
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 394643c03cb..57fd7f39e50 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -219,7 +219,9 @@ erc-stamp--current-time
(erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
- (or erc-stamp--current-time (cl-call-next-method)))
+ (or erc-stamp--current-time
+ (and erc--msg-props (gethash 'erc-ts erc--msg-props))
+ (cl-call-next-method)))
(defvar erc-stamp--skip nil
"Non-nil means inhibit `erc-add-timestamp' completely.")
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5bf6496e926..0513a5c785c 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3003,13 +3003,26 @@ erc--traverse-inserted
(defvar erc--insert-marker nil
"Internal override for `erc-insert-marker'.")
-(defun erc-display-line-1 (string buffer)
- "Display STRING in `erc-mode' BUFFER.
-Auxiliary function used in `erc-display-line'. The line gets filtered to
-interpret the control characters. Then, `erc-insert-pre-hook' gets called.
-If `erc-insert-this' is still t, STRING gets inserted into the buffer.
-Afterwards, `erc-insert-modify' and `erc-insert-post-hook' get called.
-If STRING is nil, the function does nothing."
+(define-obsolete-function-alias 'erc-display-line-1 'erc-insert-line "30.1")
+(defun erc-insert-line (string buffer)
+ "Insert STRING in an `erc-mode' BUFFER.
+When STRING is nil, do nothing. Otherwise, start off by running
+`erc-insert-pre-hook' in BUFFER with `erc-insert-this' bound to
+t. If the latter remains non-nil afterward, insert STRING into
+BUFFER, ensuring a trailing newline. After that, narrow BUFFER
+around STRING, along with its final line ending, and run
+`erc-insert-modify' and `erc-insert-post-hook', respectively. In
+all cases, run `erc-insert-done-hook' unnarrowed before exiting,
+and update positions in `buffer-undo-list'.
+
+In general, expect to be called from a higher-level insertion
+function, like `erc-display-message', especially when modules
+should consider STRING as a candidate for formatting with
+enhancements like indentation, fontification, timestamping, etc.
+Otherwise, when called directly, allow built-in modules to ignore
+STRING, which may make it appear incongruous in situ (unless
+preformatted or anticipated by third-party members of the various
+modification hooks)."
(when string
(with-current-buffer (or buffer (process-buffer erc-server-process))
(let ((insert-position (marker-position erc-insert-marker)))
@@ -3021,7 +3034,7 @@ erc-display-line-1
(when (erc-string-invisible-p string)
(erc-put-text-properties 0 (length string)
'(invisible intangible) string)))
- (erc-log (concat "erc-display-line: " string
+ (erc-log (concat "erc-display-message: " string
(format "(%S)" string) " in buffer "
(format "%s" buffer)))
(setq erc-insert-this t)
@@ -3091,39 +3104,45 @@ erc-is-valid-nick-p
"Check if NICK is a valid IRC nickname."
(string-match (concat "\\`" erc-valid-nick-regexp "\\'") nick))
-(defun erc-display-line (string &optional buffer)
- "Display STRING in the ERC BUFFER.
-All screen output must be done through this function. If BUFFER is nil
-or omitted, the default ERC buffer for the `erc-session-server' is used.
-The BUFFER can be an actual buffer, a list of buffers, `all' or `active'.
-If BUFFER = `all', the string is displayed in all the ERC buffers for the
-current session. `active' means the current active buffer
-\(`erc-active-buffer'). If the buffer can't be resolved, the current
-buffer is used. `erc-display-line-1' is used to display STRING.
-
-If STRING is nil, the function does nothing."
- (let (new-bufs)
+(defun erc--route-insertion (string buffer)
+ "Insert STRING in BUFFER.
+See `erc-display-message' for acceptable BUFFER types."
+ (let (seen msg-props)
(dolist (buf (cond
((bufferp buffer) (list buffer))
- ((listp buffer) buffer)
+ ((consp buffer)
+ (setq msg-props erc--msg-props)
+ buffer)
((processp buffer) (list (process-buffer buffer)))
((eq 'all buffer)
;; Hmm, or all of the same session server?
(erc-buffer-list nil erc-server-process))
- ((and (eq 'active buffer) (erc-active-buffer))
- (list (erc-active-buffer)))
+ ((and-let* (((eq 'active buffer))
+ (b (erc-active-buffer)))
+ (list b)))
((erc-server-buffer-live-p)
(list (process-buffer erc-server-process)))
(t (list (current-buffer)))))
(when (buffer-live-p buf)
- (erc-display-line-1 string buf)
- (push buf new-bufs)))
- (when (null new-bufs)
- (erc-display-line-1 string (if (erc-server-buffer-live-p)
- (process-buffer erc-server-process)
- (current-buffer))))))
-
-(defvar erc--compose-text-properties nil
+ (when msg-props
+ (setq erc--msg-props (copy-hash-table msg-props)))
+ (erc-insert-line string buf)
+ (setq seen t)))
+ (unless (or seen (null buffer))
+ (erc--route-insertion string nil))))
+
+(defun erc-display-line (string &optional buffer)
+ "Insert STRING in BUFFER as a plain \"local\" message.
+Take pains to ensure modification hooks see messages created by
+the old pattern (erc-display-line (erc-make-notice) my-buffer) as
+being equivalent to a `erc-display-message' TYPE of `notice'."
+ (let ((erc--msg-prop-overrides erc--msg-prop-overrides))
+ (when (eq 'erc-notice-face (get-text-property 0 'font-lock-face string))
+ (unless (assq 'erc-msg erc--msg-prop-overrides)
+ (push '(erc-msg . notice) erc--msg-prop-overrides)))
+ (erc-display-message nil nil buffer string)))
+
+(defvar erc--merge-text-properties-p nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
;; To save space, we could maintain a map of all readable property
@@ -3432,14 +3451,24 @@ erc-display-message
Insert MSG or text derived from MSG into an ERC buffer, possibly
after applying formatting by way of either a `format-spec' known
to a message-catalog entry or a TYPE known to a specialized
-string handler. Additionally, derive internal metadata, faces,
-and other text properties from the various overloaded parameters,
-such as PARSED, when it's an `erc-response' object, and MSG, when
-it's a key (symbol) for a \"message catalog\" entry. Expect
-ARGS, when applicable, to be `format-spec' args known to such an
-entry, and TYPE, when non-nil, to be a symbol handled by
+string handler. Additionally, derive metadata, faces, and other
+text properties from the various overloaded parameters, such as
+PARSED, when it's an `erc-response' object, and MSG, when it's a
+key (symbol) for a \"message catalog\" entry. Expect ARGS, when
+applicable, to be `format-spec' args known to such an entry, and
+TYPE, when non-nil, to be a symbol handled by
`erc-display-message-highlight' (necessarily accompanied by a
-string MSG).
+string MSG). Expect BUFFER to be among the sort accepted by the
+function `erc-display-line'.
+
+Expect BUFFER to be a live `erc-mode' buffer, a list of such
+buffers, or the symbols `all' or `active'. If `all', insert
+STRING in all buffers for the current session. If `active',
+defer to the function `erc-active-buffer', which may return the
+session's server buffer if the previously active buffer has been
+killed. If BUFFER is nil or a network process, pretend it's set
+to the appropriate server buffer. Otherwise, use the current
+buffer.
When TYPE is a list of symbols, call handlers from left to right
without influencing how they behave when encountering existing
@@ -3451,24 +3480,31 @@ erc-display-message
being (erc-error-face erc-notice-face) throughout MSG when
`erc-notice-highlight-type' is left at its default, `all'.
-As of ERC 5.6, assume user code will use this function instead of
-`erc-display-line' when it's important that insert hooks treat
-MSG in a manner befitting messages received from a server. That
-is, expect to process most nontrivial informational messages, for
-which PARSED is typically nil, when the caller desires
-buttonizing and other effects."
+As of ERC 5.6, assume third-party code will use this function
+instead of lower-level ones, like `erc-insert-line', when needing
+ERC to process arbitrary informative messages as if they'd been
+sent from a server. That is, guarantee \"local\" messages, for
+which PARSED is typically nil, will be subject to buttonizing,
+filling, and other effects."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
msg))
(erc--msg-props
(or erc--msg-props
- (let* ((table (make-hash-table :size 5))
- (cmd (and parsed (erc--get-eq-comparable-cmd
- (erc-response.command parsed))))
- (m (cond ((and msg (symbolp msg)) msg)
- ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
- (t 'unknown))))
- (puthash 'erc-msg m table)
+ (let ((table (make-hash-table :size 5))
+ (cmd (and parsed (erc--get-eq-comparable-cmd
+ (erc-response.command parsed)))))
+ (puthash 'erc-msg
+ (cond ((and msg (symbolp msg)) msg)
+ ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
+ (type (pcase type
+ ((pred symbolp) type)
+ ((pred listp)
+ (intern (mapconcat #'prin1-to-string
+ type "-")))
+ (_ 'unknown)))
+ (t 'unknown))
+ table)
(when cmd
(puthash 'erc-cmd cmd table))
(and erc--msg-prop-overrides
@@ -3481,7 +3517,7 @@ erc-display-message
((null type)
string)
((listp type)
- (let ((erc--compose-text-properties
+ (let ((erc--merge-text-properties-p
(and (eq (car type) t) (setq type (cdr type)))))
(dolist (type type)
(setq string (erc-display-message-highlight type string))))
@@ -3490,13 +3526,13 @@ erc-display-message
(erc-display-message-highlight type string))))
(if (not (erc-response-p parsed))
- (erc-display-line string buffer)
+ (erc--route-insertion string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
- (erc-display-line string buffer)))))
+ (erc--route-insertion string buffer)))))
(defun erc-message-type-member (position list)
"Return non-nil if the erc-parsed text-property at POSITION is in LIST.
@@ -6481,7 +6517,7 @@ erc-put-text-property
You can redefine or `defadvice' this function in order to add
EmacsSpeak support."
- (if erc--compose-text-properties
+ (if erc--merge-text-properties-p
(erc--merge-prop start end property value object)
(put-text-property start end property value object)))
diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el
index e95d99c128f..45ef0d10a6e 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -1206,7 +1206,7 @@ erc-networks--set-name
calls)
(erc-mode)
- (cl-letf (((symbol-function 'erc-display-line)
+ (cl-letf (((symbol-function 'erc--route-insertion)
(lambda (&rest r) (push r calls))))
(ert-info ("Signals when `erc-server-announced-name' unset")
diff --git a/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el
new file mode 100644
index 00000000000..51bdf305ad5
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-display-message.el
@@ -0,0 +1,64 @@
+;;; erc-scenarios-display-message.el --- erc-display-message -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(ert-deftest erc-scenarios-display-message--multibuf ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/display-message")
+ (dumb-server (erc-d-run "localhost" t 'multibuf))
+ (port (process-contact dumb-server :service))
+ (erc-server-flood-penalty 0.1)
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-autojoin-channels-alist '((foonet "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 10 "debug mode")))
+
+ (ert-info ("User dummy is a member of #chan")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (funcall expect 10 "dummy")))
+
+ (ert-info ("Dummy's QUIT notice in query contains metadata props")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "dummy"))
+ (funcall expect 10 "<dummy> hi")
+ (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
+ (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
+
+ (ert-info ("Dummy's QUIT notice in #chan contains metadata props")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
+ (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
+
+ (erc-cmd-QUIT "")))
+
+(eval-when-compile (require 'erc-join))
+
+;;; erc-scenarios-display-message.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 4f4662f5075..02dfc55b6d5 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1938,6 +1938,69 @@ erc-format-privmessage
2 5 (erc-speaker "Bob" font-lock-face erc-nick-default-face)
5 12 (font-lock-face erc-default-face))))))
+(ert-deftest erc--route-insertion ()
+ (erc-tests--send-prep)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (setq erc-networks--id (erc-networks--id-create 'foonet))
+
+ (let* ((erc-modules) ; for `erc--open-target'
+ (server-buffer (current-buffer))
+ (spam-buffer (save-excursion (erc--open-target "#spam")))
+ (chan-buffer (save-excursion (erc--open-target "#chan")))
+ calls)
+ (cl-letf (((symbol-function 'erc-insert-line)
+ (lambda (&rest r) (push (cons 'line-1 r) calls))))
+
+ (with-current-buffer chan-buffer
+
+ (ert-info ("Null `buffer' routes to live server-buffer")
+ (erc--route-insertion "null" nil)
+ (should (equal (pop calls) `(line-1 "null" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Cons `buffer' routes to live members")
+ ;; Copies a let-bound `erc--msg-props' before mutating.
+ (let* ((table (map-into '(erc-msg msg) 'hash-table))
+ (erc--msg-props table))
+ (erc--route-insertion "cons" (list server-buffer spam-buffer))
+ (should-not (eq table erc--msg-props)))
+ (should (equal (pop calls) `(line-1 "cons" ,spam-buffer)))
+ (should (equal (pop calls) `(line-1 "cons" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Variant `all' inserts in all session buffers")
+ (erc--route-insertion "all" 'all)
+ (should (equal (pop calls) `(line-1 "all" ,chan-buffer)))
+ (should (equal (pop calls) `(line-1 "all" ,spam-buffer)))
+ (should (equal (pop calls) `(line-1 "all" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Variant `active' routes to active buffer if alive")
+ (should (eq chan-buffer (erc-with-server-buffer erc-active-buffer)))
+ (erc-set-active-buffer spam-buffer)
+ (erc--route-insertion "act" 'active)
+ (should (equal (pop calls) `(line-1 "act" ,spam-buffer)))
+ (should (eq (erc-active-buffer) spam-buffer))
+ (should-not calls))
+
+ (ert-info ("Variant `active' falls back to current buffer")
+ (should (eq spam-buffer (erc-active-buffer)))
+ (kill-buffer "#spam")
+ (erc--route-insertion "nact" 'active)
+ (should (equal (pop calls) `(line-1 "nact" ,server-buffer)))
+ (should (eq (erc-with-server-buffer erc-active-buffer)
+ server-buffer))
+ (should-not calls))
+
+ (ert-info ("Dead single buffer defaults to live server-buffer")
+ (should-not (get-buffer "#spam"))
+ (erc--route-insertion "dead" 'spam-buffer)
+ (should (equal (pop calls) `(line-1 "dead" ,server-buffer)))
+ (should-not calls))))
+
+ (should-not (buffer-live-p spam-buffer))
+ (kill-buffer chan-buffer)))
+
(defvar erc-tests--ipv6-examples
'("1:2:3:4:5:6:7:8"
"::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0"
diff --git a/test/lisp/erc/resources/base/display-message/multibuf.eld b/test/lisp/erc/resources/base/display-message/multibuf.eld
new file mode 100644
index 00000000000..e49a654cd06
--- /dev/null
+++ b/test/lisp/erc/resources/base/display-message/multibuf.eld
@@ -0,0 +1,45 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
+ (0.01 ":irc.foonet.org 003 tester :This server was created Sat, 14 Oct 2023 16:08:20 UTC")
+ (0.02 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
+ (0.00 ":irc.foonet.org 251 tester :There are 0 users and 5 invisible on 1 server(s)")
+ (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0.00 ":irc.foonet.org 254 tester 2 :channels formed")
+ (0.00 ":irc.foonet.org 255 tester :I have 5 clients and 0 servers")
+ (0.00 ":irc.foonet.org 265 tester 5 5 :Current local users 5, max 5")
+ (0.02 ":irc.foonet.org 266 tester 5 5 :Current global users 5, max 5")
+ (0.01 ":irc.foonet.org 422 tester :MOTD File is missing")
+ (0.00 ":irc.foonet.org 221 tester +i")
+ (0.01 ":irc.foonet.org NOTICE tester :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."))
+
+((mode 10 "MODE tester +i")
+ (0.00 ":irc.foonet.org 221 tester +i"))
+
+((join 10 "JOIN #chan")
+ (0.03 ":tester!~u@rdjcgiwfuwqmc.irc JOIN #chan")
+ (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice dummy tester")
+ (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (0.00 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!")
+ (0.01 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!"))
+
+((mode 10 "MODE #chan")
+ (0.01 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: Persuade this rude wretch willingly to die.")
+ (0.01 ":irc.foonet.org 324 tester #chan +Cnt")
+ (0.01 ":irc.foonet.org 329 tester #chan 1697299707")
+ (0.03 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :bob: It might be yours or hers, for aught I know.")
+ (0.07 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :Would all themselves laugh mortal.")
+ (0.04 ":dummy!~u@rdjcgiwfuwqmc.irc PRIVMSG tester :hi")
+ (0.06 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: It hath pleased the devil drunkenness to give place to the devil wrath; one unperfectness shows me another, to make me frankly despise myself.")
+ (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)")
+ (0.08 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :You speak of him when he was less furnished than now he is with that which makes him both without and within."))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.04 ":tester!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)")
+ (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)"))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 238d8cc73c2..8a6f2289f5d 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index d1ce9198e69..3eb4be4919b 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index d70184724ba..82c6d52cf7c 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +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 one\n<bob> two.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#))
\ No newline at end of file
+#("\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 one\n<bob> two.\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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index def97738ce6..84a1e34670c 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +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" 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 unknown 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 ((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#))
\ No newline at end of file
+#("\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" 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 ((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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index be3e2b33cfd..83394f2f639 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index 098257d0b49..1605628b29f 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index def97738ce6..84a1e34670c 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +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" 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 unknown 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 ((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#))
\ No newline at end of file
+#("\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" 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 ((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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 360b3dafafd..7a7e01de49d 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +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 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 unknown 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
+#("\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 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
index cd3537d3c94..bb248ffb28e 100644
--- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -1 +1 @@
-#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg unknown erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
\ No newline at end of file
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg notice erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-10-17 13:48 ` J.P.
@ 2023-10-19 14:02 ` J.P.
[not found] ` <877cniaewr.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-19 14:02 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 715 bytes --]
v3 (erc-display-line redux). Properly offset renarrowed region after
inserting initial date stamp in `erc-insert-timestamp-left-and-right'.
Don't displace third-party markers when inserting left-sided stamps in
`erc-stamp--display-margin-mode'.
The first bug was introduced by
c68dc7786fc * Manage some text props for ERC insertion-hook members
and causes right-sided stamps to appear inside the prompt, among other
unpleasant things (see third patch). Thanks to Corwin for spotting this.
The other bug has been around a bit longer, likely since
63d8b2a59a4 * Make erc-fill-wrap work with left-sided stamps
It has the potential to break packages that place markers in
modification hooks (see last patch).
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 11786 bytes --]
From 15f2e73c4022edc1d5ba0ad9c2dea69bbabe3a97 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 19 Oct 2023 06:20:30 -0700
Subject: [PATCH 0/4] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (4):
; Mark erc-log test as :unstable
[5.6] Restore missing metadata props in erc-display-line
[5.6] Fix right stamps commingling with erc-prompt
[5.6] Respect user markers in erc--insert-timestamp-left
etc/ERC-NEWS | 23 +++
lisp/erc/erc-fill.el | 3 +-
lisp/erc/erc-stamp.el | 20 ++-
lisp/erc/erc.el | 146 +++++++++++-------
test/lisp/erc/erc-fill-tests.el | 57 +++----
test/lisp/erc/erc-networks-tests.el | 2 +-
.../lisp/erc/erc-scenarios-display-message.el | 64 ++++++++
test/lisp/erc/erc-scenarios-log.el | 2 +-
test/lisp/erc/erc-scenarios-stamp.el | 90 +++++++++++
test/lisp/erc/erc-tests.el | 63 ++++++++
.../base/display-message/multibuf.eld | 45 ++++++
.../resources/base/renick/queries/solo.eld | 2 +-
.../base/reuse-buffers/channel/barnet.eld | 2 +-
.../base/reuse-buffers/channel/foonet.eld | 2 +-
.../erc/resources/erc-scenarios-common.el | 4 +-
.../fill/snapshots/merge-01-start.eld | 2 +-
.../fill/snapshots/merge-02-right.eld | 2 +-
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../fill/snapshots/spacing-01-mono.eld | 2 +-
.../fill/snapshots/stamps-left-01.eld | 2 +-
24 files changed, 437 insertions(+), 106 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-display-message.el
create mode 100644 test/lisp/erc/erc-scenarios-stamp.el
create mode 100644 test/lisp/erc/resources/base/display-message/multibuf.eld
Interdiff:
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 57fd7f39e50..b515513dcb7 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -492,8 +492,11 @@ erc--conceal-prompt
(put-text-property erc-insert-marker (1- erc-input-marker)
'display `((margin left-margin) ,prompt))))
-(cl-defmethod erc-insert-timestamp-left (string)
+(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
+ (erc--insert-timestamp-left string))
+
+(cl-defmethod erc--insert-timestamp-left (string)
(goto-char (point-min))
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted)))
@@ -504,13 +507,12 @@ erc-insert-timestamp-left
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
-(cl-defmethod erc-insert-timestamp-left
+(cl-defmethod erc--insert-timestamp-left
(string &context (erc-stamp--display-margin-mode (eql t)))
(unless (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted))
(goto-char (point-min))
- (insert-before-markers-and-inherit
- (setq erc-timestamp-last-inserted string))
+ (insert-and-inherit (setq erc-timestamp-last-inserted string))
(dolist (p erc-stamp--inherited-props)
(when-let ((v (get-text-property (point) p)))
(put-text-property (point-min) (point) p v)))
@@ -704,10 +706,12 @@ erc-insert-timestamp-left-and-right
(unless erc-stamp--date-format-end
(add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t)
(add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t)
- (let ((erc--insert-marker (point-min-marker)))
+ (let ((erc--insert-marker (point-min-marker))
+ (end-marker (point-max-marker)))
(set-marker-insertion-type erc--insert-marker t)
(erc-stamp--lr-date-on-pre-modify nil)
- (narrow-to-region erc--insert-marker (point-max))
+ (narrow-to-region erc--insert-marker end-marker)
+ (set-marker end-marker nil)
(set-marker erc--insert-marker nil)))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
(ts-right (with-suppressed-warnings
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index f6c4c268017..80f5fd22ac6 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -203,36 +203,39 @@ erc-fill-wrap--monospace
(unless (>= emacs-major-version 29)
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
- (erc-fill-tests--wrap-populate
-
- (lambda ()
- (should (= erc-fill--wrap-value 27))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-01-start")
-
- (ert-info ("Shift right by one (plus)")
- ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p"
- (ert-with-message-capture messages
- ;; M-x erc-fill-wrap-nudge RET =
- (ert-simulate-command '(erc-fill-wrap-nudge 2))
- (should (string-match (rx "for further adjustment") messages)))
- (should (= erc-fill--wrap-value 29))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-02-right"))
-
- (ert-info ("Shift left by five")
- ;; "M-x erc-fill-wrap-nudge RET -----"
- (ert-simulate-command '(erc-fill-wrap-nudge -4))
- (should (= erc-fill--wrap-value 25))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-03-left"))
+ (let ((erc-prompt (lambda () "ABC>")))
+ (erc-fill-tests--wrap-populate
- (ert-info ("Reset")
- ;; M-x erc-fill-wrap-nudge RET 0
- (ert-simulate-command '(erc-fill-wrap-nudge 0))
+ (lambda ()
(should (= erc-fill--wrap-value 27))
(erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-04-reset")))))
+ (erc-fill-tests--compare "monospace-01-start")
+
+ (ert-info ("Shift right by one (plus)")
+ ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p"
+ (ert-with-message-capture messages
+ ;; M-x erc-fill-wrap-nudge RET =
+ (ert-simulate-command '(erc-fill-wrap-nudge 2))
+ (should (string-match (rx "for further adjustment") messages)))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-02-right"))
+
+ (ert-info ("Shift left by five")
+ ;; "M-x erc-fill-wrap-nudge RET -----"
+ (ert-simulate-command '(erc-fill-wrap-nudge -4))
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-03-left"))
+
+ (ert-info ("Reset")
+ ;; M-x erc-fill-wrap-nudge RET 0
+ (ert-simulate-command '(erc-fill-wrap-nudge 0))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-04-reset"))
+
+ (erc--assert-input-bounds)))))
(defun erc-fill-tests--simulate-refill ()
;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without
diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el
new file mode 100644
index 00000000000..d6b5d868ce5
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-stamp.el
@@ -0,0 +1,90 @@
+;;; erc-scenarios-stamp.el --- Misc `erc-stamp' scenarios -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-stamp)
+
+(defvar erc-scenarios-stamp--user-marker nil)
+
+(defun erc-scenarios-stamp--on-post-modify ()
+ (when-let (((erc--check-msg-prop 'erc-cmd 4)))
+ (set-marker erc-scenarios-stamp--user-marker (point-max))
+ (ert-info ("User marker correctly placed at `erc-insert-marker'")
+ (should (= ?\n (char-before erc-scenarios-stamp--user-marker)))
+ (should (= erc-scenarios-stamp--user-marker erc-insert-marker))
+ (save-excursion
+ (goto-char erc-scenarios-stamp--user-marker)
+ ;; The raw message ends in " Iabefhkloqv". However,
+ ;; `erc-server-004' only prints up to the 5th parameter.
+ (should (looking-back "CEIMRUabefhiklmnoqstuv\n"))))))
+
+(ert-deftest erc-scenarios-stamp--left/display-margin-mode ()
+
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reconnect")
+ (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
+ (port (process-contact dumb-server :service))
+ (erc-scenarios-stamp--user-marker (make-marker))
+ (erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-server-flood-penalty 0.1)
+ (erc-timestamp-only-if-changed-flag nil)
+ (erc-insert-timestamp-function #'erc-insert-timestamp-left)
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-timestamp-only-if-changed-flag nil)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :full-name "tester"
+ :nick "tester")
+
+ (add-hook 'erc-insert-post-hook #'erc-scenarios-stamp--on-post-modify
+ nil t)
+ (funcall expect 5 "This server is in debug mode")
+
+ (ert-info ("Stamps appear in left margin and are invisible")
+ (should (eq 'erc-timestamp (field-at-pos (pos-bol))))
+ (should (= (pos-bol) (field-beginning (pos-bol))))
+ (should (eq 'msg (get-text-property (pos-bol) 'erc-msg)))
+ (should (eq 'NOTICE (get-text-property (pos-bol) 'erc-cmd)))
+ (should (= ?- (char-after (field-end (pos-bol)))))
+ (should (equal (get-text-property (1+ (field-end (pos-bol)))
+ 'erc-speaker)
+ "irc.foonet.org"))
+ (should (pcase (get-text-property (pos-bol) 'display)
+ (`((margin left-margin) ,s)
+ (eq 'timestamp (get-text-property 0 'invisible s))))))
+
+ ;; We set a third-party marker at the end of 004's message (on
+ ;; then "\n"), post-insertion.
+ (ert-info ("User markers untouched by subsequent message left stamp")
+ (save-excursion
+ (goto-char erc-scenarios-stamp--user-marker)
+ (should (looking-back "CEIMRUabefhiklmnoqstuv\n"))
+ (should (looking-at (rx "[")))))))))
+
+;;; erc-scenarios-stamp.el ends here
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Mark-erc-log-test-as-unstable.patch --]
[-- Type: text/x-patch, Size: 4974 bytes --]
From 943d2abafe5f16c77f540b48d686d50e85fd52e7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 15 Oct 2023 13:43:12 -0700
Subject: [PATCH 1/4] ; Mark erc-log test as :unstable
* test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--truncate):
Mark :unstable for now.
* test/lisp/erc/resources/base/renick/queries/solo.eld: Timeouts.
* test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld: Timeouts.
* test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld: Timeouts.
* test/lisp/erc/resources/erc-scenarios-common.el: Timeouts.
---
test/lisp/erc/erc-scenarios-log.el | 2 +-
test/lisp/erc/resources/base/renick/queries/solo.eld | 2 +-
test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld | 2 +-
test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld | 2 +-
test/lisp/erc/resources/erc-scenarios-common.el | 4 ++--
5 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index f7e7d61c92e..cd28ea54b2e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -149,7 +149,7 @@ erc-scenarios-log--clear-stamp
(when noninteractive (delete-directory tempdir :recursive))))
(ert-deftest erc-scenarios-log--truncate ()
- :tags '(:expensive-test)
+ :tags '(:expensive-test :unstable)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
diff --git a/test/lisp/erc/resources/base/renick/queries/solo.eld b/test/lisp/erc/resources/base/renick/queries/solo.eld
index 12fa7d264e9..fa4c075adac 100644
--- a/test/lisp/erc/resources/base/renick/queries/solo.eld
+++ b/test/lisp/erc/resources/base/renick/queries/solo.eld
@@ -30,7 +30,7 @@
(0 ":irc.foonet.org NOTICE tester :[09:56:57] 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.")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-((mode 1 "MODE #foo")
+((mode 10 "MODE #foo")
(0 ":irc.foonet.org 324 tester #foo +nt")
(0 ":irc.foonet.org 329 tester #foo 1622454985")
(0.1 ":alice!~u@gq7yjr7gsu7nn.irc PRIVMSG #foo :bob: Farewell, pretty lady: you must hold the credit of your father.")
diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
index efc2506fd6f..d106a45cf66 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/channel/barnet.eld
@@ -56,7 +56,7 @@
(0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!")
(0 ":joe!~u@wvys46tx8tpmk.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620205534")
(0.1 ":mike!~u@wvys46tx8tpmk.irc PRIVMSG #chan :joe: Chi non te vede, non te pretia.")
diff --git a/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld b/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
index a11cfac2e73..603afa2fc3e 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/channel/foonet.eld
@@ -52,7 +52,7 @@
(0.1 ":alice!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!")
(0 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620205534")
(0.1 ":bob!~u@yppdd5tt4admc.irc PRIVMSG #chan :alice: Thou desirest me to stop in my tale against the hair.")
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 5354b300b47..9e134e6932f 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -574,7 +574,7 @@ erc-scenarios-common--upstream-reconnect
:password "changeme"
:full-name "tester")
(erc-scenarios-common-assert-initial-buf-name nil port)
- (erc-d-t-wait-for 3 (eq (erc-network) 'foonet))
+ (erc-d-t-wait-for 6 (eq (erc-network) 'foonet))
(erc-d-t-wait-for 3 (string= (buffer-name) "foonet"))
(funcall expect 5 "foonet")))
@@ -713,7 +713,7 @@ erc-scenarios-common--join-network-id
(erc-d-t-wait-for 3 (eq erc-server-process erc-server-process-foo))
(funcall expect 3 "<bob>")
(erc-d-t-absent-for 0.1 "<joe>")
- (funcall expect 10 "not given me")))
+ (funcall expect 20 "not given me")))
(ert-info ("All #chan@barnet output received")
(with-current-buffer chan-buf-bar
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Restore-missing-metadata-props-in-erc-display-li.patch --]
[-- Type: text/x-patch, Size: 72556 bytes --]
From 3996279b48589764c07329c63a39aa573546b7b5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 15 Oct 2023 17:22:22 -0700
Subject: [PATCH 2/4] [5.6] Restore missing metadata props in erc-display-line
* etc/ERC-NEWS: Designate `erc-display-message' as the favored means
of inserting messages.
* lisp/erc/erc-fill.el (erc-fill-wrap): Skip any `unknown' `erc-msg'.
* lisp/erc/erc-stamp.el (erc-stamp--current-time): Use an existing
`erc-ts' text property, when present, for the current message time.
* lisp/erc/erc.el (erc-display-line-1): Update doc string.
(erc-display-line): Convert to a thin wrapper around
`erc-display-message', and move its existing body to a new function,
`erc--route-insertion'.
(erc--route-insertion): Adopt former body of `erc-display-line'. Copy
`erc--msg-props' hash table when inserting a message in multiple
buffers. At present, only `erc-server-QUIT' uses this facility.
Also, improve readability with at most one recursive call for the
fall-through case.
(erc--compose-text-properties, erc--merge-text-properties-p): Rename
former to latter to avoid confusion with `composition' property.
(erc-display-message): Update doc string. Attempt to adapt a non-nil
TYPE parameter for use as the value of the `erc-msg' text property
before resorting to a value of `unknown'. But only do this when
PARSED is nil, and MSG is a string. Call `erc--route-insertion'
instead of `erc-display-line'. Use new name for
`erc--compose-text-properties'.
(erc-put-text-property): Update name of variable
`erc--compose-text-properties'.
* test/lisp/erc/erc-networks-tests.el (erc-networks--set-name): Mock
`erc--route-insertion' instead of `erc-display-line'.
* test/lisp/erc/erc-scenarios-display-message.el: New file.
* test/lisp/erc/erc-tests.el (erc--route-insertion): New test.
* test/lisp/erc/resources/base/display-message/multibuf.eld: New test
data.
* test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update.
* test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update.
* test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: Update.
* test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: Update.
* test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: Update.
(Bug#60936)
---
etc/ERC-NEWS | 23 +++
lisp/erc/erc-fill.el | 3 +-
lisp/erc/erc-stamp.el | 4 +-
lisp/erc/erc.el | 146 +++++++++++-------
test/lisp/erc/erc-networks-tests.el | 2 +-
.../lisp/erc/erc-scenarios-display-message.el | 64 ++++++++
test/lisp/erc/erc-tests.el | 63 ++++++++
.../base/display-message/multibuf.eld | 45 ++++++
.../fill/snapshots/merge-01-start.eld | 2 +-
.../fill/snapshots/merge-02-right.eld | 2 +-
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../fill/snapshots/spacing-01-mono.eld | 2 +-
.../fill/snapshots/stamps-left-01.eld | 2 +-
17 files changed, 301 insertions(+), 67 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-display-message.el
create mode 100644 test/lisp/erc/resources/base/display-message/multibuf.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 2e56539f210..282a538e04d 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -288,6 +288,29 @@ ERC also provisionally reserves the same depth interval for
continue to modify non-ERC hooks locally whenever possible, especially
in new code.
+*** Message insertion function 'erc-display-message' heavily favored.
+Displaying "local" messages, like help text and interactive-command
+feedback, in ERC buffers has never been straightforward. As such,
+ancient patterns, like the pairing of preformatted "notice" text with
+ERC's oldest insertion function, 'erc-display-line', still appear
+quite frequently in the wild despite having been largely phased out of
+ERC's own code base in 2002. That this specific example has endured
+makes some sense because it's probably seen as less cumbersome than
+fiddling with the more powerful and complicated 'erc-display-message'.
+
+The latest twist in this saga comes with this release, in which a
+healthy dose of \"pre-insertion business\" has been invited to take up
+residence in 'erc-display-message'. While this would seem to put
+antiquated patterns, like the above mentioned 'erc-make-notice' combo,
+at risk of having messages ignored or subject to degraded treatment by
+built-in modules, a prophylactic measure has been erected to recast
+'erc-display-line' as a thin wrapper around 'erc-display-message'.
+And though nothing of the sort has been done for the lower-level
+'erc-display-line-1' (now an obsolete alias for 'erc-insert-line'),
+some fallback code has been put in place to ensure baseline
+functionality. As always, if you find these developments disturbing,
+please say so on the tracker.
+
*** ERC now manages timestamp-related properties a bit differently.
For starters, the 'cursor-sensor-functions' text property is absent by
default unless the option 'erc-echo-timestamps' is already enabled on
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 0048956e075..e28c3563ebf 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -539,7 +539,8 @@ erc-fill-wrap
(goto-char (point-min))
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
- (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg)))
+ (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg))
+ ((not (eq msg-prop 'unknown))))
(when-let ((e (erc--get-speaker-bounds))
(b (pop e))
((or erc-fill--wrap-action-dedent-p
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 394643c03cb..57fd7f39e50 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -219,7 +219,9 @@ erc-stamp--current-time
(erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
- (or erc-stamp--current-time (cl-call-next-method)))
+ (or erc-stamp--current-time
+ (and erc--msg-props (gethash 'erc-ts erc--msg-props))
+ (cl-call-next-method)))
(defvar erc-stamp--skip nil
"Non-nil means inhibit `erc-add-timestamp' completely.")
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5bf6496e926..0513a5c785c 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3003,13 +3003,26 @@ erc--traverse-inserted
(defvar erc--insert-marker nil
"Internal override for `erc-insert-marker'.")
-(defun erc-display-line-1 (string buffer)
- "Display STRING in `erc-mode' BUFFER.
-Auxiliary function used in `erc-display-line'. The line gets filtered to
-interpret the control characters. Then, `erc-insert-pre-hook' gets called.
-If `erc-insert-this' is still t, STRING gets inserted into the buffer.
-Afterwards, `erc-insert-modify' and `erc-insert-post-hook' get called.
-If STRING is nil, the function does nothing."
+(define-obsolete-function-alias 'erc-display-line-1 'erc-insert-line "30.1")
+(defun erc-insert-line (string buffer)
+ "Insert STRING in an `erc-mode' BUFFER.
+When STRING is nil, do nothing. Otherwise, start off by running
+`erc-insert-pre-hook' in BUFFER with `erc-insert-this' bound to
+t. If the latter remains non-nil afterward, insert STRING into
+BUFFER, ensuring a trailing newline. After that, narrow BUFFER
+around STRING, along with its final line ending, and run
+`erc-insert-modify' and `erc-insert-post-hook', respectively. In
+all cases, run `erc-insert-done-hook' unnarrowed before exiting,
+and update positions in `buffer-undo-list'.
+
+In general, expect to be called from a higher-level insertion
+function, like `erc-display-message', especially when modules
+should consider STRING as a candidate for formatting with
+enhancements like indentation, fontification, timestamping, etc.
+Otherwise, when called directly, allow built-in modules to ignore
+STRING, which may make it appear incongruous in situ (unless
+preformatted or anticipated by third-party members of the various
+modification hooks)."
(when string
(with-current-buffer (or buffer (process-buffer erc-server-process))
(let ((insert-position (marker-position erc-insert-marker)))
@@ -3021,7 +3034,7 @@ erc-display-line-1
(when (erc-string-invisible-p string)
(erc-put-text-properties 0 (length string)
'(invisible intangible) string)))
- (erc-log (concat "erc-display-line: " string
+ (erc-log (concat "erc-display-message: " string
(format "(%S)" string) " in buffer "
(format "%s" buffer)))
(setq erc-insert-this t)
@@ -3091,39 +3104,45 @@ erc-is-valid-nick-p
"Check if NICK is a valid IRC nickname."
(string-match (concat "\\`" erc-valid-nick-regexp "\\'") nick))
-(defun erc-display-line (string &optional buffer)
- "Display STRING in the ERC BUFFER.
-All screen output must be done through this function. If BUFFER is nil
-or omitted, the default ERC buffer for the `erc-session-server' is used.
-The BUFFER can be an actual buffer, a list of buffers, `all' or `active'.
-If BUFFER = `all', the string is displayed in all the ERC buffers for the
-current session. `active' means the current active buffer
-\(`erc-active-buffer'). If the buffer can't be resolved, the current
-buffer is used. `erc-display-line-1' is used to display STRING.
-
-If STRING is nil, the function does nothing."
- (let (new-bufs)
+(defun erc--route-insertion (string buffer)
+ "Insert STRING in BUFFER.
+See `erc-display-message' for acceptable BUFFER types."
+ (let (seen msg-props)
(dolist (buf (cond
((bufferp buffer) (list buffer))
- ((listp buffer) buffer)
+ ((consp buffer)
+ (setq msg-props erc--msg-props)
+ buffer)
((processp buffer) (list (process-buffer buffer)))
((eq 'all buffer)
;; Hmm, or all of the same session server?
(erc-buffer-list nil erc-server-process))
- ((and (eq 'active buffer) (erc-active-buffer))
- (list (erc-active-buffer)))
+ ((and-let* (((eq 'active buffer))
+ (b (erc-active-buffer)))
+ (list b)))
((erc-server-buffer-live-p)
(list (process-buffer erc-server-process)))
(t (list (current-buffer)))))
(when (buffer-live-p buf)
- (erc-display-line-1 string buf)
- (push buf new-bufs)))
- (when (null new-bufs)
- (erc-display-line-1 string (if (erc-server-buffer-live-p)
- (process-buffer erc-server-process)
- (current-buffer))))))
-
-(defvar erc--compose-text-properties nil
+ (when msg-props
+ (setq erc--msg-props (copy-hash-table msg-props)))
+ (erc-insert-line string buf)
+ (setq seen t)))
+ (unless (or seen (null buffer))
+ (erc--route-insertion string nil))))
+
+(defun erc-display-line (string &optional buffer)
+ "Insert STRING in BUFFER as a plain \"local\" message.
+Take pains to ensure modification hooks see messages created by
+the old pattern (erc-display-line (erc-make-notice) my-buffer) as
+being equivalent to a `erc-display-message' TYPE of `notice'."
+ (let ((erc--msg-prop-overrides erc--msg-prop-overrides))
+ (when (eq 'erc-notice-face (get-text-property 0 'font-lock-face string))
+ (unless (assq 'erc-msg erc--msg-prop-overrides)
+ (push '(erc-msg . notice) erc--msg-prop-overrides)))
+ (erc-display-message nil nil buffer string)))
+
+(defvar erc--merge-text-properties-p nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
;; To save space, we could maintain a map of all readable property
@@ -3432,14 +3451,24 @@ erc-display-message
Insert MSG or text derived from MSG into an ERC buffer, possibly
after applying formatting by way of either a `format-spec' known
to a message-catalog entry or a TYPE known to a specialized
-string handler. Additionally, derive internal metadata, faces,
-and other text properties from the various overloaded parameters,
-such as PARSED, when it's an `erc-response' object, and MSG, when
-it's a key (symbol) for a \"message catalog\" entry. Expect
-ARGS, when applicable, to be `format-spec' args known to such an
-entry, and TYPE, when non-nil, to be a symbol handled by
+string handler. Additionally, derive metadata, faces, and other
+text properties from the various overloaded parameters, such as
+PARSED, when it's an `erc-response' object, and MSG, when it's a
+key (symbol) for a \"message catalog\" entry. Expect ARGS, when
+applicable, to be `format-spec' args known to such an entry, and
+TYPE, when non-nil, to be a symbol handled by
`erc-display-message-highlight' (necessarily accompanied by a
-string MSG).
+string MSG). Expect BUFFER to be among the sort accepted by the
+function `erc-display-line'.
+
+Expect BUFFER to be a live `erc-mode' buffer, a list of such
+buffers, or the symbols `all' or `active'. If `all', insert
+STRING in all buffers for the current session. If `active',
+defer to the function `erc-active-buffer', which may return the
+session's server buffer if the previously active buffer has been
+killed. If BUFFER is nil or a network process, pretend it's set
+to the appropriate server buffer. Otherwise, use the current
+buffer.
When TYPE is a list of symbols, call handlers from left to right
without influencing how they behave when encountering existing
@@ -3451,24 +3480,31 @@ erc-display-message
being (erc-error-face erc-notice-face) throughout MSG when
`erc-notice-highlight-type' is left at its default, `all'.
-As of ERC 5.6, assume user code will use this function instead of
-`erc-display-line' when it's important that insert hooks treat
-MSG in a manner befitting messages received from a server. That
-is, expect to process most nontrivial informational messages, for
-which PARSED is typically nil, when the caller desires
-buttonizing and other effects."
+As of ERC 5.6, assume third-party code will use this function
+instead of lower-level ones, like `erc-insert-line', when needing
+ERC to process arbitrary informative messages as if they'd been
+sent from a server. That is, guarantee \"local\" messages, for
+which PARSED is typically nil, will be subject to buttonizing,
+filling, and other effects."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
msg))
(erc--msg-props
(or erc--msg-props
- (let* ((table (make-hash-table :size 5))
- (cmd (and parsed (erc--get-eq-comparable-cmd
- (erc-response.command parsed))))
- (m (cond ((and msg (symbolp msg)) msg)
- ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
- (t 'unknown))))
- (puthash 'erc-msg m table)
+ (let ((table (make-hash-table :size 5))
+ (cmd (and parsed (erc--get-eq-comparable-cmd
+ (erc-response.command parsed)))))
+ (puthash 'erc-msg
+ (cond ((and msg (symbolp msg)) msg)
+ ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
+ (type (pcase type
+ ((pred symbolp) type)
+ ((pred listp)
+ (intern (mapconcat #'prin1-to-string
+ type "-")))
+ (_ 'unknown)))
+ (t 'unknown))
+ table)
(when cmd
(puthash 'erc-cmd cmd table))
(and erc--msg-prop-overrides
@@ -3481,7 +3517,7 @@ erc-display-message
((null type)
string)
((listp type)
- (let ((erc--compose-text-properties
+ (let ((erc--merge-text-properties-p
(and (eq (car type) t) (setq type (cdr type)))))
(dolist (type type)
(setq string (erc-display-message-highlight type string))))
@@ -3490,13 +3526,13 @@ erc-display-message
(erc-display-message-highlight type string))))
(if (not (erc-response-p parsed))
- (erc-display-line string buffer)
+ (erc--route-insertion string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
- (erc-display-line string buffer)))))
+ (erc--route-insertion string buffer)))))
(defun erc-message-type-member (position list)
"Return non-nil if the erc-parsed text-property at POSITION is in LIST.
@@ -6481,7 +6517,7 @@ erc-put-text-property
You can redefine or `defadvice' this function in order to add
EmacsSpeak support."
- (if erc--compose-text-properties
+ (if erc--merge-text-properties-p
(erc--merge-prop start end property value object)
(put-text-property start end property value object)))
diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el
index e95d99c128f..45ef0d10a6e 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -1206,7 +1206,7 @@ erc-networks--set-name
calls)
(erc-mode)
- (cl-letf (((symbol-function 'erc-display-line)
+ (cl-letf (((symbol-function 'erc--route-insertion)
(lambda (&rest r) (push r calls))))
(ert-info ("Signals when `erc-server-announced-name' unset")
diff --git a/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el
new file mode 100644
index 00000000000..51bdf305ad5
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-display-message.el
@@ -0,0 +1,64 @@
+;;; erc-scenarios-display-message.el --- erc-display-message -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(ert-deftest erc-scenarios-display-message--multibuf ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/display-message")
+ (dumb-server (erc-d-run "localhost" t 'multibuf))
+ (port (process-contact dumb-server :service))
+ (erc-server-flood-penalty 0.1)
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-autojoin-channels-alist '((foonet "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 10 "debug mode")))
+
+ (ert-info ("User dummy is a member of #chan")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (funcall expect 10 "dummy")))
+
+ (ert-info ("Dummy's QUIT notice in query contains metadata props")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "dummy"))
+ (funcall expect 10 "<dummy> hi")
+ (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
+ (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
+
+ (ert-info ("Dummy's QUIT notice in #chan contains metadata props")
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
+ (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
+
+ (erc-cmd-QUIT "")))
+
+(eval-when-compile (require 'erc-join))
+
+;;; erc-scenarios-display-message.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 4f4662f5075..02dfc55b6d5 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1938,6 +1938,69 @@ erc-format-privmessage
2 5 (erc-speaker "Bob" font-lock-face erc-nick-default-face)
5 12 (font-lock-face erc-default-face))))))
+(ert-deftest erc--route-insertion ()
+ (erc-tests--send-prep)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (setq erc-networks--id (erc-networks--id-create 'foonet))
+
+ (let* ((erc-modules) ; for `erc--open-target'
+ (server-buffer (current-buffer))
+ (spam-buffer (save-excursion (erc--open-target "#spam")))
+ (chan-buffer (save-excursion (erc--open-target "#chan")))
+ calls)
+ (cl-letf (((symbol-function 'erc-insert-line)
+ (lambda (&rest r) (push (cons 'line-1 r) calls))))
+
+ (with-current-buffer chan-buffer
+
+ (ert-info ("Null `buffer' routes to live server-buffer")
+ (erc--route-insertion "null" nil)
+ (should (equal (pop calls) `(line-1 "null" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Cons `buffer' routes to live members")
+ ;; Copies a let-bound `erc--msg-props' before mutating.
+ (let* ((table (map-into '(erc-msg msg) 'hash-table))
+ (erc--msg-props table))
+ (erc--route-insertion "cons" (list server-buffer spam-buffer))
+ (should-not (eq table erc--msg-props)))
+ (should (equal (pop calls) `(line-1 "cons" ,spam-buffer)))
+ (should (equal (pop calls) `(line-1 "cons" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Variant `all' inserts in all session buffers")
+ (erc--route-insertion "all" 'all)
+ (should (equal (pop calls) `(line-1 "all" ,chan-buffer)))
+ (should (equal (pop calls) `(line-1 "all" ,spam-buffer)))
+ (should (equal (pop calls) `(line-1 "all" ,server-buffer)))
+ (should-not calls))
+
+ (ert-info ("Variant `active' routes to active buffer if alive")
+ (should (eq chan-buffer (erc-with-server-buffer erc-active-buffer)))
+ (erc-set-active-buffer spam-buffer)
+ (erc--route-insertion "act" 'active)
+ (should (equal (pop calls) `(line-1 "act" ,spam-buffer)))
+ (should (eq (erc-active-buffer) spam-buffer))
+ (should-not calls))
+
+ (ert-info ("Variant `active' falls back to current buffer")
+ (should (eq spam-buffer (erc-active-buffer)))
+ (kill-buffer "#spam")
+ (erc--route-insertion "nact" 'active)
+ (should (equal (pop calls) `(line-1 "nact" ,server-buffer)))
+ (should (eq (erc-with-server-buffer erc-active-buffer)
+ server-buffer))
+ (should-not calls))
+
+ (ert-info ("Dead single buffer defaults to live server-buffer")
+ (should-not (get-buffer "#spam"))
+ (erc--route-insertion "dead" 'spam-buffer)
+ (should (equal (pop calls) `(line-1 "dead" ,server-buffer)))
+ (should-not calls))))
+
+ (should-not (buffer-live-p spam-buffer))
+ (kill-buffer chan-buffer)))
+
(defvar erc-tests--ipv6-examples
'("1:2:3:4:5:6:7:8"
"::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0"
diff --git a/test/lisp/erc/resources/base/display-message/multibuf.eld b/test/lisp/erc/resources/base/display-message/multibuf.eld
new file mode 100644
index 00000000000..e49a654cd06
--- /dev/null
+++ b/test/lisp/erc/resources/base/display-message/multibuf.eld
@@ -0,0 +1,45 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1")
+ (0.01 ":irc.foonet.org 003 tester :This server was created Sat, 14 Oct 2023 16:08:20 UTC")
+ (0.02 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server")
+ (0.00 ":irc.foonet.org 251 tester :There are 0 users and 5 invisible on 1 server(s)")
+ (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0.00 ":irc.foonet.org 254 tester 2 :channels formed")
+ (0.00 ":irc.foonet.org 255 tester :I have 5 clients and 0 servers")
+ (0.00 ":irc.foonet.org 265 tester 5 5 :Current local users 5, max 5")
+ (0.02 ":irc.foonet.org 266 tester 5 5 :Current global users 5, max 5")
+ (0.01 ":irc.foonet.org 422 tester :MOTD File is missing")
+ (0.00 ":irc.foonet.org 221 tester +i")
+ (0.01 ":irc.foonet.org NOTICE tester :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."))
+
+((mode 10 "MODE tester +i")
+ (0.00 ":irc.foonet.org 221 tester +i"))
+
+((join 10 "JOIN #chan")
+ (0.03 ":tester!~u@rdjcgiwfuwqmc.irc JOIN #chan")
+ (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice dummy tester")
+ (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (0.00 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!")
+ (0.01 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :tester, welcome!"))
+
+((mode 10 "MODE #chan")
+ (0.01 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: Persuade this rude wretch willingly to die.")
+ (0.01 ":irc.foonet.org 324 tester #chan +Cnt")
+ (0.01 ":irc.foonet.org 329 tester #chan 1697299707")
+ (0.03 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :bob: It might be yours or hers, for aught I know.")
+ (0.07 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :Would all themselves laugh mortal.")
+ (0.04 ":dummy!~u@rdjcgiwfuwqmc.irc PRIVMSG tester :hi")
+ (0.06 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: It hath pleased the devil drunkenness to give place to the devil wrath; one unperfectness shows me another, to make me frankly despise myself.")
+ (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.6-git (IRC client for GNU Emacs 30.0.50)")
+ (0.08 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :You speak of him when he was less furnished than now he is with that which makes him both without and within."))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.04 ":tester!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)")
+ (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)"))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 238d8cc73c2..8a6f2289f5d 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index d1ce9198e69..3eb4be4919b 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 1680332400 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index d70184724ba..82c6d52cf7c 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +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 one\n<bob> two.\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 unknown 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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#))
\ No newline at end of file
+#("\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 one\n<bob> two.\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 (#6=(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 1680332400 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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 475 476 (wrap-prefix #1# line-prefix #7#) 476 479 (wrap-prefix #1# line-prefix #7#) 479 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 485 488 (wrap-prefix #1# line-prefix #8# display #9#) 488 490 (wrap-prefix #1# line-prefix #8# display #9#) 490 494 (wrap-prefix #1# line-prefix #8#) 495 496 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG erc-ctcp ACTION wrap-prefix #1# line-prefix #10=(space :width (- 27 (2)))) 496 497 (wrap-prefix #1# line-prefix #10#) 497 500 (wrap-prefix #1# line-prefix #10#) 500 506 (wrap-prefix #1# line-prefix #10#) 507 508 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 508 511 (wrap-prefix #1# line-prefix #11# display #9#) 511 513 (wrap-prefix #1# line-prefix #11# display #9#) 513 518 (wrap-prefix #1# line-prefix #11#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index def97738ce6..84a1e34670c 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +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" 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 unknown 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 ((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#))
\ No newline at end of file
+#("\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" 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 ((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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index be3e2b33cfd..83394f2f639 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index 098257d0b49..1605628b29f 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
\ No newline at end of file
+#("\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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index def97738ce6..84a1e34670c 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +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" 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 unknown 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 ((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#))
\ No newline at end of file
+#("\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" 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 ((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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 360b3dafafd..7a7e01de49d 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +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 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 unknown 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg unknown erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
+#("\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 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
index cd3537d3c94..bb248ffb28e 100644
--- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -1 +1 @@
-#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg unknown erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
\ No newline at end of file
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg notice erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Fix-right-stamps-commingling-with-erc-prompt.patch --]
[-- Type: text/x-patch, Size: 5049 bytes --]
From 53bb212154471469768594e7db3c5f48918e316d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 18 Oct 2023 23:20:07 -0700
Subject: [PATCH 3/4] [5.6] Fix right stamps commingling with erc-prompt
* lisp/erc/erc-stamp.el (erc-insert-timestamp-left-and-right): Fix bug
that saw the prompt being inserted after messages but just inside the
narrowed operating portion of the buffer, which meant remaining
modification hooks would see it upon visiting. Thanks to Corwin Brust
for catching this.
* test/lisp/erc/erc-fill-tests.el (erc-fill-wrap--monospace): Use
custom `erc-prompt' function to guarantee invariants asserted by
`erc--assert-input-bounds' are preserved throughout. (Bug#60936)
---
lisp/erc/erc-stamp.el | 6 ++--
test/lisp/erc/erc-fill-tests.el | 57 +++++++++++++++++----------------
2 files changed, 34 insertions(+), 29 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 57fd7f39e50..c8fd7c35392 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -704,10 +704,12 @@ erc-insert-timestamp-left-and-right
(unless erc-stamp--date-format-end
(add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t)
(add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t)
- (let ((erc--insert-marker (point-min-marker)))
+ (let ((erc--insert-marker (point-min-marker))
+ (end-marker (point-max-marker)))
(set-marker-insertion-type erc--insert-marker t)
(erc-stamp--lr-date-on-pre-modify nil)
- (narrow-to-region erc--insert-marker (point-max))
+ (narrow-to-region erc--insert-marker end-marker)
+ (set-marker end-marker nil)
(set-marker erc--insert-marker nil)))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
(ts-right (with-suppressed-warnings
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index f6c4c268017..80f5fd22ac6 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -203,36 +203,39 @@ erc-fill-wrap--monospace
(unless (>= emacs-major-version 29)
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
- (erc-fill-tests--wrap-populate
-
- (lambda ()
- (should (= erc-fill--wrap-value 27))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-01-start")
-
- (ert-info ("Shift right by one (plus)")
- ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p"
- (ert-with-message-capture messages
- ;; M-x erc-fill-wrap-nudge RET =
- (ert-simulate-command '(erc-fill-wrap-nudge 2))
- (should (string-match (rx "for further adjustment") messages)))
- (should (= erc-fill--wrap-value 29))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-02-right"))
-
- (ert-info ("Shift left by five")
- ;; "M-x erc-fill-wrap-nudge RET -----"
- (ert-simulate-command '(erc-fill-wrap-nudge -4))
- (should (= erc-fill--wrap-value 25))
- (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-03-left"))
+ (let ((erc-prompt (lambda () "ABC>")))
+ (erc-fill-tests--wrap-populate
- (ert-info ("Reset")
- ;; M-x erc-fill-wrap-nudge RET 0
- (ert-simulate-command '(erc-fill-wrap-nudge 0))
+ (lambda ()
(should (= erc-fill--wrap-value 27))
(erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
- (erc-fill-tests--compare "monospace-04-reset")))))
+ (erc-fill-tests--compare "monospace-01-start")
+
+ (ert-info ("Shift right by one (plus)")
+ ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p"
+ (ert-with-message-capture messages
+ ;; M-x erc-fill-wrap-nudge RET =
+ (ert-simulate-command '(erc-fill-wrap-nudge 2))
+ (should (string-match (rx "for further adjustment") messages)))
+ (should (= erc-fill--wrap-value 29))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-02-right"))
+
+ (ert-info ("Shift left by five")
+ ;; "M-x erc-fill-wrap-nudge RET -----"
+ (ert-simulate-command '(erc-fill-wrap-nudge -4))
+ (should (= erc-fill--wrap-value 25))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-03-left"))
+
+ (ert-info ("Reset")
+ ;; M-x erc-fill-wrap-nudge RET 0
+ (ert-simulate-command '(erc-fill-wrap-nudge 0))
+ (should (= erc-fill--wrap-value 27))
+ (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+ (erc-fill-tests--compare "monospace-04-reset"))
+
+ (erc--assert-input-bounds)))))
(defun erc-fill-tests--simulate-refill ()
;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Respect-user-markers-in-erc-insert-timestamp-lef.patch --]
[-- Type: text/x-patch, Size: 6596 bytes --]
From 15f2e73c4022edc1d5ba0ad9c2dea69bbabe3a97 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 18 Oct 2023 23:20:07 -0700
Subject: [PATCH 4/4] [5.6] Respect user markers in erc--insert-timestamp-left
* lisp/erc/erc-stamp.el (erc-insert-timestamp-left): Convert to normal
function that calls existing generic version in order to dissuade
users from adding their own methods, which could complicate
troubleshooting, etc.
(erc--insert-timestamp-left): Rename both methods using internal
convention. In `erc-stamp--display-margin-mode' implementation, don't
insert before user markers.
* test/lisp/erc/erc-scenarios-stamp.el: New file. (Bug#60936)
---
lisp/erc/erc-stamp.el | 10 ++--
test/lisp/erc/erc-scenarios-stamp.el | 90 ++++++++++++++++++++++++++++
2 files changed, 96 insertions(+), 4 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-stamp.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index c8fd7c35392..b515513dcb7 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -492,8 +492,11 @@ erc--conceal-prompt
(put-text-property erc-insert-marker (1- erc-input-marker)
'display `((margin left-margin) ,prompt))))
-(cl-defmethod erc-insert-timestamp-left (string)
+(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
+ (erc--insert-timestamp-left string))
+
+(cl-defmethod erc--insert-timestamp-left (string)
(goto-char (point-min))
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted)))
@@ -504,13 +507,12 @@ erc-insert-timestamp-left
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
-(cl-defmethod erc-insert-timestamp-left
+(cl-defmethod erc--insert-timestamp-left
(string &context (erc-stamp--display-margin-mode (eql t)))
(unless (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted))
(goto-char (point-min))
- (insert-before-markers-and-inherit
- (setq erc-timestamp-last-inserted string))
+ (insert-and-inherit (setq erc-timestamp-last-inserted string))
(dolist (p erc-stamp--inherited-props)
(when-let ((v (get-text-property (point) p)))
(put-text-property (point-min) (point) p v)))
diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el
new file mode 100644
index 00000000000..d6b5d868ce5
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-stamp.el
@@ -0,0 +1,90 @@
+;;; erc-scenarios-stamp.el --- Misc `erc-stamp' scenarios -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-stamp)
+
+(defvar erc-scenarios-stamp--user-marker nil)
+
+(defun erc-scenarios-stamp--on-post-modify ()
+ (when-let (((erc--check-msg-prop 'erc-cmd 4)))
+ (set-marker erc-scenarios-stamp--user-marker (point-max))
+ (ert-info ("User marker correctly placed at `erc-insert-marker'")
+ (should (= ?\n (char-before erc-scenarios-stamp--user-marker)))
+ (should (= erc-scenarios-stamp--user-marker erc-insert-marker))
+ (save-excursion
+ (goto-char erc-scenarios-stamp--user-marker)
+ ;; The raw message ends in " Iabefhkloqv". However,
+ ;; `erc-server-004' only prints up to the 5th parameter.
+ (should (looking-back "CEIMRUabefhiklmnoqstuv\n"))))))
+
+(ert-deftest erc-scenarios-stamp--left/display-margin-mode ()
+
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reconnect")
+ (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
+ (port (process-contact dumb-server :service))
+ (erc-scenarios-stamp--user-marker (make-marker))
+ (erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-server-flood-penalty 0.1)
+ (erc-timestamp-only-if-changed-flag nil)
+ (erc-insert-timestamp-function #'erc-insert-timestamp-left)
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-timestamp-only-if-changed-flag nil)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :full-name "tester"
+ :nick "tester")
+
+ (add-hook 'erc-insert-post-hook #'erc-scenarios-stamp--on-post-modify
+ nil t)
+ (funcall expect 5 "This server is in debug mode")
+
+ (ert-info ("Stamps appear in left margin and are invisible")
+ (should (eq 'erc-timestamp (field-at-pos (pos-bol))))
+ (should (= (pos-bol) (field-beginning (pos-bol))))
+ (should (eq 'msg (get-text-property (pos-bol) 'erc-msg)))
+ (should (eq 'NOTICE (get-text-property (pos-bol) 'erc-cmd)))
+ (should (= ?- (char-after (field-end (pos-bol)))))
+ (should (equal (get-text-property (1+ (field-end (pos-bol)))
+ 'erc-speaker)
+ "irc.foonet.org"))
+ (should (pcase (get-text-property (pos-bol) 'display)
+ (`((margin left-margin) ,s)
+ (eq 'timestamp (get-text-property 0 'invisible s))))))
+
+ ;; We set a third-party marker at the end of 004's message (on
+ ;; then "\n"), post-insertion.
+ (ert-info ("User markers untouched by subsequent message left stamp")
+ (save-excursion
+ (goto-char erc-scenarios-stamp--user-marker)
+ (should (looking-back "CEIMRUabefhiklmnoqstuv\n"))
+ (should (looking-at (rx "[")))))))))
+
+;;; erc-scenarios-stamp.el ends here
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <877cniaewr.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <877cniaewr.fsf@neverwas.me>
@ 2023-10-24 2:19 ` J.P.
[not found] ` <877cncg3ss.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-24 2:19 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 507 bytes --]
Some bugs have surfaced stemming from recent work on this initiative.
Most come down to sloppiness on my part. The worst of the bunch involves
`erc-insert-done-hook' being narrowed on date-stamp insertion, which
defies a tacit agreement to the contrary. A related bug concerns members
of the new internal date-stamp hook possibly running twice if the latter
has a buffer-local value.
I've also added a new helper for deleting inserted messages. It attempts
to respect user markers and invisibility props.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Ensure-marker-for-max-pos-in-erc-traverse-insert.patch --]
[-- Type: text/x-patch, Size: 10821 bytes --]
From b1b473f23db097106fb250686c06f4e8ef5d536f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 21 Oct 2023 13:53:46 -0700
Subject: [PATCH] [5.6] Ensure marker for max pos in erc--traverse-inserted
* lisp/erc/erc-stamp.el (erc-stamp--propertize-left-date-stamp):
Run `erc-stamp--insert-date-hook' here.
(erc-stamp--insert-date-stamp-as-phony-message): Don't include value
of `erc-stamp--insert-date-hook' in let-bound `erc-insert-modify-hook'
because it runs twice if buffer-local. Also call getter for
`erc-stamp--current-time' and remove `erc-send-modify-hook' because
that only runs via `erc-display-msg'.
(erc-stamp--lr-date-on-pre-modify,
erc-insert-timestamp-left-and-right): Use function form of
`erc-stamp--current-time' for determining current time stamp.
* lisp/erc/erc.el (erc--traverse-inserted): Create temporary marker
when END is non-nil and not already a marker so that insertions and
deletions do not affect the position at which the loop should end.
(erc--delete-inserted-message): New function.
* test/lisp/erc/erc-tests.el (erc--delete-inserted-message): New test.
(erc--update-modules/unknown): Improve readability slightly.
* test/lisp/erc/resources/erc-d/erc-d-t.el (erc-d-t-make-expecter):
Indicate assertion flavor in error message. (Bug#60936)
---
lisp/erc/erc-stamp.el | 17 ++++---
lisp/erc/erc.el | 33 +++++++++++--
test/lisp/erc/erc-tests.el | 61 +++++++++++++++++++++---
test/lisp/erc/resources/erc-d/erc-d-t.el | 1 +
4 files changed, 94 insertions(+), 18 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index b515513dcb7..56fa975c32d 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -638,7 +638,8 @@ erc-stamp--date-format-end
(defun erc-stamp--propertize-left-date-stamp ()
(add-text-properties (point-min) (1- (point-max))
'(field erc-timestamp erc-stamp-type date-left))
- (erc--hide-message 'timestamp))
+ (erc--hide-message 'timestamp)
+ (run-hooks 'erc-stamp--insert-date-hook))
;; A kludge to pass state from insert hook to nested insert hook.
(defvar erc-stamp--current-datestamp-left nil)
@@ -665,19 +666,17 @@ erc-stamp--insert-date-stamp-as-phony-message
(cl-assert string)
(let ((erc-stamp--skip t)
(erc--msg-props (map-into `((erc-msg . datestamp)
- (erc-ts . ,erc-stamp--current-time))
+ (erc-ts . ,(erc-stamp--current-time)))
'hash-table))
- (erc-send-modify-hook `(,@erc-send-modify-hook
- erc-stamp--propertize-left-date-stamp
- ,@erc-stamp--insert-date-hook))
(erc-insert-modify-hook `(,@erc-insert-modify-hook
- erc-stamp--propertize-left-date-stamp
- ,@erc-stamp--insert-date-hook)))
+ erc-stamp--propertize-left-date-stamp))
+ ;; Don't run hooks that aren't expecting a narrowed buffer.
+ (erc-insert-done-hook nil))
(erc-display-message nil nil (current-buffer) string)
(setq erc-timestamp-last-inserted-left string)))
(defun erc-stamp--lr-date-on-pre-modify (_)
- (when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (when-let ((ct (erc-stamp--current-time))
(rendered (erc-stamp--format-date-stamp ct))
((not (string-equal rendered erc-timestamp-last-inserted-left)))
(erc-stamp--current-datestamp-left rendered)
@@ -713,7 +712,7 @@ erc-insert-timestamp-left-and-right
(narrow-to-region erc--insert-marker end-marker)
(set-marker end-marker nil)
(set-marker erc--insert-marker nil)))
- (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (let* ((ct (erc-stamp--current-time))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7d75ec49ccd..92f6f1fcb1f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3006,8 +3006,12 @@ erc--with-inserted-msg
,@body)))
(defun erc--traverse-inserted (beg end fn)
- "Visit messages between BEG and END and run FN in narrowed buffer."
- (setq end (min end (marker-position erc-insert-marker)))
+ "Visit messages between BEG and END and run FN in narrowed buffer.
+If END is a marker, possibly update its position."
+ (unless (markerp end)
+ (setq end (set-marker (make-marker) (or end erc-insert-marker))))
+ (unless (eq end erc-insert-marker)
+ (set-marker end (min erc-insert-marker end)))
(save-excursion
(goto-char beg)
(let ((b (if (get-text-property (point) 'erc-msg)
@@ -3019,7 +3023,9 @@ erc--traverse-inserted
(save-restriction
(narrow-to-region b e)
(funcall fn))
- (setq b e)))))
+ (setq b e))))
+ (unless (eq end erc-insert-marker)
+ (set-marker end nil)))
(defvar erc--insert-marker nil
"Internal override for `erc-insert-marker'.")
@@ -3241,6 +3247,27 @@ erc--hide-message
(cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+(defun erc--delete-inserted-message (beg-or-point &optional end)
+ "Remove message between BEG and END.
+Expect BEG and END to match bounds as returned by the macro
+`erc--get-inserted-msg-bounds'. Ensure all markers residing at
+the start of the deleted message end up at the beginning of the
+subsequent message."
+ (let ((beg beg-or-point))
+ (save-restriction
+ (widen)
+ (unless end
+ (setq end (erc--get-inserted-msg-bounds nil beg-or-point)
+ beg (pop end)))
+ (with-silent-modifications
+ (if erc-legacy-invisible-bounds-p
+ (delete-region beg (1+ end))
+ (save-excursion
+ (goto-char beg)
+ (insert-before-markers
+ (substring (delete-and-extract-region (1- (point)) (1+ end))
+ -1))))))))
+
(defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd))
(defun erc--order-text-properties-from-hash (table)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 57bf5860ac4..6429fce8861 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1432,6 +1432,57 @@ erc-process-input-line
(should-not calls))))))
+(ert-deftest erc--delete-inserted-message ()
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ ;; Put unique invisible properties on the line endings.
+ (erc-display-message nil 'notice nil "one")
+ (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'a)
+ (let ((erc--msg-prop-overrides '((erc-msg . datestamp) (erc-ts . 0))))
+ (erc-display-message nil nil nil
+ (propertize "\n[date]" 'field 'erc-timestamp)))
+ (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'b)
+ (erc-display-message nil 'notice nil "two")
+
+ (ert-info ("Date stamp deleted cleanly")
+ (goto-char 11)
+ (should (looking-at (rx "\n[date]")))
+ (should (eq 'datestamp (get-text-property (point) 'erc-msg)))
+ (should (eq (point) (field-beginning (1+ (point)))))
+
+ (erc--delete-inserted-message (point))
+
+ ;; Preceding line ending clobbered, replaced by trailing.
+ (should (looking-back (rx "*** one\n")))
+ (should (looking-at (rx "*** two")))
+ (should (eq 'b (get-text-property (1- (point)) 'invisible))))
+
+ (ert-info ("Markers at pos-bol preserved")
+ (erc-display-message nil 'notice nil "three")
+ (should (looking-at (rx "*** two")))
+
+ (let ((m (point-marker))
+ (n (point-marker))
+ (p (point)))
+ (set-marker-insertion-type m t)
+ (goto-char (point-max))
+ (erc--delete-inserted-message p)
+ (should (= (marker-position n) p))
+ (should (= (marker-position m) p))
+ (goto-char p)
+ (set-marker m nil)
+ (set-marker n nil)
+ (should (looking-back (rx "*** one\n")))
+ (should (looking-at (rx "*** three")))))
+
+ (ert-info ("Compat")
+ (erc-display-message nil 'notice nil "four")
+ (should (looking-at (rx "*** three\n")))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (let ((erc-legacy-invisible-bounds-p t))
+ (erc--delete-inserted-message (point))))
+ (should (looking-at (rx "*** four\n")))))
+
(ert-deftest erc--order-text-properties-from-hash ()
(let ((table (map-into '((a . 1)
(erc-ts . 0)
@@ -2617,8 +2668,8 @@ erc--update-modules/unknown
(obarray (obarray-make))
(err (should-error (erc--update-modules erc-modules))))
(should (equal (cadr err) "`foo' is not a known ERC module"))
- (should (equal (funcall get-calls)
- `((req . ,(intern-soft "erc-foo")))))))
+ (should (equal (mapcar #'prin1-to-string (funcall get-calls))
+ '("(req . erc-foo)")))))
;; Module's mode command exists but lacks an associated file.
(ert-info ("Bad autoload flagged as suspect")
@@ -2627,10 +2678,8 @@ erc--update-modules/unknown
(obarray (obarray-make))
(erc-modules (list (intern "foo"))))
- ;; Create a mode activation command.
+ ;; Create a mode-activation command and make mode-var global.
(funcall mk-cmd "foo")
-
- ;; Make the mode var global.
(funcall mk-global "foo")
;; No local modules to return.
@@ -2639,7 +2688,7 @@ erc--update-modules/unknown
'("foo")))
;; ERC requires the library via prefixed module name.
(should (equal (mapcar #'prin1-to-string (funcall get-calls))
- `("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
+ '("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to
;; load its defining library, first via the symbol property
diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el b/test/lisp/erc/resources/erc-d/erc-d-t.el
index cf869fb3c70..7126165fd91 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-t.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-t.el
@@ -157,6 +157,7 @@ erc-d-t-make-expecter
(let (positions)
(lambda (timeout text &optional reset-from)
(let* ((pos (cdr (assq (current-buffer) positions)))
+ (erc-d-t--wait-message-prefix (and (< timeout 0) "Sustaining: "))
(cb (lambda ()
(unless pos
(push (cons (current-buffer) (setq pos (make-marker)))
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <877cncg3ss.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <877cncg3ss.fsf@neverwas.me>
@ 2023-10-24 14:29 ` J.P.
[not found] ` <87jzrcccw3.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-24 14:29 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1199 bytes --]
v2. Fix date-stamp regression in erc-track. Optionally reinstate old
"prepended" date-stamp behavior gated by new compat var.
Earlier changes for this feature introduced a regression involving date
stamps and the option `erc-track-exclude-types'. Basically, date stamps
aren't supposed to affect the mode line, at least so long as their
inciting message's command appears in `erc-track-exclude-types'.
However, this changed after
c68dc7786fc * Manage some text props for ERC insertion-hook members
To reproduce from -Q:
1. Connect and ensure "JOIN" appears in `erc-track-exclude-types'
2. Join #chan
3. From the server buffer, do
(with-current-buffer "#chan"
(setq erc-timestamp-last-inserted-left nil))
3. Connect and join #chan from another client
4. Notice a [#c] in the mode line of the original client
Thanks to Corwin for pointing this out. The way I'm proposing we tackle
this is to decouple date stamps from `erc-track-exclude-types'
completely. That is, have erc-track completely ignore them, so they
never affect the mode line.
In addition to this fix, I've also added a path for accessing the old
behavior in which date stamps aren't standalone messages.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 10786 bytes --]
From 48dfdc118270fbd72ea93ca02363dcda5d7ef528 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 24 Oct 2023 07:09:53 -0700
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
; * lisp/erc/erc.el (erc-after-connect): Remove package-version.
[5.6] Ignore date stamps in erc-track
[5.6] Ensure marker for max pos in erc--traverse-inserted
etc/ERC-NEWS | 10 ++-
lisp/erc/erc-stamp.el | 36 +++++++---
lisp/erc/erc-track.el | 14 ++--
lisp/erc/erc.el | 36 ++++++++--
test/lisp/erc/erc-scenarios-stamp.el | 28 +++++++-
test/lisp/erc/erc-tests.el | 84 ++++++++++++++++++++++--
test/lisp/erc/resources/erc-d/erc-d-t.el | 1 +
7 files changed, 182 insertions(+), 27 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 41ab9cc4c5e..f59023eae62 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -228,6 +228,12 @@ with a legitimate use for this option likely also possesses the
knowledge to rig up a suitable analog with minimal effort. That said,
the road to removal is long.
+** The 'track' module always ignores date stamps.
+Users of the stamp module who leave 'erc-insert-timestamp-function'
+set to its default of 'erc-insert-timestamp-left-and-right' will find
+that date stamps no longer affect the mode line, even for IRC commands
+not included in 'erc-track-exclude-types'.
+
** Option 'erc-warn-about-blank-lines' is more informative.
Enabled by default, this option now produces more useful feedback
whenever ERC rejects prompt input containing whitespace-only lines.
@@ -348,7 +354,9 @@ leading portion of message bodies as well as special casing to act on
these areas without inflicting collateral damage. It may also be
worth noting that as consequence of these changes, the internally
managed variable 'erc-timestamp-last-inserted-left' no longer records
-the final trailing newline in 'erc-timestamp-format-left'.
+the final trailing newline in 'erc-timestamp-format-left'. If you
+must, see variable 'erc-stamp-prepend-date-stamps-p' for a temporary
+escape hatch.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 56fa975c32d..6e35c5e2244 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -688,6 +688,16 @@ erc-stamp--lr-date-on-pre-modify
(let (erc-timestamp-format erc-away-timestamp-format)
(erc-add-timestamp)))))
+(defvar erc-stamp-prepend-date-stamps-p nil
+ "When non-nil, don't treat date stamps as independent messages.
+This is an escape hatch. When enabled, expect post-5.5 features,
+like `fill-wrap', dynamic invisibility, etc., to malfunction
+severely or lead to a degraded experience. Also know that
+support for the default configuration, without any customization,
+may expire before the next major release.")
+(make-obsolete-variable 'erc-stamp-prepend-date-stamps-p
+ "unsupported legacy behavior" "30.1")
+
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
When the deprecated option `erc-timestamp-format-right' is nil,
@@ -702,7 +712,7 @@ erc-insert-timestamp-left-and-right
Additionally, ensure every date stamp is identifiable as such so
that internal modules can easily distinguish between other
left-sided stamps and date stamps inserted by this function."
- (unless erc-stamp--date-format-end
+ (unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p)
(add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t)
(add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t)
(let ((erc--insert-marker (point-min-marker))
@@ -718,6 +728,13 @@ erc-insert-timestamp-left-and-right
(if erc-timestamp-format-right
(erc-format-timestamp ct erc-timestamp-format-right)
string))))
+ ;; Maybe insert legacy date stamp.
+ (when-let ((erc-stamp-prepend-date-stamps-p)
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ ((not (string= ts-left erc-timestamp-last-inserted-left))))
+ (goto-char (point-min))
+ (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
+ (insert (setq erc-timestamp-last-inserted-left ts-left)))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
(erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index c8f2e04c3eb..a36b781e04d 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -785,6 +785,9 @@ erc-track-select-mode-line-face
choice))
choice))))
+(defvar erc-track--skipped-msgs '(datestamp)
+ "Values of `erc-msg' text prop to ignore.")
+
(defun erc-track-modified-channels ()
"Hook function for `erc-insert-post-hook'.
Check if the current buffer should be added to the mode line as a
@@ -798,10 +801,13 @@ erc-track-modified-channels
;; FIXME either use `erc--server-buffer-p' or
;; explain why that's unwise.
(erc-server-or-unjoined-channel-buffer-p)))
- (not (erc-message-type-member
- (or (erc-find-parsed-property)
- (point-min))
- erc-track-exclude-types)))
+ (not (let ((parsed (erc-find-parsed-property)))
+ (or (erc-message-type-member (or parsed (point-min))
+ erc-track-exclude-types)
+ ;; Skip certain non-server-sent messages.
+ (and (not parsed)
+ (erc--check-msg-prop 'erc-msg
+ erc-track--skipped-msgs))))))
;; If the active buffer is not visible (not shown in a
;; window), and not to be excluded, determine the kinds of
;; faces used in the current message, and unless the user
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 92f6f1fcb1f..872ce5b4f49 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2490,7 +2490,6 @@ erc-after-connect
to the 376/422 message's \"sender\", as well as the current nick,
as given by the 376/422 message's \"target\" parameter, which is
typically the same as that reported by `erc-current-nick'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
:group 'erc-hooks
:type '(repeat function))
@@ -2981,7 +2980,7 @@ erc--get-inserted-msg-bounds
(and-let*
((p (previous-single-property-change point
'erc-msg)))
- (if (= p (1- point)) point (1- p)))))))
+ (if (= p (1- point)) p (1- p)))))))
,@(and (member only '(nil 'end))
'((e (1- (next-single-property-change
(if at-start-p (1+ point) point)
diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el
index d6b5d868ce5..c420e62fe14 100644
--- a/test/lisp/erc/erc-scenarios-stamp.el
+++ b/test/lisp/erc/erc-scenarios-stamp.el
@@ -50,7 +50,6 @@ erc-scenarios-stamp--left/display-margin-mode
(erc-stamp--current-time 704591940)
(erc-stamp--tz t)
(erc-server-flood-penalty 0.1)
- (erc-timestamp-only-if-changed-flag nil)
(erc-insert-timestamp-function #'erc-insert-timestamp-left)
(erc-modules (cons 'fill-wrap erc-modules))
(erc-timestamp-only-if-changed-flag nil)
@@ -87,4 +86,31 @@ erc-scenarios-stamp--left/display-margin-mode
(should (looking-back "CEIMRUabefhiklmnoqstuv\n"))
(should (looking-at (rx "[")))))))))
+(ert-deftest erc-scenarios-stamp--legacy-date-stamps ()
+ (with-suppressed-warnings ((obsolete erc-stamp-prepend-date-stamps-p))
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reconnect")
+ (erc-stamp-prepend-date-stamps-p t)
+ (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
+ (port (process-contact dumb-server :service))
+ (erc-server-flood-penalty 0.1)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :full-name "tester"
+ :nick "tester")
+ (funcall expect 5 "opening connection")
+ (goto-char (1- (match-beginning 0)))
+ (should (eq 'erc-timestamp (field-at-pos (point))))
+ (should (eq 'unknown (erc--get-inserted-msg-prop 'erc-msg)))
+ ;; Force redraw of date stamp.
+ (setq erc-timestamp-last-inserted-left nil)
+
+ (funcall expect 5 "This server is in debug mode")
+ (while (and (zerop (forward-line -1))
+ (not (eq 'erc-timestamp (field-at-pos (point))))))
+ (should (erc--get-inserted-msg-prop 'erc-cmd)))))))
+
;;; erc-scenarios-stamp.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 6429fce8861..1af087e7e31 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1481,7 +1481,30 @@ erc--delete-inserted-message
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(let ((erc-legacy-invisible-bounds-p t))
(erc--delete-inserted-message (point))))
- (should (looking-at (rx "*** four\n")))))
+ (should (looking-at (rx "*** four\n"))))
+
+ (ert-info ("Deleting most recent message preserves markers")
+ (let ((m (point-marker))
+ (n (point-marker))
+ (p (point)))
+ (should (equal "*** four\n" (buffer-substring p erc-insert-marker)))
+ (set-marker-insertion-type m t)
+ (goto-char (point-max))
+ (erc--delete-inserted-message p)
+ (should (= (marker-position m) p))
+ (should (= (marker-position n) p))
+ (goto-char p)
+ (should (looking-back (rx "*** one\n")))
+ (should (looking-at erc-prompt))
+ (erc--assert-input-bounds)
+
+ ;; However, `m' is now forever "trapped" at `erc-insert-marker'.
+ (erc-display-message nil 'notice nil "two")
+ (should (= m erc-insert-marker))
+ (goto-char n)
+ (should (looking-at (rx "*** two\n")))
+ (set-marker m nil)
+ (set-marker n nil))))
(ert-deftest erc--order-text-properties-from-hash ()
(let ((table (map-into '((a . 1)
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-lisp-erc-erc.el-erc-after-connect-Remove-package-ver.patch --]
[-- Type: text/x-patch, Size: 781 bytes --]
From 359cd55879ee0bce87b52547e1d3e3ee087d8108 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Oct 2023 19:33:32 -0700
Subject: [PATCH 1/3] ; * lisp/erc/erc.el (erc-after-connect): Remove
package-version.
---
lisp/erc/erc.el | 1 -
1 file changed, 1 deletion(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7d75ec49ccd..f618fb17076 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2490,7 +2490,6 @@ erc-after-connect
to the 376/422 message's \"sender\", as well as the current nick,
as given by the 376/422 message's \"target\" parameter, which is
typically the same as that reported by `erc-current-nick'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
:group 'erc-hooks
:type '(repeat function))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Ignore-date-stamps-in-erc-track.patch --]
[-- Type: text/x-patch, Size: 9223 bytes --]
From bfe93b485c0760bd7c23f8bf3e8da8c53b68069b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Oct 2023 21:59:25 -0700
Subject: [PATCH 2/3] [5.6] Ignore date stamps in erc-track
* etc/ERC-NEWS: Mention that date stamps no longer optionally affect
the mode line. Also mention but discourage new variable
'erc-stamp-prepend-date-stamps-p'.
* lisp/erc/erc-stamp.el (erc-stamp-prepend-date-stamps-p): New
variable, an escape hatch to allow date stamps to once again be
prepended to messages.
(erc-insert-timestamp-left-and-right): Don't insert stamps as
independent messages when legacy flag
`erc-stamp-prepend-date-stamps-p' is non-nil.
* lisp/erc/erc-track.el (erc-track--skipped-msgs): New internal
variable.
(erc-track-modified-channels): In previous versions, a date stamp
accompanying a message for an IRC command appearing in
`erc-track-exclude-types' would have no effect on the mode line. That
they were able to otherwise was probably a bug. Regardless, this
behavior changed after date stamps became independent messages with
c68dc7786fc "Manage some text props for ERC insertion-hook members".
This commit corrects this regression by making ERC always ignore date
stamps. Thanks to Corwin Brust for spotting this.
* test/lisp/erc/erc-scenarios-stamp.el
(erc-scenarios-stamp--left/display-margin-mode): Remove redundant
binding.
(erc-scenarios-stamp--legacy-date-stamps): New test. (Bug#60936)
---
etc/ERC-NEWS | 10 +++++++++-
lisp/erc/erc-stamp.el | 19 ++++++++++++++++++-
lisp/erc/erc-track.el | 14 ++++++++++----
test/lisp/erc/erc-scenarios-stamp.el | 28 +++++++++++++++++++++++++++-
4 files changed, 64 insertions(+), 7 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 41ab9cc4c5e..f59023eae62 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -228,6 +228,12 @@ with a legitimate use for this option likely also possesses the
knowledge to rig up a suitable analog with minimal effort. That said,
the road to removal is long.
+** The 'track' module always ignores date stamps.
+Users of the stamp module who leave 'erc-insert-timestamp-function'
+set to its default of 'erc-insert-timestamp-left-and-right' will find
+that date stamps no longer affect the mode line, even for IRC commands
+not included in 'erc-track-exclude-types'.
+
** Option 'erc-warn-about-blank-lines' is more informative.
Enabled by default, this option now produces more useful feedback
whenever ERC rejects prompt input containing whitespace-only lines.
@@ -348,7 +354,9 @@ leading portion of message bodies as well as special casing to act on
these areas without inflicting collateral damage. It may also be
worth noting that as consequence of these changes, the internally
managed variable 'erc-timestamp-last-inserted-left' no longer records
-the final trailing newline in 'erc-timestamp-format-left'.
+the final trailing newline in 'erc-timestamp-format-left'. If you
+must, see variable 'erc-stamp-prepend-date-stamps-p' for a temporary
+escape hatch.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index b515513dcb7..e0db472d289 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -689,6 +689,16 @@ erc-stamp--lr-date-on-pre-modify
(let (erc-timestamp-format erc-away-timestamp-format)
(erc-add-timestamp)))))
+(defvar erc-stamp-prepend-date-stamps-p nil
+ "When non-nil, don't treat date stamps as independent messages.
+This is an escape hatch. When enabled, expect post-5.5 features,
+like `fill-wrap', dynamic invisibility, etc., to malfunction
+severely or lead to a degraded experience. Also know that
+support for the default configuration, without any customization,
+may expire before the next major release.")
+(make-obsolete-variable 'erc-stamp-prepend-date-stamps-p
+ "unsupported legacy behavior" "30.1")
+
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
When the deprecated option `erc-timestamp-format-right' is nil,
@@ -703,7 +713,7 @@ erc-insert-timestamp-left-and-right
Additionally, ensure every date stamp is identifiable as such so
that internal modules can easily distinguish between other
left-sided stamps and date stamps inserted by this function."
- (unless erc-stamp--date-format-end
+ (unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p)
(add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t)
(add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t)
(let ((erc--insert-marker (point-min-marker))
@@ -719,6 +729,13 @@ erc-insert-timestamp-left-and-right
(if erc-timestamp-format-right
(erc-format-timestamp ct erc-timestamp-format-right)
string))))
+ ;; Maybe insert legacy date stamp.
+ (when-let ((erc-stamp-prepend-date-stamps-p)
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ ((not (string= ts-left erc-timestamp-last-inserted-left))))
+ (goto-char (point-min))
+ (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
+ (insert (setq erc-timestamp-last-inserted-left ts-left)))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
(erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index c8f2e04c3eb..a36b781e04d 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -785,6 +785,9 @@ erc-track-select-mode-line-face
choice))
choice))))
+(defvar erc-track--skipped-msgs '(datestamp)
+ "Values of `erc-msg' text prop to ignore.")
+
(defun erc-track-modified-channels ()
"Hook function for `erc-insert-post-hook'.
Check if the current buffer should be added to the mode line as a
@@ -798,10 +801,13 @@ erc-track-modified-channels
;; FIXME either use `erc--server-buffer-p' or
;; explain why that's unwise.
(erc-server-or-unjoined-channel-buffer-p)))
- (not (erc-message-type-member
- (or (erc-find-parsed-property)
- (point-min))
- erc-track-exclude-types)))
+ (not (let ((parsed (erc-find-parsed-property)))
+ (or (erc-message-type-member (or parsed (point-min))
+ erc-track-exclude-types)
+ ;; Skip certain non-server-sent messages.
+ (and (not parsed)
+ (erc--check-msg-prop 'erc-msg
+ erc-track--skipped-msgs))))))
;; If the active buffer is not visible (not shown in a
;; window), and not to be excluded, determine the kinds of
;; faces used in the current message, and unless the user
diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el
index d6b5d868ce5..c420e62fe14 100644
--- a/test/lisp/erc/erc-scenarios-stamp.el
+++ b/test/lisp/erc/erc-scenarios-stamp.el
@@ -50,7 +50,6 @@ erc-scenarios-stamp--left/display-margin-mode
(erc-stamp--current-time 704591940)
(erc-stamp--tz t)
(erc-server-flood-penalty 0.1)
- (erc-timestamp-only-if-changed-flag nil)
(erc-insert-timestamp-function #'erc-insert-timestamp-left)
(erc-modules (cons 'fill-wrap erc-modules))
(erc-timestamp-only-if-changed-flag nil)
@@ -87,4 +86,31 @@ erc-scenarios-stamp--left/display-margin-mode
(should (looking-back "CEIMRUabefhiklmnoqstuv\n"))
(should (looking-at (rx "[")))))))))
+(ert-deftest erc-scenarios-stamp--legacy-date-stamps ()
+ (with-suppressed-warnings ((obsolete erc-stamp-prepend-date-stamps-p))
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reconnect")
+ (erc-stamp-prepend-date-stamps-p t)
+ (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
+ (port (process-contact dumb-server :service))
+ (erc-server-flood-penalty 0.1)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :full-name "tester"
+ :nick "tester")
+ (funcall expect 5 "opening connection")
+ (goto-char (1- (match-beginning 0)))
+ (should (eq 'erc-timestamp (field-at-pos (point))))
+ (should (eq 'unknown (erc--get-inserted-msg-prop 'erc-msg)))
+ ;; Force redraw of date stamp.
+ (setq erc-timestamp-last-inserted-left nil)
+
+ (funcall expect 5 "This server is in debug mode")
+ (while (and (zerop (forward-line -1))
+ (not (eq 'erc-timestamp (field-at-pos (point))))))
+ (should (erc--get-inserted-msg-prop 'erc-cmd)))))))
+
;;; erc-scenarios-stamp.el ends here
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Ensure-marker-for-max-pos-in-erc-traverse-insert.patch --]
[-- Type: text/x-patch, Size: 12255 bytes --]
From 48dfdc118270fbd72ea93ca02363dcda5d7ef528 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 21 Oct 2023 13:53:46 -0700
Subject: [PATCH 3/3] [5.6] Ensure marker for max pos in erc--traverse-inserted
* lisp/erc/erc-stamp.el (erc-stamp--propertize-left-date-stamp):
Run `erc-stamp--insert-date-hook' here.
(erc-stamp--insert-date-stamp-as-phony-message): Don't include value
of `erc-stamp--insert-date-hook' in let-bound `erc-insert-modify-hook'
because it runs twice if buffer-local. Also call getter for
`erc-stamp--current-time' and remove `erc-send-modify-hook' because
that only runs via `erc-display-msg'.
(erc-stamp--lr-date-on-pre-modify,
erc-insert-timestamp-left-and-right): Use function form of
`erc-stamp--current-time' for determining current time stamp.
* lisp/erc/erc.el (erc--get-inserted-msg-bounds): Fix off-by-one.
(erc--traverse-inserted): Create temporary marker when END is non-nil
and not already a marker so that insertions and deletions do not
affect the position at which the loop should end.
(erc--delete-inserted-message): New function.
* test/lisp/erc/erc-tests.el (erc--delete-inserted-message): New test.
(erc--update-modules/unknown): Improve readability slightly.
* test/lisp/erc/resources/erc-d/erc-d-t.el (erc-d-t-make-expecter):
Indicate assertion flavor in error message. (Bug#60936)
---
lisp/erc/erc-stamp.el | 17 +++--
lisp/erc/erc.el | 35 ++++++++--
test/lisp/erc/erc-tests.el | 84 ++++++++++++++++++++++--
test/lisp/erc/resources/erc-d/erc-d-t.el | 1 +
4 files changed, 118 insertions(+), 19 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index e0db472d289..6e35c5e2244 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -638,7 +638,8 @@ erc-stamp--date-format-end
(defun erc-stamp--propertize-left-date-stamp ()
(add-text-properties (point-min) (1- (point-max))
'(field erc-timestamp erc-stamp-type date-left))
- (erc--hide-message 'timestamp))
+ (erc--hide-message 'timestamp)
+ (run-hooks 'erc-stamp--insert-date-hook))
;; A kludge to pass state from insert hook to nested insert hook.
(defvar erc-stamp--current-datestamp-left nil)
@@ -665,19 +666,17 @@ erc-stamp--insert-date-stamp-as-phony-message
(cl-assert string)
(let ((erc-stamp--skip t)
(erc--msg-props (map-into `((erc-msg . datestamp)
- (erc-ts . ,erc-stamp--current-time))
+ (erc-ts . ,(erc-stamp--current-time)))
'hash-table))
- (erc-send-modify-hook `(,@erc-send-modify-hook
- erc-stamp--propertize-left-date-stamp
- ,@erc-stamp--insert-date-hook))
(erc-insert-modify-hook `(,@erc-insert-modify-hook
- erc-stamp--propertize-left-date-stamp
- ,@erc-stamp--insert-date-hook)))
+ erc-stamp--propertize-left-date-stamp))
+ ;; Don't run hooks that aren't expecting a narrowed buffer.
+ (erc-insert-done-hook nil))
(erc-display-message nil nil (current-buffer) string)
(setq erc-timestamp-last-inserted-left string)))
(defun erc-stamp--lr-date-on-pre-modify (_)
- (when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (when-let ((ct (erc-stamp--current-time))
(rendered (erc-stamp--format-date-stamp ct))
((not (string-equal rendered erc-timestamp-last-inserted-left)))
(erc-stamp--current-datestamp-left rendered)
@@ -723,7 +722,7 @@ erc-insert-timestamp-left-and-right
(narrow-to-region erc--insert-marker end-marker)
(set-marker end-marker nil)
(set-marker erc--insert-marker nil)))
- (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (let* ((ct (erc-stamp--current-time))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f618fb17076..872ce5b4f49 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2980,7 +2980,7 @@ erc--get-inserted-msg-bounds
(and-let*
((p (previous-single-property-change point
'erc-msg)))
- (if (= p (1- point)) point (1- p)))))))
+ (if (= p (1- point)) p (1- p)))))))
,@(and (member only '(nil 'end))
'((e (1- (next-single-property-change
(if at-start-p (1+ point) point)
@@ -3005,8 +3005,12 @@ erc--with-inserted-msg
,@body)))
(defun erc--traverse-inserted (beg end fn)
- "Visit messages between BEG and END and run FN in narrowed buffer."
- (setq end (min end (marker-position erc-insert-marker)))
+ "Visit messages between BEG and END and run FN in narrowed buffer.
+If END is a marker, possibly update its position."
+ (unless (markerp end)
+ (setq end (set-marker (make-marker) (or end erc-insert-marker))))
+ (unless (eq end erc-insert-marker)
+ (set-marker end (min erc-insert-marker end)))
(save-excursion
(goto-char beg)
(let ((b (if (get-text-property (point) 'erc-msg)
@@ -3018,7 +3022,9 @@ erc--traverse-inserted
(save-restriction
(narrow-to-region b e)
(funcall fn))
- (setq b e)))))
+ (setq b e))))
+ (unless (eq end erc-insert-marker)
+ (set-marker end nil)))
(defvar erc--insert-marker nil
"Internal override for `erc-insert-marker'.")
@@ -3240,6 +3246,27 @@ erc--hide-message
(cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+(defun erc--delete-inserted-message (beg-or-point &optional end)
+ "Remove message between BEG and END.
+Expect BEG and END to match bounds as returned by the macro
+`erc--get-inserted-msg-bounds'. Ensure all markers residing at
+the start of the deleted message end up at the beginning of the
+subsequent message."
+ (let ((beg beg-or-point))
+ (save-restriction
+ (widen)
+ (unless end
+ (setq end (erc--get-inserted-msg-bounds nil beg-or-point)
+ beg (pop end)))
+ (with-silent-modifications
+ (if erc-legacy-invisible-bounds-p
+ (delete-region beg (1+ end))
+ (save-excursion
+ (goto-char beg)
+ (insert-before-markers
+ (substring (delete-and-extract-region (1- (point)) (1+ end))
+ -1))))))))
+
(defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd))
(defun erc--order-text-properties-from-hash (table)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 57bf5860ac4..1af087e7e31 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1432,6 +1432,80 @@ erc-process-input-line
(should-not calls))))))
+(ert-deftest erc--delete-inserted-message ()
+ (erc-mode)
+ (erc--initialize-markers (point) nil)
+ ;; Put unique invisible properties on the line endings.
+ (erc-display-message nil 'notice nil "one")
+ (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'a)
+ (let ((erc--msg-prop-overrides '((erc-msg . datestamp) (erc-ts . 0))))
+ (erc-display-message nil nil nil
+ (propertize "\n[date]" 'field 'erc-timestamp)))
+ (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'b)
+ (erc-display-message nil 'notice nil "two")
+
+ (ert-info ("Date stamp deleted cleanly")
+ (goto-char 11)
+ (should (looking-at (rx "\n[date]")))
+ (should (eq 'datestamp (get-text-property (point) 'erc-msg)))
+ (should (eq (point) (field-beginning (1+ (point)))))
+
+ (erc--delete-inserted-message (point))
+
+ ;; Preceding line ending clobbered, replaced by trailing.
+ (should (looking-back (rx "*** one\n")))
+ (should (looking-at (rx "*** two")))
+ (should (eq 'b (get-text-property (1- (point)) 'invisible))))
+
+ (ert-info ("Markers at pos-bol preserved")
+ (erc-display-message nil 'notice nil "three")
+ (should (looking-at (rx "*** two")))
+
+ (let ((m (point-marker))
+ (n (point-marker))
+ (p (point)))
+ (set-marker-insertion-type m t)
+ (goto-char (point-max))
+ (erc--delete-inserted-message p)
+ (should (= (marker-position n) p))
+ (should (= (marker-position m) p))
+ (goto-char p)
+ (set-marker m nil)
+ (set-marker n nil)
+ (should (looking-back (rx "*** one\n")))
+ (should (looking-at (rx "*** three")))))
+
+ (ert-info ("Compat")
+ (erc-display-message nil 'notice nil "four")
+ (should (looking-at (rx "*** three\n")))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (let ((erc-legacy-invisible-bounds-p t))
+ (erc--delete-inserted-message (point))))
+ (should (looking-at (rx "*** four\n"))))
+
+ (ert-info ("Deleting most recent message preserves markers")
+ (let ((m (point-marker))
+ (n (point-marker))
+ (p (point)))
+ (should (equal "*** four\n" (buffer-substring p erc-insert-marker)))
+ (set-marker-insertion-type m t)
+ (goto-char (point-max))
+ (erc--delete-inserted-message p)
+ (should (= (marker-position m) p))
+ (should (= (marker-position n) p))
+ (goto-char p)
+ (should (looking-back (rx "*** one\n")))
+ (should (looking-at erc-prompt))
+ (erc--assert-input-bounds)
+
+ ;; However, `m' is now forever "trapped" at `erc-insert-marker'.
+ (erc-display-message nil 'notice nil "two")
+ (should (= m erc-insert-marker))
+ (goto-char n)
+ (should (looking-at (rx "*** two\n")))
+ (set-marker m nil)
+ (set-marker n nil))))
+
(ert-deftest erc--order-text-properties-from-hash ()
(let ((table (map-into '((a . 1)
(erc-ts . 0)
@@ -2617,8 +2691,8 @@ erc--update-modules/unknown
(obarray (obarray-make))
(err (should-error (erc--update-modules erc-modules))))
(should (equal (cadr err) "`foo' is not a known ERC module"))
- (should (equal (funcall get-calls)
- `((req . ,(intern-soft "erc-foo")))))))
+ (should (equal (mapcar #'prin1-to-string (funcall get-calls))
+ '("(req . erc-foo)")))))
;; Module's mode command exists but lacks an associated file.
(ert-info ("Bad autoload flagged as suspect")
@@ -2627,10 +2701,8 @@ erc--update-modules/unknown
(obarray (obarray-make))
(erc-modules (list (intern "foo"))))
- ;; Create a mode activation command.
+ ;; Create a mode-activation command and make mode-var global.
(funcall mk-cmd "foo")
-
- ;; Make the mode var global.
(funcall mk-global "foo")
;; No local modules to return.
@@ -2639,7 +2711,7 @@ erc--update-modules/unknown
'("foo")))
;; ERC requires the library via prefixed module name.
(should (equal (mapcar #'prin1-to-string (funcall get-calls))
- `("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
+ '("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to
;; load its defining library, first via the symbol property
diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el b/test/lisp/erc/resources/erc-d/erc-d-t.el
index cf869fb3c70..7126165fd91 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-t.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-t.el
@@ -157,6 +157,7 @@ erc-d-t-make-expecter
(let (positions)
(lambda (timeout text &optional reset-from)
(let* ((pos (cdr (assq (current-buffer) positions)))
+ (erc-d-t--wait-message-prefix (and (< timeout 0) "Sustaining: "))
(cb (lambda ()
(unless pos
(push (cons (current-buffer) (setq pos (make-marker)))
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <87jzrcccw3.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87jzrcccw3.fsf@neverwas.me>
@ 2023-10-24 17:10 ` Corwin Brust
2023-10-25 2:17 ` J.P.
[not found] ` <87lebra1io.fsf@neverwas.me>
2 siblings, 0 replies; 56+ messages in thread
From: Corwin Brust @ 2023-10-24 17:10 UTC (permalink / raw)
To: J.P.; +Cc: 60936, emacs-erc
[-- Attachment #1: Type: text/plain, Size: 885 bytes --]
On Tue, Oct 24, 2023 at 9:29 AM J.P. <jp@neverwas.me> wrote:
> v2. Fix date-stamp regression in erc-track. Optionally reinstate old
> "prepended" date-stamp behavior gated by new compat var.
>
> Earlier changes for this feature introduced a regression involving date
> stamps and the option `erc-track-exclude-types'. Basically, date stamps
>
>
[SNIP]
>
> To reproduce from -Q:
>
> 1. Connect and ensure "JOIN" appears in `erc-track-exclude-types'
> 2. Join #chan
> 3. From the server buffer, do
>
> (with-current-buffer "#chan"
> (setq erc-timestamp-last-inserted-left nil))
>
> 3. Connect and join #chan from another client
> 4. Notice a [#c] in the mode line of the original client
>
>
I can no longer reproduce after applying the 001-003 patches from your last
to rev 522a74d60a915ca9e922ad42dedc19d9f72e3ae5
Thank you JP!
[-- Attachment #2: Type: text/html, Size: 1436 bytes --]
^ permalink raw reply [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87jzrcccw3.fsf@neverwas.me>
2023-10-24 17:10 ` Corwin Brust
@ 2023-10-25 2:17 ` J.P.
[not found] ` <87lebra1io.fsf@neverwas.me>
2 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-25 2:17 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> v2. Fix date-stamp regression in erc-track. Optionally reinstate old
> "prepended" date-stamp behavior gated by new compat var.
>
> [...]
>
> @@ -665,19 +666,17 @@ erc-stamp--insert-date-stamp-as-phony-message
> (cl-assert string)
> (let ((erc-stamp--skip t)
> (erc--msg-props (map-into `((erc-msg . datestamp)
> - (erc-ts . ,erc-stamp--current-time))
> + (erc-ts . ,(erc-stamp--current-time)))
> 'hash-table))
> - (erc-send-modify-hook `(,@erc-send-modify-hook
> - erc-stamp--propertize-left-date-stamp
> - ,@erc-stamp--insert-date-hook))
> (erc-insert-modify-hook `(,@erc-insert-modify-hook
> - erc-stamp--propertize-left-date-stamp
> - ,@erc-stamp--insert-date-hook)))
> + erc-stamp--propertize-left-date-stamp))
> + ;; Don't run hooks that aren't expecting a narrowed buffer.
This also needs
(erc-insert-pre-hook nil)
> + (erc-insert-done-hook nil))
> (erc-display-message nil nil (current-buffer) string)
> (setq erc-timestamp-last-inserted-left string)))
because any hook member that can't operate in a narrowed buffer will
fail, especially on init, when the narrowed region is empty.
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87lebra1io.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87lebra1io.fsf@neverwas.me>
@ 2023-10-30 13:48 ` J.P.
[not found] ` <87bkcguspb.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-10-30 13:48 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> This also needs
>
> (erc-insert-pre-hook nil)
>
>> + (erc-insert-done-hook nil))
>> (erc-display-message nil nil (current-buffer) string)
>> (setq erc-timestamp-last-inserted-left string)))
>
> because any hook member that can't operate in a narrowed buffer will
> fail, especially on init, when the narrowed region is empty.
The change above was included as part of
5c4a9b73031 * Use marker for max pos in erc--traverse-inserted
This bug is already closed.
^ permalink raw reply [flat|nested] 56+ messages in thread[parent not found: <87bkcguspb.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <87bkcguspb.fsf@neverwas.me>
@ 2023-11-01 0:28 ` J.P.
[not found] ` <874ji6tiyn.fsf@neverwas.me>
1 sibling, 0 replies; 56+ messages in thread
From: J.P. @ 2023-11-01 0:28 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 462 bytes --]
Recent work on this feature introduced an annoying regression.
From emacs -Q:
1. M-: (erc-tls :server "testnet.inspircd.org") RET
2. /JOIN #test and say something
3. M-: (setq erc-timestamp-last-inserted-left nil) RET to reset the
date stamp's deduping snapshot
4. Say something else
5. Notice that point has been dislodged from the prompt and that a new
date stamp has not been inserted
The second of the attached patches should fix it.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Fix-concurrency-bug-in-erc-buffer-display-test.patch --]
[-- Type: text/x-patch, Size: 19436 bytes --]
From fd0fed210fca48cc8a7f754011b1e1aaabc4d9f4 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 30 Oct 2023 23:36:54 -0700
Subject: [PATCH 1/2] [5.6] ; Fix concurrency bug in erc-buffer-display test
* test/lisp/erc/erc-fill-tests.el
(erc-fill-tests--time-vals, erc-fill-tests--current-time-value):
Rename former to latter and change type from function to natnum.
(erc-fill-tests--wrap-populate, erc-fill-wrap--merge,
erc-fill-wrap--merge-action): Use `erc-fill-tests--current-time-value'
instead of function `erc-fill-tests--time-vals'.
* test/lisp/erc/erc-scenarios-base-association.el
(erc-scenarios-common--base-association-multi-net): Extend timeout.
* test/lisp/erc/erc-scenarios-base-buffer-display.el
(erc-scenarios-base-buffer-display--reconnect-common):
Move some common assertions here from callers.
(erc-scenarios-base-buffer-display--defwin-recbury-intbuf,
erc-scenarios-base-buffer-display--count-reset-timeout):
Factor out a couple common assertions. Clarify some comments.
(erc-scenarios-base-buffer-display--defwino-recbury-intbuf):
Factor out a couple common assertions. Clarify some comments.
Account for possible concurrency bug leading to intermittent
test failures.
* test/lisp/erc/erc-scenarios-base-misc-regressions.el
(erc-scenarios-base-gapless-connect,
erc-scenarios-base-channel-buffer-revival): Extend timeouts.
* test/lisp/erc/resources/dcc/chat/accept.eld: Extend timeout.
* test/lisp/erc/resources/base/reconnect/options-again.eld: Extend
timeouts.
* test/lisp/erc/resources/erc-d/erc-d.el (erc-d--m): Prevent
possible wrong-type error.
* test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld: Extend
timeouts.
* test/lisp/erc/resources/erc-scenarios-common.el
(erc-scenarios-common--base-network-id-bouncer): Extend timeout.
---
test/lisp/erc/erc-fill-tests.el | 10 +-
.../erc/erc-scenarios-base-association.el | 2 +-
.../erc/erc-scenarios-base-buffer-display.el | 104 ++++++++++--------
.../erc-scenarios-base-misc-regressions.el | 4 +-
.../base/reconnect/options-again.eld | 4 +-
test/lisp/erc/resources/dcc/chat/accept.eld | 2 +-
test/lisp/erc/resources/erc-d/erc-d.el | 2 +-
.../erc-d/resources/dynamic-foonet.eld | 2 +-
.../erc/resources/erc-scenarios-common.el | 2 +-
9 files changed, 73 insertions(+), 59 deletions(-)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 92424d1e556..8179cbda2cb 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -27,7 +27,7 @@
(require 'erc-fill)
(defvar erc-fill-tests--buffers nil)
-(defvar erc-fill-tests--time-vals (lambda () 0))
+(defvar erc-fill-tests--current-time-value 0)
(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
(declare (indent 1))
@@ -49,7 +49,7 @@ erc-fill-tests--wrap-populate
extended-command-history
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
(cl-letf (((symbol-function 'erc-stamp--current-time)
- (lambda () (funcall erc-fill-tests--time-vals)))
+ (lambda () erc-fill-tests--current-time-value))
((symbol-function 'erc-server-connect)
(lambda (&rest _)
(setq erc-server-process
@@ -261,7 +261,7 @@ erc-fill-wrap--merge
;; 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: "<bob> zero."
- (let ((erc-fill-tests--time-vals (lambda () 1680332400)))
+ (let ((erc-fill-tests--current-time-value 1680332400))
(erc-fill-tests--insert-privmsg "bob" "zero.")
(erc-fill-tests--insert-privmsg "alice" "one.")
(erc-fill-tests--insert-privmsg "alice" "two.")
@@ -297,8 +297,8 @@ erc-fill-wrap--merge-action
(erc-fill-tests--wrap-populate
(lambda ()
- ;; Set this here so that the first few messages are from 1970
- (let ((erc-fill-tests--time-vals (lambda () 1680332400)))
+ ;; Allow prior messages to be from 1970.
+ (let ((erc-fill-tests--current-time-value 1680332400))
(erc-fill-tests--insert-privmsg "bob" "zero.")
(erc-fill-tests--insert-privmsg "bob" "0.5")
diff --git a/test/lisp/erc/erc-scenarios-base-association.el b/test/lisp/erc/erc-scenarios-base-association.el
index a40a4cb7550..10abe14c43b 100644
--- a/test/lisp/erc/erc-scenarios-base-association.el
+++ b/test/lisp/erc/erc-scenarios-base-association.el
@@ -78,7 +78,7 @@ erc-scenarios-common--base-association-multi-net
(with-current-buffer "#chan@foonet"
(funcall expect 3 "bob")
(funcall expect 3 "was created on")
- (funcall expect 3 "prosperous")))
+ (funcall expect 10 "prosperous")))
(ert-info ("All #chan@barnet output consumed")
(with-current-buffer "#chan@barnet"
diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el
index df292a8c113..6a80baeaaa9 100644
--- a/test/lisp/erc/erc-scenarios-base-buffer-display.el
+++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el
@@ -27,7 +27,10 @@
(eval-when-compile (require 'erc-join))
;; These first couple `erc-auto-reconnect-display' tests used to live
-;; in erc-scenarios-base-reconnect but have since been renamed.
+;; in erc-scenarios-base-reconnect but have since been renamed. Note
+;; that these are somewhat difficult to reason about because the user
+;; joins a second channel after reconnecting, and the first is
+;; controlled by `autojoin'.
(defun erc-scenarios-base-buffer-display--reconnect-common
(assert-server assert-chan assert-rest)
@@ -55,6 +58,7 @@ erc-scenarios-base-buffer-display--reconnect-common
(ert-info ("Wait for some output in channels")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(funcall assert-chan expect)
+ (funcall expect 10 "welcome")
(funcall expect 10 "welcome")))
(ert-info ("Server buffer shows connection failed")
@@ -68,6 +72,10 @@ erc-scenarios-base-buffer-display--reconnect-common
(ert-info ("Wait for auto reconnect")
(with-current-buffer "FooNet" (funcall expect 10 "still in debug mode")))
+ (ert-info ("Lone window still shows messages buffer")
+ (should (eq (window-buffer) (messages-buffer)))
+ (should (frame-root-window-p (selected-window))))
+
(funcall assert-rest expect)
(ert-info ("Wait for activity to recommence in both channels")
@@ -76,40 +84,50 @@ erc-scenarios-base-buffer-display--reconnect-common
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
(funcall expect 10 "her elves come here anon")))))
+;; Interactively issuing a slash command resets the auto-reconnect
+;; count, making ERC ignore the option `erc-auto-reconnect-display'
+;; when next displaying a newly set up buffer. In the case of a
+;; /JOIN, the option `erc-interactive-display' takes precedence.
(ert-deftest erc-scenarios-base-buffer-display--defwin-recbury-intbuf ()
:tags '(:expensive-test)
(should (eq erc-buffer-display 'bury))
(should (eq erc-interactive-display 'window))
(should-not erc-auto-reconnect-display)
- (let ((erc-buffer-display 'window)
- (erc-interactive-display 'buffer)
- (erc-auto-reconnect-display 'bury))
+ (let ((erc-buffer-display 'window) ; defwin
+ (erc-interactive-display 'buffer) ; intbuf
+ (erc-auto-reconnect-display 'bury)) ; recbury
(erc-scenarios-base-buffer-display--reconnect-common
(lambda (_)
- (should (eq (window-buffer) (current-buffer)))
- (should-not (frame-root-window-p (selected-window))))
+ (ert-info ("New server buffer appears in a selected split")
+ (should (eq (window-buffer) (current-buffer)))
+ (should-not (frame-root-window-p (selected-window)))))
(lambda (_)
- (should (eq (window-buffer) (current-buffer)))
- (should (equal (get-buffer "FooNet") (window-buffer (next-window)))))
+ (ert-info ("New channel buffer appears in other window")
+ (should (eq (window-buffer) (current-buffer))) ; selected
+ (should (equal (get-buffer "FooNet") (window-buffer (next-window))))))
+
+ (lambda (expect)
+ ;; If we /JOIN #spam now, we'll cancel the auto-reconnect
+ ;; timer, and "#chan" may well pop up in a split before we can
+ ;; verify that the lone window displays #spam (a race, IOW).
+ (ert-info ("Autojoined channel #chan buried on JOIN")
+ (with-current-buffer "#chan"
+ (funcall expect 10 "You have joined channel #chan"))
+ (should (frame-root-window-p (selected-window)))
+ (should (eq (window-buffer) (messages-buffer))))
- (lambda (_)
- (with-current-buffer "FooNet"
- (should (eq (window-buffer) (messages-buffer)))
- (should (frame-root-window-p (selected-window))))
-
- ;; A manual /JOIN command tells ERC we're done auto-reconnecting
(with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam"))
- (ert-info ("#spam ignores `erc-auto-reconnect-display'")
- ;; Uses `erc-interactive-display' instead.
+ (ert-info ("A /JOIN ignores `erc-auto-reconnect-display'")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
(should (eq (window-buffer) (get-buffer "#spam")))
- ;; Option `buffer' replaces entire window (no split)
- (erc-d-t-wait-for 5 (frame-root-window-p (selected-window)))))))))
+ ;; Option `erc-interactive-display' being `buffer' means
+ ;; Emacs reuses the selected window (no split).
+ (should (frame-root-window-p (selected-window)))))))))
(ert-deftest erc-scenarios-base-buffer-display--defwino-recbury-intbuf ()
:tags '(:expensive-test)
@@ -117,7 +135,7 @@ erc-scenarios-base-buffer-display--defwino-recbury-intbuf
(should (eq erc-interactive-display 'window))
(should-not erc-auto-reconnect-display)
- (let ((erc-buffer-display 'window-noselect)
+ (let ((erc-buffer-display 'window-noselect) ; defwino
(erc-auto-reconnect-display 'bury)
(erc-interactive-display 'buffer))
(erc-scenarios-base-buffer-display--reconnect-common
@@ -139,26 +157,24 @@ erc-scenarios-base-buffer-display--defwino-recbury-intbuf
(should (eq (current-buffer) (window-buffer (next-window)))))
(lambda (_)
- (with-current-buffer "FooNet"
- (should (eq (window-buffer) (messages-buffer)))
- (should (frame-root-window-p (selected-window))))
-
- ;; A non-interactive JOIN command doesn't signal that we're
- ;; done auto-reconnecting, and `erc-interactive-display' is
- ;; ignored, so `erc-buffer-display' is again in charge (here,
- ;; that means `window-noselect').
- (ert-info ("Join chan noninteractively and open a /QUERY")
+ ;; A JOIN command sent from lisp code is "non-interactive" and
+ ;; doesn't reset the auto-reconnect count, so ERC treats the
+ ;; response as possibly server-initiated or otherwise the
+ ;; result of an autojoin and continues to favor
+ ;; `erc-auto-reconnect-display'.
+ (ert-info ("Join chan non-interactively and open a /QUERY")
(with-current-buffer "FooNet"
- (erc-cmd-JOIN "#spam")
- ;; However this will reset the option.
- (erc-scenarios-common-say "/QUERY bob")
+ (erc-cmd-JOIN "#spam") ; "non-interactive" according to ERC
+ (erc-scenarios-common-say "/QUERY bob") ; resets count
(should (eq (window-buffer) (get-buffer "bob")))
(should (frame-root-window-p (selected-window)))))
+ ;; The /QUERY above resets the count, and `erc-buffer-display'
+ ;; again decides how #spam is displayed.
(ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
(should (eq (window-buffer) (get-buffer "bob")))
- (should-not (frame-root-window-p (selected-window)))
+ (should-not (frame-root-window-p (selected-window))) ; noselect
(should (eq (current-buffer) (window-buffer (next-window))))))))))
(ert-deftest erc-scenarios-base-buffer-display--count-reset-timeout ()
@@ -177,24 +193,22 @@ erc-scenarios-base-buffer-display--count-reset-timeout
(lambda (_)
(with-current-buffer "FooNet"
- (should erc--server-reconnect-display-timer)
- (should (eq (window-buffer) (messages-buffer)))
- (should (frame-root-window-p (selected-window))))
+ (should erc--server-reconnect-display-timer))
;; A non-interactive JOIN command doesn't signal that we're
- ;; done auto-reconnecting
- (ert-info ("Join chan noninteractively")
+ ;; done auto-reconnecting.
+ (ert-info ("Join channel #spam non-interactively")
(with-current-buffer "FooNet"
(erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer))
- (erc-cmd-JOIN "#spam")))
+ (erc-cmd-JOIN "#spam"))) ; not processed as a /JOIN
- (ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'")
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
- (should (eq (window-buffer) (messages-buffer)))
- ;; If `erc-auto-reconnect-display-timeout' were left alone, this
- ;; would be (frame-root-window-p #<window 1 on *scratch*>).
- (should-not (frame-root-window-p (selected-window)))
- (should (eq (current-buffer) (window-buffer (next-window))))))))))
+ (ert-info ("Option `erc-auto-reconnect-display' ignored w/o timer")
+ (should (eq (window-buffer) (messages-buffer)))
+ (erc-d-t-wait-for 10 (get-buffer "#spam"))
+ ;; If `erc-auto-reconnect-display-timeout' were left alone,
+ ;; this would be (frame-root-window-p #<window 1 on scratch*>).
+ (should-not (frame-root-window-p (selected-window)))
+ (should (eq (get-buffer "#spam") (window-buffer (next-window)))))))))
;; This shows that the option `erc-interactive-display' overrides
;; `erc-join-buffer' during cold opens and interactive /JOINs.
diff --git a/test/lisp/erc/erc-scenarios-base-misc-regressions.el b/test/lisp/erc/erc-scenarios-base-misc-regressions.el
index c1915d088a0..42d7653d3ec 100644
--- a/test/lisp/erc/erc-scenarios-base-misc-regressions.el
+++ b/test/lisp/erc/erc-scenarios-base-misc-regressions.el
@@ -77,7 +77,7 @@ erc-scenarios-base-gapless-connect
(with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#bar"))
(funcall expect 10 "was created on")
- (funcall expect 2 "his second fit"))
+ (funcall expect 10 "his second fit"))
(with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#foo"))
(funcall expect 10 "was created on")
@@ -108,7 +108,7 @@ erc-scenarios-base-channel-buffer-revival
(should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
(ert-info ("Server buffer is unique and temp name is absent")
- (erc-d-t-wait-for 1 (get-buffer "FooNet"))
+ (erc-d-t-wait-for 10 (get-buffer "FooNet"))
(should-not (erc-scenarios-common-buflist "127.0.0.1"))
(with-current-buffer erc-server-buffer-foo
(erc-cmd-JOIN "#chan")))
diff --git a/test/lisp/erc/resources/base/reconnect/options-again.eld b/test/lisp/erc/resources/base/reconnect/options-again.eld
index f1fcc439cc3..8a3264fda9c 100644
--- a/test/lisp/erc/resources/base/reconnect/options-again.eld
+++ b/test/lisp/erc/resources/base/reconnect/options-again.eld
@@ -32,13 +32,13 @@
(0 ":irc.foonet.org 353 tester = #spam :alice tester @bob")
(0 ":irc.foonet.org 366 tester #spam :End of NAMES list"))
-((~mode-chan 4 "MODE #chan")
+((~mode-chan 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620104779")
(0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did violence on herself.")
(0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest of Arden."))
-((mode-spam 4 "MODE #spam")
+((mode-spam 20 "MODE #spam")
(0 ":irc.foonet.org 324 tester #spam +nt")
(0 ":irc.foonet.org 329 tester #spam 1620104779")
(0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #spam :alice: Signior Iachimo will not from it. Pray, let us follow 'em.")
diff --git a/test/lisp/erc/resources/dcc/chat/accept.eld b/test/lisp/erc/resources/dcc/chat/accept.eld
index a23e9580bcc..463f931d26f 100644
--- a/test/lisp/erc/resources/dcc/chat/accept.eld
+++ b/test/lisp/erc/resources/dcc/chat/accept.eld
@@ -17,7 +17,7 @@
(0 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 1.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
;; No mode answer
(0 ":irc.foonet.org NOTICE tester :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.")
(0.2 ":dummy!~u@34n9brushbpj2.irc PRIVMSG tester :\C-aDCC CHAT chat 2130706433 " port "\C-a"))
diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el
index f072c6b93b2..a87904e5830 100644
--- a/test/lisp/erc/resources/erc-d/erc-d.el
+++ b/test/lisp/erc/resources/erc-d/erc-d.el
@@ -297,7 +297,7 @@ erc-d--m
(when erc-d--m-debug
(setq format-string (concat (format-time-string "%s.%N: ") format-string)))
(let ((insertp (and process erc-d--in-process))
- (buffer (process-buffer (process-get process :server))))
+ (buffer (and process (process-buffer (process-get process :server)))))
(when (and insertp (buffer-live-p buffer))
(princ (concat (apply #'format format-string args) "\n") buffer))
(when (or erc-d--m-debug (not insertp))
diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
index e5532980644..2db750e49da 100644
--- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
+++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
@@ -17,7 +17,7 @@
(0. ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0. ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 2 "MODE tester +i")
+((mode-user 4 "MODE tester +i")
(0. ":irc.foonet.org 221 tester +Zi")
(0. ":irc.foonet.org 306 tester :You have been marked as being away")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 9e134e6932f..802ccaeedaa 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -455,7 +455,7 @@ erc-scenarios-common--base-network-id-bouncer
:id foo-id))
(setq erc-server-process-foo erc-server-process)
(erc-scenarios-common-assert-initial-buf-name foo-id port)
- (erc-d-t-wait-for 3 (eq (erc-network) 'foonet))
+ (erc-d-t-wait-for 6 (eq (erc-network) 'foonet))
(erc-d-t-wait-for 3 (string= (buffer-name) serv-buf-foo))
(funcall expect 5 "foonet")))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Preserve-point-when-inserting-date-stamps-in-ERC.patch --]
[-- Type: text/x-patch, Size: 4101 bytes --]
From 65142a8d39af7072a51911ffaf1bd38b2b53fd13 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 31 Oct 2023 16:50:16 -0700
Subject: [PATCH 2/2] [5.6] Preserve point when inserting date stamps in ERC
* lisp/erc/erc-stamp.el
(erc-stamp--insert-date-stamp-as-phony-message): Move `erc--msg-props'
binding to `erc-stamp--lr-date-on-pre-modify'.
(erc-stamp--lr-date-on-pre-modify): Bind `erc--msg-props' here so that
the related guard condition in `erc-add-timestamp' is satisfied and
`erc-insert-timestamp-function' runs. This fixes a regression new in
ERC 5.6 and introduced by c68dc778 "Manage some text props for ERC
insertion-hook members". Also, `save-excursion' when narrowing to
prevent point from being dislodged at the prompt.
(erc-insert-timestamp-left-and-right): Allow global hook members to
run so that those owned by `scrolltobottom' and similar get first
dibs. Also fix wrong hook name.
(erc-stamp--setup): Fix wrong hook name. (Bug#60936)
---
lisp/erc/erc-stamp.el | 25 ++++++++++++++-----------
1 file changed, 14 insertions(+), 11 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index b3812470a4d..7c5413a43c9 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -666,9 +666,6 @@ erc-stamp--insert-date-stamp-as-phony-message
(setq string erc-stamp--current-datestamp-left)
(cl-assert string)
(let ((erc-stamp--skip t)
- (erc--msg-props (map-into `((erc-msg . datestamp)
- (erc-ts . ,(erc-stamp--current-time)))
- 'hash-table))
(erc-insert-modify-hook `(,@erc-insert-modify-hook
erc-stamp--propertize-left-date-stamp))
;; Don't run hooks that aren't expecting a narrowed buffer.
@@ -684,11 +681,17 @@ erc-stamp--lr-date-on-pre-modify
(erc-stamp--current-datestamp-left rendered)
(erc-insert-timestamp-function
#'erc-stamp--insert-date-stamp-as-phony-message))
- (save-restriction
- (narrow-to-region (or erc--insert-marker erc-insert-marker)
- (or erc--insert-marker erc-insert-marker))
- (let (erc-timestamp-format erc-away-timestamp-format)
- (erc-add-timestamp)))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (or erc--insert-marker erc-insert-marker)
+ (or erc--insert-marker erc-insert-marker))
+ ;; Forget current `erc-cmd', etc.
+ (let ((erc--msg-props
+ (map-into `((erc-msg . datestamp)
+ (erc-ts . ,(erc-stamp--current-time)))
+ 'hash-table))
+ erc-timestamp-format erc-away-timestamp-format)
+ (erc-add-timestamp))))))
(defvar erc-stamp-prepend-date-stamps-p nil
"When non-nil, date stamps are not independent messages.
@@ -715,8 +718,8 @@ erc-insert-timestamp-left-and-right
that internal modules can easily distinguish between other
left-sided stamps and date stamps inserted by this function."
(unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p)
- (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t)
- (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t)
+ (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify 10 t)
+ (add-hook 'erc-pre-send-functions #'erc-stamp--lr-date-on-pre-modify 10 t)
(let ((erc--insert-marker (point-min-marker))
(end-marker (point-max-marker)))
(set-marker-insertion-type erc--insert-marker t)
@@ -817,7 +820,7 @@ erc-stamp--setup
(erc-munge-invisibility-spec))
;; Undo local mods from `erc-insert-timestamp-left-and-right'.
(remove-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify t)
- (remove-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify t)
+ (remove-hook 'erc-pre-send-functions #'erc-stamp--lr-date-on-pre-modify t)
(kill-local-variable 'erc-stamp--date-format-end)))
(defun erc-hide-timestamps ()
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread[parent not found: <874ji6tiyn.fsf@neverwas.me>]
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <874ji6tiyn.fsf@neverwas.me>
@ 2023-11-06 2:30 ` J.P.
0 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-11-06 2:30 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> Recent work on this feature introduced an annoying regression.
>
>>From emacs -Q:
>
> 1. M-: (erc-tls :server "testnet.inspircd.org") RET
> 2. /JOIN #test and say something
> 3. M-: (setq erc-timestamp-last-inserted-left nil) RET to reset the
> date stamp's deduping snapshot
> 4. Say something else
> 5. Notice that point has been dislodged from the prompt and that a new
> date stamp has not been inserted
>
> The second of the attached patches should fix it.
This and related fixes involving date stamps were recently installed.
See:
* f99a0dae7ca Align date stamps to whole days in ERC
* 4c851085769 Decouple disparate escape-hatch concerns in erc-stamp
* 781f950edab Preserve user markers when inserting ERC date stamps
* f7c7f7ac20d Don't over-truncate erc-timestamp-format-left
The second one might be of interest to users with a legitimate need to
call `erc-insert-line' (formerly `erc-display-line') directly, as
opposed to via `erc-display-message'. It's now possible to do so without
sacrificing timestamps and without also incurring the likely unwanted
`cursor-sensor-functions' property. (The latter now has its own separate
compatibility flag.)
^ permalink raw reply [flat|nested] 56+ messages in thread
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
[not found] ` <874jj3ok58.fsf@neverwas.me>
2023-10-14 0:24 ` J.P.
[not found] ` <87cyxi9hlc.fsf@neverwas.me>
@ 2024-04-09 18:19 ` J.P.
2 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2024-04-09 18:19 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 3427 bytes --]
"J.P." <jp@neverwas.me> writes:
>>From ef4974d8e232b0d5e5df31a30f2fd904f970c60f Mon Sep 17 00:00:00 2001
> From: "F. Jason Park" <jp@neverwas.me>
> Date: Thu, 21 Sep 2023 23:54:31 -0700
> Subject: [PATCH 6/7] [5.6] Manage meta-data text props for ERC hook members
>
> * etc/ERC-NEWS: Mention that `cursor-sensor-functions' is only added
> when `erc-echo-timestamps' is enabled, and mention that date stamps
> are now inserted as separate messages.
>
[...]
>
> (erc-stamp--date-format-end, erc-stamp--propertize-left-date-stamp):
> New function and auxiliary variable to apply date stamp properties at
> the post-modify stage. Add text property `erc-stamp-type' to inserted
> date stamps to help folks distinguish between them and other
> left-sided stamps.
> (erc-stamp-date-left-p): New public function for third-party code to
> detect whether a message is a date stamp.
> (erc-stamp--current-datestamp-left,
> erc-stamp--insert-date-stamp-as-phony-message,
> erc-stamp--lr-date-on-pre-modify): New functions and state variable to
> help ERC treat date stamps as separate messages while working within
> the established mechanism for processing inserted messages. Shadow
> `erc-stamp--invisible-property' when calling `erc-format-timestamp' in
> order to prevent date stamps from inheriting other `invisible' props.
> These date stamps are special in that they have no business being
> hidden along with the current message.
> (erc-insert-timestamp-left-and-right): On initial run in any buffer,
> record whether date stamp needs massaging on insertion. Move all
> business for inserting date stamps to post-modify hooks, but run them
> forcibly if this is the very first date stamp in the current buffer.
The above patch, which was installed as
commit c68dc7786fc808b1ff7deb32d9964ae860e26f1e
Manage some text props for ERC insertion-hook members
(along with various fixups that followed) were meant to outfit date
stamps with foundational elements supporting what's sometimes referred
to as "buffer mutability" by IRC people. What they're referring to are
support mechanisms (like message traversal, deletion, insertion, hiding,
etc.) that enable rich and dynamic next-generation features rather than
a simplistic, append-only display log.
The changes referenced above tackled this by moving date stamps to
separate messages, which was seen as superior to other ideas, like
intervening overlays between messages, because it allowed existing
formatting-related code to detect and affect date stamps with minimal
added fuss.
However, the chosen implementation was imperfect and arguably nullified
those advantages by effectively "nesting" calls to display hooks, which
some third-party hook members may not find agreeable. The justification
for this was "a lesser of two evils" hand wave aimed at avoiding the
alternative, which was more maintenance intensive on account of various
concurrency and data-coordination complications.
Despite this, the benefit of hindsight has changed my view on the
matter, and I'm now of the opinion the additional maintenance pains are
worth enduring if the associated gains come with less risk of
third-party breakage, even if no one has yet complained. The attached
patch attempts to switch tacks to this more complicated but less risky
approach by deferring date insertions to ephemeral, single-shot
`erc-timer-hook' and `erc-send-completed-hook' members. Comments
welcome.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-lisp-erc-erc-services.el-erc-nickserv-alist-Doc.patch --]
[-- Type: text/x-patch, Size: 4301 bytes --]
From 5c3b4838df7741dcfeb90eb914e7a5bba379441b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 7 Apr 2024 19:28:24 -0700
Subject: [PATCH 1/2] ; * lisp/erc/erc-services.el (erc-nickserv-alist): Doc.
---
lisp/erc/erc-services.el | 50 ++++++++++++++++++++++------------------
1 file changed, 28 insertions(+), 22 deletions(-)
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 92cb9075b5e..0881006ed77 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -22,6 +22,13 @@
;;; Commentary:
+;; As of ERC 5.6, this library's main module, `services', mainly
+;; concerns itself with authenticating to legacy IRC servers. If your
+;; server supports SASL or CERTFP, please use one of those instead.
+;; See (info "(erc) client-certificate") and (info "(erc) SASL") for
+;; details. Note that this library also contains the local module
+;; `services-regain' as well as standalone utility functions.
+
;; There are two ways to go about identifying yourself automatically to
;; NickServ with this module. The more secure way is to listen for identify
;; requests from the user NickServ. Another way is to identify yourself to
@@ -37,10 +44,7 @@
;; Usage:
;;
-;; Put into your .emacs:
-;;
-;; (require 'erc-services)
-;; (erc-services-mode 1)
+;; Customize the option `erc-modules' to include `services'.
;;
;; Add your nickname and NickServ password to `erc-nickserv-passwords'.
;; Using the Libera.Chat network as an example:
@@ -50,10 +54,7 @@
;;
;; The default automatic identification mode is autodetection of NickServ
;; identify requests. Set the variable `erc-nickserv-identify-mode' if
-;; you'd like to change this behavior. You can also change the way
-;; automatic identification is handled by using:
-;;
-;; M-x erc-nickserv-identify-mode
+;; you'd like to change this behavior.
;;
;; If you'd rather not identify yourself automatically but would like access
;; to the functions contained in this file, just load this file without
@@ -309,21 +310,26 @@ erc-nickserv-alist
"/msg\\s-NickServ\\s-IDENTIFY\\s-\^_password"
"NickServ@services.slashnet.org"
"IDENTIFY" nil nil nil))
- "Alist of NickServer details, sorted by network.
+ "Alist of NickServer details, sorted by network.
Every element in the list has the form
- (SYMBOL NICKSERV REGEXP NICK KEYWORD USE-CURRENT ANSWER SUCCESS-REGEXP)
-
-SYMBOL is a network identifier, a symbol, as used in `erc-networks-alist'.
-NICKSERV is the description of the nickserv in the form nick!user@host.
-REGEXP is a regular expression matching the message from nickserv.
-NICK is nickserv's nickname. Use nick@server where necessary/possible.
-KEYWORD is the keyword to use in the reply message to identify yourself.
-USE-CURRENT indicates whether the current nickname must be used when
- identifying.
-ANSWER is the command to use for the answer. The default is `privmsg'.
-SUCCESS-REGEXP is a regular expression matching the message nickserv
- sends when you've successfully identified.
-The last two elements are optional."
+ (NETWORK SENDER INSTRUCT-RX NICK SUBCMD YOUR-NICK-P ANSWER SUCCESS-RX)
+
+NETWORK is a network identifier, a symbol, as used in `erc-networks-alist'.
+SENDER is the exact nick!user@host \"source\" for \"NOTICE\" messages
+indicating success or requesting that the user identify.
+INSTRUCT-RX is a regular expression matching a \"NOTICE\" from the
+ services bot instructing the user to identify. It must be non-null
+ when the option `erc-nickserv-identify-mode' is set to `autodetect'.
+ When it's `both', and this field is non-null, ERC will forgo
+ identifying on nick changes and after connecting.
+NICK is the nickname of the services bot to use when issuing commands.
+SUBCMD is the bot command for identifying, typically \"IDENTIFY\".
+YOUR-NICK-P indicates whether to send the user's current nickname before
+ their password when identifying.
+ANSWER is the command to use for the answer. The default is \"PRIVMSG\".
+SUCCESS-RX is a regular expression matching the message NickServ sends
+ when you've successfully identified.
+The last two elements are optional, as are others, where implied."
:type '(repeat
(list :tag "Nickserv data"
(symbol :tag "Network name")
--
2.44.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Don-t-nest-date-stamp-insertions-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 30292 bytes --]
From 8757eeafbee2c1befafa2ce277c39c195350f802 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 8 Apr 2024 14:21:43 -0700
Subject: [PATCH 2/2] [5.6] Don't nest date stamp insertions in erc-stamp
* etc/ERC-NEWS: Don't mention certain insertion-adjacent hooks being
suppressed for date stamps, which is no longer true.
* lisp/erc/erc-fill.el (erc-fill-wrap): Don't move last-message marker
when encountering a date stamp.
* lisp/erc/erc-stamp.el (erc-stamp--recover-on-reconnect): Restore
`erc-stamp--date-stamps' on reconnect or rejoin.
(erc-stamp--date): New struct.
(erc-stamp--deferred-date-stamp): New internal variable to pass state
between hook members.
(erc-stamp--date-stamps): New internal variable to store a reference
to all inserted timestamps.
(erc-stamp--find-insertion-point): New helper function.
(erc-stamp--insert-date-stamp-as-phony-message)
(erc-stamp--lr-date-on-pre-modify): Remove.
(erc-stamp--defer-date-insertion-on-post-modify)
(erc-stamp--defer-date-insertion-on-post-insert)
(erc-stamp--defer-date-insertion-on-post-send): New function.
(erc-stamp--date-mode): Update hook-member functions.
(erc-stamp-prepend-date-stamps-p): Revise doc.
(erc-insert-timestamp-left-and-right): Remove code to initialize a
date stamp in place. Pre-render date stamp and stash it for retrieval
by `erc-stamp--defer-date-insertion-on-post-modify'.
(erc-stamp--setup): Kill `erc-stamp--deferred-date-stamp' and
`erc-stamp--date-stamps'.
(erc-stamp--reset-on-clear): Account for `erc--insert-marker' being
non-nil and remove trimmed stamps from `erc-stamp--date-stamps'.
* lisp/erc/erc.el (erc--insert-line-function): Expand doc string.
(erc--hide-message): Add new parameter `splicep' for hiding messages
being inserted between existing ones rather than at the prompt.
* test/lisp/erc/erc-button-tests.el
(erc-button-tests--erc-button-alist--function-as-form): Update
expected button bounds.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--insert-privmsg)
(erc-fill-tests--wrap-populate, erc-fill-wrap-tests--merge-action)
(erc-fill-line-spacing): Use `erc-display-message' wrappers to
intercept `erc-timer-hook' modifications.
* test/lisp/erc/resources/erc-tests-common.el
(erc-tests--common-display-message)
(erc-tests-common-display-message)
(erc-tests-common-with-date-aware-display-message): New functions and
macro for running `erc-display-message' while intercepting additions
to `erc-timer-hook'.
(erc-tests-common-snapshot-compare): Insert expected output into its
own buffer. This change is unrelated to the rest of this commit.
(Bug#60936)
---
etc/ERC-NEWS | 18 +-
lisp/erc/erc-fill.el | 2 -
lisp/erc/erc-stamp.el | 209 ++++++++++++--------
lisp/erc/erc.el | 16 +-
test/lisp/erc/erc-button-tests.el | 8 +-
test/lisp/erc/erc-fill-tests.el | 48 ++---
test/lisp/erc/resources/erc-tests-common.el | 34 +++-
7 files changed, 204 insertions(+), 131 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index d7f513addfb..b66ea6a7a02 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -486,16 +486,14 @@ these areas without inflicting collateral damage.
Despite the rationale, this move admittedly ushers in a heightened
potential for disruption because third-party members of ERC's
modification hooks may not take kindly to encountering stamp-only
-messages. They may also expect members of 'erc-insert-pre-hook' and
-'erc-insert-done-hook' to run unconditionally, even though ERC
-suppresses those hooks when inserting date stamps. Third parties may
-also not appreciate that 'erc-timestamp-last-inserted-left' no longer
-records the final trailing newline in 'erc-timestamp-format-left'. If
-these inconveniences prove too encumbering to deal with right away,
-see the escape hatch 'erc-stamp-prepend-date-stamps-p', which should
-help ease the transition. As for detecting these new stamp-only
-messages from members of 'erc-insert-modify-hook' and friends, see the
-function 'erc-stamp-inserting-date-stamp-p'.
+messages or the new behavior of 'erc-timestamp-last-inserted-left',
+which no longer records the final trailing newline in the variable
+'erc-timestamp-format-left'. If these inconveniences prove too
+encumbering to deal with right away, see the escape hatch
+'erc-stamp-prepend-date-stamps-p', which should help ease the
+transition. As for detecting these new stamp-only messages from
+members of 'erc-insert-modify-hook' and friends, see the function
+'erc-stamp-inserting-date-stamp-p'.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and "provided" library
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index aa12b807fbc..c40026683ad 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -679,8 +679,6 @@ erc-fill-wrap
(skip-syntax-forward "^-")
(forward-char)
(cond ((eq msg-prop 'datestamp)
- (when erc-fill--wrap-last-msg
- (set-marker erc-fill--wrap-last-msg (point-min)))
(save-excursion
(goto-char (point-max))
(skip-chars-backward "\n")
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index bcb9b4aafef..63abbfefcb3 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -202,7 +202,8 @@ erc-stamp--recover-on-reconnect
(when-let ((priors (or erc--server-reconnecting erc--target-priors)))
(dolist (var '(erc-timestamp-last-inserted
erc-timestamp-last-inserted-left
- erc-timestamp-last-inserted-right))
+ erc-timestamp-last-inserted-right
+ erc-stamp--date-stamps))
(when-let (existing (alist-get var priors))
(set var existing)))))
@@ -652,7 +653,7 @@ erc-insert-timestamp-right
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
(defvar erc-stamp--insert-date-hook nil
- "Functions appended to send and modify hooks when inserting date stamp.")
+ "Hook run when inserting a date stamp.")
(defvar-local erc-stamp--date-format-end nil
"Tristate value indicating how and whether date stamps have been set up.
@@ -661,9 +662,27 @@ erc-stamp--date-format-end
truncating `erc-timestamp-format-left' prior to rendering. A
value of t means the option's value doesn't require trimming.")
-(defun erc-stamp--propertize-left-date-stamp ()
+;; This struct and its namesake variable exist to assist in testing.
+(cl-defstruct erc-stamp--date
+ "Data relevant to life cycle of date-stamp insertion."
+ ( ts (error "Missing `ts' field") :type (or cons integer)
+ :documentation "Time recorded by `erc-insert-timestamp-left-and-right'.")
+ ( str (error "Missing `str' field") :type string
+ :documentation "Stamp rendered by `erc-insert-timestamp-left-and-right'.")
+ ( fn nil :type (or null function)
+ :documentation "Deferred insertion function created by post-modify hook.")
+ ( marker (make-marker) :type marker
+ :documentation "Insertion marker."))
+
+(defvar-local erc-stamp--deferred-date-stamp nil
+ "Active `erc-stamp--date' instance.
+Non-nil between insertion-modification and \"done\" (or timer) hook.")
+
+(defvar-local erc-stamp--date-stamps nil
+ "List of stamps in the current buffer.")
+
+(defun erc-stamp--propertize-left-date-stamp (&rest _)
(add-text-properties (point-min) (1- (point-max)) '(field erc-timestamp))
- (erc--hide-message 'timestamp)
(run-hooks 'erc-stamp--insert-date-hook))
(defun erc-stamp--format-date-stamp (ct)
@@ -680,6 +699,16 @@ erc-stamp--format-date-stamp
0 erc-stamp--date-format-end)
erc-timestamp-format-left))))
+(defun erc-stamp--find-insertion-point (p target-time)
+ "Scan buffer backwards from P looking for TARGET-TIME.
+Return P or, if found, a position less than P."
+ (while-let ((q (previous-single-property-change (1- p) 'erc--ts))
+ (qq (erc--get-inserted-msg-beg q))
+ (ts (get-text-property qq 'erc--ts))
+ ((not (time-less-p ts target-time))))
+ (setq p qq))
+ p)
+
(defun erc-stamp-inserting-date-stamp-p ()
"Return non-nil if the narrowed buffer contains a date stamp.
Expect to be called by members of `erc-insert-modify-hook' and
@@ -687,75 +716,76 @@ erc-stamp-inserting-date-stamp-p
inserted is a date stamp."
(erc--check-msg-prop 'erc--msg 'datestamp))
-;; Calling `erc-display-message' from within a hook it's currently
-;; running is roundabout, but it's a definite means of ensuring hooks
-;; can act on the date stamp as a standalone message to do things like
-;; adjust invisibility props.
-(defun erc-stamp--insert-date-stamp-as-phony-message (string)
- (cl-assert (string-empty-p string))
- (setq string erc-timestamp-last-inserted-left)
- (let ((erc-stamp--skip t)
- (erc-insert-modify-hook `(,@erc-insert-modify-hook
- erc-stamp--propertize-left-date-stamp))
- (erc--insert-line-function #'insert-before-markers)
- ;; Don't run hooks that aren't expecting a narrowed buffer.
- (erc-insert-pre-hook nil)
- (erc-insert-done-hook nil))
- (erc-display-message nil nil (current-buffer) string)))
-
-(defun erc-stamp--lr-date-on-pre-modify (_)
- (when-let (((not erc-stamp--skip))
- (ct (erc-stamp--current-time))
- (rendered (erc-stamp--format-date-stamp ct))
- ((not (string-equal rendered erc-timestamp-last-inserted-left)))
- (erc-insert-timestamp-function
- #'erc-stamp--insert-date-stamp-as-phony-message))
- (save-excursion
- (save-restriction
- (narrow-to-region (or erc--insert-marker erc-insert-marker)
- (or erc--insert-marker erc-insert-marker))
- ;; Ensure all hooks, like `erc-stamp--insert-date-hook', only
- ;; see the let-bound value below during `erc-add-timestamp'.
- (setq erc-timestamp-last-inserted-left nil)
- (let* ((aligned (erc-stamp--time-as-day ct))
- (erc-stamp--current-time aligned)
- ;; Forget current `erc--cmd', etc.
- (erc--msg-props (map-into `((erc--msg . datestamp))
- 'hash-table))
- (erc-timestamp-last-inserted-left rendered)
- erc-timestamp-format erc-away-timestamp-format)
- (erc-add-timestamp))
- (setq erc-timestamp-last-inserted-left rendered)))))
-
-;; This minor mode is just a placeholder and currently unhelpful for
-;; managing complexity. A useful version would leave a marker during
-;; post-modify hooks and then perform insertions (before markers)
-;; during "done" hooks. This would enable completely decoupling from
-;; and possibly deprecating `erc-insert-timestamp-left-and-right'.
-;; However, doing this would require expanding the internal API to
-;; include insertion and deletion handlers for twiddling and massaging
-;; text properties based on context immediately after modifying text
-;; earlier in a buffer (away from `erc-insert-marker'). Without such
-;; handlers, things like "merged" `fill-wrap' speakers and invisible
-;; messages may be damaged by buffer modifications.
+(defun erc-stamp--defer-date-insertion-on-post-modify (hook-var)
+ "Schedule a date stamp to be inserted via HOOK-VAR.
+Do so when `erc-stamp--deferred-date-stamp' and its `fn' slot are
+non-nil."
+ (when-let ((data erc-stamp--deferred-date-stamp)
+ ((null (erc-stamp--date-fn data)))
+ (ct (erc-stamp--date-ts data))
+ (rendered (erc-stamp--date-str data))
+ (buffer (current-buffer))
+ (symbol (make-symbol "erc-stamp--insert-date"))
+ (marker (setf (erc-stamp--date-marker data) (point-min-marker))))
+ (setf (erc-stamp--date-fn data) symbol)
+ (fset symbol
+ (lambda (&rest _)
+ (remove-hook hook-var symbol)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (setq erc-stamp--date-stamps
+ (cl-sort (cons data erc-stamp--date-stamps) #'time-less-p
+ :key #'erc-stamp--date-ts))
+ (setq erc-stamp--deferred-date-stamp nil)
+ (set-marker-insertion-type marker t)
+ (let* ((aligned (erc-stamp--time-as-day ct))
+ (pt (erc-stamp--find-insertion-point marker aligned))
+ (erc--insert-marker (set-marker marker pt))
+ (erc-stamp--current-time aligned)
+ (erc--msg-props (map-into '((erc--msg . datestamp))
+ 'hash-table))
+ (erc-insert-post-hook
+ `(,(lambda () (erc--hide-message 'timestamp 'splice))
+ ,@erc-insert-post-hook))
+ (erc-insert-timestamp-function
+ #'erc-stamp--propertize-left-date-stamp)
+ (erc--insert-line-function #'insert-before-markers)
+ ;;
+ erc-timestamp-format erc-away-timestamp-format)
+ (erc-display-message nil nil (current-buffer) rendered)
+ (setf (erc-stamp--date-ts data) aligned))
+ (setq erc-timestamp-last-inserted-left rendered)))))
+ (add-hook hook-var symbol -90)))
+
+(defun erc-stamp--defer-date-insertion-on-post-insert ()
+ (erc-stamp--defer-date-insertion-on-post-modify 'erc-timer-hook))
+
+(defun erc-stamp--defer-date-insertion-on-post-send ()
+ (erc-stamp--defer-date-insertion-on-post-modify 'erc-send-completed-hook))
+
+;; This minor mode is hopefully just a placeholder because it's quite
+;; unhelpful for managing complexity. A useful version would exist as
+;; a standalone module to allow completely decoupling from and
+;; possibly deprecating `erc-insert-timestamp-left-and-right'.
(define-minor-mode erc-stamp--date-mode
"Insert date stamps as standalone messages."
:interactive nil
(if erc-stamp--date-mode
- (progn (add-hook 'erc-insert-pre-hook
- #'erc-stamp--lr-date-on-pre-modify 10 t)
- (add-hook 'erc-pre-send-functions
- #'erc-stamp--lr-date-on-pre-modify 10 t))
+ (progn
+ (add-hook 'erc-insert-post-hook
+ #'erc-stamp--defer-date-insertion-on-post-insert 0 t)
+ (add-hook 'erc-send-post-hook
+ #'erc-stamp--defer-date-insertion-on-post-send 0 t))
(kill-local-variable 'erc-timestamp-last-inserted-left)
- (remove-hook 'erc-insert-pre-hook
- #'erc-stamp--lr-date-on-pre-modify t)
- (remove-hook 'erc-pre-send-functions
- #'erc-stamp--lr-date-on-pre-modify t)))
+ (remove-hook 'erc-insert-post-hook
+ #'erc-stamp--defer-date-insertion-on-post-insert t)
+ (remove-hook 'erc-send-post-hook
+ #'erc-stamp--defer-date-insertion-on-post-send t)))
(defvar erc-stamp-prepend-date-stamps-p nil
"When non-nil, date stamps are not independent messages.
-This flag restores pre-5.6 behavior in which date stamps formed
-the leading portion of affected messages. Beware that enabling
+This flag restores pre-5.6 behavior in which date stamps were
+prepended to normal chat messages. Beware that enabling
this degrades the user experience by causing 5.6+ features, like
`fill-wrap', dynamic invisibility, etc., to malfunction. When
non-nil, none of the newline twiddling mentioned in the doc
@@ -775,26 +805,17 @@ erc-insert-timestamp-left-and-right
Allow the stamp's `invisible' property to span that same interval
but also cover the previous newline, in order to satisfy folding
requirements related to `erc-legacy-invisible-bounds-p'.
-Additionally, ensure every date stamp is identifiable as such so
-that internal modules can easily distinguish between other
-left-sided stamps and date stamps inserted by this function."
+Additionally, ensure every date stamp is identifiable as such via
+the function `erc-stamp-inserting-date-stamp-p' so that internal
+modules can easily distinguish between other left-sided stamps
+and date stamps inserted by this function."
(unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p
(and (or (null erc-timestamp-format-left)
(string-empty-p ; compat
(string-trim erc-timestamp-format-left "\n")))
(always (erc-stamp--date-mode -1))
(setq erc-stamp-prepend-date-stamps-p t)))
- (erc-stamp--date-mode +1)
- ;; Hooks used by ^ are the preferred means of inserting date
- ;; stamps. But they'll never see this inaugural message, so it
- ;; must be handled specially.
- (let ((erc--insert-marker (point-min-marker))
- (end-marker (point-max-marker)))
- (set-marker-insertion-type erc--insert-marker t)
- (erc-stamp--lr-date-on-pre-modify nil)
- (narrow-to-region erc--insert-marker end-marker)
- (set-marker end-marker nil)
- (set-marker erc--insert-marker nil)))
+ (erc-stamp--date-mode +1))
(let* ((ct (erc-stamp--current-time))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
@@ -805,12 +826,22 @@ erc-insert-timestamp-left-and-right
;; "prepended" date stamps as well. However, since this is a
;; compatibility oriented code path, and pre-5.6 did no such
;; thing, better to punt.
- (when-let ((erc-stamp-prepend-date-stamps-p)
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- ((not (string= ts-left erc-timestamp-last-inserted-left))))
- (goto-char (point-min))
- (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
- (insert (setq erc-timestamp-last-inserted-left ts-left)))
+ (if-let ((erc-stamp-prepend-date-stamps-p)
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ ((not (string= ts-left erc-timestamp-last-inserted-left))))
+ (progn
+ (goto-char (point-min))
+ (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp
+ ts-left)
+ (insert (setq erc-timestamp-last-inserted-left ts-left)))
+ (when-let
+ (((null erc-stamp--deferred-date-stamp))
+ (rendered (erc-stamp--format-date-stamp ct))
+ ((not (string-equal rendered erc-timestamp-last-inserted-left)))
+ ((null (cl-find rendered erc-stamp--date-stamps
+ :test #'string= :key #'erc-stamp--date-str))))
+ (setq erc-stamp--deferred-date-stamp
+ (make-erc-stamp--date :ts ct :str rendered))))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
(erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
@@ -924,6 +955,8 @@ erc-stamp--setup
(kill-local-variable 'erc-stamp--last-stamp)
(kill-local-variable 'erc-timestamp-last-inserted)
(kill-local-variable 'erc-timestamp-last-inserted-right)
+ (kill-local-variable 'erc-stamp--deferred-date-stamp)
+ (kill-local-variable 'erc-stamp--date-stamps)
(kill-local-variable 'erc-stamp--date-format-end)))
(defun erc-hide-timestamps ()
@@ -993,7 +1026,11 @@ erc-stamp--update-saved-position
(defun erc-stamp--reset-on-clear (pos)
"Forget last-inserted stamps when POS is at insert marker."
- (when (= pos (1- erc-insert-marker))
+ (when (= pos (1- (or erc--insert-marker erc-insert-marker)))
+ (when erc-stamp--date-stamps
+ (setq erc-stamp--date-stamps
+ (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos))
+ erc-stamp--date-stamps)))
(when erc-stamp--date-mode
(add-hook 'erc-stamp--insert-date-hook
#'erc-stamp--update-saved-position 0 t))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 4ed77655f19..4ec8c40c7c6 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3325,7 +3325,11 @@ erc--insert-invisible-as-intangible-p
time, so if you need them, please let ERC know with \\[erc-bug].")
(defvar erc--insert-line-function nil
- "When non-nil, an alterntive to `insert' for inserting messages.")
+ "When non-nil, an `insert'-like function for inserting messages.
+Modules, like `fill-wrap', that leave a marker at the beginning of an
+inserted message clearly want that marker to advance along with text
+inserted at that position. This can be addressed by binding this
+variable to `insert-before-markers' around calls to `display-message'.")
(defvar erc--insert-marker nil
"Internal override for `erc-insert-marker'.")
@@ -3573,13 +3577,15 @@ erc-legacy-invisible-bounds-p
(make-obsolete-variable 'erc-legacy-invisible-bounds-p
"decremented interval now permanent" "30.1")
-(defun erc--hide-message (value)
+(defun erc--hide-message (value &optional splicep)
"Apply `invisible' text-property with VALUE to current message.
Expect to run in a narrowed buffer during message insertion.
Begin the invisible interval at the previous message's trailing
newline and end before the current message's. If the preceding
message ends in a double newline or there is no previous message,
-don't bother including the preceding newline."
+don't bother including the preceding newline. With SPLICEP,
+transplant the `invisible' props from the trailing newline before
+`point-min' to the inserted newline at `point-max'."
(if erc-legacy-invisible-bounds-p
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
@@ -3588,6 +3594,10 @@ erc--hide-message
(end (point-max)))
(save-restriction
(widen)
+ (when-let ((splicep)
+ (bval (get-text-property (1- beg) 'invisible)))
+ (put-text-property (1- end) end 'invisible bval)
+ (remove-text-properties (1- beg) beg '(invisible nil)))
(when (or (<= beg 4) (= ?\n (char-before (- beg 2))))
(cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el
index 603b3745a27..9d8fb0081c5 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -74,9 +74,11 @@ erc-button-tests--erc-button-alist--function-as-form
(entry (list (rx "+1") 0 func #'ignore 0))
(erc-button-alist (cons entry erc-button-alist)))
- (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
- (erc-display-message nil nil (current-buffer) "+1")
- (erc-display-message nil 'notice (current-buffer) "Spam")
+ (erc-tests-common-display-message nil 'notice (current-buffer)
+ "Foo bar baz")
+ (erc-tests-common-display-message nil nil (current-buffer) "+1")
+ (erc-tests-common-display-message nil 'notice (current-buffer) "Spam")
+
(should (equal (pop erc-button-tests--form)
'(53 55 ignore nil ("+1") "\\+1")))
(should-not erc-button-tests--form)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 3c4ad04abd7..250ade90587 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -48,7 +48,7 @@ erc-fill-tests--insert-privmsg
:command "PRIVMSG"
:command-args (list "#chan" msg)
:contents msg)))
- (erc-display-message parsed nil (current-buffer) msg)))
+ (erc-tests-common-display-message parsed nil (current-buffer) msg)))
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
@@ -79,7 +79,7 @@ erc-fill-tests--wrap-populate
(erc-update-channel-member
"#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
- (erc-display-message
+ (erc-tests-common-display-message
nil 'notice (current-buffer)
(concat "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 "
@@ -260,29 +260,31 @@ erc-fill-wrap-tests--merge-action
(erc-fill-tests--insert-privmsg "bob" "zero.")
(erc-fill-tests--insert-privmsg "bob" "0.5")
- (erc-process-ctcp-query
- erc-server-process
- (make-erc-response
- :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1"
- :sender "bob!~u@fake"
- :command "PRIVMSG"
- :command-args '("#chan" "\1ACTION one.\1")
- :contents "\1ACTION one.\1")
- "bob" "~u" "fake")
+ (erc-tests-common-with-date-aware-display-message
+ (erc-process-ctcp-query
+ erc-server-process
+ (make-erc-response
+ :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1"
+ :sender "bob!~u@fake"
+ :command "PRIVMSG"
+ :command-args '("#chan" "\1ACTION one.\1")
+ :contents "\1ACTION one.\1")
+ "bob" "~u" "fake"))
(erc-fill-tests--insert-privmsg "bob" "two.")
(erc-fill-tests--insert-privmsg "bob" "2.5")
;; Compat switch to opt out of overhanging speaker.
- (let (erc-fill--wrap-action-dedent-p)
- (erc-process-ctcp-query
- erc-server-process
- (make-erc-response
- :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1"
- :sender "bob!~u@fake" :command "PRIVMSG"
- :command-args '("#chan" "\1ACTION three\1")
- :contents "\1ACTION three\1")
- "bob" "~u" "fake"))
+ (erc-tests-common-with-date-aware-display-message
+ (let (erc-fill--wrap-action-dedent-p)
+ (erc-process-ctcp-query
+ erc-server-process
+ (make-erc-response
+ :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1"
+ :sender "bob!~u@fake" :command "PRIVMSG"
+ :command-args '("#chan" "\1ACTION three\1")
+ :contents "\1ACTION three\1")
+ "bob" "~u" "fake")))
(erc-fill-tests--insert-privmsg "bob" "four."))
@@ -320,8 +322,10 @@ erc-fill-line-spacing
(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-tests-common-display-message nil 'notice
+ (current-buffer) "one two three")
+ (erc-tests-common-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")))))
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el
index 99f15b89b03..2ec32db77cd 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -39,7 +39,7 @@
;;; Code:
(require 'ert-x)
(require 'erc)
-
+(eval-when-compile (require 'erc-stamp))
(defmacro erc-tests-common-equal-with-props (a b)
"Compare strings A and B for equality including text props.
@@ -196,6 +196,25 @@ erc-tests-common-assert-get-inserted-msg-readonly-with
(erc-readonly-mode +1)
(funcall assert-fn test-fn)))
+(defun erc-tests--common-display-message (orig &rest args)
+ (require 'erc-stamp)
+ (defvar erc-stamp--deferred-date-stamp)
+ (let (erc-stamp--deferred-date-stamp)
+ (prog1 (apply orig args)
+ (when-let ((inst erc-stamp--deferred-date-stamp)
+ (fn (erc-stamp--date-fn inst)))
+ (funcall fn)))))
+
+(defun erc-tests-common-display-message (&rest args)
+ (apply #'erc-tests--common-display-message #'erc-display-message args))
+
+(defmacro erc-tests-common-with-date-aware-display-message (&rest body)
+ `(progn
+ (advice-add 'erc-display-message
+ :around #'erc-tests--common-display-message)
+ (unwind-protect (progn ,@body)
+ (advice-remove 'erc-display-message
+ #'erc-tests--common-display-message))))
;;;; Buffer snapshots
@@ -223,12 +242,19 @@ erc-tests-common-snapshot-compare
(print-escape-nonascii t)
(got (erc--remove-text-properties
(buffer-substring (point-min) erc-insert-marker)))
- (repr (funcall (or trans-fn #'identity) (prin1-to-string got))))
+ (repr (funcall (or trans-fn #'identity) (prin1-to-string got)))
+ (xstr (read (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (buffer-string)))))
(with-current-buffer (generate-new-buffer name)
(with-silent-modifications
(insert (setq got (read repr))))
(when buf-init-fn (funcall buf-init-fn))
(erc-mode))
+ (unless noninteractive
+ (with-current-buffer (generate-new-buffer (format "%s-xpt" name))
+ (insert xstr)
+ (erc-mode)))
;; LHS is a string, RHS is a symbol.
(if (string= erc-tests-common-snapshot-save-p
(ert-test-name (ert-running-test)))
@@ -242,9 +268,7 @@ erc-tests-common-snapshot-compare
;; recursive (signals `max-lisp-eval-depth' exceeded).
(named-let assert-equal
((latest (read repr))
- (expect (read (with-temp-buffer
- (insert-file-contents-literally expect-file)
- (buffer-string)))))
+ (expect xstr))
(pcase latest
((or "" 'nil) t)
((pred stringp)
--
2.44.0
^ permalink raw reply related [flat|nested] 56+ messages in thread
* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (21 preceding siblings ...)
[not found] ` <87a5te47sz.fsf@neverwas.me>
@ 2023-11-13 21:01 ` J.P.
2023-12-07 7:14 ` J.P.
` (2 subsequent siblings)
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-11-13 21:01 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 322 bytes --]
I'm thinking it might make sense to have `fill-wrap' formally depend on
`scrolltobottom', even though there's no technical reason to do so. The
rare user who prefers otherwise can still get their way via
`erc-scrolltobottom-mode-hook'. Alternatively, we could just enable
`scrolltobottom' by default in a future release.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Make-erc-fill-wrap-depend-on-scrolltobottom.patch --]
[-- Type: text/x-patch, Size: 5952 bytes --]
From 66a7f1a34924a7244ac27b25e8d6b36d9c3ceaf2 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 13 Nov 2023 12:07:36 -0800
Subject: [PATCH] [5.6] Make erc-fill-wrap depend on scrolltobottom
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-function): Add
reference to `erc-fill-wrap-mode' in doc string.
(erc--fill-scrolltobottom-exempt-p): New variable.
(erc-fill--wrap-ensure-dependencies): Warn and enable
`erc-scrolltobottom-mode' if necessary.
(erc-fill-wrap-mode): Mention workaround for users who don't want this
module to automatically enable `scrolltobottom'.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate):
Exempt tests from `scrolltobottom' dependency. (Bug#60936)
---
lisp/erc/erc-fill.el | 44 +++++++++++++++++++--------------
test/lisp/erc/erc-fill-tests.el | 1 +
2 files changed, 26 insertions(+), 19 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e48d5540c86..457e51e6053 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -44,11 +44,7 @@ erc-fill
(define-erc-module fill nil
"Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
-the channel buffers are filled."
- ;; FIXME ensure a consistent ordering relative to hook members from
- ;; other modules. Ideally, this module's processing should happen
- ;; after "morphological" modifications to a message's text but
- ;; before superficial decorations.
+the channel buffers are filled. See also `erc-fill-wrap-mode'."
((add-hook 'erc-insert-modify-hook #'erc-fill 60)
(add-hook 'erc-send-modify-hook #'erc-fill 60))
((remove-hook 'erc-insert-modify-hook #'erc-fill)
@@ -86,11 +82,12 @@ erc-fill-function
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 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
+enables when this option is set to `erc-fill-wrap' or when the
+module `fill-wrap' is active \(see `erc-fill-wrap-mode' for
+details). 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)
@@ -367,8 +364,11 @@ erc-fill-wrap-mode-map
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
(defvar erc-button-mode)
+(defvar erc-scrolltobottom-mode)
(defvar erc-legacy-invisible-bounds-p)
+(defvar erc--fill-scrolltobottom-exempt-p nil)
+
(defun erc-fill--wrap-ensure-dependencies ()
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(when erc-legacy-invisible-bounds-p
@@ -381,6 +381,10 @@ erc-fill--wrap-ensure-dependencies
(unless erc-fill-mode
(push 'fill missing-deps)
(erc-fill-mode +1))
+ (unless (or erc-scrolltobottom-mode (memq 'scrolltobottom erc-modules)
+ erc--fill-scrolltobottom-exempt-p)
+ (push 'scrolltobottom missing-deps)
+ (erc-scrolltobottom-mode +1))
(when erc-fill-wrap-merge
(require 'erc-button)
(unless erc-button-mode
@@ -401,20 +405,22 @@ erc-fill--wrap-ensure-dependencies
;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
(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'.
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. 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'.
+to `erc-fill-wrap'. 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. 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'. Note that this module currently ensures
+`erc-scrolltobottom-mode' is active. Users wishing otherwise can
+suppress that behavior by leveraging `erc-fill-wrap-mode-hook'.
This module imposes various restrictions on the appearance of
timestamps. Most notably, it insists on displaying them in the
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index c21f3935503..d54204eb0ce 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -47,6 +47,7 @@ erc-fill-tests--insert-privmsg
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
+ (erc--fill-scrolltobottom-exempt-p t)
(erc-stamp--tz t)
(erc-fill-function 'erc-fill-wrap)
(pre-command-hook pre-command-hook)
--
2.41.0
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (22 preceding siblings ...)
2023-11-13 21:01 ` J.P.
@ 2023-12-07 7:14 ` J.P.
2024-02-15 12:01 ` tzakmagiel via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-09 20:48 ` bug#60936: (no subject) Alcor
25 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2023-12-07 7:14 UTC (permalink / raw)
To: 60936; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1490 bytes --]
Changes related to this feature introduced a number of meta-data
oriented text properties that I think, in retrospect, should have been
double-hyphenated to dissuade users from depending on them. Also, a
couple of properties, like `erc-stamp-type', are superfluous, and can be
removed. The first of the attached patches should take care of this.
There's also (IMO) a rather obvious need for an `erc--spkr' property to
aid modules in quickly distinguishing between inserted messages based on
their speaker (nick). For example, a module that detects continued
messages that should be displayed as a single unit might otherwise have
to keep a local backlog or parse inserted messages at runtime. The
second of the attached patches tries to address this.
Lastly, in "designing" the makeup of these properties, I chose to assign
a constant `msg' value for the required `erc--msg' property to all
speaker-owned messages, like those originating from PRIVMSG and NOTICE
commands. The idea was to allow modules to distinguish between speaker
messages and other types. However, making `erc--msg' a union of `msg'
and `format-spec' "catalog" keys (and `erc-display-message' TYPE
parameters) meant coercing keys for speaker messages to `msg', thereby
discarding what now looks to be valuable information (especially in
light of bug#67677). Thus, I'm proposing we remove `msg' as an
advertised `erc--msg' value and instead rely on `erc--spkr' to convey
speaker associations. See bug#67677 for more.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0003-5.6-Double-hyphenate-internal-ERC-5.6-text-props.patch --]
[-- Type: text/x-patch, Size: 95055 bytes --]
From 218a4f1f4b405fe5c7d934948bdc12a9ea0f2baf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 1 Dec 2023 22:30:04 -0800
Subject: [PATCH 03/11] [5.6] Double hyphenate internal ERC 5.6 text props
* lisp/erc/erc-fill.el (erc-fill, erc-fill-static,
erc-fill--wrap-continued-message-p, erc-fill-wrap,
erc-fill--wrap-rejigger-region): Add second hyphen to "msg prop" text
properties.
* lisp/erc/erc-goodies.el (erc--command-indicator-display): Rename
`erc-msg' to `erc--msg'.
* lisp/erc/erc-stamp.el (erc-stamp--current-time, erc-add-timestamp,
erc-stamp-prefix-log-filter, erc-stamp--lr-date-on-pre-modify,
erc-munge-invisibility-spec, erc-stamp--add-csf-on-post-modify,
erc-stamp--on-clear-message, erc-echo-timestamp, erc--echo-ts-csf):
Rename "msg props" with second hyphen.
* lisp/erc/erc-track.el (erc-track--skipped-msgs,
erc-track-modified-channels): Rename "msg prop" text properties with
second hyphen.
* lisp/erc/erc.el (erc--msg-props): Update doc with double-hyphenated
"msg prop" names.
(erc--send-action-display erc--get-inserted-msg-bounds,
erc--traverse-inserted, erc-insert-line, erc-display-line,
erc--ranked-properties, erc-display-message, erc--get-speaker-bounds,
erc-process-ctcp-query, erc-display-msg): Update all "msg prop" names
to have two hyphens.
* test/lisp/erc/erc-scenarios-display-message.el
(erc-scenarios-display-message--multibuf): Double hyphenate "msg prop"
text properties.
* test/lisp/erc/erc-scenarios-match.el
(erc-scenarios-match--hide-fools/stamp-both/fill-wrap,
erc-scenarios-match--hide-fools/stamp-both/fill-wrap/speak,
erc-scenarios-match--stamp-both-invisible-fill-static): Update "msg
prop" names.
* test/lisp/erc/erc-scenarios-stamp.el
(erc-scenarios-stamp--on-post-modify,
erc-scenarios-stamp--left/display-margin-mode,
erc-scenarios-stamp--legacy-date-stamps,
erc-scenarios-stamp--on-insert-modify,
erc-scenarios-stamp--date-mode/left-and-right): Add second hyphen to
all "msg props".
* test/lisp/erc/erc-stamp-tests.el (erc-echo-timestamp): Rename "msg
prop".
* test/lisp/erc/erc-tests.el (erc--get-inserted-msg-bounds,
erc--delete-inserted-message, erc--order-text-properties-from-hash,
erc--route-insertion): Rename "msg props" with second hyphen.
(Bug#60936)
; * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld:
; Add second hyphen to msg props.
; * test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld:
; Add second hyphen to msg props.
---
lisp/erc/erc-fill.el | 22 ++++----
lisp/erc/erc-goodies.el | 2 +-
lisp/erc/erc-stamp.el | 24 ++++-----
lisp/erc/erc-track.el | 4 +-
lisp/erc/erc.el | 50 +++++++++----------
.../lisp/erc/erc-scenarios-display-message.el | 4 +-
test/lisp/erc/erc-scenarios-match.el | 14 +++---
test/lisp/erc/erc-scenarios-stamp.el | 18 +++----
test/lisp/erc/erc-stamp-tests.el | 2 +-
test/lisp/erc/erc-tests.el | 20 ++++----
.../fill/snapshots/merge-01-start.eld | 2 +-
.../fill/snapshots/merge-02-right.eld | 2 +-
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../merge-wrap-indicator-post-01.eld | 2 +-
.../snapshots/merge-wrap-indicator-pre-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../fill/snapshots/spacing-01-mono.eld | 2 +-
.../fill/snapshots/stamps-left-01.eld | 2 +-
21 files changed, 91 insertions(+), 91 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 9b0c74b518d..5434d9af966 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -177,10 +177,10 @@ erc-fill
(when-let ((erc-fill-line-spacing)
(p (point-min)))
(widen)
- (when (or (erc--check-msg-prop 'erc-msg 'msg)
+ (when (or (erc--check-msg-prop 'erc--msg 'msg)
(and-let* ((m (save-excursion
(forward-line -1)
- (erc--get-inserted-msg-prop 'erc-msg))))
+ (erc--get-inserted-msg-prop 'erc--msg))))
(eq 'msg m)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
@@ -190,7 +190,7 @@ erc-fill-static
(save-restriction
(goto-char (point-min))
(when-let (((looking-at "^\\(\\S-+\\)"))
- ((not (erc--check-msg-prop 'erc-msg 'datestamp)))
+ ((not (erc--check-msg-prop 'erc--msg 'datestamp)))
(nick (match-string 1)))
(progn
(let ((fill-column (- erc-fill-column (erc-timestamp-offset)))
@@ -557,7 +557,7 @@ erc-fill--wrap-continued-message-p
advance `erc-fill--wrap-last-msg' unless the message has been
marked as being ephemeral."
(and
- (not (erc--check-msg-prop 'erc-ephemeral))
+ (not (erc--check-msg-prop 'erc--ephemeral))
(progn ; preserve blame for now, unprogn on next major change
(prog1
(and-let*
@@ -568,12 +568,12 @@ erc-fill--wrap-continued-message-p
(props (save-restriction
(widen)
(and-let*
- (((eq 'msg (get-text-property m 'erc-msg)))
- ((not (eq (get-text-property m 'erc-ctcp)
+ (((eq 'msg (get-text-property m 'erc--msg)))
+ ((not (eq (get-text-property m 'erc--ctcp)
'ACTION)))
((not (invisible-p m)))
(spr (next-single-property-change m 'erc-speaker)))
- (cons (get-text-property m 'erc-ts)
+ (cons (get-text-property m 'erc--ts)
(get-text-property spr 'erc-speaker)))))
(ts (pop props))
(props)
@@ -582,7 +582,7 @@ erc-fill--wrap-continued-message-p
erc-fill--wrap-max-lull))
;; Assume presence of leading angle bracket or hyphen.
(speaker (next-single-property-change (point-min) 'erc-speaker))
- ((not (erc--check-msg-prop 'erc-ctcp 'ACTION)))
+ ((not (erc--check-msg-prop 'erc--ctcp 'ACTION)))
(nick (get-text-property speaker 'erc-speaker))
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))))
@@ -668,12 +668,12 @@ erc-fill-wrap
(goto-char (point-min))
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
- (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg))
+ (and-let* ((msg-prop (erc--check-msg-prop 'erc--msg))
((not (eq msg-prop 'unknown))))
(when-let ((e (erc--get-speaker-bounds))
(b (pop e))
((or erc-fill--wrap-action-dedent-p
- (not (erc--check-msg-prop 'erc-ctcp
+ (not (erc--check-msg-prop 'erc--ctcp
'ACTION)))))
(goto-char e))
(skip-syntax-forward "^-")
@@ -755,7 +755,7 @@ erc-fill--wrap-rejigger-region
(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)))
+ (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))
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 6c8ec567bd9..e10f047b187 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -578,7 +578,7 @@ erc--command-indicator-display
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
(erc--msg-props (or erc--msg-props
(let ((ovs erc--msg-prop-overrides))
- (map-into `((erc-msg . slash-cmd)
+ (map-into `((erc--msg . slash-cmd)
,@(reverse ovs))
'hash-table)))))
(when-let ((string (erc-command-indicator))
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index e6a8f36c332..a6efa3b5151 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -212,7 +212,7 @@ erc-stamp--current-time
(cl-defgeneric erc-stamp--current-time ()
"Return a lisp time object to associate with an IRC message.
-This becomes the message's `erc-ts' text property."
+This becomes the message's `erc--ts' text property."
(erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
@@ -249,10 +249,10 @@ erc-add-timestamp
;; FIXME on major version bump, make this `erc-' prefixed.
(if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(skipp (or (and erc-stamp--skip-when-invisible invisible)
- (erc--check-msg-prop 'erc-ephemeral)))
+ (erc--check-msg-prop 'erc--ephemeral)))
(erc-stamp--current-time ct))
(when erc--msg-props
- (puthash 'erc-ts ct erc--msg-props))
+ (puthash 'erc--ts ct erc--msg-props))
(unless skipp
(funcall erc-insert-timestamp-function
(erc-format-timestamp ct erc-timestamp-format)))
@@ -270,7 +270,7 @@ erc-add-timestamp
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
;; Regions are no longer contiguous ^
- '(erc--echo-ts-csf) 'erc-ts ct))))))
+ '(erc--echo-ts-csf) 'erc--ts ct))))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -403,7 +403,7 @@ erc-stamp-prefix-log-filter
;; Skip a line that's just a timestamp.
((> beg (point))))
(delete-region beg (1+ end)))
- (when-let (time (erc--get-inserted-msg-prop 'erc-ts))
+ (when-let (time (erc--get-inserted-msg-prop 'erc--ts))
(insert (format-time-string "[%H:%M:%S] " time)))
(zerop (forward-line))))
"")
@@ -711,8 +711,8 @@ erc-stamp--lr-date-on-pre-modify
(setq erc-timestamp-last-inserted-left nil)
(let* ((aligned (erc-stamp--time-as-day ct))
(erc-stamp--current-time aligned)
- ;; Forget current `erc-cmd', etc.
- (erc--msg-props (map-into `((erc-msg . datestamp))
+ ;; Forget current `erc--cmd', etc.
+ (erc--msg-props (map-into `((erc--msg . datestamp))
'hash-table))
(erc-timestamp-last-inserted-left rendered)
erc-timestamp-format erc-away-timestamp-format)
@@ -867,7 +867,7 @@ erc-munge-invisibility-spec
erc-stamp--csf-props-updated-p nil)
(unless erc-stamp--csf-props-updated-p
(setq erc-stamp--csf-props-updated-p t)
- (let ((erc--msg-props (map-into '((erc-ts . t)) 'hash-table)))
+ (let ((erc--msg-props (map-into '((erc--ts . t)) 'hash-table)))
(with-silent-modifications
(erc--traverse-inserted
(point-min) erc-insert-marker
@@ -889,7 +889,7 @@ erc-munge-invisibility-spec
(defun erc-stamp--add-csf-on-post-modify ()
"Add `cursor-sensor-functions' to narrowed buffer."
- (when (erc--check-msg-prop 'erc-ts)
+ (when (erc--check-msg-prop 'erc--ts)
(put-text-property (point-min) (1- (point-max))
'cursor-sensor-functions '(erc--echo-ts-csf))))
@@ -940,7 +940,7 @@ erc-stamp--last-stamp
(defun erc-stamp--on-clear-message (&rest _)
"Return `dont-clear-message' when operating inside the same stamp."
(and erc-stamp--last-stamp erc-echo-timestamps
- (eq (erc--get-inserted-msg-prop 'erc-ts) erc-stamp--last-stamp)
+ (eq (erc--get-inserted-msg-prop 'erc--ts) erc-stamp--last-stamp)
'dont-clear-message))
(defun erc-echo-timestamp (dir stamp &optional zone)
@@ -950,7 +950,7 @@ erc-echo-timestamp
interpret a \"raw\" prefix as UTC. To specify a zone for use
with the option `erc-echo-timestamps', see the companion option
`erc-echo-timestamp-zone'."
- (interactive (list nil (erc--get-inserted-msg-prop 'erc-ts)
+ (interactive (list nil (erc--get-inserted-msg-prop 'erc--ts)
(pcase current-prefix-arg
((and (pred numberp) v)
(if (<= (abs v) 14) (* v 3600) v))
@@ -964,7 +964,7 @@ erc-echo-timestamp
(setq erc-stamp--last-stamp nil))))
(defun erc--echo-ts-csf (_window _before dir)
- (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc-ts)))
+ (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc--ts)))
(defun erc-stamp--update-saved-position (&rest _)
(remove-hook 'erc-stamp--insert-date-hook
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index a36b781e04d..7dc4fe754cd 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -786,7 +786,7 @@ erc-track-select-mode-line-face
choice))))
(defvar erc-track--skipped-msgs '(datestamp)
- "Values of `erc-msg' text prop to ignore.")
+ "Values of `erc--msg' text prop to ignore.")
(defun erc-track-modified-channels ()
"Hook function for `erc-insert-post-hook'.
@@ -806,7 +806,7 @@ erc-track-modified-channels
erc-track-exclude-types)
;; Skip certain non-server-sent messages.
(and (not parsed)
- (erc--check-msg-prop 'erc-msg
+ (erc--check-msg-prop 'erc--msg
erc-track--skipped-msgs))))))
;; If the active buffer is not visible (not shown in a
;; window), and not to be excluded, determine the kinds of
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a42c50d91ff..c68c74467b8 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -154,26 +154,26 @@ erc--msg-props
their markers accordingly. The following properties have meaning
as of ERC 5.6:
- - `erc-msg': a symbol, guaranteed present; values include:
+ - `erc--msg': a symbol, guaranteed present; values include:
`msg', signifying a `PRIVMSG' or an incoming `NOTICE';
`unknown', a fallback for `erc-display-message'; a catalog
key, such as `s401' or `finished'; an `erc-display-message'
TYPE parameter, like `notice'
- - `erc-cmd': a message's associated IRC command, as read by
+ - `erc--cmd': a message's associated IRC command, as read by
`erc--get-eq-comparable-cmd'; currently either a symbol, like
`PRIVMSG', or a number, like 5, which represents the numeric
\"005\"; absent on \"local\" messages, such as simple warnings
and help text, and on outgoing messages unless echoed back by
the server (assuming future support)
- - `erc-ctcp': a CTCP command, like `ACTION'
+ - `erc--ctcp': a CTCP command, like `ACTION'
- - `erc-ts': a timestamp, possibly provided by the server; as of
+ - `erc--ts': a timestamp, possibly provided by the server; as of
5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\"
type otherwise; managed by the `stamp' module
- - `erc-ephemeral': a symbol prefixed by or matching a module
+ - `erc--ephemeral': a symbol prefixed by or matching a module
name; indicates to other modules and members of modification
hooks that the current message should not affect stateful
operations, such as recording a channel's most recent speaker
@@ -3004,7 +3004,7 @@ erc-send-action
;; Sending and displaying are provided separately to afford modules
;; more flexibility, e.g., to forgo displaying on the way out when
;; expecting the server to echo messages back and/or to associate
-;; outgoing messages with IDs generated for `erc-ephemeral'
+;; outgoing messages with IDs generated for `erc--ephemeral'
;; placeholders.
(defun erc--send-action-perform-ctcp (target string force)
"Send STRING to TARGET, possibly immediately, with FORCE."
@@ -3013,8 +3013,8 @@ erc--send-action-perform-ctcp
(defun erc--send-action-display (string)
"Display STRING as an outgoing \"CTCP ACTION\" message."
;; Allow hooks acting on inserted PRIVMSG and NOTICES to process us.
- (let ((erc--msg-prop-overrides `((erc-msg . msg)
- (erc-ctcp . ACTION)
+ (let ((erc--msg-prop-overrides `((erc--msg . msg)
+ (erc--ctcp . ACTION)
,@erc--msg-prop-overrides))
(nick (erc-current-nick)))
(setq nick (propertize nick 'erc-speaker nick
@@ -3142,20 +3142,20 @@ erc--get-inserted-msg-bounds
POINT, search from POINT instead of `point'."
;; TODO add edebug spec.
`(let* ((point ,(or point '(point)))
- (at-start-p (get-text-property point 'erc-msg)))
+ (at-start-p (get-text-property point 'erc--msg)))
(and-let*
(,@(and (member only '(nil beg 'beg))
'((b (or (and at-start-p point)
(and-let*
((p (previous-single-property-change point
- 'erc-msg)))
+ 'erc--msg)))
(if (= p (1- point))
- (if (get-text-property p 'erc-msg) p (1- p))
+ (if (get-text-property p 'erc--msg) p (1- p))
(1- p)))))))
,@(and (member only '(nil end 'end))
'((e (1- (next-single-property-change
(if at-start-p (1+ point) point)
- 'erc-msg nil erc-insert-marker))))))
+ 'erc--msg nil erc-insert-marker))))))
,(pcase only
('(quote beg) 'b)
('(quote end) 'e)
@@ -3184,12 +3184,12 @@ erc--traverse-inserted
(set-marker end (min erc-insert-marker end)))
(save-excursion
(goto-char beg)
- (let ((b (if (get-text-property (point) 'erc-msg)
+ (let ((b (if (get-text-property (point) 'erc--msg)
(point)
- (next-single-property-change (point) 'erc-msg nil end))))
+ (next-single-property-change (point) 'erc--msg nil end))))
(while-let ((b)
((< b end))
- (e (next-single-property-change (1+ b) 'erc-msg nil end)))
+ (e (next-single-property-change (1+ b) 'erc--msg nil end)))
(save-restriction
(narrow-to-region b e)
(funcall fn))
@@ -3267,7 +3267,7 @@ erc-insert-line
(let ((props (if erc--msg-props
(erc--order-text-properties-from-hash
erc--msg-props)
- '(erc-msg unknown))))
+ '(erc--msg unknown))))
(add-text-properties (point-min) (1+ (point-min)) props)))
(erc--refresh-prompt)))))
(run-hooks 'erc-insert-done-hook)
@@ -3340,8 +3340,8 @@ erc-display-line
being equivalent to a `erc-display-message' TYPE of `notice'."
(let ((erc--msg-prop-overrides erc--msg-prop-overrides))
(when (eq 'erc-notice-face (get-text-property 0 'font-lock-face string))
- (unless (assq 'erc-msg erc--msg-prop-overrides)
- (push '(erc-msg . notice) erc--msg-prop-overrides)))
+ (unless (assq 'erc--msg erc--msg-prop-overrides)
+ (push '(erc--msg . notice) erc--msg-prop-overrides)))
(erc-display-message nil nil buffer string)))
(defvar erc--merge-text-properties-p nil
@@ -3458,7 +3458,7 @@ erc--delete-inserted-message
(substring (delete-and-extract-region (1- (point)) (1+ end))
-1))))))))
-(defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd))
+(defvar erc--ranked-properties '(erc--msg erc--ts erc--cmd))
(defun erc--order-text-properties-from-hash (table)
"Return a plist of text props from items in TABLE.
@@ -3732,7 +3732,7 @@ erc-display-message
(let ((table (make-hash-table :size 5))
(cmd (and parsed (erc--get-eq-comparable-cmd
(erc-response.command parsed)))))
- (puthash 'erc-msg
+ (puthash 'erc--msg
(cond ((and msg (symbolp msg)) msg)
((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
(type (pcase type
@@ -3744,7 +3744,7 @@ erc-display-message
(t 'unknown))
table)
(when cmd
- (puthash 'erc-cmd cmd table))
+ (puthash 'erc--cmd cmd table))
(and-let* ((ovs erc--msg-prop-overrides))
(pcase-dolist (`(,k . ,v) (reverse ovs))
(puthash k v table)))
@@ -5744,7 +5744,7 @@ erc-is-message-ctcp-and-not-action-p
(defun erc--get-speaker-bounds ()
"Return the bounds of `erc-speaker' text property when present.
Assume buffer is narrowed to the confines of an inserted message."
- (and-let* (((erc--check-msg-prop 'erc-msg 'msg))
+ (and-let* (((erc--check-msg-prop 'erc--msg 'msg))
(beg (text-property-not-all (point-min) (point-max)
'erc-speaker nil)))
(cons beg (next-single-property-change beg 'erc-speaker))))
@@ -6074,8 +6074,8 @@ erc-process-ctcp-query
(while queries
(let* ((type (upcase (car (split-string (car queries)))))
(hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))
- (erc--msg-prop-overrides `((erc-msg . msg)
- (erc-ctcp . ,(intern type))
+ (erc--msg-prop-overrides `((erc--msg . msg)
+ (erc--ctcp . ,(intern type))
,@erc--msg-prop-overrides)))
(if (and hook (boundp hook))
(if (string-equal type "ACTION")
@@ -7521,7 +7521,7 @@ erc-display-msg
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
(erc--msg-props (or erc--msg-props
(let ((ovs erc--msg-prop-overrides))
- (map-into `((erc-msg . msg) ,@(reverse ovs))
+ (map-into `((erc--msg . msg) ,@(reverse ovs))
'hash-table))))
beg)
(insert (erc-format-my-nick))
diff --git a/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el
index c7e0c2fc17a..91b82889f3e 100644
--- a/test/lisp/erc/erc-scenarios-display-message.el
+++ b/test/lisp/erc/erc-scenarios-display-message.el
@@ -50,12 +50,12 @@ erc-scenarios-display-message--multibuf
(with-current-buffer (erc-d-t-wait-for 5 (get-buffer "dummy"))
(funcall expect 10 "<dummy> hi")
(funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
- (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
+ (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc--msg)))))
(ert-info ("Dummy's QUIT notice in #chan contains metadata props")
(with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
(funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
- (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
+ (should (eq 'QUIT (get-text-property (match-beginning 0) 'erc--msg)))))
(with-current-buffer "foonet"
(erc-cmd-QUIT ""))))
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index 17f7649566e..0eed1853879 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -304,9 +304,9 @@ erc-scenarios-match--hide-fools/stamp-both/fill-wrap
(should (= mend (field-end right-stamp)))
(should (eq (field-at-pos (1- mend)) 'erc-timestamp))))
- ;; The `erc-ts' property is present in prop stack.
- (should (get-text-property (pos-bol) 'erc-ts))
- (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
+ ;; The `erc--ts' property is present in prop stack.
+ (should (get-text-property (pos-bol) 'erc--ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc--ts))
;; Line ending has the `invisible' property `match-fools'.
(should (eq (get-text-property mbeg 'invisible) 'match-fools))
@@ -413,7 +413,7 @@ erc-scenarios-match--hide-fools/stamp-both/fill-wrap/speak
(should-not (equal "" (get-text-property (pos-bol) 'display)))
;; No remaining meta-data positions, no more timestamps.
- (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc--ts))
;; No remaining invisible messages.
(should-not (text-property-not-all (pos-bol) erc-insert-marker
'invisible nil))
@@ -456,10 +456,10 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(should (eq (field-at-pos (field-end mbeg)) 'erc-timestamp))
(should (eq (field-at-pos (1- mend)) 'erc-timestamp)))
- ;; The `erc-ts' property is present in the message's
+ ;; The `erc--ts' property is present in the message's
;; width 1 prop collection at its first char.
- (should (get-text-property (pos-bol) 'erc-ts))
- (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
+ (should (get-text-property (pos-bol) 'erc--ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc--ts))
;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el
index 49307dd228a..68769e203ff 100644
--- a/test/lisp/erc/erc-scenarios-stamp.el
+++ b/test/lisp/erc/erc-scenarios-stamp.el
@@ -29,7 +29,7 @@
(defvar erc-scenarios-stamp--user-marker nil)
(defun erc-scenarios-stamp--on-post-modify ()
- (when-let (((erc--check-msg-prop 'erc-cmd 4)))
+ (when-let (((erc--check-msg-prop 'erc--cmd 4)))
(set-marker erc-scenarios-stamp--user-marker (point-max))
(ert-info ("User marker correctly placed at `erc-insert-marker'")
(should (= ?\n (char-before erc-scenarios-stamp--user-marker)))
@@ -68,8 +68,8 @@ erc-scenarios-stamp--left/display-margin-mode
(ert-info ("Stamps appear in left margin and are invisible")
(should (eq 'erc-timestamp (field-at-pos (pos-bol))))
(should (= (pos-bol) (field-beginning (pos-bol))))
- (should (eq 'msg (get-text-property (pos-bol) 'erc-msg)))
- (should (eq 'NOTICE (get-text-property (pos-bol) 'erc-cmd)))
+ (should (eq 'msg (get-text-property (pos-bol) 'erc--msg)))
+ (should (eq 'NOTICE (get-text-property (pos-bol) 'erc--cmd)))
(should (= ?- (char-after (field-end (pos-bol)))))
(should (equal (get-text-property (1+ (field-end (pos-bol)))
'erc-speaker)
@@ -104,14 +104,14 @@ erc-scenarios-stamp--legacy-date-stamps
(funcall expect 5 "Opening connection")
(goto-char (1- (match-beginning 0)))
(should (eq 'erc-timestamp (field-at-pos (point))))
- (should (eq 'unknown (erc--get-inserted-msg-prop 'erc-msg)))
+ (should (eq 'unknown (erc--get-inserted-msg-prop 'erc--msg)))
;; Force redraw of date stamp.
(setq erc-timestamp-last-inserted-left nil)
(funcall expect 5 "This server is in debug mode")
(while (and (zerop (forward-line -1))
(not (eq 'erc-timestamp (field-at-pos (point))))))
- (should (erc--get-inserted-msg-prop 'erc-cmd)))))))
+ (should (erc--get-inserted-msg-prop 'erc--cmd)))))))
;; This user-owned hook member places a marker on the first message in
;; a buffer. Inserting a date stamp in front of it shouldn't move the
@@ -125,18 +125,18 @@ erc-scenarios-stamp--on-insert-modify
;; Sometime after the first message ("Opening connection.."), assert
;; that the marker we just placed hasn't moved.
- (when (erc--check-msg-prop 'erc-cmd 2)
+ (when (erc--check-msg-prop 'erc--cmd 2)
(save-restriction
(widen)
(ert-info ("Date stamp preserves opening user marker")
(goto-char erc-scenarios-stamp--user-marker)
(should-not (eq 'erc-timestamp (field-at-pos (point))))
(should (looking-at "Opening"))
- (should (eq 'unknown (get-text-property (point) 'erc-msg))))))
+ (should (eq 'unknown (get-text-property (point) 'erc--msg))))))
;; On 003 ("*** This server was created on"), clear state to force a
;; new date stamp on the next message.
- (when (erc--check-msg-prop 'erc-cmd 3)
+ (when (erc--check-msg-prop 'erc--cmd 3)
(setq erc-timestamp-last-inserted-left nil)
(set-marker erc-scenarios-stamp--user-marker erc-insert-marker)))
@@ -174,7 +174,7 @@ erc-scenarios-stamp--date-mode/left-and-right
(goto-char erc-scenarios-stamp--user-marker)
(should-not (eq 'erc-timestamp (field-at-pos (point))))
(should (looking-at (rx "*** irc.foonet.org oragono")))
- (should (eq 's004 (get-text-property (point) 'erc-msg))))
+ (should (eq 's004 (get-text-property (point) 'erc--msg))))
(funcall expect 5 "This server is in debug mode")))))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index cc61d599387..fd2e7000c0e 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -279,7 +279,7 @@ erc-echo-timestamp
(should-not erc-echo-timestamps)
(should-not erc-stamp--last-stamp)
- (insert (propertize "a" 'erc-ts 433483200 'erc-msg 'msg) "bc")
+ (insert (propertize "a" 'erc--ts 433483200 'erc--msg 'msg) "bc")
(goto-char (point-min))
(let ((inhibit-message t)
(erc-echo-timestamp-format "%Y-%m-%d %H:%M:%S %Z")
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 49d500fadea..b8ebc23e686 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1738,7 +1738,7 @@ erc--get-inserted-msg-bounds
:command "PRIVMSG"
:command-args (list "#chan" "hi")
:contents "hi"))
- (erc--msg-prop-overrides '((erc-ts . 0))))
+ (erc--msg-prop-overrides '((erc--ts . 0))))
(erc-display-message parsed nil (current-buffer)
(erc-format-privmessage "bob" "hi" nil t)))
(goto-char 3)
@@ -1785,7 +1785,7 @@ erc--delete-inserted-message
;; Put unique invisible properties on the line endings.
(erc-display-message nil 'notice nil "one")
(put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'a)
- (let ((erc--msg-prop-overrides '((erc-msg . datestamp) (erc-ts . 0))))
+ (let ((erc--msg-prop-overrides '((erc--msg . datestamp) (erc--ts . 0))))
(erc-display-message nil nil nil
(propertize "\n[date]" 'field 'erc-timestamp)))
(put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'b)
@@ -1794,7 +1794,7 @@ erc--delete-inserted-message
(ert-info ("Date stamp deleted cleanly")
(goto-char 11)
(should (looking-at (rx "\n[date]")))
- (should (eq 'datestamp (get-text-property (point) 'erc-msg)))
+ (should (eq 'datestamp (get-text-property (point) 'erc--msg)))
(should (eq (point) (field-beginning (1+ (point)))))
(erc--delete-inserted-message (point))
@@ -1855,19 +1855,19 @@ erc--delete-inserted-message
(ert-deftest erc--order-text-properties-from-hash ()
(let ((table (map-into '((a . 1)
- (erc-ts . 0)
- (erc-msg . s005)
+ (erc--ts . 0)
+ (erc--msg . s005)
(b . 2)
- (erc-cmd . 5)
+ (erc--cmd . 5)
(c . 3))
'hash-table)))
(with-temp-buffer
(erc-mode)
(insert "abc\n")
(add-text-properties 1 2 (erc--order-text-properties-from-hash table))
- (should (equal '( erc-msg s005
- erc-ts 0
- erc-cmd 5
+ (should (equal '( erc--msg s005
+ erc--ts 0
+ erc--cmd 5
a 1
b 2
c 3)
@@ -2392,7 +2392,7 @@ erc--route-insertion
(ert-info ("Cons `buffer' routes to live members")
;; Copies a let-bound `erc--msg-props' before mutating.
- (let* ((table (map-into '(erc-msg msg) 'hash-table))
+ (let* ((table (map-into '(erc--msg msg) 'hash-table))
(erc--msg-props table))
(erc--route-insertion "cons" (list server-buffer spam-buffer))
(should-not (eq table erc--msg-props)))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index c07eee3517f..f4a43a9384f 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 (#6=(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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 (#6=(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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index cf5cdb4f825..78450ec08e2 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 (- 29 (18)))) 455 456 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc-msg msg erc-ts 1680332400 erc-cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 (- 29 (18)))) 455 456 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index ad4e6483f01..8e5535093e1 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +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#) 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#))
+#("\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#) 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#))
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
index 893588c028f..a0c03244afe 100644
--- 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
@@ -1 +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#))
\ No newline at end of file
+#("\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#))
\ 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
index 2b67cbbf90e..c4a51e06354 100644
--- 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
@@ -1 +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#))
\ No newline at end of file
+#("\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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index 84a1e34670c..5eea73b4f16 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +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" 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 ((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#))
+#("\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" 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 ((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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index 83394f2f639..bc59c0bef22 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
+#("\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" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index 1605628b29f..bfb75c0838e 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +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" 2 3 (erc-msg datestamp erc-ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
+#("\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" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index 84a1e34670c..5eea73b4f16 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +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" 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 ((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#))
+#("\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" 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 ((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#))
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 7a7e01de49d..1362c57ef10 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +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 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc-msg notice erc-ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc-msg msg erc-cmd PRIVMSG erc-ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
+#("\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 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc--msg msg erc--cmd PRIVMSG erc--ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc--msg msg erc--cmd PRIVMSG erc--ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc--msg msg erc--cmd PRIVMSG erc--ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc--msg msg erc--cmd PRIVMSG erc--ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
index bb248ffb28e..4f87c7d2547 100644
--- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -1 +1 @@
-#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg notice erc-ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc-msg msg erc-ts 0 erc-cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg notice erc--ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc--msg msg erc--ts 0 erc--cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc--msg msg erc--ts 0 erc--cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
--
2.42.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0004-5.6-Add-erc-spkr-text-property-to-chat-messages.patch --]
[-- Type: text/x-patch, Size: 77716 bytes --]
From 1dd470f193d1a7bb0baa34798317d5eac83a93ce Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 4 Dec 2023 22:13:02 -0800
Subject: [PATCH 04/11] [5.6] Add erc--spkr text property to chat messages
* etc/ERC-NEWS: Mention combined face ordering for "/me" messages.
* lisp/erc/erc-backend.el: Bind `erc--msg-prop-overrides'.
* lisp/erc/erc-fill.el (erc-fill): Switch to `erc--spkr' as sentinel
property.
(erc-fill--wrap-continued-message-p): Look for `erc--spkr' property
instead of `erc-speaker'.
* lisp/erc/erc.el (erc--msg-props): Mention `erc--spkr' in doc.
(erc--msg-props): Mention `erc--spkr'.
(erc--send-action-perform-ctcp): Add `erc--spkr' property and ensure
`erc-my-nick-face' appears above `erc-input-face' in the speaker
portion.
(erc--insure-spkr-prop): New function.
(erc--ranked-properties): Add `erc--spkr', `erc--ctcp', and
`erc--ephemeral'.
(erc-display-message): Use default hash table size when initializing.
Remove unnecessary assignment of `msg' to `erc--msg' for PRIVMSG and
NOTICE commands.
(erc--own-property-names): Add all `erc--msg-props' props.
(erc--get-speaker-bounds): Use `erc--spkr' instead of `erc--msg'.
(erc-format-privmessage, erc-format-my-nick, erc-ctcp-query-ACTION):
Add `erc--spkr' to `erc--msg-prop-overrides' when available.
* test/lisp/erc/erc-fill-tests.el:
(erc--order-text-properties-from-hash): Include `erc--spkr'.
(erc-fill-tests--insert-privmsg): bind `erc--msg-prop-overrides'.
(erc-fill-tests--compare): Require environment variable value to match
current test name for saving to work. Add `erc--msg-props'
individually to white list.
(Bug#60936)
; * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld:
; Update.
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld:
; Update.
; * test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: Update.
---
etc/ERC-NEWS | 5 ++-
lisp/erc/erc-backend.el | 3 ++
lisp/erc/erc-fill.el | 20 ++++-----
lisp/erc/erc.el | 43 +++++++++++++------
test/lisp/erc/erc-fill-tests.el | 11 +++--
test/lisp/erc/erc-tests.el | 2 +
.../fill/snapshots/merge-01-start.eld | 2 +-
.../fill/snapshots/merge-02-right.eld | 2 +-
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../merge-wrap-indicator-post-01.eld | 2 +-
.../snapshots/merge-wrap-indicator-pre-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../fill/snapshots/spacing-01-mono.eld | 2 +-
.../fill/snapshots/stamps-left-01.eld | 2 +-
17 files changed, 66 insertions(+), 40 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 238c40feefb..f6a9d934e80 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -214,7 +214,10 @@ Users of the default theme may notice that 'erc-action-face' and
'erc-notice-face' now appear slightly less bold on systems supporting
a weight of 'semi-bold'. This was done to make buttons detectable and
to spare users from resorting to tweaking these faces, or options like
-'erc-notice-highlight-type', just to achieve this effect.
+'erc-notice-highlight-type', just to achieve this effect. It's
+currently most prominent in "/ME" messages, where 'erc-action-face'
+sits beneath 'erc-input-face', as well as 'erc-my-nick-face' in the
+speaker portion.
** Improved interplay between buffer truncation and message logging.
While most of these improvements are subtle, some affect everyday use.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 500e025e5a1..b1ceeea4f44 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1916,6 +1916,7 @@ erc--server-determine-join-display-context
(erc-ignored-reply-p msg tgt proc))
(when erc-minibuffer-ignored
(message "Ignored %s from %s to %s" cmd sender-spec tgt))
+ (defvar erc--msg-prop-overrides)
(let* ((sndr (erc-parse-user sender-spec))
(nick (nth 0 sndr))
(login (nth 1 sndr))
@@ -1926,6 +1927,8 @@ erc--server-determine-join-display-context
(privp (erc-current-nick-p tgt))
(erc--display-context `((erc-buffer-display . ,(intern cmd))
,@erc--display-context))
+ (erc--msg-prop-overrides `((erc--msg . msg)
+ ,@erc--msg-prop-overrides))
s buffer
fnick)
(setf (erc-response.contents parsed) msg)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 5434d9af966..de6cd581fec 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -177,11 +177,10 @@ erc-fill
(when-let ((erc-fill-line-spacing)
(p (point-min)))
(widen)
- (when (or (erc--check-msg-prop 'erc--msg 'msg)
- (and-let* ((m (save-excursion
- (forward-line -1)
- (erc--get-inserted-msg-prop 'erc--msg))))
- (eq 'msg m)))
+ (when (or (erc--check-msg-prop 'erc--spkr)
+ (save-excursion
+ (forward-line -1)
+ (erc--get-inserted-msg-prop 'erc--spkr)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
@@ -568,22 +567,19 @@ erc-fill--wrap-continued-message-p
(props (save-restriction
(widen)
(and-let*
- (((eq 'msg (get-text-property m 'erc--msg)))
+ ((speaker (get-text-property m 'erc--spkr))
((not (eq (get-text-property m 'erc--ctcp)
'ACTION)))
- ((not (invisible-p m)))
- (spr (next-single-property-change m 'erc-speaker)))
- (cons (get-text-property m 'erc--ts)
- (get-text-property spr 'erc-speaker)))))
+ ((not (invisible-p m))))
+ (cons (get-text-property m 'erc--ts) speaker))))
(ts (pop props))
(props)
((not (time-less-p (erc-stamp--current-time) ts)))
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
;; Assume presence of leading angle bracket or hyphen.
- (speaker (next-single-property-change (point-min) 'erc-speaker))
+ (nick (erc--check-msg-prop 'erc--spkr))
((not (erc--check-msg-prop 'erc--ctcp 'ACTION)))
- (nick (get-text-property speaker 'erc-speaker))
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index c68c74467b8..7397add1e98 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -167,6 +167,8 @@ erc--msg-props
and help text, and on outgoing messages unless echoed back by
the server (assuming future support)
+ - `erc--spkr': a string, the nick of the person speaking
+
- `erc--ctcp': a CTCP command, like `ACTION'
- `erc--ts': a timestamp, possibly provided by the server; as of
@@ -3013,13 +3015,16 @@ erc--send-action-perform-ctcp
(defun erc--send-action-display (string)
"Display STRING as an outgoing \"CTCP ACTION\" message."
;; Allow hooks acting on inserted PRIVMSG and NOTICES to process us.
- (let ((erc--msg-prop-overrides `((erc--msg . msg)
- (erc--ctcp . ACTION)
- ,@erc--msg-prop-overrides))
- (nick (erc-current-nick)))
+ (defvar erc--merge-prop-behind-p)
+ (let* ((nick (erc-current-nick))
+ (erc--msg-prop-overrides `((erc--msg . msg)
+ (erc--ctcp . ACTION)
+ (erc--spkr . ,nick)
+ ,@erc--msg-prop-overrides))
+ (erc--merge-prop-behind-p t))
(setq nick (propertize nick 'erc-speaker nick
'font-lock-face 'erc-my-nick-face))
- (erc-display-message nil '(t action input) (current-buffer)
+ (erc-display-message nil '(t input action) (current-buffer)
'ACTION ?n nick ?a string ?u "" ?h "")))
(defun erc--send-action (target string force)
@@ -3029,6 +3034,12 @@ erc--send-action
;; Display interface
+(defun erc--ensure-spkr-prop (nick)
+ "Maybe add NICK to `erc--msg-props' or `erc--msg-prop-overrides'."
+ (cond (erc--msg-props (puthash 'erc--spkr nick erc--msg-props))
+ (erc--msg-prop-overrides
+ (push (cons 'erc--spkr nick) erc--msg-prop-overrides))))
+
(defun erc-string-invisible-p (string)
"Check whether STRING is invisible or not.
I.e. any char in it has the `invisible' property set."
@@ -3458,7 +3469,8 @@ erc--delete-inserted-message
(substring (delete-and-extract-region (1- (point)) (1+ end))
-1))))))))
-(defvar erc--ranked-properties '(erc--msg erc--ts erc--cmd))
+(defvar erc--ranked-properties
+ '(erc--msg erc--spkr erc--ts erc--cmd erc--ctcp erc--ephemeral))
(defun erc--order-text-properties-from-hash (table)
"Return a plist of text props from items in TABLE.
@@ -3729,12 +3741,11 @@ erc-display-message
msg))
(erc--msg-props
(or erc--msg-props
- (let ((table (make-hash-table :size 5))
+ (let ((table (make-hash-table))
(cmd (and parsed (erc--get-eq-comparable-cmd
(erc-response.command parsed)))))
(puthash 'erc--msg
(cond ((and msg (symbolp msg)) msg)
- ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
(type (pcase type
((pred symbolp) type)
((pred listp)
@@ -3745,8 +3756,8 @@ erc-display-message
table)
(when cmd
(puthash 'erc--cmd cmd table))
- (and-let* ((ovs erc--msg-prop-overrides))
- (pcase-dolist (`(,k . ,v) (reverse ovs))
+ (when erc--msg-prop-overrides
+ (pcase-dolist (`(,k . ,v) (reverse erc--msg-prop-overrides))
(puthash k v table)))
table)))
(erc-message-parsed parsed))
@@ -4645,6 +4656,9 @@ erc-send-message
(funcall erc--send-message-nested-function line force)
(erc--send-message-external line force)))
+;; FIXME fully simulate `erc-display-msg'. This doesn't currently add
+;; the correct text properties. For example, the LINE should have
+;; `erc-default-face'.
(defun erc--send-message-external (line force)
(erc-message "PRIVMSG" (concat (erc-default-target) " " line) force)
(erc-display-line
@@ -5258,7 +5272,9 @@ erc-ensure-channel-name
(concat "#" channel)))
(defvar erc--own-property-names
- '( tags erc-speaker erc-parsed display ; core
+ `( tags erc-speaker erc-parsed display ; core
+ ;; `erc--msg-props'
+ ,@erc--ranked-properties
;; `erc-display-prompt'
rear-nonsticky erc-prompt field front-sticky read-only
;; stamp
@@ -5744,7 +5760,7 @@ erc-is-message-ctcp-and-not-action-p
(defun erc--get-speaker-bounds ()
"Return the bounds of `erc-speaker' text property when present.
Assume buffer is narrowed to the confines of an inserted message."
- (and-let* (((erc--check-msg-prop 'erc--msg 'msg))
+ (and-let* (((erc--check-msg-prop 'erc--spkr))
(beg (text-property-not-all (point-min) (point-max)
'erc-speaker nil)))
(cons beg (next-single-property-change beg 'erc-speaker))))
@@ -5772,6 +5788,7 @@ erc-format-privmessage
nick-prefix-face nick))
0))
(msg-face (if privp 'erc-direct-msg-face 'erc-default-face)))
+ (erc--ensure-spkr-prop nick)
;; add text properties to text before the nick, the nick and after the nick
(erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str)
(erc-put-text-properties (+ (length mark-s) prefix-len)
@@ -5827,6 +5844,7 @@ erc-format-my-nick
(close "> ")
(nick (erc-current-nick))
(mode (erc-get-user-mode-prefix nick)))
+ (erc--ensure-spkr-prop nick)
(concat
(propertize open 'font-lock-face 'erc-default-face)
(propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
@@ -6111,6 +6129,7 @@ erc-ctcp-query-ACTION
(buf (or (erc-get-buffer to proc)
(erc-get-buffer nick proc)
(process-buffer proc))))
+ (erc--ensure-spkr-prop nick)
(setq nick (propertize nick 'erc-speaker nick))
(erc-display-message
parsed 'action buf
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index bfdf8cd7320..8560d421cc2 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -35,7 +35,8 @@ erc-stamp--current-time
(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
(declare (indent 1))
- (let* ((msg (erc-format-privmessage speaker
+ (let* ((erc--msg-prop-overrides `((erc--msg . msg)))
+ (msg (erc-format-privmessage speaker
(apply #'concat msg-parts) nil t))
(parsed (make-erc-response :unparsed (format ":%s PRIVMSG #chan :%s"
speaker msg)
@@ -150,7 +151,9 @@ erc-fill-tests--compare
"eld"))
(erc--own-property-names
(seq-difference `(font-lock-face ,@erc--own-property-names)
- '(field display wrap-prefix line-prefix)
+ `(field display wrap-prefix line-prefix
+ erc--msg erc--cmd erc--spkr erc--ts erc--ctcp
+ erc--ephemeral)
#'eq))
(print-circle t)
(print-escape-newlines t)
@@ -165,12 +168,12 @@ erc-fill-tests--compare
(with-silent-modifications
(insert (setq got (read repr))))
(erc-mode))
- (if erc-fill-tests--save-p
+ ;; LHS is a string, RHS is a symbol.
+ (if (string= erc-fill-tests--save-p (ert-test-name (ert-running-test)))
(let (inhibit-message)
(with-temp-file expect-file
(insert repr))
;; Limit writing snapshots to one test at a time.
- (setq erc-fill-tests--save-p nil)
(message "erc-fill-tests--compare: wrote %S" expect-file))
(if (file-exists-p expect-file)
;; Ensure string-valued properties, like timestamps, aren't
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b8ebc23e686..ed1dcccd59c 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1859,6 +1859,7 @@ erc--order-text-properties-from-hash
(erc--msg . s005)
(b . 2)
(erc--cmd . 5)
+ (erc--spkr . "X")
(c . 3))
'hash-table)))
(with-temp-buffer
@@ -1866,6 +1867,7 @@ erc--order-text-properties-from-hash
(insert "abc\n")
(add-text-properties 1 2 (erc--order-text-properties-from-hash table))
(should (equal '( erc--msg s005
+ erc--spkr "X"
erc--ts 0
erc--cmd 5
a 1
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index f4a43a9384f..3c32719a052 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 (#6=(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 #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\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 (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" 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--spkr "bob" 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--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index 78450ec08e2..e2064b914c4 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(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 (- 29 (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 (- 29 (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 (- 29 (18)))) 455 456 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 29 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[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 (- 29 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 29 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 29 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
+#("\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<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG) 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 (space :width (- 29 (8)))) 349 350 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG) 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 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 455 456 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index 8e5535093e1..9f648915d5c 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +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#) 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#))
+#("\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--spkr "alice" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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#) 506 507 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
index a0c03244afe..a63fcad3d38 100644
--- 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
@@ -1 +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#))
\ No newline at end of file
+#("\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--spkr "alice" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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
index c4a51e06354..7cbabfd0581 100644
--- 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
@@ -1 +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#))
\ No newline at end of file
+#("\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--spkr "alice" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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--spkr "bob" 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
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index 5eea73b4f16..c94629cf357 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +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" 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 ((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#))
+#("\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" 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" 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--spkr "bob" 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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index bc59c0bef22..127c0b29bc9 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +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" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 29 (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 (- 29 (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#))
+#("\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" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (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--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index bfb75c0838e..a9f3f1d1904 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +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" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((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 (- 25 (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 (- 25 (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#))
+#("\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" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (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--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index 5eea73b4f16..c94629cf357 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +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" 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 ((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#))
+#("\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" 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" 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--spkr "bob" 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#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 1362c57ef10..754d7989cea 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +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 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc--msg msg erc--cmd PRIVMSG erc--ts 0 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#) 348 349 (line-spacing 0.5) 349 350 (erc--msg msg erc--cmd PRIVMSG erc--ts 0 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#) 435 436 (line-spacing 0.5) 436 437 (erc--msg msg erc--cmd PRIVMSG erc--ts 0 wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc--msg msg erc--cmd PRIVMSG erc--ts 0 wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
+#("\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 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 ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" 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#) 348 349 (line-spacing 0.5) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" 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#) 435 436 (line-spacing 0.5) 436 437 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
index 4f87c7d2547..1b22b6c5cfd 100644
--- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -1 +1 @@
-#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg notice erc--ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc--msg msg erc--ts 0 erc--cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc--msg msg erc--ts 0 erc--cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg notice erc--ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#))
\ No newline at end of file
--
2.42.0
^ permalink raw reply related [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (23 preceding siblings ...)
2023-12-07 7:14 ` J.P.
@ 2024-02-15 12:01 ` tzakmagiel via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-21 1:12 ` J.P.
2024-04-09 20:48 ` bug#60936: (no subject) Alcor
25 siblings, 1 reply; 56+ messages in thread
From: tzakmagiel via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-15 12:01 UTC (permalink / raw)
To: 60936@debbugs.gnu.org
+1'ing this the issue in Message #166 for visibility. I raised this question under the nick "alcor" on #erc yesterday, and I agree that the default behavior of `fill-wrap' (i.e. without `scrolltobottom') might be confusing/unexpected for new `fill-wrap' users (such as myself, in this case).
For the record, the behavior without the scrolltobottom module could be described as "messages tend to drift upward on screen, gradually increasing the whitespace between prompt and bottom of window" (This description courtesy of corwin on #erc).
>I'm thinking it might make sense to have `fill-wrap' formally depend on `scrolltobottom', even though there's no technical reason to do so.
+1 on that too. The behavior with `scrolltobottom' makes more sense (as a default) and is more in line with other IRC clients, where the message prompt is kept at the bottom of the window.
^ permalink raw reply [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2024-02-15 12:01 ` tzakmagiel via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-21 1:12 ` J.P.
0 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2024-02-21 1:12 UTC (permalink / raw)
To: tzakmagiel; +Cc: 60936
tzakmagiel writes:
> +1'ing this the issue in Message #166 for visibility. I raised this question
> under the nick "alcor" on #erc yesterday, and I agree that the default
> behavior of `fill-wrap' (i.e. without `scrolltobottom') might be
> confusing/unexpected for new `fill-wrap' users (such as myself, in this case).
>
> For the record, the behavior without the scrolltobottom module could be
> described as "messages tend to drift upward on screen, gradually increasing
> the whitespace between prompt and bottom of window" (This description courtesy
> of corwin on #erc).
>
>>I'm thinking it might make sense to have `fill-wrap' formally depend on
> `scrolltobottom', even though there's no technical reason to do so.
>
> +1 on that too. The behavior with `scrolltobottom' makes more sense (as a
> default) and is more in line with other IRC clients, where the message prompt
> is kept at the bottom of the window.
Appreciate the input. `fill-wrap' now activates `scrolltobottom' if not
already enabled and also reminds users to add it to `erc-modules' when
that's the case:
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=9668b4f9
Please let us know if something's still amiss or if the fix is otherwise
inadequate. Thanks.
^ permalink raw reply [flat|nested] 56+ messages in thread
* bug#60936: (no subject)
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
` (24 preceding siblings ...)
2024-02-15 12:01 ` tzakmagiel via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-04-09 20:48 ` Alcor
2024-04-23 22:37 ` bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
25 siblings, 1 reply; 56+ messages in thread
From: Alcor @ 2024-04-09 20:48 UTC (permalink / raw)
To: 60936
Hi J.P.,
I have applied and tested
0002-5.6-Don-t-nest-date-stamp-insertions-in-erc-stamp.patch on
erc-5.6snapshot0.20240407.125921 with a few high-traffic channels (#emacs,
#linux) and observe no regressions.
+1.
Cheers,
-A.
^ permalink raw reply [flat|nested] 56+ messages in thread* bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
2024-04-09 20:48 ` bug#60936: (no subject) Alcor
@ 2024-04-23 22:37 ` J.P.
0 siblings, 0 replies; 56+ messages in thread
From: J.P. @ 2024-04-23 22:37 UTC (permalink / raw)
To: Alcor; +Cc: 60936, emacs-erc
Alcor <alcor@tilde.club> writes:
> Hi J.P.,
>
> I have applied and tested
> 0002-5.6-Don-t-nest-date-stamp-insertions-in-erc-stamp.patch on
> erc-5.6snapshot0.20240407.125921 with a few high-traffic channels (#emacs,
> #linux) and observe no regressions.
>
> +1.
Thanks a lot for trying this. I have installed something similar as:
86184cba218 Don't nest date stamp insertions in erc-stamp
This bug is already closed.
^ permalink raw reply [flat|nested] 56+ messages in thread
![[-- Attachment #3: fill-wrap-log-compare-chan.png --] [-- Type: image/png, Size: 54453 bytes --]](../../87mt5xcvfj.fsf__24753.536765796$1675261731$gmane$org@neverwas.me/3-fill-wrap-log-compare-chan.png){kind=link}