From unknown Mon Aug 18 11:18:50 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#64301 <64301@debbugs.gnu.org> To: bug#64301 <64301@debbugs.gnu.org> Subject: Status: 30.0.50; ERC 5.6: Make speaker labels easier to work with Reply-To: bug#64301 <64301@debbugs.gnu.org> Date: Mon, 18 Aug 2025 18:18:50 +0000 retitle 64301 30.0.50; ERC 5.6: Make speaker labels easier to work with reassign 64301 emacs submitter 64301 "J.P." severity 64301 normal tag 64301 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 26 09:50:38 2023 Received: (at submit) by debbugs.gnu.org; 26 Jun 2023 13:50:38 +0000 Received: from localhost ([127.0.0.1]:44897 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qDmc1-0000NK-LM for submit@debbugs.gnu.org; Mon, 26 Jun 2023 09:50:38 -0400 Received: from lists.gnu.org ([209.51.188.17]:34010) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qDmbz-0000NC-Cv for submit@debbugs.gnu.org; Mon, 26 Jun 2023 09:50:36 -0400 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 1qDmbz-0003ob-3R for bug-gnu-emacs@gnu.org; Mon, 26 Jun 2023 09:50:35 -0400 Received: from mail-108-mta89.mxroute.com ([136.175.108.89]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qDmbw-0005Wx-IJ for bug-gnu-emacs@gnu.org; Mon, 26 Jun 2023 09:50:34 -0400 Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta89.mxroute.com (ZoneMTA) with ESMTPSA id 188f7f83979000ca8f.001 for (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Mon, 26 Jun 2023 13:50:20 +0000 X-Zone-Loop: d392d2e1f0d02c430466bec04904cc81279d031a3e13 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:Subject:To:From:Sender: Reply-To:Cc:Content-Transfer-Encoding:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=WSEuxsE/dYf81h7UdkcpVJLpcT3LUAaX/af2wIQ0zbc=; b=jndGbFoFx4l/A1FdLZAzZOOuwP eB5wnS4wmJciUIkQ6LpHAK8qF581NGlPh5IbGFY+twUcmLHuutO6BHu9jStcka93J7XhOgoVhzzOP UMZ+uTUCrZsrzntyb9VOci2EmxiTdUucyDB2M9U9tWNwS++Nf8X1oLqbv0XCx7+472hQfRP02VncN /OTnVUouvE5bAC+YhNhuHF7P+nJSWRLOI8PdMvGOo/qDQXN+Xq9qbHiH6BXsvMjfU1H31hU0Rgl3w PvJ1AKHWEa6lLJPWGsgnj20yY0PCIOO+rTd/lMZQx6uCEw0P+pkR8GCLgFMlBYhQOZvMinrHmnKmG ERqbMp5Q==; From: "J.P." To: bug-gnu-emacs@gnu.org Subject: 30.0.50; ERC 5.6: Make speaker labels easier to work with X-Debbugs-CC: emacs-erc@gnu.org Date: Mon, 26 Jun 2023 06:50:17 -0700 Message-ID: <87bkh21gfa.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Authenticated-Id: masked@neverwas.me Received-SPF: pass client-ip=136.175.108.89; envelope-from=jp@neverwas.me; helo=mail-108-mta89.mxroute.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) --=-=-= Content-Type: text/plain Tags: patch Currently, modules that operate on inserted messages use heuristics, like delimiting characters and face properties, to find the bounds of the "speaker label" (my term for the stylized nick prepended to the start of every displayed message). I think it's worth making these boundaries easier and more reliable to detect. At a bare minimum, having a specific text property or field spanning the nick portion should provide enough information to identify other regions of interest preceding the actual message (in most cases). The attached patch attempts to do this. However, it may be useful in the long run to provide an internal interface for influencing how this happens. Use cases include hiding or altering bookend styling (currently hard-coded to angle brackets) and using alternate display names for nicks themselves. One approach for implementing something like this was proposed in an iteration of the change set from bug#60933 [1] but was ultimately removed prior to installation. The attached patch also fixes a somewhat related bug discovered by incal. From emacs -Q: - Set `erc-format-nick-function' to `erc-format-@nick' - Customize `erc-nick-prefix-face' to make it easily noticeable - Connect to some network - Create a new dummy channel and say something - Notice that your speaker nick is decorated with the status prefix "@" but that it lacks the face changes you made earlier The only thing giving me pause about this bug is that there's no (surviving) mention of it in the usual places, and the offending code has been around since at least 2006. So, it's possible we're still missing something here. Thanks. [1] https://lists.gnu.org/archive/html/emacs-erc/2023-04/msg00018.html See `erc--format-speaker-functions' in the third patch 0003-5.6-Use-getter-for-finding-users-in-erc-server-PRIVM.patch. In GNU Emacs 30.0.50 (build 4, x86_64-pc-linux-gnu, GTK+ Version 3.24.37, cairo version 1.17.6) of 2023-06-25 built on localhost Repository revision: a6de0d22e4209e2c75dbf1e8c005dfc9d8c64cce Repository branch: master Windowing system distributor 'The X.Org Foundation', version 11.0.12014000 System Description: Fedora Linux 37 (Workstation Edition) Configured using: 'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs 'CFLAGS=-O0 -g3' PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig' Configured features: ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB Important settings: value of $LANG: en_US.UTF-8 value of $XMODIFIERS: @im=ibus locale-coding-system: utf-8-unix Major mode: Lisp Interaction Minor modes in effect: tooltip-mode: t global-eldoc-mode: t eldoc-mode: t show-paren-mode: t electric-indent-mode: t mouse-wheel-mode: t tool-bar-mode: t menu-bar-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t line-number-mode: t indent-tabs-mode: t transient-mark-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t Load-path shadows: None found. Features: (shadow sort mail-extr emacsbug message mailcap yank-media puny dired dired-loaddefs rfc822 mml mml-sec epa derived epg rfc6068 epg-config gnus-util text-property-search time-date mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils erc auth-source cl-seq eieio eieio-core cl-macs password-cache json subr-x map format-spec cl-loaddefs cl-lib erc-backend erc-networks byte-opt gv bytecomp byte-compile erc-common erc-compat erc-loaddefs rmc iso-transl tooltip cconv eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic indonesian philippine cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite emoji-zwj charscript charprop case-table epa-hook jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs theme-loaddefs faces cus-face macroexp files window text-properties overlay sha1 md5 base64 format env code-pages mule custom widget keymap hashtable-print-readable backquote threads dbusbind inotify lcms2 dynamic-setting system-font-setting font-render-setting cairo move-toolbar gtk x-toolkit xinput2 x multi-tty make-network-process emacs) Memory information: ((conses 16 64551 8809) (symbols 48 8582 0) (strings 32 23258 1697) (string-bytes 1 673861) (vectors 16 15002) (vector-slots 8 207268 8157) (floats 8 24 37) (intervals 56 231 0) (buffers 976 10)) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Don-t-clobber-erc-nick-prefix-face.patch >From 41e15143e16a842fc4ae072d28a647f25c58fdb8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 24 Jun 2023 18:33:20 -0700 Subject: [PATCH] [5.6] Don't clobber erc-nick-prefix-face * lisp/erc/erc-fill.el (erc-fill-wrap): Look for `erc-speaker' property before falling back on word at point. * lisp/erc/erc.el (erc-send-action): Ensure nickname passed to `erc-display-message' has `erc-speaker' property. (erc--own-property-names): Add `erc-speaker'. (erc-format-privmessage): Retain face applied to a leading stretch of characters in the `nick' parameter. But continue to discard any trailing faces. (erc-format-privmessage, erc-format-my-nick, erc-ctcp-query-ACTION): Add a new text property, `erc-speaker', to the nick portion of the formatted speaker label. Do this to assist modules, like `button' and `match', that re-parse speakers in inserted messages. --- lisp/erc/erc-fill.el | 10 +++++++++- lisp/erc/erc.el | 22 ++++++++++++++++------ 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 5115e45210d..acc07e7a6af 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -428,8 +428,16 @@ erc-fill-wrap (let ((len (or (and erc-fill--wrap-length-function (funcall erc-fill--wrap-length-function)) (progn + (when-let ((b (next-single-property-change + (point) 'erc-speaker nil (pos-eol))) + ((not (= (pos-eol) b))) + ;; String vals `eq' along same stretch + (e (text-property-not-all + b (pos-eol) 'erc-speaker + (get-text-property b 'erc-speaker)))) + (goto-char e)) (skip-syntax-forward "^-") - (forward-char) + (skip-syntax-forward "-") ;; Using the `invisible' property might make more ;; sense, but that would require coordination ;; with other modules, like `erc-match'. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 70adbb15b5f..c7720221115 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2724,9 +2724,11 @@ erc-send-action (let ((erc-insert-pre-hook (cons (lambda (s) ; Leave newline be. (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)) - erc-insert-pre-hook))) + erc-insert-pre-hook)) + (nick (erc-current-nick))) + (setq nick (propertize nick 'erc-speaker nick)) (erc-display-message nil 'input (current-buffer) - 'ACTION ?n (erc-current-nick) ?a str ?u "" ?h ""))) + 'ACTION ?n nick ?a str ?u "" ?h ""))) ;; Display interface @@ -4532,7 +4534,7 @@ erc-ensure-channel-name (concat "#" channel))) (defvar erc--own-property-names - '( tags erc-parsed display ; core + '( tags erc-speaker erc-parsed display ; core ;; `erc-display-prompt' rear-nonsticky erc-prompt field front-sticky read-only ;; stamp @@ -5037,11 +5039,18 @@ erc-format-privmessage (mark-e (if msgp (if privp "*" ">") "-")) (str (format "%s%s%s %s" mark-s nick mark-e msg)) (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) + (nick-prefix-face (get-text-property 0 'font-lock-face nick)) + (prefix-len (or (text-property-not-all 0 (length nick) 'font-lock-face + nick-prefix-face nick) + 0)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick (erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str) - (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'font-lock-face nick-face str) + (erc-put-text-properties (+ (length mark-s) prefix-len) + (+ (length mark-s) (length nick)) + '(font-lock-face erc-speaker) str + (list nick-face + (substring-no-properties nick prefix-len))) (erc-put-text-property (+ (length mark-s) (length nick)) (length str) 'font-lock-face msg-face str) str)) @@ -5093,7 +5102,7 @@ erc-format-my-nick (concat (propertize open 'font-lock-face 'erc-default-face) (propertize mode 'font-lock-face 'erc-my-nick-prefix-face) - (propertize nick 'font-lock-face 'erc-my-nick-face) + (propertize nick 'font-lock-face 'erc-my-nick-face 'erc-speaker nick) (propertize close 'font-lock-face 'erc-default-face))) (let ((prefix "> ")) (propertize prefix 'font-lock-face 'erc-default-face)))) @@ -5366,6 +5375,7 @@ erc-ctcp-query-ACTION (buf (or (erc-get-buffer to proc) (erc-get-buffer nick proc) (process-buffer proc)))) + (setq nick (propertize nick 'erc-speaker nick)) (erc-display-message parsed 'action buf 'ACTION ?n nick ?u login ?h host ?a s)))) -- 2.40.1 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Wed Jul 05 10:03:24 2023 Received: (at 64301) by debbugs.gnu.org; 5 Jul 2023 14:03:24 +0000 Received: from localhost ([127.0.0.1]:38751 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qH36K-0007Wq-4Q for submit@debbugs.gnu.org; Wed, 05 Jul 2023 10:03:24 -0400 Received: from mail-108-mta237.mxroute.com ([136.175.108.237]:36461) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qH36I-0007Wh-0e for 64301@debbugs.gnu.org; Wed, 05 Jul 2023 10:03:22 -0400 Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta237.mxroute.com (ZoneMTA) with ESMTPSA id 189265d5d750007ced.001 for <64301@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Wed, 05 Jul 2023 14:03:20 +0000 X-Zone-Loop: 6089260c08ec5b98865ab72ec562b04dafcc06e469a7 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=slJeX0aQ8cibU1U3Q7kZczBqXB6DdvPuMC5byYUMckU=; b=B7Yb8oof9SfgVqAgU8V/bFaj+S /XP5fHTWPXaL1HWjqgfRPoXkO9vW9uZAedTnI57fTGfz5piDDZtKoU2bUM4PyYNtKLtwc0kFb37y8 +ZCbBgiMgOQoTTEfHcCbStappc+vEwQRvjtMA9+GFEo4VdlfnkQ6GsvypRNkoYv1cCwpt7oNMbo29 kImTOuuSRoqq3c2PBP+cQy0+ErFeO1Nx4G08Vwbt/F7scAh8Si5NMk0tqq5xmm1BBcr/WHRYjG8dD iFd/BsJz9hPbzAdKdufXE24EmYDiBsuI881KyKhz0vkjextXSa9E/2bmXsBUj7kJA39Htb4uJ6w/B T0FBBSkg==; From: "J.P." To: 64301@debbugs.gnu.org Subject: Re: bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with In-Reply-To: <87bkh21gfa.fsf@neverwas.me> (J. P.'s message of "Mon, 26 Jun 2023 06:50:17 -0700") References: <87bkh21gfa.fsf@neverwas.me> Date: Wed, 05 Jul 2023 07:03:16 -0700 Message-ID: <87o7kq8nh7.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Authenticated-Id: masked@neverwas.me X-Debbugs-Envelope-To: 64301 Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" --=-=-= Content-Type: text/plain v2. Add `erc-ctcp' text property to inserted CTCP ACTION messages. Demote `erc-fill-spaced-commands' from a user option to an internal variable. Dedent action messages with module `fill-wrap'. Combine faces in `erc-display-message' when called with a list `type' arg. Have `erc-put-text-property' conditionally combine prop values instead of clobber. Apply `invisible' property to white space around stamps. This iteration includes a number of changes, the most important being one that looks severe but is largely mechanical. It concerns a bug that's been around forever and, as such, is now part of the foundation. Basically, the `type' parameter of the function `erc-display-message' determines a special handler that applies styling to a message. When the parameter is a list, the function calls each handler in turn, left to right, which clobbers existing faces instead of combines them. The net effect (in most cases) is identical to calling the function with the last member alone. Despite this, it would seem ending up with multiple, "layered" faces was the authors' original intent based on the ubiquity of call sites featuring the list variant. Authoritative intent aside, in the intervening decades, other code was written that expects the current clobbering behavior. An example of this exists in the default value of `erc-track-faces-priority-list', which contains `erc-error-face' alone rather than paired with `erc-notice-face'. There may indeed be others that will go undetected should we make this "fix," which I'm still in favor of despite the attendant risk. Though improved call-site readability is one upside, I'm more interested in the UX possibilities such layering opens up. Subtle benefits can already be seen after applying these changes, for example, in text inserted for outgoing /me commands, which now sport a combination of `erc-input-face' and `erc-action-face'. In a bid to mitigate potential breakage, at least internally, I've gone ahead and mass-replaced all instances of (erc-display-message parsed '(notice error) ...) with (erc-display-message parsed 'error ...) which amounts to 38 incisions in total. Once again, if we leave things as is, users who've customized `erc-track-faces-priority-list' won't ever see error-colored text in their mode line, which is a deal breaker. The other major change involves making time stamps more sensitive to existing invisible text by combining `stamp'-owned spec members with existing properties and by extending those propertized areas to include surrounding white space. Previously, the `stamp' module went to great lengths to avoid applying stamps to invisible messages entirely. However, this policy caused uneven output in logs with `left-handed' stamps and in formerly hidden messages mentioning designated "fools". It's true that what I'm proposing would mark a complete reversal, but it's not as drastic as it sounds. To see the effect, do something like (setq erc-insert-timestamp-function #'erc-insert-timestamp-left erc-timestamp-only-if-changed-flag nil erc-text-matched-hook '(erc-log-matches erc-hide-fools) erc-fools '("somebot")) After connecting, say something to trigger "somebot" while ensuring `erc-toggle-timestamps' still works. Then do M-: (remove-from-invisibility-spec 'erc-match) RET and notice that the revealed text has timestamps in all the right places. And if you have the `log' module enabled, notice that stamps are likewise present on all messages. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From 171dbaefbdc47154b21aa7f7e8c980958f983313 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 4 Jul 2023 23:21:25 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): [5.6] Respect existing invisibility props in erc-stamp [5.6] Simplify erc-button-add-nickname-buttons [5.6] Add text props for CTCPs and speakers in ERC [5.6] Handle composite faces better in erc-display-message etc/ERC-NEWS | 15 +++ lisp/erc/erc-backend.el | 39 +++---- lisp/erc/erc-button.el | 78 +++++++------ lisp/erc/erc-dcc.el | 16 +-- lisp/erc/erc-fill.el | 25 +++-- lisp/erc/erc-match.el | 14 +-- lisp/erc/erc-sasl.el | 8 +- lisp/erc/erc-stamp.el | 20 +++- lisp/erc/erc-track.el | 12 +- lisp/erc/erc.el | 99 +++++++++++++---- test/lisp/erc/erc-button-tests.el | 2 +- test/lisp/erc/erc-fill-tests.el | 5 +- test/lisp/erc/erc-scenarios-match.el | 160 +++++++++++++++++++++++---- 13 files changed, 347 insertions(+), 146 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5665b760ea9..40bcd934772 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -224,6 +224,21 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** 'erc-display-message' combines faces when 'type' is a list. +Users may notice that ERC now renders messages passed to the +convenience function 'erc-display-error-notice' in a combination of +'erc-error-face' and 'erc-notice-face'. This is merely a consequence +of that function being a wrapper around 'erc-display-message', which +has gotten smarter about how it treats face properties when its 'type' +parameter is a list. Originally, ERC's authors intended to display +both server-originating and ERC-generated errors in this style, but +due to various complications, that intent was never realized until +this release, and even now only partially so. Indeed, to minimize +churn, the effect has been limited to internal and usage errors. For +third-party code, the key take away is that more 'font-lock-face' +properties encountered in the wild may be combinations of faces rather +than simple ones. + *** Prompt input is split before 'erc-pre-send-functions' has a say. Hook members are now treated to input whose lines have already been adjusted to fall within the allowed length limit. For convenience, diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index f1b51f9234a..bf21ec96225 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -148,7 +148,6 @@ erc-whowas-on-nosuchnick (declare-function erc-current-time "erc" (&optional specified-time)) (declare-function erc-default-target "erc" nil) (declare-function erc-delete-default-channel "erc" (channel &optional buffer)) -(declare-function erc-display-error-notice "erc" (parsed string)) (declare-function erc-display-server-message "erc" (_proc parsed)) (declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time)) (declare-function erc-format-message "erc" (msg &rest args)) @@ -2411,47 +2410,47 @@ erc-server-322-message (when erc-whowas-on-nosuchnick (erc-log (format "cmd: WHOWAS: %s" nick/channel)) (erc-server-send (format "WHOWAS %s 1" nick/channel))) - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's401 ?n nick/channel))) (define-erc-response-handler (402) "No such server." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's402 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (403) "No such channel." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's403 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (404) "Cannot send to channel." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's404 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (405) "Can't join that many channels." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's405 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (406) "No such nick." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's406 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (412) "No text to send." nil - (erc-display-message parsed '(notice error) 'active 's412)) + (erc-display-message parsed 'error 'active 's412)) (define-erc-response-handler (421) "Unknown command." nil - (erc-display-message parsed '(notice error) 'active 's421 + (erc-display-message parsed 'error 'active 's421 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (432) "Bad nick." nil - (erc-display-message parsed '(notice error) 'active 's432 + (erc-display-message parsed 'error 'active 's432 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (433) @@ -2469,12 +2468,12 @@ erc-server-322-message (define-erc-response-handler (442) "Not on channel." nil - (erc-display-message parsed '(notice error) 'active 's442 + (erc-display-message parsed 'error 'active 's442 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (461) "Not enough parameters for command." nil - (erc-display-message parsed '(notice error) 'active 's461 + (erc-display-message parsed 'error 'active 's461 ?c (cadr (erc-response.command-args parsed)) ?m (erc-response.contents parsed))) @@ -2482,20 +2481,19 @@ erc-server-322-message "You are banned from this server." nil (setq erc-server-banned t) ;; show the server's message, as a reason might be provided - (erc-display-error-notice - parsed + (erc-display-message parsed 'error 'active (erc-response.contents parsed))) (define-erc-response-handler (474) "Banned from channel errors." nil - (erc-display-message parsed '(notice error) nil + (erc-display-message parsed 'error nil (intern (format "s%s" (erc-response.command parsed))) ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (475) "Channel key needed." nil - (erc-display-message parsed '(notice error) nil 's475 + (erc-display-message parsed 'error nil 's475 ?c (cadr (erc-response.command-args parsed))) (when erc-prompt-for-channel-key (let ((channel (cadr (erc-response.command-args parsed))) @@ -2516,7 +2514,7 @@ erc-server-322-message "You need to be a channel operator to do that." nil (let ((channel (cadr (erc-response.command-args parsed))) (message (erc-response.contents parsed))) - (erc-display-message parsed '(notice error) 'active 's482 + (erc-display-message parsed 'error 'active 's482 ?c channel ?m message))) (define-erc-response-handler (671) @@ -2551,11 +2549,8 @@ erc-server-322-message ;; 491 - No O-lines for your host ;; 501 - Unknown MODE flag ;; 502 - Cannot change mode for other users - "Generic display of server error messages. - -See `erc-display-error-notice'." nil - (erc-display-error-notice - parsed + "Display error message as given from server." nil + (erc-display-message parsed 'error 'active (intern (format "s%s" (erc-response.command parsed))))) ;; FIXME: These are yet to be implemented, they're just stubs for now diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 0c616a6026d..c30f7c10ca6 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -355,8 +355,6 @@ erc-button--nick ( cuser nil :type (or null erc-channel-user) ;; The CDR of a value from an `erc-channel-users' table. :documentation "A possibly nil `erc-channel-user'.") - ( face erc-button-face :type symbol - :documentation "Temp `erc-button-face' while buttonizing.") ( nickname-face erc-button-nickname-face :type symbol :documentation "Temp `erc-button-nickname-face' while buttonizing.") ( mouse-face erc-button-mouse-face :type symbol @@ -431,45 +429,43 @@ erc-button--phantom-users-mode (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." - (let ((form (nth 2 entry)) - (fun (nth 3 entry)) - (erc-button-buttonize-nicks (and erc-button-buttonize-nicks - erc-button--modify-nick-function)) - bounds word) - (when (and form (setq form (erc-button--extract-form form))) - (goto-char (point-min)) - (while (erc-forward-word) - (when (setq bounds (erc-bounds-of-word-at-point)) - (setq word (buffer-substring-no-properties - (car bounds) (cdr bounds))) - (let* ((erc-button-face erc-button-face) - (erc-button-mouse-face erc-button-mouse-face) - (erc-button-nickname-face erc-button-nickname-face) - (down (erc-downcase word)) - (cuser (and erc-channel-users - (gethash down erc-channel-users))) - (user (or (and cuser (car cuser)) - (and erc-server-users - (gethash down erc-server-users)) - (funcall erc-button--fallback-user-function - down word bounds))) - (data (list word))) - (when (or (not (functionp form)) - (and-let* ((user) - (obj (funcall form (make-erc-button--nick - :bounds bounds :data data - :downcased down :user user - :cuser (cdr cuser))))) - (setq bounds (erc-button--nick-bounds obj) - data (erc-button--nick-data obj) - erc-button-mouse-face - (erc-button--nick-mouse-face obj) - erc-button-nickname-face - (erc-button--nick-nickname-face obj) - erc-button-face - (erc-button--nick-face obj)))) - (erc-button-add-button (car bounds) (cdr bounds) - fun t data)))))))) + (when-let ((form (nth 2 entry)) + ;; Spoof `form' slot of default legacy `nicknames' entry + ;; so `erc-button--extract-form' sees a function value. + (form (let ((erc-button-buttonize-nicks + (and erc-button-buttonize-nicks + erc-button--modify-nick-function))) + (erc-button--extract-form form))) + (seen 0)) + (goto-char (point-min)) + (while-let + (((erc-forward-word)) + (bounds (or (and (= 1 (cl-incf seen)) (erc--get-speaker-bounds)) + (erc-bounds-of-word-at-point))) + (word (buffer-substring-no-properties (car bounds) (cdr bounds))) + (down (erc-downcase word))) + (let* ((erc-button-mouse-face erc-button-mouse-face) + (erc-button-nickname-face erc-button-nickname-face) + (cuser (and erc-channel-users (gethash down erc-channel-users))) + (user (or (and cuser (car cuser)) + (and erc-server-users (gethash down erc-server-users)) + (funcall erc-button--fallback-user-function + down word bounds))) + (data (list word))) + (when (or (not (functionp form)) + (and-let* ((user) + (obj (funcall form (make-erc-button--nick + :bounds bounds :data data + :downcased down :user user + :cuser (cdr cuser))))) + (setq erc-button-mouse-face ; might be null + (erc-button--nick-mouse-face obj) + erc-button-nickname-face ; might be null + (erc-button--nick-nickname-face obj) + data (erc-button--nick-data obj) + bounds (erc-button--nick-bounds obj)))) + (erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry) + 'nickp data)))))) (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index cc2dcc9a788..8968295a83c 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -566,7 +566,7 @@ erc-dcc-do-GET-command file)) (erc-dcc-get-file elt file proc) (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-get-cmd-aborted ?n nick ?f filename))) (t @@ -578,7 +578,7 @@ erc-dcc-do-GET-command (setq erc-dcc-list (cons (plist-put elt :turbo t) (delq elt erc-dcc-list))))) (erc-display-message - nil '(notice error) 'active + nil 'error 'active 'dcc-get-notfound ?n nick ?f filename)))) (defvar-local erc-dcc-byte-count nil) @@ -648,7 +648,7 @@ erc-dcc-do-SEND-command nil 'notice 'active 'dcc-send-offer ?n nick ?f file) (erc-dcc-send-file nick file) t) - (erc-display-message nil '(notice error) proc "File not found") t)) + (erc-display-message nil 'error proc "File not found") t)) ;;; Server message handling (i.e. messages from remote users) @@ -675,7 +675,7 @@ erc-ctcp-query-DCC (funcall handler proc query nick login host to) ;; FIXME: Send a ctcp error notice to the remote end? (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-ctcp-unknown ?q query ?n nick ?u login ?h host)))) @@ -771,7 +771,7 @@ erc-dcc-handle-ctcp-chat (;; DCC CHAT requests must be sent to you, and you alone. (not (erc-current-nick-p to)) (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-request-bogus ?r "CHAT" ?n nick ?u login ?h host)) ((string-match erc-dcc-ctcp-query-chat-regexp query) ;; We need to use let* here, since erc-dcc-member might clutter @@ -805,7 +805,7 @@ erc-dcc-handle-ctcp-chat proc)))) (t (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-malformed ?n nick ?u login ?h host ?q query))))) @@ -1053,7 +1053,7 @@ erc-dcc-get-filter ((and (> (plist-get erc-dcc-entry-data :size) 0) (> received-bytes (plist-get erc-dcc-entry-data :size))) (erc-display-message - nil '(notice error) 'active + nil 'error 'active 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) @@ -1085,7 +1085,7 @@ erc-dcc-get-sentinel (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) (let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))) (erc-display-message - nil (if done 'notice '(notice error)) erc-server-process + nil (if done 'notice 'error) erc-server-process (if done 'dcc-get-complete 'dcc-get-failed) ?v (plist-get erc-dcc-entry-data :size) ?f erc-dcc-file-name diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 35289910d0a..a65c95f1d85 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -124,11 +124,9 @@ erc-fill-line-spacing :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) number)) -(defcustom erc-fill-spaced-commands '(PRIVMSG NOTICE) +(defvar erc-fill--spaced-commands '(PRIVMSG NOTICE) "Types of messages to add space between on graphical displays. -Only considered when `erc-fill-line-spacing' is non-nil." - :package-version '(ERC . "5.6") ; FIXME sync on release - :type '(repeat (choice integer symbol))) +Only considered when `erc-fill-line-spacing' is non-nil.") (defvar-local erc-fill--function nil "Internal copy of `erc-fill-function'. @@ -153,12 +151,12 @@ erc-fill (p (point-min))) (widen) (when (or (and-let* ((cmd (get-text-property p 'erc-command))) - (memq cmd erc-fill-spaced-commands)) + (memq cmd erc-fill--spaced-commands)) (and-let* ((cmd (save-excursion (forward-line -1) (get-text-property (point) 'erc-command)))) - (memq cmd erc-fill-spaced-commands))) + (memq cmd erc-fill--spaced-commands))) (put-text-property (1- p) p 'line-spacing erc-fill-line-spacing)))))))) @@ -433,13 +431,8 @@ erc-fill-wrap (let ((len (or (and erc-fill--wrap-length-function (funcall erc-fill--wrap-length-function)) (progn - (when-let ((b (next-single-property-change - (point) 'erc-speaker nil (pos-eol))) - ((/= (pos-eol) b)) - ;; String vals `eq' along same stretch - (e (text-property-not-all - b (pos-eol) 'erc-speaker - (get-text-property b 'erc-speaker))) + (when-let ((e (erc--get-speaker-bounds)) + (b (pop e)) ((or erc-fill--wrap-action-dedent-p (not (eq (get-text-property b 'erc-ctcp) 'ACTION))))) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 2b7fff87ff0..549de4feeb8 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -657,22 +657,18 @@ erc-go-to-log-matches-buffer (defvar-local erc-match--hide-fools-offset-bounds nil) -;; FIXME this should merge with instead of overwrite existing -;; `invisible' values. (defun erc-hide-fools (match-type _nickuserhost _message) - "Hide foolish comments. -This function should be called from `erc-text-matched-hook'." + "Hide comments from designated fools." (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))))) + (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match))) + ;; Before ERC 5.6, this also used to add an `intangible' + ;; property, but the docs say it's now obsolete. + (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 482d6d901ab..dd481032e7e 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -29,6 +29,8 @@ ;; ;; This is the "networks" module. ;; +;; M-x erc-server-select provides an alternative way to connect to servers by +;; choosing networks. ;; You can use (eq (erc-network) 'Network) if you'd like to set variables or do ;; certain actions according to which network you're connected to. ;; If a network you use is not listed in `erc-networks-alist', you can put @@ -485,8 +487,6 @@ erc-server-alist (choice (integer :tag "Port number") (list :tag "Port range" integer integer))))))) -(make-obsolete-variable 'erc-server-alist - "specify `:server' with `erc-tls'." "30.1") (defcustom erc-networks-alist '((4-irc "4-irc.com") @@ -1544,9 +1544,9 @@ erc-ports-list result))))) (nreverse result))) +;;;###autoload (defun erc-server-select () "Interactively select a server to connect to using `erc-server-alist'." - (declare (obsolete erc-tls "30.1")) (interactive) (let* ((completion-ignore-case t) (net (intern diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index c6922b1b26b..73d318fd4fd 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -377,7 +377,7 @@ erc-sasl--destroy (define-erc-response-handler (902) "Handle an ERR_NICKLOCKED response." nil - (erc-display-message parsed '(notice error) 'active 's902 + (erc-display-message parsed 'error 'active 's902 ?n (car (erc-response.command-args parsed)) ?s (erc-response.contents parsed)) (erc-sasl--destroy proc)) @@ -391,19 +391,19 @@ erc-sasl--destroy (define-erc-response-handler (907) "Handle a RPL_SASLALREADY response." nil - (erc-display-message parsed '(notice error) 'active 's907 + (erc-display-message parsed 'error 'active 's907 ?s (erc-response.contents parsed))) (define-erc-response-handler (904 905 906) "Handle various SASL-related error responses." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active (intern (format "s%s" (erc-response.command parsed))) ?s (erc-response.contents parsed)) (erc-sasl--destroy proc)) (define-erc-response-handler (908) "Handle a RPL_SASLMECHS response." nil - (erc-display-message parsed '(notice error) 'active 's908 + (erc-display-message parsed 'error 'active 's908 ?m (alist-get 'mechanism erc-sasl--options) ?s (string-join (cdr (erc-response.command-args parsed)) " ")) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 5035e60a87d..2f52d78d42b 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -179,6 +179,12 @@ stamp (kill-local-variable 'erc-timestamp-last-inserted-left) (kill-local-variable 'erc-timestamp-last-inserted-right)))) +(defvar erc-stamp--invisible-property nil + "Existing `invisible' property value and/or symbol `timestamp'.") + +(defvar erc-stamp--skip-when-invisible nil + "Escape hatch for omitting stamps when first char is invisible.") + (defun erc-stamp--recover-on-reconnect () (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted @@ -209,8 +215,11 @@ erc-add-timestamp (progn ; remove this `progn' on next major refactor (let* ((ct (erc-stamp--current-time)) (invisible (get-text-property (point-min) 'invisible)) + (erc-stamp--invisible-property + ;; FIXME on major version bump, make this `erc-' prefixed. + (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp)) (erc-stamp--current-time ct)) - (unless invisible + (unless (setq invisible (and erc-stamp--skip-when-invisible invisible)) (funcall erc-insert-timestamp-function (erc-format-timestamp ct erc-timestamp-format))) ;; FIXME this will error when advice has been applied. @@ -380,7 +389,7 @@ erc-insert-timestamp-left (s (if ignore-p (make-string len ? ) string))) (unless ignore-p (setq erc-timestamp-last-inserted string)) (erc-put-text-property 0 len 'field 'erc-timestamp s) - (erc-put-text-property 0 len 'invisible 'timestamp s) + (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) (insert s))) (defun erc-insert-aligned (string pos) @@ -477,6 +486,8 @@ erc-insert-timestamp-right (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) + (erc-put-text-property from (point) 'invisible + erc-stamp--invisible-property) (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) @@ -520,9 +531,8 @@ erc-format-timestamp (let ((ts (format-time-string format time erc-stamp--tz))) (erc-put-text-property 0 (length ts) 'font-lock-face 'erc-timestamp-face ts) - (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) - (erc-put-text-property 0 (length ts) - 'isearch-open-invisible 'timestamp ts) + (erc-put-text-property 0 (length ts) 'invisible + erc-stamp--invisible-property ts) ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index ef064c6a4ee..bc09c5d87fb 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -164,7 +164,6 @@ erc-track-use-faces (defcustom erc-track-faces-priority-list '(erc-error-face - (erc-error-face erc-notice-face) (erc-nick-default-face erc-current-nick-face) erc-current-nick-face erc-keyword-face @@ -311,6 +310,8 @@ erc-track-switch-direction (const leastactive) (const mostactive))) +(defconst erc-track--attn-faces '((erc-error-face erc-notice-face)) + "Faces whose presence always trigger mode-line inclusion.") (defun erc-track-remove-from-mode-line () "Remove `erc-track-modified-channels' from the mode-line." @@ -738,6 +739,9 @@ erc-track-find-face (declare (obsolete erc-track-select-mode-line-face "28.1")) (erc-track-select-mode-line-face (car faces) (cdr faces))) +;; Note that unless called by `erc-track-modified-channels', +;; `erc-track-faces-priority-list' will not begin with +;; `erc-track--attn-faces'. (defun erc-track-select-mode-line-face (cur-face new-faces) "Return the face to use in the mode line. @@ -804,7 +808,9 @@ erc-track-modified-channels ;; (in the car), change its face attribute (in the cddr) if ;; necessary. See `erc-modified-channels-alist' for the ;; exact data structure used. - (let ((faces (erc-faces-in (buffer-string)))) + (let ((faces (erc-faces-in (buffer-string))) + (erc-track-faces-priority-list + `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))) (unless (and (or (eq erc-track-priority-faces-only 'all) (member this-channel erc-track-priority-faces-only)) @@ -875,7 +881,7 @@ erc-track-face-priority higher number than any other face in that list." (let ((count 0)) (catch 'done - (dolist (item erc-track-faces-priority-list) + (dolist (item `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)) (if (equal item face) (throw 'done t) (setq count (1+ count))))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a7d3f7d0ed5..98127697815 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1309,7 +1309,8 @@ erc-notice-face "ERC face for notices." :group 'erc-faces) -(defface erc-action-face '((t :weight bold)) +(defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold) + (t :weight bold)) "ERC face for actions generated by /ME." :group 'erc-faces) @@ -4962,17 +4963,14 @@ erc--nickname-in-use-make-request (erc-cmd-NICK temp)) (defun erc-nickname-in-use (nick reason) - "If NICK is unavailable, tell the user the REASON. - -See also `erc-display-error-notice'." + "Explain REASON NICK is taken and maybe ask for alternate." (if (or (not erc-try-new-nick-p) ;; how many default-nicks are left + one more try... (eq erc-nick-change-attempt-count (if (consp erc-nick) (+ (length erc-nick) 1) 1))) - (erc-display-error-notice - nil + (erc-display-message nil 'error 'active (format "Nickname %s is %s, try another." nick reason)) (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1)) (let ((newnick (nth 1 erc-default-nicks)) @@ -4995,8 +4993,7 @@ erc-nickname-in-use (- 9 (length erc-nick-uniquifier)))) erc-nick-uniquifier))) (erc--nickname-in-use-make-request nick newnick) - (erc-display-error-notice - nil + (erc-display-message nil 'error 'active (format "Nickname %s is %s, trying %s" nick reason newnick))))) @@ -5052,6 +5049,16 @@ erc-is-message-ctcp-and-not-action-p (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) +(define-inline erc--get-speaker-bounds () + "Return the bounds of `erc-speaker' property when present. +Assume buffer is narrowed to the confines of an inserted message." + (inline-quote + (and-let* + (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE))) + (beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min)) + (next-single-property-change (point-min) 'erc-speaker)))) + (cons beg (next-single-property-change beg 'erc-speaker))))) + (defvar erc--user-from-nick-function #'erc--examine-nick "Function to possibly consider unknown user. Must return either nil or a cons of an `erc-server-user' and a @@ -5069,8 +5076,9 @@ erc-format-privmessage (str (format "%s%s%s %s" mark-s nick mark-e msg)) (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) (nick-prefix-face (get-text-property 0 'font-lock-face nick)) - (prefix-len (or (text-property-not-all 0 (length nick) 'font-lock-face - nick-prefix-face nick) + (prefix-len (or (and nick-prefix-face (text-property-not-all + 0 (length nick) 'font-lock-face + nick-prefix-face nick)) 0)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 15a8087f848..99ec4a9635e 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -153,7 +153,10 @@ erc-fill-tests--compare (with-temp-file expect-file (insert repr)) (if (file-exists-p expect-file) - ;; Compare set-equal over intervals + ;; Compare set-equal over intervals. This comparison is + ;; less useful for messages treated by other modules because + ;; it doesn't compare "nested" props belonging to + ;; string-valued properties, like timestamps. (should (equal-including-properties (read repr) (read (with-temp-buffer diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 782907bfc30..edc1749cdd2 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -26,6 +26,7 @@ (require 'erc-stamp) (require 'erc-match) +(require 'erc-fill) ;; This defends against a regression in which all matching by the ;; `erc-match-message' fails when `erc-add-timestamp' precedes it in @@ -57,28 +58,20 @@ erc-scenarios-match--stamp-left-current-nick (should (eq (get-text-property (1- (point)) 'font-lock-face) 'erc-current-nick-face)))))) -;; This asserts that when stamps appear before a message, -;; some non-nil invisibility property spans the entire message. -(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () - :tags '(:expensive-test) - (ert-skip "WIP: fix included in bug#64301") +;; When hacking on tests that use this fixture, it's best to run it +;; interactively, and check for wierdness before and after doing +;; M-: (remove-from-invisibility-spec 'erc-match) RET. +(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") (dumb-server (erc-d-run "localhost" t 'foonet)) (port (process-contact dumb-server :service)) (erc-server-flood-penalty 0.1) - (erc-insert-timestamp-function 'erc-insert-timestamp-left) (erc-timestamp-only-if-changed-flag nil) (erc-fools '("bob")) (erc-text-matched-hook '(erc-hide-fools)) (erc-autojoin-channels-alist '((FooNet "#chan"))) - (expect (erc-d-t-make-expecter)) - (hiddenp (lambda () - (and (eq (field-at-pos (pos-bol)) 'erc-timestamp) - (get-text-property (pos-bol) 'invisible) - (>= (next-single-property-change (pos-bol) - 'invisible nil) - (pos-eol)))))) + (expect (erc-d-t-make-expecter))) (ert-info ("Connect") (with-current-buffer (erc :server "127.0.0.1" @@ -94,30 +87,155 @@ erc-scenarios-match--stamp-left-fools-invisible (ert-info ("Ensure lines featuring \"bob\" are invisible") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (should (funcall expect 10 " tester, welcome!")) - (should (funcall hiddenp)) + (ert-info (" tester, welcome!") (funcall hiddenp)) ;; Alice's is the only one visible. (should (funcall expect 10 " tester, welcome!")) - (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) - (should (get-text-property (pos-bol) 'invisible)) - (should-not (get-text-property (point) 'invisible)) + (ert-info (" tester, welcome!") (funcall visiblep)) (should (funcall expect 10 " alice: But, as it seems")) - (should (funcall hiddenp)) + (ert-info (" alice: But, as it seems") (funcall hiddenp)) (should (funcall expect 10 " bob: Well, this is the forest")) - (should (funcall hiddenp)) + (ert-info (" bob: Well, this is the forest") (funcall hiddenp)) (should (funcall expect 10 " bob: And will you")) - (should (funcall hiddenp)) + (ert-info (" bob: And will you") (funcall hiddenp)) (should (funcall expect 10 " alice: Live, and be prosperous")) - (should (funcall hiddenp)) + (ert-info (" alice: Live, and be prosperous") (funcall hiddenp)) (should (funcall expect 10 "ERC>")) (should-not (get-text-property (pos-bol) 'invisible)) (should-not (get-text-property (point) 'invisible)))))) +;; This asserts that when stamps appear before a message, registered +;; invisibility properties owned by modules span the entire message. +(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left)) + (erc-scenarios-match--invisible-stamp + + (lambda () + ;; This is a time-stamped message. + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + + ;; Leading stamp has combined `invisible' property value. + (should (equal (get-text-property (pos-bol) 'invisible) + '(timestamp erc-match))) + + ;; Message proper has the `invisible' property `erc-match'. + (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) + (should (eq (get-text-property msg-beg 'invisible) 'erc-match)) + (should (>= (next-single-property-change msg-beg 'invisible nil) + (pos-eol))))) + + (lambda () + ;; This is a time-stamped message. + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + (should (get-text-property (pos-bol) 'invisible)) + + ;; The entire message proper is visible. + (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) + (should + (= (next-single-property-change msg-beg 'invisible nil (pos-eol)) + (pos-eol)))))))) + +(defun erc-scenarios-match--find-eol () + (save-excursion + (goto-char (next-single-property-change (point) 'erc-command)) + (pos-eol))) + +;; In most cases, `erc-hide-fools' makes line endings invisible. +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) + (erc-scenarios-match--invisible-stamp + + (lambda () + (let ((end (erc-scenarios-match--find-eol))) + ;; The end of the message is a newline. + (should (= ?\n (char-after end))) + + ;; Every message has a trailing time stamp. + (should (eq (field-at-pos (1- end)) 'erc-timestamp)) + + ;; Stamps have a combined `invisible' property value. + (should (equal (get-text-property (1- end) 'invisible) + '(timestamp erc-match))) + + ;; The final newline is hidden by `match', not `stamps' + (should (equal (get-text-property end 'invisible) 'erc-match)) + + ;; The message proper has the `invisible' property `erc-match', + ;; and it starts after the preceding newline. + (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + + ;; It ends just before the timestamp. + (let ((msg-end (next-single-property-change (pos-bol) 'invisible))) + (should (equal (get-text-property msg-end 'invisible) + '(timestamp erc-match))) + + ;; Stamp's `invisible' property extends throughout the stamp + ;; and ends before the trailing newline. + (should (= (next-single-property-change msg-end 'invisible) end))))) + + (lambda () + (let ((end (erc-scenarios-match--find-eol))) + ;; This message has a time stamp like all the others. + (should (eq (field-at-pos (1- end)) 'erc-timestamp)) + + ;; The entire message proper is visible. + (should-not (get-text-property (pos-bol) 'invisible)) + (let ((inv-beg (next-single-property-change (pos-bol) 'invisible))) + (should (eq (get-text-property inv-beg 'invisible) + 'timestamp)))))))) + +;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides +;; the preceding message's line ending. +(ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right) + (erc-fill-function #'erc-fill-wrap)) + (erc-scenarios-match--invisible-stamp + + (lambda () + ;; Every message has a trailing time stamp. + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + + ;; Stamps appear in the right margin. + (should (equal (car (get-text-property (1- (pos-eol)) 'display)) + '(margin right-margin))) + + ;; Stamps have a combined `invisible' property value. + (should (equal (get-text-property (1- (pos-eol)) 'invisible) + '(timestamp erc-match))) + + ;; The message proper has the `invisible' property `erc-match', + ;; which starts at the preceding newline... + (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match)) + + ;; ... and ends just before the timestamp. + (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible))) + (should (equal (get-text-property msgend 'invisible) + '(timestamp erc-match))) + + ;; The newline before `erc-insert-marker' is still visible. + (should-not (get-text-property (pos-eol) 'invisible)) + (should (= (next-single-property-change msgend 'invisible) + (pos-eol))))) + + (lambda () + ;; This message has a time stamp like all the others. + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + + ;; Unlike hidden messages, the preceding newline is visible. + (should-not (get-text-property (1- (pos-bol)) 'invisible)) + + ;; The entire message proper is visible. + (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) + (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) + (eval-when-compile (require 'erc-join)) ;;; erc-scenarios-match.el ends here -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Respect-existing-invisibility-props-in-erc-stamp.patch >From f6698105d08b0c9186b7a95ffc00dcd8cd496506 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 2 Jul 2023 20:58:37 -0700 Subject: [PATCH 1/4] [5.6] Respect existing invisibility props in erc-stamp * lisp/erc/erc-match.el (erc-hide-fools): change `invisible' property to `erc-match' for all messages, not just those with offset bounds. * lisp/erc/erc-stamp.el (erc-stamp--invisible-property): Add new internal variable to hold existing `invisible' property merged with the one registered by this module. (erc-stamp--skip-when-invisible): Add new internal variable to act as escape hatch for pre ERC-5.6 behavior in which timestamps were not applied at all to invisible messages. This led to strange-looking, uneven logs, and it prevented other modules from offering toggle functionality for invisibility spec members registered to them. (erc-add-timestamp): Merge with existing `invisible' property, when present, instead of clobbering, but only when escape hatch `erc-stamp--skip-when-invisible' is nil. (erc-insert-timestamp-left, erc-format-timestamp): Use possibly merged `invisible' prop value. Don't bother with `isearch-open-invisible', which only affects overlays. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--invisible-stamp): Move setup and core assertions for stamp-related tests into fixture. (erc-scenarios-match--stamp-left-fools-invisible): Fix temporarily disabled test and use fixture. (erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-right-invisible-fill-wrap): New test. --- lisp/erc/erc-match.el | 7 +- lisp/erc/erc-stamp.el | 20 +++- test/lisp/erc/erc-scenarios-match.el | 160 +++++++++++++++++++++++---- 3 files changed, 157 insertions(+), 30 deletions(-) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 2b7fff87ff0..468358536ae 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -669,10 +669,9 @@ erc-hide-fools (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))))) + ;; Before ERC 5.6, this also used to add an `intangible' + ;; property, but the docs say it's now obsolete. + (put-text-property (point-min) (point-max) 'invisible 'erc-match)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 5035e60a87d..2f52d78d42b 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -179,6 +179,12 @@ stamp (kill-local-variable 'erc-timestamp-last-inserted-left) (kill-local-variable 'erc-timestamp-last-inserted-right)))) +(defvar erc-stamp--invisible-property nil + "Existing `invisible' property value and/or symbol `timestamp'.") + +(defvar erc-stamp--skip-when-invisible nil + "Escape hatch for omitting stamps when first char is invisible.") + (defun erc-stamp--recover-on-reconnect () (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted @@ -209,8 +215,11 @@ erc-add-timestamp (progn ; remove this `progn' on next major refactor (let* ((ct (erc-stamp--current-time)) (invisible (get-text-property (point-min) 'invisible)) + (erc-stamp--invisible-property + ;; FIXME on major version bump, make this `erc-' prefixed. + (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp)) (erc-stamp--current-time ct)) - (unless invisible + (unless (setq invisible (and erc-stamp--skip-when-invisible invisible)) (funcall erc-insert-timestamp-function (erc-format-timestamp ct erc-timestamp-format))) ;; FIXME this will error when advice has been applied. @@ -380,7 +389,7 @@ erc-insert-timestamp-left (s (if ignore-p (make-string len ? ) string))) (unless ignore-p (setq erc-timestamp-last-inserted string)) (erc-put-text-property 0 len 'field 'erc-timestamp s) - (erc-put-text-property 0 len 'invisible 'timestamp s) + (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) (insert s))) (defun erc-insert-aligned (string pos) @@ -477,6 +486,8 @@ erc-insert-timestamp-right (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) + (erc-put-text-property from (point) 'invisible + erc-stamp--invisible-property) (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) @@ -520,9 +531,8 @@ erc-format-timestamp (let ((ts (format-time-string format time erc-stamp--tz))) (erc-put-text-property 0 (length ts) 'font-lock-face 'erc-timestamp-face ts) - (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) - (erc-put-text-property 0 (length ts) - 'isearch-open-invisible 'timestamp ts) + (erc-put-text-property 0 (length ts) 'invisible + erc-stamp--invisible-property ts) ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 782907bfc30..edc1749cdd2 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -26,6 +26,7 @@ (require 'erc-stamp) (require 'erc-match) +(require 'erc-fill) ;; This defends against a regression in which all matching by the ;; `erc-match-message' fails when `erc-add-timestamp' precedes it in @@ -57,28 +58,20 @@ erc-scenarios-match--stamp-left-current-nick (should (eq (get-text-property (1- (point)) 'font-lock-face) 'erc-current-nick-face)))))) -;; This asserts that when stamps appear before a message, -;; some non-nil invisibility property spans the entire message. -(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () - :tags '(:expensive-test) - (ert-skip "WIP: fix included in bug#64301") +;; When hacking on tests that use this fixture, it's best to run it +;; interactively, and check for wierdness before and after doing +;; M-: (remove-from-invisibility-spec 'erc-match) RET. +(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") (dumb-server (erc-d-run "localhost" t 'foonet)) (port (process-contact dumb-server :service)) (erc-server-flood-penalty 0.1) - (erc-insert-timestamp-function 'erc-insert-timestamp-left) (erc-timestamp-only-if-changed-flag nil) (erc-fools '("bob")) (erc-text-matched-hook '(erc-hide-fools)) (erc-autojoin-channels-alist '((FooNet "#chan"))) - (expect (erc-d-t-make-expecter)) - (hiddenp (lambda () - (and (eq (field-at-pos (pos-bol)) 'erc-timestamp) - (get-text-property (pos-bol) 'invisible) - (>= (next-single-property-change (pos-bol) - 'invisible nil) - (pos-eol)))))) + (expect (erc-d-t-make-expecter))) (ert-info ("Connect") (with-current-buffer (erc :server "127.0.0.1" @@ -94,30 +87,155 @@ erc-scenarios-match--stamp-left-fools-invisible (ert-info ("Ensure lines featuring \"bob\" are invisible") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (should (funcall expect 10 " tester, welcome!")) - (should (funcall hiddenp)) + (ert-info (" tester, welcome!") (funcall hiddenp)) ;; Alice's is the only one visible. (should (funcall expect 10 " tester, welcome!")) - (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) - (should (get-text-property (pos-bol) 'invisible)) - (should-not (get-text-property (point) 'invisible)) + (ert-info (" tester, welcome!") (funcall visiblep)) (should (funcall expect 10 " alice: But, as it seems")) - (should (funcall hiddenp)) + (ert-info (" alice: But, as it seems") (funcall hiddenp)) (should (funcall expect 10 " bob: Well, this is the forest")) - (should (funcall hiddenp)) + (ert-info (" bob: Well, this is the forest") (funcall hiddenp)) (should (funcall expect 10 " bob: And will you")) - (should (funcall hiddenp)) + (ert-info (" bob: And will you") (funcall hiddenp)) (should (funcall expect 10 " alice: Live, and be prosperous")) - (should (funcall hiddenp)) + (ert-info (" alice: Live, and be prosperous") (funcall hiddenp)) (should (funcall expect 10 "ERC>")) (should-not (get-text-property (pos-bol) 'invisible)) (should-not (get-text-property (point) 'invisible)))))) +;; This asserts that when stamps appear before a message, registered +;; invisibility properties owned by modules span the entire message. +(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left)) + (erc-scenarios-match--invisible-stamp + + (lambda () + ;; This is a time-stamped message. + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + + ;; Leading stamp has combined `invisible' property value. + (should (equal (get-text-property (pos-bol) 'invisible) + '(timestamp erc-match))) + + ;; Message proper has the `invisible' property `erc-match'. + (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) + (should (eq (get-text-property msg-beg 'invisible) 'erc-match)) + (should (>= (next-single-property-change msg-beg 'invisible nil) + (pos-eol))))) + + (lambda () + ;; This is a time-stamped message. + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + (should (get-text-property (pos-bol) 'invisible)) + + ;; The entire message proper is visible. + (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) + (should + (= (next-single-property-change msg-beg 'invisible nil (pos-eol)) + (pos-eol)))))))) + +(defun erc-scenarios-match--find-eol () + (save-excursion + (goto-char (next-single-property-change (point) 'erc-command)) + (pos-eol))) + +;; In most cases, `erc-hide-fools' makes line endings invisible. +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) + (erc-scenarios-match--invisible-stamp + + (lambda () + (let ((end (erc-scenarios-match--find-eol))) + ;; The end of the message is a newline. + (should (= ?\n (char-after end))) + + ;; Every message has a trailing time stamp. + (should (eq (field-at-pos (1- end)) 'erc-timestamp)) + + ;; Stamps have a combined `invisible' property value. + (should (equal (get-text-property (1- end) 'invisible) + '(timestamp erc-match))) + + ;; The final newline is hidden by `match', not `stamps' + (should (equal (get-text-property end 'invisible) 'erc-match)) + + ;; The message proper has the `invisible' property `erc-match', + ;; and it starts after the preceding newline. + (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + + ;; It ends just before the timestamp. + (let ((msg-end (next-single-property-change (pos-bol) 'invisible))) + (should (equal (get-text-property msg-end 'invisible) + '(timestamp erc-match))) + + ;; Stamp's `invisible' property extends throughout the stamp + ;; and ends before the trailing newline. + (should (= (next-single-property-change msg-end 'invisible) end))))) + + (lambda () + (let ((end (erc-scenarios-match--find-eol))) + ;; This message has a time stamp like all the others. + (should (eq (field-at-pos (1- end)) 'erc-timestamp)) + + ;; The entire message proper is visible. + (should-not (get-text-property (pos-bol) 'invisible)) + (let ((inv-beg (next-single-property-change (pos-bol) 'invisible))) + (should (eq (get-text-property inv-beg 'invisible) + 'timestamp)))))))) + +;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides +;; the preceding message's line ending. +(ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right) + (erc-fill-function #'erc-fill-wrap)) + (erc-scenarios-match--invisible-stamp + + (lambda () + ;; Every message has a trailing time stamp. + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + + ;; Stamps appear in the right margin. + (should (equal (car (get-text-property (1- (pos-eol)) 'display)) + '(margin right-margin))) + + ;; Stamps have a combined `invisible' property value. + (should (equal (get-text-property (1- (pos-eol)) 'invisible) + '(timestamp erc-match))) + + ;; The message proper has the `invisible' property `erc-match', + ;; which starts at the preceding newline... + (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match)) + + ;; ... and ends just before the timestamp. + (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible))) + (should (equal (get-text-property msgend 'invisible) + '(timestamp erc-match))) + + ;; The newline before `erc-insert-marker' is still visible. + (should-not (get-text-property (pos-eol) 'invisible)) + (should (= (next-single-property-change msgend 'invisible) + (pos-eol))))) + + (lambda () + ;; This message has a time stamp like all the others. + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + + ;; Unlike hidden messages, the preceding newline is visible. + (should-not (get-text-property (1- (pos-bol)) 'invisible)) + + ;; The entire message proper is visible. + (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) + (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) + (eval-when-compile (require 'erc-join)) ;;; erc-scenarios-match.el ends here -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Simplify-erc-button-add-nickname-buttons.patch >From 2ce173cb0a29b3b0eb74904749b59e68efc71b53 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 30 Jun 2023 23:42:01 -0700 Subject: [PATCH 2/4] [5.6] Simplify erc-button-add-nickname-buttons * lisp/erc/erc-button.el (erc-button--nick): Remove `face' slot which was set to `erc-button-face' by default. It's ignored when the button is a nick and thus completely useless. (erc-button-add-nickname-buttons): Rework and reflow for readability. Don't bind or set `erc-button' face because it's ignored when dealing with nicks. Don't return the value of face options when calling a `form' function because they can be nil in practice even though their Custom type specs do not say so. * lisp/erc/erc.el (erc--get-speaker-bounds): New helper function to retrieve bounds of a speaker label when present. (Bug#64301) --- lisp/erc/erc-button.el | 78 ++++++++++++++++++++---------------------- lisp/erc/erc.el | 10 ++++++ 2 files changed, 47 insertions(+), 41 deletions(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 0c616a6026d..c30f7c10ca6 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -355,8 +355,6 @@ erc-button--nick ( cuser nil :type (or null erc-channel-user) ;; The CDR of a value from an `erc-channel-users' table. :documentation "A possibly nil `erc-channel-user'.") - ( face erc-button-face :type symbol - :documentation "Temp `erc-button-face' while buttonizing.") ( nickname-face erc-button-nickname-face :type symbol :documentation "Temp `erc-button-nickname-face' while buttonizing.") ( mouse-face erc-button-mouse-face :type symbol @@ -431,45 +429,43 @@ erc-button--phantom-users-mode (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." - (let ((form (nth 2 entry)) - (fun (nth 3 entry)) - (erc-button-buttonize-nicks (and erc-button-buttonize-nicks - erc-button--modify-nick-function)) - bounds word) - (when (and form (setq form (erc-button--extract-form form))) - (goto-char (point-min)) - (while (erc-forward-word) - (when (setq bounds (erc-bounds-of-word-at-point)) - (setq word (buffer-substring-no-properties - (car bounds) (cdr bounds))) - (let* ((erc-button-face erc-button-face) - (erc-button-mouse-face erc-button-mouse-face) - (erc-button-nickname-face erc-button-nickname-face) - (down (erc-downcase word)) - (cuser (and erc-channel-users - (gethash down erc-channel-users))) - (user (or (and cuser (car cuser)) - (and erc-server-users - (gethash down erc-server-users)) - (funcall erc-button--fallback-user-function - down word bounds))) - (data (list word))) - (when (or (not (functionp form)) - (and-let* ((user) - (obj (funcall form (make-erc-button--nick - :bounds bounds :data data - :downcased down :user user - :cuser (cdr cuser))))) - (setq bounds (erc-button--nick-bounds obj) - data (erc-button--nick-data obj) - erc-button-mouse-face - (erc-button--nick-mouse-face obj) - erc-button-nickname-face - (erc-button--nick-nickname-face obj) - erc-button-face - (erc-button--nick-face obj)))) - (erc-button-add-button (car bounds) (cdr bounds) - fun t data)))))))) + (when-let ((form (nth 2 entry)) + ;; Spoof `form' slot of default legacy `nicknames' entry + ;; so `erc-button--extract-form' sees a function value. + (form (let ((erc-button-buttonize-nicks + (and erc-button-buttonize-nicks + erc-button--modify-nick-function))) + (erc-button--extract-form form))) + (seen 0)) + (goto-char (point-min)) + (while-let + (((erc-forward-word)) + (bounds (or (and (= 1 (cl-incf seen)) (erc--get-speaker-bounds)) + (erc-bounds-of-word-at-point))) + (word (buffer-substring-no-properties (car bounds) (cdr bounds))) + (down (erc-downcase word))) + (let* ((erc-button-mouse-face erc-button-mouse-face) + (erc-button-nickname-face erc-button-nickname-face) + (cuser (and erc-channel-users (gethash down erc-channel-users))) + (user (or (and cuser (car cuser)) + (and erc-server-users (gethash down erc-server-users)) + (funcall erc-button--fallback-user-function + down word bounds))) + (data (list word))) + (when (or (not (functionp form)) + (and-let* ((user) + (obj (funcall form (make-erc-button--nick + :bounds bounds :data data + :downcased down :user user + :cuser (cdr cuser))))) + (setq erc-button-mouse-face ; might be null + (erc-button--nick-mouse-face obj) + erc-button-nickname-face ; might be null + (erc-button--nick-nickname-face obj) + data (erc-button--nick-data obj) + bounds (erc-button--nick-bounds obj)))) + (erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry) + 'nickp data)))))) (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e23185934f7..06b88ade2a0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5025,6 +5025,16 @@ erc-is-message-ctcp-and-not-action-p (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) +(define-inline erc--get-speaker-bounds () + "Return the bounds of `erc-speaker' property when present. +Assume buffer is narrowed to the confines of an inserted message." + (inline-quote + (and-let* + (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE))) + (beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min)) + (next-single-property-change (point-min) 'erc-speaker)))) + (cons beg (next-single-property-change beg 'erc-speaker))))) + (defvar erc--user-from-nick-function #'erc--examine-nick "Function to possibly consider unknown user. Must return either nil or a cons of an `erc-server-user' and a -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Add-text-props-for-CTCPs-and-speakers-in-ERC.patch >From b56dd9c5b17e68b80e097cb601062264cbafb94b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 24 Jun 2023 18:33:20 -0700 Subject: [PATCH 3/4] [5.6] Add text props for CTCPs and speakers in ERC * lisp/erc/erc-fill.el (erc-fill-spaced-commands, erc-fill--spaced-commands): Rename former to latter and demote from user option to internal variable. (erc-fill--wrap-continued-message-p): Use `erc-ctcp' text prop instead of face to detect ACTION. (erc-fill--wrap-action-dedent-p): New variable to toggle whether `line-prefix' is applied to CTCP ACTION messages. (erc-fill-wrap): Look for `erc-speaker' property before falling back on word at point. Use `erc-ctcp' to detect ACTION messages. * lisp/erc/erc.el (erc-notice-face, erc-action-face): Prefer weight of `semi-bold' when available so that buttonization is at least somewhat visible. (erc-send-action): Ensure nickname passed to `erc-display-message' has `erc-speaker' property and `erc-ctcp' ACTION property. Apply both `erc-input-face' and `erc-action-face' to messages. (erc--own-property-names): Add `erc-speaker'. (erc-format-privmessage): Don't clobber `erc-nick-prefix-face'. That is, retain face applied to a leading stretch of characters in the `nick' parameter. But continue to discard trailing faces. (erc-format-my-nick, erc-ctcp-query-ACTION): Add a new text property, `erc-speaker', to the nick portion of the formatted speaker label. Do this to assist modules, like `button' and `match', that re-parse speakers in inserted messages. (erc-process-ctcp-query): Add `erc-ctcp' property to entire message before insertion hooks. (Bug#64301) * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--compare): Warn about certain unreliable comparisons if generalizing helper for use by other modules. --- lisp/erc/erc-fill.el | 25 ++++++++++++++------- lisp/erc/erc.el | 40 ++++++++++++++++++++++++--------- test/lisp/erc/erc-fill-tests.el | 5 ++++- 3 files changed, 51 insertions(+), 19 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 5115e45210d..a65c95f1d85 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -124,11 +124,9 @@ erc-fill-line-spacing :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) number)) -(defcustom erc-fill-spaced-commands '(PRIVMSG NOTICE) +(defvar erc-fill--spaced-commands '(PRIVMSG NOTICE) "Types of messages to add space between on graphical displays. -Only considered when `erc-fill-line-spacing' is non-nil." - :package-version '(ERC . "5.6") ; FIXME sync on release - :type '(repeat (choice integer symbol))) +Only considered when `erc-fill-line-spacing' is non-nil.") (defvar-local erc-fill--function nil "Internal copy of `erc-fill-function'. @@ -153,12 +151,12 @@ erc-fill (p (point-min))) (widen) (when (or (and-let* ((cmd (get-text-property p 'erc-command))) - (memq cmd erc-fill-spaced-commands)) + (memq cmd erc-fill--spaced-commands)) (and-let* ((cmd (save-excursion (forward-line -1) (get-text-property (point) 'erc-command)))) - (memq cmd erc-fill-spaced-commands))) + (memq cmd erc-fill--spaced-commands))) (put-text-property (1- p) p 'line-spacing erc-fill-line-spacing)))))))) @@ -384,8 +382,7 @@ erc-fill--wrap-continued-message-p (when (eq 'erc-timestamp (field-at-pos m)) (set-marker m (field-end m))) (and (eq 'PRIVMSG (get-text-property m 'erc-command)) - (not (eq (get-text-property m 'font-lock-face) - 'erc-action-face)) + (not (eq (get-text-property m 'erc-ctcp) 'ACTION)) (cons (get-text-property m 'erc-timestamp) (get-text-property (1+ m) 'erc-data))))) (ts (pop props)) @@ -418,6 +415,12 @@ erc-fill--wrap-stamp-insert-prefixed-date `(space :width (- erc-fill--wrap-value ,width)))) args) +;; An escape hatch for third-party code expecting speakers of ACTION +;; messages to be exempt from `line-prefix'. This could be converted +;; into a user option if users feel similarly. +(defvar erc-fill--wrap-action-dedent-p t + "Whether to dedent speakers in CTCP \"ACTION\" lines.") + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." @@ -428,6 +431,12 @@ erc-fill-wrap (let ((len (or (and erc-fill--wrap-length-function (funcall erc-fill--wrap-length-function)) (progn + (when-let ((e (erc--get-speaker-bounds)) + (b (pop e)) + ((or erc-fill--wrap-action-dedent-p + (not (eq (get-text-property b 'erc-ctcp) + 'ACTION))))) + (goto-char e)) (skip-syntax-forward "^-") (forward-char) ;; Using the `invisible' property might make more diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 06b88ade2a0..d43281825fb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1302,12 +1302,15 @@ erc-command-indicator-face (defface erc-notice-face '((default :weight bold) + (((class color) (min-colors 88) (supports :weight semi-bold)) + :weight semi-bold :foreground "SlateBlue") (((class color) (min-colors 88)) :foreground "SlateBlue") (t :foreground "blue")) "ERC face for notices." :group 'erc-faces) -(defface erc-action-face '((t :weight bold)) +(defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold) + (t :weight bold)) "ERC face for actions generated by /ME." :group 'erc-faces) @@ -2723,10 +2726,13 @@ erc-send-action (erc-send-ctcp-message tgt (format "ACTION %s" str) force) (let ((erc-insert-pre-hook (cons (lambda (s) ; Leave newline be. - (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)) - erc-insert-pre-hook))) - (erc-display-message nil 'input (current-buffer) - 'ACTION ?n (erc-current-nick) ?a str ?u "" ?h ""))) + (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s) + (put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s)) + erc-insert-pre-hook)) + (nick (erc-current-nick))) + (setq nick (propertize nick 'erc-speaker nick)) + (erc-display-message nil '(action input) (current-buffer) + 'ACTION ?n nick ?a str ?u "" ?h ""))) ;; Display interface @@ -4532,7 +4538,7 @@ erc-ensure-channel-name (concat "#" channel))) (defvar erc--own-property-names - '( tags erc-parsed display ; core + '( tags erc-speaker erc-parsed display ; core ;; `erc-display-prompt' rear-nonsticky erc-prompt field front-sticky read-only ;; stamp @@ -5051,11 +5057,19 @@ erc-format-privmessage (mark-e (if msgp (if privp "*" ">") "-")) (str (format "%s%s%s %s" mark-s nick mark-e msg)) (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) + (nick-prefix-face (get-text-property 0 'font-lock-face nick)) + (prefix-len (or (and nick-prefix-face (text-property-not-all + 0 (length nick) 'font-lock-face + nick-prefix-face nick)) + 0)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick (erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str) - (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'font-lock-face nick-face str) + (erc-put-text-properties (+ (length mark-s) prefix-len) + (+ (length mark-s) (length nick)) + '(font-lock-face erc-speaker) str + (list nick-face + (substring-no-properties nick prefix-len))) (erc-put-text-property (+ (length mark-s) (length nick)) (length str) 'font-lock-face msg-face str) str)) @@ -5107,7 +5121,7 @@ erc-format-my-nick (concat (propertize open 'font-lock-face 'erc-default-face) (propertize mode 'font-lock-face 'erc-my-nick-prefix-face) - (propertize nick 'font-lock-face 'erc-my-nick-face) + (propertize nick 'font-lock-face 'erc-my-nick-face 'erc-speaker nick) (propertize close 'font-lock-face 'erc-default-face))) (let ((prefix "> ")) (propertize prefix 'font-lock-face 'erc-default-face)))) @@ -5345,7 +5359,12 @@ erc-process-ctcp-query 'ctcp-empty ?n nick) (while queries (let* ((type (upcase (car (split-string (car queries))))) - (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))) + (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))) + (erc-insert-pre-hook + (cons (lambda (s) + (put-text-property 0 (1- (length s)) 'erc-ctcp + (intern type) s)) + erc-insert-pre-hook))) (if (and hook (boundp hook)) (if (string-equal type "ACTION") (run-hook-with-args-until-success @@ -5380,6 +5399,7 @@ erc-ctcp-query-ACTION (buf (or (erc-get-buffer to proc) (erc-get-buffer nick proc) (process-buffer proc)))) + (setq nick (propertize nick 'erc-speaker nick)) (erc-display-message parsed 'action buf 'ACTION ?n nick ?u login ?h host ?a s)))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 15a8087f848..99ec4a9635e 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -153,7 +153,10 @@ erc-fill-tests--compare (with-temp-file expect-file (insert repr)) (if (file-exists-p expect-file) - ;; Compare set-equal over intervals + ;; Compare set-equal over intervals. This comparison is + ;; less useful for messages treated by other modules because + ;; it doesn't compare "nested" props belonging to + ;; string-valued properties, like timestamps. (should (equal-including-properties (read repr) (read (with-temp-buffer -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.6-Handle-composite-faces-better-in-erc-display-mes.patch >From 171dbaefbdc47154b21aa7f7e8c980958f983313 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 24 Jun 2023 18:33:20 -0700 Subject: [PATCH 4/4] [5.6] Handle composite faces better in erc-display-message * etc/ERC-NEWS: Tell users to update their customized `erc-track-faces-priority-list' values. * lisp/erc/erc-backend.el (erc-server-401, erc-server-402, erc-server-403, erc-server-404, erc-server-405, erc-server-406, erc-server-412, erc-server-421, erc-server-432, erc-server-442, erc-server-461, erc-server-474, erc-server-475, erc-server-482): Change `erc-display-message' `type' arg from list of both `error' and `notice' to just a lone `error' symbol. (erc-server-465, erc-server-431): Inline calls to `erc-display-error-notice, except just pass `error' for `type' arg. Also, remove forward declaration for `erc-display-error-notice' from atop file. * lisp/erc/erc-dcc.el (erc-dcc-do-GET-command, erc-dcc-do-SEND-command, erc-ctcp-query-DCC, erc-dcc-handle-ctcp-chat, erc-dcc-get-filter, erc-dcc-get-sentinel): Change `erc-display-message' `type' arg from list to `error'. * lisp/erc/erc-match.el (erc-hide-fools): Merge `invisible' prop `erc-match' with existing, if present. * lisp/erc/erc-sasl.el (erc-server-902, erc-server-907, erc-server-904, erc-server-908): Change `erc-display-message' `type' arg from list to `error'. * lisp/erc/erc-track.el: Require `erc-button' atop file because options, like `erc-track-faces-priority-list', whose Custom type involves faces, fail validation otherwise. (erc-track--attn-faces): Add new internal variable for faces that should always light up the mode line no matter what. (erc-track-modified-channels, erc-track-face-priority): Prepend `erc-track--attn-faces' to `erc-track-faces-priority-list'. * lisp/erc/erc.el (erc--compose-text-properties): New internal variable to alter behavior of `erc-put-text-property'. (erc--merge-prop): Port over `erc-button-add-face' for general use by all of ERC. (erc-display-message-highlight): Set face to `erc-default-face' the symbol instead of the string. (erc-display-message): Explain how type param works when it's a list. Fix code in type-as-list branch so that it combines faces instead of clobbers them. (erc-nickname-in-use): Inline `erc-display-error-notice' but change `type' arg from list to `error'. (erc-put-text-property): Unalias from `put-text-property' and instead fall back to latter unless caller wants to combine faces, in which case defer to `erc--merge-prop'. * test/lisp/erc/erc-button-tests.el (erc-button--display-error-notice-with-keys): Expect a combined "error notice" face. (Bug#64301) --- etc/ERC-NEWS | 15 ++++++++++ lisp/erc/erc-backend.el | 39 +++++++++++------------- lisp/erc/erc-dcc.el | 16 +++++----- lisp/erc/erc-match.el | 9 ++---- lisp/erc/erc-sasl.el | 8 ++--- lisp/erc/erc-track.el | 12 ++++++-- lisp/erc/erc.el | 49 ++++++++++++++++++++++--------- test/lisp/erc/erc-button-tests.el | 2 +- 8 files changed, 93 insertions(+), 57 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5665b760ea9..40bcd934772 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -224,6 +224,21 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** 'erc-display-message' combines faces when 'type' is a list. +Users may notice that ERC now renders messages passed to the +convenience function 'erc-display-error-notice' in a combination of +'erc-error-face' and 'erc-notice-face'. This is merely a consequence +of that function being a wrapper around 'erc-display-message', which +has gotten smarter about how it treats face properties when its 'type' +parameter is a list. Originally, ERC's authors intended to display +both server-originating and ERC-generated errors in this style, but +due to various complications, that intent was never realized until +this release, and even now only partially so. Indeed, to minimize +churn, the effect has been limited to internal and usage errors. For +third-party code, the key take away is that more 'font-lock-face' +properties encountered in the wild may be combinations of faces rather +than simple ones. + *** Prompt input is split before 'erc-pre-send-functions' has a say. Hook members are now treated to input whose lines have already been adjusted to fall within the allowed length limit. For convenience, diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index f1b51f9234a..bf21ec96225 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -148,7 +148,6 @@ erc-whowas-on-nosuchnick (declare-function erc-current-time "erc" (&optional specified-time)) (declare-function erc-default-target "erc" nil) (declare-function erc-delete-default-channel "erc" (channel &optional buffer)) -(declare-function erc-display-error-notice "erc" (parsed string)) (declare-function erc-display-server-message "erc" (_proc parsed)) (declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time)) (declare-function erc-format-message "erc" (msg &rest args)) @@ -2411,47 +2410,47 @@ erc-server-322-message (when erc-whowas-on-nosuchnick (erc-log (format "cmd: WHOWAS: %s" nick/channel)) (erc-server-send (format "WHOWAS %s 1" nick/channel))) - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's401 ?n nick/channel))) (define-erc-response-handler (402) "No such server." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's402 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (403) "No such channel." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's403 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (404) "Cannot send to channel." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's404 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (405) "Can't join that many channels." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's405 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (406) "No such nick." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's406 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (412) "No text to send." nil - (erc-display-message parsed '(notice error) 'active 's412)) + (erc-display-message parsed 'error 'active 's412)) (define-erc-response-handler (421) "Unknown command." nil - (erc-display-message parsed '(notice error) 'active 's421 + (erc-display-message parsed 'error 'active 's421 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (432) "Bad nick." nil - (erc-display-message parsed '(notice error) 'active 's432 + (erc-display-message parsed 'error 'active 's432 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (433) @@ -2469,12 +2468,12 @@ erc-server-322-message (define-erc-response-handler (442) "Not on channel." nil - (erc-display-message parsed '(notice error) 'active 's442 + (erc-display-message parsed 'error 'active 's442 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (461) "Not enough parameters for command." nil - (erc-display-message parsed '(notice error) 'active 's461 + (erc-display-message parsed 'error 'active 's461 ?c (cadr (erc-response.command-args parsed)) ?m (erc-response.contents parsed))) @@ -2482,20 +2481,19 @@ erc-server-322-message "You are banned from this server." nil (setq erc-server-banned t) ;; show the server's message, as a reason might be provided - (erc-display-error-notice - parsed + (erc-display-message parsed 'error 'active (erc-response.contents parsed))) (define-erc-response-handler (474) "Banned from channel errors." nil - (erc-display-message parsed '(notice error) nil + (erc-display-message parsed 'error nil (intern (format "s%s" (erc-response.command parsed))) ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (475) "Channel key needed." nil - (erc-display-message parsed '(notice error) nil 's475 + (erc-display-message parsed 'error nil 's475 ?c (cadr (erc-response.command-args parsed))) (when erc-prompt-for-channel-key (let ((channel (cadr (erc-response.command-args parsed))) @@ -2516,7 +2514,7 @@ erc-server-322-message "You need to be a channel operator to do that." nil (let ((channel (cadr (erc-response.command-args parsed))) (message (erc-response.contents parsed))) - (erc-display-message parsed '(notice error) 'active 's482 + (erc-display-message parsed 'error 'active 's482 ?c channel ?m message))) (define-erc-response-handler (671) @@ -2551,11 +2549,8 @@ erc-server-322-message ;; 491 - No O-lines for your host ;; 501 - Unknown MODE flag ;; 502 - Cannot change mode for other users - "Generic display of server error messages. - -See `erc-display-error-notice'." nil - (erc-display-error-notice - parsed + "Display error message as given from server." nil + (erc-display-message parsed 'error 'active (intern (format "s%s" (erc-response.command parsed))))) ;; FIXME: These are yet to be implemented, they're just stubs for now diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index cc2dcc9a788..8968295a83c 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -566,7 +566,7 @@ erc-dcc-do-GET-command file)) (erc-dcc-get-file elt file proc) (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-get-cmd-aborted ?n nick ?f filename))) (t @@ -578,7 +578,7 @@ erc-dcc-do-GET-command (setq erc-dcc-list (cons (plist-put elt :turbo t) (delq elt erc-dcc-list))))) (erc-display-message - nil '(notice error) 'active + nil 'error 'active 'dcc-get-notfound ?n nick ?f filename)))) (defvar-local erc-dcc-byte-count nil) @@ -648,7 +648,7 @@ erc-dcc-do-SEND-command nil 'notice 'active 'dcc-send-offer ?n nick ?f file) (erc-dcc-send-file nick file) t) - (erc-display-message nil '(notice error) proc "File not found") t)) + (erc-display-message nil 'error proc "File not found") t)) ;;; Server message handling (i.e. messages from remote users) @@ -675,7 +675,7 @@ erc-ctcp-query-DCC (funcall handler proc query nick login host to) ;; FIXME: Send a ctcp error notice to the remote end? (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-ctcp-unknown ?q query ?n nick ?u login ?h host)))) @@ -771,7 +771,7 @@ erc-dcc-handle-ctcp-chat (;; DCC CHAT requests must be sent to you, and you alone. (not (erc-current-nick-p to)) (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-request-bogus ?r "CHAT" ?n nick ?u login ?h host)) ((string-match erc-dcc-ctcp-query-chat-regexp query) ;; We need to use let* here, since erc-dcc-member might clutter @@ -805,7 +805,7 @@ erc-dcc-handle-ctcp-chat proc)))) (t (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-malformed ?n nick ?u login ?h host ?q query))))) @@ -1053,7 +1053,7 @@ erc-dcc-get-filter ((and (> (plist-get erc-dcc-entry-data :size) 0) (> received-bytes (plist-get erc-dcc-entry-data :size))) (erc-display-message - nil '(notice error) 'active + nil 'error 'active 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) @@ -1085,7 +1085,7 @@ erc-dcc-get-sentinel (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) (let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))) (erc-display-message - nil (if done 'notice '(notice error)) erc-server-process + nil (if done 'notice 'error) erc-server-process (if done 'dcc-get-complete 'dcc-get-failed) ?v (plist-get erc-dcc-entry-data :size) ?f erc-dcc-file-name diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 468358536ae..549de4feeb8 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -657,21 +657,18 @@ erc-go-to-log-matches-buffer (defvar-local erc-match--hide-fools-offset-bounds nil) -;; FIXME this should merge with instead of overwrite existing -;; `invisible' values. (defun erc-hide-fools (match-type _nickuserhost _message) - "Hide foolish comments. -This function should be called from `erc-text-matched-hook'." + "Hide comments from designated fools." (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))) + (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match))) ;; Before ERC 5.6, this also used to add an `intangible' ;; property, but the docs say it's now obsolete. - (put-text-property (point-min) (point-max) 'invisible 'erc-match)))) + (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index c6922b1b26b..73d318fd4fd 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -377,7 +377,7 @@ erc-sasl--destroy (define-erc-response-handler (902) "Handle an ERR_NICKLOCKED response." nil - (erc-display-message parsed '(notice error) 'active 's902 + (erc-display-message parsed 'error 'active 's902 ?n (car (erc-response.command-args parsed)) ?s (erc-response.contents parsed)) (erc-sasl--destroy proc)) @@ -391,19 +391,19 @@ erc-sasl--destroy (define-erc-response-handler (907) "Handle a RPL_SASLALREADY response." nil - (erc-display-message parsed '(notice error) 'active 's907 + (erc-display-message parsed 'error 'active 's907 ?s (erc-response.contents parsed))) (define-erc-response-handler (904 905 906) "Handle various SASL-related error responses." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active (intern (format "s%s" (erc-response.command parsed))) ?s (erc-response.contents parsed)) (erc-sasl--destroy proc)) (define-erc-response-handler (908) "Handle a RPL_SASLMECHS response." nil - (erc-display-message parsed '(notice error) 'active 's908 + (erc-display-message parsed 'error 'active 's908 ?m (alist-get 'mechanism erc-sasl--options) ?s (string-join (cdr (erc-response.command-args parsed)) " ")) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index e060b7039bd..bc09c5d87fb 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -37,6 +37,7 @@ (eval-when-compile (require 'cl-lib)) (require 'erc) (require 'erc-match) +(require 'erc-button) ; for validating faces in custom options ;;; Code: @@ -309,6 +310,8 @@ erc-track-switch-direction (const leastactive) (const mostactive))) +(defconst erc-track--attn-faces '((erc-error-face erc-notice-face)) + "Faces whose presence always trigger mode-line inclusion.") (defun erc-track-remove-from-mode-line () "Remove `erc-track-modified-channels' from the mode-line." @@ -736,6 +739,9 @@ erc-track-find-face (declare (obsolete erc-track-select-mode-line-face "28.1")) (erc-track-select-mode-line-face (car faces) (cdr faces))) +;; Note that unless called by `erc-track-modified-channels', +;; `erc-track-faces-priority-list' will not begin with +;; `erc-track--attn-faces'. (defun erc-track-select-mode-line-face (cur-face new-faces) "Return the face to use in the mode line. @@ -802,7 +808,9 @@ erc-track-modified-channels ;; (in the car), change its face attribute (in the cddr) if ;; necessary. See `erc-modified-channels-alist' for the ;; exact data structure used. - (let ((faces (erc-faces-in (buffer-string)))) + (let ((faces (erc-faces-in (buffer-string))) + (erc-track-faces-priority-list + `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))) (unless (and (or (eq erc-track-priority-faces-only 'all) (member this-channel erc-track-priority-faces-only)) @@ -873,7 +881,7 @@ erc-track-face-priority higher number than any other face in that list." (let ((count 0)) (catch 'done - (dolist (item erc-track-faces-priority-list) + (dolist (item `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)) (if (equal item face) (throw 'done t) (setq count (1+ count))))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d43281825fb..98127697815 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2885,6 +2885,25 @@ erc-display-line (process-buffer erc-server-process) (current-buffer)))))) +(defvar erc--compose-text-properties nil + "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.") + +(defun erc--merge-prop (from to prop val &optional object) + "Compose existing PROP values with VAL between FROM and TO in OBJECT. +For spans where PROP is non-nil, cons VAL onto the existing +value, ensuring a proper list. Otherwise, just set PROP to VAL. +See also `erc-button-add-face'." + (let ((old (get-text-property from prop object)) + (pos from) + (end (next-single-property-change from prop object to)) + new) + (while (< pos to) + (setq new (if old (cons val (ensure-list old)) val)) + (put-text-property pos end prop new object) + (setq pos end + old (get-text-property pos prop object) + end (next-single-property-change pos prop object to))))) + (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. @@ -2896,7 +2915,7 @@ erc-display-message-highlight 0 (length string) 'font-lock-face (or (intern-soft (concat "erc-" (symbol-name type) "-face")) - "erc-default-face") + 'erc-default-face) string) string))) @@ -3100,6 +3119,10 @@ erc-display-message ARGS, PARSED, and TYPE are used to format MSG sensibly. +When TYPE is a list of symbols, call handlers from left to right. +For example, expect a TYPE of (notice error) to result in MSG's +`font-lock-face' being (erc-error-face erc-notice-face). + See also `erc-format-message' and `erc-display-line'." (let ((string (if (symbolp msg) (apply #'erc-format-message msg args) @@ -3110,10 +3133,9 @@ erc-display-message ((null type) string) ((listp type) - (mapc (lambda (type) - (setq string - (erc-display-message-highlight type string))) - type) + (let ((erc--compose-text-properties t)) + (dolist (type type) + (setq string (erc-display-message-highlight type string)))) string) ((symbolp type) (erc-display-message-highlight type string)))) @@ -4941,17 +4963,14 @@ erc--nickname-in-use-make-request (erc-cmd-NICK temp)) (defun erc-nickname-in-use (nick reason) - "If NICK is unavailable, tell the user the REASON. - -See also `erc-display-error-notice'." + "Explain REASON NICK is taken and maybe ask for alternate." (if (or (not erc-try-new-nick-p) ;; how many default-nicks are left + one more try... (eq erc-nick-change-attempt-count (if (consp erc-nick) (+ (length erc-nick) 1) 1))) - (erc-display-error-notice - nil + (erc-display-message nil 'error 'active (format "Nickname %s is %s, try another." nick reason)) (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1)) (let ((newnick (nth 1 erc-default-nicks)) @@ -4974,8 +4993,7 @@ erc-nickname-in-use (- 9 (length erc-nick-uniquifier)))) erc-nick-uniquifier))) (erc--nickname-in-use-make-request nick newnick) - (erc-display-error-notice - nil + (erc-display-message nil 'error 'active (format "Nickname %s is %s, trying %s" nick reason newnick))))) @@ -6079,7 +6097,7 @@ erc-highlight-error (erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s) s) -(defalias 'erc-put-text-property 'put-text-property +(defun erc-put-text-property (start end property value &optional object) "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'. @@ -6089,7 +6107,10 @@ 'erc-put-text-property OBJECT is modified without being copied first. You can redefine or `defadvice' this function in order to add -EmacsSpeak support.") +EmacsSpeak support." + (if erc--compose-text-properties + (erc--merge-prop start end property value object) + (put-text-property start end property value object))) (defalias 'erc-list 'ensure-list) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index 6a6f6934389..3dacf95a59f 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -265,7 +265,7 @@ erc-button--display-error-notice-with-keys (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k (erc-button-next 1) (should (equal (get-text-property (point) 'font-lock-face) - '(erc-button erc-error-face))) + '(erc-button erc-error-face erc-notice-face))) (should (eq (get-text-property (point) 'mouse-face) 'highlight)) (should (eq erc-button-face 'erc-button))) ; extent evaporates -- 2.41.0 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sat Jul 08 10:19:41 2023 Received: (at 64301) by debbugs.gnu.org; 8 Jul 2023 14:19:41 +0000 Received: from localhost ([127.0.0.1]:45032 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qI8mf-00054m-Mq for submit@debbugs.gnu.org; Sat, 08 Jul 2023 10:19:40 -0400 Received: from mail-108-mta17.mxroute.com ([136.175.108.17]:32777) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qI8mb-00054Z-BW for 64301@debbugs.gnu.org; Sat, 08 Jul 2023 10:19:36 -0400 Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta17.mxroute.com (ZoneMTA) with ESMTPSA id 18935df3c730007ced.001 for <64301@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Sat, 08 Jul 2023 14:19:29 +0000 X-Zone-Loop: ae40c419092b05028c88da4d02e6dc9fc5e9aa054461 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=X7fnbEzwnArxMe8N91FILeNmRXEghj/ebuN+09NQUrI=; b=XhtwulivSshAMvs+onJ/v+sF0e ruqWv7+lK9wpO6ODt9A6MnUBr/ZFyyLy2seP440TYfzHPcfYdTwyc3ufp8sDCmzUz1SwXLbicStgF 6NW45SAsjDqHADPmypw2nc3BzV/W9eUPXkOTB0C2osiSNpg8B7JPrF5UpcE6y62Vb4fF6/zUHhddw oFn7YS5ggIeazdd2sD5hLgxV5VbIHjH3k/P83SofZLH61SmCpCulhfx3qGfC/vsC1TUb4ZFnvPfBp rFINi2Q49axLWTL3aS0RN2SlIjEy3HLMFzQbBGRd3MCPqSfbyJyUhbMuJrGOPwaXBB88HQLiPshCo d4maRWLw==; From: "J.P." To: 64301@debbugs.gnu.org Subject: Re: bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with In-Reply-To: <87bkh21gfa.fsf@neverwas.me> (J. P.'s message of "Mon, 26 Jun 2023 06:50:17 -0700") References: <87bkh21gfa.fsf@neverwas.me> Date: Sat, 08 Jul 2023 07:19:26 -0700 Message-ID: <87sf9y32q9.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Authenticated-Id: masked@neverwas.me X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 64301 Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain v3. Fix problem calculating column width. Add command to toggle fool invisibility. Add test for hidden date stamps. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v2-v3.diff >From aae534bcbe0eb75e436c428b248a87748ec185b6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 8 Jul 2023 07:06:09 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): [5.6] Respect existing invisibility props in erc-stamp [5.6] Simplify erc-button-add-nickname-buttons [5.6] Add text props for CTCPs and speakers in ERC [5.6] Handle composite faces better in erc-display-message etc/ERC-NEWS | 29 ++- lisp/erc/erc-backend.el | 39 ++-- lisp/erc/erc-button.el | 78 ++++---- lisp/erc/erc-dcc.el | 16 +- lisp/erc/erc-fill.el | 25 ++- lisp/erc/erc-match.el | 29 +-- lisp/erc/erc-sasl.el | 8 +- lisp/erc/erc-stamp.el | 21 ++- lisp/erc/erc-track.el | 12 +- lisp/erc/erc.el | 99 +++++++--- test/lisp/erc/erc-button-tests.el | 2 +- test/lisp/erc/erc-fill-tests.el | 5 +- test/lisp/erc/erc-scenarios-match.el | 259 ++++++++++++++++++++++++--- 13 files changed, 467 insertions(+), 155 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 40bcd934772..795553f1666 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -144,11 +144,12 @@ the same effect by issuing a "/CLEAR" at the prompt. Some minor quality-of-life niceties have finally made their way to ERC. For example, the function 'erc-echo-timestamp' is now interactive and can be invoked on any message to view its timestamp in -the echo area. The command 'erc-button-previous' now moves to the -beginning instead of the end of buttons. A new command, 'erc-news', -can now be invoked to visit this very file. And the 'irccontrols' -module now supports additional colors and special handling for -"spoilers" (hidden text). +the echo area. Fool visibility has become togglable with the new +command 'erc-match-toggle-hidden-fools'. The 'button' module's +'erc-button-previous' now moves to the beginning instead of the end of +buttons. A new command, 'erc-news', can be invoked to visit this very +file. And the 'irccontrols' module now supports additional colors and +special handling for "spoilers" (hidden text). ** Changes in the library API. @@ -197,6 +198,9 @@ traversing messages. To compensate, a new property, 'erc-timestamp', now spans message bodies but not the newlines delimiting them. Somewhat relatedly, the function 'erc-insert-aligned' has been deprecated and removed from the primary client code path. +Additionally, the 'stamp' module now merges its 'invisible' property +with existing ones, when present, and it includes all white space +around stamps when doing so. *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and provided library diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 549de4feeb8..a5b0af41b2a 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -660,6 +660,10 @@ erc-match--hide-fools-offset-bounds (defun erc-hide-fools (match-type _nickuserhost _message) "Hide comments from designated fools." (when (eq match-type 'fool) + (erc-match--hide-message))) + +(defun erc-match--hide-message () + (progn ; FIXME raise sexp (if erc-match--hide-fools-offset-bounds (let ((beg (point-min)) (end (point-max))) @@ -677,12 +681,21 @@ erc-beep-on-match (beep))) (defun erc-match--modify-invisibility-spec () - "Add an ellipsis property to the local spec." + "Add an `erc-match' 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)))) +(defun erc-match-toggle-hidden-fools () + "Toggle fool visibility. +Expect `erc-hide-fools' or a function that does something similar +to be in `erc-text-matched-hook'." + (interactive) + (if (memq 'erc-match (ensure-list buffer-invisibility-spec)) + (remove-from-invisibility-spec 'erc-match) + (add-to-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 2f52d78d42b..83ee4a200ed 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -437,6 +437,7 @@ erc-insert-timestamp-right (goto-char (point-max)) (forward-char -1) ; before the last newline (let* ((str-width (string-width string)) + (buffer-invisibility-spec nil) ; `current-column' > 0 window ; used in computation of `pos' only (pos (cond (erc-timestamp-right-column erc-timestamp-right-column) diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index edc1749cdd2..715fe9c25d7 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -24,8 +24,11 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(require 'erc-stamp) -(require 'erc-match) +(eval-when-compile + (require 'erc-join) + (require 'erc-stamp) + (require 'erc-match)) + (require 'erc-fill) ;; This defends against a regression in which all matching by the @@ -62,6 +65,9 @@ erc-scenarios-match--stamp-left-current-nick ;; interactively, and check for wierdness before and after doing ;; M-: (remove-from-invisibility-spec 'erc-match) RET. (defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) + (unless noninteractive + (kill-new "(remove-from-invisibility-spec 'erc-match)")) + (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") (dumb-server (erc-d-run "localhost" t 'foonet)) @@ -236,6 +242,93 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) -(eval-when-compile (require 'erc-join)) +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () + :tags '(:expensive-test) + (should (eq erc-insert-timestamp-function + #'erc-insert-timestamp-left-and-right)) + + ;; Rewind the clock to known date artificially. + (let ((erc-stamp--current-time 704591940) + (erc-stamp--tz t) + (erc-fill-function #'erc-fill-static) + (bob-utterance-counter 0)) + + (erc-scenarios-match--invisible-stamp + + (lambda () + (ert-info ("Baseline check") + ;; False date printed initially before anyone speaks. + (when (zerop bob-utterance-counter) + (save-excursion + (goto-char (point-min)) + (search-forward "[Wed Apr 29 1992]") + (search-forward "[23:59]")))) + + (ert-info ("Line endings in Bob's messages are invisible") + ;; The message proper has the `invisible' property `erc-match'. + (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) + (mend (next-single-property-change mbeg 'erc-command))) + + (if (/= 1 bob-utterance-counter) + (should-not (field-at-pos mend)) + ;; For Bob's stamped message, check newline after stamp. + (should (eq (field-at-pos mend) 'erc-timestamp)) + (setq mend (field-end mend))) + + ;; The `erc-timestamp' property spans entire messages, + ;; including stamps and filled text, which makes for + ;; convenient traversal when `erc-stamp-mode' is enabled. + (should (get-text-property (pos-bol) 'erc-timestamp)) + (should (= (next-single-property-change (pos-bol) 'erc-timestamp) + mend)) + + ;; Line ending has the `invisible' property `erc-match'. + (should (= (char-after mend) ?\n)) + (should (eq (get-text-property mend'invisible) 'erc-match)))) + + ;; Only the message right after Alice speaks contains stamps. + (when (= 1 bob-utterance-counter) + + (ert-info ("Date stamp occupying previous line is invisible") + (save-excursion + (forward-line -1) + (goto-char (pos-bol)) + (should (looking-at (rx "[Mon May 4 1992]"))) + ;; Date stamp has a combined `invisible' property value + ;; that extends until the start of the message proper. + (should (equal (get-text-property (point) 'invisible) + '(timestamp erc-match))) + (should (= (next-single-property-change (point) 'invisible) + (1+ (pos-eol)))))) + + (ert-info ("Folding preserved despite invisibility") + ;; Message has a trailing time stamp, but it's been folded + ;; over to the next line. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (save-excursion + (forward-line) + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))) + + ;; Stamp invisibility starts where message's ends. + (let ((msgend (next-single-property-change (pos-bol) 'invisible))) + ;; Stamp has a combined `invisible' property value. + (should (equal (get-text-property msgend 'invisible) + '(timestamp erc-match))) + + ;; Combined `invisible' property spans entire timestamp. + (should (= (next-single-property-change msgend 'invisible) + (save-excursion (forward-line) (pos-eol))))))) + + (cl-incf bob-utterance-counter)) + + ;; Alice. + (lambda () + ;; Set clock ahead a week or so. + (setq erc-stamp--current-time 704962800) + + ;; This message has no time stamp and is completely visible. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (should-not (next-single-property-change (pos-bol) 'invisible)))))) ;;; erc-scenarios-match.el ends here -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Respect-existing-invisibility-props-in-erc-stamp.patch >From 4ac5a1835bdaa31d69449e1bcc3aa3d33c770585 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 2 Jul 2023 20:58:37 -0700 Subject: [PATCH 1/4] [5.6] Respect existing invisibility props in erc-stamp * lisp/erc/erc-match.el (erc-hide-fools): change `invisible' property to `erc-match' for all messages, not just those with offset bounds. (erc-match--modify-invisibility-spec): Fix error in doc string. (erc-match-toggle-hidden-fools): New command. * lisp/erc/erc-stamp.el (erc-stamp--invisible-property): Add new internal variable to hold existing `invisible' property merged with the one registered by this module. (erc-stamp--skip-when-invisible): Add new internal variable to act as escape hatch for pre ERC-5.6 behavior in which timestamps were not applied at all to invisible messages. This led to strange-looking, uneven logs, and it prevented other modules from offering toggle functionality for invisibility spec members registered to them. (erc-add-timestamp): Merge with existing `invisible' property, when present, instead of clobbering, but only when escape hatch `erc-stamp--skip-when-invisible' is nil. (erc-insert-timestamp-left, erc-format-timestamp): Use possibly merged `invisible' prop value. Don't bother with `isearch-open-invisible', which only affects overlays. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--invisible-stamp): Move setup and core assertions for stamp-related tests into fixture. (erc-scenarios-match--stamp-left-fools-invisible): Fix temporarily disabled test and use fixture. (erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-right-invisible-fill-wrap): New test. (Bug#64301) --- etc/ERC-NEWS | 14 +- lisp/erc/erc-match.el | 18 +- lisp/erc/erc-stamp.el | 21 ++- test/lisp/erc/erc-scenarios-match.el | 259 ++++++++++++++++++++++++--- 4 files changed, 273 insertions(+), 39 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5665b760ea9..37435a1d915 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -144,11 +144,12 @@ the same effect by issuing a "/CLEAR" at the prompt. Some minor quality-of-life niceties have finally made their way to ERC. For example, the function 'erc-echo-timestamp' is now interactive and can be invoked on any message to view its timestamp in -the echo area. The command 'erc-button-previous' now moves to the -beginning instead of the end of buttons. A new command, 'erc-news', -can now be invoked to visit this very file. And the 'irccontrols' -module now supports additional colors and special handling for -"spoilers" (hidden text). +the echo area. Fool visibility has become togglable with the new +command 'erc-match-toggle-hidden-fools'. The 'button' module's +'erc-button-previous' now moves to the beginning instead of the end of +buttons. A new command, 'erc-news', can be invoked to visit this very +file. And the 'irccontrols' module now supports additional colors and +special handling for "spoilers" (hidden text). ** Changes in the library API. @@ -197,6 +198,9 @@ traversing messages. To compensate, a new property, 'erc-timestamp', now spans message bodies but not the newlines delimiting them. Somewhat relatedly, the function 'erc-insert-aligned' has been deprecated and removed from the primary client code path. +Additionally, the 'stamp' module now merges its 'invisible' property +with existing ones, when present, and it includes all white space +around stamps when doing so. *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and provided library diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 2b7fff87ff0..cd2c55b0091 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -669,10 +669,9 @@ erc-hide-fools (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))))) + ;; Before ERC 5.6, this also used to add an `intangible' + ;; property, but the docs say it's now obsolete. + (put-text-property (point-min) (point-max) 'invisible 'erc-match)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. @@ -681,12 +680,21 @@ erc-beep-on-match (beep))) (defun erc-match--modify-invisibility-spec () - "Add an ellipsis property to the local spec." + "Add an `erc-match' 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)))) +(defun erc-match-toggle-hidden-fools () + "Toggle fool visibility. +Expect `erc-hide-fools' or a function that does something similar +to be in `erc-text-matched-hook'." + (interactive) + (if (memq 'erc-match (ensure-list buffer-invisibility-spec)) + (remove-from-invisibility-spec 'erc-match) + (add-to-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 5035e60a87d..83ee4a200ed 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -179,6 +179,12 @@ stamp (kill-local-variable 'erc-timestamp-last-inserted-left) (kill-local-variable 'erc-timestamp-last-inserted-right)))) +(defvar erc-stamp--invisible-property nil + "Existing `invisible' property value and/or symbol `timestamp'.") + +(defvar erc-stamp--skip-when-invisible nil + "Escape hatch for omitting stamps when first char is invisible.") + (defun erc-stamp--recover-on-reconnect () (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted @@ -209,8 +215,11 @@ erc-add-timestamp (progn ; remove this `progn' on next major refactor (let* ((ct (erc-stamp--current-time)) (invisible (get-text-property (point-min) 'invisible)) + (erc-stamp--invisible-property + ;; FIXME on major version bump, make this `erc-' prefixed. + (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp)) (erc-stamp--current-time ct)) - (unless invisible + (unless (setq invisible (and erc-stamp--skip-when-invisible invisible)) (funcall erc-insert-timestamp-function (erc-format-timestamp ct erc-timestamp-format))) ;; FIXME this will error when advice has been applied. @@ -380,7 +389,7 @@ erc-insert-timestamp-left (s (if ignore-p (make-string len ? ) string))) (unless ignore-p (setq erc-timestamp-last-inserted string)) (erc-put-text-property 0 len 'field 'erc-timestamp s) - (erc-put-text-property 0 len 'invisible 'timestamp s) + (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) (insert s))) (defun erc-insert-aligned (string pos) @@ -428,6 +437,7 @@ erc-insert-timestamp-right (goto-char (point-max)) (forward-char -1) ; before the last newline (let* ((str-width (string-width string)) + (buffer-invisibility-spec nil) ; `current-column' > 0 window ; used in computation of `pos' only (pos (cond (erc-timestamp-right-column erc-timestamp-right-column) @@ -477,6 +487,8 @@ erc-insert-timestamp-right (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) + (erc-put-text-property from (point) 'invisible + erc-stamp--invisible-property) (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) @@ -520,9 +532,8 @@ erc-format-timestamp (let ((ts (format-time-string format time erc-stamp--tz))) (erc-put-text-property 0 (length ts) 'font-lock-face 'erc-timestamp-face ts) - (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) - (erc-put-text-property 0 (length ts) - 'isearch-open-invisible 'timestamp ts) + (erc-put-text-property 0 (length ts) 'invisible + erc-stamp--invisible-property ts) ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 782907bfc30..715fe9c25d7 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -24,8 +24,12 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(require 'erc-stamp) -(require 'erc-match) +(eval-when-compile + (require 'erc-join) + (require 'erc-stamp) + (require 'erc-match)) + +(require 'erc-fill) ;; This defends against a regression in which all matching by the ;; `erc-match-message' fails when `erc-add-timestamp' precedes it in @@ -57,28 +61,23 @@ erc-scenarios-match--stamp-left-current-nick (should (eq (get-text-property (1- (point)) 'font-lock-face) 'erc-current-nick-face)))))) -;; This asserts that when stamps appear before a message, -;; some non-nil invisibility property spans the entire message. -(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () - :tags '(:expensive-test) - (ert-skip "WIP: fix included in bug#64301") +;; When hacking on tests that use this fixture, it's best to run it +;; interactively, and check for wierdness before and after doing +;; M-: (remove-from-invisibility-spec 'erc-match) RET. +(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) + (unless noninteractive + (kill-new "(remove-from-invisibility-spec 'erc-match)")) + (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") (dumb-server (erc-d-run "localhost" t 'foonet)) (port (process-contact dumb-server :service)) (erc-server-flood-penalty 0.1) - (erc-insert-timestamp-function 'erc-insert-timestamp-left) (erc-timestamp-only-if-changed-flag nil) (erc-fools '("bob")) (erc-text-matched-hook '(erc-hide-fools)) (erc-autojoin-channels-alist '((FooNet "#chan"))) - (expect (erc-d-t-make-expecter)) - (hiddenp (lambda () - (and (eq (field-at-pos (pos-bol)) 'erc-timestamp) - (get-text-property (pos-bol) 'invisible) - (>= (next-single-property-change (pos-bol) - 'invisible nil) - (pos-eol)))))) + (expect (erc-d-t-make-expecter))) (ert-info ("Connect") (with-current-buffer (erc :server "127.0.0.1" @@ -94,30 +93,242 @@ erc-scenarios-match--stamp-left-fools-invisible (ert-info ("Ensure lines featuring \"bob\" are invisible") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (should (funcall expect 10 " tester, welcome!")) - (should (funcall hiddenp)) + (ert-info (" tester, welcome!") (funcall hiddenp)) ;; Alice's is the only one visible. (should (funcall expect 10 " tester, welcome!")) - (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) - (should (get-text-property (pos-bol) 'invisible)) - (should-not (get-text-property (point) 'invisible)) + (ert-info (" tester, welcome!") (funcall visiblep)) (should (funcall expect 10 " alice: But, as it seems")) - (should (funcall hiddenp)) + (ert-info (" alice: But, as it seems") (funcall hiddenp)) (should (funcall expect 10 " bob: Well, this is the forest")) - (should (funcall hiddenp)) + (ert-info (" bob: Well, this is the forest") (funcall hiddenp)) (should (funcall expect 10 " bob: And will you")) - (should (funcall hiddenp)) + (ert-info (" bob: And will you") (funcall hiddenp)) (should (funcall expect 10 " alice: Live, and be prosperous")) - (should (funcall hiddenp)) + (ert-info (" alice: Live, and be prosperous") (funcall hiddenp)) (should (funcall expect 10 "ERC>")) (should-not (get-text-property (pos-bol) 'invisible)) (should-not (get-text-property (point) 'invisible)))))) -(eval-when-compile (require 'erc-join)) +;; This asserts that when stamps appear before a message, registered +;; invisibility properties owned by modules span the entire message. +(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left)) + (erc-scenarios-match--invisible-stamp + + (lambda () + ;; This is a time-stamped message. + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + + ;; Leading stamp has combined `invisible' property value. + (should (equal (get-text-property (pos-bol) 'invisible) + '(timestamp erc-match))) + + ;; Message proper has the `invisible' property `erc-match'. + (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) + (should (eq (get-text-property msg-beg 'invisible) 'erc-match)) + (should (>= (next-single-property-change msg-beg 'invisible nil) + (pos-eol))))) + + (lambda () + ;; This is a time-stamped message. + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + (should (get-text-property (pos-bol) 'invisible)) + + ;; The entire message proper is visible. + (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) + (should + (= (next-single-property-change msg-beg 'invisible nil (pos-eol)) + (pos-eol)))))))) + +(defun erc-scenarios-match--find-eol () + (save-excursion + (goto-char (next-single-property-change (point) 'erc-command)) + (pos-eol))) + +;; In most cases, `erc-hide-fools' makes line endings invisible. +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) + (erc-scenarios-match--invisible-stamp + + (lambda () + (let ((end (erc-scenarios-match--find-eol))) + ;; The end of the message is a newline. + (should (= ?\n (char-after end))) + + ;; Every message has a trailing time stamp. + (should (eq (field-at-pos (1- end)) 'erc-timestamp)) + + ;; Stamps have a combined `invisible' property value. + (should (equal (get-text-property (1- end) 'invisible) + '(timestamp erc-match))) + + ;; The final newline is hidden by `match', not `stamps' + (should (equal (get-text-property end 'invisible) 'erc-match)) + + ;; The message proper has the `invisible' property `erc-match', + ;; and it starts after the preceding newline. + (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + + ;; It ends just before the timestamp. + (let ((msg-end (next-single-property-change (pos-bol) 'invisible))) + (should (equal (get-text-property msg-end 'invisible) + '(timestamp erc-match))) + + ;; Stamp's `invisible' property extends throughout the stamp + ;; and ends before the trailing newline. + (should (= (next-single-property-change msg-end 'invisible) end))))) + + (lambda () + (let ((end (erc-scenarios-match--find-eol))) + ;; This message has a time stamp like all the others. + (should (eq (field-at-pos (1- end)) 'erc-timestamp)) + + ;; The entire message proper is visible. + (should-not (get-text-property (pos-bol) 'invisible)) + (let ((inv-beg (next-single-property-change (pos-bol) 'invisible))) + (should (eq (get-text-property inv-beg 'invisible) + 'timestamp)))))))) + +;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides +;; the preceding message's line ending. +(ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right) + (erc-fill-function #'erc-fill-wrap)) + (erc-scenarios-match--invisible-stamp + + (lambda () + ;; Every message has a trailing time stamp. + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + + ;; Stamps appear in the right margin. + (should (equal (car (get-text-property (1- (pos-eol)) 'display)) + '(margin right-margin))) + + ;; Stamps have a combined `invisible' property value. + (should (equal (get-text-property (1- (pos-eol)) 'invisible) + '(timestamp erc-match))) + + ;; The message proper has the `invisible' property `erc-match', + ;; which starts at the preceding newline... + (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match)) + + ;; ... and ends just before the timestamp. + (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible))) + (should (equal (get-text-property msgend 'invisible) + '(timestamp erc-match))) + + ;; The newline before `erc-insert-marker' is still visible. + (should-not (get-text-property (pos-eol) 'invisible)) + (should (= (next-single-property-change msgend 'invisible) + (pos-eol))))) + + (lambda () + ;; This message has a time stamp like all the others. + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + + ;; Unlike hidden messages, the preceding newline is visible. + (should-not (get-text-property (1- (pos-bol)) 'invisible)) + + ;; The entire message proper is visible. + (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) + (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) + +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () + :tags '(:expensive-test) + (should (eq erc-insert-timestamp-function + #'erc-insert-timestamp-left-and-right)) + + ;; Rewind the clock to known date artificially. + (let ((erc-stamp--current-time 704591940) + (erc-stamp--tz t) + (erc-fill-function #'erc-fill-static) + (bob-utterance-counter 0)) + + (erc-scenarios-match--invisible-stamp + + (lambda () + (ert-info ("Baseline check") + ;; False date printed initially before anyone speaks. + (when (zerop bob-utterance-counter) + (save-excursion + (goto-char (point-min)) + (search-forward "[Wed Apr 29 1992]") + (search-forward "[23:59]")))) + + (ert-info ("Line endings in Bob's messages are invisible") + ;; The message proper has the `invisible' property `erc-match'. + (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) + (mend (next-single-property-change mbeg 'erc-command))) + + (if (/= 1 bob-utterance-counter) + (should-not (field-at-pos mend)) + ;; For Bob's stamped message, check newline after stamp. + (should (eq (field-at-pos mend) 'erc-timestamp)) + (setq mend (field-end mend))) + + ;; The `erc-timestamp' property spans entire messages, + ;; including stamps and filled text, which makes for + ;; convenient traversal when `erc-stamp-mode' is enabled. + (should (get-text-property (pos-bol) 'erc-timestamp)) + (should (= (next-single-property-change (pos-bol) 'erc-timestamp) + mend)) + + ;; Line ending has the `invisible' property `erc-match'. + (should (= (char-after mend) ?\n)) + (should (eq (get-text-property mend'invisible) 'erc-match)))) + + ;; Only the message right after Alice speaks contains stamps. + (when (= 1 bob-utterance-counter) + + (ert-info ("Date stamp occupying previous line is invisible") + (save-excursion + (forward-line -1) + (goto-char (pos-bol)) + (should (looking-at (rx "[Mon May 4 1992]"))) + ;; Date stamp has a combined `invisible' property value + ;; that extends until the start of the message proper. + (should (equal (get-text-property (point) 'invisible) + '(timestamp erc-match))) + (should (= (next-single-property-change (point) 'invisible) + (1+ (pos-eol)))))) + + (ert-info ("Folding preserved despite invisibility") + ;; Message has a trailing time stamp, but it's been folded + ;; over to the next line. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (save-excursion + (forward-line) + (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))) + + ;; Stamp invisibility starts where message's ends. + (let ((msgend (next-single-property-change (pos-bol) 'invisible))) + ;; Stamp has a combined `invisible' property value. + (should (equal (get-text-property msgend 'invisible) + '(timestamp erc-match))) + + ;; Combined `invisible' property spans entire timestamp. + (should (= (next-single-property-change msgend 'invisible) + (save-excursion (forward-line) (pos-eol))))))) + + (cl-incf bob-utterance-counter)) + + ;; Alice. + (lambda () + ;; Set clock ahead a week or so. + (setq erc-stamp--current-time 704962800) + + ;; This message has no time stamp and is completely visible. + (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) + (should-not (next-single-property-change (pos-bol) 'invisible)))))) ;;; erc-scenarios-match.el ends here -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Simplify-erc-button-add-nickname-buttons.patch >From a8e8078b95fa3dfa0b37b88a4d3b94432ae75468 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 30 Jun 2023 23:42:01 -0700 Subject: [PATCH 2/4] [5.6] Simplify erc-button-add-nickname-buttons * lisp/erc/erc-button.el (erc-button--nick): Remove `face' slot which was set to `erc-button-face' by default. It's ignored when the button is a nick and thus completely useless. (erc-button-add-nickname-buttons): Rework and reflow for readability. Don't bind or set `erc-button' face because it's ignored when dealing with nicks. Don't return the value of face options when calling a `form' function because they can be nil in practice even though their Custom type specs do not say so. * lisp/erc/erc.el (erc--get-speaker-bounds): New helper function to retrieve bounds of a speaker label when present. (Bug#64301) --- lisp/erc/erc-button.el | 78 ++++++++++++++++++++---------------------- lisp/erc/erc.el | 10 ++++++ 2 files changed, 47 insertions(+), 41 deletions(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 0c616a6026d..c30f7c10ca6 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -355,8 +355,6 @@ erc-button--nick ( cuser nil :type (or null erc-channel-user) ;; The CDR of a value from an `erc-channel-users' table. :documentation "A possibly nil `erc-channel-user'.") - ( face erc-button-face :type symbol - :documentation "Temp `erc-button-face' while buttonizing.") ( nickname-face erc-button-nickname-face :type symbol :documentation "Temp `erc-button-nickname-face' while buttonizing.") ( mouse-face erc-button-mouse-face :type symbol @@ -431,45 +429,43 @@ erc-button--phantom-users-mode (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." - (let ((form (nth 2 entry)) - (fun (nth 3 entry)) - (erc-button-buttonize-nicks (and erc-button-buttonize-nicks - erc-button--modify-nick-function)) - bounds word) - (when (and form (setq form (erc-button--extract-form form))) - (goto-char (point-min)) - (while (erc-forward-word) - (when (setq bounds (erc-bounds-of-word-at-point)) - (setq word (buffer-substring-no-properties - (car bounds) (cdr bounds))) - (let* ((erc-button-face erc-button-face) - (erc-button-mouse-face erc-button-mouse-face) - (erc-button-nickname-face erc-button-nickname-face) - (down (erc-downcase word)) - (cuser (and erc-channel-users - (gethash down erc-channel-users))) - (user (or (and cuser (car cuser)) - (and erc-server-users - (gethash down erc-server-users)) - (funcall erc-button--fallback-user-function - down word bounds))) - (data (list word))) - (when (or (not (functionp form)) - (and-let* ((user) - (obj (funcall form (make-erc-button--nick - :bounds bounds :data data - :downcased down :user user - :cuser (cdr cuser))))) - (setq bounds (erc-button--nick-bounds obj) - data (erc-button--nick-data obj) - erc-button-mouse-face - (erc-button--nick-mouse-face obj) - erc-button-nickname-face - (erc-button--nick-nickname-face obj) - erc-button-face - (erc-button--nick-face obj)))) - (erc-button-add-button (car bounds) (cdr bounds) - fun t data)))))))) + (when-let ((form (nth 2 entry)) + ;; Spoof `form' slot of default legacy `nicknames' entry + ;; so `erc-button--extract-form' sees a function value. + (form (let ((erc-button-buttonize-nicks + (and erc-button-buttonize-nicks + erc-button--modify-nick-function))) + (erc-button--extract-form form))) + (seen 0)) + (goto-char (point-min)) + (while-let + (((erc-forward-word)) + (bounds (or (and (= 1 (cl-incf seen)) (erc--get-speaker-bounds)) + (erc-bounds-of-word-at-point))) + (word (buffer-substring-no-properties (car bounds) (cdr bounds))) + (down (erc-downcase word))) + (let* ((erc-button-mouse-face erc-button-mouse-face) + (erc-button-nickname-face erc-button-nickname-face) + (cuser (and erc-channel-users (gethash down erc-channel-users))) + (user (or (and cuser (car cuser)) + (and erc-server-users (gethash down erc-server-users)) + (funcall erc-button--fallback-user-function + down word bounds))) + (data (list word))) + (when (or (not (functionp form)) + (and-let* ((user) + (obj (funcall form (make-erc-button--nick + :bounds bounds :data data + :downcased down :user user + :cuser (cdr cuser))))) + (setq erc-button-mouse-face ; might be null + (erc-button--nick-mouse-face obj) + erc-button-nickname-face ; might be null + (erc-button--nick-nickname-face obj) + data (erc-button--nick-data obj) + bounds (erc-button--nick-bounds obj)))) + (erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry) + 'nickp data)))))) (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e23185934f7..06b88ade2a0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5025,6 +5025,16 @@ erc-is-message-ctcp-and-not-action-p (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) +(define-inline erc--get-speaker-bounds () + "Return the bounds of `erc-speaker' property when present. +Assume buffer is narrowed to the confines of an inserted message." + (inline-quote + (and-let* + (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE))) + (beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min)) + (next-single-property-change (point-min) 'erc-speaker)))) + (cons beg (next-single-property-change beg 'erc-speaker))))) + (defvar erc--user-from-nick-function #'erc--examine-nick "Function to possibly consider unknown user. Must return either nil or a cons of an `erc-server-user' and a -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Add-text-props-for-CTCPs-and-speakers-in-ERC.patch >From 0f324a9946804fe01476ed62be9c23e99b47aaed Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 24 Jun 2023 18:33:20 -0700 Subject: [PATCH 3/4] [5.6] Add text props for CTCPs and speakers in ERC * lisp/erc/erc-fill.el (erc-fill-spaced-commands, erc-fill--spaced-commands): Rename former to latter and demote from user option to internal variable. (erc-fill--wrap-continued-message-p): Use `erc-ctcp' text prop instead of face to detect ACTION. (erc-fill--wrap-action-dedent-p): New variable to toggle whether `line-prefix' is applied to CTCP ACTION messages. (erc-fill-wrap): Look for `erc-speaker' property before falling back on word at point. Use `erc-ctcp' to detect ACTION messages. * lisp/erc/erc.el (erc-notice-face, erc-action-face): Prefer weight of `semi-bold' when available so that buttonization is at least somewhat visible. (erc-send-action): Ensure nickname passed to `erc-display-message' has `erc-speaker' property and `erc-ctcp' ACTION property. Apply both `erc-input-face' and `erc-action-face' to messages. (erc--own-property-names): Add `erc-speaker'. (erc-format-privmessage): Don't clobber `erc-nick-prefix-face'. That is, retain face applied to a leading stretch of characters in the `nick' parameter. But continue to discard trailing faces. (erc-format-my-nick, erc-ctcp-query-ACTION): Add a new text property, `erc-speaker', to the nick portion of the formatted speaker label. Do this to assist modules, like `button' and `match', that re-parse speakers in inserted messages. (erc-process-ctcp-query): Add `erc-ctcp' property to entire message before insertion hooks. (Bug#64301) * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--compare): Warn about certain unreliable comparisons if generalizing helper for use by other modules. --- lisp/erc/erc-fill.el | 25 ++++++++++++++------- lisp/erc/erc.el | 40 ++++++++++++++++++++++++--------- test/lisp/erc/erc-fill-tests.el | 5 ++++- 3 files changed, 51 insertions(+), 19 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 5115e45210d..a65c95f1d85 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -124,11 +124,9 @@ erc-fill-line-spacing :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) number)) -(defcustom erc-fill-spaced-commands '(PRIVMSG NOTICE) +(defvar erc-fill--spaced-commands '(PRIVMSG NOTICE) "Types of messages to add space between on graphical displays. -Only considered when `erc-fill-line-spacing' is non-nil." - :package-version '(ERC . "5.6") ; FIXME sync on release - :type '(repeat (choice integer symbol))) +Only considered when `erc-fill-line-spacing' is non-nil.") (defvar-local erc-fill--function nil "Internal copy of `erc-fill-function'. @@ -153,12 +151,12 @@ erc-fill (p (point-min))) (widen) (when (or (and-let* ((cmd (get-text-property p 'erc-command))) - (memq cmd erc-fill-spaced-commands)) + (memq cmd erc-fill--spaced-commands)) (and-let* ((cmd (save-excursion (forward-line -1) (get-text-property (point) 'erc-command)))) - (memq cmd erc-fill-spaced-commands))) + (memq cmd erc-fill--spaced-commands))) (put-text-property (1- p) p 'line-spacing erc-fill-line-spacing)))))))) @@ -384,8 +382,7 @@ erc-fill--wrap-continued-message-p (when (eq 'erc-timestamp (field-at-pos m)) (set-marker m (field-end m))) (and (eq 'PRIVMSG (get-text-property m 'erc-command)) - (not (eq (get-text-property m 'font-lock-face) - 'erc-action-face)) + (not (eq (get-text-property m 'erc-ctcp) 'ACTION)) (cons (get-text-property m 'erc-timestamp) (get-text-property (1+ m) 'erc-data))))) (ts (pop props)) @@ -418,6 +415,12 @@ erc-fill--wrap-stamp-insert-prefixed-date `(space :width (- erc-fill--wrap-value ,width)))) args) +;; An escape hatch for third-party code expecting speakers of ACTION +;; messages to be exempt from `line-prefix'. This could be converted +;; into a user option if users feel similarly. +(defvar erc-fill--wrap-action-dedent-p t + "Whether to dedent speakers in CTCP \"ACTION\" lines.") + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." @@ -428,6 +431,12 @@ erc-fill-wrap (let ((len (or (and erc-fill--wrap-length-function (funcall erc-fill--wrap-length-function)) (progn + (when-let ((e (erc--get-speaker-bounds)) + (b (pop e)) + ((or erc-fill--wrap-action-dedent-p + (not (eq (get-text-property b 'erc-ctcp) + 'ACTION))))) + (goto-char e)) (skip-syntax-forward "^-") (forward-char) ;; Using the `invisible' property might make more diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 06b88ade2a0..d43281825fb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1302,12 +1302,15 @@ erc-command-indicator-face (defface erc-notice-face '((default :weight bold) + (((class color) (min-colors 88) (supports :weight semi-bold)) + :weight semi-bold :foreground "SlateBlue") (((class color) (min-colors 88)) :foreground "SlateBlue") (t :foreground "blue")) "ERC face for notices." :group 'erc-faces) -(defface erc-action-face '((t :weight bold)) +(defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold) + (t :weight bold)) "ERC face for actions generated by /ME." :group 'erc-faces) @@ -2723,10 +2726,13 @@ erc-send-action (erc-send-ctcp-message tgt (format "ACTION %s" str) force) (let ((erc-insert-pre-hook (cons (lambda (s) ; Leave newline be. - (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)) - erc-insert-pre-hook))) - (erc-display-message nil 'input (current-buffer) - 'ACTION ?n (erc-current-nick) ?a str ?u "" ?h ""))) + (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s) + (put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s)) + erc-insert-pre-hook)) + (nick (erc-current-nick))) + (setq nick (propertize nick 'erc-speaker nick)) + (erc-display-message nil '(action input) (current-buffer) + 'ACTION ?n nick ?a str ?u "" ?h ""))) ;; Display interface @@ -4532,7 +4538,7 @@ erc-ensure-channel-name (concat "#" channel))) (defvar erc--own-property-names - '( tags erc-parsed display ; core + '( tags erc-speaker erc-parsed display ; core ;; `erc-display-prompt' rear-nonsticky erc-prompt field front-sticky read-only ;; stamp @@ -5051,11 +5057,19 @@ erc-format-privmessage (mark-e (if msgp (if privp "*" ">") "-")) (str (format "%s%s%s %s" mark-s nick mark-e msg)) (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) + (nick-prefix-face (get-text-property 0 'font-lock-face nick)) + (prefix-len (or (and nick-prefix-face (text-property-not-all + 0 (length nick) 'font-lock-face + nick-prefix-face nick)) + 0)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick (erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str) - (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'font-lock-face nick-face str) + (erc-put-text-properties (+ (length mark-s) prefix-len) + (+ (length mark-s) (length nick)) + '(font-lock-face erc-speaker) str + (list nick-face + (substring-no-properties nick prefix-len))) (erc-put-text-property (+ (length mark-s) (length nick)) (length str) 'font-lock-face msg-face str) str)) @@ -5107,7 +5121,7 @@ erc-format-my-nick (concat (propertize open 'font-lock-face 'erc-default-face) (propertize mode 'font-lock-face 'erc-my-nick-prefix-face) - (propertize nick 'font-lock-face 'erc-my-nick-face) + (propertize nick 'font-lock-face 'erc-my-nick-face 'erc-speaker nick) (propertize close 'font-lock-face 'erc-default-face))) (let ((prefix "> ")) (propertize prefix 'font-lock-face 'erc-default-face)))) @@ -5345,7 +5359,12 @@ erc-process-ctcp-query 'ctcp-empty ?n nick) (while queries (let* ((type (upcase (car (split-string (car queries))))) - (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))) + (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))) + (erc-insert-pre-hook + (cons (lambda (s) + (put-text-property 0 (1- (length s)) 'erc-ctcp + (intern type) s)) + erc-insert-pre-hook))) (if (and hook (boundp hook)) (if (string-equal type "ACTION") (run-hook-with-args-until-success @@ -5380,6 +5399,7 @@ erc-ctcp-query-ACTION (buf (or (erc-get-buffer to proc) (erc-get-buffer nick proc) (process-buffer proc)))) + (setq nick (propertize nick 'erc-speaker nick)) (erc-display-message parsed 'action buf 'ACTION ?n nick ?u login ?h host ?a s)))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 15a8087f848..99ec4a9635e 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -153,7 +153,10 @@ erc-fill-tests--compare (with-temp-file expect-file (insert repr)) (if (file-exists-p expect-file) - ;; Compare set-equal over intervals + ;; Compare set-equal over intervals. This comparison is + ;; less useful for messages treated by other modules because + ;; it doesn't compare "nested" props belonging to + ;; string-valued properties, like timestamps. (should (equal-including-properties (read repr) (read (with-temp-buffer -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.6-Handle-composite-faces-better-in-erc-display-mes.patch >From aae534bcbe0eb75e436c428b248a87748ec185b6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 24 Jun 2023 18:33:20 -0700 Subject: [PATCH 4/4] [5.6] Handle composite faces better in erc-display-message * etc/ERC-NEWS: Tell users to update their customized `erc-track-faces-priority-list' values. * lisp/erc/erc-backend.el (erc-server-401, erc-server-402, erc-server-403, erc-server-404, erc-server-405, erc-server-406, erc-server-412, erc-server-421, erc-server-432, erc-server-442, erc-server-461, erc-server-474, erc-server-475, erc-server-482): Change `erc-display-message' `type' arg from list of both `error' and `notice' to just a lone `error' symbol. (erc-server-465, erc-server-431): Inline calls to `erc-display-error-notice, except just pass `error' for `type' arg. Also, remove forward declaration for `erc-display-error-notice' from atop file. * lisp/erc/erc-dcc.el (erc-dcc-do-GET-command, erc-dcc-do-SEND-command, erc-ctcp-query-DCC, erc-dcc-handle-ctcp-chat, erc-dcc-get-filter, erc-dcc-get-sentinel): Change `erc-display-message' `type' arg from list to `error'. * lisp/erc/erc-match.el (erc-hide-fools): Merge `invisible' prop `erc-match' with existing, if present, and move body to helper for hiding matched messages. (erc-match--hide-message): New generalized helper function to hide messages regardless of match type. * lisp/erc/erc-sasl.el (erc-server-902, erc-server-907, erc-server-904, erc-server-908): Change `erc-display-message' `type' arg from list to `error'. * lisp/erc/erc-track.el: Require `erc-button' atop file because options, like `erc-track-faces-priority-list', whose Custom type involves faces, fail validation otherwise. (erc-track--attn-faces): Add new internal variable for faces that should always light up the mode line no matter what. (erc-track-modified-channels, erc-track-face-priority): Prepend `erc-track--attn-faces' to `erc-track-faces-priority-list'. * lisp/erc/erc.el (erc--compose-text-properties): New internal variable to alter behavior of `erc-put-text-property'. (erc--merge-prop): Port over `erc-button-add-face' for general use by all of ERC. (erc-display-message-highlight): Set face to `erc-default-face' the symbol instead of the string. (erc-display-message): Explain how type param works when it's a list. Fix code in type-as-list branch so that it combines faces instead of clobbers them. (erc-nickname-in-use): Inline `erc-display-error-notice' but change `type' arg from list to `error'. (erc-put-text-property): Unalias from `put-text-property' and instead fall back to latter unless caller wants to combine faces, in which case defer to `erc--merge-prop'. * test/lisp/erc/erc-button-tests.el (erc-button--display-error-notice-with-keys): Expect a combined "error notice" face. (Bug#64301) --- etc/ERC-NEWS | 15 ++++++++++ lisp/erc/erc-backend.el | 39 +++++++++++------------- lisp/erc/erc-dcc.el | 16 +++++----- lisp/erc/erc-match.el | 13 ++++---- lisp/erc/erc-sasl.el | 8 ++--- lisp/erc/erc-track.el | 12 ++++++-- lisp/erc/erc.el | 49 ++++++++++++++++++++++--------- test/lisp/erc/erc-button-tests.el | 2 +- 8 files changed, 97 insertions(+), 57 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 37435a1d915..795553f1666 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -228,6 +228,21 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** 'erc-display-message' combines faces when 'type' is a list. +Users may notice that ERC now renders messages passed to the +convenience function 'erc-display-error-notice' in a combination of +'erc-error-face' and 'erc-notice-face'. This is merely a consequence +of that function being a wrapper around 'erc-display-message', which +has gotten smarter about how it treats face properties when its 'type' +parameter is a list. Originally, ERC's authors intended to display +both server-originating and ERC-generated errors in this style, but +due to various complications, that intent was never realized until +this release, and even now only partially so. Indeed, to minimize +churn, the effect has been limited to internal and usage errors. For +third-party code, the key take away is that more 'font-lock-face' +properties encountered in the wild may be combinations of faces rather +than simple ones. + *** Prompt input is split before 'erc-pre-send-functions' has a say. Hook members are now treated to input whose lines have already been adjusted to fall within the allowed length limit. For convenience, diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index f1b51f9234a..bf21ec96225 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -148,7 +148,6 @@ erc-whowas-on-nosuchnick (declare-function erc-current-time "erc" (&optional specified-time)) (declare-function erc-default-target "erc" nil) (declare-function erc-delete-default-channel "erc" (channel &optional buffer)) -(declare-function erc-display-error-notice "erc" (parsed string)) (declare-function erc-display-server-message "erc" (_proc parsed)) (declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time)) (declare-function erc-format-message "erc" (msg &rest args)) @@ -2411,47 +2410,47 @@ erc-server-322-message (when erc-whowas-on-nosuchnick (erc-log (format "cmd: WHOWAS: %s" nick/channel)) (erc-server-send (format "WHOWAS %s 1" nick/channel))) - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's401 ?n nick/channel))) (define-erc-response-handler (402) "No such server." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's402 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (403) "No such channel." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's403 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (404) "Cannot send to channel." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's404 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (405) "Can't join that many channels." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's405 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (406) "No such nick." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active 's406 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (412) "No text to send." nil - (erc-display-message parsed '(notice error) 'active 's412)) + (erc-display-message parsed 'error 'active 's412)) (define-erc-response-handler (421) "Unknown command." nil - (erc-display-message parsed '(notice error) 'active 's421 + (erc-display-message parsed 'error 'active 's421 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (432) "Bad nick." nil - (erc-display-message parsed '(notice error) 'active 's432 + (erc-display-message parsed 'error 'active 's432 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (433) @@ -2469,12 +2468,12 @@ erc-server-322-message (define-erc-response-handler (442) "Not on channel." nil - (erc-display-message parsed '(notice error) 'active 's442 + (erc-display-message parsed 'error 'active 's442 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (461) "Not enough parameters for command." nil - (erc-display-message parsed '(notice error) 'active 's461 + (erc-display-message parsed 'error 'active 's461 ?c (cadr (erc-response.command-args parsed)) ?m (erc-response.contents parsed))) @@ -2482,20 +2481,19 @@ erc-server-322-message "You are banned from this server." nil (setq erc-server-banned t) ;; show the server's message, as a reason might be provided - (erc-display-error-notice - parsed + (erc-display-message parsed 'error 'active (erc-response.contents parsed))) (define-erc-response-handler (474) "Banned from channel errors." nil - (erc-display-message parsed '(notice error) nil + (erc-display-message parsed 'error nil (intern (format "s%s" (erc-response.command parsed))) ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (475) "Channel key needed." nil - (erc-display-message parsed '(notice error) nil 's475 + (erc-display-message parsed 'error nil 's475 ?c (cadr (erc-response.command-args parsed))) (when erc-prompt-for-channel-key (let ((channel (cadr (erc-response.command-args parsed))) @@ -2516,7 +2514,7 @@ erc-server-322-message "You need to be a channel operator to do that." nil (let ((channel (cadr (erc-response.command-args parsed))) (message (erc-response.contents parsed))) - (erc-display-message parsed '(notice error) 'active 's482 + (erc-display-message parsed 'error 'active 's482 ?c channel ?m message))) (define-erc-response-handler (671) @@ -2551,11 +2549,8 @@ erc-server-322-message ;; 491 - No O-lines for your host ;; 501 - Unknown MODE flag ;; 502 - Cannot change mode for other users - "Generic display of server error messages. - -See `erc-display-error-notice'." nil - (erc-display-error-notice - parsed + "Display error message as given from server." nil + (erc-display-message parsed 'error 'active (intern (format "s%s" (erc-response.command parsed))))) ;; FIXME: These are yet to be implemented, they're just stubs for now diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index cc2dcc9a788..8968295a83c 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -566,7 +566,7 @@ erc-dcc-do-GET-command file)) (erc-dcc-get-file elt file proc) (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-get-cmd-aborted ?n nick ?f filename))) (t @@ -578,7 +578,7 @@ erc-dcc-do-GET-command (setq erc-dcc-list (cons (plist-put elt :turbo t) (delq elt erc-dcc-list))))) (erc-display-message - nil '(notice error) 'active + nil 'error 'active 'dcc-get-notfound ?n nick ?f filename)))) (defvar-local erc-dcc-byte-count nil) @@ -648,7 +648,7 @@ erc-dcc-do-SEND-command nil 'notice 'active 'dcc-send-offer ?n nick ?f file) (erc-dcc-send-file nick file) t) - (erc-display-message nil '(notice error) proc "File not found") t)) + (erc-display-message nil 'error proc "File not found") t)) ;;; Server message handling (i.e. messages from remote users) @@ -675,7 +675,7 @@ erc-ctcp-query-DCC (funcall handler proc query nick login host to) ;; FIXME: Send a ctcp error notice to the remote end? (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-ctcp-unknown ?q query ?n nick ?u login ?h host)))) @@ -771,7 +771,7 @@ erc-dcc-handle-ctcp-chat (;; DCC CHAT requests must be sent to you, and you alone. (not (erc-current-nick-p to)) (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-request-bogus ?r "CHAT" ?n nick ?u login ?h host)) ((string-match erc-dcc-ctcp-query-chat-regexp query) ;; We need to use let* here, since erc-dcc-member might clutter @@ -805,7 +805,7 @@ erc-dcc-handle-ctcp-chat proc)))) (t (erc-display-message - nil '(notice error) proc + nil 'error proc 'dcc-malformed ?n nick ?u login ?h host ?q query))))) @@ -1053,7 +1053,7 @@ erc-dcc-get-filter ((and (> (plist-get erc-dcc-entry-data :size) 0) (> received-bytes (plist-get erc-dcc-entry-data :size))) (erc-display-message - nil '(notice error) 'active + nil 'error 'active 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) @@ -1085,7 +1085,7 @@ erc-dcc-get-sentinel (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) (let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))) (erc-display-message - nil (if done 'notice '(notice error)) erc-server-process + nil (if done 'notice 'error) erc-server-process (if done 'dcc-get-complete 'dcc-get-failed) ?v (plist-get erc-dcc-entry-data :size) ?f erc-dcc-file-name diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index cd2c55b0091..a5b0af41b2a 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -657,21 +657,22 @@ erc-go-to-log-matches-buffer (defvar-local erc-match--hide-fools-offset-bounds nil) -;; FIXME this should merge with instead of overwrite existing -;; `invisible' values. (defun erc-hide-fools (match-type _nickuserhost _message) - "Hide foolish comments. -This function should be called from `erc-text-matched-hook'." + "Hide comments from designated fools." (when (eq match-type 'fool) + (erc-match--hide-message))) + +(defun erc-match--hide-message () + (progn ; FIXME raise sexp (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))) + (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match))) ;; Before ERC 5.6, this also used to add an `intangible' ;; property, but the docs say it's now obsolete. - (put-text-property (point-min) (point-max) 'invisible 'erc-match)))) + (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index c6922b1b26b..73d318fd4fd 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -377,7 +377,7 @@ erc-sasl--destroy (define-erc-response-handler (902) "Handle an ERR_NICKLOCKED response." nil - (erc-display-message parsed '(notice error) 'active 's902 + (erc-display-message parsed 'error 'active 's902 ?n (car (erc-response.command-args parsed)) ?s (erc-response.contents parsed)) (erc-sasl--destroy proc)) @@ -391,19 +391,19 @@ erc-sasl--destroy (define-erc-response-handler (907) "Handle a RPL_SASLALREADY response." nil - (erc-display-message parsed '(notice error) 'active 's907 + (erc-display-message parsed 'error 'active 's907 ?s (erc-response.contents parsed))) (define-erc-response-handler (904 905 906) "Handle various SASL-related error responses." nil - (erc-display-message parsed '(notice error) 'active + (erc-display-message parsed 'error 'active (intern (format "s%s" (erc-response.command parsed))) ?s (erc-response.contents parsed)) (erc-sasl--destroy proc)) (define-erc-response-handler (908) "Handle a RPL_SASLMECHS response." nil - (erc-display-message parsed '(notice error) 'active 's908 + (erc-display-message parsed 'error 'active 's908 ?m (alist-get 'mechanism erc-sasl--options) ?s (string-join (cdr (erc-response.command-args parsed)) " ")) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index e060b7039bd..bc09c5d87fb 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -37,6 +37,7 @@ (eval-when-compile (require 'cl-lib)) (require 'erc) (require 'erc-match) +(require 'erc-button) ; for validating faces in custom options ;;; Code: @@ -309,6 +310,8 @@ erc-track-switch-direction (const leastactive) (const mostactive))) +(defconst erc-track--attn-faces '((erc-error-face erc-notice-face)) + "Faces whose presence always trigger mode-line inclusion.") (defun erc-track-remove-from-mode-line () "Remove `erc-track-modified-channels' from the mode-line." @@ -736,6 +739,9 @@ erc-track-find-face (declare (obsolete erc-track-select-mode-line-face "28.1")) (erc-track-select-mode-line-face (car faces) (cdr faces))) +;; Note that unless called by `erc-track-modified-channels', +;; `erc-track-faces-priority-list' will not begin with +;; `erc-track--attn-faces'. (defun erc-track-select-mode-line-face (cur-face new-faces) "Return the face to use in the mode line. @@ -802,7 +808,9 @@ erc-track-modified-channels ;; (in the car), change its face attribute (in the cddr) if ;; necessary. See `erc-modified-channels-alist' for the ;; exact data structure used. - (let ((faces (erc-faces-in (buffer-string)))) + (let ((faces (erc-faces-in (buffer-string))) + (erc-track-faces-priority-list + `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))) (unless (and (or (eq erc-track-priority-faces-only 'all) (member this-channel erc-track-priority-faces-only)) @@ -873,7 +881,7 @@ erc-track-face-priority higher number than any other face in that list." (let ((count 0)) (catch 'done - (dolist (item erc-track-faces-priority-list) + (dolist (item `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)) (if (equal item face) (throw 'done t) (setq count (1+ count))))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d43281825fb..98127697815 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2885,6 +2885,25 @@ erc-display-line (process-buffer erc-server-process) (current-buffer)))))) +(defvar erc--compose-text-properties nil + "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.") + +(defun erc--merge-prop (from to prop val &optional object) + "Compose existing PROP values with VAL between FROM and TO in OBJECT. +For spans where PROP is non-nil, cons VAL onto the existing +value, ensuring a proper list. Otherwise, just set PROP to VAL. +See also `erc-button-add-face'." + (let ((old (get-text-property from prop object)) + (pos from) + (end (next-single-property-change from prop object to)) + new) + (while (< pos to) + (setq new (if old (cons val (ensure-list old)) val)) + (put-text-property pos end prop new object) + (setq pos end + old (get-text-property pos prop object) + end (next-single-property-change pos prop object to))))) + (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. @@ -2896,7 +2915,7 @@ erc-display-message-highlight 0 (length string) 'font-lock-face (or (intern-soft (concat "erc-" (symbol-name type) "-face")) - "erc-default-face") + 'erc-default-face) string) string))) @@ -3100,6 +3119,10 @@ erc-display-message ARGS, PARSED, and TYPE are used to format MSG sensibly. +When TYPE is a list of symbols, call handlers from left to right. +For example, expect a TYPE of (notice error) to result in MSG's +`font-lock-face' being (erc-error-face erc-notice-face). + See also `erc-format-message' and `erc-display-line'." (let ((string (if (symbolp msg) (apply #'erc-format-message msg args) @@ -3110,10 +3133,9 @@ erc-display-message ((null type) string) ((listp type) - (mapc (lambda (type) - (setq string - (erc-display-message-highlight type string))) - type) + (let ((erc--compose-text-properties t)) + (dolist (type type) + (setq string (erc-display-message-highlight type string)))) string) ((symbolp type) (erc-display-message-highlight type string)))) @@ -4941,17 +4963,14 @@ erc--nickname-in-use-make-request (erc-cmd-NICK temp)) (defun erc-nickname-in-use (nick reason) - "If NICK is unavailable, tell the user the REASON. - -See also `erc-display-error-notice'." + "Explain REASON NICK is taken and maybe ask for alternate." (if (or (not erc-try-new-nick-p) ;; how many default-nicks are left + one more try... (eq erc-nick-change-attempt-count (if (consp erc-nick) (+ (length erc-nick) 1) 1))) - (erc-display-error-notice - nil + (erc-display-message nil 'error 'active (format "Nickname %s is %s, try another." nick reason)) (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1)) (let ((newnick (nth 1 erc-default-nicks)) @@ -4974,8 +4993,7 @@ erc-nickname-in-use (- 9 (length erc-nick-uniquifier)))) erc-nick-uniquifier))) (erc--nickname-in-use-make-request nick newnick) - (erc-display-error-notice - nil + (erc-display-message nil 'error 'active (format "Nickname %s is %s, trying %s" nick reason newnick))))) @@ -6079,7 +6097,7 @@ erc-highlight-error (erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s) s) -(defalias 'erc-put-text-property 'put-text-property +(defun erc-put-text-property (start end property value &optional object) "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'. @@ -6089,7 +6107,10 @@ 'erc-put-text-property OBJECT is modified without being copied first. You can redefine or `defadvice' this function in order to add -EmacsSpeak support.") +EmacsSpeak support." + (if erc--compose-text-properties + (erc--merge-prop start end property value object) + (put-text-property start end property value object))) (defalias 'erc-list 'ensure-list) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index 6a6f6934389..3dacf95a59f 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -265,7 +265,7 @@ erc-button--display-error-notice-with-keys (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k (erc-button-next 1) (should (equal (get-text-property (point) 'font-lock-face) - '(erc-button erc-error-face))) + '(erc-button erc-error-face erc-notice-face))) (should (eq (get-text-property (point) 'mouse-face) 'highlight)) (should (eq erc-button-face 'erc-button))) ; extent evaporates -- 2.41.0 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Thu Jul 13 22:20:29 2023 Received: (at 64301-done) by debbugs.gnu.org; 14 Jul 2023 02:20:29 +0000 Received: from localhost ([127.0.0.1]:41104 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qK8Py-0000yw-5r for submit@debbugs.gnu.org; Thu, 13 Jul 2023 22:20:29 -0400 Received: from mail-108-mta90.mxroute.com ([136.175.108.90]:40485) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qK8Pq-0000yg-CF for 64301-done@debbugs.gnu.org; Thu, 13 Jul 2023 22:20:24 -0400 Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta90.mxroute.com (ZoneMTA) with ESMTPSA id 1895232dd030004cef.001 for <64301-done@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Fri, 14 Jul 2023 02:20:12 +0000 X-Zone-Loop: 45b20eb0f10adff5cd2ec7ebafe3173779ba7e2b0a38 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=+CM9wrRzJKZUYzUQu2a0mQNb9lnLAj0ptxc1mVjEQHo=; b=Nd57EozeKucFPexOkNpuz1Xzw/ +XxWjSgrqn1XcwQnV8cOHt3Zif04lMlcGZAxzzhqzQhfpAy8vRWCm+FoQBoRjYvF1WTfQgjQLoj32 rjmT/geG5FWVk5xh8qOiteXHH5eLrXzGqpEhfjHt3h7s/R41NJ3ppfLUCcbdZTVIh+sSMmiYLDWSg nDUw2Ucf+eTXTy3sdVXHiEmbRJJukgUlkFZ/fiw4SpaFmQlmWXLsb8XFXTAM7jFY9PNJfmU8l5b+S 2Et9iLjNMKYONs0fvKPsP2GZD/MKkmIJZGAqI+j+JFNPp3S+sFWo9OYVDli/oJDFijEW3ncFF6EZe R0nCWqHw==; From: "J.P." To: 64301-done@debbugs.gnu.org Subject: Re: bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with In-Reply-To: <87sf9y32q9.fsf@neverwas.me> (J. P.'s message of "Sat, 08 Jul 2023 07:19:26 -0700") References: <87bkh21gfa.fsf@neverwas.me> <87sf9y32q9.fsf@neverwas.me> Date: Thu, 13 Jul 2023 19:20:08 -0700 Message-ID: <87zg3zqlnr.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Authenticated-Id: masked@neverwas.me X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 64301-done Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) "J.P." writes: > v2. [...] Combine faces in `erc-display-message' when called with a > list `type' arg. > [...] > > This iteration includes a number of changes, the most important being > one that looks severe but is largely mechanical. It concerns a bug > that's been around forever and, as such, is now part of the foundation. > Basically, the `type' parameter of the function `erc-display-message' > determines a special handler that applies styling to a message. When the > parameter is a list, the function calls each handler in turn, left to > right, which clobbers existing faces instead of combines them. The net > effect (in most cases) is identical to calling the function with the > last member alone. Despite this, it would seem ending up with multiple, > "layered" faces was the authors' original intent based on the ubiquity > of call sites featuring the list variant. > > Authoritative intent aside, in the intervening decades, other code was > written that expects the current clobbering behavior. An example of this > exists in the default value of `erc-track-faces-priority-list', which > contains `erc-error-face' alone rather than paired with > `erc-notice-face'. There may indeed be others that will go undetected > should we make this "fix," which I'm still in favor of despite the > attendant risk. Actually, I decided against doing this after all [1]. There was simply no telling what kind of damage might result from these changes rippling through two decades of third-party code. > Though improved call-site readability is one upside, I'm more > interested in the UX possibilities such layering opens up. Subtle > benefits can already be seen after applying these changes, for > example, in text inserted for outgoing /me commands, which now sport a > combination of `erc-input-face' and `erc-action-face'. > > In a bid to mitigate potential breakage, at least internally, I've gone > ahead and mass-replaced all instances of > (erc-display-message parsed '(notice error) ...) > with > (erc-display-message parsed 'error ...) > which amounts to 38 incisions in total. Once again, if we leave things > as is, users who've customized `erc-track-faces-priority-list' won't > ever see error-colored text in their mode line, which is a deal breaker. Instead of all that, I've implemented an uglier and less transparent (but also non-disruptive) way for `erc-display-message' to perform such layering. Basically, callers can request the effect by specifying a slight variant of its list `type' parameter, namely, one headed by the symbol t, e.g, (erc-display-message parsed '(t notice error) ...) Without the t, this function acts as it always has. With it, the function composes faces atop one another, left to right. Existing call sites obviously won't benefit, but at least they'll be shielded from harm. Hope that's an agreeable compromise. Thanks and closing. [1] https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=d45770e8 From debbugs-submit-bounces@debbugs.gnu.org Sat Jul 15 10:06:04 2023 Received: (at 64301-done) by debbugs.gnu.org; 15 Jul 2023 14:06:04 +0000 Received: from localhost ([127.0.0.1]:45675 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qKfuN-0006wP-K9 for submit@debbugs.gnu.org; Sat, 15 Jul 2023 10:06:04 -0400 Received: from mail-108-mta89.mxroute.com ([136.175.108.89]:34697) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qKfuJ-0006vw-Jk for 64301-done@debbugs.gnu.org; Sat, 15 Jul 2023 10:06:02 -0400 Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta89.mxroute.com (ZoneMTA) with ESMTPSA id 18959df51c70004cef.001 for <64301-done@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Sat, 15 Jul 2023 14:05:55 +0000 X-Zone-Loop: 10cb518fb4bd92cf39a01c4857ff7f6b0642f5d620f3 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=5X5gbCSwIiqGEo1cxob193MbvZmmL3B6+hEt0Ge/AMA=; b=Qkr4d9RuiQb8Ad31GAfUHjYK3B o8oLgileYQ4ZLhFgmsdwSOseUjXABJn/k9X6CzcJmbnjySCULxz7PT62xYCch9QjPbFBalwXFRJiR TTiSiIDU0N3C1XuY1IQt5AxY6ihD7esbepCvr49HX5s1yYJNtX3698ku8ph8tJETG37ReE2J1169E s42pEtz68ZDQyNVzMBgKx0qURqeAfPhMGsvUbouN7JKihNVgTtjHAWmIGl94Hl7qvxFSrqKY7mwor dz5OFotVBXW9wW60cO0cqiRiQmjc9/dCT4z6B8++twuGsPG38CTFxMujPjpzVQFJ4FGBpPdg44VsG 32uN4UgQ==; From: "J.P." To: 64301-done@debbugs.gnu.org Subject: Re: bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with In-Reply-To: <87zg3zqlnr.fsf@neverwas.me> (J. P.'s message of "Thu, 13 Jul 2023 19:20:08 -0700") References: <87bkh21gfa.fsf@neverwas.me> <87sf9y32q9.fsf@neverwas.me> <87zg3zqlnr.fsf@neverwas.me> Date: Sat, 15 Jul 2023 07:05:51 -0700 Message-ID: <87cz0tnubk.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Authenticated-Id: masked@neverwas.me X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 64301-done Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Some functionality I introduced for wrangling text properties in erc-match.el was shoddily done and not very usable from the perspective of another module building on erc-match as a foundation. The attached patch attempts to correct that. It also ditches "erc-" namespacing for invisibility spec members because the potential for collision seems pretty low given that we're only talking ERC buffers. (Hopefully, I'm not missing any downsides here.) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Don-t-bother-namespacing-ERC-s-own-invisibility-.patch >From 9fe0a765eba8105ef616280487882247834c299a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 14 Jul 2023 21:08:31 -0700 Subject: [PATCH] [5.6] Don't bother namespacing ERC's own invisibility props * lisp/erc/erc-fill.el (erc-fill-wrap-mode, erc-fill-wrap-enable): Update name of internal flag for hiding messages. * lisp/erc/erc-match.el (erc-match--hide-fools-offset-bounds, erc-match--offset-invisible-bounds-p): Rename internal variable from former to latter. (erc-match--hide-fools-offset-bounds): Call `erc-match--hide-message' with own `invisible' property value specifically for fools. Specifically, use `match-fools' rather than `erc-match' or `erc-match-fools' to save room when visually inspecting. This retains the module name as a prefix to hopefully minimize collisions with invisibility spec members owned by non-ERC minor modes. (erc-match--hide-message): Define property parameter instead of hard-coding to `erc-match'. (erc-match--modify-invisibility-spec): Use toggle command non-interactively for adding and removing invisibility spec member. (erc-match-toggle-hidden-fools): Add explicit override argument and defer to general helper for actually modifying spec. (erc-match--toggle-hidden): New helper for toggling invisibility spec. * lisp/erc/erc.el (erc--merge-prop): If new value is a list, prepend onto existing. * test/lisp/erc/erc-scenarios-match.el: (erc-scenarios-match--invisible-stamp): Fix comment. (erc-scenarios-match--find-eol): Fix bug affecting interactive use. (erc-scenarios-match--stamp-left-fools-invisible, erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-right-invisible-fill-wrap, erc-scenarios-match--stamp-both-invisible-fill-static): Update `invisible' property from `erc-match' to `match-fools'. * test/lisp/erc/erc-tests.el (erc-tests--equal-including-properties): Relocate macro in same file. (erc--merge-prop): New test. (Bug#64301) --- lisp/erc/erc-fill.el | 4 +-- lisp/erc/erc-match.el | 43 +++++++++++++++-------- lisp/erc/erc.el | 9 +++-- test/lisp/erc/erc-scenarios-match.el | 51 ++++++++++++++++------------ test/lisp/erc/erc-tests.el | 50 +++++++++++++++++++++++---- 5 files changed, 110 insertions(+), 47 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a65c95f1d85..2dfae35b871 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -290,7 +290,7 @@ erc-fill-wrap-mode-map (defvar erc-match-mode) (defvar erc-button-mode) -(defvar erc-match--hide-fools-offset-bounds) +(defvar erc-match--offset-invisible-bounds-p) (defun erc-fill--wrap-ensure-dependencies () (let (missing-deps) @@ -340,7 +340,7 @@ fill-wrap (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-match--offset-invisible-bounds-p t)) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index a5b0af41b2a..3fba35536b3 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -655,24 +655,25 @@ erc-go-to-log-matches-buffer (get-buffer (car buffer-cons)))))) (switch-to-buffer buffer-name))) -(defvar-local erc-match--hide-fools-offset-bounds nil) +(defvar-local erc-match--offset-invisible-bounds-p nil + "Whether to hide a message from its preceding newline.") (defun erc-hide-fools (match-type _nickuserhost _message) "Hide comments from designated fools." (when (eq match-type 'fool) - (erc-match--hide-message))) + (erc-match--hide-message 'match-fools))) -(defun erc-match--hide-message () +(defun erc-match--hide-message (prop) (progn ; FIXME raise sexp - (if erc-match--hide-fools-offset-bounds + (if erc-match--offset-invisible-bounds-p (let ((beg (point-min)) (end (point-max))) (save-restriction (widen) - (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match))) + (erc--merge-prop (1- beg) (1- end) 'invisible prop))) ;; Before ERC 5.6, this also used to add an `intangible' ;; property, but the docs say it's now obsolete. - (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match)))) + (erc--merge-prop (point-min) (point-max) 'invisible prop)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. @@ -682,19 +683,31 @@ erc-beep-on-match (defun erc-match--modify-invisibility-spec () "Add an `erc-match' property to the local spec." + ;; Hopefully, this will be extended to do the same for other + ;; invisible properties managed by this module. (if erc-match-mode - (add-to-invisibility-spec 'erc-match) + (erc-match-toggle-hidden-fools +1) (erc-with-all-buffers-of-server nil nil - (remove-from-invisibility-spec 'erc-match)))) + (erc-match-toggle-hidden-fools -1)))) -(defun erc-match-toggle-hidden-fools () +(defun erc-match-toggle-hidden-fools (arg) "Toggle fool visibility. -Expect `erc-hide-fools' or a function that does something similar -to be in `erc-text-matched-hook'." - (interactive) - (if (memq 'erc-match (ensure-list buffer-invisibility-spec)) - (remove-from-invisibility-spec 'erc-match) - (add-to-invisibility-spec 'erc-match))) +Expect the function `erc-hide-fools' or similar to be present in +`erc-text-matched-hook'." + (interactive "P") + (erc-match--toggle-hidden 'match-fools arg)) + +(defun erc-match--toggle-hidden (prop arg) + "Toggle invisibility for spec member PROP. +Treat ARG in a manner similar to mode toggles defined by +`define-minor-mode'." + (when arg + (setq arg (prefix-numeric-value arg))) + (if (memq prop (ensure-list buffer-invisibility-spec)) + (unless (natnump arg) + (remove-from-invisibility-spec prop)) + (when (or (not arg) (natnump arg)) + (add-to-invisibility-spec prop)))) (provide 'erc-match) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 03c21059a92..6ed919c91c2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3011,13 +3011,18 @@ erc--merge-prop "Compose existing PROP values with VAL between FROM and TO in OBJECT. For spans where PROP is non-nil, cons VAL onto the existing value, ensuring a proper list. Otherwise, just set PROP to VAL. -See also `erc-button-add-face'." +When VAL is itself a list, prepend its members onto an existing +value. See also `erc-button-add-face'." (let ((old (get-text-property from prop object)) (pos from) (end (next-single-property-change from prop object to)) new) (while (< pos to) - (setq new (if old (cons val (ensure-list old)) val)) + (setq new (if old + (if (listp val) + (append val (ensure-list old)) + (cons val (ensure-list old))) + val)) (put-text-property pos end prop new object) (setq pos end old (get-text-property pos prop object) diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 8a718962c55..a438635960e 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -62,11 +62,15 @@ erc-scenarios-match--stamp-left-current-nick 'erc-current-nick-face)))))) ;; When hacking on tests that use this fixture, it's best to run it -;; interactively, and check for wierdness before and after doing -;; M-: (remove-from-invisibility-spec 'erc-match) RET. +;; interactively, and visually inspect the output with various +;; combinations of: +;; +;; M-x erc-match-toggle-hidden-fools RET +;; M-x erc-toggle-timestamps RET +;; (defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) (unless noninteractive - (kill-new "(remove-from-invisibility-spec 'erc-match)")) + (kill-new "erc-match-toggle-hidden-fools")) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") @@ -128,11 +132,11 @@ erc-scenarios-match--stamp-left-fools-invisible ;; Leading stamp has combined `invisible' property value. (should (equal (get-text-property (pos-bol) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) - ;; Message proper has the `invisible' property `erc-match'. + ;; Message proper has the `invisible' property `match-fools'. (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) - (should (eq (get-text-property msg-beg 'invisible) 'erc-match)) + (should (eq (get-text-property msg-beg 'invisible) 'match-fools)) (should (>= (next-single-property-change msg-beg 'invisible nil) (pos-eol))))) @@ -149,7 +153,10 @@ erc-scenarios-match--stamp-left-fools-invisible (defun erc-scenarios-match--find-eol () (save-excursion - (goto-char (next-single-property-change (point) 'erc-command)) + (if-let ((next (next-single-property-change (point) 'erc-command))) + (goto-char next) + ;; We're already at the end of the message. + (should (get-text-property (1- (point)) 'erc-command))) (pos-eol))) ;; In most cases, `erc-hide-fools' makes line endings invisible. @@ -168,19 +175,19 @@ erc-scenarios-match--stamp-right-fools-invisible ;; Stamps have a combined `invisible' property value. (should (equal (get-text-property (1- end) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; The final newline is hidden by `match', not `stamps' - (should (equal (get-text-property end 'invisible) 'erc-match)) + (should (equal (get-text-property end 'invisible) 'match-fools)) - ;; The message proper has the `invisible' property `erc-match', + ;; The message proper has the `invisible' property `match-fools', ;; and it starts after the preceding newline. - (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) ;; It ends just before the timestamp. (let ((msg-end (next-single-property-change (pos-bol) 'invisible))) (should (equal (get-text-property msg-end 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; Stamp's `invisible' property extends throughout the stamp ;; and ends before the trailing newline. @@ -215,16 +222,16 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap ;; Stamps have a combined `invisible' property value. (should (equal (get-text-property (1- (pos-eol)) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) - ;; The message proper has the `invisible' property `erc-match', + ;; The message proper has the `invisible' property `match-fools', ;; which starts at the preceding newline... - (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match)) + (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'match-fools)) ;; ... and ends just before the timestamp. (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible))) (should (equal (get-text-property msgend 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; The newline before `erc-insert-marker' is still visible. (should-not (get-text-property (pos-eol) 'invisible)) @@ -265,8 +272,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static (search-forward "[23:59]")))) (ert-info ("Line endings in Bob's messages are invisible") - ;; The message proper has the `invisible' property `erc-match'. - (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + ;; The message proper has the `invisible' property `match-fools'. + (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) (mend (next-single-property-change mbeg 'erc-command))) @@ -283,9 +290,9 @@ erc-scenarios-match--stamp-both-invisible-fill-static (should (= (next-single-property-change (pos-bol) 'erc-timestamp) mend)) - ;; Line ending has the `invisible' property `erc-match'. + ;; Line ending has the `invisible' property `match-fools'. (should (= (char-after mend) ?\n)) - (should (eq (get-text-property mend'invisible) 'erc-match)))) + (should (eq (get-text-property mend'invisible) 'match-fools)))) ;; Only the message right after Alice speaks contains stamps. (when (= 1 bob-utterance-counter) @@ -298,7 +305,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static ;; Date stamp has a combined `invisible' property value ;; that extends until the start of the message proper. (should (equal (get-text-property (point) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) (should (= (next-single-property-change (point) 'invisible) (1+ (pos-eol)))))) @@ -314,7 +321,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static (let ((msgend (next-single-property-change (pos-bol) 'invisible))) ;; Stamp has a combined `invisible' property value. (should (equal (get-text-property msgend 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; Combined `invisible' property spans entire timestamp. (should (= (next-single-property-change msgend 'invisible) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b5db5fe8764..610fb149a94 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1272,6 +1272,50 @@ erc-process-input-line (should-not calls)))))) +(defmacro erc-tests--equal-including-properties (a b) + (list (if (< emacs-major-version 29) + 'ert-equal-including-properties + 'equal-including-properties) + a b)) + +(ert-deftest erc--merge-prop () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Baseline. + (insert "abc\n") + (erc--merge-prop 1 3 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 0 2 (erc-test x)))) + (erc--merge-prop 1 3 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 0 2 (erc-test (y x))))) + + ;; Multiple intervals. + (goto-char (point-min)) + (insert "def\n") + (erc--merge-prop 1 2 'erc-test 'x) + (erc--merge-prop 2 3 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("def" 0 1 (erc-test x) 1 2 (erc-test y)))) + (erc--merge-prop 1 3 'erc-test 'z) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("def" 0 1 (erc-test (z x)) 1 2 (erc-test (z y))))) + + ;; New val as list. + (goto-char (point-min)) + (insert "ghi\n") + (erc--merge-prop 2 3 'erc-test '(y z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" 1 2 (erc-test (y z))))) + (erc--merge-prop 1 3 'erc-test '(w x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z))))) + + (when noninteractive + (kill-buffer)))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space @@ -1488,12 +1532,6 @@ erc-message (kill-buffer "ExampleNet") (kill-buffer "#chan"))) -(defmacro erc-tests--equal-including-properties (a b) - (list (if (< emacs-major-version 29) - 'ert-equal-including-properties - 'equal-including-properties) - a b)) - (ert-deftest erc-format-privmessage () ;; Basic PRIVMSG (should (erc-tests--equal-including-properties -- 2.41.0 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Thu Jul 20 09:29:26 2023 Received: (at 64301-done) by debbugs.gnu.org; 20 Jul 2023 13:29:26 +0000 Received: from localhost ([127.0.0.1]:58032 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qMTid-0001kd-Tg for submit@debbugs.gnu.org; Thu, 20 Jul 2023 09:29:26 -0400 Received: from mail-108-mta22.mxroute.com ([136.175.108.22]:44201) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qMTiZ-0001kS-Ul for 64301-done@debbugs.gnu.org; Thu, 20 Jul 2023 09:29:21 -0400 Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta22.mxroute.com (ZoneMTA) with ESMTPSA id 189737d8ff50004cef.001 for <64301-done@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Thu, 20 Jul 2023 13:29:16 +0000 X-Zone-Loop: 05bb7bad9e52ddb82c55ee6b62d7f5c34775bc010092 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=0HPlW1TEbECReBqV2hjLGIJcdFtNye1A9rSZcDJR9GU=; b=TGihEHeIffCfJwlCfS8/UQXRtf 2IiHSIyeYIQWVPEEYTZNEz/gRXjPSXtQutab+tCpD9Uu+4WMAxGU/Lv46OEIWCAC4wzhJ/X76mcwt Gg1p9QWHlCCHroIrh6/9FMSUKpu9aYIo2MHjGGG8FJUxlGwRmNrLKULNxbKYrshM3n8u8lDAgKBhD ifkWtR/i6factgD0ZuNXiEGzPnCBSeWYebVrW8JCRhhFfmtADdnN2MR/D9s2EZQCZzTpjOheP4Cos gn8kTCNXiMITagtzrreMwsE/kkx/0Bps8xiOI86vWGnzGJ3uhimSSKg42V8hkajcusFk3CSL3jJUm 2BXgPmcA==; From: "J.P." To: 64301-done@debbugs.gnu.org Subject: Re: bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with In-Reply-To: <87cz0tnubk.fsf@neverwas.me> (J. P.'s message of "Sat, 15 Jul 2023 07:05:51 -0700") References: <87bkh21gfa.fsf@neverwas.me> <87sf9y32q9.fsf@neverwas.me> <87zg3zqlnr.fsf@neverwas.me> <87cz0tnubk.fsf@neverwas.me> Date: Thu, 20 Jul 2023 06:29:13 -0700 Message-ID: <871qh2iudy.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Authenticated-Id: masked@neverwas.me X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 64301-done Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain v2 (invisibility API). Move primary message-hiding function to erc.el. Invert meaning of invisible-bounds switch and make old non-nil behavior new default. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From 8f0f4c1d424e0a70c6e46b97ca5b75699f80c892 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 20 Jul 2023 05:38:35 -0700 Subject: [PATCH 0/1] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (1): [5.6] Improve ERC's internal invisibility API etc/ERC-NEWS | 9 +++ lisp/erc/erc-fill.el | 16 +++-- lisp/erc/erc-match.el | 46 +++++++------- lisp/erc/erc.el | 32 +++++++++- test/lisp/erc/erc-scenarios-match.el | 95 ++++++++++++++++++++-------- test/lisp/erc/erc-tests.el | 50 +++++++++++++-- 6 files changed, 183 insertions(+), 65 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 4c881e32ab4..16577c73b2e 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -287,6 +287,15 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** Hidden messages contain a preceding rather than trailing newline. +ERC has traditionally only offered to hide messages involving fools, +but plans are to make hiding more powerful. Anyone depending on the +existing behavior should be aware that hidden messages now start and +end one character earlier, so that hidden line endings precede rather +than follow accompanying text. However, an escape hatch is available +in the variable 'erc-legacy-invisible-bounds-p'. It reinstates the +old behavior, which is unsupported by newer modules and features. + *** 'erc-display-message' optionally combines faces. Users may notice that ERC now inserts some important error messages in a combination of 'erc-error-face' and 'erc-notice-face'. This is diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 2dfae35b871..bb11b03e791 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -288,11 +288,17 @@ erc-fill-wrap-mode-map ;; Not sure if this is problematic because `erc-bol' takes no args. " " #'erc-fill--wrap-beginning-of-line) -(defvar erc-match-mode) (defvar erc-button-mode) -(defvar erc-match--offset-invisible-bounds-p) +(defvar erc-legacy-invisible-bounds-p) (defun erc-fill--wrap-ensure-dependencies () + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (when erc-legacy-invisible-bounds-p + (erc--warn-once-before-connect 'erc-fill-wrap-mode + "Module `fill-wrap' is incompatible with the obsolete compatibility" + " flag `erc-legacy-invisible-bounds-p'. Disabling locally in %s." + (current-buffer)) + (setq-local erc-legacy-invisible-bounds-p nil))) (let (missing-deps) (unless erc-fill-mode (push 'fill missing-deps) @@ -336,11 +342,7 @@ fill-wrap ;; Internal integrations. (add-function :after (local 'erc-stamp--insert-date-function) #'erc-fill--wrap-stamp-insert-prefixed-date) - (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--offset-invisible-bounds-p t)) + (erc-stamp--display-margin-mode +1) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 3fba35536b3..50db8a132ec 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -655,25 +655,10 @@ erc-go-to-log-matches-buffer (get-buffer (car buffer-cons)))))) (switch-to-buffer buffer-name))) -(defvar-local erc-match--offset-invisible-bounds-p nil - "Whether to hide a message from its preceding newline.") - (defun erc-hide-fools (match-type _nickuserhost _message) "Hide comments from designated fools." (when (eq match-type 'fool) - (erc-match--hide-message 'match-fools))) - -(defun erc-match--hide-message (prop) - (progn ; FIXME raise sexp - (if erc-match--offset-invisible-bounds-p - (let ((beg (point-min)) - (end (point-max))) - (save-restriction - (widen) - (erc--merge-prop (1- beg) (1- end) 'invisible prop))) - ;; Before ERC 5.6, this also used to add an `intangible' - ;; property, but the docs say it's now obsolete. - (erc--merge-prop (point-min) (point-max) 'invisible prop)))) + (erc--hide-message 'match-fools))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4192ea9a9e2..972cf8d63f3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3007,6 +3007,9 @@ erc-display-line (defvar erc--compose-text-properties nil "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.") +;; We could maintain a cache of all combined values and dispense +;; archetype singleton objects so all occurrences of some list (a b) +;; across all ERC buffers are actually the same object. (defun erc--merge-prop (from to prop val &optional object) "Compose existing PROP values with VAL between FROM and TO in OBJECT. For spans where PROP is non-nil, cons VAL onto the existing @@ -3028,6 +3031,26 @@ erc--merge-prop old (get-text-property pos prop object) end (next-single-property-change pos prop object to))))) +(defvar erc-legacy-invisible-bounds-p nil + "Whether to hide trailing rather than preceding newlines. +Beginning in ERC 5.6, invisibility extends from a message's +preceding newline to its last non-newline character.") +(make-obsolete-variable 'erc-legacy-invisible-bounds-p + "decremented interval now permanent" "30.1") + +(defun erc--hide-message (value) + "Apply `invisible' text-property with VALUE to current message. +Expect to run in a narrowed buffer during message insertion." + (if erc-legacy-invisible-bounds-p + ;; Before ERC 5.6, this also used to add an `intangible' + ;; property, but the docs say it's now obsolete. + (erc--merge-prop (point-min) (point-max) 'invisible value) + (let ((beg (point-min)) + (end (point-max))) + (save-restriction + (widen) + (erc--merge-prop (1- beg) (1- end) 'invisible value))))) + (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index a438635960e..cd899fddb98 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -151,6 +151,12 @@ erc-scenarios-match--stamp-left-fools-invisible (= (next-single-property-change msg-beg 'invisible nil (pos-eol)) (pos-eol)))))))) +(defun erc-scenarios-match--find-bol () + (save-excursion + (should (get-text-property (1- (point)) 'erc-command)) + (goto-char (should (previous-single-property-change (point) 'erc-command))) + (pos-bol))) + (defun erc-scenarios-match--find-eol () (save-excursion (if-let ((next (next-single-property-change (point) 'erc-command))) @@ -160,13 +166,14 @@ erc-scenarios-match--find-eol (pos-eol))) ;; In most cases, `erc-hide-fools' makes line endings invisible. -(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () +(defun erc-scenarios-match--stamp-right-fools-invisible () :tags '(:expensive-test) (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) (erc-scenarios-match--invisible-stamp (lambda () - (let ((end (erc-scenarios-match--find-eol))) + (let ((beg (erc-scenarios-match--find-bol)) + (end (erc-scenarios-match--find-eol))) ;; The end of the message is a newline. (should (= ?\n (char-after end))) @@ -178,7 +185,11 @@ erc-scenarios-match--stamp-right-fools-invisible '(timestamp match-fools))) ;; The final newline is hidden by `match', not `stamps' - (should (equal (get-text-property end 'invisible) 'match-fools)) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (if erc-legacy-invisible-bounds-p + (should (eq (get-text-property end 'invisible) 'match-fools)) + (should (eq (get-text-property beg 'invisible) 'match-fools)) + (should-not (get-text-property end 'invisible)))) ;; The message proper has the `invisible' property `match-fools', ;; and it starts after the preceding newline. @@ -204,6 +215,17 @@ erc-scenarios-match--stamp-right-fools-invisible (should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))) +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () + :tags '(:expensive-test) + (erc-scenarios-match--stamp-right-fools-invisible)) + +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible--nooffset () + :tags '(:expensive-test) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (should-not erc-legacy-invisible-bounds-p) + (let ((erc-legacy-invisible-bounds-p t)) + (erc-scenarios-match--stamp-right-fools-invisible)))) + ;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides ;; the preceding message's line ending. (ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap () @@ -249,8 +271,7 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) -(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () - :tags '(:expensive-test) +(defun erc-scenarios-match--stamp-both-invisible-fill-static () (should (eq erc-insert-timestamp-function #'erc-insert-timestamp-left-and-right)) @@ -292,7 +313,11 @@ erc-scenarios-match--stamp-both-invisible-fill-static ;; Line ending has the `invisible' property `match-fools'. (should (= (char-after mend) ?\n)) - (should (eq (get-text-property mend'invisible) 'match-fools)))) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (if erc-legacy-invisible-bounds-p + (should (eq (get-text-property mend 'invisible) 'match-fools)) + (should (eq (get-text-property mbeg 'invisible) 'match-fools)) + (should-not (get-text-property mend 'invisible)))))) ;; Only the message right after Alice speaks contains stamps. (when (= 1 bob-utterance-counter) @@ -338,4 +363,15 @@ erc-scenarios-match--stamp-both-invisible-fill-static (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) (should-not (next-single-property-change (pos-bol) 'invisible)))))) +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () + :tags '(:expensive-test) + (erc-scenarios-match--stamp-both-invisible-fill-static)) + +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset () + :tags '(:expensive-test) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (should-not erc-legacy-invisible-bounds-p) + (let ((erc-legacy-invisible-bounds-p t)) + (erc-scenarios-match--stamp-both-invisible-fill-static)))) + ;;; erc-scenarios-match.el ends here -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Improve-ERC-s-internal-invisibility-API.patch >From 8f0f4c1d424e0a70c6e46b97ca5b75699f80c892 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 14 Jul 2023 21:08:31 -0700 Subject: [PATCH 1/1] [5.6] Improve ERC's internal invisibility API * etc/ERC-NEWS: Mention that line endings have moved from the end to the beginning of hidden messages. * lisp/erc/erc-fill.el (erc-fill--wrap-ensure-dependencies): Warn when users have `erc-legacy-invisible-bounds-p' enabled, and force it to its default value of nil in the current buffer. (erc-fill-wrap-mode, erc-fill-wrap-enable): Move business involving compat variable for enabling legacy hidden-message behavior to helper. * lisp/erc/erc-match.el (erc-match--hide-fools-offset-bounds): Move internal variable from to main library file and rename to `erc-legacy-invisible-bounds-p'. Also make obsolete and flip semantics so non-nil enables the traditional behavior. (erc-match--hide-message): Move to main library file and rename to `erc--hide-message'. Add a property-value parameter instead of hard-coding to `erc-match'. Also, condition behavior on inverted and renamed compatibility flag `erc-legacy-invisible-bounds-p'. (erc-hide-fools): Call `erc--hide-message' with own value for `invisible' property specifically for fools. That is, use `match-fools' rather than `erc-match' or `erc-match-fools' to save room when visually inspecting. This retains the module name as a prefix to hopefully minimize collisions with invisibility spec members owned by non-ERC minor modes. The `timestamp' spec member owned by erc-stamp likewise lacks a namespace prefix, but its feature/group is already inherent. (erc-match--modify-invisibility-spec): Use toggle command non-interactively for adding and removing invisibility spec member. (erc-match-toggle-hidden-fools): Add explicit override argument and defer to general helper for actually modifying spec. (erc-match--toggle-hidden): New helper for toggling invisibility spec. * lisp/erc/erc.el (erc--merge-prop): If new value is a list, prepend onto existing. Add note about possible space optimization. (erc-legacy-invisible-bounds-p): New obsolete compat variable to enable traditional pre-5.6 invisibility interval on hidden messages. Replaces `erc-match--hide-fools-offset-bounds-p' but has an inverted meaning. The new default value of nil means invisibility covers a shifted interval consisting of the message body plus the line ending immediately preceding it. (erc--hide-message): New function, formerly `erc-match--hide-message' from erc-match.el introduced in ERC 5.6. * test/lisp/erc/erc-scenarios-match.el: (erc-scenarios-match--invisible-stamp): Fix comment and use API function in interactive convenience setup. (erc-scenarios-match--find-bol): New test helper. (erc-scenarios-match--find-eol): Fix bug affecting interactive use. (erc-scenarios-match--stamp-left-fools-invisible, erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-right-invisible-fill-wrap, erc-scenarios-match--stamp-both-invisible-fill-static): Update `invisible' property from `erc-match' to `match-fools'. (erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-both-invisible-fill-static): Move test body to function of same name for use in multiple cases. (erc-scenarios-match--stamp-right-fools-invisible--nooffset, erc-scenarios-match--stamp-both-invisible-fill-static--nooffset): New test variants asserting proper hiding with old pre-5.6 invisibility interval. * test/lisp/erc/erc-tests.el (erc-tests--equal-including-properties): Relocate macro in same file. (erc--merge-prop): New test. (Bug#64301) --- etc/ERC-NEWS | 9 +++ lisp/erc/erc-fill.el | 16 +++-- lisp/erc/erc-match.el | 46 +++++++------- lisp/erc/erc.el | 32 +++++++++- test/lisp/erc/erc-scenarios-match.el | 95 ++++++++++++++++++++-------- test/lisp/erc/erc-tests.el | 50 +++++++++++++-- 6 files changed, 183 insertions(+), 65 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 4c881e32ab4..16577c73b2e 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -287,6 +287,15 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** Hidden messages contain a preceding rather than trailing newline. +ERC has traditionally only offered to hide messages involving fools, +but plans are to make hiding more powerful. Anyone depending on the +existing behavior should be aware that hidden messages now start and +end one character earlier, so that hidden line endings precede rather +than follow accompanying text. However, an escape hatch is available +in the variable 'erc-legacy-invisible-bounds-p'. It reinstates the +old behavior, which is unsupported by newer modules and features. + *** 'erc-display-message' optionally combines faces. Users may notice that ERC now inserts some important error messages in a combination of 'erc-error-face' and 'erc-notice-face'. This is diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a65c95f1d85..bb11b03e791 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -288,11 +288,17 @@ erc-fill-wrap-mode-map ;; Not sure if this is problematic because `erc-bol' takes no args. " " #'erc-fill--wrap-beginning-of-line) -(defvar erc-match-mode) (defvar erc-button-mode) -(defvar erc-match--hide-fools-offset-bounds) +(defvar erc-legacy-invisible-bounds-p) (defun erc-fill--wrap-ensure-dependencies () + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (when erc-legacy-invisible-bounds-p + (erc--warn-once-before-connect 'erc-fill-wrap-mode + "Module `fill-wrap' is incompatible with the obsolete compatibility" + " flag `erc-legacy-invisible-bounds-p'. Disabling locally in %s." + (current-buffer)) + (setq-local erc-legacy-invisible-bounds-p nil))) (let (missing-deps) (unless erc-fill-mode (push 'fill missing-deps) @@ -336,11 +342,7 @@ fill-wrap ;; Internal integrations. (add-function :after (local 'erc-stamp--insert-date-function) #'erc-fill--wrap-stamp-insert-prefixed-date) - (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)) + (erc-stamp--display-margin-mode +1) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index a5b0af41b2a..50db8a132ec 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -655,24 +655,10 @@ erc-go-to-log-matches-buffer (get-buffer (car buffer-cons)))))) (switch-to-buffer buffer-name))) -(defvar-local erc-match--hide-fools-offset-bounds nil) - (defun erc-hide-fools (match-type _nickuserhost _message) "Hide comments from designated fools." (when (eq match-type 'fool) - (erc-match--hide-message))) - -(defun erc-match--hide-message () - (progn ; FIXME raise sexp - (if erc-match--hide-fools-offset-bounds - (let ((beg (point-min)) - (end (point-max))) - (save-restriction - (widen) - (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match))) - ;; Before ERC 5.6, this also used to add an `intangible' - ;; property, but the docs say it's now obsolete. - (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match)))) + (erc--hide-message 'match-fools))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. @@ -682,19 +668,31 @@ erc-beep-on-match (defun erc-match--modify-invisibility-spec () "Add an `erc-match' property to the local spec." + ;; Hopefully, this will be extended to do the same for other + ;; invisible properties managed by this module. (if erc-match-mode - (add-to-invisibility-spec 'erc-match) + (erc-match-toggle-hidden-fools +1) (erc-with-all-buffers-of-server nil nil - (remove-from-invisibility-spec 'erc-match)))) + (erc-match-toggle-hidden-fools -1)))) -(defun erc-match-toggle-hidden-fools () +(defun erc-match-toggle-hidden-fools (arg) "Toggle fool visibility. -Expect `erc-hide-fools' or a function that does something similar -to be in `erc-text-matched-hook'." - (interactive) - (if (memq 'erc-match (ensure-list buffer-invisibility-spec)) - (remove-from-invisibility-spec 'erc-match) - (add-to-invisibility-spec 'erc-match))) +Expect the function `erc-hide-fools' or similar to be present in +`erc-text-matched-hook'." + (interactive "P") + (erc-match--toggle-hidden 'match-fools arg)) + +(defun erc-match--toggle-hidden (prop arg) + "Toggle invisibility for spec member PROP. +Treat ARG in a manner similar to mode toggles defined by +`define-minor-mode'." + (when arg + (setq arg (prefix-numeric-value arg))) + (if (memq prop (ensure-list buffer-invisibility-spec)) + (unless (natnump arg) + (remove-from-invisibility-spec prop)) + (when (or (not arg) (natnump arg)) + (add-to-invisibility-spec prop)))) (provide 'erc-match) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index eca6a90d706..972cf8d63f3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3007,22 +3007,50 @@ erc-display-line (defvar erc--compose-text-properties nil "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.") +;; We could maintain a cache of all combined values and dispense +;; archetype singleton objects so all occurrences of some list (a b) +;; across all ERC buffers are actually the same object. (defun erc--merge-prop (from to prop val &optional object) "Compose existing PROP values with VAL between FROM and TO in OBJECT. For spans where PROP is non-nil, cons VAL onto the existing value, ensuring a proper list. Otherwise, just set PROP to VAL. -See also `erc-button-add-face'." +When VAL is itself a list, prepend its members onto an existing +value. See also `erc-button-add-face'." (let ((old (get-text-property from prop object)) (pos from) (end (next-single-property-change from prop object to)) new) (while (< pos to) - (setq new (if old (cons val (ensure-list old)) val)) + (setq new (if old + (if (listp val) + (append val (ensure-list old)) + (cons val (ensure-list old))) + val)) (put-text-property pos end prop new object) (setq pos end old (get-text-property pos prop object) end (next-single-property-change pos prop object to))))) +(defvar erc-legacy-invisible-bounds-p nil + "Whether to hide trailing rather than preceding newlines. +Beginning in ERC 5.6, invisibility extends from a message's +preceding newline to its last non-newline character.") +(make-obsolete-variable 'erc-legacy-invisible-bounds-p + "decremented interval now permanent" "30.1") + +(defun erc--hide-message (value) + "Apply `invisible' text-property with VALUE to current message. +Expect to run in a narrowed buffer during message insertion." + (if erc-legacy-invisible-bounds-p + ;; Before ERC 5.6, this also used to add an `intangible' + ;; property, but the docs say it's now obsolete. + (erc--merge-prop (point-min) (point-max) 'invisible value) + (let ((beg (point-min)) + (end (point-max))) + (save-restriction + (widen) + (erc--merge-prop (1- beg) (1- end) 'invisible value))))) + (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 8a718962c55..cd899fddb98 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -62,11 +62,15 @@ erc-scenarios-match--stamp-left-current-nick 'erc-current-nick-face)))))) ;; When hacking on tests that use this fixture, it's best to run it -;; interactively, and check for wierdness before and after doing -;; M-: (remove-from-invisibility-spec 'erc-match) RET. +;; interactively, and visually inspect the output with various +;; combinations of: +;; +;; M-x erc-match-toggle-hidden-fools RET +;; M-x erc-toggle-timestamps RET +;; (defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) (unless noninteractive - (kill-new "(remove-from-invisibility-spec 'erc-match)")) + (kill-new "erc-match-toggle-hidden-fools")) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") @@ -128,11 +132,11 @@ erc-scenarios-match--stamp-left-fools-invisible ;; Leading stamp has combined `invisible' property value. (should (equal (get-text-property (pos-bol) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) - ;; Message proper has the `invisible' property `erc-match'. + ;; Message proper has the `invisible' property `match-fools'. (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) - (should (eq (get-text-property msg-beg 'invisible) 'erc-match)) + (should (eq (get-text-property msg-beg 'invisible) 'match-fools)) (should (>= (next-single-property-change msg-beg 'invisible nil) (pos-eol))))) @@ -147,19 +151,29 @@ erc-scenarios-match--stamp-left-fools-invisible (= (next-single-property-change msg-beg 'invisible nil (pos-eol)) (pos-eol)))))))) +(defun erc-scenarios-match--find-bol () + (save-excursion + (should (get-text-property (1- (point)) 'erc-command)) + (goto-char (should (previous-single-property-change (point) 'erc-command))) + (pos-bol))) + (defun erc-scenarios-match--find-eol () (save-excursion - (goto-char (next-single-property-change (point) 'erc-command)) + (if-let ((next (next-single-property-change (point) 'erc-command))) + (goto-char next) + ;; We're already at the end of the message. + (should (get-text-property (1- (point)) 'erc-command))) (pos-eol))) ;; In most cases, `erc-hide-fools' makes line endings invisible. -(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () +(defun erc-scenarios-match--stamp-right-fools-invisible () :tags '(:expensive-test) (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) (erc-scenarios-match--invisible-stamp (lambda () - (let ((end (erc-scenarios-match--find-eol))) + (let ((beg (erc-scenarios-match--find-bol)) + (end (erc-scenarios-match--find-eol))) ;; The end of the message is a newline. (should (= ?\n (char-after end))) @@ -168,19 +182,23 @@ erc-scenarios-match--stamp-right-fools-invisible ;; Stamps have a combined `invisible' property value. (should (equal (get-text-property (1- end) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; The final newline is hidden by `match', not `stamps' - (should (equal (get-text-property end 'invisible) 'erc-match)) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (if erc-legacy-invisible-bounds-p + (should (eq (get-text-property end 'invisible) 'match-fools)) + (should (eq (get-text-property beg 'invisible) 'match-fools)) + (should-not (get-text-property end 'invisible)))) - ;; The message proper has the `invisible' property `erc-match', + ;; The message proper has the `invisible' property `match-fools', ;; and it starts after the preceding newline. - (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) ;; It ends just before the timestamp. (let ((msg-end (next-single-property-change (pos-bol) 'invisible))) (should (equal (get-text-property msg-end 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; Stamp's `invisible' property extends throughout the stamp ;; and ends before the trailing newline. @@ -197,6 +215,17 @@ erc-scenarios-match--stamp-right-fools-invisible (should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))) +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () + :tags '(:expensive-test) + (erc-scenarios-match--stamp-right-fools-invisible)) + +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible--nooffset () + :tags '(:expensive-test) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (should-not erc-legacy-invisible-bounds-p) + (let ((erc-legacy-invisible-bounds-p t)) + (erc-scenarios-match--stamp-right-fools-invisible)))) + ;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides ;; the preceding message's line ending. (ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap () @@ -215,16 +244,16 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap ;; Stamps have a combined `invisible' property value. (should (equal (get-text-property (1- (pos-eol)) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) - ;; The message proper has the `invisible' property `erc-match', + ;; The message proper has the `invisible' property `match-fools', ;; which starts at the preceding newline... - (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match)) + (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'match-fools)) ;; ... and ends just before the timestamp. (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible))) (should (equal (get-text-property msgend 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; The newline before `erc-insert-marker' is still visible. (should-not (get-text-property (pos-eol) 'invisible)) @@ -242,8 +271,7 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) -(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () - :tags '(:expensive-test) +(defun erc-scenarios-match--stamp-both-invisible-fill-static () (should (eq erc-insert-timestamp-function #'erc-insert-timestamp-left-and-right)) @@ -265,8 +293,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static (search-forward "[23:59]")))) (ert-info ("Line endings in Bob's messages are invisible") - ;; The message proper has the `invisible' property `erc-match'. - (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + ;; The message proper has the `invisible' property `match-fools'. + (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) (mend (next-single-property-change mbeg 'erc-command))) @@ -283,9 +311,13 @@ erc-scenarios-match--stamp-both-invisible-fill-static (should (= (next-single-property-change (pos-bol) 'erc-timestamp) mend)) - ;; Line ending has the `invisible' property `erc-match'. + ;; Line ending has the `invisible' property `match-fools'. (should (= (char-after mend) ?\n)) - (should (eq (get-text-property mend'invisible) 'erc-match)))) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (if erc-legacy-invisible-bounds-p + (should (eq (get-text-property mend 'invisible) 'match-fools)) + (should (eq (get-text-property mbeg 'invisible) 'match-fools)) + (should-not (get-text-property mend 'invisible)))))) ;; Only the message right after Alice speaks contains stamps. (when (= 1 bob-utterance-counter) @@ -298,7 +330,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static ;; Date stamp has a combined `invisible' property value ;; that extends until the start of the message proper. (should (equal (get-text-property (point) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) (should (= (next-single-property-change (point) 'invisible) (1+ (pos-eol)))))) @@ -314,7 +346,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static (let ((msgend (next-single-property-change (pos-bol) 'invisible))) ;; Stamp has a combined `invisible' property value. (should (equal (get-text-property msgend 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; Combined `invisible' property spans entire timestamp. (should (= (next-single-property-change msgend 'invisible) @@ -331,4 +363,15 @@ erc-scenarios-match--stamp-both-invisible-fill-static (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) (should-not (next-single-property-change (pos-bol) 'invisible)))))) +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () + :tags '(:expensive-test) + (erc-scenarios-match--stamp-both-invisible-fill-static)) + +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset () + :tags '(:expensive-test) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (should-not erc-legacy-invisible-bounds-p) + (let ((erc-legacy-invisible-bounds-p t)) + (erc-scenarios-match--stamp-both-invisible-fill-static)))) + ;;; erc-scenarios-match.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b5db5fe8764..610fb149a94 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1272,6 +1272,50 @@ erc-process-input-line (should-not calls)))))) +(defmacro erc-tests--equal-including-properties (a b) + (list (if (< emacs-major-version 29) + 'ert-equal-including-properties + 'equal-including-properties) + a b)) + +(ert-deftest erc--merge-prop () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Baseline. + (insert "abc\n") + (erc--merge-prop 1 3 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 0 2 (erc-test x)))) + (erc--merge-prop 1 3 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 0 2 (erc-test (y x))))) + + ;; Multiple intervals. + (goto-char (point-min)) + (insert "def\n") + (erc--merge-prop 1 2 'erc-test 'x) + (erc--merge-prop 2 3 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("def" 0 1 (erc-test x) 1 2 (erc-test y)))) + (erc--merge-prop 1 3 'erc-test 'z) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("def" 0 1 (erc-test (z x)) 1 2 (erc-test (z y))))) + + ;; New val as list. + (goto-char (point-min)) + (insert "ghi\n") + (erc--merge-prop 2 3 'erc-test '(y z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" 1 2 (erc-test (y z))))) + (erc--merge-prop 1 3 'erc-test '(w x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z))))) + + (when noninteractive + (kill-buffer)))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space @@ -1488,12 +1532,6 @@ erc-message (kill-buffer "ExampleNet") (kill-buffer "#chan"))) -(defmacro erc-tests--equal-including-properties (a b) - (list (if (< emacs-major-version 29) - 'ert-equal-including-properties - 'equal-including-properties) - a b)) - (ert-deftest erc-format-privmessage () ;; Basic PRIVMSG (should (erc-tests--equal-including-properties -- 2.41.0 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sun Jul 23 10:00:42 2023 Received: (at 64301) by debbugs.gnu.org; 23 Jul 2023 14:00:42 +0000 Received: from localhost ([127.0.0.1]:41088 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qNZda-0004XC-2J for submit@debbugs.gnu.org; Sun, 23 Jul 2023 10:00:42 -0400 Received: from mail-108-mta92.mxroute.com ([136.175.108.92]:38293) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qNZdX-0004X0-9w for 64301@debbugs.gnu.org; Sun, 23 Jul 2023 10:00:40 -0400 Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta92.mxroute.com (ZoneMTA) with ESMTPSA id 189830d518a0004cef.001 for <64301@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Sun, 23 Jul 2023 14:00:35 +0000 X-Zone-Loop: 887691c28a2d6905fc84d651307c8fac220075a1c8b5 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=JXmOQt6/b2sAKm9E0wuxixy2UDHvRLzMfmv8jNCjBAs=; b=DGkItmKD6ZSO+BlkSZ9A3uzNo/ xySFwmfrCD/MGAu2C2XVulTMrum5kd6HlI2/UkBQEC0iTLDZo4EKubSYwnqnfBL7EHinLHNlKvyce jIhbkxB/96fRsGcwHyvN7xITtNfQ1CxbLrwBk62eXcTSTuJ3TvAJBbi2sPmzABNmTe8sUIT2pHebT C1aEENCRVuCwBJLDs/uuqZmyYobO2El+dfR3enNfFV6R1D7dqykcKinF4p5v51xLBEYvNdPemoLYN pJewguRez2YhiLY1K6o3iWOm4YEY7+v826fRoQEEQ4w5HhO3bojeF8n2yOSAhuZ7TLxpuOBYptsG1 G670tyxA==; From: "J.P." To: 64301@debbugs.gnu.org Subject: Re: bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with In-Reply-To: <871qh2iudy.fsf@neverwas.me> (J. P.'s message of "Thu, 20 Jul 2023 06:29:13 -0700") References: <87bkh21gfa.fsf@neverwas.me> <87sf9y32q9.fsf@neverwas.me> <87zg3zqlnr.fsf@neverwas.me> <87cz0tnubk.fsf@neverwas.me> <871qh2iudy.fsf@neverwas.me> Date: Sun, 23 Jul 2023 07:00:32 -0700 Message-ID: <87fs5eg22n.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Authenticated-Id: masked@neverwas.me X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 64301 Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) "J.P." writes: > v2 (invisibility API). Move primary message-hiding function to erc.el. > Invert meaning of invisible-bounds switch and make old non-nil behavior > new default. This was added as af547c4bbe8 "Improve ERC's internal invisibility API". From unknown Mon Aug 18 11:18:50 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Mon, 21 Aug 2023 11:24:05 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator