Optionally combine faces in erc-display-message

* etc/ERC-NEWS: Tell module authors that `erc-display-message' can now
combine faces.
* lisp/erc/erc-button.el (erc-button--display-error-notice-with-keys):
Ask `erc-display-message' to compose `erc-notice-face' and
`erc-error-face'.
* lisp/erc/erc-match.el (erc-hide-fools): Merge `invisible' prop
`erc-match' with existing, if present, and move body to helper for
hiding matched messages.
(erc-match--hide-message): New helper function to hide messages
regardless of match type.
* lisp/erc/erc-track.el: (erc-track-faces-priority-list): Note in doc
string that faces reserved for critical messages are always
prioritized.  Wrap :type declaration in macro helper to ensure
`erc-button' is loaded beforehand.  Otherwise calling `setopt' with
the option's default value fails.
(erc-track--attn-faces): Add new internal variable for faces that
should always appear in the mode line, at least in the default client.
(erc-track-modified-channels, erc-track-face-priority): Prepend
`erc-track--attn-faces' to `erc-track-faces-priority-list'.
* lisp/erc/erc.el (erc-send-action): Ask `erc-display-message' to
apply both `erc-input-face' and `erc-action-face' to messages.
(erc--compose-text-properties): New internal variable to act as flag
for altering behavior of `erc-put-text-property'.
(erc--merge-prop): New function copied from `erc-button-add-face' for
general internal use with any text property by all of ERC.
(erc-display-message-highlight): Set fallback face to
`erc-default-face' the symbol instead of the string.  For this to
break third-party code, callers would have to supply erroneous types
for nonexistent or undefined handlers and then explicitly check for
and depend on such misuse, which seems unlikely and therefore not
worth mentioning in etc/ERC-NEWS.
(erc-display-message): Explain how `type' param works when it's a
list.  Fix code in type-as-list branch so that it optionally combines
faces instead of clobbers them.
(erc-put-text-property): Unalias from `put-text-property', but fall
back to the 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

@@ -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,

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

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.

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)))))

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)
 

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