* 29.0.50; Add command for refilling ERC buffers
@ 2021-11-19 10:39 J.P.
2021-11-20 4:12 ` bug#51969: " J.P.
` (3 more replies)
0 siblings, 4 replies; 5+ messages in thread
From: J.P. @ 2021-11-19 10:39 UTC (permalink / raw)
To: bug-gnu-emacs; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 5017 bytes --]
Tags: patch
A recent bug entitled
bug#51841: 27.2; erc-insert-marker has no value
(opened by Libera user Bost) was in part brought about by confusion over
whether ERC already offered this feature and perhaps applied it during
major-mode setup. While I don't think erc-stamp and erc-fill currently
provide sufficient support to rig up automated refilling in a reliable
way (on window configuration change, for example), I agree that some
means of doing so manually might occasionally come in handy.
A related issue concerns the purpose and treatment of the option
`erc-fill-prefix'. This one's a mystery to me and seems to have little
meaningful bearing on anything. It does make an appearance in
erc-button.el, but to what end I'm not entirely certain. Like a few
other puzzlers, it was present in much the same form back when ERC was
first ported to ye old CVS some twenty years ago (almost to the day)
[1]. Anyway, I will continue to investigate this. Thanks.
[1] https://gitlab.com/jpneverwas/og-erc/-/commit/9a819366bdf8a6f5a304916baa2d6a501eb3987b#4042b2fc4c564fbd556343d1ed666da630f85951_0_97
In GNU Emacs 29.0.50 (build 1, x86_64-redhat-linux-gnu, GTK+ Version 3.24.30, cairo version 1.17.4)
of 2021-11-18 built on localhost
Repository revision: 69f1bc43c026049ed2aab6a6368e2e9a5406b779
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Fedora 34 (Workstation Edition)
Configured using:
'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
--build=x86_64-redhat-linux-gnu --host=x86_64-redhat-linux-gnu
--program-prefix= --prefix=/usr --exec-prefix=/usr --bindir=/usr/bin
--sbindir=/usr/sbin --sysconfdir=/etc --datadir=/usr/share
--includedir=/usr/include --libdir=/usr/lib64 --libexecdir=/usr/libexec
--localstatedir=/var --sharedstatedir=/var/lib --mandir=/usr/share/man
--infodir=/usr/share/info --with-dbus --with-gif --with-jpeg --with-png
--with-rsvg --with-tiff --with-xft --with-xpm --with-x-toolkit=gtk3
--with-gpm=no --with-xwidgets --with-modules --with-harfbuzz
--with-cairo --with-json build_alias=x86_64-redhat-linux-gnu
host_alias=x86_64-redhat-linux-gnu CC=gcc 'CFLAGS=-O0 -g3'
LDFLAGS=-Wl,-z,relro
PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG JSON
LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY
INOTIFY PDUMPER PNG RSVG SECCOMP SOUND THREADS TIFF TOOLKIT_SCROLL_BARS
WEBP X11 XDBE XIM XPM XWIDGETS GTK3 ZLIB
Important settings:
value of $LANG: en_US.UTF-8
value of $XMODIFIERS: @im=ibus
locale-coding-system: utf-8-unix
Major mode: Lisp Interaction
Minor modes in effect:
tooltip-mode: t
global-eldoc-mode: t
eldoc-mode: t
show-paren-mode: t
electric-indent-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
line-number-mode: t
indent-tabs-mode: t
transient-mark-mode: t
Load-path shadows:
None found.
Features:
(shadow sort mail-extr emacsbug message mailcap yank-media rmc puny
dired dired-loaddefs rfc822 mml mml-sec epa derived epg rfc6068
epg-config gnus-util rmail rmail-loaddefs auth-source cl-seq eieio
eieio-core cl-macs eieio-loaddefs password-cache json map
text-property-search time-date seq gv subr-x byte-opt bytecomp
byte-compile cconv mm-decode mm-bodies mm-encode mail-parse rfc2231
mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045 ietf-drums
mm-util mail-prsvr mail-utils help-mode cl-loaddefs cl-lib iso-transl
tooltip eldoc paren electric uniquify ediff-hook vc-hooks
lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd
tool-bar dnd fontset image regexp-opt fringe tabulated-list replace
newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar
rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock
font-lock syntax font-core term/tty-colors frame minibuffer cl-generic
cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao
korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech
european ethiopic indian cyrillic chinese composite emoji-zwj charscript
charprop case-table epa-hook jka-cmpr-hook help simple abbrev obarray
cl-preloaded nadvice button loaddefs faces cus-face macroexp files
window text-properties overlay sha1 md5 base64 format env code-pages
mule custom widget keymap hashtable-print-readable backquote threads
xwidget-internal dbusbind inotify lcms2 dynamic-setting
system-font-setting font-render-setting cairo move-toolbar gtk x-toolkit
x multi-tty make-network-process emacs)
Memory information:
((conses 16 53474 6237)
(symbols 48 6794 1)
(strings 32 19269 1625)
(string-bytes 1 642335)
(vectors 16 14025)
(vector-slots 8 189932 12509)
(floats 8 22 37)
(intervals 56 262 0)
(buffers 992 10))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-command-to-refill-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 18937 bytes --]
From bb9850eee9e44555a67f8e838b12e315c0085f38 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--remove-stamp-{left,right},
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 | 115 ++++++++++
.../erc/erc-fill-resources/static-60.buffer | 21 ++
.../erc/erc-fill-resources/static-72.buffer | 17 ++
.../erc/erc-fill-resources/variable-60.buffer | 16 ++
.../erc/erc-fill-resources/variable-72.buffer | 16 ++
test/lisp/erc/erc-fill-tests.el | 206 ++++++++++++++++++
6 files changed, 391 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..3bf335d098 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -112,6 +112,121 @@ 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--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)
+ ;;
+ left-changed right-changed 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
+ (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))
+ (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..b33f11ae96
--- /dev/null
+++ b/test/lisp/erc/erc-fill-resources/static-60.buffer
@@ -0,0 +1,21 @@
+
+
+
+[Tue Jan 1 1980]
+ *** #chan modes: +nt [00:00]
+ *** #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]
+
+[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..79ed88d112
--- /dev/null
+++ b/test/lisp/erc/erc-fill-resources/static-72.buffer
@@ -0,0 +1,17 @@
+
+
+
+[Tue Jan 1 1980]
+ *** #chan modes: +nt [00:00]
+ *** #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]
+
+[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..4bf2741af0
--- /dev/null
+++ b/test/lisp/erc/erc-fill-resources/variable-60.buffer
@@ -0,0 +1,16 @@
+
+
+
+[Tue Jan 1 1980]
+*** #chan modes: +nt [00:00]
+*** #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]
+
+[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..de376cc15d
--- /dev/null
+++ b/test/lisp/erc/erc-fill-resources/variable-72.buffer
@@ -0,0 +1,16 @@
+
+
+
+[Tue Jan 1 1980]
+*** #chan modes: +nt [00:00]
+*** #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]
+
+[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..a7e3d78d74
--- /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 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"
+ " button's been loaded by an earlier test. ERC needs help!")
+
+ (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 ()
+ ;; 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)
+ (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-current-buffer (find-file-literally (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
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#51969: 29.0.50; Add command for refilling ERC buffers
2021-11-19 10:39 29.0.50; Add command for refilling ERC buffers J.P.
@ 2021-11-20 4:12 ` J.P.
2021-11-24 13:38 ` J.P.
` (2 subsequent siblings)
3 siblings, 0 replies; 5+ messages in thread
From: J.P. @ 2021-11-20 4:12 UTC (permalink / raw)
To: 51969; +Cc: emacs-erc
[-- 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
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#51969: 29.0.50; Add command for refilling ERC buffers
2021-11-19 10:39 29.0.50; Add command for refilling ERC buffers J.P.
2021-11-20 4:12 ` bug#51969: " J.P.
@ 2021-11-24 13:38 ` J.P.
2021-11-29 13:09 ` J.P.
2023-05-22 4:16 ` J.P.
3 siblings, 0 replies; 5+ messages in thread
From: J.P. @ 2021-11-24 13:38 UTC (permalink / raw)
To: 51969; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 220 bytes --]
v4. Removed hack to get at stored timestamp.
TODO:
- preserve white space when filling (treat text as preformatted)
- ensure jobs can be canceled with impunity
- try with non-Latin alphabets, uncommon characters, etc.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v3-v4.diff --]
[-- Type: text/x-patch, Size: 5273 bytes --]
From 4929787d009733f77b087676e85b7f65490bbb96 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:20:26 -0800
Subject: NOT A PATCH
F. Jason Park (2):
Remove timestamp from erc-stamp sensor function
Add command to refill ERC buffers
lisp/erc/erc-fill.el | 109 +++++++++
lisp/erc/erc-stamp.el | 7 +-
.../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 ++++++++++++++++++
7 files changed, 399 insertions(+), 3 deletions(-)
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 49130b9ffc..f9f8f8ad5d 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -112,6 +112,10 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
+;; If there's a chance of a job's cancellation leaving things in a bad
+;; state (like with stamps removed and yet to be replaced), this
+;; function should be protected by a condition-case so the narrowed
+;; buffer's contents can be restored and the signal repropagated.
(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."
@@ -154,24 +158,8 @@ erc-fill--refill-message
(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).
+;; TODO make `erc-fill-mode' respect preformatted text. Currently, diagrams
+;; and art (like figlets) meant to span multiple messages get ruined.
(defun erc-fill--refill ()
(let ((m (make-marker))
(reporter (unless noninteractive
@@ -195,6 +183,7 @@ erc-fill--refill
((/= res max))) ; otherwise, we're done.
res)))
(val (get-text-property beg 'cursor-sensor-functions))
+ (ts (get-text-property beg 'erc-timestamp))
(beg (progn ; remove left padding, if any.
(goto-char beg)
(skip-syntax-forward "-")
@@ -205,8 +194,7 @@ erc-fill--refill
(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))))
+ (when (setq ct (and (erc-fill--refill-message beg end) ts))
(erc-add-timestamp))
(when reporter
(cl-incf (aref (cdr reporter) 2) ; max += d_new - d_old
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 7d31bc971e..1ef791c78b 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -179,7 +179,8 @@ erc-add-timestamp
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
(list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ (erc-echo-timestamp dir)))
+ 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -398,10 +399,10 @@ erc-toggle-timestamps
(erc-munge-invisibility-spec)))
(erc-buffer-list)))
-(defun erc-echo-timestamp (dir stamp)
+(defun erc-echo-timestamp (dir &optional stamp)
"Print timestamp text-property of an IRC message."
(when (and erc-echo-timestamps (eq 'entered dir))
- (when stamp
+ (when (or stamp (setq stamp (get-text-property (point) 'erc-timestamp)))
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
--
2.31.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Remove-timestamp-from-erc-stamp-sensor-function.patch --]
[-- Type: text/x-patch, Size: 1677 bytes --]
From 61e0af7a032aebdc930a3b3df73818506ad4eccb 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 1/2] Remove timestamp from erc-stamp sensor function
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
called `erc-timestamp' to store lisp time object formerly ensconced in
closure.
(erc-echo-timestamp): Check text property for timestamp when not
provided as second argument, which is now optional.
---
lisp/erc/erc-stamp.el | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 7d31bc971e..1ef791c78b 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -179,7 +179,8 @@ erc-add-timestamp
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
(list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ (erc-echo-timestamp dir)))
+ 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -398,10 +399,10 @@ erc-toggle-timestamps
(erc-munge-invisibility-spec)))
(erc-buffer-list)))
-(defun erc-echo-timestamp (dir stamp)
+(defun erc-echo-timestamp (dir &optional stamp)
"Print timestamp text-property of an IRC message."
(when (and erc-echo-timestamps (eq 'entered dir))
- (when stamp
+ (when (or stamp (setq stamp (get-text-property (point) 'erc-timestamp)))
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
--
2.31.1
[-- Attachment #4: 0002-Add-command-to-refill-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 19596 bytes --]
From 4929787d009733f77b087676e85b7f65490bbb96 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 2/2] 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 | 109 +++++++++
.../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, 395 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..f9f8f8ad5d 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -112,6 +112,115 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
+;; If there's a chance of a job's cancellation leaving things in a bad
+;; state (like with stamps removed and yet to be replaced), this
+;; function should be protected by a condition-case so the narrowed
+;; buffer's contents can be restored and the signal repropagated.
+(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)))
+
+;; TODO make `erc-fill-mode' respect preformatted text. Currently, diagrams
+;; and art (like figlets) meant to span multiple messages get ruined.
+(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))
+ (ts (get-text-property beg 'erc-timestamp))
+ (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) ts))
+ (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
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#51969: 29.0.50; Add command for refilling ERC buffers
2021-11-19 10:39 29.0.50; Add command for refilling ERC buffers J.P.
2021-11-20 4:12 ` bug#51969: " J.P.
2021-11-24 13:38 ` J.P.
@ 2021-11-29 13:09 ` J.P.
2023-05-22 4:16 ` J.P.
3 siblings, 0 replies; 5+ messages in thread
From: J.P. @ 2021-11-29 13:09 UTC (permalink / raw)
To: 51969; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 757 bytes --]
v5. Fixed a few oversights, but others undoubtedly remain.
If we're serious about preserving a message's original white space, then
various details related to filling and indenting still need hammering
out. And if that ultimately involves tampering with the two existing
fill functions (and such a prospect proves sufficiently unpopular), we
could always try adding dedicated variants that preserve original
spacing as their thing. It's also possible that such additions may end
up needing companions to unfill in their particular style.
But progress on these and other fronts will have to wait (unless someone
else wants to have a go) because this feature remains among ERC's lowest
priorities, ATM (IMO).
(Also, the undo situation is yet unexplored.)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v4-v5.patch --]
[-- Type: text/x-patch, Size: 14233 bytes --]
From d5e69f8ec65105d19bf46490611b0b6becefbd85 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 28 Nov 2021 23:59:45 -0800
Subject: NOT A PATCH
F. Jason Park (3):
Remove timestamp from erc-stamp sensor function
Make some erc-stamp functions more limber
Add command to refill ERC buffers
lisp/erc/erc-fill.el | 126 ++++++++++-
lisp/erc/erc-stamp.el | 41 ++--
.../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 | 198 ++++++++++++++++++
7 files changed, 430 insertions(+), 15 deletions(-)
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 f9f8f8ad5d..b3f650bc92 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -112,15 +112,10 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
-;; If there's a chance of a job's cancellation leaving things in a bad
-;; state (like with stamps removed and yet to be replaced), this
-;; function should be protected by a condition-case so the narrowed
-;; buffer's contents can be restored and the signal repropagated.
-(defun erc-fill--refill-message (beg end)
- "Refill but don't re-stamp region between BEG and END.
+(defun erc-fill--refill-message ()
+ "Refill but don't re-stamp accessible portion of current buffer.
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
@@ -138,7 +133,7 @@ erc-fill--refill-message
;; 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.
+ ;; Remove all right stamps, if any.
(goto-char (point-min))
(setq right-changed
(when-let* ((nextf (next-single-property-change (point) 'field)))
@@ -158,6 +153,15 @@ erc-fill--refill-message
(setq erc-timestamp-last-inserted-right nil))
t)))
+(defvar erc-fill--refilling nil
+ "Non-nil when refilling.") ; Otherwise nil during normal response handling
+
+(defvar-local erc-fill--refill-thread nil
+ "A thread running a buffer-refill job.")
+
+(cl-defmethod erc-stamp--current-time (&context (erc-fill--refilling cons))
+ erc-fill--refilling)
+
;; TODO make `erc-fill-mode' respect preformatted text. Currently, diagrams
;; and art (like figlets) meant to span multiple messages get ruined.
(defun erc-fill--refill ()
@@ -165,47 +169,52 @@ erc-fill--refill
(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))
- (ts (get-text-property beg 'erc-timestamp))
- (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) ts))
- (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.")
+ (buffer-undo-list t)
+ (inhibit-point-motion-hooks t))
+ (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))
+ (ts (get-text-property beg 'erc-timestamp))
+ (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
+ (narrow-to-region beg end)
+ (let ((bs (buffer-string))
+ (erc-fill--refilling ts))
+ (condition-case err
+ (when (erc-fill--refill-message)
+ (erc-add-timestamp))
+ (error
+ (delete-region (point-min) (point-max))
+ (insert bs)
+ (signal (car err) (cdr err)))))
+ ;; FIXME sometimes off by 1 (doesn't reach 100%); probably just
+ ;; needs final report after while loop
+ (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)))
+ (setq erc-fill--refill-thread nil))
(define-error 'erc-fill-canceled "ERC refill canceled" 'error)
@@ -219,7 +228,9 @@ erc-fill-buffer
(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")))
+ (setq erc-fill--refill-thread
+ (make-thread #'erc-fill--refill
+ (format "erc-fill[%f]" (erc-current-time)))))
;;;###autoload
(defun erc-fill ()
@@ -249,7 +260,8 @@ erc-fill-static
(length nick) 1))
32))
(erc-fill-regarding-timestamp))
- (erc-restore-text-properties))))
+ (unless erc-fill--refilling
+ (erc-restore-text-properties)))))
(defun erc-fill-variable ()
"Fill from `point-min' to `point-max'."
@@ -274,7 +286,8 @@ erc-fill-variable
fill-column))
32)))
(erc-fill-regarding-timestamp))))
- (erc-restore-text-properties)))
+ (unless erc-fill--refilling
+ (erc-restore-text-properties))))
(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 1ef791c78b..9aed20a1a9 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -157,17 +157,25 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(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))
+
(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"))
+ (let ((ct (erc-stamp--current-time)))
+ (funcall erc-insert-timestamp-function
+ ;; HACK unpaint ourselves from an unfriendly corner
+ (if (eq erc-insert-timestamp-function
+ #'erc-insert-timestamp-left-and-right)
+ ct
+ (erc-format-timestamp ct erc-timestamp-format)))
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
@@ -316,14 +324,20 @@ 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)
+(defun erc-insert-timestamp-left-and-right (ct)
"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)))
+it off to the right.
+
+As has always been the case, this function differs from the other
+`erc-insert-timestamp-function' variants in that it ignores its only
+argument. For practical reasons, this may not always be true when used
+internally."
+ (unless (consp ct)
+ (setq ct (erc-stamp--current-time)))
+ (let ((ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index a0b695a6c7..ecd746196c 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -111,22 +111,14 @@ erc-fill-tests--compare
(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))))
+ (thread-join erc-fill--refill-thread))
(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)
+ (let (erc-insert-pre-hook
+ erc-insert-modify-hook
+ erc-send-modify-hook
+ erc-mode-hook
+ erc-stamp-mode)
(erc-fill-tests--setup)
@@ -168,12 +160,11 @@ erc-fill-buffer
(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)
+ (let (erc-insert-pre-hook
+ erc-insert-modify-hook
+ erc-send-modify-hook
+ erc-mode-hook
+ erc-stamp-mode)
(erc-fill-tests--setup)
@@ -185,20 +176,21 @@ erc-fill-buffer--interrupted
(ert-info ("Baseline")
(should (erc-fill-tests--compare "variable-60.buffer")))
- (ert-info ("Denied")
+ (ert-info ("Denied while previous job in progress")
(setq erc-fill-column 72)
- (call-interactively #'erc-fill-buffer)
- (should-error (erc-fill-buffer nil))
- (thread-join erc-fill--refill-thread)
+ (erc-fill-tests--await-fill)
(should (erc-fill-tests--compare "variable-72.buffer")))
- (ert-info ("Canceled")
+ (ert-info ("Override switch cancels ongoing job")
(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")))))
+ (should (erc-fill-tests--compare "variable-60.buffer")))
+
+ (ert-info ("Thread variable cleared")
+ (should-not erc-fill--refill-thread))))
(when noninteractive
(erc-fill-tests--teardown)))
--
2.31.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Remove-timestamp-from-erc-stamp-sensor-function.patch --]
[-- Type: text/x-patch, Size: 1677 bytes --]
From ebae073445d67c0570137f8b8ba972faa4f60538 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 1/3] Remove timestamp from erc-stamp sensor function
* lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property
called `erc-timestamp' to store lisp time object formerly ensconced in
closure.
(erc-echo-timestamp): Check text property for timestamp when not
provided as second argument, which is now optional.
---
lisp/erc/erc-stamp.el | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 7d31bc971e..1ef791c78b 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -179,7 +179,8 @@ erc-add-timestamp
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
(list (lambda (_window _before dir)
- (erc-echo-timestamp dir ct))))))))
+ (erc-echo-timestamp dir)))
+ 'erc-timestamp ct)))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -398,10 +399,10 @@ erc-toggle-timestamps
(erc-munge-invisibility-spec)))
(erc-buffer-list)))
-(defun erc-echo-timestamp (dir stamp)
+(defun erc-echo-timestamp (dir &optional stamp)
"Print timestamp text-property of an IRC message."
(when (and erc-echo-timestamps (eq 'entered dir))
- (when stamp
+ (when (or stamp (setq stamp (get-text-property (point) 'erc-timestamp)))
(message "%s" (format-time-string erc-echo-timestamp-format
stamp)))))
--
2.31.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 3477 bytes --]
From 9a49b4ef69fa34d7e877a5fb1d2523c3769434ea Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:35:35 -0800
Subject: [PATCH 2/3] Make some erc-stamp functions more limber
* lisp/erc/erc-stamp.el (erc-stamp-current-time): Add new function
to return current time. Default to calling `current-time'.
(erc-add-timestamp): Employ ugly hack to pass current time instead of
formatted timestamp to `erc-insert-timestamp-left-and-right' when it's
the value of `erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Accept a lisp timestamp as
returned by `current-time' for formerly unused string param.
---
lisp/erc/erc-stamp.el | 34 ++++++++++++++++++++++++----------
1 file changed, 24 insertions(+), 10 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 1ef791c78b..9aed20a1a9 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -157,17 +157,25 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(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))
+
(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"))
+ (let ((ct (erc-stamp--current-time)))
+ (funcall erc-insert-timestamp-function
+ ;; HACK unpaint ourselves from an unfriendly corner
+ (if (eq erc-insert-timestamp-function
+ #'erc-insert-timestamp-left-and-right)
+ ct
+ (erc-format-timestamp ct erc-timestamp-format)))
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
@@ -316,14 +324,20 @@ 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)
+(defun erc-insert-timestamp-left-and-right (ct)
"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)))
+it off to the right.
+
+As has always been the case, this function differs from the other
+`erc-insert-timestamp-function' variants in that it ignores its only
+argument. For practical reasons, this may not always be true when used
+internally."
+ (unless (consp ct)
+ (setq ct (erc-stamp--current-time)))
+ (let ((ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
--
2.31.1
[-- Attachment #5: 0003-Add-command-to-refill-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 20582 bytes --]
From d5e69f8ec65105d19bf46490611b0b6becefbd85 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 3/3] 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.
(erc-fill--refilling, erc-fill-static, erc-fill-variable): Add new
variable `erc-fill-refilling' telling fill functions not to run
`erc-restore-text-properties'.
* 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 | 126 ++++++++++-
.../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 | 198 ++++++++++++++++++
6 files changed, 402 insertions(+), 2 deletions(-)
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..b3f650bc92 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -112,6 +112,126 @@ erc-fill-column
"The column at which a filled paragraph is broken."
:type 'integer)
+(defun erc-fill--refill-message ()
+ "Refill but don't re-stamp accessible portion of current buffer.
+Return non-nil if timestamps were removed."
+ (let (left-changed right-changed)
+ ;; 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 all right stamps, if any.
+ (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)))
+
+(defvar erc-fill--refilling nil
+ "Non-nil when refilling.") ; Otherwise nil during normal response handling
+
+(defvar-local erc-fill--refill-thread nil
+ "A thread running a buffer-refill job.")
+
+(cl-defmethod erc-stamp--current-time (&context (erc-fill--refilling cons))
+ erc-fill--refilling)
+
+;; TODO make `erc-fill-mode' respect preformatted text. Currently, diagrams
+;; and art (like figlets) meant to span multiple messages get ruined.
+(defun erc-fill--refill ()
+ (let ((m (make-marker))
+ (reporter (unless noninteractive
+ (make-progress-reporter "filling" 0 (point-max))))
+ (inhibit-read-only t)
+ (buffer-undo-list t)
+ (inhibit-point-motion-hooks t))
+ (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))
+ (ts (get-text-property beg 'erc-timestamp))
+ (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
+ (narrow-to-region beg end)
+ (let ((bs (buffer-string))
+ (erc-fill--refilling ts))
+ (condition-case err
+ (when (erc-fill--refill-message)
+ (erc-add-timestamp))
+ (error
+ (delete-region (point-min) (point-max))
+ (insert bs)
+ (signal (car err) (cdr err)))))
+ ;; FIXME sometimes off by 1 (doesn't reach 100%); probably just
+ ;; needs final report after while loop
+ (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)))
+ (setq erc-fill--refill-thread nil))
+
+(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
+ (format "erc-fill[%f]" (erc-current-time)))))
+
;;;###autoload
(defun erc-fill ()
"Fill a region using the function referenced in `erc-fill-function'.
@@ -140,7 +260,8 @@ erc-fill-static
(length nick) 1))
32))
(erc-fill-regarding-timestamp))
- (erc-restore-text-properties))))
+ (unless erc-fill--refilling
+ (erc-restore-text-properties)))))
(defun erc-fill-variable ()
"Fill from `point-min' to `point-max'."
@@ -165,7 +286,8 @@ erc-fill-variable
fill-column))
32)))
(erc-fill-regarding-timestamp))))
- (erc-restore-text-properties)))
+ (unless erc-fill--refilling
+ (erc-restore-text-properties))))
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
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..ecd746196c
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,198 @@
+;;; 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)
+ (thread-join erc-fill--refill-thread))
+
+(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-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-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 while previous job in progress")
+ (setq erc-fill-column 72)
+ (erc-fill-tests--await-fill)
+ (should (erc-fill-tests--compare "variable-72.buffer")))
+
+ (ert-info ("Override switch cancels ongoing job")
+ (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")))
+
+ (ert-info ("Thread variable cleared")
+ (should-not erc-fill--refill-thread))))
+
+ (when noninteractive
+ (erc-fill-tests--teardown)))
+
+;;; erc-fill-tests.el ends here
--
2.31.1
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#51969: 29.0.50; Add command for refilling ERC buffers
2021-11-19 10:39 29.0.50; Add command for refilling ERC buffers J.P.
` (2 preceding siblings ...)
2021-11-29 13:09 ` J.P.
@ 2023-05-22 4:16 ` J.P.
3 siblings, 0 replies; 5+ messages in thread
From: J.P. @ 2023-05-22 4:16 UTC (permalink / raw)
To: 51969-done; +Cc: emacs-erc
The need for such a command has probably dwindled with the arrival of
`erc-fill-wrap' (bug#60936). That said, it would still be nice to have a
way to refill an entire buffer, which can help when
- switching between legacy fill styles
- toggling `truncate-lines' to read pre-formatted text
- recovering from a mishap
OTOH, it might not be easily achievable because other hooks that run
alongside `erc-fill' sometimes perform additional formatting. And it
doesn't seem like a module's place to be managing the membership and
ordering of hooks it doesn't own (beyond subscribing/unsubscribing).
Anyway, I'm closing this for no specific reason (call it lack of
initiative).
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2023-05-22 4:16 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-11-19 10:39 29.0.50; Add command for refilling ERC buffers J.P.
2021-11-20 4:12 ` bug#51969: " J.P.
2021-11-24 13:38 ` J.P.
2021-11-29 13:09 ` J.P.
2023-05-22 4:16 ` J.P.
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).