unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: "J.P." <jp@neverwas.me>
To: 51969@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#51969: 29.0.50; Add command for refilling ERC buffers
Date: Mon, 29 Nov 2021 05:09:10 -0800	[thread overview]
Message-ID: <871r2zt8g9.fsf__30822.935029731$1638191497$gmane$org@neverwas.me> (raw)
In-Reply-To: <87bl2gjuo9.fsf@neverwas.me> (J. P.'s message of "Fri, 19 Nov 2021 02:39:50 -0800")

[-- Attachment #1: Type: text/plain, Size: 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


  parent reply	other threads:[~2021-11-29 13:09 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-11-19 10:39 29.0.50; Add command for refilling ERC buffers J.P.
2021-11-20  4:12 ` bug#51969: " J.P.
2021-11-24 13:38 ` J.P.
2021-11-29 13:09 ` J.P. [this message]
2023-05-22  4:16 ` J.P.

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='871r2zt8g9.fsf__30822.935029731$1638191497$gmane$org@neverwas.me' \
    --to=jp@neverwas.me \
    --cc=51969@debbugs.gnu.org \
    --cc=emacs-erc@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).