From 5d5ef884c47695a39c22d931c4bc44e6a812d7b4 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/color.el (color-name-to-rgb): Use color-component-max instead
of the error-prone method of (color-values "#ffffffffffff"), which
would give unexpected values or outright fail if called without
an initialised display (as in batch mode).
* lisp/facemenu.el (list-colors-print): Use readable-foreground-color.
(color-dark-p, color-component-max): New functions.
* 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/color.el              |  4 +---
 lisp/facemenu.el           |  8 +++-----
 lisp/faces.el              | 34 +++++++++++++++++++++++++---------
 lisp/frame.el              | 10 +++-------
 lisp/term/pc-win.el        |  8 +++-----
 lisp/term/rxvt.el          | 12 +++++-------
 lisp/term/w32console.el    |  5 ++---
 lisp/term/xterm.el         |  5 ++---
 lisp/textmodes/css-mode.el | 14 ++------------
 9 files changed, 46 insertions(+), 54 deletions(-)

diff --git a/lisp/color.el b/lisp/color.el
index 560631ae66..2385874028 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -50,9 +50,7 @@ color-name-to-rgb
 Optional argument FRAME specifies the frame where the color is to be
 displayed.  If FRAME is omitted or nil, use the selected frame.
 If FRAME cannot display COLOR, return nil."
-  ;; `colors-values' maximum value is either 65535 or 65280 depending on the
-  ;; display system.  So we use a white conversion to get the max value.
-  (let ((valmax (float (car (color-values "#ffffffffffff")))))
+  (let ((valmax (float (color-component-max frame))))
     (mapcar (lambda (x) (/ x valmax)) (color-values color frame))))
 
 (defun color-rgb-to-hex  (red green blue &optional digits-per-component)
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index b10d874b21..119a2ba790 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -621,9 +621,7 @@ 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)))
@@ -639,7 +637,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 +649,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..2b9bcb9bcf 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1786,15 +1786,22 @@ 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 ((r (nth 0 rgb))
+        (g (nth 1 rgb))
+        (b (nth 2 rgb)))
+    (unless (<= 0 (min r g b) (max r g b) 1)
+      (error "RGB component not in [0,1]"))
+    ;; Simple heuristic -- correct luma requires gamma correction,
+    ;; which is overkill for this purpose.
+    ;; The cut-off value was designed to make saturated green 'light',
+    ;; but saturated red and blue 'dark'.
+    (< (+ (* r 0.299) (* g 0.587) (* b 0.114))
+       0.58)))
 
 (declare-function xw-color-defined-p "xfns.c" (color &optional frame))
 
@@ -1840,6 +1847,15 @@ color-values
    (t
     (tty-color-values color frame))))
 
+(defun color-component-max (&optional frame)
+  "The highest value of a color component on FRAME.
+If FRAME is omitted or nil, use the selected frame."
+  ;; Right now, NS frames are the only ones having a different maximum
+  ;; colour component value.
+  (if (eq (framep-on-display frame) 'ns)
+      #xff00
+    #xffff))
+
 (defalias 'x-color-values 'color-values)
 
 (declare-function xw-display-color-p "xfns.c" (&optional terminal))
diff --git a/lisp/frame.el b/lisp/frame.el
index 6c2f774709..fed46f333d 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1181,13 +1181,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 (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..ebcb13db77 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 (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..b249a4e602 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -86,9 +86,8 @@ 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) (/ g 65535) (/ b 65535)))
+                      '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 eda739a397..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 and bug#41544 for a discussion of this.
-  (if (> (color-distance name "black") 138500)
-      "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)

