[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 9d889af0d68 17/19: Promote "normal" faces in erc-track

From: F. Jason Park
Subject: master 9d889af0d68 17/19: Promote "normal" faces in erc-track
Date: Sun, 17 Dec 2023 23:21:41 -0500 (EST)

branch: master
commit 9d889af0d68a73aa45d112cbad9577f897b6e3c3
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Promote "normal" faces in erc-track
    * etc/ERC-NEWS: Add entry for new behavior involving the option
    * lisp/erc/erc-button.el (erc-button-nick-default-face): New face to
    serve as default for `erc-button-nickname-face'.
    (erc-button-nickname-face): Change default value to
    * lisp/erc/erc-track.el (erc-track--massage-nick-button-faces): New
    function to serve as Custom :set function for priority and "normal"
    face-list options.
    (erc-track-faces-normal-list): Fix Custom :type by loading
    `erc-button' during validation so Customize chooses the correct UI
    instead of a generic form field with "(mismatch)" printed alongside
    the "STATE" button.
    (erc-track-faces-priority-list, erc-track-faces-normal-list): Remove
    values for "buttonized" `match' module faces that, if retained, would
    need updating to feature `erc-button-nick-default-face' instead of
    `erc-nick-default-face'.  However, as noted in the NEWS entry, this
    ordering of button face atop match face is not possible.  Use :set
    function to massage saved user values.
    (erc-track-ignore-normal-contenders-p): New compatibility switch to
    access pre-5.6 behavior, in which faces in
    `erc-track-faces-normal-list' were only considered for promotion to
    the mode line if the current face occupying that pole position wasn't
    (erc-track-mode, erc-track-enable, erc-track-disable): Add comments
    regarding perceived futility of hooking on `erc-server-001-functions'
    and likely unneeded hook removal.  Run common buffer-local setup and
    (erc-track--normal-faces): New local variable, a snapshot of
    (erc-track--setup): New function to stash
    `erc-track-faces-normal-list' on init.
    (erc-track-select-mode-line-face): Offer alternate explanation of
    certain particulars in doc string.
    (erc-track--alt-normals-function): New function-valued variable to
    allow other modules to intervene in deciding whether to pursue and
    promote a "normal" contending face.
    (erc-track--select-mode-line-face): New function similar to its public
    namesake except that it considers other viable candidates among the
    "normal" alternatives.
    (erc-track-modified-channels): Only run face selection portion when
    faces are actually found.  Use `erc-track--select-mode-line-face'
    instead of `erc-track-select-mode-line-face'.
    * test/lisp/erc/erc-track-tests.el
    (erc-track-select-mode-line-face): New test.
    (erc-track-tests--select-mode-line-face): New fixture function.
    (erc-track--select-mode-line-face): New test.  (Bug#67767)
 etc/ERC-NEWS                     |  39 +++++++
 lisp/erc/erc-button.el           |   8 +-
 lisp/erc/erc-track.el            | 224 ++++++++++++++++++++++++++++++++++-----
 test/lisp/erc/erc-track-tests.el | 130 +++++++++++++++++++++++
 4 files changed, 376 insertions(+), 25 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 1311df3c21a..c883f575c15 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -163,6 +163,19 @@ options, like 'erc-command-indicator', have moved to the 
 library, although their Custom groups remain the same.  Add
 'command-indicator' to 'erc-modules' to get started.
+** Option 'erc-track-faces-normal-list' slightly more influential.
+This option has always been a source of confusion for users, mainly
+because its influence rode heavily on the makeup of faces in a given
+message.  Historically, when a buffer's current mode-line face was a
+member of this option's value, ERC would only swap it out for a fellow
+"normal" if it was absent from the message being processed.  Beginning
+with this release, ERC now looks to other ranked and, if necessary,
+unranked "normals" instead of sustaining the same face between
+messages.  This was done to better honor the stated purpose of the
+option, which is to provide consistent visual feedback when buffer
+activity occurs.  If you experience problems with this development,
+see the compatibility flag 'erc-track-ignore-normal-contenders-p'.
 ** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
 It's no secret that the 'buttons' module treats potential nicknames
 specially.  This is perhaps most evident in its treatment of the
@@ -177,6 +190,23 @@ s-expressions, which ERC will continue to honor.  Although 
the default
 lineup remains functionally equivalent, its members have all been
 updated accordingly.
+** 'erc-track-faces-priority-list' and 'erc-track-faces-normal-list' slimmed.
+These options have been purged of certain 'button'-related face
+combinations.  Originally added in ERC 5.3, these combinations
+described the effect of "buttonizing" atop faces added by the 'match'
+module, like '(erc-nick-default-face erc-pal-face)'.  However, since
+at least Emacs 27, 'match' has run before 'button' in
+'erc-insert-modify-hook', meaning such permutations aren't possible.
+More importantly, users who've customized either of these options
+should update them with the new default value of the option
+'erc-button-nickname-face'.  Like 'erc-nick-default-face', which it
+replaces, the new 'erc-button-nick-default-face' is also a "real"
+face.  Its sole reason for existing is to make it easier for users and
+modules to distinguish between basic buttonized faces and
+'erc-nick-default-face', which is now reserved to mean the base
+"speaker" face.
 ** Option 'erc-query-on-unjoined-chan-privmsg' restored and renamed.
 This option was accidentally removed from the default client in ERC
 5.5 and was thus prevented from influencing PRIVMSG routing.  It's now
@@ -329,6 +359,15 @@ from 't' to the more useful 'erc-prompt', although the 
property of the
 same name has been retained and now has a value of 'hidden' when
+*** Lists of faces in buttonized text are no longer nested.
+Previously, when "buttonizing" a new region, ERC would combine faces
+by blindly consing the new onto the existing.  In theory, this kept a
+nice record of all modifications to a given region.  However, it also
+complicated life for other modules wanting to analyze and operate on
+these regions.  Beginning with this release, ERC now merges combined
+faces together when creating buttons, although the odd nested list may
+still crop up here and there.
 *** Members of insert- and send-related hooks have been reordered.
 As anyone reading this is no doubt aware, both built-in and
 third-party modules rely on certain hooks for adjusting incoming and
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 8e013c3a0d7..0af6911aaf4 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -70,6 +70,11 @@
   "ERC button face."
   :group 'erc-faces)
+(defface erc-button-nick-default-face '((t :inherit erc-nick-default-face))
+  "Default face for a buttonized nickname."
+  :package-version '(ERC . "5.6")
+  :group 'erc-faces)
 (defcustom erc-button-face 'erc-button
   "Face used for highlighting buttons in ERC buffers.
@@ -78,8 +83,9 @@ A button is a piece of text that you can activate by pressing
   :type 'face
   :group 'erc-faces)
-(defcustom erc-button-nickname-face 'erc-nick-default-face
+(defcustom erc-button-nickname-face 'erc-button-nick-default-face
   "Face used for ERC nickname buttons."
+  :package-version '(ERC . "5.6")
   :type 'face
   :group 'erc-faces)
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 7dc4fe754cd..b704575ebca 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -161,23 +161,39 @@ The faces used are the same as used for text in the 
 \(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
   :type 'boolean)
+(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)))))
 (defcustom erc-track-faces-priority-list
-    (erc-nick-default-face erc-current-nick-face)
-    (erc-nick-default-face erc-pal-face)
     (erc-button erc-default-face)
-    (erc-nick-default-face erc-dangerous-host-face)
-    (erc-nick-default-face erc-default-face)
+    (erc-button-nick-default-face erc-default-face)
-    (erc-nick-default-face erc-fool-face)
@@ -188,6 +204,8 @@ be highlighted using that face.  The first matching face is 
 Note that ERC prioritizes certain faces reserved for critical
 messages regardless of this option's value."
+  :package-version '(ERC . "5.6")
+  :set #'erc-track--massage-nick-button-faces
   :type (erc--with-dependent-type-match
          (repeat (choice face (repeat :tag "Combination" face)))
@@ -209,10 +227,9 @@ setting this variable might not be very useful."
 (defcustom erc-track-faces-normal-list
   '((erc-button erc-default-face)
-    (erc-nick-default-face erc-dangerous-host-face)
-    (erc-nick-default-face erc-default-face)
+    (erc-button-nick-default-face erc-default-face)
   "A list of faces considered to be part of normal conversations.
@@ -224,9 +241,26 @@ the buffer name will be highlighted using the face from the
 message.  This gives a rough indication that active conversations
 are occurring in these channels.
+Note that ERC makes a copy of this option when initializing the
+module.  To see your changes reflected mid-session, cycle
 The effect may be disabled by setting this variable to nil."
-  :type '(repeat (choice face
-                        (repeat :tag "Combination" face))))
+  :package-version '(ERC . "5.6")
+  :set #'erc-track--massage-nick-button-faces
+  :type (erc--with-dependent-type-match
+         (repeat (choice face (repeat :tag "Combination" face)))
+         erc-button))
+(defvar erc-track-ignore-normal-contenders-p nil
+  "Compatibility flag to promote only exclusively new \"normal\" faces.
+When non-nil, revert to pre-5.6 behavior in which only a current
+mode-line face that both outranks and is absent from the current
+message is eligible for replacement by a fellow face from
+`erc-track-faces-normal-list' that does appear in the message.
+By extension, when enabled, never replace the current, reigning
+mode-line face if it's present in the current message.  May be
+incompatible with modules introduced after ERC 5.5.")
 (defcustom erc-track-position-in-mode-line 'before-modes
   "Where to show modified channel information in the mode-line.
@@ -518,6 +552,9 @@ keybindings will not do anything useful."
           (add-hook 'window-configuration-change-hook #'erc-user-is-active)
           (add-hook 'erc-send-completed-hook #'erc-user-is-active)
+           ;; FIXME find out why this uses `erc-server-001-functions'.
+           ;; `erc-user-is-active' runs when `erc-server-connected' is
+           ;; non-nil.  But this hook usually only runs when it's nil.
           (add-hook 'erc-server-001-functions #'erc-user-is-active))
        (erc-track-add-to-mode-line erc-track-position-in-mode-line)
@@ -528,6 +565,8 @@ keybindings will not do anything useful."
      ;; enable the tracking keybindings
      (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
+   (add-hook 'erc-mode-hook #'erc-track--setup)
+   (unless erc--updating-modules-p (erc-buffer-do #'erc-track--setup))
    (add-hook 'erc-networks--copy-server-buffer-functions
   ;; Disable:
@@ -539,6 +578,7 @@ keybindings will not do anything useful."
           (remove-hook 'erc-send-completed-hook #'erc-user-is-active)
           (remove-hook 'erc-server-001-functions #'erc-user-is-active)
+           ;; FIXME remove this if unused.
           (remove-hook 'erc-timer-hook #'erc-user-is-active))
        (remove-hook 'window-configuration-change-hook
@@ -548,9 +588,12 @@ keybindings will not do anything useful."
      (remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
      (when erc-track-minor-mode
        (erc-track-minor-mode -1)))
+   (remove-hook 'erc-mode-hook #'erc-track--setup)
+   (erc-buffer-do #'erc-track--setup)
    (remove-hook 'erc-networks--copy-server-buffer-functions
+;; FIXME move this above the module definition.
 (defcustom erc-track-when-inactive nil
   "Enable channel tracking even for visible buffers, if you are inactive."
   :type 'boolean
@@ -562,6 +605,51 @@ keybindings will not do anything useful."
           (set sym val))))
+(defvar-local erc-track--normal-faces nil
+  "Local copy of `erc-track-faces-normal-list' as a hash table.")
+(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
+  (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)
+        ;; 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)
+              (erc-track--massage-nick-button-faces opt (symbol-value opt)
+                                                    #'set)))
+          (dolist (opt opts)
+            (when (get opt 'erc-track--obsolete-faces)
+              (push opt 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))))
+    (kill-local-variable 'erc-track--normal-faces)))
 ;;; Visibility
 (defvar erc-buffer-activity nil
@@ -766,7 +854,12 @@ instead.  This has the effect of allowing the current mode 
 face, if a member of `erc-track-faces-normal-list', to be
 replaced with another with lower priority face from NEW-FACES, if
 that face with highest priority in NEW-FACES is also a member of
+To put it another way, when CUR-FACE outranks all NEW-FACES and
+doesn't appear among them, it's eligible to be replaced with a
+fellow \"normal\" from NEW-FACES.  But if it does appear among
+them, it can't be replaced."
   (let ((choice (catch 'face
                   (dolist (candidate erc-track-faces-priority-list)
                     (when (or (equal candidate cur-face)
@@ -785,6 +878,53 @@ that face with highest priority in NEW-FACES is also a 
member of
+(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.")
+(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-face-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."
+  (cl-check-type erc-track-ignore-normal-contenders-p null)
+  (cl-check-type new-faces cons)
+  (when-let ((choice (catch 'face
+                       (dolist (candidate 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))
+        (and (equal choice cur-face)
+             (gethash choice normals)
+             (catch 'face
+               (progn
+                 (dolist (candidate ranks)
+                   (when (and (not (equal candidate choice))
+                              (gethash candidate (car new-faces))
+                              (gethash choice normals))
+                     (throw 'face candidate)))
+                 (dolist (candidate (cdr new-faces))
+                   (when (and (not (equal candidate choice))
+                              (gethash candidate normals))
+                     (throw 'face candidate))))))
+        choice)))
 (defvar erc-track--skipped-msgs '(datestamp)
   "Values of `erc--msg' text prop to ignore.")
@@ -819,31 +959,43 @@ 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)))
-              (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))
-                  (not (catch 'found
-                         (dolist (f faces)
-                           (when (member f erc-track-faces-priority-list)
-                             (throw 'found t))))))
+        (when-let
+            ((faces (if erc-track-ignore-normal-contenders-p
+                        (erc-faces-in (buffer-string))
+                      (erc-track--get-faces-in-current-message)))
+             (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)
+             ((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)))))))))
+          (progn ; FIXME remove `progn' on next major edit
            (if (not (assq (current-buffer) erc-modified-channels-alist))
                ;; Add buffer, faces and counts
                (setq erc-modified-channels-alist
                      (cons (cons (current-buffer)
-                                   1 (erc-track-select-mode-line-face
-                                      nil faces)))
+                                   1 (if erc-track-ignore-normal-contenders-p
+                                         (erc-track-select-mode-line-face
+                                          nil faces)
+                                       (erc-track--select-mode-line-face
+                                        nil faces ranks normals))))
              ;; Else modify the face for the buffer, if necessary.
              (when faces
                (let* ((cell (assq (current-buffer)
                       (old-face (cddr cell))
-                      (new-face (erc-track-select-mode-line-face
-                                  old-face faces)))
+                       (new-face (if erc-track-ignore-normal-contenders-p
+                                     (erc-track-select-mode-line-face
+                                      old-face faces)
+                                   (erc-track--select-mode-line-face
+                                    old-face faces ranks normals))))
                  (setcdr cell (cons (1+ (cadr cell)) new-face)))))
            ;; And display it
@@ -872,6 +1024,30 @@ the current buffer is in `erc-mode'."
           (push cur faces)))
+(defvar erc-track--face-reject-function nil
+  "Function called with face in current buffer to massage or reject.")
+(defun erc-track--get-faces-in-current-message ()
+  "Collect all faces in the narrowed buffer.
+Return a cons of a hash table and a list ordered from most
+recently seen to earliest seen."
+  (let ((i (text-property-not-all (point-min) (point-max) 'font-lock-face nil))
+        (seen (make-hash-table :test #'equal))
+        ;;
+        (rfaces ())
+        (faces (make-hash-table :test #'equal)))
+    (while-let ((i)
+                (cur (get-text-property i 'face)))
+      (unless (gethash cur seen)
+        (puthash cur t seen)
+        (when erc-track--face-reject-function
+          (setq cur (funcall erc-track--face-reject-function cur)))
+        (when cur
+          (push cur rfaces)
+          (puthash cur t faces)))
+      (setq i (next-single-property-change i 'font-lock-face)))
+    (cons faces rfaces)))
 ;;; Buffer switching
 (defvar erc-track-last-non-erc-buffer nil
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index ab8d708b721..4477727be8a 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -120,4 +120,134 @@
     (should (erc-faces-in str0))
     (should (erc-faces-in str1)) ))
+;; This simulates an alternating bold/non-bold [#c] in the mode-line,
+;; i.e., an `erc-modified-channels-alist' that vacillates between
+;;   ((#<buffer #chan> 42 . erc-default-face))
+;; and
+;;   ((#<buffer #chan> 42 erc-nick-default-face erc-default-face))
+;; This is a fairly typical scenario where consecutive messages
+;; feature speaker and addressee button highlighting and otherwise
+;; plain message bodies.  This mapping of phony to real faces
+;; describes the picture in 5.6:
+;;   `1': (erc-button erc-default-face)                 ; URL
+;;   `2': (erc-nick-default-face erc-default-face)      ; mention
+;;   `3': erc-default-face                              ; body
+;;   `_': (erc-nick-default-face erc-nick-default-face) ; speaker
+;; The `_' represents a commonly occurring face (a <speaker>) that's
+;; not present in either option's default (standard) value.  It's a
+;; no-op from the POV of `erc-track-select-mode-line-face'.
+(ert-deftest erc-track-select-mode-line-face ()
+  ;; Observed (see key above).
+  (let ((erc-track-faces-priority-list '(1 2 3))
+        (erc-track-faces-normal-list   '(1 2 3)))
+    (should (equal 2 (erc-track-select-mode-line-face 3 '(2 _ 3))))
+    (should (equal 2 (erc-track-select-mode-line-face 2 '(2 _ 3))))
+    (should (equal 3 (erc-track-select-mode-line-face 2 '(_ 3))))
+    (should (equal 2 (erc-track-select-mode-line-face 3 '(2 3))))
+    (should (equal 3 (erc-track-select-mode-line-face 2 '(3))))
+    (should (equal 1 (erc-track-select-mode-line-face 1 '(2 1 3))))
+    (should (equal 1 (erc-track-select-mode-line-face 1 '(1 3))))
+    (should (equal 1 (erc-track-select-mode-line-face 1 '(1 3 2))))
+    (should (equal 1 (erc-track-select-mode-line-face 1 '(3 1)))))
+  ;; When the current face outranks all new faces and doesn't appear
+  ;; among them, it's eligible to be replaced with a fellow "normal"
+  ;; from those new faces.  But if it does appear among them, it's
+  ;; never replaced.
+  (let ((erc-track-faces-priority-list '(a b))
+        (erc-track-faces-normal-list   '(a b)))
+    (should (equal 'a (erc-track-select-mode-line-face 'a '(b a))))
+    (should (equal 'a (erc-track-select-mode-line-face 'a '(a b))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(b a))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(a b))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(a))))
+    (should (equal 'b (erc-track-select-mode-line-face 'a '(b)))))
+  ;; The ordering of the "normal" list doesn't matter.
+  (let ((erc-track-faces-priority-list '(a b))
+        (erc-track-faces-normal-list   '(b a)))
+    (should (equal 'a (erc-track-select-mode-line-face 'a '(b a))))
+    (should (equal 'a (erc-track-select-mode-line-face 'a '(a b))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(b a))))
+    (should (equal 'a (erc-track-select-mode-line-face 'b '(a b))))))
+(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)))
+  (pcase-dolist (`(,want ,cur-face ,new-faces) cases)
+    (ert-info ((format "Observed: {cur: %S, new: %S, want: %S}"
+                       cur-face new-faces want))
+      (setq new-faces (cons (map-into
+                             (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))))))
+;; The main difference between these variants is that with the above,
+;; when given alternating lines like
+;;  CUR      NEW                          CHOICE
+;;   text     (mention $speaker text)  =>   mention
+;;   mention  ($speaker text)          =>   text
+;; we see the effect of alternating faces in the indicator.  But when
+;; given consecutive lines with a similar composition, like
+;;   text     (mention $speaker text)  =>   mention
+;;   text     (mention $speaker text)  =>   mention
+;; we lose the effect.  With the variant below, we get
+;;   text     (mention $speaker text)  =>   mention
+;;   text     (mention $speaker text)  =>   text
+(ert-deftest erc-track--select-mode-line-face ()
+  (should-not erc-track-ignore-normal-contenders-p)
+  ;; These are the same test cases from the previous test.  The syntax
+  ;; is (expected cur-face new-faces).
+  (erc-track-tests--select-mode-line-face
+   '(1 2 3) '(1 2 3)
+   '((2 3 (2 _ 3))
+     (3 2 (2 _ 3))
+     (3 2 (_ 3))
+     (2 3 (2 3))
+     (3 2 (3))
+     (2 1 (2 1 3))
+     (3 1 (1 3))
+     (2 1 (1 3 2))
+     (3 1 (3 1))))
+  (erc-track-tests--select-mode-line-face
+   '(a b) '(a b)
+   '((b a (b a))
+     (b a (a b))
+     (a b (b a))
+     (a b (a b))
+     (a b (a))
+     (b a (b))))
+  (erc-track-tests--select-mode-line-face
+   '(a b) '(b a)
+   '((b a (b a))
+     (b a (a b))
+     (a b (b a))
+     (a b (a b)))))
 ;;; erc-track-tests.el ends here

reply via email to

[Prev in Thread] Current Thread [Next in Thread]