Option 'erc-keep-place-indicator-truncation' manages the tension between
truncation and place keeping, prioritizing one or the other.
+** Updated defaults for the 'track' module's face-list options.
+The default values of options 'erc-track-faces-priority-list' and
+'erc-track-faces-normal-list' have both gained a face for buttonized
+speaker names, with the latter option also gaining 'erc-notice-face'.
+This was done to provide a more frequent and practical indication of
+channel activity in keeping with the module's original design.
+
+** An arguably less distracting 'erc-nicks-track-faces' variant.
+Setting this option to t tells the 'track' module to have the mode-line
+indicator stick with the most recent speaker's face, even when they're
+monologuing, instead of alternating between it and the highest ranked
+'erc-track-faces-normal-list' member in a given message.
+
\f
* Changes in ERC 5.6
should adjust it before connecting."
:type '(repeat string))
-(defcustom erc-nicks-skip-faces '( erc-notice-face erc-current-nick-face
- erc-my-nick-face erc-pal-face erc-fool-face)
+(defcustom erc-nicks-skip-faces '(erc-notice-face erc-my-nick-face)
"Faces to avoid highlighting atop."
- :type (erc--with-dependent-type-match (repeat face) erc-match))
+ :type '(repeat face)
+ :package-version '(ERC . "5.6.1"))
(defcustom erc-nicks-backing-face erc-button-nickname-face
"Face to mix with generated one for emphasizing non-speakers."
(defcustom erc-nicks-track-faces 'prioritize
"Show nick faces in the `track' module's portion of the mode line.
-A value of nil means don't show nick faces at all. A value of
-`defer' means have `track' consider nick faces only after those
-ranked faces in `erc-track-faces-normal-list'. This has the
-effect of \"alternating\" between a ranked \"normal\" and a nick.
-The value `prioritize' means have `track' consider nick faces to
-be \"normal\" unless the current speaker is the same as the
-previous one, in which case pretend the value is `defer'. Like
-most options in this module, updating the value mid-session is
-not officially supported, although cycling \\[erc-nicks-mode] may
-be worth a shot."
- :type '(choice (const nil) (const defer) (const prioritize)))
+A value of nil means don't show `nicks'-managed faces at all. A value
+of t means treat them as non-\"normal\" faces ranked at or below
+`erc-default-face'. This has the effect of always showing them while
+suppressing the \"alternating\" behavior normally associated with
+`erc-track-faces-normal-list' (including between the speaker and nicks
+mentioned in the message body.) A value of `defer' means treat nicks as
+unranked normals to favor alternating between them and ranked normals.
+A value of `prioritize' exhibits the same alternating effect as `defer'
+when speakers stay the same but allows a new speaker's face to
+impersonate a ranked normal so that adjacent speakers alternate among
+themselves before deferring to non-face normals. Like most options in
+this module, updating the value mid-session is not officially supported,
+although cycling \\[erc-nicks-mode] may be worth a shot."
+ :type '(choice boolean (const defer) (const prioritize)))
(defvar erc-nicks--max-skip-search 3 ; make this an option?
"Max number of faces to visit when testing `erc-nicks-skip-faces'.")
(remove-function (local 'erc-button--modify-nick-function)
#'erc-nicks--highlight-button)
(remove-function (local 'erc-track--alt-normals-function)
- #'erc-nicks--check-normals)
+ #'erc-nicks--track-prioritize)
+ (remove-function (local 'erc-track--alt-normals-function)
+ #'erc-nicks--track-always)
(remove-hook 'erc-track-mode-hook #'erc-nicks--setup-track-integration t)
(setf (alist-get "Edit face"
erc-button--nick-popup-alist nil 'remove #'equal)
((facep next))
((not (intern-soft next))))
(setq candidate (cdr candidate)))
- (if (and (consp candidate) (not (cdr candidate))) (car candidate) candidate))
+ (erc--solo candidate))
-(define-inline erc-nicks--oursp (face)
+(define-inline erc-nicks--ours-p (face)
+ "Return uninterned `nicks'-created face if FACE is a known list of faces."
(inline-quote
(and-let* ((sym (car-safe ,face))
((symbolp sym))
((get sym 'erc-nicks--key)))
sym)))
-(defun erc-nicks--check-normals (current contender contenders normals)
- "Return a viable `nicks'-owned face from NORMALS in CONTENDERS.
-But only do so if the CURRENT face is also one of ours and in
-NORMALS and if the highest ranked CONTENDER among new faces is
-`erc-default-face'."
- (and-let* (((eq contender 'erc-default-face))
- ((or (null current) (gethash current normals)))
- (spkr (or (null current) (erc-nicks--oursp current))))
+(defvar erc-nicks-track-normal-max-rank 'erc-default-face
+ "Highest priority normal face still eligible to alternate with `nicks' faces.
+Must appear in both `erc-track-faces-priority-list' and
+`erc-track-faces-normal-list'.")
+
+(defun erc-nicks--assess-track-faces (current contender ranks normals)
+ "Return symbol face for CURRENT or t, to mean CURRENT is replaceable.
+But only do so if CURRENT and CONTENDER are either nil or \"normal\"
+faces ranking at or below `erc-nicks-track-normal-max-rank'. See
+`erc-track--select-mode-line-face' for the expected types of RANKS and
+NORMALS. Expect a non-nil CONTENDER to always be ranked."
+ (and-let*
+ (((or (null contender) (gethash contender normals)))
+ ((or (null current) (gethash current normals)))
+ (threshold (gethash erc-nicks-track-normal-max-rank (car ranks)))
+ ((or (null contender) (<= threshold (gethash contender (car ranks)))))
+ ((or (erc-nicks--ours-p current)
+ (null current)
+ (<= threshold (or (gethash current (car ranks)) 0)))))))
+
+(defun erc-nicks--track-prioritize (current contender contenders ranks normals)
+ "Return a viable non-CURRENT `nicks' face among CONTENDERS.
+See `erc-track--select-mode-line-face' for parameter types."
+ (when-let
+ ((spkr (erc-nicks--assess-track-faces current contender ranks normals)))
(catch 'contender
- (dolist (candidate (cdr contenders) contender)
+ (dolist (candidate (cdr contenders))
(when-let (((not (equal candidate current)))
- ((gethash candidate normals))
- (s (erc-nicks--oursp candidate))
+ (s (erc-nicks--ours-p candidate))
((not (eq s spkr))))
(throw 'contender candidate))))))
+(defun erc-nicks--track-always (current contender contenders ranks normals)
+ "Return a viable `nicks' face, possibly CURRENT, among CONTENDERS.
+See `erc-track--select-mode-line-face' for parameter types."
+ (when (erc-nicks--assess-track-faces current contender ranks normals)
+ (catch 'contender
+ (dolist (candidate (reverse (cdr contenders)))
+ (when (erc-nicks--ours-p candidate)
+ (throw 'contender candidate))))))
+
(defun erc-nicks--setup-track-integration ()
"Restore traditional \"alternating normal\" face functionality to mode-line."
(when (bound-and-true-p erc-track-mode)
;; Variant `defer' is handled elsewhere.
('prioritize
(add-function :override (local 'erc-track--alt-normals-function)
- #'erc-nicks--check-normals))
+ #'erc-nicks--track-prioritize))
+ ('t
+ (add-function :override (local 'erc-track--alt-normals-function)
+ #'erc-nicks--track-always))
('nil
(add-function :override (local 'erc-track--face-reject-function)
#'erc-nicks--reject-uninterned-faces)))))
\(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
:type 'boolean)
+;; In an emergency, users can opt out of this migration with:
+;;
+;; (put 'erc-track-faces-priority-list 'erc-track--obsolete-faces t)
+;; (put 'erc-track-faces-normal-list 'erc-track--obsolete-faces t)
+;;
(defun erc-track--massage-nick-button-faces (sym val &optional set-fn)
- "Transform VAL of face-list option SYM to have new defaults.
-Use `set'-compatible SET-FN when given. If an update was
-performed, set the symbol property `erc-track--obsolete-faces' of
-SYM to t."
- (let* ((changedp nil)
- (new (mapcar
- (lambda (f)
- (if (and (eq (car-safe f) 'erc-nick-default-face)
- (equal f '(erc-nick-default-face erc-default-face)))
- (progn
- (setq changedp t)
- (put sym 'erc-track--obsolete-faces t)
- (cons 'erc-button-nick-default-face (cdr f)))
- f))
- val)))
- (if set-fn
- (funcall set-fn sym (if changedp new val))
- (set-default sym (if changedp new val)))))
+ "Transform VAL of face-list option SYM to remove/replace obsolete items.
+Use `set'-compatible SET-FN when given. Record any migrations as cons
+cells of (OLD . NEW) in the symbol property `erc-track--obsolete-faces'
+of SYM."
+ (let* ((oldface '(erc-nick-default-face erc-default-face))
+ (newface '(erc-button-nick-default-face erc-default-face))
+ (migrations (get sym 'erc-track--obsolete-faces))
+ (new (if migrations
+ val
+ (delq nil
+ (mapcar
+ (lambda (f)
+ (if (equal f oldface)
+ (setf (alist-get oldface migrations
+ nil nil #'equal)
+ (and (not (member newface val)) newface))
+ f))
+ val)))))
+ (when migrations
+ (put sym 'erc-track--obsolete-faces migrations))
+ (if set-fn (funcall set-fn sym new) (set-default sym new))))
(defcustom erc-track-faces-priority-list
'(erc-error-face
(erc-button erc-default-face)
erc-dangerous-host-face
erc-nick-default-face
+ (erc-button-nick-default-face erc-nick-default-face)
(erc-button-nick-default-face erc-default-face)
erc-default-face
erc-action-face
Note that ERC prioritizes certain faces reserved for critical
messages regardless of this option's value."
- :package-version '(ERC . "5.6")
+ :package-version '(ERC . "5.6.1")
:set #'erc-track--massage-nick-button-faces
:type (erc--with-dependent-type-match
(repeat (choice face (repeat :tag "Combination" face)))
'((erc-button erc-default-face)
erc-dangerous-host-face
erc-nick-default-face
+ (erc-button-nick-default-face erc-nick-default-face)
(erc-button-nick-default-face erc-default-face)
erc-default-face
+ erc-notice-face
erc-action-face)
"A list of faces considered to be part of normal conversations.
This list is used to highlight active buffer names in the mode line.
\\[erc-track-mode].
The effect may be disabled by setting this variable to nil."
- :package-version '(ERC . "5.6")
+ :package-version '(ERC . "5.6.1")
:set #'erc-track--massage-nick-button-faces
:type (erc--with-dependent-type-match
(repeat (choice face (repeat :tag "Combination" face)))
(erc-track-enable))
(set sym val))))
+(defvar-local erc-track--priority-faces nil
+ "Local copy of `erc-track-faces-priority-list' as a hash table.
+Keys are faces and values are rank integers (smaller is more important).")
+
(defvar-local erc-track--normal-faces nil
- "Local copy of `erc-track-faces-normal-list' as a hash table.")
+ "Local copy of `erc-track-faces-normal-list' as a hash table.
+Keys and values are faces. The table is weak valued so it can double as
+a buttonizing cache. See `erc-button-add-button' and `erc--merge-prop'.")
(defun erc-track--setup ()
"Initialize a buffer for use with the `track' module.
-If this is a server buffer or `erc-track-faces-normal-list' is
-locally bound, create a new `erc-track--normal-faces' for the
-current buffer. Otherwise, set the local value to the server
-buffer's."
+If this is a server buffer or either `erc-track-faces-normal-list' or
+`erc-track-faces-priority-list' is locally bound, create a new cache
+table with corresponding local variable `erc-track--normal-faces' or
+`erc-track--priority-faces'. Otherwise, in target buffers with no local
+binding, set the cache variable's local value to that of server's."
(if erc-track-mode
- (let ((existing (erc-with-server-buffer erc-track--normal-faces))
- (localp (and erc--target
- (local-variable-p 'erc-track-faces-normal-list)))
- (opts '(erc-track-faces-normal-list erc-track-faces-priority-list))
- warnp table)
+ (let (warnp)
;; Don't bother warning users who've disabled `button'.
- (unless (or erc--target (not (or (bound-and-true-p erc-button-mode)
- (memq 'button erc-modules))))
- (when (or localp (local-variable-p 'erc-track-faces-priority-list))
- (dolist (opt opts)
+ (unless (or erc--target
+ (not (or (bound-and-true-p erc-button-mode)
+ (memq 'button erc-modules))))
+ (dolist (opt '(erc-track-faces-normal-list
+ erc-track-faces-priority-list))
+ (when (local-variable-p opt)
(erc-track--massage-nick-button-faces opt (symbol-value opt)
- #'set)))
- (dolist (opt opts)
- (when (get opt 'erc-track--obsolete-faces)
- (push opt warnp)
+ #'set))
+ (when-let ((migrations (get opt 'erc-track--obsolete-faces))
+ ((consp migrations)))
+ (push (cons opt
+ (mapcar (pcase-lambda (`(,old . ,new))
+ (format (if new "changed %s to %s"
+ "removed %s")
+ old new))
+ migrations))
+ warnp)
(put opt 'erc-track--obsolete-faces nil)))
(when warnp
- (erc--warn-once-before-connect 'erc-track-mode
- (if (cdr warnp) "Options " "Option ")
- (mapconcat (lambda (o) (format "`%S'" o)) warnp " and ")
- (if (cdr warnp) " contain" " contains")
- " an obsolete item, %S, intended to match buttonized nicknames."
- " ERC has changed it to %S for the current session."
- " Please save the current value to silence this message."
- '(erc-nick-default-face erc-default-face)
- '(erc-button-nick-default-face erc-default-face))))
- (when (or (null existing) localp)
- (setq table (map-into (mapcar (lambda (f) (cons f f))
- erc-track-faces-normal-list)
- '(hash-table :test equal :weakness value))))
- (setq erc-track--normal-faces (or table existing))
- (unless (or localp existing)
- (erc-with-server-buffer (setq erc-track--normal-faces table))))
+ (pcase-dolist (`(,opt . ,migrations) warnp)
+ (erc--warn-once-before-connect 'erc-track-mode
+ "Option `%S' contains "
+ (if (cdr migrations) "obsolete items." "an obsolete item.")
+ " ERC has done the following for the current session: %s."
+ " Please review these changes and, if convinced,"
+ " silence this message by saving the current value."
+ opt (string-join migrations ", ")))))
+ ;; Set `erc-track--priority-faces' cache to new or shared value.
+ (let* ((localp (and erc--target
+ (local-variable-p 'erc-track-faces-priority-list)))
+ (existing (erc-with-server-buffer erc-track--priority-faces))
+ (table (or (and (not localp) existing)
+ (let ((p 0))
+ (map-into
+ (mapcar (lambda (f) (cons f (cl-incf p)))
+ (append erc-track--attn-faces
+ erc-track-faces-priority-list))
+ `(hash-table :test equal))))))
+ (setq erc-track--priority-faces table)
+ (unless (or localp existing)
+ (erc-with-server-buffer (setq erc-track--priority-faces table))))
+ ;; Likewise for `erc-track--normal-faces' cache.
+ (let* ((localp (and erc--target
+ (local-variable-p 'erc-track-faces-normal-list)))
+ (existing (erc-with-server-buffer erc-track--normal-faces))
+ (table (or (and (not localp) existing)
+ (map-into (mapcar (lambda (f) (cons f f))
+ erc-track-faces-normal-list)
+ `(hash-table :test equal
+ :weakness value)))))
+ (setq erc-track--normal-faces table)
+ (unless (or localp existing)
+ (erc-with-server-buffer (setq erc-track--normal-faces table)))))
+ (kill-local-variable 'erc-track--priority-faces)
(kill-local-variable 'erc-track--normal-faces)))
;;; Visibility
(defvar erc-track--alt-normals-function nil
"A function to possibly elect a \"normal\" face.
Called with the current incumbent and the worthiest new contender
-followed by all new contending faces and so-called \"normal\"
-faces. See `erc-track--select-mode-line-face' for their meanings
-and expected types. This function should return a face or nil.")
+followed by all new contending faces, ranked faces, and so-called
+\"normal\" faces. See `erc-track--select-mode-line-face' for their
+meanings and expected types. This function should return a face or nil.")
(defun erc-track--select-mode-line-face (cur-face new-faces ranks normals)
"Return CUR-FACE or a replacement for displaying in the mode-line, or nil.
-Expect RANKS to be a list of faces and both NORMALS and the car
-of NEW-FACES to be hash tables mapping faces to non-nil values.
-Assume the latter's makeup and that of RANKS to resemble
-`erc-track-faces-normal-list' and `erc-track-faces-priority-list'.
-If NEW-FACES has a cdr, expect it to be its car's contents
-ordered from most recently seen (later in the buffer) to
-earliest. In general, act like `erc-track-select-mode-line-face'
-except appeal to `erc-track--alt-normals-function' if it's
-non-nil, falling back on reconsidering NEW-FACES when CUR-FACE
-outranks all its members. That is, choose the first among RANKS
-in NEW-FACES not equal to CUR-FACE. Failing that, choose the
-first face in NEW-FACES that's also in NORMALS, assuming
-NEW-FACES has a cdr."
+Expect NEW-FACES to be a cons cell whose car is a hash table mapping
+faces present in the applicable region to t and whose cdr is its car's
+contents ordered from most recently seen (later in the buffer) to
+earliest. Expect RANKS to be a cons cell whose car is a hash table
+similar to `erc-track--priority-faces' and whose cdr is a list of
+prioritized faces resembling `erc-track-faces-priority-list'. Expect
+NORMALS to be a hash table mapping faces to themselves. In general, act
+identically to `erc-track-select-mode-line-face', except appeal to
+`erc-track--alt-normals-function' if it's non-nil, and fall back on
+reconsidering only NEW-FACES appearing in NORMALS when CUR-FACE is
+itself \"normal\" and outranks all NEW-FACES. That is, choose the first
+among RANKS in both NEW-FACES and NORMALS not equal to CUR-FACE.
+Failing that, choose the first face in both NEW-FACES and NORMALS."
(cl-check-type erc-track-ignore-normal-contenders-p null)
(cl-check-type new-faces cons)
+ ;; Choose the highest ranked face in `erc-track-faces-priority-list'
+ ;; that's either `cur-face' itself or one appearing in the region
+ ;; being processed.
(when-let ((choice (catch 'face
- (dolist (candidate ranks)
+ (dolist (candidate (cdr ranks))
(when (or (equal candidate cur-face)
(gethash candidate (car new-faces)))
(throw 'face candidate))))))
(or (and erc-track--alt-normals-function
(funcall erc-track--alt-normals-function
- cur-face choice new-faces normals))
+ cur-face choice new-faces ranks normals))
+ ;; If `choice' is still `cur-face' and also a "normal", attempt
+ ;; to choose another normal in order to produce the flickering
+ ;; effect mentioned in the doc of `erc-track-faces-normal-list'.
(and (equal choice cur-face)
(gethash choice normals)
(catch 'face
+ ;; If ranked "normal" faces other than `choice' appear in
+ ;; the region, return the most important one.
(progn
- (dolist (candidate ranks)
+ (dolist (candidate (cdr ranks))
(when (and (not (equal candidate choice))
(gethash candidate (car new-faces))
(gethash choice normals))
(throw 'face candidate)))
+ ;; Otherwise, go with any "normal" face other than
+ ;; `choice' in the region.
(dolist (candidate (cdr new-faces))
(when (and (not (equal candidate choice))
(gethash candidate normals))
(normals erc-track--normal-faces)
(erc-track-faces-priority-list
`(,@erc-track--attn-faces ,@erc-track-faces-priority-list))
- (ranks erc-track-faces-priority-list)
+ (ranks (cons erc-track--priority-faces
+ erc-track-faces-priority-list))
((not (and
(or (eq erc-track-priority-faces-only 'all)
(member this-channel erc-track-priority-faces-only))
- (not (catch 'found
- (dolist (f ranks)
- (when (gethash f (or (car-safe faces) faces))
- (throw 'found t)))))))))
+ ;; Iterate over the shorter of `ranks' and `faces'.
+ (let* ((r>fp (or erc-track-ignore-normal-contenders-p
+ (> (hash-table-count (car ranks))
+ (hash-table-count (car faces)))))
+ (elems (cond ((not r>fp) (cdr ranks)) ; f>=r
+ (erc-track-ignore-normal-contenders-p
+ faces)
+ ((cdr faces))))
+ (table (if r>fp (car ranks) (car faces))))
+ (not (catch 'found
+ (dolist (f elems)
+ (when (gethash f table)
+ (throw 'found t))))))))))
(progn ; FIXME remove `progn' on next major edit
(if (not (assq (current-buffer) erc-modified-channels-alist))
;; Add buffer, faces and counts
nil faces ranks normals))))
erc-modified-channels-alist))
;; Else modify the face for the buffer, if necessary.
- (when faces
+ (when (or erc-track-ignore-normal-contenders-p (cdr faces))
(let* ((cell (assq (current-buffer)
erc-modified-channels-alist))
(old-face (cddr cell))
;;; Code:
-(require 'ert-x)
(require 'erc-nicks)
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-tests-common)))
;; This function replicates the behavior of older "invert" strategy
;; implementations from EmacsWiki, etc. The values for the lower and
(should (equal erc-nicks--colors-rejects '(t)))))
+(declare-function erc-track-modified-channels "erc-track" ())
+
+(defun erc-nicks-tests--track-faces (test)
+ (require 'erc-track)
+ (defvar erc-modified-channels-alist)
+ (defvar erc-track--normal-faces)
+
+ (erc-tests-common-make-server-buf)
+ (erc-nicks-mode +1)
+
+ (let ((erc-modules (cons 'nicks erc-modules))
+ ;; Pretend these faces were added in response-handling during
+ ;; insertion modification by buttonizing hooks. See
+ ;; `erc-nicks--highlight-button'.
+ (add-face (lambda (face)
+ (erc-nicks--remember-face-for-track ; speaker
+ (list face 'erc-nick-default-face))
+ (erc-nicks--remember-face-for-track ; mention
+ (list face 'erc-default-face))))
+ ;;
+ bob-face alice-face assert-result)
+
+ (with-current-buffer (erc--open-target "#chan")
+ (should erc-nicks-mode)
+ (should (setq bob-face (erc-nicks--get-face "bob" "bob@foonet")))
+ (should (setq alice-face (erc-nicks--get-face "alice" "alice@foonet")))
+
+ (erc-tests-common-track-modified-channels-sans-setup
+
+ (lambda (set-faces)
+
+ (setq assert-result ; fixture binds `erc-modified-channels-alist'
+ (lambda (result)
+ (should (equal (alist-get (current-buffer)
+ erc-modified-channels-alist)
+ result))))
+
+ (funcall test set-faces assert-result add-face
+ bob-face alice-face)))))
+
+ (erc-tests-common-kill-buffers))
+
+(ert-deftest erc-nicks-track-faces/prioritize ()
+ (should (eq erc-nicks-track-faces 'prioritize))
+ (erc-nicks-tests--track-faces
+ (lambda (set-faces assert-result add-face bob-face alice-face)
+
+ (defvar erc-track--alt-normals-function)
+ (should erc-track--alt-normals-function)
+
+ (funcall add-face bob-face)
+ (funcall add-face alice-face)
+
+ ;; Simulate a JOIN.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(1 . erc-notice-face))
+
+ ;; Someone speaks, and the mode-line changes to a `nicks' owned
+ ;; composite face for the speaker.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(2 ,bob-face erc-nick-default-face))
+
+ ;; That same someone speaks, and the mode-line indicator changes to
+ ;; another "normal" face in the message body.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(3 . erc-default-face))
+
+ ;; And yet again, which results in the indicator going back to one.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(4 ,bob-face erc-nick-default-face))
+
+ ;; Now the same person mentions another server user, resulting in a
+ ;; change to *that* `nicks' owned face because it appears later in
+ ;; the message content (timestamp is last).
+ (funcall set-faces `(erc-timestamp-face
+ (,alice-face erc-default-face)
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(5 ,alice-face erc-default-face))
+
+ ;; The mentioned user replies, mentioning the mentioner. But
+ ;; instead of the normal "normals" processing preferring the ranked
+ ;; `erc-default-face', the `erc-nicks-track-faces' logic kicks in
+ ;; via `erc-track--alt-normals-function' and provides a `nicks'
+ ;; owned replacement.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-default-face)
+ (,alice-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(6 ,bob-face erc-default-face))
+
+ ;; Finally, another notice arrives.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(7 . erc-notice-face)))))
+
+(ert-deftest erc-nicks-track-faces/defer ()
+ (should (eq erc-nicks-track-faces 'prioritize))
+ (let ((erc-nicks-track-faces 'defer))
+ (erc-nicks-tests--track-faces
+ (lambda (set-faces assert-result add-face bob-face alice-face)
+
+ (funcall add-face bob-face)
+ (funcall add-face alice-face)
+
+ ;; Simulate a JOIN.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(1 . erc-notice-face))
+
+ ;; Someone speaks, and the mode-line indicator changes to the
+ ;; highest ranked face in the message. (All `nicks' owned faces
+ ;; are unranked).
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(2 . erc-default-face))
+
+ ;; That same someone speaks, and the mode-line indicator changes
+ ;; to a `nicks' owned face. It first reaches for the highest
+ ;; ranked face in the message but then applies the "normals"
+ ;; rules, resulting in a promoted alternate.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(3 ,bob-face erc-nick-default-face))
+
+ ;; And yet again, which results in the indicator going back to one.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(4 . erc-default-face))
+
+ ;; The same person mentions another server user, resulting in a
+ ;; change to that `nicks' owned face because the logic from
+ ;; 3. again applies.
+ (funcall set-faces `(erc-timestamp-face
+ (,alice-face erc-default-face)
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(5 ,alice-face erc-default-face))
+
+ ;; The mentioned user replies, mentioning the mentioner.
+ ;; However, the `nicks' module does not intercede in the decision
+ ;; making to overrule the ranked nominee.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-default-face)
+ (,alice-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(6 . erc-default-face))
+
+ ;; Finally, another notice arrives.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(7 . erc-notice-face))))))
+
+(ert-deftest erc-nicks-track-faces/nil ()
+ (should (eq erc-nicks-track-faces 'prioritize))
+ (let (erc-nicks-track-faces)
+ (erc-nicks-tests--track-faces
+ (lambda (set-faces assert-result _ bob-face alice-face)
+
+ (defvar erc-track--face-reject-function)
+ (should erc-track--face-reject-function)
+
+ ;; Simulate a JOIN.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(1 . erc-notice-face))
+
+ ;; Someone speaks, and the mode-line indicator changes to the
+ ;; only ranked face in the message.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(2 . erc-default-face))
+
+ ;; That same someone speaks, and since no other "normals" exist
+ ;; in the message, the indicator is not updated.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(3 . erc-default-face))
+
+ ;; Now the same person mentions another server user, but the same
+ ;; logic applies, and the indicator is not updated.
+ (funcall set-faces `(erc-timestamp-face
+ (,alice-face erc-default-face)
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(4 . erc-default-face))
+
+ ;; Finally, another notice arrives.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(5 . erc-notice-face))))))
+
+(ert-deftest erc-nicks-track-faces/t ()
+ (should (eq erc-nicks-track-faces 'prioritize))
+ (let ((erc-nicks-track-faces t))
+ (erc-nicks-tests--track-faces
+ (lambda (set-faces assert-result add-face bob-face alice-face)
+
+ (defvar erc-track--alt-normals-function)
+ (should erc-track--alt-normals-function)
+
+ (funcall add-face bob-face)
+ (funcall add-face alice-face)
+
+ ;; Simulate a JOIN.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(1 . erc-notice-face))
+
+ ;; Someone speaks, and the mode-line indicator changes to that
+ ;; someone's `nicks'-owned face.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(2 ,bob-face erc-nick-default-face))
+
+ ;; That same someone speaks, and though one other "normal" exists
+ ;; in the message, `erc-default-face', no update occurs.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(3 ,bob-face erc-nick-default-face))
+
+ ;; Another server user speaks, mentioning the previous speaker,
+ ;; and the indicator is updated to reflect the new speaker.
+ (funcall set-faces `(erc-timestamp-face
+ (,bob-face erc-default-face) ; bob:
+ (,alice-face erc-nick-default-face) ; <alice>
+ erc-default-face))
+ (erc-track-modified-channels)
+ (funcall assert-result `(4 ,alice-face erc-nick-default-face))
+
+ ;; Finally, another notice arrives.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (funcall assert-result '(5 . erc-notice-face))))))
+
;;; erc-nicks-tests.el ends here
(defun erc-track-tests--select-mode-line-face (ranked normals cases)
(setq normals (map-into (mapcar (lambda (f) (cons f t)) normals)
'(hash-table :test equal)))
+
+ (setq ranked (cons (map-into (mapcar (let ((i 0))
+ (lambda (f) (cons f (cl-incf i))))
+ ranked)
+ '(hash-table :test equal))
+ ranked))
+
(pcase-dolist (`(,want ,cur-face ,new-faces) cases)
(ert-info ((format "Observed: {cur: %S, new: %S, want: %S}"
(mapcar (lambda (f) (cons f t)) new-faces)
'(hash-table :test equal))
(reverse new-faces)))
- (should (equal want (funcall #'erc-track--select-mode-line-face
- cur-face new-faces ranked normals))))))
+ (should (equal want (erc-track--select-mode-line-face
+ cur-face new-faces ranked normals))))))
;; The main difference between these variants is that with the above,
;; when given alternating lines like
(when noninteractive
(kill-buffer))))
+(defun erc-track-tests--modified-channels/baseline (set-faces)
+ ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(1 . erc-notice-face)))
+
+ ;; Someone speaks, and the mode-line face goes from ERC's generic
+ ;; "notice" face, `erc-notice-face', to the first face in the
+ ;; inserted message that outranks it, which happens to be the
+ ;; `button' module's composite face for buttonized speakers:
+ ;; (erc-button-nick-default-face erc-nick-default-face). It
+ ;; outranks both the previous occupant, `erc-notice-face', and its
+ ;; one cohabitant in the message text, `erc-default-face', in
+ ;; `erc-track-faces-priority-list'. Note that in the following
+ ;; list, `erc-default-face' appears first because it's used for the
+ ;; opening speaker bracket "<". The timestamp appears last because
+ ;; it's a right-sided stamp appended to the message body.
+ (funcall set-faces '(erc-timestamp-face
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(2 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; The speaker speaks again immediately, and the segment changes to
+ ;; `erc-default-face', which appears later in the message, as
+ ;; normal body text. This happens because both `erc-default-face'
+ ;; and (erc-button-nick-default-face erc-nick-default-face) appear
+ ;; in `erc-track-faces-normal-list', meaning the lower-ranked
+ ;; former can replace the higher-ranked latter in the mode-line for
+ ;; the purpose of indicating channel activity.
+ (funcall set-faces '(erc-timestamp-face
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(3 . erc-default-face)))
+
+ ;; Note: if (erc-button-nick-default-face erc-nick-default-face)
+ ;; were removed from `erc-track-faces-priority-list' but kept in
+ ;; `erc-track-faces-normal-list', then replaying the sequence would
+ ;; result in the previous two results being switched:
+ ;; `erc-default-face' would replace `erc-notice-face' before being
+ ;; replaced by the buttonized composite.
+
+ ;; The speaker speaks yet again, and the segment goes back to the
+ ;; higher ranking face.
+ (funcall set-faces '(erc-timestamp-face
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(4 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; Finally, another notice arrives. Although lower ranked, it also
+ ;; appears in `erc-track-faces-normal-list' and so is eligible to
+ ;; replace the incumbent.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(5 . erc-notice-face))))
+
+(ert-deftest erc-track-modified-channels/baseline ()
+ (erc-tests-common-track-modified-channels
+ #'erc-track-tests--modified-channels/baseline))
+
+(ert-deftest erc-track-modified-channels/baseline/mention ()
+ (erc-tests-common-track-modified-channels
+ (lambda (set-faces)
+ ;; Note: these messages don't have timestamps.
+
+ ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(1 . erc-notice-face)))
+
+ ;; Someone speaks, mentioning someone else, and the mode-line
+ ;; changes to (erc-button-nick-default-face erc-nick-default-face)
+ ;; rather than (erc-button-nick-default-face erc-default-face)
+ ;; based on their rankings in `erc-track-faces-priority-list'.
+ (funcall set-faces '((erc-button-nick-default-face erc-default-face)
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(2 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; Someone else speaks, again with a mention and additional body text.
+ (funcall set-faces '((erc-button-nick-default-face erc-default-face)
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(3 erc-button-nick-default-face erc-default-face)))
+
+ ;; And yet again, which results in the indicator going back to one.
+ (funcall set-faces '((erc-button-nick-default-face erc-default-face)
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(4 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; Finally, another notice arrives.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(5 . erc-notice-face))))))
+
+;; The compat-oriented option `erc-track-ignore-normal-contenders-p'
+;; blinds track to `erc-track-faces-normal-list' for certain consecutive
+;; messages with an identical face makeup.
+(ert-deftest erc-track-modified-channels/baseline/ignore ()
+ (let ((erc-track-ignore-normal-contenders-p t))
+ (erc-tests-common-track-modified-channels
+ (lambda (set-faces)
+ ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(1 . erc-notice-face)))
+
+ ;; Someone speaks, and the mode-line indicator's face changes to
+ ;; that of a buttonized speaker.
+ (funcall set-faces
+ '(erc-timestamp-face
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(2 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; The speaker speaks again immediately, and the segment doesn't
+ ;; change.
+ (funcall set-faces
+ '(erc-timestamp-face
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(3 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; Finally, another notice arrives.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(4 . erc-notice-face)))))))
+
+;; Compat-oriented option `erc-track-ignore-normal-contenders-p'.
+(ert-deftest erc-track-modified-channels/baseline/mention/ignore ()
+ (let ((erc-track-ignore-normal-contenders-p t))
+ (erc-tests-common-track-modified-channels
+ (lambda (set-faces)
+
+ ;; Simulate a JOIN, PART, etc. that's displayed in `erc-notice-face'.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(1 . erc-notice-face)))
+
+ ;; Someone speaks, and the mode-line indicator's face changes to
+ ;; that of a buttonized speaker.
+ (funcall set-faces
+ '((erc-button-nick-default-face erc-default-face)
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(2 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; Someone else speaks, again with a mention and additional body
+ ;; text, but the indicator stays the same.
+ (funcall set-faces
+ '((erc-button-nick-default-face erc-default-face)
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(3 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; Finally, another notice arrives.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(4 . erc-notice-face)))))))
+
+;; Option `erc-track-priority-faces-only' does not affect the behavior
+;; of the baseline "normals" scenario because all faces appear in
+;; `erc-track-faces-priority-list'.
+(ert-deftest erc-track-modified-channels/priority-only-all/baseline ()
+ (let ((erc-track-priority-faces-only 'all))
+ (erc-tests-common-track-modified-channels
+ #'erc-track-tests--modified-channels/baseline)))
+
+;; This test simulates a common configuration that combines an
+;; `erc-track-faces-priority-list' removed of `erc-notice-face' with
+;; `erc-track-priority-faces-only' being `all'. It also features in the
+;; sample configuration in ERC's manual.
+(ert-deftest erc-track-modified-channels/priority-only-all/sans-notice ()
+ (let ((erc-track-priority-faces-only 'all)
+ (erc-track-faces-priority-list
+ (remq 'erc-notice-face erc-track-faces-priority-list)))
+
+ (erc-tests-common-track-modified-channels
+ (lambda (set-faces)
+ ;; Note: these messages don't have timestamps.
+
+ ;; Simulate a message normally displayed in `erc-notice-face',
+ ;; which has been removed from `erc-track-faces-priority-list'.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should-not (alist-get (current-buffer) erc-modified-channels-alist))
+
+ ;; Someone speaks, mentioning someone else, and the mode-line
+ ;; changes to the buttonized speaker face rather than the
+ ;; buttonized mention face, due to their respective ranks.
+ (funcall set-faces
+ '((erc-button-nick-default-face erc-default-face)
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(1 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; Someone else speaks, again with a mention and additional body text.
+ (funcall set-faces
+ '((erc-button-nick-default-face erc-default-face)
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(2 erc-button-nick-default-face erc-default-face)))
+
+ ;; And yet again, which results in the indicator going back to one.
+ (funcall set-faces
+ '((erc-button-nick-default-face erc-default-face)
+ (erc-button-nick-default-face erc-nick-default-face)
+ erc-default-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(3 erc-button-nick-default-face erc-nick-default-face)))
+
+ ;; Finally, another notice arrives, which is ignored.
+ (funcall set-faces '(erc-notice-face))
+ (erc-track-modified-channels)
+ (should (equal (alist-get (current-buffer) erc-modified-channels-alist)
+ '(3 erc-button-nick-default-face
+ erc-nick-default-face)))))))
+
;;; erc-track-tests.el ends here
(set-process-query-on-exit-flag proc t)
proc))
+(declare-function erc-track--setup "erc-track" ())
+
+(defun erc-tests-common-track-modified-channels (test)
+ (erc-tests-common-prep-for-insertion)
+ (setq erc--target (erc--target-from-string "#chan"))
+ (erc-tests-common-track-modified-channels-sans-setup test))
+
+(defun erc-tests-common-track-modified-channels-sans-setup (test)
+ "Provide a fixture for testing `erc-track-modified-channels'.
+Call function TEST with another function that sets the mocked return
+value of `erc-track--collect-faces-in' to the given argument, a list of
+faces in the reverse order they appear in an inserted message."
+ (defvar erc-modified-channels-alist)
+ (defvar erc-modified-channels-object)
+ (defvar erc-track--attn-faces)
+ (defvar erc-track--normal-faces)
+ (defvar erc-track--priority-faces)
+ (defvar erc-track-faces-normal-list)
+ (defvar erc-track-faces-priority-list)
+ (defvar erc-track-mode)
+
+ (cl-letf* ((erc-track-mode t)
+ (erc-modified-channels-alist nil)
+ (erc-modified-channels-object erc-modified-channels-object)
+ (faces ())
+ ((symbol-function 'force-mode-line-update) #'ignore)
+ ((symbol-function 'erc-faces-in) (lambda (_) faces))
+ ((symbol-function 'erc-track--collect-faces-in)
+ (lambda ()
+ (cons (map-into (mapcar (lambda (f) (cons f t)) faces)
+ '(hash-table :test equal))
+ faces))))
+ (erc-track--setup)
+
+ ;; Faces from `erc-track--attn-faces' prepended.
+ (should (= (+ (length erc-track--attn-faces)
+ (length erc-track-faces-priority-list))
+ (hash-table-count erc-track--priority-faces)))
+ (should (= (length erc-track-faces-normal-list)
+ (hash-table-count erc-track--normal-faces)))
+
+ (funcall test (lambda (arg) (setq faces arg)))))
+
(provide 'erc-tests-common)
projects / emacs.git / commitdiff