From: F. Jason Park Date: Sun, 25 Jun 2023 01:33:20 +0000 (-0700) Subject: Optionally combine faces in erc-display-message X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d45770e8d03ae82d44d05086e22d552ab60e34e9;p=emacs.git 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 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