From: "J.P." <jp@neverwas.me>
To: 51969@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#51969: 29.0.50; Add command for refilling ERC buffers
Date: Fri, 19 Nov 2021 20:12:13 -0800 [thread overview]
Message-ID: <87fsrrqxcy.fsf__29180.3152345651$1637381603$gmane$org@neverwas.me> (raw)
In-Reply-To: <87bl2gjuo9.fsf@neverwas.me> (J. P.'s message of "Fri, 19 Nov 2021 02:39:50 -0800")
[-- Attachment #1: Type: text/plain, Size: 85 bytes --]
Addressed some erroneous line folding involving wide chars. But bugs
likely remain.
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 13430 bytes --]
From 1058b9202f9b530062bd5268c81a111976db61f2 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 19 Nov 2021 19:07:24 -0800
Subject: NOT A PATCH
F. Jason Park (1):
Add command to refill ERC buffers
lisp/erc/erc-fill.el | 121 ++++++++++
.../erc/erc-fill-resources/static-60.buffer | 24 ++
.../erc/erc-fill-resources/static-72.buffer | 20 ++
.../erc/erc-fill-resources/variable-60.buffer | 18 ++
.../erc/erc-fill-resources/variable-72.buffer | 18 ++
test/lisp/erc/erc-fill-tests.el | 206 ++++++++++++++++++
6 files changed, 407 insertions(+)
create mode 100644 test/lisp/erc/erc-fill-resources/static-60.buffer
create mode 100644 test/lisp/erc/erc-fill-resources/static-72.buffer
create mode 100644 test/lisp/erc/erc-fill-resources/variable-60.buffer
create mode 100644 test/lisp/erc/erc-fill-resources/variable-72.buffer
create mode 100644 test/lisp/erc/erc-fill-tests.el
Interdiff:
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 3bf335d098..49130b9ffc 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -112,30 +112,47 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
-(defun erc-fill--remove-stamp-right ()
- (goto-char (point-min))
- (let (changed)
- (while
- (when-let* ((nextf (next-single-property-change (point) 'field)))
- (goto-char (field-end nextf t))
- ;; Sweep up residual phantom field remants
- (delete-region nextf (field-end nextf t))
- (setq changed t)))
- changed))
-
-(defun erc-fill--remove-stamp-left ()
- "Remove at most one LEFT or one right timestamp, if any."
- (goto-char (point-min))
- ;; FIXME actually, it may be a mistake to blow past white space
- ;; without checking for intervening intervals that need cleaning up.
- (when-let* ((beg (save-excursion (skip-syntax-forward ">-") (point)))
- (nextf (when (eq 'erc-timestamp (field-at-pos beg))
- (field-beginning beg t)))
- ((eq 'erc-timestamp (get-text-property nextf 'field))))
- (goto-char (field-end nextf t))
- (skip-syntax-forward "-")
- (delete-region nextf (point))
- t))
+(defun erc-fill--refill-message (beg end)
+ "Refill but don't re-stamp region between BEG and END.
+Return non-nil if timestamps were removed."
+ (let (left-changed right-changed)
+ (narrow-to-region beg end)
+ ;; Remove at most one left timestamp, if any.
+ (goto-char (point-min))
+ (setq left-changed
+ ;; FIXME it may be a mistake to blow past leading whitespace
+ ;; without removing any intervening ws-only field intervals
+ (when-let* ((beg (save-excursion (skip-syntax-forward ">-") (point)))
+ (nextf (when (eq 'erc-timestamp (field-at-pos beg))
+ (field-beginning beg t)))
+ ((eq 'erc-timestamp (get-text-property nextf 'field))))
+ (goto-char (field-end nextf t))
+ (skip-syntax-forward "-")
+ (delete-region nextf (point))
+ t))
+ ;; Get everything on one line (if NOSQUEEZE seems warranted, see
+ ;; note below re ASCII art).
+ (let ((fill-column (string-width (buffer-string))))
+ (fill-region (point-min) (point-max)))
+ ;; Remove any stamps from right-hand side.
+ (goto-char (point-min))
+ (setq right-changed
+ (when-let* ((nextf (next-single-property-change (point) 'field)))
+ (delete-region nextf (1- (point-max)))
+ t))
+ (erc-fill)
+ ;; Remove trailing whitespace from last line, if any.
+ (goto-char (point-max))
+ (forward-line -1)
+ (when (re-search-forward "\\s-$" (line-end-position) t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; Neuter timestamp caching to force insertion.
+ (when (or left-changed right-changed)
+ (when left-changed
+ (setq erc-timestamp-last-inserted-left nil))
+ (when right-changed
+ (setq erc-timestamp-last-inserted-right nil))
+ t)))
(defun erc-fill--hack-csf (f)
;; HACK until necessary additions to erc-stamp.el arrive (possibly
@@ -162,7 +179,7 @@ erc-fill--refill
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
;;
- left-changed right-changed ct) ; cached current time
+ ct) ; cached current time
(cl-letf (((symbol-function #'erc-restore-text-properties) #'ignore)
((symbol-function #'current-time) (lambda () ct)))
(while
@@ -188,19 +205,8 @@ erc-fill--refill
(end (text-property-not-all beg (point-max)
'cursor-sensor-functions val)))
(save-restriction
- (narrow-to-region beg end)
- (setq left-changed (erc-fill--remove-stamp-left))
- ;; If NOSQUEEZE seems warranted, see note above.
- (let ((fill-column (- (point-max) (point-min))))
- (fill-region (point-min) (point-max)))
- (setq right-changed (erc-fill--remove-stamp-right))
- (erc-fill)
- (when (setq ct (when (or left-changed right-changed)
- (erc-fill--hack-csf (car val))))
- (when left-changed
- (setq erc-timestamp-last-inserted-left nil))
- (when right-changed
- (setq erc-timestamp-last-inserted-right nil))
+ (when (setq ct (and (erc-fill--refill-message beg end)
+ (erc-fill--hack-csf (car val))))
(erc-add-timestamp))
(when reporter
(cl-incf (aref (cdr reporter) 2) ; max += d_new - d_old
diff --git a/test/lisp/erc/erc-fill-resources/static-60.buffer b/test/lisp/erc/erc-fill-resources/static-60.buffer
index b33f11ae96..f8db4bf7f4 100644
--- a/test/lisp/erc/erc-fill-resources/static-60.buffer
+++ b/test/lisp/erc/erc-fill-resources/static-60.buffer
@@ -2,7 +2,9 @@
[Tue Jan 1 1980]
- *** #chan modes: +nt [00:00]
+ *** Users on #chan: alice @bob robot
+ tester [00:00]
+ *** #chan modes: +nt
*** #chan was created on 2021-05-04
05:06:19
<bob> lorem ipsum This buffer is for
@@ -10,9 +12,10 @@
Lisp evaluation. [00:01]
<alice> tester, welcome! Your name may or
may not be highlighted depending
- on whether button's been loaded
- by an earlier test. ERC needs
- help! [00:03]
+ on whether erc-button's been
+ enabled by an earlier test. ERC
+ needs help! [00:03]
+ <robot> ・゜゜・。。・゜゜\_o< QUACK!
[Wed Jan 2 1980]
<bob> tester, welcome! To create a
diff --git a/test/lisp/erc/erc-fill-resources/static-72.buffer b/test/lisp/erc/erc-fill-resources/static-72.buffer
index 79ed88d112..6523f0887e 100644
--- a/test/lisp/erc/erc-fill-resources/static-72.buffer
+++ b/test/lisp/erc/erc-fill-resources/static-72.buffer
@@ -2,14 +2,17 @@
[Tue Jan 1 1980]
- *** #chan modes: +nt [00:00]
+ *** Users on #chan: alice @bob robot tester
+ [00:00]
+ *** #chan modes: +nt
*** #chan was created on 2021-05-04 05:06:19
<bob> lorem ipsum This buffer is for text that is
not saved, and for Lisp evaluation. [00:01]
<alice> tester, welcome! Your name may or may not be
- highlighted depending on whether button's
- been loaded by an earlier test. ERC needs
+ highlighted depending on whether erc-button's
+ been enabled by an earlier test. ERC needs
help! [00:03]
+ <robot> ・゜゜・。。・゜゜\_o< QUACK!
[Wed Jan 2 1980]
<bob> tester, welcome! To create a file, visit it
diff --git a/test/lisp/erc/erc-fill-resources/variable-60.buffer b/test/lisp/erc/erc-fill-resources/variable-60.buffer
index 4bf2741af0..38723209bf 100644
--- a/test/lisp/erc/erc-fill-resources/variable-60.buffer
+++ b/test/lisp/erc/erc-fill-resources/variable-60.buffer
@@ -2,13 +2,15 @@
[Tue Jan 1 1980]
-*** #chan modes: +nt [00:00]
+*** Users on #chan: alice @bob robot tester [00:00]
+*** #chan modes: +nt
*** #chan was created on 2021-05-04 05:06:19
<bob> lorem ipsum This buffer is for text that is not saved,
and for Lisp evaluation. [00:01]
<alice> tester, welcome! Your name may or may not be
- highlighted depending on whether button's been
- loaded by an earlier test. ERC needs help! [00:03]
+ highlighted depending on whether erc-button's been
+ enabled by an earlier test. ERC needs help! [00:03]
+<robot> ・゜゜・。。・゜゜\_o< QUACK!
[Wed Jan 2 1980]
<bob> tester, welcome! To create a file, visit it with ? and
diff --git a/test/lisp/erc/erc-fill-resources/variable-72.buffer b/test/lisp/erc/erc-fill-resources/variable-72.buffer
index de376cc15d..cc2410d7a7 100644
--- a/test/lisp/erc/erc-fill-resources/variable-72.buffer
+++ b/test/lisp/erc/erc-fill-resources/variable-72.buffer
@@ -2,13 +2,15 @@
[Tue Jan 1 1980]
-*** #chan modes: +nt [00:00]
+*** Users on #chan: alice @bob robot tester [00:00]
+*** #chan modes: +nt
*** #chan was created on 2021-05-04 05:06:19
<bob> lorem ipsum This buffer is for text that is not saved, and for
Lisp evaluation. [00:01]
<alice> tester, welcome! Your name may or may not be highlighted
- depending on whether button's been loaded by an earlier
+ depending on whether erc-button's been enabled by an earlier
test. ERC needs help! [00:03]
+<robot> ・゜゜・。。・゜゜\_o< QUACK!
[Wed Jan 2 1980]
<bob> tester, welcome! To create a file, visit it with ? and enter text
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index a7e3d78d74..a0b695a6c7 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -67,6 +67,10 @@ erc-fill-tests--populate
(cl-letf (((symbol-function 'current-time) (lambda () ct)))
(with-current-buffer "foonet"
+ (erc-fill-tests--insert ":irc.foonet.org 353 tester = #chan :"
+ "alice @bob robot tester")
+ (erc-fill-tests--insert ":irc.foonet.org 366 tester #chan :"
+ "End of /NAMES list.")
(erc-fill-tests--insert ":irc.foonet.org 324 tester #chan +nt")
(erc-fill-tests--insert ":irc.foonet.org 329 tester #chan 1620104779")
@@ -79,7 +83,10 @@ erc-fill-tests--populate
(erc-fill-tests--insert
":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"
" Your name may or may not be highlighted depending on whether"
- " button's been loaded by an earlier test. ERC needs help!")
+ " erc-button's been enabled by an earlier test. ERC needs help!")
+
+ (erc-fill-tests--insert
+ ":robot!~u@rz2v467q4rwhy.irc PRIVMSG #chan :・゜゜・。。・゜゜\\_o< QUACK!")
(setq ct (time-convert (cl-incf ts (* 60 60 24))))
(erc-fill-tests--insert
@@ -87,14 +94,6 @@ erc-fill-tests--populate
" To create a file, visit it with ? and enter text in its buffer.")))))
(defun erc-fill-tests--teardown ()
- ;; XXX when inspecting manually, must reactivate fill and stamp modes.
- ;; Otherwise `erc-fill-buffer' won't work.
- (dolist (buf '("variable-60.buffer"
- "variable-72.buffer"
- "static-60.buffer"
- "static-72.buffer"))
- (when (buffer-live-p buf)
- (kill-buffer buf)))
(advice-remove 'format-time-string 'ts)
(let (erc-kill-server-hook
erc-kill-channel-hook)
@@ -106,7 +105,8 @@ erc-fill-tests--compare
;; Git didn't allow committing with a trailing space after the
;; prompt, hence this:
(equal (substring-no-properties (buffer-string) 0 -1)
- (with-current-buffer (find-file-literally (ert-resource-file name))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file name))
(buffer-string))))
(defun erc-fill-tests--await-fill ()
--
2.31.1
[-- Attachment #3: 0001-Add-command-to-refill-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 20218 bytes --]
From 1058b9202f9b530062bd5268c81a111976db61f2 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 16 Nov 2021 06:28:25 -0800
Subject: [PATCH 1/1] Add command to refill ERC buffers
* lisp/erc/erc-fill.el (erc-fill-buffer, erc-fill--refill,
erc-fill--refill-thread, erc-fill--refill-message,
erc-fill--hack-csf): Add new command and helpers to refill ERC
buffers.
* lisp/erc/erc-fill-tests.el: Add new file containing tests for
`erc-fill-buffer'. Add some support files to test against in
lisp/erc/erc-fill-resources.
---
lisp/erc/erc-fill.el | 121 ++++++++++
.../erc/erc-fill-resources/static-60.buffer | 24 ++
.../erc/erc-fill-resources/static-72.buffer | 20 ++
.../erc/erc-fill-resources/variable-60.buffer | 18 ++
.../erc/erc-fill-resources/variable-72.buffer | 18 ++
test/lisp/erc/erc-fill-tests.el | 206 ++++++++++++++++++
6 files changed, 407 insertions(+)
create mode 100644 test/lisp/erc/erc-fill-resources/static-60.buffer
create mode 100644 test/lisp/erc/erc-fill-resources/static-72.buffer
create mode 100644 test/lisp/erc/erc-fill-resources/variable-60.buffer
create mode 100644 test/lisp/erc/erc-fill-resources/variable-72.buffer
create mode 100644 test/lisp/erc/erc-fill-tests.el
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 9f29b9dad9..49130b9ffc 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -112,6 +112,127 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
+(defun erc-fill--refill-message (beg end)
+ "Refill but don't re-stamp region between BEG and END.
+Return non-nil if timestamps were removed."
+ (let (left-changed right-changed)
+ (narrow-to-region beg end)
+ ;; Remove at most one left timestamp, if any.
+ (goto-char (point-min))
+ (setq left-changed
+ ;; FIXME it may be a mistake to blow past leading whitespace
+ ;; without removing any intervening ws-only field intervals
+ (when-let* ((beg (save-excursion (skip-syntax-forward ">-") (point)))
+ (nextf (when (eq 'erc-timestamp (field-at-pos beg))
+ (field-beginning beg t)))
+ ((eq 'erc-timestamp (get-text-property nextf 'field))))
+ (goto-char (field-end nextf t))
+ (skip-syntax-forward "-")
+ (delete-region nextf (point))
+ t))
+ ;; Get everything on one line (if NOSQUEEZE seems warranted, see
+ ;; note below re ASCII art).
+ (let ((fill-column (string-width (buffer-string))))
+ (fill-region (point-min) (point-max)))
+ ;; Remove any stamps from right-hand side.
+ (goto-char (point-min))
+ (setq right-changed
+ (when-let* ((nextf (next-single-property-change (point) 'field)))
+ (delete-region nextf (1- (point-max)))
+ t))
+ (erc-fill)
+ ;; Remove trailing whitespace from last line, if any.
+ (goto-char (point-max))
+ (forward-line -1)
+ (when (re-search-forward "\\s-$" (line-end-position) t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; Neuter timestamp caching to force insertion.
+ (when (or left-changed right-changed)
+ (when left-changed
+ (setq erc-timestamp-last-inserted-left nil))
+ (when right-changed
+ (setq erc-timestamp-last-inserted-right nil))
+ t)))
+
+(defun erc-fill--hack-csf (f)
+ ;; HACK until necessary additions to erc-stamp.el arrive (possibly
+ ;; with erc-v3 in #49860), there's no civilized way of detecting the
+ ;; bounds of a displayed message after initial insertion.
+ ;;
+ ;; These callback closures are used for that purpose, but they also
+ ;; contain the timestamp we need. An unforeseen benefit of this
+ ;; awkwardness is that it plays well with `text-property-not-all',
+ ;; which needs unique values to match against. That wouldn't be the
+ ;; case were we to use lisp time objects instead because successive
+ ;; messages might contain the exact same one.
+ (if (byte-code-function-p f) (aref (aref f 2) 0) (alist-get 'ct (cadr f))))
+
+;; Enabling `erc-fill-mode' is ultimately destructive to preformatted
+;; text (like ASCII art and figlets), which degenerate immediately
+;; upon display. This is permanent because we don't store original
+;; messages (though with IRCv3, it may be possible to request a
+;; replacement from the server).
+(defun erc-fill--refill ()
+ (let ((m (make-marker))
+ (reporter (unless noninteractive
+ (make-progress-reporter "filling" 0 (point-max))))
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ ;;
+ ct) ; cached current time
+ (cl-letf (((symbol-function #'erc-restore-text-properties) #'ignore)
+ ((symbol-function #'current-time) (lambda () ct)))
+ (while
+ (save-excursion
+ (goto-char (or (marker-position m) (set-marker m (point-min))))
+ (when-let*
+ ((beg (if (get-text-property (point) 'cursor-sensor-functions)
+ (point)
+ (when-let*
+ ((max (min (point-max) (+ 512 (point))))
+ (res (next-single-property-change
+ (point) 'cursor-sensor-functions nil max))
+ ((/= res max))) ; otherwise, we're done.
+ res)))
+ (val (get-text-property beg 'cursor-sensor-functions))
+ (beg (progn ; remove left padding, if any.
+ (goto-char beg)
+ (skip-syntax-forward "-")
+ (delete-region (min (line-beginning-position) beg)
+ (point))
+ (point)))
+ ;; Don't expect output limited to IRC message length.
+ (end (text-property-not-all beg (point-max)
+ 'cursor-sensor-functions val)))
+ (save-restriction
+ (when (setq ct (and (erc-fill--refill-message beg end)
+ (erc-fill--hack-csf (car val))))
+ (erc-add-timestamp))
+ (when reporter
+ (cl-incf (aref (cdr reporter) 2) ; max += d_new - d_old
+ (- (point-max) (point-min) end (- beg))))
+ (set-marker m (goto-char (point-max))))))
+ (when reporter
+ (progress-reporter-update reporter (point)))
+ (thread-yield)))))
+
+(defvar-local erc-fill--refill-thread nil
+ "A thread running a buffer-refill job.")
+
+(define-error 'erc-fill-canceled "ERC refill canceled" 'error)
+
+(defun erc-fill-buffer (force)
+ "Refill an ERC buffer.
+With FORCE, cancel an active refill job if one exists."
+ (interactive "P")
+ (when (and erc-fill--refill-thread
+ (thread-live-p erc-fill--refill-thread))
+ (if force
+ (thread-signal erc-fill--refill-thread
+ 'erc-fill-canceled (list (buffer-name)))
+ (user-error "Already refilling.")))
+ (setq erc-fill--refill-thread (make-thread #'erc-fill--refill "erc-fill")))
+
;;;###autoload
(defun erc-fill ()
"Fill a region using the function referenced in `erc-fill-function'.
diff --git a/test/lisp/erc/erc-fill-resources/static-60.buffer b/test/lisp/erc/erc-fill-resources/static-60.buffer
new file mode 100644
index 0000000000..f8db4bf7f4
--- /dev/null
+++ b/test/lisp/erc/erc-fill-resources/static-60.buffer
@@ -0,0 +1,24 @@
+
+
+
+[Tue Jan 1 1980]
+ *** Users on #chan: alice @bob robot
+ tester [00:00]
+ *** #chan modes: +nt
+ *** #chan was created on 2021-05-04
+ 05:06:19
+ <bob> lorem ipsum This buffer is for
+ text that is not saved, and for
+ Lisp evaluation. [00:01]
+ <alice> tester, welcome! Your name may or
+ may not be highlighted depending
+ on whether erc-button's been
+ enabled by an earlier test. ERC
+ needs help! [00:03]
+ <robot> ・゜゜・。。・゜゜\_o< QUACK!
+
+[Wed Jan 2 1980]
+ <bob> tester, welcome! To create a
+ file, visit it with ? and enter
+ text in its buffer.
+ERC>
\ No newline at end of file
diff --git a/test/lisp/erc/erc-fill-resources/static-72.buffer b/test/lisp/erc/erc-fill-resources/static-72.buffer
new file mode 100644
index 0000000000..6523f0887e
--- /dev/null
+++ b/test/lisp/erc/erc-fill-resources/static-72.buffer
@@ -0,0 +1,20 @@
+
+
+
+[Tue Jan 1 1980]
+ *** Users on #chan: alice @bob robot tester
+ [00:00]
+ *** #chan modes: +nt
+ *** #chan was created on 2021-05-04 05:06:19
+ <bob> lorem ipsum This buffer is for text that is
+ not saved, and for Lisp evaluation. [00:01]
+ <alice> tester, welcome! Your name may or may not be
+ highlighted depending on whether erc-button's
+ been enabled by an earlier test. ERC needs
+ help! [00:03]
+ <robot> ・゜゜・。。・゜゜\_o< QUACK!
+
+[Wed Jan 2 1980]
+ <bob> tester, welcome! To create a file, visit it
+ with ? and enter text in its buffer.
+ERC>
\ No newline at end of file
diff --git a/test/lisp/erc/erc-fill-resources/variable-60.buffer b/test/lisp/erc/erc-fill-resources/variable-60.buffer
new file mode 100644
index 0000000000..38723209bf
--- /dev/null
+++ b/test/lisp/erc/erc-fill-resources/variable-60.buffer
@@ -0,0 +1,18 @@
+
+
+
+[Tue Jan 1 1980]
+*** Users on #chan: alice @bob robot tester [00:00]
+*** #chan modes: +nt
+*** #chan was created on 2021-05-04 05:06:19
+<bob> lorem ipsum This buffer is for text that is not saved,
+ and for Lisp evaluation. [00:01]
+<alice> tester, welcome! Your name may or may not be
+ highlighted depending on whether erc-button's been
+ enabled by an earlier test. ERC needs help! [00:03]
+<robot> ・゜゜・。。・゜゜\_o< QUACK!
+
+[Wed Jan 2 1980]
+<bob> tester, welcome! To create a file, visit it with ? and
+ enter text in its buffer.
+ERC>
\ No newline at end of file
diff --git a/test/lisp/erc/erc-fill-resources/variable-72.buffer b/test/lisp/erc/erc-fill-resources/variable-72.buffer
new file mode 100644
index 0000000000..cc2410d7a7
--- /dev/null
+++ b/test/lisp/erc/erc-fill-resources/variable-72.buffer
@@ -0,0 +1,18 @@
+
+
+
+[Tue Jan 1 1980]
+*** Users on #chan: alice @bob robot tester [00:00]
+*** #chan modes: +nt
+*** #chan was created on 2021-05-04 05:06:19
+<bob> lorem ipsum This buffer is for text that is not saved, and for
+ Lisp evaluation. [00:01]
+<alice> tester, welcome! Your name may or may not be highlighted
+ depending on whether erc-button's been enabled by an earlier
+ test. ERC needs help! [00:03]
+<robot> ・゜゜・。。・゜゜\_o< QUACK!
+
+[Wed Jan 2 1980]
+<bob> tester, welcome! To create a file, visit it with ? and enter text
+ in its buffer.
+ERC>
\ No newline at end of file
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 0000000000..a0b695a6c7
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,206 @@
+;;; erc-fill-tests.el --- ERC message filling -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 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)
+(require 'erc-fill)
+
+(defun erc-fill-tests--insert (&rest strings)
+ (let ((inhibit-read-only t))
+ (erc-parse-server-response erc-server-process (apply #'concat strings))))
+
+(defun erc-fill-tests--setup-server-buffer ()
+ (with-current-buffer (get-buffer-create "foonet")
+ (erc-mode)
+ (setq erc-server-process (start-process "true" (current-buffer) "true")
+ erc-server-current-nick "tester"
+ erc-server-users (make-hash-table :test #'equal))
+ (set-process-query-on-exit-flag erc-server-process nil)))
+
+(defun erc-fill-tests--setup-channel-buffer ()
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (insert "\n\n")
+ (setq erc-input-marker (make-marker)
+ ;; Kludge to get around saving display prop
+ erc-timestamp-use-align-to nil
+ ;; Kludge to make whitespace compare equal without expanding
+ indent-tabs-mode nil
+ erc-insert-marker (make-marker)
+ erc-default-recipients '("#chan")
+ erc-channel-users (make-hash-table :test #'equal)
+ erc-server-process (with-current-buffer "foonet"
+ erc-server-process))
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)))
+
+(defun erc-fill-tests--setup ()
+ (advice-add 'format-time-string :filter-args
+ (lambda (args) (list (car args) (cadr args) 0)) '((name . ts)))
+
+ (erc-stamp-mode +1)
+
+ (erc-fill-tests--setup-server-buffer)
+ (erc-fill-tests--setup-channel-buffer)
+ (erc-fill-tests--populate))
+
+(defun erc-fill-tests--populate ()
+ (let* ((ts (+ (* 2 60 60 24) (* 60 60 24 365 10))) ; Jan 1 1980
+ (ct (time-convert ts)))
+
+ (cl-letf (((symbol-function 'current-time) (lambda () ct)))
+ (with-current-buffer "foonet"
+ (erc-fill-tests--insert ":irc.foonet.org 353 tester = #chan :"
+ "alice @bob robot tester")
+ (erc-fill-tests--insert ":irc.foonet.org 366 tester #chan :"
+ "End of /NAMES list.")
+ (erc-fill-tests--insert ":irc.foonet.org 324 tester #chan +nt")
+ (erc-fill-tests--insert ":irc.foonet.org 329 tester #chan 1620104779")
+
+ (setq ct (time-convert (cl-incf ts 60)))
+ (erc-fill-tests--insert
+ ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :lorem ipsum"
+ " This buffer is for text that is not saved, and for Lisp evaluation.")
+
+ (setq ct (time-convert (cl-incf ts 120)))
+ (erc-fill-tests--insert
+ ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"
+ " Your name may or may not be highlighted depending on whether"
+ " erc-button's been enabled by an earlier test. ERC needs help!")
+
+ (erc-fill-tests--insert
+ ":robot!~u@rz2v467q4rwhy.irc PRIVMSG #chan :・゜゜・。。・゜゜\\_o< QUACK!")
+
+ (setq ct (time-convert (cl-incf ts (* 60 60 24))))
+ (erc-fill-tests--insert
+ ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"
+ " To create a file, visit it with ? and enter text in its buffer.")))))
+
+(defun erc-fill-tests--teardown ()
+ (advice-remove 'format-time-string 'ts)
+ (let (erc-kill-server-hook
+ erc-kill-channel-hook)
+ (kill-buffer "#chan")
+ (kill-buffer "foonet"))
+ (should (= erc-fill-column 78)))
+
+(defun erc-fill-tests--compare (name)
+ ;; Git didn't allow committing with a trailing space after the
+ ;; prompt, hence this:
+ (equal (substring-no-properties (buffer-string) 0 -1)
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file name))
+ (buffer-string))))
+
+(defun erc-fill-tests--await-fill ()
+ (call-interactively #'erc-fill-buffer)
+ ;; This timeout silliness seemed a little more realistic than just:
+ ;;
+ ;; (thread-join erc-fill--refill-thread)
+ ;;
+ ;; Probably dumb, right?.
+ (with-timeout (3 (error "Failed"))
+ (while (thread-live-p erc-fill--refill-thread)
+ (sleep-for 0.01))))
+
+(ert-deftest erc-fill-buffer ()
+ (let* (erc-insert-pre-hook
+ erc-insert-modify-hook
+ erc-send-modify-hook
+ erc-mode-hook
+ erc-stamp-mode
+ erc-fill--refill-thread)
+
+ (erc-fill-tests--setup)
+
+ (with-current-buffer "#chan"
+ ;; These would get clobbered by the new thread if we let-bound
+ ;; them, and we can't set them globally, so best just fake it:
+ (setq-local erc-fill-mode t
+ erc-stamp-mode t
+ erc-fill-column 60)
+ (erc-fill-tests--await-fill)
+ (ert-info ("Baseline")
+ (should (erc-fill-tests--compare "variable-60.buffer")))
+
+ (ert-info ("Wider")
+ (setq erc-fill-column 72)
+ (erc-fill-tests--await-fill)
+ (should (erc-fill-tests--compare "variable-72.buffer")))
+
+ (ert-info ("Fancy")
+ (setq erc-fill-function #'erc-fill-static)
+ (erc-fill-tests--await-fill)
+ (should (erc-fill-tests--compare "static-72.buffer")))
+
+ (ert-info ("Fancy normal")
+ (setq erc-fill-column 60)
+ (erc-fill-tests--await-fill)
+ (should (erc-fill-tests--compare "static-60.buffer")))
+
+ (ert-info ("Again!")
+ (erc-fill-tests--await-fill)
+ (should (erc-fill-tests--compare "static-60.buffer")))
+
+ (ert-info ("Back home")
+ (setq erc-fill-function #'erc-fill-variable)
+ (erc-fill-tests--await-fill)
+ (should (erc-fill-tests--compare "variable-60.buffer")))))
+
+ (when noninteractive
+ (erc-fill-tests--teardown)))
+
+(ert-deftest erc-fill-buffer--interrupted ()
+ (let* (erc-insert-pre-hook
+ erc-insert-modify-hook
+ erc-send-modify-hook
+ erc-mode-hook
+ erc-stamp-mode
+ erc-fill--refill-thread)
+
+ (erc-fill-tests--setup)
+
+ (with-current-buffer "#chan"
+ (setq-local erc-fill-mode t ; see note re these in prev test
+ erc-stamp-mode t
+ erc-fill-column 60)
+ (erc-fill-tests--await-fill)
+ (ert-info ("Baseline")
+ (should (erc-fill-tests--compare "variable-60.buffer")))
+
+ (ert-info ("Denied")
+ (setq erc-fill-column 72)
+ (call-interactively #'erc-fill-buffer)
+ (should-error (erc-fill-buffer nil))
+ (thread-join erc-fill--refill-thread)
+ (should (erc-fill-tests--compare "variable-72.buffer")))
+
+ (ert-info ("Canceled")
+ (setq erc-fill-column 60)
+ (call-interactively #'erc-fill-buffer)
+ (sleep-for (cl-random 0.1))
+ (erc-fill-buffer t)
+ (thread-join erc-fill--refill-thread)
+ (should (erc-fill-tests--compare "variable-60.buffer")))))
+
+ (when noninteractive
+ (erc-fill-tests--teardown)))
+
+;;; erc-fill-tests.el ends here
--
2.31.1
next prev parent reply other threads:[~2021-11-20 4:12 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-11-19 10:39 29.0.50; Add command for refilling ERC buffers J.P.
2021-11-20 4:12 ` J.P. [this message]
2021-11-24 13:38 ` bug#51969: " J.P.
2021-11-29 13:09 ` J.P.
2023-05-22 4:16 ` J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87fsrrqxcy.fsf__29180.3152345651$1637381603$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=51969@debbugs.gnu.org \
--cc=emacs-erc@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).