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,gmane.emacs.erc.general Subject: bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode Date: Fri, 27 Jan 2023 06:31:47 -0800 Message-ID: <87a6242gmk.fsf@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="23302"; 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 Fri Jan 27 15:32:35 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 1pLPmM-0005hu-12 for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 27 Jan 2023 15:32:34 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pLPls-0004sW-EQ; Fri, 27 Jan 2023 09:32:04 -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 1pLPlr-0004s5-4i for bug-gnu-emacs@gnu.org; Fri, 27 Jan 2023 09: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 1pLPlq-0005jc-SK for bug-gnu-emacs@gnu.org; Fri, 27 Jan 2023 09:32:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pLPlq-0004sz-NL for bug-gnu-emacs@gnu.org; Fri, 27 Jan 2023 09:32:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 27 Jan 2023 14:32:02 +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.167482992118774 (code B ref 60936); Fri, 27 Jan 2023 14:32:02 +0000 Original-Received: (at 60936) by debbugs.gnu.org; 27 Jan 2023 14:32:01 +0000 Original-Received: from localhost ([127.0.0.1]:36967 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pLPlo-0004sj-QN for submit@debbugs.gnu.org; Fri, 27 Jan 2023 09:32:00 -0500 Original-Received: from mail-108-mta2.mxroute.com ([136.175.108.2]:38473) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pLPln-0004sV-Dz for 60936@debbugs.gnu.org; Fri, 27 Jan 2023 09:31:59 -0500 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta2.mxroute.com (ZoneMTA) with ESMTPSA id 185f3a45714000011e.001 for <60936@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Fri, 27 Jan 2023 14:31:51 +0000 X-Zone-Loop: fef49ba55f7bf28a49544d5f0431fdc279d528aec5fa 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=bM/P+7qko0Si+d88sEKasRmybixdIwRhFQxVl/UaYZQ=; b=Hm8pAh7i1H63e1WFyO/8iOv0Zv PJfx0jn4eUSEuUif9720D9bomVxkVJjkBbkXblebrLfkP5IH4B5SU+7DEvhtd9AzjUPQ1aKQ+g6I8 E6+8r4riF4IYstGw8bEfYW50lnke/66IHTt8R8rgKzUMQqwHzEyNGOFb7rWMd4AEUJv8wqDMy9TfS hnuGtOU/pFeJa4R4vYh2n/bWZ0t64Auli3aVKnaYPN/mGJZMlghonpKmtr9lJr0I0cIc4Lm2VhD8J GqSMECwbEA3bqJvD/3OduD9P+fjIrSEg0JEXljqf10h/nQx5jMeJ9T3bXvUqvXXnKT8NCDqXYt+MY fzNPprPw==; 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:254259 gmane.emacs.erc.general:2065 Archived-At: --=-=-= Content-Type: text/plain v4. Fix invisibility for fools and timestamps with wrapped filling. Consolidate prompt setup in `erc-open'. Deprecate some items in erc-stamp. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v3-v4.diff >From 8ff3d6905355e41bd91fd8e24577b68e762cfb0a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 27 Jan 2023 06:28:37 -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-common.el | 1 + lisp/erc/erc-fill.el | 307 ++++++++++++++++-- lisp/erc/erc-match.el | 31 +- lisp/erc/erc-stamp.el | 166 ++++++++-- lisp/erc/erc.el | 136 +++++--- test/lisp/erc/erc-fill-tests.el | 172 ++++++++++ .../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++ .../erc/erc-scenarios-base-local-modules.el | 99 ------ test/lisp/erc/erc-stamp-tests.el | 261 +++++++++++++++ test/lisp/erc/erc-tests.el | 79 ++++- 10 files changed, 1248 insertions(+), 215 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 Interdiff: diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a05f2a558f8..ecd721f2f03 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -85,8 +85,8 @@ erc-fill-function function is called. A third style resembles static filling but \"wraps\" instead of -fills, courtesy of `visual-line-mode' mode, which ERC -automatically enables when this option is `erc-fill-wrap' or +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'." @@ -96,13 +96,15 @@ erc-fill-function function)) (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. - -Also used by the `erc-fill-function' variant `erc-fill-wrap' for -its initial leading \"prefix\" width." + "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) (defcustom erc-fill-variable-maximum-indentation 17 @@ -171,65 +173,71 @@ erc-fill-variable (defvar-local erc-fill--wrap-prefix nil) (defvar-local erc-fill--wrap-value nil) -(defvar-local erc-fill--wrap-movement nil) +(defvar-local erc-fill--wrap-visual-keys nil) -(defcustom erc-fill-wrap-movement t - "Whether to override keys defined by `visual-line-mode'. -A value of `display' means to favor default `erc-mode' keys when -point is in the input area." +(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.5") ; 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.5") ; FIXME sync on release - :type '(choice boolean (const display :tag "Display area" - :doc "Use `erc-mode' keys in input area"))) + :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 (>= (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 users - ;; still need to see the message. - (pcase erc-fill--wrap-movement - ('display (if (>= (point) erc-input-marker) - (kill-line arg) - (kill-visual-line arg))) - ('t (kill-visual-line arg)) - (_ (kill-line arg)))) + ;; 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") - (pcase erc-fill--wrap-movement - ('display (if (>= (point) erc-input-marker) - (move-beginning-of-line arg) - (beginning-of-visual-line arg))) - ('t (beginning-of-visual-line arg)) - (_ (move-beginning-of-line arg))) + (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'." + "Defer to `move-end-of-line' or `end-of-visual-line'." (interactive "^p") - (pcase erc-fill--wrap-movement - ('display (if (>= (point) erc-input-marker) - (move-end-of-line arg) - (end-of-visual-line arg))) - ('t (end-of-visual-line arg)) - (_ (move-end-of-line arg)))) + (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-movement' styles ARG times. -Go from nil to t to `display' and back around, but set internal -state instead of mutating `erc-fill-wrap-movement'. When ARG is -0, reset to value of `erc-fill-wrap-movement'." + "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-movement erc-fill-wrap-movement)) + (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys)) (while (not (zerop arg)) (cl-incf arg (- (abs arg))) - (setq erc-fill--wrap-movement (pcase erc-fill--wrap-movement - ('nil t) - ('t 'display) - ('display nil)))) - (message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement)) + (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." @@ -237,16 +245,22 @@ erc-fill-wrap-mode-map " " #'erc-fill--wrap-kill-line " " #'erc-fill--wrap-end-of-line " " #'erc-fill--wrap-beginning-of-line - "C-c c" #'erc-fill-wrap-cycle-visual-movement + "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) + (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." +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) @@ -261,11 +275,15 @@ 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-movement (alist-get 'erc-fill--wrap-movement vars) + (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys + vars) erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix vars) erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars))) - (when (eq erc-timestamp-use-align-to 'margin) - (erc-timestamp--display-margin-mode +1)) + (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) ;; @@ -273,29 +291,30 @@ fill-wrap (or erc-fill--wrap-prefix (list 'space :width erc-fill--wrap-value))) (visual-line-mode +1) - (unless (local-variable-p 'erc-fill--wrap-movement) - (setq erc-fill--wrap-movement erc-fill-wrap-movement)) + (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-timestamp--display-margin-mode - (erc-timestamp--display-margin-mode -1)) + ((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-prefix) (kill-local-variable 'erc-fill--wrap-value) (kill-local-variable 'erc-fill-function) - (kill-local-variable 'erc-fill--wrap-movement) + (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 perceived nickname. -It should return an integer representing the length of the -nickname, including any enclosing brackets, or nil, to fall back -to the default behavior of taking the length from the first word.") - -(defvar erc-fill--wrap-use-pixels t) -(declare-function buffer-text-pixel-size "xdisp" - (&optional buffer-or-name window x-limit y-limit)) + "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'. @@ -309,12 +328,13 @@ erc-fill-wrap (progn (skip-syntax-forward "^-") (forward-char) - (if (and erc-fill--wrap-use-pixels + (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 ,len)) @@ -337,7 +357,7 @@ erc-fill--wrap-fix (while (and (zerop (forward-line)) (< (point) (min (point-max) erc-insert-marker))) (save-restriction - (narrow-to-region (pos-bol) (pos-eol)) + (narrow-to-region (line-beginning-position) (line-end-position)) (erc-fill-wrap)))))) (defun erc-fill--wrap-nudge (arg) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 499bcaf5724..87272f0b647 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 @@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer (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 +675,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 diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index e9592448a33..21885f3a36f 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,29 +165,43 @@ 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) '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")) + (unless (get-text-property (point-min) 'invisible) + (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) (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. @@ -232,29 +254,53 @@ erc-timestamp-use-align-to A side effect of enabling this is that there will only be one space before a right timestamp in any saved logs." :type '(choice boolean integer (const margin)) - :package-version '(ERC . "5.4.1")) ; FIXME update when merging - -;; If people want to use this directly, we can offer an option to set -;; the margin's width. -(define-minor-mode erc-timestamp--display-margin-mode - "Internal minor mode for built-in modules integrating with `stamp'." + :package-version '(ERC . "5.5")) ; 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.5") ; 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))) + +;; 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-let ((erc-timestamp--display-margin-mode) - (width (if erc-timestamp-last-inserted-right - (length erc-timestamp-last-inserted-right) - (1+ (length (erc-format-timestamp - (current-time) - erc-timestamp-format-right)))))) - (progn + (if erc-stamp--display-margin-mode + (let ((width (or erc-stamp-right-margin-width + (1+ (string-width (or erc-timestamp-last-inserted + (erc-format-timestamp + (current-time) + erc-timestamp-format))))))) (setq right-margin-width width right-fringe-width 0) - (unless noninteractive - (set-window-margins nil left-margin-width width) - (set-window-fringes nil left-fringe-width 0))) + (set-window-margins nil left-margin-width width) + (set-window-fringes nil left-fringe-width 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) - (unless noninteractive - (set-window-margins nil nil) - (set-window-fringes nil nil)))) + (kill-local-variable 'right-fringe-width) + (set-window-margins left-margin-width nil) + (set-window-fringes left-fringe-width nil))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." @@ -365,14 +411,19 @@ erc-insert-timestamp-right (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) -(defun erc-insert-timestamp-left-and-right (_string) - "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)) @@ -400,8 +451,9 @@ erc-format-timestamp ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible - (not erc-hide-timestamps) ; bug#11706 - (erc-put-text-property 0 (length ts) 'cursor-intangible t ts)) + ;; (not erc-hide-timestamps) ; bug#11706 + (erc-put-text-property 0 (1- (length ts)) + 'cursor-intangible t ts)) ts) "")) @@ -450,11 +502,15 @@ 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)) + (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/lisp/erc/erc.el b/lisp/erc/erc.el index 4bc9fc20f8a..6b3d0b4af2f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1966,6 +1966,45 @@ 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 + ;; 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'. + (set-marker erc-input-marker + (next-single-property-change (point) 'erc-prompt nil + (point-max))) + (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 +2038,12 @@ 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))))))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) @@ -2020,21 +2061,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 +2107,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))) @@ -2867,6 +2880,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) + (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)) @@ -4244,6 +4260,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. @@ -5667,7 +5707,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'. @@ -5677,14 +5717,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). @@ -7278,10 +7313,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." @@ -7301,6 +7337,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'. diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index cf243ef43c7..77d553bc3a2 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -36,6 +36,7 @@ erc-fill-tests--wrap-populate (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) @@ -63,13 +64,13 @@ erc-fill-tests--wrap-populate (erc-display-message nil nil (current-buffer) - (erc--format-privmsg "alice" msg nil t nil)) + (erc-format-privmessage "alice" msg nil 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-privmsg "bob" msg nil t nil)) + (erc-format-privmessage "bob" msg nil t)) (funcall test) (when noninteractive @@ -92,9 +93,15 @@ erc-fill-wrap--monospace '(space :width 27))) (should (equal (get-text-property (pos-eol) 'wrap-prefix) '(space :width 27))) + ;; 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) - (`(space :width (- 27 (,w))) - (should (= w (string-pixel-width " ")))))) + ((and (guard (fboundp 'string-pixel-width)) + `(space :width (- 27 (,w)))) + (= w (string-pixel-width " "))) + (`(space :width (- 27 ,w)) + (= w (length " "))))) (erc-fill--wrap-nudge 2) @@ -106,12 +113,17 @@ erc-fill-wrap--monospace (should (equal (get-text-property (pos-eol) 'wrap-prefix) '(space :width 29))) (should (pcase (get-text-property (point) 'line-prefix) - (`(space :width (- 29 (,w))) - (should (= w (string-pixel-width " "))))))))) + ((and (guard (fboundp 'string-pixel-width)) + `(space :width (- 29 (,w)))) + (= w (string-pixel-width " "))) + (`(space :width (- 29 ,w)) + (= w (length " ")))))))) (ert-deftest erc-fill-wrap--variable-pitch () :tags '(:unstable) - (unless (and (not noninteractive) (display-graphic-p)) + (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"))) @@ -124,8 +136,6 @@ erc-fill-wrap--variable-pitch (lambda () - ;; Prefix props are applied properly and faces are accounted - ;; for when determining widths. (goto-char (point-min)) (should (search-forward " w (string-pixel-width " ")))))) + (> w (string-pixel-width " "))))) (erc-fill--wrap-nudge 2) @@ -149,7 +159,7 @@ erc-fill-wrap--variable-pitch '(space :width 29))) (should (pcase (get-text-property (point) 'line-prefix) (`(space :width (- 29 (,w))) - (should (> w (string-pixel-width " ")))))) + (> w (string-pixel-width " "))))) ;; FIXME figure out how to get rid of this "void variable ;; `erc--results-ewoc'" error, which seems related to operating 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 916d105779a..990c971b4cd 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -81,105 +81,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-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 4994feefd4e..69523274812 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -20,7 +20,7 @@ ;;; Commentary: ;;; Code: -(require 'ert) +(require 'ert-x) (require 'erc-stamp) (require 'erc-goodies) ; for `erc-make-read-only' @@ -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 ?\[ (char-after (1+ (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,9 @@ 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 () @@ -146,7 +146,7 @@ erc-timestamp-use-align-to--integer (ert-deftest erc-timestamp-use-align-to--margin () (erc-stamp-tests--insert-right (lambda () - (erc-timestamp--display-margin-mode +1) + (erc-stamp--display-margin-mode +1) (ert-info ("margin, normal") (let ((erc-timestamp-use-align-to 'margin)) @@ -155,7 +155,7 @@ erc-timestamp-use-align-to--margin (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)) + (should (search-forward "msg one[" nil t)) ;; Field covers stamp alone (should (eql ?e (char-before (field-beginning (point))))) ;; Vanity props extended @@ -170,9 +170,92 @@ erc-timestamp-use-align-to--margin (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)) + (should (search-forward "oooo[" nil t)) ;; Field starts at leading space. - (should (eql ?\s (char-after (field-beginning (point))))) + (should (eql ?\[ (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) +;; This concerns the partial reversal of 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 irreversible, which at least one user has complained +;; about. Turning off `cursor-intangible-mode' does do the trick, but +;; a better solution seems to be 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 works +;; whether `erc-hide-timestamps' is enabled or not. +;; +;; 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 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=0001-5.6-Refactor-marker-initialization-in-erc-open.patch >From 4ab7539fa3f6b44e645b004438c6256feee3a5b2 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. --- lisp/erc/erc.el | 79 ++++--- .../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, 331 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 ff1820cfaf2..363fe30ee58 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1966,6 +1966,45 @@ 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 + ;; 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'. + (set-marker erc-input-marker + (next-single-property-change (point) 'erc-prompt nil + (point-max))) + (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 +2038,12 @@ 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))))))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) @@ -2020,21 +2061,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 +2107,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 916d105779a..990c971b4cd 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -81,105 +81,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 456f765ec19ecb7421093a887bdb22afac5ec631 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 TODO: mention adjustment in ERC-NEWS for 5.6. * 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. --- 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 363fe30ee58..6b3d0b4af2f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2880,7 +2880,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)) @@ -4258,6 +4260,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. @@ -4309,7 +4335,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)) @@ -5681,7 +5707,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'. @@ -5691,14 +5717,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). @@ -7292,10 +7313,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." @@ -7315,6 +7337,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 9172c82d0e896d4129dd0c83624d282045c52c21 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-format-timestamp): Don't omit the `cursor-intangible' property when `erc-hide-timestamps' is non-nil. This reverts the changes from bug#11706. (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. --- lisp/erc/erc-stamp.el | 19 +-- test/lisp/erc/erc-stamp-tests.el | 203 +++++++++++++++++++++++++++++++ 2 files changed, 215 insertions(+), 7 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..bf1b0c6952c 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. @@ -350,8 +350,9 @@ erc-format-timestamp ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible - (not erc-hide-timestamps) ; bug#11706 - (erc-put-text-property 0 (length ts) 'cursor-intangible t ts)) + ;; (not erc-hide-timestamps) ; bug#11706 + (erc-put-text-property 0 (1- (length ts)) + 'cursor-intangible t ts)) ts) "")) @@ -400,11 +401,15 @@ 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)) + (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..c8e5d75d77d --- /dev/null +++ b/test/lisp/erc/erc-stamp-tests.el @@ -0,0 +1,203 @@ +;;; 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 the partial reversal of 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 irreversible, which at least one user has complained +;; about. Turning off `cursor-intangible-mode' does do the trick, but +;; a better solution seems to be 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 works +;; whether `erc-hide-timestamps' is enabled or not. +;; +;; 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 3671227a2be6ac134279cd383bc18e952c196ef0 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. --- lisp/erc/erc-stamp.el | 36 +++++++++++++++++++++++++++++------- 1 file changed, 29 insertions(+), 7 deletions(-) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index bf1b0c6952c..459d022338a 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) -- 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 65833116b95cf7d21a3ed655387c28277d3f3e3a 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. --- lisp/erc/erc-stamp.el | 111 ++++++++++++++++++++++++++----- test/lisp/erc/erc-stamp-tests.el | 70 +++++++++++++++++-- 2 files changed, 159 insertions(+), 22 deletions(-) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 459d022338a..21885f3a36f 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -239,14 +239,68 @@ 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. +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. + A side effect of enabling this is that there will only be one space before a right timestamp in any saved logs." - :type 'boolean) + :type '(choice boolean integer (const margin)) + :package-version '(ERC . "5.5")) ; 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.5") ; 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))) + +;; 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 + (let ((width (or erc-stamp-right-margin-width + (1+ (string-width (or erc-timestamp-last-inserted + (erc-format-timestamp + (current-time) + erc-timestamp-format))))))) + (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) + (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 left-margin-width nil) + (set-window-fringes left-fringe-width nil))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." @@ -265,6 +319,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 +330,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 +383,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 c8e5d75d77d..69523274812 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 leading space. + (should (eql ?\[ (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) ;; This concerns the partial reversal of changes resulting from: -- 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 23a185750d8e246dc517bc3ad0a11e491f2be2ef 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. --- 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 563bd525a913e98efca9ce1e50b07924f4c1b689 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. --- lisp/erc/erc-match.el | 31 +++++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 499bcaf5724..87272f0b647 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 @@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer (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 +675,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 >From 8ff3d6905355e41bd91fd8e24577b68e762cfb0a 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-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-mode, erc-fill--wrap-prefix, erc-fill--wrap-value, erc-fill--wrap-movement): New minor mode and variables to support it. (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): 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. --- lisp/erc/erc-common.el | 1 + lisp/erc/erc-fill.el | 273 +++++++++++++++++++++++++++++++- test/lisp/erc/erc-fill-tests.el | 172 ++++++++++++++++++++ 3 files changed, 441 insertions(+), 5 deletions(-) create mode 100644 test/lisp/erc/erc-fill-tests.el diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 994555acecf..aae8280baa9 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -95,6 +95,7 @@ erc--features-to-modules (erc-join autojoin) (erc-page page ctcp-page) (erc-sound sound ctcp-sound) + (erc-fill fill-wrap) (erc-stamp stamp timestamp) (erc-services services nickserv)) "Migration alist mapping a library feature to module names. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index caf401bf222..ecd721f2f03 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. +;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops +;; support for Emacs 27. + ;;; Code: (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)) (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) (defcustom erc-fill-variable-maximum-indentation 17 @@ -155,6 +171,253 @@ erc-fill-variable (erc-fill-regarding-timestamp)))) (erc-restore-text-properties))) +(defvar-local erc-fill--wrap-prefix nil) +(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.5") ; 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.5") ; 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 (>= (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) + +(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 + (concat "WARNING: enabling default global module `fill' needed " + " by local module `fill-wrap'. This will impact all" + " ERC sessions. Add `fill' to `erc-modules' to avoid " + " this 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-prefix (alist-get 'erc-fill--wrap-prefix 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) + ;; + erc-fill--wrap-prefix + (or erc-fill--wrap-prefix + (list 'space :width erc-fill--wrap-value))) + (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-prefix) + (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 ,len)) + ,erc-fill--wrap-prefix))))) + +;; 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. + +(defun erc-fill--wrap-fix (&optional value) + "Re-wrap from `point-min' to `point-max'. +Reset prefix to VALUE, when given." + (save-excursion + (when value + (setq erc-fill--wrap-value value + erc-fill--wrap-prefix (list 'space :width 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) + (save-excursion + (save-restriction + (widen) + (let ((inhibit-field-text-motion t) + (inhibit-read-only t) ; necessary? + (p (goto-char (point-min)))) + (when (zerop arg) + (setq arg (- erc-fill-static-center erc-fill--wrap-value))) + (cl-incf (caddr erc-fill--wrap-prefix) arg) + (cl-incf erc-fill--wrap-value arg) + (while (setq p (next-single-property-change p 'line-prefix)) + (when-let ((v (get-text-property p 'line-prefix))) + (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len)) + (when-let + ((e (text-property-not-all p (point-max) 'line-prefix v))) + (goto-char e))))))) + 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'. Note that misalignment may occur when +messages contain decorations applied by third-party modules. +See `erc-fill--wrap-fix' for a workaround." + (interactive "p") + (unless erc-fill--wrap-value + (cl-assert (not erc-fill-wrap-mode)) + (user-error "Minor mode `erc-fill-wrap-mode' disabled")) + (let ((total (erc-fill--wrap-nudge arg)) + (start (window-start)) + (marker (set-marker (make-marker) (point)))) + (when (zerop arg) + (setq arg 1)) + (set-transient-map + (let ((map (make-sparse-keymap))) + (dolist (key '(?+ ?= ?- ?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)) + (set-window-start (selected-window) start) + (goto-char marker))))) + map) + t + (lambda () + (set-marker marker nil) + (message "Fill prefix: %d (%+d col%s)" + erc-fill--wrap-value total (if (> (abs total) 1) "s" ""))) + "Use %k for further adjustment" + 1) + (goto-char marker) + (set-window-start (selected-window) start))) + (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..77d553bc3a2 --- /dev/null +++ b/test/lisp/erc/erc-fill-tests.el @@ -0,0 +1,172 @@ +;;; 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: + +;;; Code: +(require 'ert-x) +(require 'erc-fill) + +(defun erc-fill-tests--wrap-populate (test) + (let ((proc (start-process "sleep" (current-buffer) "sleep" "1")) + (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) + (erc-modules '(fill stamp)) + (msg "Hello World") + 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)) + (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)) + + (funcall test) + (when noninteractive + (kill-buffer))))) + +(ert-deftest erc-fill-wrap--monospace () + :tags '(:unstable) + + (erc-fill-tests--wrap-populate + + (lambda () + + ;; Prefix props are applied properly and faces are accounted + ;; for when determining widths. + (goto-char (point-min)) + (should (search-forward " "))) + (`(space :width (- 27 ,w)) + (= w (length " "))))) + + (erc-fill--wrap-nudge 2) + + (should (search-forward " "))) + (`(space :width (- 29 ,w)) + (= w (length " ")))))))) + +(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 () + + (goto-char (point-min)) + (should (search-forward " w (string-pixel-width " "))))) + + (erc-fill--wrap-nudge 2) + + (should (search-forward " w (string-pixel-width " "))))) + + ;; FIXME figure out how to get rid of this "void variable + ;; `erc--results-ewoc'" error, which seems related to operating + ;; in this second 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)))))) + +;;; erc-fill-tests.el ends here -- 2.39.1 --=-=-=--