mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-28 07:45:00 +00:00
Promote "normal" faces in erc-track
* etc/ERC-NEWS: Add entry for new behavior involving the option `erc-track-faces-normal-list'. * 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 `erc-button-nick-default-face'. * 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 present. (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 teardown. (erc-track--normal-faces): New local variable, a snapshot of `erc-track-faces-normal-list'. (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)
This commit is contained in:
F. Jason Park
parent
741bce8489
commit
9d889af0d6
39
etc/ERC-NEWS
39
etc/ERC-NEWS
@ -163,6 +163,19 @@ options, like 'erc-command-indicator', have moved to the 'erc-goodies'
|
||||
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
|
||||
disconnected.
|
||||
|
||||
*** 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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -161,23 +161,39 @@ The faces used are the same as used for text in the buffers.
|
||||
\(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-error-face
|
||||
(erc-nick-default-face erc-current-nick-face)
|
||||
erc-current-nick-face
|
||||
erc-keyword-face
|
||||
(erc-nick-default-face erc-pal-face)
|
||||
erc-pal-face
|
||||
erc-nick-msg-face
|
||||
erc-direct-msg-face
|
||||
(erc-button erc-default-face)
|
||||
(erc-nick-default-face erc-dangerous-host-face)
|
||||
erc-dangerous-host-face
|
||||
erc-nick-default-face
|
||||
(erc-nick-default-face erc-default-face)
|
||||
(erc-button-nick-default-face erc-default-face)
|
||||
erc-default-face
|
||||
erc-action-face
|
||||
(erc-nick-default-face erc-fool-face)
|
||||
erc-fool-face
|
||||
erc-notice-face
|
||||
erc-input-face
|
||||
@ -188,6 +204,8 @@ 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."
|
||||
: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))
|
||||
@ -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-dangerous-host-face
|
||||
erc-nick-default-face
|
||||
(erc-nick-default-face erc-default-face)
|
||||
(erc-button-nick-default-face erc-default-face)
|
||||
erc-default-face
|
||||
erc-action-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
|
||||
\\[erc-track-mode].
|
||||
|
||||
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."
|
||||
(progn
|
||||
(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)
|
||||
(erc-update-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)
|
||||
(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
|
||||
#'erc-track--replace-killed-buffer))
|
||||
;; Disable:
|
||||
@ -539,6 +578,7 @@ keybindings will not do anything useful."
|
||||
#'erc-user-is-active)
|
||||
(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
|
||||
#'erc-window-configuration-change)
|
||||
@ -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
|
||||
#'erc-track--replace-killed-buffer)))
|
||||
|
||||
;; 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."
|
||||
(erc-track-enable))
|
||||
(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
|
||||
buffer'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)
|
||||
;; 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 line
|
||||
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
|
||||
`erc-track-faces-normal-list'."
|
||||
`erc-track-faces-normal-list'.
|
||||
|
||||
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
|
||||
choice))
|
||||
choice))))
|
||||
|
||||
(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)
|
||||
(cons
|
||||
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))))
|
||||
erc-modified-channels-alist))
|
||||
;; Else modify the face for the buffer, if necessary.
|
||||
(when faces
|
||||
(let* ((cell (assq (current-buffer)
|
||||
erc-modified-channels-alist))
|
||||
(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
|
||||
(erc-modified-channels-display)))
|
||||
@ -872,6 +1024,30 @@ the current buffer is in `erc-mode'."
|
||||
(push cur faces)))
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user