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