From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#51969: 29.0.50; Add command for refilling ERC buffers Date: Mon, 29 Nov 2021 05:09:10 -0800 Message-ID: <871r2zt8g9.fsf__30822.935029731$1638191497$gmane$org@neverwas.me> References: <87bl2gjuo9.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="17159"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.60 (gnu/linux) Cc: emacs-erc@gnu.org To: 51969@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Nov 29 14:11:29 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mrgRM-0004Du-Jw for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 29 Nov 2021 14:11:29 +0100 Original-Received: from localhost ([::1]:47682 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mrgRL-0002j0-8g for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 29 Nov 2021 08:11:27 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:38106) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mrgPz-0001oO-3c for bug-gnu-emacs@gnu.org; Mon, 29 Nov 2021 08:10:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:54077) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mrgPy-0004BQ-QN for bug-gnu-emacs@gnu.org; Mon, 29 Nov 2021 08:10:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mrgPy-0001wz-HD for bug-gnu-emacs@gnu.org; Mon, 29 Nov 2021 08:10:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 29 Nov 2021 13:10:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 51969 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 51969-submit@debbugs.gnu.org id=B51969.16381913657450 (code B ref 51969); Mon, 29 Nov 2021 13:10:02 +0000 Original-Received: (at 51969) by debbugs.gnu.org; 29 Nov 2021 13:09:25 +0000 Original-Received: from localhost ([127.0.0.1]:37390 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mrgPL-0001w5-Rg for submit@debbugs.gnu.org; Mon, 29 Nov 2021 08:09:25 -0500 Original-Received: from mail-108-mta175.mxroute.com ([136.175.108.175]:37611) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mrgPJ-0001vq-1H for 51969@debbugs.gnu.org; Mon, 29 Nov 2021 08:09:22 -0500 Original-Received: from filter004.mxroute.com ([149.28.56.236] filter004.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta175.mxroute.com (ZoneMTA) with ESMTPSA id 17d6bd04f7e000177f.001 for <51969@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Mon, 29 Nov 2021 13:09:13 +0000 X-Zone-Loop: 78347433bbcae0c0db3c8b21bc718093091fa0cf705b X-Originating-IP: [149.28.56.236] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date:References: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=6lWEQRe8LCPgKIpjhSCo+yDWy9DDYLrYLLi0nOAlSx0=; b=DqTkB9mpBhgqECBDhc8wmqeu84 tTcuYdMWCNsLbWj4GayG4otAXgYoAJLPnpkrN+FwTA+mD39zpOLvrWonNKNWy6k5/DcchGGbj0CJG 3Dw60Bt2lGogwchEm8sLMI++G5ntmHkB/5j6YW+sRqmdcCY5uEAi0j7Y84fW9ugTaBA/SRLwubC2S cXfc92+aHPlVUGEWkOINi+g/tVEeDj9Hkz7bq4H+ir5nwE7Redpvx0iUxvAl+6nuZJveeuanndfMp dOnw6HM/9FF3LuPlOe4qosPVBo9FWWPgeBvWfbDoA9I837sS2dWQ8X8pLlTaBGSgwqlh2wp5Q+Vtv REsPeXEw==; In-Reply-To: <87bl2gjuo9.fsf@neverwas.me> (J. P.'s message of "Fri, 19 Nov 2021 02:39:50 -0800") X-AuthUser: masked@neverwas.me X-Zone-Spam-Resolution: no action X-Zone-Spam-Status: No, score=-0.1, required=15, tests=[ARC_NA=0, RCPT_COUNT_TWO=0, FROM_HAS_DN=0, NEURAL_HAM=0, HAS_ATTACHMENT=0, FROM_EQ_ENVFROM=0, MIME_TRACE=0, MIME_GOOD=-0.1, TO_DN_NONE=0, MID_RHS_MATCH_FROM=0, RCVD_COUNT_ZERO=0] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:220991 Archived-At: --=-=-= Content-Type: text/plain 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.) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v4-v5.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Remove-timestamp-from-erc-stamp-sensor-function.patch >From ebae073445d67c0570137f8b8ba972faa4f60538 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Make-some-erc-stamp-functions-more-limber.patch >From 9a49b4ef69fa34d7e877a5fb1d2523c3769434ea Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0003-Add-command-to-refill-ERC-buffers.patch Content-Transfer-Encoding: quoted-printable >From d5e69f8ec65105d19bf46490611b0b6becefbd85 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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) =20 +(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 ">-") (poi= nt))) + (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 handli= ng + +(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, diagra= ms +;; 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-function= s) + (point) + (when-let* + ((max (min (point-max) (+ 512 (point)))) + (res (next-single-property-change + (point) 'cursor-sensor-functions nil max)) + ((/=3D 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 j= ust + ;; needs final report after while loop + (when reporter + (cl-incf (aref (cdr reporter) 2) ; max +=3D 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))))) =20 (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)))) =20 (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 + lorem ipsum This buffer is for + text that is not saved, and for + Lisp evaluation. [00:01] + 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] + =E3=83=BB=E3=82=9C=E3=82=9C=E3=83=BB=E3=80=82= =E3=80=82=E3=83=BB=E3=82=9C=E3=82=9C\_o< QUACK! + +[Wed Jan 2 1980] + 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 + lorem ipsum This buffer is for text that is + not saved, and for Lisp evaluation. [00:01] + 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] + =E3=83=BB=E3=82=9C=E3=82=9C=E3=83=BB=E3=80=82= =E3=80=82=E3=83=BB=E3=82=9C=E3=82=9C\_o< QUACK! + +[Wed Jan 2 1980] + 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/lis= p/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 + lorem ipsum This buffer is for text that is not saved, + and for Lisp evaluation. [00:01] + 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] + =E3=83=BB=E3=82=9C=E3=82=9C=E3=83=BB=E3=80=82=E3=80=82=E3=83=BB=E3= =82=9C=E3=82=9C\_o< QUACK! + +[Wed Jan 2 1980] + 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/lis= p/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 + lorem ipsum This buffer is for text that is not saved, and for + Lisp evaluation. [00:01] + 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] + =E3=83=BB=E3=82=9C=E3=82=9C=E3=83=BB=E3=80=82=E3=80=82=E3=83=BB=E3= =82=9C=E3=82=9C\_o< QUACK! + +[Wed Jan 2 1980] + 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 . + +;;; 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 =3D #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 16201047= 79") + + (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 evaluat= ion.") + + (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 :=E3=83=BB=E3=82=9C=E3= =82=9C=E3=83=BB=E3=80=82=E3=80=82=E3=83=BB=E3=82=9C=E3=82=9C\\_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 (=3D 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 --=20 2.31.1 --=-=-=--