diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3d062e2e9ab..9c94f68ce27 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -251,6 +251,19 @@ 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' optionally combines faces. +Users may notice that ERC now inserts some important error messages in +a combination of 'erc-error-face' and 'erc-notice-face'. This is +merely a consequence of 'erc-display-message' getting smarter about +how it treats face properties when its 'type' parameter is a list that +starts with t. Originally, ERC's authors intended to display both +server-originating and ERC-generated errors in this style, but that +intent was never realized. Though now possible, the effect has been +limited to special errors involving usage and internal state. For +third-party code, the key takeaway is that more 'font-lock-face' +properties encountered in the wild may be combinations of faces rather +than lone 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-button.el b/lisp/erc/erc-button.el index c30f7c10ca6..89a6cd131c0 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -815,7 +815,7 @@ non-strings, concatenate leading string members before applying erc-button--display-error-with-buttons erc-button-describe-symbol 1) ,@erc-button-alist))) - (erc-display-message parsed '(notice error) (or buffer 'active) string) + (erc-display-message parsed '(t notice error) (or buffer 'active) string) string)) ;;;###autoload diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index cd2c55b0091..a5b0af41b2a 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -657,21 +657,22 @@ See `erc-log-match-format'." (defvar-local erc-match--hide-fools-offset-bounds nil) -;; FIXME this should merge with instead of overwrite existing -;; `invisible' values. (defun erc-hide-fools (match-type _nickuserhost _message) - "Hide foolish comments. -This function should be called from `erc-text-matched-hook'." + "Hide comments from designated fools." (when (eq match-type 'fool) + (erc-match--hide-message))) + +(defun erc-match--hide-message () + (progn ; FIXME raise sexp (if erc-match--hide-fools-offset-bounds (let ((beg (point-min)) (end (point-max))) (save-restriction (widen) - (put-text-property (1- beg) (1- end) 'invisible 'erc-match))) + (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match))) ;; Before ERC 5.6, this also used to add an `intangible' ;; property, but the docs say it's now obsolete. - (put-text-property (point-min) (point-max) 'invisible 'erc-match)))) + (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match)))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index e060b7039bd..8101183ce3d 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -184,9 +184,13 @@ The faces used are the same as used for text in the buffers. erc-prompt-face) "A list of faces used to highlight active buffer names in the mode line. If a message contains one of the faces in this list, the buffer name will -be highlighted using that face. The first matching face is used." - :type '(repeat (choice face - (repeat :tag "Combination" face)))) +be highlighted using that face. The first matching face is used. + +Note that ERC prioritizes certain faces reserved for critical +messages regardless of this option's value." + :type (erc--with-dependent-type-match + (repeat (choice face (repeat :tag "Combination" face))) + erc-button)) (defcustom erc-track-priority-faces-only nil "Only track text highlighted with a priority face. @@ -309,6 +313,8 @@ important." (const leastactive) (const mostactive))) +(defconst erc-track--attn-faces '((erc-error-face erc-notice-face)) + "Faces whose presence always triggers mode-line inclusion.") (defun erc-track-remove-from-mode-line () "Remove `erc-track-modified-channels' from the mode-line." @@ -736,6 +742,9 @@ Use `erc-make-mode-line-buffer-name' to create buttons." (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 +811,9 @@ the current buffer is in `erc-mode'." ;; (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 +884,7 @@ If face is not in `erc-track-faces-priority-list', it will have a 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 c10b39e9a1b..f2ea69f6bba 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2745,7 +2745,7 @@ If ARG is non-nil, show the *erc-protocol* buffer." erc-insert-pre-hook)) (nick (erc-current-nick))) (setq nick (propertize nick 'erc-speaker nick)) - (erc-display-message nil 'input (current-buffer) + (erc-display-message nil '(t action input) (current-buffer) 'ACTION ?n nick ?a str ?u "" ?h ""))) ;; Display interface @@ -2899,6 +2899,25 @@ If STRING is nil, the function does nothing." (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. @@ -2910,7 +2929,7 @@ See also `erc-make-notice'." 0 (length string) 'font-lock-face (or (intern-soft (concat "erc-" (symbol-name type) "-face")) - "erc-default-face") + 'erc-default-face) string) string))) @@ -3114,6 +3133,17 @@ returns non-nil." ARGS, PARSED, and TYPE are used to format MSG sensibly. +When TYPE is a list of symbols, call handlers from left to right +without influencing how they behave when encountering existing +faces. As of ERC 5.6, expect a TYPE of (notice error) to insert +MSG with `font-lock-face' as `erc-error-face' throughout. +However, when the list of symbols begins with t, tell compatible +handlers to compose rather than clobber faces. For example, as +of ERC 5.6, expect a TYPE of (t notice error) to result in MSG's +`font-lock-face' being (erc-error-face erc-notice-face) +throughout when `erc-notice-highlight-type' is set to its default +`all'. + See also `erc-format-message' and `erc-display-line'." (let ((string (if (symbolp msg) (apply #'erc-format-message msg args) @@ -3124,10 +3154,10 @@ See also `erc-format-message' and `erc-display-line'." ((null type) string) ((listp type) - (mapc (lambda (type) - (setq string - (erc-display-message-highlight type string))) - type) + (let ((erc--compose-text-properties + (and (eq (car type) t) (setq type (cdr type))))) + (dolist (type type) + (setq string (erc-display-message-highlight type string)))) string) ((symbolp type) (erc-display-message-highlight type string)))) @@ -6129,7 +6159,7 @@ See also variable `erc-notice-highlight-type'." (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'. @@ -6139,7 +6169,10 @@ OBJECT is a string which will be modified and returned. 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 @@ (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