>From d5e69f8ec65105d19bf46490611b0b6becefbd85 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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