From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with Date: Wed, 05 Jul 2023 07:03:16 -0700 Message-ID: <87o7kq8nh7.fsf__21764.4576028519$1688565868$gmane$org@neverwas.me> References: <87bkh21gfa.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="14288"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 64301@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Jul 05 16:04:19 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qH37C-0003Qj-LG for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 05 Jul 2023 16:04:19 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qH371-00087Z-CR; Wed, 05 Jul 2023 10:04:07 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qH36w-00087G-KH for bug-gnu-emacs@gnu.org; Wed, 05 Jul 2023 10:04:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qH36w-0001VO-BW for bug-gnu-emacs@gnu.org; Wed, 05 Jul 2023 10:04:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qH36v-0007Xt-V8 for bug-gnu-emacs@gnu.org; Wed, 05 Jul 2023 10:04:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 05 Jul 2023 14:04:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 64301 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 64301-submit@debbugs.gnu.org id=B64301.168856580428948 (code B ref 64301); Wed, 05 Jul 2023 14:04:01 +0000 Original-Received: (at 64301) by debbugs.gnu.org; 5 Jul 2023 14:03:24 +0000 Original-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 Original-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 Original-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==; In-Reply-To: <87bkh21gfa.fsf@neverwas.me> (J. P.'s message of "Mon, 26 Jun 2023 06:50:17 -0700") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:264635 Archived-At: --=-=-= 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 --=-=-=--