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#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode Date: Mon, 20 Feb 2023 07:31:12 -0800 Message-ID: <87lekstku7.fsf__15884.4560197153$1676907148$gmane$org@neverwas.me> References: <87tu0nao77.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="24636"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 60936@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Feb 20 16:32:20 2023 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 1pU89J-00068s-Ru for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 20 Feb 2023 16:32:18 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pU899-00035l-Ug; Mon, 20 Feb 2023 10:32:08 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pU894-000335-Jh for bug-gnu-emacs@gnu.org; Mon, 20 Feb 2023 10:32:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pU894-00067V-8H for bug-gnu-emacs@gnu.org; Mon, 20 Feb 2023 10:32:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pU893-0000W7-LW for bug-gnu-emacs@gnu.org; Mon, 20 Feb 2023 10:32:01 -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, 20 Feb 2023 15:32:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 60936 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 60936-submit@debbugs.gnu.org id=B60936.16769070861940 (code B ref 60936); Mon, 20 Feb 2023 15:32:01 +0000 Original-Received: (at 60936) by debbugs.gnu.org; 20 Feb 2023 15:31:26 +0000 Original-Received: from localhost ([127.0.0.1]:53272 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pU88U-0000VE-KJ for submit@debbugs.gnu.org; Mon, 20 Feb 2023 10:31:26 -0500 Original-Received: from mail-108-mta54.mxroute.com ([136.175.108.54]:43893) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pU88S-0000Uv-CN for 60936@debbugs.gnu.org; Mon, 20 Feb 2023 10:31:24 -0500 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta54.mxroute.com (ZoneMTA) with ESMTPSA id 1866f73596f000edb4.001 for <60936@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Mon, 20 Feb 2023 15:31:15 +0000 X-Zone-Loop: b3f4b28a13a6d2c0068c148067353953521d76507bb3 X-Originating-IP: [136.175.111.2] 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:Date:References:In-Reply-To: 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=udjvRtBLk8abNCDOf34t/3/XfOwrKKWn1na1uO9YSYo=; b=OWj0z9A+OCGtNUIfsdFNg6QcsU AgEpe+lNm3Xyqdu/JWVTe5BD55NWMB3UOy0nyubPgFDzbw27FXpK9RUebxYKkXpxc/jr/NrJu4obF j3rkNE+np+3kx5KBGDGbO5/C8NT+yXnyMPbr01RiTlSqxTNAxOWT9+cIm/2ElkpINzQ+SvS0eXCx5 +xqFZOgs9VHrFzHVp3wtH4/iP86zfq8MRB4fFDt6FL0k5wblc2PqYooo6Eal9UvZsYvyI63H9eO5R /fyhoIFQJvq2Q+2TdvdjgP9Nix2uXf686MBzsF3nG8lv1L5OjH/Twgo5iFf77xWzUC+Ew7jx4BhEx 58OJME4A==; In-Reply-To: <87tu0nao77.fsf@neverwas.me> (J. P.'s message of "Wed, 18 Jan 2023 06:53:48 -0800") X-Authenticated-Id: masked@neverwas.me 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-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:256191 Archived-At: --=-=-= Content-Type: text/plain v9. Trust previous values when initializing markers. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v8-v9.diff >From f2613f703f3e4fa49a0efb3e120b493bb0731c53 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 20 Feb 2023 00:05:34 -0800 Subject: [PATCH 0/8] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (8): [5.6] Refactor marker initialization in erc-open [5.6] Adjust some old text properties in ERC buffers [5.6] Expose insertion time as text prop in erc-stamp [5.6] Make some erc-stamp functions more limber [5.6] Put display properties to better use in erc-stamp [5.6] Convert erc-fill minor mode into a proper module [5.6] Add variant for erc-match invisibility spec [5.6] Add erc-fill style based on visual-line-mode lisp/erc/erc-compat.el | 57 +++ lisp/erc/erc-fill.el | 307 +++++++++++++++-- lisp/erc/erc-match.el | 31 +- lisp/erc/erc-stamp.el | 210 ++++++++++-- lisp/erc/erc.el | 127 ++++--- test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++ .../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++ .../erc/erc-scenarios-base-local-modules.el | 99 ------ test/lisp/erc/erc-stamp-tests.el | 265 ++++++++++++++ test/lisp/erc/erc-tests.el | 79 ++++- .../fill/snapshots/monospace-01-start.eld | 1 + .../fill/snapshots/monospace-02-right.eld | 1 + .../fill/snapshots/monospace-03-left.eld | 1 + .../fill/snapshots/monospace-04-reset.eld | 1 + 14 files changed, 1497 insertions(+), 217 deletions(-) create mode 100644 test/lisp/erc/erc-fill-tests.el create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el create mode 100644 test/lisp/erc/erc-stamp-tests.el create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld Interdiff: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 95d374b121e..b04386c6a3b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1976,22 +1976,12 @@ erc--initialize-markers erc-input-marker (make-marker)) (if continued-session (progn - ;; Respect existing multiline input after prompt. Expect any - ;; text preceding it on the same line, including whitespace, - ;; to be part of the prompt itself. - (goto-char (point-max)) - (forward-line 0) - (while (and (not (get-text-property (point) 'erc-prompt)) - (zerop (forward-line -1)))) - (cl-assert (not (= (point) (point-min)))) - (set-marker erc-insert-marker (point)) - ;; If the input area is clean, this search should fail and - ;; return point max. Otherwise, it should return the position - ;; after the last char with the `erc-prompt' property, as per - ;; the doc string for `next-single-property-change'. + ;; Trust existing markers. + (set-marker erc-insert-marker + (alist-get 'erc-insert-marker continued-session)) (set-marker erc-input-marker - (next-single-property-change (point) 'erc-prompt nil - (point-max))) + (alist-get 'erc-input-marker continued-session)) + (goto-char erc-insert-marker) (cl-assert (= (field-end) erc-input-marker)) (goto-char old-point) (erc--unhide-prompt)) @@ -2043,7 +2033,8 @@ erc-open (and-let* (((not target)) (m (buffer-local-value 'erc-input-marker buffer)) - ((marker-position m))))))) + ((marker-position m))) + (buffer-local-variables buffer))))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Refactor-marker-initialization-in-erc-open.patch >From 342d6959d68015d596ffc12a65bb57bff942d6ec Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 23 Jan 2023 20:48:24 -0800 Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open * lisp/erc/erc.el (erc--initialize-markers): New helper to ensure prompt and its associated markers are set up correctly. (erc-open): When determining whether a session is a logical continuation, leverage the work already performed by the `erc-networks' library to that effect. Its verdicts are based on network context and thus reliable even when a user dials anew from an entry-point, which is not a simple reconnection because the user expects a clean slate for everything except an existing buffer's messages, meaning `erc--server-reconnecting' will be nil and local-module state variables need resetting. Also remove the check for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create' always does the right thing in. Replace all code involving marker and prompt setup by deferring to a new helper, `erc--initialize markers'. * test/lisp/erc/erc-tests.el (erc--initialize-markers): New test. * test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file. * test/lisp/erc/erc-scenarios-base-local-modules.el (erc-scenarios-base-local-modules--mode-persistence): Move test to separate file to help with parallel "-j" runs. (Bug#60936.) --- lisp/erc/erc.el | 70 +++--- .../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++ .../erc/erc-scenarios-base-local-modules.el | 99 -------- test/lisp/erc/erc-tests.el | 79 ++++++- 4 files changed, 322 insertions(+), 137 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d35907a1677..27e46e6681b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1966,6 +1966,35 @@ erc--merge-local-modes (cons (nreverse (car out)) (nreverse (cdr out)))) (list new-modes))) +;; This function doubles as a convenient helper for use in unit tests. +;; Prior to 5.6, its contents lived in `erc-open'. + +(defun erc--initialize-markers (old-point continued-session) + "Ensure prompt and its bounding markers have been initialized." + ;; FIXME erase assertions after code review and additional testing. + (setq erc-insert-marker (make-marker) + erc-input-marker (make-marker)) + (if continued-session + (progn + ;; Trust existing markers. + (set-marker erc-insert-marker + (alist-get 'erc-insert-marker continued-session)) + (set-marker erc-input-marker + (alist-get 'erc-input-marker continued-session)) + (goto-char erc-insert-marker) + (cl-assert (= (field-end) erc-input-marker)) + (goto-char old-point) + (erc--unhide-prompt)) + (cl-assert (not (get-text-property (point) 'erc-prompt))) + ;; In the original version from `erc-open', the snippet that + ;; handled these newline insertions appeared twice close in + ;; proximity, which was probably unintended. Nevertheless, we + ;; preserve the double newlines here for historical reasons. + (insert "\n\n") + (set-marker erc-insert-marker (point)) + (erc-display-prompt) + (cl-assert (= (point) (point-max))))) + (defun erc-open (&optional server port nick full-name connect passwd tgt-list channel process client-certificate user id) @@ -1999,10 +2028,13 @@ erc-open (old-recon-count erc-server-reconnect-count) (old-point nil) (delayed-modules nil) - (continued-session (and erc--server-reconnecting - (with-suppressed-warnings - ((obsolete erc-reuse-buffers)) - erc-reuse-buffers)))) + (continued-session (or erc--server-reconnecting + erc--target-priors + (and-let* (((not target)) + (m (buffer-local-value + 'erc-input-marker buffer)) + ((marker-position m))) + (buffer-local-variables buffer))))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) @@ -2020,21 +2052,6 @@ erc-open (buffer-local-value 'erc-server-announced-name old-buffer))) ;; connection parameters (setq erc-server-process process) - (setq erc-insert-marker (make-marker)) - (setq erc-input-marker (make-marker)) - ;; go to the end of the buffer and open a new line - ;; (the buffer may have existed) - (goto-char (point-max)) - (forward-line 0) - (when (or continued-session (get-text-property (point) 'erc-prompt)) - (setq continued-session t) - (set-marker erc-input-marker - (or (next-single-property-change (point) 'erc-prompt) - (point-max)))) - (unless continued-session - (goto-char (point-max)) - (insert "\n")) - (set-marker erc-insert-marker (point)) ;; stack of default recipients (setq erc-default-recipients tgt-list) (when target @@ -2081,20 +2098,7 @@ erc-open (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) (erc-determine-parameters server port nick full-name user passwd) - - ;; FIXME consolidate this prompt-setup logic with the pass above. - - ;; set up prompt - (unless continued-session - (goto-char (point-max)) - (insert "\n")) - (if continued-session - (progn (goto-char old-point) - (erc--unhide-prompt)) - (set-marker erc-insert-marker (point)) - (erc-display-prompt) - (goto-char (point-max))) - + (erc--initialize-markers old-point continued-session) (save-excursion (run-mode-hooks) (dolist (mod (car delayed-modules)) (funcall mod +1)) (dolist (var (cdr delayed-modules)) (set var nil))) diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el new file mode 100644 index 00000000000..7b91e28dc83 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el @@ -0,0 +1,211 @@ +;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- lexical-binding: t -*- + +;; Copyright (C) 2023 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 . + +;;; Commentary: + +;; A local module doubles as a minor mode whose mode variable and +;; associated local data can withstand service disruptions. +;; Unfortunately, the current implementation is too unwieldy to be +;; made public because it doesn't perform any of the boiler plate +;; needed to save and restore buffer-local and "network-local" copies +;; of user options. Ultimately, a user-friendly framework must fill +;; this void if third-party local modules are ever to become +;; practical. +;; +;; The following tests all use `sasl' because, as of ERC 5.5, it's the +;; only local module. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-sasl) + +;; After quitting a session for which `sasl' is enabled, you +;; disconnect and toggle `erc-sasl-mode' off. You then reconnect +;; using an alternate nickname. You again disconnect and reconnect, +;; this time immediately, and the mode stays disabled. Finally, you +;; once again disconnect, toggle the mode back on, and reconnect. You +;; are authenticated successfully, just like in the initial session. +;; +;; This is meant to show that a user's local mode settings persist +;; between sessions. It also happens to show (in round four, below) +;; that a server renicking a user on 001 after a 903 is handled just +;; like a user-initiated renick, although this is not the main thrust. + +(ert-deftest erc-scenarios-base-local-module-modes--reconnect () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/local-modules") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (expect (erc-d-t-make-expecter)) + (server-buffer-name (format "127.0.0.1:%d" port))) + + (ert-info ("Round one, initial authentication succeeds as expected") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name)) + (funcall expect 10 "You are now logged in as tester")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (funcall expect 10 "This server is in debug mode") + (erc-cmd-JOIN "#chan") + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "She is Lavinia, therefore must")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round two, nick rejected, alternate granted") + (with-current-buffer "foonet" + + (ert-info ("Toggle mode off, reconnect") + (erc-sasl-mode -1) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester`") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Some enigma, some riddle")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round three, send alternate nick initially") + (with-current-buffer "foonet" + + (ert-info ("Keep mode off, reconnect") + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester`") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Let our reciprocal vows be remembered.")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round four, authenticated successfully again") + (with-current-buffer "foonet" + + (ert-info ("Toggle mode on, reconnect") + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (erc-sasl-mode +1) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Well met; good morrow, Titus and Hortensius.")) + + (erc-cmd-QUIT ""))))) + +;; In contrast to the mode-persistence test above, this one +;; demonstrates that a user reinvoking an entry point declares their +;; intention to reset local-module state for the server buffer. +;; Whether a local-module's state variable is also reset in target +;; buffers up to the module. That is, by default, they're left alone. + +(ert-deftest erc-scenarios-base-local-module-modes--entrypoint () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/local-modules") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'first 'first)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (expect (erc-d-t-make-expecter)) + (server-buffer-name (format "127.0.0.1:%d" port))) + + (ert-info ("Round one, initial authentication succeeds as expected") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name)) + (funcall expect 10 "You are now logged in as tester")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (funcall expect 10 "This server is in debug mode") + (erc-cmd-JOIN "#chan") + + (ert-info ("Toggle local-module off in target buffer") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "She is Lavinia, therefore must") + (erc-sasl-mode -1))) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished") + + (ert-info ("Toggle mode off") + (erc-sasl-mode -1) + (should (local-variable-p 'erc-sasl-mode))))) + + (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.") + ;; If you were to /RECONNECT here, no PASS changeme would be + ;; sent instead of CAP SASL, resulting in a failure. + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name)) + (funcall expect 10 "You are now logged in as tester") + + (erc-d-t-wait-for 10 (equal (buffer-name) "foonet")) + (funcall expect 10 "User modes for tester") + (should erc-sasl-mode)) ; obviously + + ;; No other foonet buffer exists, e.g., foonet<2> + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + + (ert-info ("Target buffer retains local-module state") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "She is Lavinia, therefore must") + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (erc-cmd-QUIT "")))))) + +;;; erc-scenarios-base-local-module-modes.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el index 1318207a3bf..d6dbd87c8cc 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -82,105 +82,6 @@ erc-scenarios-base-local-modules--reconnect-let (erc-cmd-QUIT "") (funcall expect 10 "finished"))))) -;; After quitting a session for which `sasl' is enabled, you -;; disconnect and toggle `erc-sasl-mode' off. You then reconnect -;; using an alternate nickname. You again disconnect and reconnect, -;; this time immediately, and the mode stays disabled. Finally, you -;; once again disconnect, toggle the mode back on, and reconnect. You -;; are authenticated successfully, just like in the initial session. -;; -;; This is meant to show that a user's local mode settings persist -;; between sessions. It also happens to show (in round four, below) -;; that a server renicking a user on 001 after a 903 is handled just -;; like a user-initiated renick, although this is not the main thrust. - -(ert-deftest erc-scenarios-base-local-modules--mode-persistence () - :tags '(:expensive-test) - (erc-scenarios-common-with-cleanup - ((erc-scenarios-common-dialog "base/local-modules") - (erc-server-flood-penalty 0.1) - (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth)) - (port (process-contact dumb-server :service)) - (erc-modules (cons 'sasl erc-modules)) - (expect (erc-d-t-make-expecter)) - (server-buffer-name (format "127.0.0.1:%d" port))) - - (ert-info ("Round one, initial authentication succeeds as expected") - (with-current-buffer (erc :server "127.0.0.1" - :port port - :nick "tester" - :user "tester" - :password "changeme" - :full-name "tester") - (should (string= (buffer-name) server-buffer-name)) - (funcall expect 10 "You are now logged in as tester")) - - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) - (funcall expect 10 "This server is in debug mode") - (erc-cmd-JOIN "#chan") - - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) - (funcall expect 20 "She is Lavinia, therefore must")) - - (erc-cmd-QUIT "") - (funcall expect 10 "finished"))) - - (ert-info ("Round two, nick rejected, alternate granted") - (with-current-buffer "foonet" - - (ert-info ("Toggle mode off, reconnect") - (erc-sasl-mode -1) - (erc-cmd-RECONNECT)) - - (funcall expect 10 "User modes for tester`") - (should-not (cdr (erc-scenarios-common-buflist "foonet"))) - (should (equal (buffer-name) "foonet")) - (should-not (cdr (erc-scenarios-common-buflist "#chan"))) - - (with-current-buffer "#chan" - (funcall expect 10 "Some enigma, some riddle")) - - (erc-cmd-QUIT "") - (funcall expect 10 "finished"))) - - (ert-info ("Round three, send alternate nick initially") - (with-current-buffer "foonet" - - (ert-info ("Keep mode off, reconnect") - (should-not erc-sasl-mode) - (should (local-variable-p 'erc-sasl-mode)) - (erc-cmd-RECONNECT)) - - (funcall expect 10 "User modes for tester`") - (should-not (cdr (erc-scenarios-common-buflist "foonet"))) - (should (equal (buffer-name) "foonet")) - (should-not (cdr (erc-scenarios-common-buflist "#chan"))) - - (with-current-buffer "#chan" - (funcall expect 10 "Let our reciprocal vows be remembered.")) - - (erc-cmd-QUIT "") - (funcall expect 10 "finished"))) - - (ert-info ("Round four, authenticated successfully again") - (with-current-buffer "foonet" - - (ert-info ("Toggle mode on, reconnect") - (should-not erc-sasl-mode) - (should (local-variable-p 'erc-sasl-mode)) - (erc-sasl-mode +1) - (erc-cmd-RECONNECT)) - - (funcall expect 10 "User modes for tester") - (should-not (cdr (erc-scenarios-common-buflist "foonet"))) - (should (equal (buffer-name) "foonet")) - (should-not (cdr (erc-scenarios-common-buflist "#chan"))) - - (with-current-buffer "#chan" - (funcall expect 10 "Well met; good morrow, Titus and Hortensius.")) - - (erc-cmd-QUIT ""))))) - ;; For local modules, the twin toggle commands `erc-FOO-enable' and ;; `erc-FOO-disable' affect all buffers of a connection, whereas ;; `erc-FOO-mode' continues to operate only on the current buffer. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 40a2d2de657..c5a40d9bc72 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -117,11 +117,7 @@ erc-tests--send-prep ;; Caller should probably shadow `erc-insert-modify-hook' or ;; populate user tables for erc-button. (erc-mode) - (insert "\n\n") - (setq erc-input-marker (make-marker) - erc-insert-marker (make-marker)) - (set-marker erc-insert-marker (point-max)) - (erc-display-prompt) + (erc--initialize-markers (point) nil) (should (= (point) erc-input-marker))) (defun erc-tests--set-fake-server-process (&rest args) @@ -257,6 +253,79 @@ erc-hide-prompt (kill-buffer "bob") (kill-buffer "ServNet")))) +(ert-deftest erc--initialize-markers () + (let ((proc (start-process "true" (current-buffer) "true")) + erc-modules + erc-connect-pre-hook + erc-insert-modify-hook + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (set-process-query-on-exit-flag proc nil) + (erc-mode) + (setq erc-server-process proc + erc-networks--id (erc-networks--id-create 'foonet)) + (erc-open "localhost" 6667 "tester" "Tester" nil + "fake" nil "#chan" proc nil "user" nil) + (with-current-buffer (should (get-buffer "#chan")) + (should (= ?\n (char-after 1))) + (should (= ?E (char-after erc-insert-marker))) + (should (= 3 (marker-position erc-insert-marker))) + (should (= 8 (marker-position erc-input-marker))) + (should (= 8 (point-max))) + (should (= 8 (point))) + ;; These prompt properties are a continual source of confusion. + ;; Including the literal defaults here can hopefully serve as a + ;; quick reference for anyone operating in that area. + (should (equal (buffer-string) + #("\n\nERC> " + 2 6 ( font-lock-face erc-prompt-face + rear-nonsticky t + erc-prompt t + field erc-prompt + front-sticky t + read-only t) + 6 7 ( rear-nonsticky t + erc-prompt t + field erc-prompt + front-sticky t + read-only t)))) + + ;; Simulate some activity by inserting some text before and + ;; after the prompt (multiline). + (erc-display-error-notice nil "Welcome") + (goto-char (point-max)) + (insert "Hello\nWorld") + (goto-char 3) + (should (looking-at-p (regexp-quote "*** Welcome")))) + + (ert-info ("Reconnect") + (erc-open "localhost" 6667 "tester" "Tester" nil + "fake" nil "#chan" proc nil "user" nil) + (should-not (get-buffer "#chan<2>"))) + + (ert-info ("Existing prompt respected") + (with-current-buffer (should (get-buffer "#chan")) + (should (= ?\n (char-after 1))) + (should (= ?E (char-after erc-insert-marker))) + (should (= 15 (marker-position erc-insert-marker))) + (should (= 20 (marker-position erc-input-marker))) + (should (= 3 (point))) ; point restored + (should (equal (buffer-string) + #("\n\n*** Welcome\nERC> Hello\nWorld" + 2 13 (font-lock-face erc-error-face) + 14 18 ( font-lock-face erc-prompt-face + rear-nonsticky t + erc-prompt t + field erc-prompt + front-sticky t + read-only t) + 18 19 ( rear-nonsticky t + erc-prompt t + field erc-prompt + front-sticky t + read-only t)))) + (when noninteractive + (kill-buffer)))))) + (ert-deftest erc--switch-to-buffer () (defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch >From b38279a2e792015065bbf142a5a57e3539416763 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 16 Jun 2022 01:20:49 -0700 Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers * lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text property, which has been around since 2002, with more useful `erc-message' property. (erc-display-prompt): Make the `field' text property more meaningful to aid in searching, although this makes the `erc-prompt' property somewhat redundant. (erc-put-text-property, erc-list): Alias these to built-in functions. (erc--own-property-names, erc--remove-text-properties) Add internal variable and helper function for filtering values returned by `filter-buffer-substring-function'. (erc-restore-text-properties): Don't forget tags when restoring. (erc--get-eq-comparable-cmd): New function to extract commands for use as easily searchable text-property values. (Bug#60936.) --- lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 43 insertions(+), 14 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 27e46e6681b..b04386c6a3b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2871,7 +2871,9 @@ erc-display-message (erc-display-line string buffer) (unless (erc-hide-current-message-p parsed) (erc-put-text-property 0 (length string) 'erc-parsed parsed string) - (erc-put-text-property 0 (length string) 'rear-sticky t string) + (put-text-property + 0 (length string) 'erc-message + (erc--get-eq-comparable-cmd (erc-response.command parsed)) string) (when (erc-response.tags parsed) (erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed) string)) @@ -4249,6 +4251,30 @@ erc-ensure-channel-name channel (concat "#" channel))) +(defvar erc--own-property-names + '( tags erc-parsed display ; core + ;; `erc-display-prompt' + rear-nonsticky erc-prompt field front-sticky read-only + ;; stamp + cursor-intangible cursor-sensor-functions isearch-open-invisible + ;; match + invisible intangible + ;; button + erc-callback erc-data mouse-face keymap + ;; fill-wrap + line-prefix wrap-prefix) + "Props added by ERC that should not survive killing. +Among those left behind by default are `font-lock-face' and +`erc-secret'.") + +(defun erc--remove-text-properties (string) + "Remove text properties in STRING added by ERC. +Specifically, remove any that aren't members of +`erc--own-property-names'." + (remove-list-of-text-properties 0 (length string) + erc--own-property-names string) + string) + (defun erc-grab-region (start end) "Copy the region between START and END in a recreatable format. @@ -4300,7 +4326,7 @@ erc-display-prompt (setq prompt (propertize prompt 'rear-nonsticky t 'erc-prompt t - 'field t + 'field 'erc-prompt 'front-sticky t 'read-only t)) (erc-put-text-property 0 (1- (length prompt)) @@ -5672,7 +5698,7 @@ erc-highlight-error (erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s) s) -(defun erc-put-text-property (start end property value &optional object) +(defalias 'erc-put-text-property 'put-text-property "Set text-property for an object (usually a string). START and END define the characters covered. PROPERTY is the text-property set, usually the symbol `face'. @@ -5682,14 +5708,9 @@ erc-put-text-property OBJECT is modified without being copied first. You can redefine or `defadvice' this function in order to add -EmacsSpeak support." - (put-text-property start end property value object)) +EmacsSpeak support.") -(defun erc-list (thing) - "Return THING if THING is a list, or a list with THING as its element." - (if (listp thing) - thing - (list thing))) +(defalias 'erc-list 'ensure-list) (defun erc-parse-user (string) "Parse STRING as a user specification (nick!login@host). @@ -7283,10 +7304,11 @@ erc-find-parsed-property (defun erc-restore-text-properties () "Restore the property `erc-parsed' for the region." - (let ((parsed-posn (erc-find-parsed-property))) - (put-text-property - (point-min) (point-max) - 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn))))) + (when-let* ((parsed-posn (erc-find-parsed-property)) + (found (erc-get-parsed-vector parsed-posn))) + (put-text-property (point-min) (point-max) 'erc-parsed found) + (when-let ((tags (get-text-property parsed-posn 'tags))) + (put-text-property (point-min) (point-max) 'tags tags)))) (defun erc-get-parsed-vector (point) "Return the whole parsed vector on POINT." @@ -7306,6 +7328,13 @@ erc-get-parsed-vector-type (and vect (erc-response.command vect))) +(defun erc--get-eq-comparable-cmd (command) + "Return a symbol or a fixnum representing a message's COMMAND. +See also `erc-message-type'." + ;; IRC numerics are three-digit numbers, possibly with leading 0s. + ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o)) + (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n)) + ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch >From 52e83b811bfa55ae1c4b46728e6724ab8573ba04 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 24 Nov 2021 03:10:20 -0800 Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp * lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property `erc-timestamp' to store lisp time object formerly ensconced in a closure. Instead of creating a new lambda for the cursor-sensor function of each message in a buffer, leave a gap between messages to trip the sensor function. The motivation behind this change is to allow third parties access to valuable timestamp data already stored by ERC anyway. Of secondary importance is discouraging the reliance on those lambdas as a means of detecting message bounds. The gap now serves a similar purpose. Basically, the final character in a message, a newline, will not have a timestamp or a sensor function. When the stamps module isn't loaded, the `erc-message' property can be used instead. Also, instead of looking for the `invisible' text property at point, which is normally `point-max' and thus outside the accessible portion of the buffer, look at the beginning of the inserted message. This allows hook members running before this function to opt out of timestamps by marking a message as invisible. (erc-echo-timestamp): Make interactive and show timestamps even when the variable `erc-echo-timestamps' is nil. (erc--echo-ts-csf): Add new function to serve as value of cursor-sensor function text properties. * test/lisp/erc/erc-stamp-tests.el: New file. (Bug#60936.) --- lisp/erc/erc-stamp.el | 15 ++- test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++ 2 files changed, 217 insertions(+), 5 deletions(-) create mode 100644 test/lisp/erc/erc-stamp-tests.el diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 0aa1590f801..051d0702f06 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -162,7 +162,7 @@ erc-add-timestamp This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (unless (get-text-property (point) 'invisible) + (unless (get-text-property (point-min) 'invisible) (let ((ct (current-time))) (if (fboundp erc-insert-timestamp-function) (funcall erc-insert-timestamp-function @@ -174,12 +174,12 @@ erc-add-timestamp (not erc-timestamp-format)) (funcall erc-insert-away-timestamp-function (erc-format-timestamp ct erc-away-timestamp-format))) - (add-text-properties (point-min) (point-max) + (add-text-properties (point-min) (1- (point-max)) ;; It's important for the function to ;; be different on different entries (bug#22700). (list 'cursor-sensor-functions - (list (lambda (_window _before dir) - (erc-echo-timestamp dir ct)))))))) + ;; Regions are no longer contiguous ^ + '(erc--echo-ts-csf) 'erc-timestamp ct))))) (defvar-local erc-timestamp-last-window-width nil "The width of the last window that showed the current buffer. @@ -400,11 +400,16 @@ erc-toggle-timestamps (defun erc-echo-timestamp (dir stamp) "Print timestamp text-property of an IRC message." - (when (and erc-echo-timestamps (eq 'entered dir)) + ;; Could also pass an &optional `zone' arg to `format-time-string'. + (interactive (list 'entered (get-text-property (point) 'erc-timestamp))) + (when (eq 'entered dir) (when stamp (message "%s" (format-time-string erc-echo-timestamp-format stamp))))) +(defun erc--echo-ts-csf (_window _before dir) + (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp))) + (provide 'erc-stamp) ;;; erc-stamp.el ends here diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el new file mode 100644 index 00000000000..935b9e650b3 --- /dev/null +++ b/test/lisp/erc/erc-stamp-tests.el @@ -0,0 +1,207 @@ +;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- lexical-binding:t -*- + +;; Copyright (C) 2023 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 . + +;;; Commentary: + +;;; Code: +(require 'ert-x) +(require 'erc-stamp) +(require 'erc-goodies) ; for `erc-make-read-only' + +;; These display-oriented tests are brittle because many factors +;; influence how text properties are applied. We should just +;; rework these into full scenarios. + +(defun erc-stamp-tests--insert-right (test) + (let ((val (list 0 0)) + (erc-insert-modify-hook '(erc-add-timestamp)) + (erc-insert-post-hook '(erc-make-read-only)) ; see comment above + (erc-timestamp-only-if-changed-flag nil) + ;; + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + + (advice-add 'erc-format-timestamp :filter-args + (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args))) + '((name . ert-deftest--erc-timestamp-use-align-to))) + + (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*") + (erc-mode) + (erc-munge-invisibility-spec) + (setq erc-server-process (start-process "p" (current-buffer) + "sleep" "1") + erc-input-marker (make-marker) + erc-insert-marker (make-marker)) + (set-process-query-on-exit-flag erc-server-process nil) + (set-marker erc-insert-marker (point-max)) + (erc-display-prompt) + + (funcall test) + + (when noninteractive + (kill-buffer))) + + (advice-remove 'erc-format-timestamp + 'ert-deftest--erc-timestamp-use-align-to))) + +(ert-deftest erc-timestamp-use-align-to--nil () + (erc-stamp-tests--insert-right + (lambda () + + (ert-info ("nil, normal") + (let ((erc-timestamp-use-align-to nil)) + (erc-display-message nil 'notice (current-buffer) "begin")) + (goto-char (point-min)) + (should (search-forward-regexp + (rx "begin" (+ "\t") (* " ") " [") nil t)) + ;; Field includes intervening spaces + (should (eql ?n (char-before (field-beginning (point))))) + ;; Timestamp extends to the end of the line + (should (eql ?\n (char-after (field-end (point)))))) + + ;; The option `erc-timestamp-right-column' is normally nil by + ;; default, but it's a convenient stand in for a sufficiently + ;; small `erc-fill-column' (we can force a line break without + ;; involving that module). + (should-not erc-timestamp-right-column) + + (ert-info ("nil, overlong (hard wrap)") + (let ((erc-timestamp-use-align-to nil) + (erc-timestamp-right-column 20)) + (erc-display-message nil 'notice (current-buffer) + "twenty characters")) + (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t)) + ;; Field excludes leading whitespace (arguably undesirable). + (should (eql ?\s (char-after (field-beginning (point))))) + ;; Timestamp extends to the end of the line. + (should (eql ?\n (char-after (field-end (point))))))))) + +(ert-deftest erc-timestamp-use-align-to--t () + (erc-stamp-tests--insert-right + (lambda () + + (ert-info ("t, normal") + (let ((erc-timestamp-use-align-to t)) + (let ((msg (erc-format-privmessage "bob" "msg one" nil t))) + (erc-display-message nil nil (current-buffer) msg))) + (goto-char (point-min)) + ;; Exactly two spaces, one from format, one added by erc-stamp. + (should (search-forward "msg one [" nil t)) + ;; Field covers space between. + (should (eql ?e (char-before (field-beginning (point))))) + (should (eql ?\n (char-after (field-end (point)))))) + + (ert-info ("t, overlong (hard wrap)") + (let ((erc-timestamp-use-align-to t) + (erc-timestamp-right-column 20)) + (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) + (erc-display-message nil nil (current-buffer) msg))) + ;; Indented to pos (this is arguably a bug). + (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t)) + ;; Field starts *after* leading space (arguably bad). + (should (eql ?\[ (char-after (1+ (field-beginning (point)))))) + (should (eql ?\n (char-after (field-end (point))))))))) + +;; This concerns a proposed partial reversal of the changes resulting +;; from: +;; +;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706) +;; +;; Perhaps core behavior has changed since this bug was reported, but +;; C-e stopping one char short of EOL no longer seems a problem. +;; However, invoking C-n (`next-line') exhibits a similar effect. +;; When point is in a stamp or near the beginning of a line, issuing a +;; C-n puts point one past the start of the message (i.e., two chars +;; beyond the timestamp's closing "]". Dropping the invisible +;; property when timestamps are hidden does indeed prevent this, but +;; it's also a lasting commitment. The docs mention that it's +;; pointless to pair the old `intangible' property with `invisible' +;; and suggest users look at `cursor-intangible-mode'. Turning off +;; the latter does indeed do the trick as does decrementing the end of +;; the `cursor-intangible' interval so that, in addition to C-n +;; working, a C-f from before the timestamp doesn't overshoot. This +;; appears to be the case whether `erc-hide-timestamps' is enabled or +;; not, but it may be inadvisable for some reason (a hack) and +;; therefore warrants further investigation. +;; +;; Note some striking omissions here: +;; +;; 1. a lack of `fill' module integration (we simulate it by +;; making lines short enough to not wrap) +;; 2. functions like `line-move' behave differently when +;; `noninteractive' +;; 3. no actual test assertions involving `cursor-sensor' movement +;; even though that's a huge ingredient + +(ert-deftest erc-timestamp-intangible--left () + (let ((erc-timestamp-only-if-changed-flag nil) + (erc-timestamp-intangible t) ; default changed to nil in 2014 + (erc-hide-timestamps t) + (erc-insert-timestamp-function 'erc-insert-timestamp-left) + (erc-server-process (start-process "true" (current-buffer) "true")) + (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp)) + msg + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (should (not cursor-sensor-inhibit)) + (set-process-query-on-exit-flag erc-server-process nil) + (erc-mode) + (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") + (erc-mode) + (erc--initialize-markers (point) nil) + (erc-munge-invisibility-spec) + (erc-display-message nil 'notice (current-buffer) "Welcome") + ;; + ;; Pretend `fill' is active and that these lines are + ;; folded. Otherwise, there's an annoying issue on wrapped lines + ;; (when visual-line-mode is off and stamps are visible) where + ;; C-e sends you to the end of the previous line. + (setq msg "Lorem ipsum dolor sit amet") + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage "alyssa" msg nil t)) + (erc-display-message nil 'notice (current-buffer) "Home") + (goto-char (point-min)) + + ;; EOL is actually EOL (Bug#11706) + + (ert-info ("Notice before stamp, C-e") ; first line/stamp + (should (search-forward "Welcome" nil t)) + (ert-simulate-command '(erc-bol)) + (should (looking-at (rx "["))) + (let ((end (pos-eol))) ; `line-end-position' fails because fields + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (ert-info ("Privmsg before stamp, C-e") + (should (search-forward "Lorem" nil t)) + (goto-char (pos-bol)) + (should (looking-at (rx "["))) + (let ((end (pos-eol))) + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (ert-info ("Privmsg first line, C-e") + (goto-char (pos-bol)) + (should (search-forward "ipsum" nil t)) + (let ((end (pos-eol))) + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (when noninteractive + (kill-buffer))))) + +;;; erc-stamp-tests.el ends here -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.6-Make-some-erc-stamp-functions-more-limber.patch >From 984bd396d31dbf1652e8230d03886614b6cde1b5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 24 Nov 2021 05:35:35 -0800 Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber TODO: update ERC-NEWS announcing deprecation. * lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option and change meaning of its nil value to fall through to `erc-timestamp-format'. Do this to allow modules to predict what the right-hand stamp's final width will be. This also saves `erc-insert-timestamp-left-and-right' from calling `erc-format-timestamp' again for no reason. (erc-stamp--current-time): Add new generic function and method to return current time. Default to calling `current-time'. (erc-stamp--current-time): New internal variable to hold time value used to construct time formatted stamp passed to `erc-insert-timestamp-function'. (erc-add-timestamp): Bind `erc-stamp--current-time' when calling `erc-insert-timestamp-function'. (erc-insert-timestamp-left-and-right): Use STRING parameter and favor it over the now deprecated `erc-timestamp-format-right' to avoid formatting twice. Also extract current time from the variable `erc-stamp--current-time' for similar reasons. (Bug#60936.) (erc-stamp--tz): New internal variable. (erc-format-timestamp): Pass `erc-stamp--tz' as time-zone to `format-time-string'. --- lisp/erc/erc-stamp.el | 39 +++++++++++++++++++++++++++++++-------- 1 file changed, 31 insertions(+), 8 deletions(-) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 051d0702f06..736aa498803 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -55,6 +55,9 @@ erc-timestamp-format :type '(choice (const nil) (string))) +;; FIXME remove surrounding whitespace from default value and have +;; `erc-insert-timestamp-left-and-right' add it before insertion. + (defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n" "If set to a string, messages will be timestamped. This string is processed using `format-time-string'. @@ -68,7 +71,7 @@ erc-timestamp-format-left :type '(choice (const nil) (string))) -(defcustom erc-timestamp-format-right " [%H:%M]" +(defcustom erc-timestamp-format-right nil "If set to a string, messages will be timestamped. This string is processed using `format-time-string'. Good examples are \"%T\" and \"%H:%M\". @@ -77,9 +80,14 @@ erc-timestamp-format-right screen when `erc-insert-timestamp-function' is set to `erc-insert-timestamp-left-and-right'. -If nil, timestamping is turned off." +Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if +the value of this option is nil, it falls back to using the value +of `erc-timestamp-format'." + :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) (string))) +(make-obsolete-variable 'erc-timestamp-format-right + 'erc-timestamp-format "30.1") (defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right "Function to use to insert timestamps. @@ -157,17 +165,31 @@ stamp (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp))) +(defvar erc-stamp--current-time nil + "The current time when calling `erc-insert-timestamp-function'. +Specifically, this is the same lisp time object used to create +the stamp passed to `erc-insert-timestamp-function'.") + +(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)) + +(cl-defmethod erc-stamp--current-time :around () + (or erc-stamp--current-time (cl-call-next-method))) + (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-min) '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)) + (erc-stamp--current-time ct)) + (funcall erc-insert-timestamp-function + (erc-format-timestamp ct erc-timestamp-format)) + ;; FIXME this will error when advice has been applied. (when (and (fboundp erc-insert-away-timestamp-function) erc-away-timestamp-format (erc-away-time) @@ -336,12 +358,13 @@ erc-insert-timestamp-left-and-right (setq erc-timestamp-last-inserted-right ts-right)))) ;; for testing: (setq erc-timestamp-only-if-changed-flag nil) +(defvar erc-stamp--tz nil) (defun erc-format-timestamp (time format) "Return TIME formatted as string according to FORMAT. Return the empty string if FORMAT is nil." (if format - (let ((ts (format-time-string format time))) + (let ((ts (format-time-string format time erc-stamp--tz))) (erc-put-text-property 0 (length ts) 'font-lock-face 'erc-timestamp-face ts) (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch >From e68de4d0069a9a12f4884a93678e2e55fed9efbf Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 24 Nov 2021 05:35:35 -0800 Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp * lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning of option to accept numeric value for dynamically aligned right-side stamps. Use `graphic-display-p' to determine default value even though, as stated in the manual, terminal Emacs also supports the "space" display spec. (erc-stamp-right-margin-width): New option to determine width of right margin when `erc-stamp--display-margin-mode' is active or `erc-timestamp-use-align-to' is set to `margin'. (erc-stamp--display-margin-force): Add new helper function for `erc-stamp--display-margin-mode'. (erc-stamp--display-margin-mode): Add internal minor mode to help other modules quickly ensure stamps are showing correctly. (erc-stamp--inherited-props): Add internal const to hold properties that should be inherited from message being inserted. (erc-insert-aligned): Deprecate function and remove from primary client code path. (erc-insert-timestamp-right): Account for new display-related values of `erc-timestamp-use-align-to'. * test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil, erc-timestamp-use-align-to--t): Adjust spacing for new default right-hand stamp, `erc-format-timestamp', which lacks a leading space. (erc-timestamp-use-align-to--integer, erc-timestamp-use-align-to--margin): New tests. (Bug#60936.) --- lisp/erc/erc-stamp.el | 156 +++++++++++++++++++++++++++---- test/lisp/erc/erc-stamp-tests.el | 70 ++++++++++++-- 2 files changed, 202 insertions(+), 24 deletions(-) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 736aa498803..e689caf7b61 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -239,14 +239,109 @@ erc-timestamp-right-column (integer :tag "Column number") (const :tag "Unspecified" nil))) -(defcustom erc-timestamp-use-align-to (eq window-system 'x) +(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t) "If non-nil, use the :align-to display property to align the stamp. This gives better results when variable-width characters (like Asian language characters and math symbols) precede a timestamp. -A side effect of enabling this is that there will only be one -space before a right timestamp in any saved logs." - :type 'boolean) +This option only matters when `erc-insert-timestamp-function' is +set to `erc-insert-timestamp-right' or that option's default, +`erc-insert-timestamp-left-and-right'. If the value is a +positive integer, alignment occurs that many columns from the +right edge. If the value is `margin', the stamp appears in the +right margin when visible. + +Enabling this option produces a side effect in that stamps aren't +indented in saved logs. When its value is an integer, this +option adds a space after the end of a message if the stamp +doesn't already start with one. And when its value is t, it adds +a single space, unconditionally. And while this option never +adds a space when its value is `margin', ERC does offer a +workaround in `erc-stamp-prefix-log-filter', which strips +trailing stamps from messages and puts them before every line." + :type '(choice boolean integer (const margin)) + :package-version '(ERC . "5.6")) ; FIXME sync on release + +(defcustom erc-stamp-right-margin-width nil + "Width in columns of the right margin. +When this option is nil, pretend its value is one column greater +than the `string-width' of the formatted `erc-timestamp-format'. +This option only matters when `erc-timestamp-use-align-to' is set +to `margin'." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type '(choice (const nil) integer)) + +(defun erc-stamp--display-margin-force (orig &rest r) + (let ((erc-timestamp-use-align-to 'margin)) + (apply orig r))) + +(defun erc-stamp--adjust-right-margin (cols) + "Adjust right margin by COLS. +When COLS is zero, reset width to `erc-stamp-right-margin-width' +or one col more than the `string-width' of +`erc-timestamp-format'." + (let ((width + (if (zerop cols) + (or erc-stamp-right-margin-width + (1+ (string-width (or erc-timestamp-last-inserted + (erc-format-timestamp + (current-time) + erc-timestamp-format))))) + (+ right-margin-width cols)))) + (setq right-margin-width width + right-fringe-width 0) + (set-window-margins nil left-margin-width width) + (set-window-fringes nil left-fringe-width 0))) + +(defun erc-stamp-prefix-log-filter (text) + "Prefix every message in the buffer with a stamp. +Remove trailing stamps as well. For now, hard code the format to +\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a +`erc-log-filter-function' when `erc-timestamp-use-align-to' is +non-nil." + (insert text) + (goto-char (point-min)) + (while + (progn + (when-let* (((< (point) (pos-eol))) + (end (1- (pos-eol))) + ((eq 'erc-timestamp (field-at-pos end))) + (beg (field-beginning end)) + ;; Skip a line that's just a timestamp. + ((> beg (point)))) + (delete-region beg (1+ end))) + (when-let (time (get-text-property (point) 'erc-timestamp)) + (insert (format-time-string "[%H:%M:%S] " time))) + (zerop (forward-line)))) + "") + +(declare-function erc--remove-text-properties "erc" (string)) + +;; If people want to use this directly, we can convert it into +;; a local module. +(define-minor-mode erc-stamp--display-margin-mode + "Internal minor mode for built-in modules integrating with `stamp'. +It binds `erc-timestamp-use-align-to' to `margin' around calls to +`erc-insert-timestamp-function' in the current buffer, and sets +the right window margin to `erc-stamp-right-margin-width'. It +also arranges to remove most text properties when a user kills +message text so that stamps will be visible when yanked." + :interactive nil + (if erc-stamp--display-margin-mode + (progn + (erc-stamp--adjust-right-margin 0) + (add-function :filter-return (local 'filter-buffer-substring-function) + #'erc--remove-text-properties) + (add-function :around (local 'erc-insert-timestamp-function) + #'erc-stamp--display-margin-force)) + (remove-function (local 'filter-buffer-substring-function) + #'erc--remove-text-properties) + (remove-function (local 'erc-insert-timestamp-function) + #'erc-stamp--display-margin-force) + (kill-local-variable 'right-margin-width) + (kill-local-variable 'right-fringe-width) + (set-window-margins nil left-margin-width nil) + (set-window-fringes nil left-fringe-width nil))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." @@ -265,6 +360,7 @@ erc-insert-aligned If `erc-timestamp-use-align-to' is t, use the :align-to display property to get to the POSth column." + (declare (obsolete "inlined and removed from client code path" "30.1")) (if (not erc-timestamp-use-align-to) (indent-to pos) (insert " ") @@ -275,6 +371,8 @@ erc-insert-aligned ;; Silence byte-compiler (defvar erc-fill-column) +(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)) + (defun erc-insert-timestamp-right (string) "Insert timestamp on the right side of the screen. STRING is the timestamp to insert. This function is a possible @@ -326,25 +424,47 @@ erc-insert-timestamp-right ;; some margin of error if what is displayed on the line differs ;; from the number of characters on the line. (setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6)))) - (if (< col pos) - (erc-insert-aligned string pos) - (newline) - (indent-to pos) - (setq from (point)) - (insert string)) + ;; For compatibility reasons, the `erc-timestamp' field includes + ;; intervening white space unless a hard break is warranted. + (pcase erc-timestamp-use-align-to + ((and 't (guard (< col pos))) + (insert " ") + (put-text-property from (point) 'display `(space :align-to ,pos))) + ((pred integerp) ; (cl-type (integer 0 *)) + (insert " ") + (when (eq ?\s (aref string 0)) + (setq string (substring string 1))) + (let ((s (+ erc-timestamp-use-align-to (string-width string)))) + (put-text-property from (point) 'display + `(space :align-to (- right ,s))))) + ('margin + (put-text-property 0 (length string) + 'display `((margin right-margin) ,string) + string)) + ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point))) + (_ (indent-to pos))) + (insert string) + (dolist (p erc-stamp--inherited-props) + (when-let ((v (get-text-property (1- from) p))) + (put-text-property from (point) p v))) (erc-put-text-property from (point) 'field 'erc-timestamp) (erc-put-text-property from (point) 'rear-nonsticky t) (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) -(defun erc-insert-timestamp-left-and-right (_string) - "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))) +(defun erc-insert-timestamp-left-and-right (string) + "Insert a stamp on either side when it changes. +When the deprecated option `erc-timestamp-format-right' is nil, +use STRING, which originates from `erc-timestamp-format', for the +right-hand stamp. Use `erc-timestamp-format-left' for the +left-hand stamp and expect it to change less frequently." + (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + (ts-right (with-suppressed-warnings + ((obsolete erc-timestamp-format-right)) + (if erc-timestamp-format-right + (erc-format-timestamp ct erc-timestamp-format-right) + string)))) ;; insert left timestamp (unless (string-equal ts-left erc-timestamp-last-inserted-left) (goto-char (point-min)) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 935b9e650b3..01e71e348e0 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil (erc-display-message nil 'notice (current-buffer) "begin")) (goto-char (point-min)) (should (search-forward-regexp - (rx "begin" (+ "\t") (* " ") " [") nil t)) + (rx "begin" (+ "\t") (* " ") "[") nil t)) ;; Field includes intervening spaces (should (eql ?n (char-before (field-beginning (point))))) ;; Timestamp extends to the end of the line @@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil (erc-timestamp-right-column 20)) (erc-display-message nil 'notice (current-buffer) "twenty characters")) - (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t)) + (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) ;; Field excludes leading whitespace (arguably undesirable). - (should (eql ?\s (char-after (field-beginning (point))))) + (should (eql ?\[ (char-after (field-beginning (point))))) ;; Timestamp extends to the end of the line. (should (eql ?\n (char-after (field-end (point))))))))) @@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t (erc-display-message nil nil (current-buffer) msg))) (goto-char (point-min)) ;; Exactly two spaces, one from format, one added by erc-stamp. - (should (search-forward "msg one [" nil t)) + (should (search-forward "msg one [" nil t)) ;; Field covers space between. (should (eql ?e (char-before (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point)))))) @@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) (erc-display-message nil nil (current-buffer) msg))) ;; Indented to pos (this is arguably a bug). - (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t)) + (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) ;; Field starts *after* leading space (arguably bad). - (should (eql ?\[ (char-after (1+ (field-beginning (point)))))) + (should (eql ?\[ (char-after (field-beginning (point))))) + (should (eql ?\n (char-after (field-end (point))))))))) + +(ert-deftest erc-timestamp-use-align-to--integer () + (erc-stamp-tests--insert-right + (lambda () + + (ert-info ("integer, normal") + (let ((erc-timestamp-use-align-to 1)) + (let ((msg (erc-format-privmessage "bob" "msg one" nil t))) + (erc-display-message nil nil (current-buffer) msg))) + (goto-char (point-min)) + ;; Space not added because included in format string. + (should (search-forward "msg one [" nil t)) + ;; Field covers space between. + (should (eql ?e (char-before (field-beginning (point))))) + (should (eql ?\n (char-after (field-end (point)))))) + + (ert-info ("integer, overlong (hard wrap)") + (let ((erc-timestamp-use-align-to 1) + (erc-timestamp-right-column 20)) + (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) + (erc-display-message nil nil (current-buffer) msg))) + ;; No hard wrap + (should (search-forward "oooo [" nil t)) + ;; Field starts at leading space. + (should (eql ?\s (char-after (field-beginning (point))))) + (should (eql ?\n (char-after (field-end (point))))))))) + +(ert-deftest erc-timestamp-use-align-to--margin () + (erc-stamp-tests--insert-right + (lambda () + (erc-stamp--display-margin-mode +1) + + (ert-info ("margin, normal") + (let ((erc-timestamp-use-align-to 'margin)) + (let ((msg (erc-format-privmessage "bob" "msg one" nil t))) + (put-text-property 0 (length msg) 'wrap-prefix 10 msg) + (erc-display-message nil nil (current-buffer) msg))) + (goto-char (point-min)) + ;; Space not added (treated as opaque string). + (should (search-forward "msg one[" nil t)) + ;; Field covers stamp alone + (should (eql ?e (char-before (field-beginning (point))))) + ;; Vanity props extended + (should (get-text-property (field-beginning (point)) 'wrap-prefix)) + (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix)) + (should (get-text-property (1- (field-end (point))) 'wrap-prefix)) + (should (eql ?\n (char-after (field-end (point)))))) + + (ert-info ("margin, overlong (hard wrap)") + (let ((erc-timestamp-use-align-to 'margin) + (erc-timestamp-right-column 20)) + (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) + (erc-display-message nil nil (current-buffer) msg))) + ;; No hard wrap + (should (search-forward "oooo[" nil t)) + ;; Field starts at format string (right bracket) + (should (eql ?\[ (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) ;; This concerns a proposed partial reversal of the changes resulting -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch >From c7bdb4ff5f91e5abeb324b28d0bebade0ed3589d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 24 Apr 2022 02:38:12 -0700 Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module * lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable, erc-fill-disable): Use API to create these. (erc-fill-static): Save restriction instead of caller's match data. (Bug#60936.) --- lisp/erc/erc-fill.el | 34 +++++++++++----------------------- 1 file changed, 11 insertions(+), 23 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index e10b7d790f6..caf401bf222 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -38,30 +38,18 @@ erc-fill :group 'erc) ;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t) -(define-minor-mode erc-fill-mode - "Toggle ERC fill mode. -With a prefix argument ARG, enable ERC fill mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. - +(define-erc-module fill nil + "Manage filling in ERC buffers. ERC fill mode is a global minor mode. When enabled, messages in the channel buffers are filled." - :global t - (if erc-fill-mode - (erc-fill-enable) - (erc-fill-disable))) - -(defun erc-fill-enable () - "Setup hooks for `erc-fill-mode'." - (interactive) - (add-hook 'erc-insert-modify-hook #'erc-fill) - (add-hook 'erc-send-modify-hook #'erc-fill)) - -(defun erc-fill-disable () - "Cleanup hooks, disable `erc-fill-mode'." - (interactive) - (remove-hook 'erc-insert-modify-hook #'erc-fill) - (remove-hook 'erc-send-modify-hook #'erc-fill)) + ;; FIXME ensure a consistent ordering relative to hook members from + ;; other modules. Ideally, this module's processing should happen + ;; after "morphological" modifications to a message's text but + ;; before superficial decorations. + ((add-hook 'erc-insert-modify-hook #'erc-fill) + (add-hook 'erc-send-modify-hook #'erc-fill)) + ((remove-hook 'erc-insert-modify-hook #'erc-fill) + (remove-hook 'erc-send-modify-hook #'erc-fill))) (defcustom erc-fill-prefix nil "Values used as `fill-prefix' for `erc-fill-variable'. @@ -130,7 +118,7 @@ erc-fill (defun erc-fill-static () "Fills a text such that messages start at column `erc-fill-static-center'." - (save-match-data + (save-restriction (goto-char (point-min)) (looking-at "^\\(\\S-+\\)") (let ((nick (match-string 1))) -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch >From 64fa7a93cd5bb249104180a9a6bea93a8fc5d956 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 27 Jan 2023 05:34:56 -0800 Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec * lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange for possibly adding or removing `erc-match' from `buffer-invisibility-spec'. (erc-match--hide-fools-offset-bounds): Add new variable to serve as switch for activating invisibility on a modified interval that's offset toward `point-min' by one character. (erc-hide-fools): Optionally offset start and end of invisible region by minus one. (erc-match--modify-invisibility-spec): New housekeeping function to set up and tear down offset spec. (Bug#60936.) --- lisp/erc/erc-match.el | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 52ee5c855f3..a5e9720bad4 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -52,8 +52,11 @@ match `erc-current-nick-highlight-type'. For all these highlighting types, you can decide whether the entire message or only the sending nick is highlighted." - ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)) - ((remove-hook 'erc-insert-modify-hook #'erc-match-message))) + ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append) + (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)) + ((remove-hook 'erc-insert-modify-hook #'erc-match-message) + (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec) + (erc-match--modify-invisibility-spec))) ;; Remaining customizations @@ -647,15 +650,22 @@ erc-go-to-log-matches-buffer (get-buffer (car buffer-cons)))))) (switch-to-buffer buffer-name))) -(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer) +(defvar-local erc-match--hide-fools-offset-bounds nil) (defun erc-hide-fools (match-type _nickuserhost _message) "Hide foolish comments. This function should be called from `erc-text-matched-hook'." - (when (eq match-type 'fool) - (erc-put-text-properties (point-min) (point-max) - '(invisible intangible) - (current-buffer)))) + (when (eq match-type 'fool) + (if erc-match--hide-fools-offset-bounds + (let ((beg (point-min)) + (end (point-max))) + (save-restriction + (widen) + (put-text-property (1- beg) (1- end) 'invisible 'erc-match))) + ;; The docs say `intangible' is deprecated, but this has been + ;; like this for ages. Should verify unneeded and remove if so. + (erc-put-text-properties (point-min) (point-max) + '(invisible intangible))))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. @@ -663,6 +673,13 @@ erc-beep-on-match (when (member match-type erc-beep-match-types) (beep))) +(defun erc-match--modify-invisibility-spec () + "Add an ellipsis property to the local spec." + (if erc-match-mode + (add-to-invisibility-spec 'erc-match) + (erc-with-all-buffers-of-server nil nil + (remove-from-invisibility-spec 'erc-match)))) + (provide 'erc-match) ;;; erc-match.el ends here -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch Content-Transfer-Encoding: quoted-printable >From f2613f703f3e4fa49a0efb3e120b493bb0731c53 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 13 Jan 2023 00:00:56 -0800 Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode * lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for local module `fill-wrap'. * lisp/erc/erc-compat.el (erc-compat--29-set-transient-map-timer, erc-compat--29-set-transient-map, erc-compat--set-transient-map): Backport `set-transient-map' definition from Emacs 29. * lisp/erc/erc-fill.el (erc-fill-function): Add new value, `erc-fill-wrap'. (erc-fill-static-center): Extend meaning of option to also affect `erc-wrap-mode'. (erc-fill--wrap-value, erc-fill--wrap-movement): New variables to support new local module. (erc-fill-wrap-movement): New option to control how where `visual-line-mode' keys are active. (erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line, erc-fill--wrap-end-of-line): New movement commands. (erc-fill-wrap-cycle-visual-movement): New command to cycle local value of `erc-fill-wrap-movement'. (erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'. (erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): New local module. (erc-fill-wrap): New function implementing `erc-fill-function' (behavioral) interface. (erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper for growing and shrinking visual fill prefix. * test/lisp/erc/erc-fill-tests.el: New file. (Bug#60936.) --- lisp/erc/erc-compat.el | 57 +++ lisp/erc/erc-fill.el | 273 ++++++++++++++- test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++ .../fill/snapshots/monospace-01-start.eld | 1 + .../fill/snapshots/monospace-02-right.eld | 1 + .../fill/snapshots/monospace-03-left.eld | 1 + .../fill/snapshots/monospace-04-reset.eld | 1 + 7 files changed, 653 insertions(+), 5 deletions(-) create mode 100644 test/lisp/erc/erc-fill-tests.el create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-sta= rt.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-rig= ht.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-lef= t.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-res= et.eld diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 5601ede27a5..7d635e5b1af 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -409,6 +409,63 @@ erc-compat--29-browse-url-irc (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) existing)))))) =20 +;; FIXME remove these after bumping Compat version to 29 +(defvar erc-compat--29-set-transient-map-timer nil) + +(defun erc-compat--29-set-transient-map + (map &optional keep-pred on-exit message timeout) + (let* ((message + (when message + (let (keys) + (map-keymap (lambda (key cmd) (and cmd (push key keys))) map) + (format-spec + (if (stringp message) message "Repeat with %k") + `((?k . ,(mapconcat + (lambda (key) + (substitute-command-keys + (format "\\`%s'" (key-description (vector key)= )))) + keys ", "))))))) + (clearfun (make-symbol "clear-transient-map")) + (exitfun (lambda () + (internal-pop-keymap map 'overriding-terminal-local-ma= p) + (remove-hook 'pre-command-hook clearfun) + (when message (message "")) + (when erc-compat--29-set-transient-map-timer + (cancel-timer erc-compat--29-set-transient-map-timer= )) + (when on-exit (funcall on-exit))))) + (fset clearfun + (lambda () + (with-demoted-errors "set-transient-map PCH: %S" + (if (cond + ((null keep-pred) nil) + ((and (not (eq map (cadr overriding-terminal-local-map)= )) + (memq map (cddr overriding-terminal-local-map))) + t) + ((eq t keep-pred) + (let ((mc (lookup-key map (this-command-keys-vector)))) + (when (and mc (symbolp mc)) + (setq mc (or (command-remapping mc) mc))) + (and mc (eq this-command mc)))) + (t (funcall keep-pred))) + (when message (message "%s" message)) + (funcall exitfun))))) + (add-hook 'pre-command-hook clearfun) + (internal-push-keymap map 'overriding-terminal-local-map) + (when timeout + (when erc-compat--29-set-transient-map-timer + (cancel-timer erc-compat--29-set-transient-map-timer)) + (setq erc-compat--29-set-transient-map-timer + (run-with-idle-timer timeout nil exitfun))) + (when message (message "%s" message)) + exitfun)) + +(defmacro erc-compat--set-transient-map (&rest args) + (cons (if (>=3D emacs-major-version 29) + 'set-transient-map + 'erc-compat--29-set-transient-map) + args)) + + (provide 'erc-compat) =20 ;;; erc-compat.el ends here diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index caf401bf222..032206b514a 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -28,6 +28,9 @@ ;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to ;; change the style. =20 +;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops +;; support for Emacs 27. + ;;; Code: =20 (require 'erc) @@ -79,16 +82,29 @@ erc-fill-function These two styles are implemented using `erc-fill-variable' and `erc-fill-static'. You can, of course, define your own filling function. Narrowing to the region in question is in effect while your -function is called." +function is called. + +A third style resembles static filling but \"wraps\" instead of +fills, thanks to `visual-line-mode' mode, which ERC automatically +enables when this option is `erc-fill-wrap' or when +`erc-fill-wrap-mode' is active. Set `erc-fill-static-center' to +your preferred initial \"prefix\" width. For adjusting the width +during a session, see the command `erc-fill-wrap-nudge'." :type '(choice (const :tag "Variable Filling" erc-fill-variable) (const :tag "Static Filling" erc-fill-static) + (const :tag "Dynamic word-wrap" erc-fill-wrap) function)) =20 (defcustom erc-fill-static-center 27 - "Column around which all statically filled messages will be centered. -This column denotes the point where the ` ' character between - and the entered text will be put, thus aligning nick -names right and text left." + "Number of columns to \"outdent\" the first line of a message. +During early message handing, ERC prepends a span of +non-whitespace characters to every message, such as a bracketed +\"\" or an `erc-notice-prefix'. The +`erc-fill-function' variants `erc-fill-static' and +`erc-fill-wrap' look to this option to determine the amount of +padding to apply to that portion until the filled (or wrapped) +message content aligns with the indicated column. See also +https://en.wikipedia.org/wiki/Hanging_indent." :type 'integer) =20 (defcustom erc-fill-variable-maximum-indentation 17 @@ -155,6 +171,253 @@ erc-fill-variable (erc-fill-regarding-timestamp)))) (erc-restore-text-properties))) =20 +(defvar-local erc-fill--wrap-value nil) +(defvar-local erc-fill--wrap-visual-keys nil) + +(defcustom erc-fill-wrap-use-pixels t + "Whether to calculate padding in pixels when possible. +A value of nil means ERC should use columns, which may happen +regardless, depending on the Emacs version. This option only +matters when `erc-fill-wrap-mode' is enabled." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type 'boolean) + +(defcustom erc-fill-wrap-visual-keys 'non-input + "Whether to retain keys defined by `visual-line-mode'. +A value of t tells ERC to use movement commands defined by +`visual-line-mode' everywhere in an ERC buffer along with visual +editing commands in the input area. A value of nil means to +never do so. A value of `non-input' tells ERC to act like the +value is nil in the input area and t elsewhere. This option only +plays a role when `erc-fill-wrap-mode' is enabled." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type '(choice (const nil) (const t) (const non-input))) + +(defun erc-fill--wrap-move (normal-cmd visual-cmd arg) + (funcall (pcase erc-fill--wrap-visual-keys + ('non-input + (if (>=3D (point) erc-input-marker) normal-cmd visual-cmd)) + ('t visual-cmd) + (_ normal-cmd)) + arg)) + +(defun erc-fill--wrap-kill-line (arg) + "Defer to `kill-line' or `kill-visual-line'." + (interactive "P") + ;; ERC buffers are read-only outside of the input area, but we run + ;; `kill-line' anyway so that users can see the error. + (erc-fill--wrap-move #'kill-line #'kill-visual-line arg)) + +(defun erc-fill--wrap-beginning-of-line (arg) + "Defer to `move-beginning-of-line' or `beginning-of-visual-line'." + (interactive "^p") + (let ((inhibit-field-text-motion t)) + (erc-fill--wrap-move #'move-beginning-of-line + #'beginning-of-visual-line arg)) + (when (get-text-property (point) 'erc-prompt) + (goto-char erc-input-marker))) + +(defun erc-fill--wrap-end-of-line (arg) + "Defer to `move-end-of-line' or `end-of-visual-line'." + (interactive "^p") + (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg)) + +(defun erc-fill-wrap-cycle-visual-movement (arg) + "Cycle through `erc-fill-wrap-visual-keys' styles ARG times. +Go from nil to t to `non-input' and back around, but set internal +state instead of mutating `erc-fill-wrap-visual-keys'. When ARG +is 0, reset to value of `erc-fill-wrap-visual-keys'." + (interactive "^p") + (when (zerop arg) + (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys)) + (while (not (zerop arg)) + (cl-incf arg (- (abs arg))) + (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys + ('nil t) + ('t 'non-input) + ('non-input nil)))) + (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys)) + +(defvar-keymap erc-fill-wrap-mode-map ; Compat 29 + :doc "Keymap for ERC's `fill-wrap' module." + :parent visual-line-mode-map + " " #'erc-fill--wrap-kill-line + " " #'erc-fill--wrap-end-of-line + " " #'erc-fill--wrap-beginning-of-line + "C-c a" #'erc-fill-wrap-cycle-visual-movement + ;; Not sure if this is problematic because `erc-bol' takes no args. + " " #'erc-fill--wrap-beginning-of-line) + +(defvar erc-match-mode) +(defvar erc-match--hide-fools-offset-bounds) + +;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) +(define-erc-module fill-wrap nil + "Fill style leveraging `visual-line-mode'. +This local module depends on the global `fill' module. To use +it, either include `fill-wrap' in `erc-modules' or set +`erc-fill-function' to `erc-fill-wrap'. You can also manually +invoke one of the minor-mode toggles. When the option +`erc-insert-timestamp-function' is `erc-insert-timestamp-right' +or `erc-insert-timestamp-left-and-right', it shows timestamps in +the right margin." + ((let (msg) + (unless erc-fill-mode + (unless (memq 'fill erc-modules) + (setq msg + ;; FIXME use `erc-button--display-error-notice-with-keys' + ;; when bug#60933 is ready. + (concat "Enabling default global module `fill' needed by lo= cal" + " module `fill-wrap'. This will impact \C-]all\C-]= ERC" + " sessions. Add `fill' to `erc-modules' to avoid t= his" + " warning. See Info:\"(erc) Modules\" for more."))) + (erc-fill-mode +1)) + ;; Set local value of user option (can we avoid this somehow?) + (unless (eq erc-fill-function #'erc-fill-wrap) + (setq-local erc-fill-function #'erc-fill-wrap)) + (when-let* ((vars (or erc--server-reconnecting erc--target-priors)) + ((alist-get 'erc-fill-wrap-mode vars))) + (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-= keys + vars) + erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars))) + (when (or erc-stamp-mode (memq 'stamp erc-modules)) + (erc-stamp--display-margin-mode +1)) + (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules)) + (require 'erc-match) + (setq erc-match--hide-fools-offset-bounds t)) + (setq erc-fill--wrap-value + (or erc-fill--wrap-value erc-fill-static-center)) + (visual-line-mode +1) + (unless (local-variable-p 'erc-fill--wrap-visual-keys) + (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys)) + (when msg + (erc-display-error-notice nil msg)))) + ((when erc-stamp--display-margin-mode + (erc-stamp--display-margin-mode -1)) + (kill-local-variable 'erc-button--add-nickname-face-function) + (kill-local-variable 'erc-fill--wrap-value) + (kill-local-variable 'erc-fill-function) + (kill-local-variable 'erc-fill--wrap-visual-keys) + (visual-line-mode -1)) + 'local) + +(defvar-local erc-fill--wrap-length-function nil + "Function to determine length of overhanging characters. +It should return an EXPR as defined by the Info node `(elisp) +Pixel Specification'. This value should represent the width of +the overhang with all faces applied, including any enclosing +brackets (which are not normally fontified) and a trailing space. +It can also return nil to tell ERC to fall back to the default +behavior of taking the length from the first \"word\". This +variable can be converted to a public one if needed by third +parties.") + +(defun erc-fill-wrap () + "Use text props to mimic the effect of `erc-fill-static'. +See `erc-fill-wrap-mode' for details." + (unless erc-fill-wrap-mode + (erc-fill-wrap-mode +1)) + (save-excursion + (goto-char (point-min)) + (let* ((len (or (and erc-fill--wrap-length-function + (funcall erc-fill--wrap-length-function)) + (progn + (skip-syntax-forward "^-") + (forward-char) + (if (and erc-fill-wrap-use-pixels + (fboundp 'buffer-text-pixel-size)) + (save-restriction + (narrow-to-region (point-min) (point)) + (list (car (buffer-text-pixel-size)))) + (- (point) (point-min))))))) + ;; Leaving out the final newline doesn't seem to affect anything. + (erc-put-text-properties (point-min) (point-max) + '(line-prefix wrap-prefix) nil + `((space :width (- erc-fill--wrap-value ,le= n)) + (space :width erc-fill--wrap-value)))))) + +;; This is an experimental helper for third-party modules. You could, +;; for example, use this to automatically resize the prefix to a +;; fraction of the window's width on some event change. Another use +;; case would be to fix lines affected by toggling a display-oriented +;; mode, like `display-line-numbers-mode'. + +(defun erc-fill--wrap-fix (&optional value) + "Re-wrap from `point-min' to `point-max'. +That is, recalculate the width of all accessible lines and reset +local prefix VALUE when non-nil." + (save-excursion + (when value + (setq erc-fill--wrap-value value)) + (let ((inhibit-field-text-motion t) + (inhibit-read-only t)) + (goto-char (point-min)) + (while (and (zerop (forward-line)) + (< (point) (min (point-max) erc-insert-marker))) + (save-restriction + (narrow-to-region (line-beginning-position) (line-end-position)) + (erc-fill-wrap)))))) + +(defun erc-fill--wrap-nudge (arg) + (when (zerop arg) + (setq arg (- erc-fill-static-center erc-fill--wrap-value))) + (cl-incf erc-fill--wrap-value arg) + arg) + +(defun erc-fill-wrap-nudge (arg) + "Adjust `erc-fill-wrap' by ARG columns. +Offer to repeat command in a manner similar to +`text-scale-adjust'. + + \\`+', \\`=3D' Increase indentation by one column + \\`-' Decrease indentation by one column + \\`0' Reset indentation to the default + \\`C-+', \\`C-=3D' Shift right margin rightward (shrink it) + by one column + \\`C--' Shift right margin leftward (grow it) by one + column + \\`C-0' Reset the right margin to the default + +Note that misalignment may occur when messages contain +decorations applied by third-party modules. See +`erc-fill--wrap-fix' for a temporary workaround." + (interactive "p") + (unless erc-fill--wrap-value + (cl-assert (not erc-fill-wrap-mode)) + (user-error "Minor mode `erc-fill-wrap-mode' disabled")) + (unless (get-buffer-window) + (user-error "Command called in an undisplayed buffer")) + (let* ((total (erc-fill--wrap-nudge arg)) + (win-ratio (/ (float (- (window-point) (window-start))) + (- (window-end nil t) (window-start))))) + (when (zerop arg) + (setq arg 1)) + (erc-compat--set-transient-map + (let ((map (make-sparse-keymap))) + (dolist (key '(?+ ?=3D ?- ?0)) + (let ((a (pcase key + (?0 0) + (?- (- (abs arg))) + (_ (abs arg))))) + (define-key map (vector (list key)) + (lambda () + (interactive) + (cl-incf total (erc-fill--wrap-nudge a)) + (recenter (round (* win-ratio (window-height)))))) + (define-key map (vector (list 'control key)) + (lambda () + (interactive) + (erc-stamp--adjust-right-margin (- a)) + (recenter (round (* win-ratio (window-height)))))= ))) + map) + t + (lambda () + (message "Fill prefix: %d (%+d col%s)" + erc-fill--wrap-value total (if (> (abs total) 1) "s" ""))) + "Use %k for further adjustment" + 1) + (recenter (round (* win-ratio (window-height)))))) + (defun erc-fill-regarding-timestamp () "Fills a text such that messages start at column `erc-fill-static-center= '." (fill-region (point-min) (point-max) t t) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests= .el new file mode 100644 index 00000000000..a254d5bbc73 --- /dev/null +++ b/test/lisp/erc/erc-fill-tests.el @@ -0,0 +1,324 @@ +;;; erc-fill-tests.el --- Tests for erc-fill -*- lexical-binding:t -*- + +;; Copyright (C) 2023 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 . + +;;; Commentary: + +;; FIXME these fixtures (and tests) are now largely useless. Due to +;; the author's ignorance regarding display properties, the "space" +;; specs of prefix props on different lines didn't initially leverage +;; a common variable (`erc-fill--wrap-value'), so the column twiddling +;; was more laborious. See decades-old comment above +;; calc_pixel_width_or_height in in xdisp.c for examples. +;; +;; TODO maybe use erts files instead of own snapshots. + +;;; Code: +(require 'ert-x) +(require 'erc-fill) + +(defvar erc-fill-tests--buffers nil) + +(defun erc-fill-tests--wrap-populate (test) + (cl-letf (((symbol-function 'erc-stamp--current-time) + (lambda () '(0 1)))) + (let ((proc (start-process "sleep" (current-buffer) "sleep" "1")) + (erc-stamp--tz t) + (id (erc-networks--id-create 'foonet)) + (erc-insert-modify-hook '(erc-fill erc-add-timestamp)) + (erc-server-users (make-hash-table :test 'equal)) + (erc-fill-function 'erc-fill-wrap) + (pre-command-hook pre-command-hook) + (erc-modules '(fill stamp)) + (msg "Hello World") + (inhibit-message noninteractive) + erc-insert-post-hook + extended-command-history + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (when (bound-and-true-p erc-button-mode) + (push 'erc-button-add-buttons erc-insert-modify-hook)) + (erc-mode) + (setq erc-server-process proc erc-networks--id id) + (set-process-query-on-exit-flag erc-server-process nil) + + (with-current-buffer (get-buffer-create "#chan") + (erc-mode) + (erc-munge-invisibility-spec) + (setq erc-server-process proc + erc-networks--id id + erc-channel-users (make-hash-table :test 'equal) + erc--target (erc--target-from-string "#chan") + erc-default-recipients (list "#chan")) + (erc--initialize-markers (point) nil) + + (erc-update-channel-member + "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil= t) + + (erc-update-channel-member + "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t) + + (setq msg "This server is in debug mode and is logging all user I/= O.\ + If you do not wish for everything you send to be readable\ + by the server owner(s), please disconnect.") + (erc-display-message nil 'notice (current-buffer) msg) + + (setq msg "bob: come, you are a tedious fool: to the purpose.\ + What was done to Elbow's wife, that he hath cause to complain of?\ + Come me to what was done to her.") + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage "alice" msg nil t)) + + ;; Introduce an artificial gap in properties `line-prefix' and + ;; `wrap-prefix' and later ensure they're not incremented twice. + (save-excursion + (forward-line -1) + (search-forward "? ") + (remove-text-properties (1- (point)) (point) + '(line-prefix t wrap-prefix t))) + + (setq msg "alice: Either your unparagoned mistress is dead,\ + or she's outprized by a trifle.") + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage "bob" msg nil t)) + + (let ((original-window-buffer (window-buffer (selected-window)))) + (set-window-buffer (selected-window) (current-buffer)) + ;; Defend against non-local exits from `ert-skip' + (unwind-protect + (funcall test) + (set-window-buffer (selected-window) original-window-buffer) + (when noninteractive + (while-let ((buf (pop erc-fill-tests--buffers))) + (kill-buffer buf)) + (kill-buffer)))))))) + +(defun erc-fill-tests--wrap-check-props (speaker) + ;; Prefix props are applied properly and faces are accounted + ;; for when determining widths. + (should (search-forward speaker nil t)) + (should (get-text-property (pos-bol) 'line-prefix)) + (should (get-text-property (pos-eol) 'line-prefix)) + (should (equal (get-text-property (pos-bol) 'wrap-prefix) + '(space :width erc-fill--wrap-value))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width erc-fill--wrap-value))) + + ;; The last elt in the `:width' value is a singleton (NUM) when + ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the + ;; prod rules table under (info "(elisp) Pixel Specification"). + (should (pcase (get-text-property (point) 'line-prefix) + ((and (guard (fboundp 'string-pixel-width)) + `(space :width (- erc-fill--wrap-value (,w)))) + (=3D w (string-pixel-width speaker))) + (`(space :width (- erc-fill--wrap-value ,w)) + (=3D w (length speaker)))))) + +(defun erc-fill-tests--wrap-check-prefixes () + (save-excursion + (goto-char (point-min)) + (erc-fill-tests--wrap-check-props "*** ") + (erc-fill-tests--wrap-check-props " ") + ;; Ensure the loop is not visited twice due to the gap. + (erc-fill-tests--wrap-check-props " "))) + +;; Set this variable to t to generate new snapshots after carefully +;; reviewing the output of each. +(defvar erc-fill-tests--save-p nil) + +(defun erc-fill-tests--compare (name) + (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)= )) + (expect-file (file-name-with-extension (expand-file-name name dir) + "eld")) + (erc--own-property-names + (seq-difference `(erc-timestamp font-lock-face + ,@erc--own-property-names) + '(display wrap-prefix line-prefix) + #'eq)) + (print-circle t) + (print-escape-newlines t) + (print-escape-nonascii t) + (got (erc--remove-text-properties + (buffer-substring (point-min) erc-insert-marker))) + (repr (string-replace "erc-fill--wrap-value" + (number-to-string erc-fill--wrap-value) + (prin1-to-string got)))) + (with-current-buffer (generate-new-buffer name) + (push name erc-fill-tests--buffers) + (with-silent-modifications + (insert (setq got (read repr)))) + (erc-mode)) + (if erc-fill-tests--save-p + (with-temp-file expect-file + (insert repr)) + (with-temp-buffer + (insert-file-contents-literally expect-file) + (should (equal got (read (current-buffer)))))))) + +(ert-deftest erc-fill-wrap--monospace () + :tags '(:unstable) + + (erc-fill-tests--wrap-populate + + (lambda () + (set-window-buffer (selected-window) (current-buffer)) + (should (=3D erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill-tests--compare "monospace-01-start") + + (ert-info ("Shift right by one (plus)") + (ert-with-message-capture messages + (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +")) + (should (string-match (rx "for further adjustment") messages))) + (should (=3D erc-fill--wrap-value 29)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill-tests--compare "monospace-02-right")) + + (ert-info ("Shift left by five") + (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----")) + (should (=3D erc-fill--wrap-value 25)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill-tests--compare "monospace-03-left")) + + (ert-info ("Reset") + (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0")) + (should (=3D erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill-tests--compare "monospace-04-reset"))))) + +(ert-deftest erc-fill-wrap--variable-pitch () + :tags '(:unstable) + (unless (and (fboundp 'string-pixel-width) + (not noninteractive) + (display-graphic-p)) + (ert-skip "Test needs interactive graphical Emacs")) + + (with-selected-frame (make-frame '((name . "other"))) + (set-face-attribute 'default (selected-frame) + :family "Sans Serif" + :foundry 'unspecified + :font 'unspecified) + + (erc-fill-tests--wrap-populate + (lambda () + (should (=3D erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill--wrap-nudge 2) + (should (=3D erc-fill--wrap-value 29)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill--wrap-nudge -6) + (should (=3D erc-fill--wrap-value 25)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill--wrap-nudge 0) + (should (=3D erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes) + + ;; FIXME get rid of this "void variable `erc--results-ewoc'" + ;; error, which seems related to operating in a non-default + ;; frame. + ;; + ;; As a kludge, checking if point made it to the prompt can + ;; serve as visual confirmation that the test passed. + (goto-char (point-max)))))) + +(ert-deftest erc-fill-wrap-visual-keys--body () + :tags '(:unstable) + (erc-fill-tests--wrap-populate + + (lambda () + (set-window-buffer (selected-window) (current-buffer)) + (ert-info ("Value: non-input") + (should (eq erc-fill--wrap-visual-keys 'non-input)) + (goto-char (point-min)) + (should (search-forward "that he hath" nil t)) + (execute-kbd-macro "\C-a") + (should-not (looking-at (rx " "))) + (execute-kbd-macro "\C-e") + (should (search-backward "tedious fool" nil t)) + (should-not (looking-back "done to her\\.")) + (forward-char) + (execute-kbd-macro "\C-e") + (should (search-forward "done to her." nil t))) + + (ert-info ("Value: nil") + (execute-kbd-macro "\C-ca") + (should-not erc-fill--wrap-visual-keys) + (goto-char (point-min)) + (should (search-forward "in debug mode" nil t)) + (execute-kbd-macro "\C-a") + (should (looking-at (rx "*** "))) + (execute-kbd-macro "\C-e") + (should (eql ?\] (char-before (point))))) + + (ert-info ("Value: t") + (execute-kbd-macro "\C-ca") + (should (eq erc-fill--wrap-visual-keys t)) + (goto-char (point-min)) + (should (search-forward "that he hath" nil t)) + (execute-kbd-macro "\C-a") + (should-not (looking-at (rx " "))) + (should (search-backward "tedious fool" nil t)) + (execute-kbd-macro "\C-e") + (should-not (looking-back (rx "done to her\\."))) + (should (search-forward "done to her." nil t)) + (execute-kbd-macro "\C-a") + (should-not (looking-at (rx " "))))))) + +(ert-deftest erc-fill-wrap-visual-keys--prompt () + :tags '(:unstable) + (erc-fill-tests--wrap-populate + + (lambda () + (set-window-buffer (selected-window) (current-buffer)) + (goto-char erc-input-marker) + (insert "This buffer is for text that is not saved, and for Lisp " + "evaluation. To create a file, visit it with C-x C-f and " + "enter text in its buffer.") + + (ert-info ("Value: non-input") + (should (eq erc-fill--wrap-visual-keys 'non-input)) + (execute-kbd-macro "\C-a") + (should (looking-at "This buffer")) + (execute-kbd-macro "\C-e") + (should (looking-back "its buffer\\.")) + (execute-kbd-macro "\C-a") + (execute-kbd-macro "\C-k") + (should (eobp))) + + (ert-info ("Value: nil") ; same + (execute-kbd-macro "\C-ca") + (should-not erc-fill--wrap-visual-keys) + (execute-kbd-macro "\C-y") + (should (looking-back "its buffer\\.")) + (execute-kbd-macro "\C-a") + (should (looking-at "This buffer")) + (execute-kbd-macro "\C-k") + (should (eobp))) + + (ert-info ("Value: non-input") + (execute-kbd-macro "\C-ca") + (should (eq erc-fill--wrap-visual-keys t)) + (execute-kbd-macro "\C-y") + (execute-kbd-macro "\C-a") + (should-not (looking-at "This buffer")) + (execute-kbd-macro "\C-p") + (should-not (looking-back "its buffer\\.")) + (should (search-forward "its buffer." nil t)) + (should (search-backward "ERC> " nil t)) + (execute-kbd-macro "\C-a"))))) + +;;; erc-fill-tests.el ends here diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld = b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld new file mode 100644 index 00000000000..8262c5056f4 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is loggin= g all user I/O. If you do not wish for everything you send to be readable b= y the server owner(s), please disconnect.[00:00]\n bob: come, you ar= e a tedious fool: to the purpose. What was done to Elbow's wife, that he ha= th cause to complain of? Come me to what was done to her.\n alice: Eit= her your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2= 1 183 (wrap-prefix #2=3D(space :width 27) line-prefix #3=3D(space :width (-= 27 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=3D((margin r= ight-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp = invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-pre= fix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=3D(space := width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-= prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 3= 49 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #= 5=3D(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 35= 3 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefi= x #5#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld = b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld new file mode 100644 index 00000000000..3f5f344cc64 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is loggin= g all user I/O. If you do not wish for everything you send to be readable b= y the server owner(s), please disconnect.[00:00]\n bob: come, you ar= e a tedious fool: to the purpose. What was done to Elbow's wife, that he ha= th cause to complain of? Come me to what was done to her.\n alice: Eit= her your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2= 1 183 (wrap-prefix #2=3D(space :width 29) line-prefix #3=3D(space :width (-= 29 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=3D((margin r= ight-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp = invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-pre= fix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=3D(space := width (- 29 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-= prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 3= 49 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #= 5=3D(space :width (- 29 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 35= 3 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefi= x #5#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b= /test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld new file mode 100644 index 00000000000..3b215936c39 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is loggin= g all user I/O. If you do not wish for everything you send to be readable b= y the server owner(s), please disconnect.[00:00]\n bob: come, you ar= e a tedious fool: to the purpose. What was done to Elbow's wife, that he ha= th cause to complain of? Come me to what was done to her.\n alice: Eit= her your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2= 1 183 (wrap-prefix #2=3D(space :width 25) line-prefix #3=3D(space :width (-= 25 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=3D((margin r= ight-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp = invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-pre= fix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=3D(space := width (- 25 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-= prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 3= 49 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #= 5=3D(space :width (- 25 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 35= 3 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefi= x #5#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld = b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld new file mode 100644 index 00000000000..8262c5056f4 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is loggin= g all user I/O. If you do not wish for everything you send to be readable b= y the server owner(s), please disconnect.[00:00]\n bob: come, you ar= e a tedious fool: to the purpose. What was done to Elbow's wife, that he ha= th cause to complain of? Come me to what was done to her.\n alice: Eit= her your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2= 1 183 (wrap-prefix #2=3D(space :width 27) line-prefix #3=3D(space :width (-= 27 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=3D((margin r= ight-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp = invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-pre= fix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=3D(space := width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-= prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 3= 49 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #= 5=3D(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 35= 3 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefi= x #5#)) \ No newline at end of file --=20 2.39.1 --=-=-=--