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