bug#41544: 26.3; Possible incorrect results from color-distance

["Mattias Engdegård" <mattiase@acm.org>]

[-- Attachment #1: Type: text/plain, Size: 686 bytes --]

6 juni 2020 kl. 15.57 skrev Eli Zaretskii <eliz@gnu.org>:

>> can you come up with a concrete and realistic example of what you think will break?
> 
> None at this time.

That's high praise!

> I think a Lisp program that interprets the documentation too
> literally is making a mistake

I must remember that, a most useful answer!

> , but I'm not opposed to make that
> clearer in the docs.

No, I really don't think we should document the bug.

Since we are making little progress, let's leave color-name-to-rgb unchanged for the moment. We can both change our minds later. It's not strictly required for the introduction and use of color-dark-p; patch updated.


[-- Attachment #2: 0001-Use-a-single-light-dark-colour-predicate.patch --]
[-- Type: application/octet-stream, Size: 10474 bytes --]

From f7693e7a2e6cc65ad40d42c9854539ed85466bae Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Sun, 31 May 2020 21:12:46 +0200
Subject: [PATCH] Use a single light/dark colour predicate

Add a single predicate, color-dark-p, for deciding whether a colour
is more readable against black or white.  Previously this was done in
different ways in several places, and with worse results.  (Bug#41544)

* lisp/facemenu.el (list-colors-print): Use readable-foreground-color.
(color-dark-p): New function.
* lisp/term/pc-win.el: Update comment.
* lisp/term/rxvt.el (rxvt-set-background-mode):
* lisp/term/w32console.el (terminal-init-w32console):
* lisp/term/xterm.el (xterm-maybe-set-dark-background-mode):
* lisp/faces.el (readable-foreground-color):
* lisp/frame.el (frame-set-background-mode): Use color-dark-p.
* lisp/textmodes/css-mode.el (css--contrasty-color): Remove.
(css--fontify-region): Use color-dark-p.
---
 lisp/facemenu.el           | 11 +++++------
 lisp/faces.el              | 27 ++++++++++++++++++---------
 lisp/frame.el              | 17 ++++++++++-------
 lisp/term/pc-win.el        |  8 +++-----
 lisp/term/rxvt.el          | 12 +++++-------
 lisp/term/w32console.el    |  6 +++---
 lisp/term/xterm.el         |  5 ++---
 lisp/textmodes/css-mode.el | 14 ++------------
 8 files changed, 48 insertions(+), 52 deletions(-)

diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index b10d874b21..419b76101b 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -621,12 +621,11 @@ list-colors-print
 						 (downcase b))))))
 	(setq color (list color)))
       (let* ((opoint (point))
-	     (color-values (color-values (car color)))
-	     (light-p (>= (apply 'max color-values)
-			  (* (car (color-values "white")) .5))))
+             (fg (readable-foreground-color (car color))))
 	(insert (car color))
 	(indent-to 22)
-	(put-text-property opoint (point) 'face `(:background ,(car color)))
+	(put-text-property opoint (point) 'face `(:background ,(car color)
+                                                  :foreground ,fg))
 	(put-text-property
 	 (prog1 (point)
 	   (insert " ")
@@ -639,7 +638,7 @@ list-colors-print
 	(insert (propertize
 		 (apply 'format "#%02x%02x%02x"
 			(mapcar (lambda (c) (ash c -8))
-				color-values))
+				(color-values (car color))))
 		 'mouse-face 'highlight
 		 'help-echo
 		 (let ((hsv (apply 'color-rgb-to-hsv
@@ -651,7 +650,7 @@ list-colors-print
 	   opoint (point)
 	   'follow-link t
 	   'mouse-face (list :background (car color)
-			     :foreground (if light-p "black" "white"))
+			     :foreground fg)
 	   'color-name (car color)
 	   'action callback-fn)))
       (insert "\n"))
diff --git a/lisp/faces.el b/lisp/faces.el
index e707f6f4b6..caa72fbfff 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1786,15 +1786,24 @@ defined-colors-with-face-attributes
 
 (defun readable-foreground-color (color)
   "Return a readable foreground color for background COLOR."
-  (let* ((rgb   (color-values color))
-	 (max   (apply #'max rgb))
-	 (black (car (color-values "black")))
-	 (white (car (color-values "white"))))
-    ;; Select black or white depending on which one is less similar to
-    ;; the brightest component.
-    (if (> (abs (- max black)) (abs (- max white)))
-	"black"
-      "white")))
+  (if (color-dark-p (color-name-to-rgb color)) "white" "black"))
+
+(defun color-dark-p (rgb)
+  "Whether RGB is more readable against white than black.
+RGB is a 3-element list (R G B), each component in the range [0,1]."
+  (let* ((sr (nth 0 rgb))
+         (sg (nth 1 rgb))
+         (sb (nth 2 rgb))
+         ;; Use the power 2.2 as an approximation to sRGB gamma;
+         ;; it should be good enough for the purpose of this function.
+         (r (expt sr 2.2))
+         (g (expt sg 2.2))
+         (b (expt sb 2.2)))
+    (unless (<= 0 (min r g b) (max r g b) 1)
+      (error "RGB components %S not in [0,1]" rgb))
+    ;; The cut-off value was determined experimentally; see bug#41544.
+    (< (+ (* r 0.299) (* g 0.587) (* b 0.114))
+       (eval-when-compile (expt 0.6 2.2)))))
 
 (declare-function xw-color-defined-p "xfns.c" (color &optional frame))
 
diff --git a/lisp/frame.el b/lisp/frame.el
index 6c2f774709..253528da75 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1156,6 +1156,13 @@ frame-background-mode
 
 (defvar inhibit-frame-set-background-mode nil)
 
+(defun frame--color-name-to-rgb (color frame)
+  "Convert the COLOR string to a list of normalised RGB components.
+Like `color-name-to-rgb', but works even when the display has not yet
+been initialised."
+  (let ((valmax (if (eq (framep-on-display frame) 'ns) 65280.0 65535.0)))
+    (mapcar (lambda (x) (/ x valmax)) (color-values color frame))))
+
 (defun frame-set-background-mode (frame &optional keep-face-specs)
   "Set up display-dependent faces on FRAME.
 Display-dependent faces are those which have different definitions
@@ -1181,13 +1188,9 @@ frame-set-background-mode
 		   non-default-bg-mode)
 		  ((not (color-values bg-color frame))
 		   default-bg-mode)
-		  ((>= (apply '+ (color-values bg-color frame))
-		       ;; Just looking at the screen, colors whose
-		       ;; values add up to .6 of the white total
-		       ;; still look dark to me.
-		       (* (apply '+ (color-values "white" frame)) .6))
-		   'light)
-		  (t 'dark)))
+                  ((color-dark-p (frame--color-name-to-rgb bg-color frame))
+                   'dark)
+                  (t 'light)))
 	   (display-type
 	    (cond ((null (window-system frame))
 		   (if (tty-display-color-p frame) 'color 'mono))
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 76a48a86c7..16eb660f00 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -54,11 +54,9 @@
 ;; DJGPP-compiled Emacs on the same PC.  The names of X colors used to
 ;; define the pixel values are shown as comments to each color below.
 ;;;
-;; If you want to change the RGB values, keep in mind that various pieces
-;; of Emacs think that a color whose RGB values add up to less than 0.6 of
-;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the
-;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for
-;; an example.
+;; If you want to change the RGB values, consider the heuristics in
+;; `color-dark-p' which is used to select a suitably contrasting
+;; foreground or background colour.
 (defvar msdos-color-values
   '(("black"          0     0     0     0)
     ("blue"           1     0     0 52480) ; MediumBlue
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index 31e3d6ede4..5dc754c8e0 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -206,13 +206,11 @@ rxvt-set-background-mode
       ;; The next line assumes that rxvt-standard-colors are ordered
       ;; by the color index in the ascending order!
       (setq rgb (car (cddr (nth bg rxvt-standard-colors))))
-      ;; See the commentary in frame-set-background-mode about the
-      ;; computation below.
-      (if (< (apply '+ rgb)
-	     ;; The following line assumes that white is the 15th
-	     ;; color in rxvt-standard-colors.
-	     (* (apply '+ (car (cddr (nth 15 rxvt-standard-colors)))) 0.6))
-	  (set-terminal-parameter nil 'background-mode 'dark)))))
+      ;; The following line assumes that white is the 15th
+      ;; color in rxvt-standard-colors.
+      (let ((comp-max (float (caddr (nth 15 rxvt-standard-colors)))))
+        (when (color-dark-p (mapcar (lambda (c) (/ c comp-max)) rgb))
+	  (set-terminal-parameter nil 'background-mode 'dark))))))
 
 (provide 'term/rxvt)
 
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index 36e9d896c7..0e9d7c8b5c 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -86,9 +86,9 @@ terminal-init-w32console
     (setq r (nth 2 descr)
 	  g (nth 3 descr)
 	  b (nth 4 descr))
-    (if (< (+ r g b) (* .6 (+ 65535 65535 65535)))
-	(setq bg-mode 'dark)
-      (setq bg-mode 'light))
+    (setq bg-mode (if (color-dark-p
+                       (list (/ r 65535.0) (/ g 65535.0) (/ b 65535.0)))
+                      'dark 'light))
     (set-terminal-parameter nil 'background-mode bg-mode))
   (tty-set-up-initial-frame-faces)
   (run-hooks 'terminal-init-w32-hook))
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 1a727e3933..bf9bcae526 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -1120,9 +1120,8 @@ xterm-register-default-colors
     (clear-face-cache)))
 
 (defun xterm-maybe-set-dark-background-mode (redc greenc bluec)
-  ;; Use the heuristic in `frame-set-background-mode' to decide if a
-  ;; frame is dark.
-  (when (< (+ redc greenc bluec) (* .6 (+ 65535 65535 65535)))
+  (when (color-dark-p (mapcar (lambda (c) (/ c 65535.0))
+                              (list redc greenc bluec)))
     (set-terminal-parameter nil 'background-mode 'dark)
     t))
 
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 0035c5e7b0..2cd99787e8 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1149,17 +1149,6 @@ css--compute-color
    ;; Evaluate to the color if the name is found.
    ((css--named-color start-point match))))
 
-(defun css--contrasty-color (name)
-  "Return a color that contrasts with NAME.
-NAME is of any form accepted by `color-distance'.
-The returned color will be usable by Emacs and will contrast
-with NAME; in particular so that if NAME is used as a background
-color, the returned color can be used as the foreground and still
-be readable."
-  ;; See bug#25525 for a discussion of this.
-  (if (> (color-distance name "black") 292485)
-      "black" "white"))
-
 (defcustom css-fontify-colors t
   "Whether CSS colors should be fontified using the color as the background.
 When non-`nil', a text representing CSS color will be fontified
@@ -1199,7 +1188,8 @@ css--fontify-region
 		    (add-text-properties
 		     start (point)
 		     (list 'face (list :background color
-				       :foreground (css--contrasty-color color)
+				       :foreground (readable-foreground-color
+                                                    color)
 				       :box '(:line-width -1))))))))))))
     extended-region))
 
-- 
2.21.1 (Apple Git-122.3)