From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#63569: 30.0.50; ERC 5.6: Add automatic nickname highlighting to ERC Date: Tue, 23 May 2023 06:37:43 -0700 Message-ID: <87v8gjrwwo.fsf__25148.7589253642$1684849113$gmane$org@neverwas.me> References: <87ilcp1za1.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="14472"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 63569@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue May 23 15:38:26 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1q1SDY-0003Xw-DB for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 23 May 2023 15:38:25 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1q1SDM-00028X-PQ; Tue, 23 May 2023 09:38:12 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q1SDD-00024z-IA for bug-gnu-emacs@gnu.org; Tue, 23 May 2023 09:38:04 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1q1SDB-0007Kt-QF for bug-gnu-emacs@gnu.org; Tue, 23 May 2023 09:38:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1q1SDB-0001Jt-M5 for bug-gnu-emacs@gnu.org; Tue, 23 May 2023 09:38:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 23 May 2023 13:38:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63569 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 63569-submit@debbugs.gnu.org id=B63569.16848490795065 (code B ref 63569); Tue, 23 May 2023 13:38:01 +0000 Original-Received: (at 63569) by debbugs.gnu.org; 23 May 2023 13:37:59 +0000 Original-Received: from localhost ([127.0.0.1]:38683 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q1SD7-0001Jb-9T for submit@debbugs.gnu.org; Tue, 23 May 2023 09:37:59 -0400 Original-Received: from mail-108-mta81.mxroute.com ([136.175.108.81]:35599) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q1SD3-0001JJ-Cc for 63569@debbugs.gnu.org; Tue, 23 May 2023 09:37:55 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta81.mxroute.com (ZoneMTA) with ESMTPSA id 18848d4806a00074ee.001 for <63569@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Tue, 23 May 2023 13:37:46 +0000 X-Zone-Loop: 2d7adc9913f8da320d309ee0146c40b25fae8aad7c3e X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=FV+EfIYEtbg56cWQYYu903I5ppOl5pxu/GphRCzHPTI=; b=M77lb17iIWJgFRnWx/jzDdN2vU DJTlvukKG9wXPGCZQxZ/J9TIHjRX0m78/dPdYID63+VMl6PVw/R4zob7jmO6P+2+2wSvhj6+vvJKk az2tZVXzuYFJcvc0WtjYwCWUnvcuMQldu0iqQrm7XH6JkdmpMb+uWBOOj40yAF9LHBA2/mnRrGgjS mAfHLzpPNAqzfPXFaWqy+bS5vIW38dtt4RcREGq7cZ2/A83+3zp4wLXRryJ3gJ5RnEpikaWT4LERJ xlTl55tiRCpQCAe6I8gLOXAx2XbgZAf97HFOsyzrRaQg4bM2GrImrkEIZXi0rZxh0NiMqD/7wm36x pbOcBjJg==; In-Reply-To: <87ilcp1za1.fsf@neverwas.me> (J. P.'s message of "Thu, 18 May 2023 07:37:26 -0700") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:262229 Archived-At: --=-=-= Content-Type: text/plain v2. Generalize contrast function. Make option `erc-nicks-contrast-ratio' a cons. Change default for `erc-nicks-color-contrast-strategy'. Generate `use-package' snippet alongside standard `defface' (to help Customize haters persist edited colors). --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From 8e16d161b6e9f3c67b4ccbe9e44fc73c43bb70f5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 23 May 2023 06:31:04 -0700 Subject: [PATCH 0/1] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (1): [5.6] Add module for colorizing nicknames to ERC doc/misc/erc.texi | 4 + etc/ERC-NEWS | 8 + lisp/erc/erc-button.el | 12 +- lisp/erc/erc-nicks.el | 389 +++++++++++++++++++++++++++++++ lisp/erc/erc.el | 1 + test/lisp/erc/erc-nicks-tests.el | 174 ++++++++++++++ test/lisp/erc/erc-tests.el | 2 +- 7 files changed, 586 insertions(+), 4 deletions(-) create mode 100644 lisp/erc/erc-nicks.el create mode 100644 test/lisp/erc/erc-nicks-tests.el Interdiff: diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index 53d1e0cc592..85d182f9a09 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -44,7 +44,7 @@ erc-nicks-ignore-chars-regexp (cons (rx bot (+ (any ",`'_-"))) (rx (+ (any ",`'_-")) eot)) "Characters surrounding a nick to ignore while highlighting. Regexps should be suitable for `string-trim'." - :type '(choice (cons string string) (const nil))) + :type '(choice (cons regexp regexp) (const nil))) (defcustom erc-nicks-skip-nicks nil "Nicks to not highlight." @@ -68,7 +68,7 @@ erc-nicks-bg-color :type 'string) (defcustom erc-nicks-color-contrast-strategy - '(erc-nicks-invert erc-nicks-add-contrast) + '(erc-nicks-add-contrast erc-nicks-cap-contrast) "Treatments applied to colors for increasing visibility. A value of `erc-nicks-invert' inverts a nick when it's too close to the background. A value of `erc-nicks-add-contrast' @@ -82,22 +82,24 @@ erc-nicks-color-contrast-strategy that anything specified by this option will still be applied when `erc-nicks-colors' is a user-defined list of colors." :type '(choice (function-item :tag "Invert" erc-nicks-invert) - (function-item :tag "Contrast" erc-nicks-add-contrast) + (function-item :tag "Add contrast" erc-nicks-add-contrast) + (function-item :tag "Cap contrast" erc-nicks-cap-contrast) (repeat function) (const nil) function)) -(defcustom erc-nicks-contrast-ratio 3.5 - "Desired amount of contrast. -For this to matter, `erc-nicks-add-contrast' must be present in -the value of `erc-nicks-color-contrast-strategy'. When that's -so, this specifies the amount of contrast between a buffer's -background color and the foreground colors chosen. The closer -the number is to the maximum, 21(:1), the greater the contrast. -Depending on the background, nicks are either tinted in pastel or -muted with dark gray. Somewhere between 3.0 and 4.5 seems ideal." - :type '(number :match (lambda (_ n) (and (floatp n) (< 0 n 21))) - :type-error "This should be a float between 0 and 21")) +(defcustom erc-nicks-contrast-ratio '(3.5 . 12.5) + "Desired range of contrast as a cons of (MIN . MAX). +For this to matter, `erc-nicks-color-contrast-strategy' must be +set to `erc-nicks-add-contrast' or `erc-nicks-cap-contrast' or +contain at least one if that option is a list. If adding +contrast, MIN specifies the minimum amount allowed between a +buffer's background color and the foreground colors specified by +`erc-nicks-colors'. The closer the number to the possible +maximum of 21(:1), the greater the contrast. Depending on the +background, nicks are either tinted in pastel or muted with dark +gray. MAX works similarly for reducing contrast." + :type '(cons float float)) (defcustom erc-nicks-colors 'all "Pool of colors. @@ -142,14 +144,11 @@ erc-nicks--bg-luminance ;; We could cache results, which may help when `erc-nicks-colors' is ;; set to `defined'. -(defun erc-nicks-add-contrast (color) - "Adjust COLOR by blending it with white or black. -Unless sufficient contrast exists between COLOR and the -background, bring the contrast up to `erc-nicks-contrast-ratio'." +(defun erc-nicks--adjust-contrast (color target &optional decrease) (let* ((lum-bg (or erc-nicks--bg-luminance (setq erc-nicks--bg-luminance (erc-nicks--get-luminance erc-nicks-bg-color)))) - (stop (if (eq 'dark (erc-nicks--bg-mode)) + (stop (if (eq (if decrease 'light 'dark) (erc-nicks--bg-mode)) '(1.0 1.0 1.0) '(0.0 0.0 0.0))) (start (color-name-to-rgb color)) @@ -168,7 +167,7 @@ erc-nicks-add-contrast (lighter (if (= darker lum-bg) lum-fg lum-bg)) (cur (/ (+ 0.05 lighter) (+ 0.05 darker))) (scale (expt 2 maxtries))) - (cond ((< cur erc-nicks-contrast-ratio) + (cond ((if decrease (> cur target) (< cur target)) (setq r (+ r (* r-step scale)) g (+ g (* g-step scale)) b (+ b (* b-step scale)))) @@ -185,6 +184,19 @@ erc-nicks-add-contrast (not (zerop (cl-decf maxtries))))) (color-rgb-to-hex r g b))) +(defun erc-nicks-add-contrast (color) + "Increase COLOR's contrast by blending it with white or black. +Unless sufficient contrast exists between COLOR and the +background, raise it to somewhere around the lower bound of +`erc-nicks-contrast-ratio'." + (erc-nicks--adjust-contrast color (car erc-nicks-contrast-ratio))) + +(defun erc-nicks-cap-contrast (color) + "Reduce COLOR's contrast by blending it with white or black. +If excessive contrast exists between COLOR and the background, +lower it to the upper bound of `erc-nicks-contrast-ratio'." + (erc-nicks--adjust-contrast color (cdr erc-nicks-contrast-ratio) 'remove)) + ;; Inversion thresholds for dark and light, respectively. (defvar erc-nicks--min-lum (/ 1 3.0)) (defvar erc-nicks--max-lum (/ 2 3.0)) @@ -237,6 +249,9 @@ erc-nicks--create-defface-template face (face-user-default-spec face) (face-documentation face)) (cl-loop for (k v) on erc-nicks--custom-keywords by #'cddr concat (format "\n %s %S" k (list 'quote v))) + ")\n\n;; Or, if you use use-package\n(use-package erc-nicks\n" + " :custom-face\n" + (format " (%s %S)" face (face-user-default-spec face)) ")\n")) (defun erc-nicks--redirect-face-widget-link (args) diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el index 756260d718d..e0a5691b073 100644 --- a/test/lisp/erc/erc-nicks-tests.el +++ b/test/lisp/erc/erc-nicks-tests.el @@ -60,8 +60,8 @@ erc-nicks-invert (should (equal (erc-nicks-invert "black") "black")) (should (equal (erc-nicks-invert "green") "#ffff0000ffff")))) -(defun erc-nicks-tests--show-contrast (color) - (let ((result (erc-nicks-add-contrast color)) +(defun erc-nicks-tests--print-contrast (fn color) + (let ((result (funcall fn color)) (fg (if (eq 'dark erc-nicks--bg-mode-value) "white" "black")) (start (point))) (insert (format "%16s%-16s%16s%-16s\n" @@ -79,29 +79,59 @@ erc-nicks-tests--show-contrast (ert-deftest erc-nicks-add-contrast () (let ((erc-nicks--bg-luminance 1.0) - (erc-nicks--bg-mode-value 'light)) + (erc-nicks--bg-mode-value 'light) + (show (lambda (c) (erc-nicks-tests--print-contrast + #'erc-nicks-add-contrast c)))) (with-current-buffer (get-buffer-create "*erc-nicks-add-contrast*") - (should (equal "#893a893a893a" (erc-nicks-tests--show-contrast "white"))) - (should (equal "#893a893a893a" - (erc-nicks-tests--show-contrast "#893a893a893a"))) - (should (equal "#000000000000" (erc-nicks-tests--show-contrast "black"))) - (should (equal "#ffff00000000" (erc-nicks-tests--show-contrast "red"))) - (should (equal "#0000a12e0000" (erc-nicks-tests--show-contrast "green"))) - (should (equal "#00000000ffff" (erc-nicks-tests--show-contrast "blue"))) + (should (equal "#893a893a893a" (funcall show "white"))) + (should (equal "#893a893a893a" (funcall show "#893a893a893a"))) + (should (equal "#000000000000" (funcall show "black"))) + (should (equal "#ffff00000000" (funcall show "red"))) + (should (equal "#0000a12e0000" (funcall show "green"))) + (should (equal "#00000000ffff" (funcall show "blue"))) ;; When the input is already near the desired ratio, the result ;; may not be in bounds, only close. But the difference is ;; usually imperceptible. (unless noninteractive - (should (equal "#777788889999" ; well inside (light slate gray) - (erc-nicks-tests--show-contrast "#777788889999"))) - (should (equal "#7c498bd39b5c" ; slightly outside -> just outside - (erc-nicks-tests--show-contrast "#88889999aaaa"))) - (should (equal "#7bcc8b479ac0" ; just outside -> just inside - (erc-nicks-tests--show-contrast "#7c498bd39b5c"))) - (should (equal "#7bcc8b479ac0" ; just inside - (erc-nicks-tests--show-contrast "#7bcc8b479ac0")))) + ;; Well inside (light slate gray) + (should (equal "#777788889999" (funcall show "#777788889999"))) + ;; Slightly outside -> just outside + (should (equal "#7c498bd39b5c" (funcall show "#88889999aaaa"))) + ;; Just outside -> just inside + (should (equal "#7bcc8b479ac0" (funcall show "#7c498bd39b5c"))) + ;; Just inside + (should (equal "#7bcc8b479ac0" (funcall show "#7bcc8b479ac0")))) + + (when noninteractive + (kill-buffer))))) + +(ert-deftest erc-nicks-cap-contrast () + (should (= 12.5 (cdr erc-nicks-contrast-ratio))) + (let ((erc-nicks--bg-luminance 1.0) + (erc-nicks--bg-mode-value 'light) + (show (lambda (c) (erc-nicks-tests--print-contrast + #'erc-nicks-cap-contrast c)))) + + (with-current-buffer (get-buffer-create "*erc-nicks-remove-contrast*") + (should (equal (funcall show "black") "#34e534e534e5" )) ; 21.0 -> 12.14 + (should ; 12.32 -> 12.32 (same) + (equal (funcall show "#34e534e534e5") "#34e534e534e5")) + (should (equal (funcall show "white") "#ffffffffffff")) + + (unless noninteractive + (should (equal (funcall show "DarkRed") "#8b8b00000000")) + (should (equal (funcall show "DarkGreen") "#000064640000")) + ;; 15.29 -> 12.38 + (should (equal (funcall show "DarkBlue") "#1cf11cf198b5")) + + ;; 12.50 -> 12.22 + (should (equal (funcall show "#33e033e033e0") "#34ab34ab34ab")) + ;; 12.57 -> 12.28 + (should (equal (funcall show "#338033803380") "#344c344c344c")) + ;; 12.67 -> 12.37 + (should (equal (funcall show "#330033003300") "#33cc33cc33cc"))) (when noninteractive (kill-buffer))))) @@ -118,22 +148,26 @@ erc-nicks-add-contrast (ert-deftest erc-nicks--hash () (with-current-buffer (get-buffer-create "*erc-nicks--hash*") - ;; Similar nicks yielding similar colors is likely undesirable. - (should (= (erc-nicks--hash "00000000") #xe4deaa6df385)) - (should (= (erc-nicks--hash "00000001") #xe4deaa6df386)) - (erc-nicks-tests--show-contrast "#e4deaa6df385") - (erc-nicks-tests--show-contrast "#e4deaa6df386") - - ;; So we currently pad from the right to avoid this. - (should (= (erc-nicks--hash "0Libera.Chat") #x32fdc0d63a92)) - (should (= (erc-nicks--hash "1Libera.Chat") #xc2c4f1c997f3)) - (erc-nicks-tests--show-contrast "#32fdc0d63a92") - (erc-nicks-tests--show-contrast "#c2c4f1c997f3") - - (should (= (erc-nicks--hash "0 OFTC") #x6805b7521261)) - (should (= (erc-nicks--hash "1 OFTC") #xf7cce8456fc2)) - (erc-nicks-tests--show-contrast "#6805b7521261") - (erc-nicks-tests--show-contrast "#f7cce8456fc2") + ;; Here, we're just using `erc-nicks-tests--show-contrast' for show. + (let ((show (lambda (c) (erc-nicks-tests--print-contrast #'identity c)))) + + ;; Similar nicks yielding similar colors is likely undesirable. + (should (= (erc-nicks--hash "00000000") #xe4deaa6df385)) + (should (= (erc-nicks--hash "00000001") #xe4deaa6df386)) + (funcall show "#e4deaa6df385") + (funcall show "#e4deaa6df386") + + ;; So we currently pad from the right to avoid this. + (should (= (erc-nicks--hash "0Libera.Chat") #x32fdc0d63a92)) + (should (= (erc-nicks--hash "1Libera.Chat") #xc2c4f1c997f3)) + (funcall show "#32fdc0d63a92") + (funcall show "#c2c4f1c997f3") + + (should (= (erc-nicks--hash "0 OFTC") #x6805b7521261)) + (should (= (erc-nicks--hash "1 OFTC") #xf7cce8456fc2)) + (funcall show "#6805b7521261") + (funcall show "#f7cce8456fc2")) + (when noninteractive (kill-buffer)))) -- 2.40.0 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-5.6-Add-module-for-colorizing-nicknames-to-ERC.patch Content-Transfer-Encoding: quoted-printable >From 8e16d161b6e9f3c67b4ccbe9e44fc73c43bb70f5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 18 Dec 2022 19:01:40 -0800 Subject: [PATCH 1/1] [5.6] Add module for colorizing nicknames to ERC * doc/misc/erc.texi: Add `nicks' to module lineup. * etc/ERC-NEWS: Mention new module `nicks'. * lisp/erc/erc-button.el (erc--nick-popup-alist, erc-nick-popup): New variable to help the latter access special actions owned by modules. * lisp/erc/erc-nicks.el: New file. * lisp/erc/erc.el: (erc-modules): Add `nicks'. * test/lisp/erc/erc-nicks-tests.el: New file. * test/lisp/erc/erc-tests (erc-tests--modules): Add `nicks'. (Bug#63569) --- doc/misc/erc.texi | 4 + etc/ERC-NEWS | 8 + lisp/erc/erc-button.el | 12 +- lisp/erc/erc-nicks.el | 389 +++++++++++++++++++++++++++++++ lisp/erc/erc.el | 1 + test/lisp/erc/erc-nicks-tests.el | 174 ++++++++++++++ test/lisp/erc/erc-tests.el | 2 +- 7 files changed, 586 insertions(+), 4 deletions(-) create mode 100644 lisp/erc/erc-nicks.el create mode 100644 test/lisp/erc/erc-nicks-tests.el diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 1f343fc8529..f7036e57638 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -459,6 +459,10 @@ Modules @item netsplit Detect netsplits =20 +@cindex modules, nicks +@item nicks +Automatically colorize nicks + @cindex modules, noncommands @item noncommands Don't display non-IRC commands after evaluation diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index d257bdcbf51..2d3626e28b8 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -30,6 +30,14 @@ helper called 'erc-fill-wrap-nudge' allows for dynamic "= refilling" of buffers on the fly. Set 'erc-fill-function' to 'erc-fill-wrap' to get started. =20 +** A new module for nickname highlighting has joined ERC. +Automatic nickname coloring has come to ERC core. Users familiar with +the excellent 'erc-hl-nicks' by David Leatherman, from which this new +addition draws heavily, will already be familiar with its suite of +handy options. By default, each nickname in an ERC session receives a +unique face with a unique (or evenly dealt) foreground color. Add +'nicks' to 'erc-modules' to get started. + ** A unified interactive entry point. New users are often dismayed to discover that M-x ERC doesn't connect to its default network, Libera.Chat, over TLS. Though perhaps a diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 4307dc3b860..b370fa4bf95 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -685,15 +685,21 @@ erc-nick-popup-alist :type '(repeat (cons (string :tag "Op") sexp))) =20 +(defvar-local erc--nick-popup-alist nil + "Internally controlled items for `erc-nick-popup-alist'.") + (defun erc-nick-popup (nick) (let* ((completion-ignore-case t) + (alist (append erc-nick-popup-alist erc--nick-popup-alist)) (action (completing-read (format-message "What action to take on `%s'? " nick) - erc-nick-popup-alist)) - (code (cdr (assoc action erc-nick-popup-alist)))) + alist)) + (code (cdr (assoc action alist)))) (when code (erc-set-active-buffer (current-buffer)) - (eval code `((nick . ,nick)))))) + (if (functionp code) + (funcall code nick) + (eval code `((nick . ,nick))))))) =20 ;;; Callback functions (defun erc-button-describe-symbol (symbol-name) diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el new file mode 100644 index 00000000000..85d182f9a09 --- /dev/null +++ b/lisp/erc/erc-nicks.el @@ -0,0 +1,389 @@ +;;; erc-nicks.el -- Nick colors for ERC -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This module is heavily influenced by the lovely and more featureful +;; +;; `erc-hl-nicks' by David Leatherman +;; +;; +;; which itself is based on +;; +;; `erc-highlight-nicknames' by Andr=C3=A9 Riemann, Andy Stewart, and +;; others +;; + +;;; Code: + +(require 'erc-button) +(require 'color) + +(defgroup erc-nicks nil + "Colorize nicknames in ERC buffers." + :package-version '(ERC . "5.6") ; FIXME sync on release + :group 'erc) + +(defcustom erc-nicks-ignore-chars-regexp + (cons (rx bot (+ (any ",`'_-"))) (rx (+ (any ",`'_-")) eot)) + "Characters surrounding a nick to ignore while highlighting. +Regexps should be suitable for `string-trim'." + :type '(choice (cons regexp regexp) (const nil))) + +(defcustom erc-nicks-skip-nicks nil + "Nicks to not highlight." + :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) + "Faces to avoid highlighting atop." + :type '(repeat symbol)) + +(defcustom erc-nicks-nickname-face erc-button-nickname-face + "Face to mix with generated one for emphasizing non-speakers." + :type '(choice face (const nil))) + +(defcustom erc-nicks-bg-color + (frame-parameter (selected-frame) 'background-color) + "Background color for calculating contrast. +Set this explicitly when the background color isn't discoverable, +which may be the case in terminal Emacs." + :type 'string) + +(defcustom erc-nicks-color-contrast-strategy + '(erc-nicks-add-contrast erc-nicks-cap-contrast) + "Treatments applied to colors for increasing visibility. +A value of `erc-nicks-invert' inverts a nick when it's too close +to the background. A value of `erc-nicks-add-contrast' +attempts to find a decent contrast ratio by brightening or +darkening. This option can also be a list, in which case, +members will be applied in the order they appear. For example, + + \\=3D'(erc-nicks-invert erc-nicks-add-contrast) + +will invert as needed and likewise adjust the contrast. Note +that anything specified by this option will still be applied when +`erc-nicks-colors' is a user-defined list of colors." + :type '(choice (function-item :tag "Invert" erc-nicks-invert) + (function-item :tag "Add contrast" erc-nicks-add-contrast) + (function-item :tag "Cap contrast" erc-nicks-cap-contrast) + (repeat function) + (const nil) + function)) + +(defcustom erc-nicks-contrast-ratio '(3.5 . 12.5) + "Desired range of contrast as a cons of (MIN . MAX). +For this to matter, `erc-nicks-color-contrast-strategy' must be +set to `erc-nicks-add-contrast' or `erc-nicks-cap-contrast' or +contain at least one if that option is a list. If adding +contrast, MIN specifies the minimum amount allowed between a +buffer's background color and the foreground colors specified by +`erc-nicks-colors'. The closer the number to the possible +maximum of 21(:1), the greater the contrast. Depending on the +background, nicks are either tinted in pastel or muted with dark +gray. MAX works similarly for reducing contrast." + :type '(cons float float)) + +(defcustom erc-nicks-colors 'all + "Pool of colors. +This can be a list of hexes or color names, such as those +provided by `defined-colors', which can itself be used when the +value is the symbol `defined'. With `all', use any 24-bit color." + :type '(choice (const all) (const defined) (list string))) + +(defvar-local erc-nicks--face-table nil + "Hash table containing unique nick faces.") + +;; https://stackoverflow.com/questions/596216#answer-56678483 +(defun erc-nicks--get-luminance (color) + "Return relative luminance of COLOR. +COLOR can be a list of normalized values or a name." + (let ((out 0) + (coefficients '(0.2126 0.7152 0.0722)) + (chnls (if (stringp color) (color-name-to-rgb color) color))) + (dolist (ch chnls out) + (cl-incf out (* (pop coefficients) + (if (<=3D ch 0.04045) + (/ ch 12.92) + (expt (/ (+ ch 0.055) 1.055) 2.4))))))) + +(defvar-local erc-nicks--bg-mode-value nil) + +(defmacro erc-nicks--bg-mode () + `(or erc-nicks--bg-mode-value + (setq erc-nicks--bg-mode-value + ,(cond ((fboundp 'frame--current-background-mode) + '(frame--current-background-mode (selected-frame))) + ((fboundp 'frame--current-backround-mode) + '(frame--current-backround-mode (selected-frame))) + (t + '(frame-parameter (selected-frame) 'background-mode))= )))) + +(defvar erc-nicks--grad-steps 9) +(defvar-local erc-nicks--bg-luminance nil) + +;; https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contra= st.html +;; +;; We could cache results, which may help when `erc-nicks-colors' is +;; set to `defined'. + +(defun erc-nicks--adjust-contrast (color target &optional decrease) + (let* ((lum-bg (or erc-nicks--bg-luminance + (setq erc-nicks--bg-luminance + (erc-nicks--get-luminance erc-nicks-bg-color)))) + (stop (if (eq (if decrease 'light 'dark) (erc-nicks--bg-mode)) + '(1.0 1.0 1.0) + '(0.0 0.0 0.0))) + (start (color-name-to-rgb color)) + ;; From `color-gradient' in color.el + (r (nth 0 start)) + (g (nth 1 start)) + (b (nth 2 start)) + (interval (float (1+ (expt 2 erc-nicks--grad-steps)))) + (r-step (/ (- (nth 0 stop) r) interval)) + (g-step (/ (- (nth 1 stop) g) interval)) + (b-step (/ (- (nth 2 stop) b) interval)) + (maxtries erc-nicks--grad-steps) + started) + (while (let* ((lum-fg (erc-nicks--get-luminance (list r g b))) + (darker (if (< lum-bg lum-fg) lum-bg lum-fg)) + (lighter (if (=3D darker lum-bg) lum-fg lum-bg)) + (cur (/ (+ 0.05 lighter) (+ 0.05 darker))) + (scale (expt 2 maxtries))) + (cond ((if decrease (> cur target) (< cur target)) + (setq r (+ r (* r-step scale)) + g (+ g (* g-step scale)) + b (+ b (* b-step scale)))) + (started + (setq r (- r (* r-step scale)) + g (- g (* g-step scale)) + b (- b (* b-step scale)))) + (t (setq maxtries 1))) + (unless started + (setq started t)) + (setq r (min 1.0 (max 0 r)) + g (min 1.0 (max 0 g)) + b (min 1.0 (max 0 b))) + (not (zerop (cl-decf maxtries))))) + (color-rgb-to-hex r g b))) + +(defun erc-nicks-add-contrast (color) + "Increase COLOR's contrast by blending it with white or black. +Unless sufficient contrast exists between COLOR and the +background, raise it to somewhere around the lower bound of +`erc-nicks-contrast-ratio'." + (erc-nicks--adjust-contrast color (car erc-nicks-contrast-ratio))) + +(defun erc-nicks-cap-contrast (color) + "Reduce COLOR's contrast by blending it with white or black. +If excessive contrast exists between COLOR and the background, +lower it to the upper bound of `erc-nicks-contrast-ratio'." + (erc-nicks--adjust-contrast color (cdr erc-nicks-contrast-ratio) 'remove= )) + +;; Inversion thresholds for dark and light, respectively. +(defvar erc-nicks--min-lum (/ 1 3.0)) +(defvar erc-nicks--max-lum (/ 2 3.0)) + +(defun erc-nicks-invert (color) + "Invert COLOR based on luminance and background." + (if (pcase (erc-nicks--bg-mode) + ('dark (< (erc-nicks--get-luminance color) erc-nicks--min-lum)) + ('light (> (erc-nicks--get-luminance color) erc-nicks--max-lum))) + (pcase-let ((`(,r ,g ,b) (color-values color))) + (format "#%04x%04x%04x" (- 65535 r) (- 65535 g) (- 65535 b))) + color)) + +;; http://www.cse.yorku.ca/~oz/hash.html +;; See also gui_nick_hash_djb2_64 in weechat/src/gui/gui-nick.c, +;; which is originally from https://savannah.nongnu.org/patch/?8062. +;; +;; Short strings of the same length and those differing only in their +;; low order bits tend to land in neighboring buckets, which are often +;; similar in color. Padding on the right with at least nine added +;; chars seems to scramble things sufficiently enough for our needs. + +(defun erc-nicks--hash (s &optional nchoices) + (let ((h 5381) ; seed and multiplier (33) hardcoded for now + (p (or nchoices 281474976710656)) ; 48-bits (expt 2 48) + (i 0) + (n (length s))) + (while (< (setq h (% (+ (* h 33) (aref s i)) p) + i (1+ i)) + n)) + h)) + +(defvar-local erc-nicks--colors-len nil) +(defvar-local erc-nicks--custom-keywords '(:group erc-nicks :group erc-fac= es)) + +(defun erc-nicks--revive (new-face old-face nick net) + (put new-face 'erc-nicks--custom-nick (cons nick net)) + (apply #'custom-declare-face new-face (face-user-default-spec old-face) + (format "Persistent `erc-nicks' color for %s on %s." nick net) + erc-nicks--custom-keywords)) + +(defun erc-nicks--create-defface-template (face) + (pop-to-buffer (get-buffer-create (format "*New face %s*" face))) + (erase-buffer) + (lisp-interaction-mode) + (insert ";; If you *don't* use Customize, put something like this in you= r\n" + (substitute-command-keys + ";; init.el and use \\[eval-last-sexp] to apply any edits.\n\n") + (format "(defface %s\n '%S\n %S" + face (face-user-default-spec face) (face-documentation f= ace)) + (cl-loop for (k v) on erc-nicks--custom-keywords by #'cddr + concat (format "\n %s %S" k (list 'quote v))) + ")\n\n;; Or, if you use use-package\n(use-package erc-nicks\n" + " :custom-face\n" + (format " (%s %S)" face (face-user-default-spec face)) + ")\n")) + +(defun erc-nicks--redirect-face-widget-link (args) + (pcase args + (`(,widget face-link . ,plist) + (when-let* ((face (widget-value widget)) + ((get face 'erc-nicks--custom-nick))) + (unless (symbol-file face) + (setf (plist-get plist :action) + (lambda (&rest _) (erc-nicks--create-defface-template face)= ))) + (setf (plist-get plist :help-echo) "Create or edit `defface'." + (cddr args) plist)))) + args) + +(defun erc-nicks--get-face (nick key) + "Retrieve or create a face for NICK, stored locally under KEY. +But favor a custom erc-nicks-NICK@NETWORK-face, when defined." + (setq nick (erc-downcase nick)) + (let ((table (buffer-local-value 'erc-nicks--face-table + (erc-server-buffer)))) + (or (gethash nick table) + (and-let* ((face (intern-soft (concat "erc-nicks-" nick "@" + (erc-network-name) "-face"))) + ((or (and (facep face) face) + (erc-nicks--revive face face nick (erc-network))))= )) + (let ((color (seq-reduce + (lambda (color strategy) (funcall strategy color)) + (erc-list erc-nicks-color-contrast-strategy) + (pcase erc-nicks-colors + ('all (format "#%012x" (erc-nicks--hash key))) + ((or 'defined v) + (unless v (setq v (defined-colors (selected-frame= )))) + (unless erc-nicks--colors-len + (setq erc-nicks--colors-len (length v))) + (nth (erc-nicks--hash key erc-nicks--colors-len) + v))))) + (new-face (make-symbol (concat "erc-nicks-" nick "-face")))) + (face-spec-set new-face `((t :foreground ,color)) 'face-defface-= spec) + (set-face-documentation + new-face (format "Internal face for %s on %s." nick (erc-networ= k))) + (puthash nick new-face table))))) + +(defvar erc-nicks--phony-face nil + "Face to pretend is propertizing the nick at point. +Modules needing to colorize nicks outside of a buttonizing +context can use this instead of setting fictitious bounds on the +`erc-button--nick' object passed to `erc-nicks--highlight'.") + +(defun erc-nicks--highlight (nick-object) + "Possibly highlight a single nick." + (when-let* + ((nick-object) + (server-user (erc-button--nick-user nick-object)) + (trimmed (if erc-nicks-ignore-chars-regexp + (string-trim (erc-server-user-nickname server-user) + (car erc-nicks-ignore-chars-regexp) + (cdr erc-nicks-ignore-chars-regexp)) + (erc-server-user-nickname server-user))) + ((not (member trimmed erc-nicks-skip-nicks))) + (face (or erc-nicks--phony-face + (get-text-property (car (erc-button--nick-bounds nick-obj= ect)) + 'font-lock-face))) + ((not (seq-some (lambda (f) (memq f erc-nicks-skip-faces)) + (erc-list face)))) ; cl-notany + ;; Ensure nicks are colored uniquely (per network) by padding + ;; from the right, as mentioned above in `erc-nicks--hash'. + (key (concat (erc-button--nick-downcased nick-object) + (and-let* ((net (erc-network))) (format "%9s" net)))) + (out (erc-nicks--get-face trimmed key))) + ;; `font-lock-prepend-text-property' could also work if preserving + ;; history isn't needed (in which case this var should be nil). + (setf (erc-button--nick-erc-button-nickname-face nick-object) + (if (or (not erc-nicks-nickname-face) + (eq face erc-nicks-nickname-face)) + out + (cons out (erc-list erc-nicks-nickname-face))))) + nick-object) + +(define-erc-module nicks nil + "Uniquely colorize nicknames in target buffers." + ((if erc--target + (progn + (add-function :filter-return (local 'erc-button--modify-nick-func= tion) + #'erc-nicks--highlight '((depth . 80))) + (erc-button--phantom-users-mode +1)) + (unless erc-button-mode + (unless (memq 'button erc-modules) + (erc--warn-once-before-connect 'erc-nicks-mode + "Enabling default global module `button' needed by local" + " module `nicks'. This will impact \C-]all\C-] ERC" + " sessions. Add `nicks' to `erc-modules' to avoid this" + " warning. See Info:\"(erc) Modules\" for more.")) + (erc-button-mode +1)) + (when (equal erc-nicks-bg-color "unspecified-bg") + (let ((temp (if (eq (erc-nicks--bg-mode) 'light) "white" "black"))) + (erc-button--display-error-notice-with-keys + "Module `nicks' unable to determine background color. Setting t= o \"" + temp "\" globally. Please see `erc-nicks-bg-color'.") + (custom-set-variables (list 'erc-nicks-bg-color temp)))) + (setq erc-nicks--face-table (make-hash-table :test #'equal))) + (setf (alist-get "Edit face" erc--nick-popup-alist nil nil #'equal) + #'erc-nicks-customize-face) + (advice-add 'widget-create-child-and-convert :filter-args + #'erc-nicks--redirect-face-widget-link)) + ((kill-local-variable 'erc-nicks--face-table) + (kill-local-variable 'erc-nicks--bg-mode-value) + (kill-local-variable 'erc-nicks--bg-luminance) + (kill-local-variable 'erc-nicks--colors-len) + (when (fboundp 'erc-button--phantom-users-mode) + (erc-button--phantom-users-mode -1)) + (remove-function (local 'erc-button--modify-nick-function) + #'erc-nicks--highlight) + (setf (alist-get "Edit face" erc--nick-popup-alist nil 'remove #'equal) + nil)) + 'local) + +(defun erc-nicks-customize-face (nick) + "Customize or create persistent face for NICK." + (interactive (list (or (car (get-text-property (point) 'erc-data)) + (completing-read "nick: " (or erc-channel-users + erc-server-users)))= )) + (setq nick (erc-downcase (substring-no-properties nick))) + (let* ((net (erc-network)) + (key (concat nick (and net (format "%9s" net)))) + (old-face (erc-nicks--get-face nick key)) + (new-face (intern (format "erc-nicks-%s@%s-face" nick net)))) + (unless (eq new-face old-face) + (erc-nicks--revive new-face old-face nick net) + (set-face-attribute old-face nil :foreground 'unspecified) + (set-face-attribute old-face nil :inherit new-face)) + (customize-face new-face))) + +(provide 'erc-nicks) + +;;; erc-nicks.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 495e25212ce..5a3b312b53b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2026,6 +2026,7 @@ erc-modules move-to-prompt) (const :tag "netsplit: Detect netsplits" netsplit) (const :tag "networks: Provide data about IRC networks" networks) + (const :tag "nicks: Uniquely colorize nicknames in target buffers" nic= ks) (const :tag "noncommands: Don't display non-IRC commands after evaluat= ion" noncommands) (const :tag "notifications: Desktop alerts on PRIVMSG or mentions" diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tes= ts.el new file mode 100644 index 00000000000..e0a5691b073 --- /dev/null +++ b/test/lisp/erc/erc-nicks-tests.el @@ -0,0 +1,174 @@ +;;; erc-nicks-tests.el --- Tests for erc-nicks -*- lexical-binding:t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; TODO: +;; +;; * Add mock session (or scenario) with buffer snapshots, like those +;; in erc-fill-tests.el. (Should probably move helpers to a common +;; library under ./resources.) + +;;; Code: + +(require 'ert) +(require 'erc-nicks) + +(ert-deftest erc-nicks--get-luminance () + (should (eql 0.0 (erc-nicks--get-luminance "black"))) + (should (eql 1.0 (erc-nicks--get-luminance "white"))) + (should (eql 21.0 (/ (+ 0.05 1.0) (+ 0.05 0.0)))) + + ;; RGB floats from a `display-graphic-p' session. + (let ((a (erc-nicks--get-luminance ; #9439ad + '(0.5803921568627451 0.2235294117647059 0.6784313725490196))) + (b (erc-nicks--get-luminance ; #ae54c7 + '(0.6823529411764706 0.32941176470588235 0.7803921568627451))) + (c (erc-nicks--get-luminance ; #d19ddf + '(0.8196078431372549 0.615686274509804 0.8745098039215686))) + (d (erc-nicks--get-luminance ; #f5e8f8 + '(0.9607843137254902 0.9098039215686274 0.9725490196078431)))) + ;; Low, med, high contrast comparisons against known values from + ;; an external source. + (should (eql 1.42 (/ (round (* 100 (/ (+ 0.05 b) (+ 0.05 a)))) 100.0))) + (should (eql 2.78 (/ (round (* 100 (/ (+ 0.05 c) (+ 0.05 a)))) 100.0))) + (should (eql 5.16 (/ (round (* 100 (/ (+ 0.05 d) (+ 0.05 a)))) 100.0))= ))) + +(ert-deftest erc-nicks-invert () + (let ((erc-nicks--bg-mode-value 'dark)) + (should (equal (erc-nicks-invert "white") "white")) + (should (equal (erc-nicks-invert "black") "#ffffffffffff")) + (should (equal (erc-nicks-invert "green") "green"))) + (let ((erc-nicks--bg-mode-value 'light)) + (should (equal (erc-nicks-invert "white") "#000000000000")) + (should (equal (erc-nicks-invert "black") "black")) + (should (equal (erc-nicks-invert "green") "#ffff0000ffff")))) + +(defun erc-nicks-tests--print-contrast (fn color) + (let ((result (funcall fn color)) + (fg (if (eq 'dark erc-nicks--bg-mode-value) "white" "black")) + (start (point))) + (insert (format "%16s%-16s%16s%-16s\n" + (concat color "-") + (concat ">" result) + (concat color " ") + (concat " " result))) + (put-text-property start (+ start 32) 'face + (list :foreground fg)) + (put-text-property (+ start 32) (+ start 48) 'face + (list :background color :foreground result)) + (put-text-property (+ start 48) (+ start 64) 'face + (list :background result :foreground color)) + result)) + +(ert-deftest erc-nicks-add-contrast () + (let ((erc-nicks--bg-luminance 1.0) + (erc-nicks--bg-mode-value 'light) + (show (lambda (c) (erc-nicks-tests--print-contrast + #'erc-nicks-add-contrast c)))) + + (with-current-buffer (get-buffer-create "*erc-nicks-add-contrast*") + (should (equal "#893a893a893a" (funcall show "white"))) + (should (equal "#893a893a893a" (funcall show "#893a893a893a"))) + (should (equal "#000000000000" (funcall show "black"))) + (should (equal "#ffff00000000" (funcall show "red"))) + (should (equal "#0000a12e0000" (funcall show "green"))) + (should (equal "#00000000ffff" (funcall show "blue"))) + + ;; When the input is already near the desired ratio, the result + ;; may not be in bounds, only close. But the difference is + ;; usually imperceptible. + (unless noninteractive + ;; Well inside (light slate gray) + (should (equal "#777788889999" (funcall show "#777788889999"))) + ;; Slightly outside -> just outside + (should (equal "#7c498bd39b5c" (funcall show "#88889999aaaa"))) + ;; Just outside -> just inside + (should (equal "#7bcc8b479ac0" (funcall show "#7c498bd39b5c"))) + ;; Just inside + (should (equal "#7bcc8b479ac0" (funcall show "#7bcc8b479ac0")))) + + (when noninteractive + (kill-buffer))))) + +(ert-deftest erc-nicks-cap-contrast () + (should (=3D 12.5 (cdr erc-nicks-contrast-ratio))) + (let ((erc-nicks--bg-luminance 1.0) + (erc-nicks--bg-mode-value 'light) + (show (lambda (c) (erc-nicks-tests--print-contrast + #'erc-nicks-cap-contrast c)))) + + (with-current-buffer (get-buffer-create "*erc-nicks-remove-contrast*") + (should (equal (funcall show "black") "#34e534e534e5" )) ; 21.0 -> 1= 2.14 + (should ; 12.32 -> 12.32 (same) + (equal (funcall show "#34e534e534e5") "#34e534e534e5")) + (should (equal (funcall show "white") "#ffffffffffff")) + + (unless noninteractive + (should (equal (funcall show "DarkRed") "#8b8b00000000")) + (should (equal (funcall show "DarkGreen") "#000064640000")) + ;; 15.29 -> 12.38 + (should (equal (funcall show "DarkBlue") "#1cf11cf198b5")) + + ;; 12.50 -> 12.22 + (should (equal (funcall show "#33e033e033e0") "#34ab34ab34ab")) + ;; 12.57 -> 12.28 + (should (equal (funcall show "#338033803380") "#344c344c344c")) + ;; 12.67 -> 12.37 + (should (equal (funcall show "#330033003300") "#33cc33cc33cc"))) + + (when noninteractive + (kill-buffer))))) + +;; Here is an example of how filters can steer us wrong (don't always +;; DTRT). Two keys with similar names hash to very different values: +;; +;; 1) "awbLibera.Chat" -> #x1e3b5ca4edbc ; deep blue +;; 2) "twbLibera.Chat" -> #xdeb4c26934af ; yellow/orange +;; +;; But on a dark bg, (1) falls below `erc-nicks-invert's min threshold +;; and thus gets treated, becoming #xe1c4a35b1243, which is quite +;; close to and thus easily confused with (2). + +(ert-deftest erc-nicks--hash () + (with-current-buffer (get-buffer-create "*erc-nicks--hash*") + ;; Here, we're just using `erc-nicks-tests--show-contrast' for show. + (let ((show (lambda (c) (erc-nicks-tests--print-contrast #'identity c)= ))) + + ;; Similar nicks yielding similar colors is likely undesirable. + (should (=3D (erc-nicks--hash "00000000") #xe4deaa6df385)) + (should (=3D (erc-nicks--hash "00000001") #xe4deaa6df386)) + (funcall show "#e4deaa6df385") + (funcall show "#e4deaa6df386") + + ;; So we currently pad from the right to avoid this. + (should (=3D (erc-nicks--hash "0Libera.Chat") #x32fdc0d63a92)) + (should (=3D (erc-nicks--hash "1Libera.Chat") #xc2c4f1c997f3)) + (funcall show "#32fdc0d63a92") + (funcall show "#c2c4f1c997f3") + + (should (=3D (erc-nicks--hash "0 OFTC") #x6805b7521261)) + (should (=3D (erc-nicks--hash "1 OFTC") #xf7cce8456fc2)) + (funcall show "#6805b7521261") + (funcall show "#f7cce8456fc2")) + + (when noninteractive + (kill-buffer)))) + +;;; erc-nicks-tests.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b624186d88d..991bfa3b082 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1953,7 +1953,7 @@ erc-handle-irc-url (defconst erc-tests--modules '( autoaway autojoin button capab-identify completion dcc fill identd imenu irccontrols keep-place list log match menu move-to-prompt netsp= lit - networks noncommands notifications notify page readonly + networks nicks noncommands notifications notify page readonly replace ring sasl scrolltobottom services smiley sound spelling stamp track truncate unmorse xdcc)) =20 --=20 2.40.0 --=-=-=--