From: "Mattias Engdegård" <mattiase@acm.org>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 41544@debbugs.gnu.org
Subject: bug#41544: 26.3; Possible incorrect results from color-distance
Date: Sat, 6 Jun 2020 18:54:41 +0200 [thread overview]
Message-ID: <EAD39303-6870-4E5F-8D3B-4B4DE29AD57B@acm.org> (raw)
In-Reply-To: <83img48ffx.fsf@gnu.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.
---
| 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(-)
--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)
next prev parent reply other threads:[~2020-06-06 16:54 UTC|newest]
Thread overview: 72+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-05-26 16:29 bug#41544: 26.3; Possible incorrect results from color-distance Simon Pugnet
2020-05-28 17:31 ` Mattias Engdegård
2020-05-29 15:17 ` Mattias Engdegård
2020-05-29 15:36 ` Eli Zaretskii
2020-05-29 17:28 ` Mattias Engdegård
2020-05-29 17:52 ` Tom Tromey
2020-05-31 20:46 ` Mattias Engdegård
2020-06-01 16:32 ` Eli Zaretskii
2020-06-01 17:24 ` Mattias Engdegård
2020-06-01 17:35 ` Eli Zaretskii
2020-06-01 17:44 ` Eli Zaretskii
2020-06-02 15:27 ` Mattias Engdegård
2020-06-02 16:14 ` Eli Zaretskii
2020-06-02 20:41 ` Mattias Engdegård
2020-06-03 14:24 ` Eli Zaretskii
2020-06-03 15:01 ` Mattias Engdegård
2020-06-03 15:59 ` Eli Zaretskii
2020-06-03 20:08 ` Mattias Engdegård
2020-06-04 14:07 ` Eli Zaretskii
2020-06-04 15:29 ` Mattias Engdegård
2020-06-05 12:27 ` Eli Zaretskii
2020-06-05 15:50 ` Mattias Engdegård
2020-06-06 7:29 ` Eli Zaretskii
2020-06-06 10:59 ` Mattias Engdegård
2020-06-06 11:59 ` Eli Zaretskii
2020-06-06 13:29 ` Mattias Engdegård
2020-06-06 13:57 ` Eli Zaretskii
2020-06-06 16:54 ` Mattias Engdegård [this message]
2020-06-06 18:15 ` Drew Adams
2020-06-07 9:13 ` Mattias Engdegård
2020-06-07 14:30 ` Eli Zaretskii
2020-06-07 16:12 ` Drew Adams
2020-06-09 12:19 ` Mattias Engdegård
2020-06-07 16:00 ` Drew Adams
2020-06-06 18:27 ` Eli Zaretskii
2020-06-07 9:04 ` Simen Heggestøyl
[not found] ` <87pnabfdr5.fsf@simenheg@gmail.com>
2020-06-07 10:14 ` Mattias Engdegård
2020-06-07 19:23 ` Simen Heggestøyl
[not found] ` <87d06ar87d.fsf@simenheg@gmail.com>
2020-06-07 19:27 ` Mattias Engdegård
2020-06-08 18:39 ` Simen Heggestøyl
2020-06-07 14:26 ` Eli Zaretskii
2020-06-07 16:10 ` Drew Adams
2020-06-07 19:26 ` Simen Heggestøyl
2020-06-08 13:11 ` Mattias Engdegård
2020-06-08 14:30 ` Drew Adams
2020-06-08 19:53 ` Mattias Engdegård
2020-06-10 18:37 ` Drew Adams
2020-06-10 19:12 ` Mattias Engdegård
2020-06-09 16:20 ` Eli Zaretskii
2020-06-10 14:51 ` Mattias Engdegård
2020-06-10 15:08 ` Eli Zaretskii
2020-06-10 18:29 ` Mattias Engdegård
2020-06-10 18:45 ` Eli Zaretskii
2020-08-18 13:44 ` Lars Ingebrigtsen
2020-08-18 14:06 ` Eli Zaretskii
2020-08-18 14:10 ` Lars Ingebrigtsen
2020-08-18 14:19 ` Mattias Engdegård
2020-08-19 10:11 ` Lars Ingebrigtsen
2020-08-19 11:28 ` Mattias Engdegård
2020-08-19 11:34 ` Lars Ingebrigtsen
2020-08-18 14:51 ` Eli Zaretskii
2020-08-19 10:13 ` Lars Ingebrigtsen
2020-08-19 14:52 ` Eli Zaretskii
2020-08-19 15:03 ` Lars Ingebrigtsen
2020-08-19 17:15 ` Eli Zaretskii
2020-08-20 13:08 ` Lars Ingebrigtsen
2020-08-21 11:32 ` Mattias Engdegård
2020-08-22 13:22 ` Lars Ingebrigtsen
2020-06-04 6:15 ` Simon Pugnet
2020-06-04 8:57 ` Mattias Engdegård
2020-06-01 19:46 ` Basil L. Contovounesios
2020-06-02 15:08 ` Mattias Engdegård
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=EAD39303-6870-4E5F-8D3B-4B4DE29AD57B@acm.org \
--to=mattiase@acm.org \
--cc=41544@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.