>From bb9850eee9e44555a67f8e838b12e315c0085f38 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 18 Nov 2021 18:29:47 -0800 Subject: NOT A PATCH F. Jason Park (1): Add command to refill ERC buffers 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 Interdiff: diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 0a1184b156..3bf335d098 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -141,6 +141,13 @@ erc-fill--hack-csf ;; 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 @@ -203,13 +210,21 @@ erc-fill--refill (progress-reporter-update reporter (point))) (thread-yield))))) -;; For now, don't clean this up or present errors. Just leave it for -;; enterprising users to fiddle with if need be. -(defvar-local erc-fill--refill-thread nil) - -(defun erc-fill-buffer () - "Refill an ERC buffer... eventually." - (interactive) +(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 diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index cf1b3ba78f..a7e3d78d74 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -51,8 +51,18 @@ erc-fill-tests--setup-channel-buffer (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))) + (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))) @@ -79,10 +89,12 @@ erc-fill-tests--populate (defun erc-fill-tests--teardown () ;; XXX when inspecting manually, must reactivate fill and stamp modes. ;; Otherwise `erc-fill-buffer' won't work. - (kill-buffer "variable-60.buffer") - (kill-buffer "variable-72.buffer") - (kill-buffer "static-60.buffer") - (kill-buffer "static-72.buffer") + (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) @@ -109,8 +121,6 @@ erc-fill-tests--await-fill (sleep-for 0.01)))) (ert-deftest erc-fill-buffer () - (advice-add 'format-time-string :filter-args - (lambda (args) (list (car args) (cadr args) 0)) '((name . ts))) (let* (erc-insert-pre-hook erc-insert-modify-hook erc-send-modify-hook @@ -118,11 +128,7 @@ erc-fill-buffer erc-stamp-mode erc-fill--refill-thread) - (erc-stamp-mode +1) - - (erc-fill-tests--setup-server-buffer) - (erc-fill-tests--setup-channel-buffer) - (erc-fill-tests--populate) + (erc-fill-tests--setup) (with-current-buffer "#chan" ;; These would get clobbered by the new thread if we let-bound @@ -161,4 +167,40 @@ erc-fill-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