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)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 3d062e2e9abd7bdca8216fde03d89a89bdd87e95..9c94f68ce27abc22d9bba79df58ad28f3c465c99 100644 (file)
--- 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 c30f7c10ca63d3f0f1fe5838a035546ea5da612d..89a6cd131c06a9cf45c52c7734e195ec207aeec4 100644 (file)
--- 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 cd2c55b00919f8402c672a9ce5d4fb6bd082919a..a5b0af41b2afff67318644982627bf9df197d2e3 100644 (file)
--- 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 e060b7039bdae8807d599f688c05f5896b8ff2b6..8101183ce3d22309a9268db0ced5724285f04901 100644 (file)
--- 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 c10b39e9a1b8dfc8ac85c27de7933b4bb03ebb93..f2ea69f6bbadd2e6e770a31d60662c6f0d756806 100644 (file)
--- 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 6a6f693438921e7ba29b7eceb5bad4ec50ac1a0f..3dacf95a59fa03ba1fe255af78cd7c3ab28925f3 100644 (file)
--- 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