* bug#5305: [patch] add defined-colors-with-face-attributes to faces.el
@ 2010-01-03 21:02 Jan Moringen
2016-02-28 6:30 ` Lars Ingebrigtsen
0 siblings, 1 reply; 4+ messages in thread
From: Jan Moringen @ 2010-01-03 21:02 UTC (permalink / raw
To: bug-gnu-emacs
[-- Attachment #1: Type: text/plain, Size: 797 bytes --]
Hi,
in an application I wrote, the user is prompted for a color using
`read-color'. The completion table used there presents color names.
However, based on color names alone, I often found it hard to choose a
color. Therefore I wrote `defined-colors-with-face-attributes' which
is
like `defined-colors' but adds text properties to the color names that
make them render with the color they name as background. I also
changed
`read-color' to call the new function when a color display is
available.
I have tested the new behavior on X displays and TTYs and it seems to
work. However, I could not test windows or other terminal types and/or
other color depths.
If this change is considered useful, I would like to contribute it. I
have done the copyright assignment for Emacs.
Kind regards,
Jan
[-- Attachment #2: read-color-99203-merge-directive.txt --]
[-- Type: text/plain, Size: 5242 bytes --]
# Bazaar merge directive format 2 (Bazaar 0.90)
# revision_id: jmoringe@techfak.uni-bielefeld.de-20100101171626-\
# xqgoilbu7snk983t
# target_branch: ../../trunk/
# testament_sha1: 03e05b71c38db0d0fe6939f26f5602047497d84b
# timestamp: 2010-01-01 19:08:52 +0100
# base_revision_id: handa@m17n.org-20091228074829-kp7iv7vpr3xvibbn
#
# Begin patch
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog 2009-12-28 07:29:24 +0000
+++ lisp/ChangeLog 2010-01-01 17:16:26 +0000
@@ -1,3 +1,13 @@
+2010-01-01
+
+ Display colored completion candidates in read-color.
+ * faces.el (defined-colors-with-face-attributes): new function;
+ like defined-colors but returned color names have suitable color
+ text properties
+ (read-color): use defined-colors-with-face-attributes when display
+ supports colors
+ Patch by Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
+
2009-12-28 Juanma Barranquero <lekktu@gmail.com>
Supersede color.diff settings in git log (bug#5211).
=== modified file 'lisp/faces.el'
--- lisp/faces.el 2009-11-13 22:19:45 +0000
+++ lisp/faces.el 2010-01-01 17:16:26 +0000
@@ -1647,6 +1647,32 @@
(mapcar 'car (tty-color-alist frame))))
(defalias 'x-defined-colors 'defined-colors)
+(defun defined-colors-with-face-attributes (&optional frame)
+ "Return a list of colors supported for a particular frame.
+See `defined-colors' for arguments and return value. In contrast
+to `define-colors' the elements of the returned list are color
+strings with text properties, that make the color names render
+with the color they represent as background color."
+ (mapcar
+ (lambda (color-name)
+ (let ((foreground (readable-foreground-color color-name))
+ (color (copy-sequence color-name)))
+ (propertize color 'face (list :foreground foreground
+ :background color))))
+ (defined-colors frame)))
+
+(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")))
+
(declare-function xw-color-defined-p "xfns.c" (color &optional frame))
(defun color-defined-p (color &optional frame)
@@ -1737,7 +1763,9 @@
(interactive "i\np\ni\np") ; Always convert to RGB interactively.
(let* ((completion-ignore-case t)
(colors (append '("foreground at point" "background at point")
- (defined-colors)))
+ (if (display-color-p)
+ (defined-colors-with-face-attributes)
+ (defined-colors))))
(color (completing-read (or prompt "Color (name or #R+G+B+): ")
colors))
hex-string)
# Begin bundle
IyBCYXphYXIgcmV2aXNpb24gYnVuZGxlIHY0CiMKQlpoOTFBWSZTWaT0/q0AAv3fgHgwWff//142
2AD////wYAcdok+GB7HV2y6d7em29mVL0GSkaaGhpoNDJkPUNAAAAAACUQmJkaCYST00npqaBoMj
QBoAAEpE8p6Jqn6oaNNGgBoAAAAADQJEhNE0yo8TTEyZI9KeobU/VPEgNGajxQeoOYExNBhMmTJk
YTBNNMjEwBDAJJEyaamJhEZppMRTxPIpsU0AA0DEyqlUDVQYNtsR+EznaPPRSOHr6bOu0utkPCPL
d+RTfXSD5Zq2xg04WO+spJNkVnAEu4HPg46IWvd3qYrrSFNa3oc36z+UoasEz0g6DNbGTjB9NvPb
f5+Msn0ZC3XV3TKuXU954nQ221o8lonklEPZEG5kOZPfLlXC7A6tkjjxzy0vabb5txG+yXlWSyjJ
xWUXz1yurY5QQv2ssaVeSbG77OW1/9ZBYKzmp1FnMVnoqjfsufAlAni1a73VUgmT2rNwdelTstKE
cKMVs236nT41MtvSb8jp4y2HYFHwOxwg5QeGYjvYgmzufIdndCmw78kUf3r+74Sxb6PhIJeE5Izt
ddGysUh6PbwximJp1f6bTMbT7JBpAgDI9BHuDmyHsLxQ478OPqtai4TpDLBHp3gPlM+L8YYWiKkW
h65iOBWUW2HDZZeSQYtQmwcBR4pF/pBnoJARQRMah6gKDHtVRSaAhFIYpCAVmQ9oUSePLBQOb3nJ
yA5RKqNhr2brkSdESYFUMvdALqQZGNuFbkS9JC3hmN7tMwHpaRAYfsPKw0febVRLolCSng0yZpNe
SLG7EQ6FAaJWUmQsq1HDgcV7dYVY1AMaPEoUScsYIW+oHzcXHIZSVwhYKWxW8yq3dyGyR1MSQHfx
Sy1ScdCQOiZs2ERNHpoJjuBk0teNHmSYF2sTNrLLMpa3Y4E6tS8xymUdgYfwTiJVVtYBSltHvH5g
SUeW41scvlsJ0y74O8EYcvRMcskpaBOda1GsRS6gsytgUU5Z3C4LumHiBirH4WhXgoTeBEgxhQOI
6XXS11VUjKIp5O1kzFIi4ohAlEpo7QLOVpWdXQtHzK/O19rWXxZFM9rwi4GJNBTRTU3h8D3ngrDL
iVt6odo1G/5HKXZ7whIvGm345S3upI6/SRI8fOylSqNJpvHI9fseEDBl55Ge8eUi3g7f3b5h9K3L
Igkce1h3LOlmHhn6UWiPDTZ38gvnVtth7PQll0hpYTwalfOr8URVWMIr+smelBzAinX2GzTO4t6F
0SW4tEYw4jagyVT3lwDpo2idxSlT6lpx9PrO6rO4y65HwWfqaPi0e7mm+3RcIzVFRrHW8XAwhkRB
EJwNsbA5oUq5KtQ2xptOrGoQahHPx09hgRq2TCQNvMyCM6AsT5ONwjafPDBzOTA0otuXwirXLcJh
vRxYNvdsG6cMldKx2bWMSQgZoE0HkLrxKnfDcN22excTKyQjObWs55WMjBKbdOUhEarYuovo6mQa
PBhfLgY8mvF7pNZRaItBPFDkjTX3Ny+LisQuwEOfUopry3ceDMFOCV8o0Mlew35UdIGTHLFiIBEe
ISQ0uuix2iKAJi5LUZgKFaAOW4QYCpvndIpjn0a4RZyOC8haRGC/Jv7PErICNjg826XDhzJoEa7G
tobGfXME0MMvs/YC45NjVK+44JM4ixD7h5RpZHvh/T4CHC6axaBECuNfRMjNox6vmjydq9REYrIi
EunPMCoVJ19RsRQIxnNC0b+uE5jMk9M0CGgz7RY3HCHSZ6izKDEIhKCa2KjwKgQjoAVKS6UUWG8o
02GCMIDejo5r+SYFBFIGmEAtsSH44j6DRnORxEgrgE94Sq7EzubRQTm469KaNXV/4QexGJSgpQXH
JrYsxnBATAlAebgQgWogJN2S0lxCCJFZArAaqIt2agK9IrwIKwk1796wuF16JYn7mwoBvQIyUaT+
O26juR6vqFYmRJkKxDDxfeEhH0HqgFNRV+hBdiVc1XuYYG2ULXUFKfoZlDYuapkVcJmQvkBF9TDm
UDQ2NtiW2RemSRoW7RXLe8rInUCVEnc1HtcoBS6M5I750gnsrkZvhWG9BFCqqBxFlGprITpOcogu
lGmcFsENjQ0TnF71e0HgY5EQWr7X1ATRaYQQ3cjPcdku0xstg18Ik9hmqq1IMqXkQslQ5D/ARqlf
opYOmm5HDQk5KO2YYF+GVEMlxQ2IXoMYlSqoWWISQ3ibgNt/mVM5382/ixM0BwiCvRhWLK9P7F9o
sdSitSOxezpHJvIYy0IsE2wVYOAkl061Ru2ye+Ls3ne/UEP/F3JFOFCQpPT+rQ==
[-- Attachment #3: read-color-99203.patch --]
[-- Type: text/x-patch, Size: 2505 bytes --]
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog 2009-12-28 07:29:24 +0000
+++ lisp/ChangeLog 2010-01-01 17:16:26 +0000
@@ -1,3 +1,13 @@
+2010-01-01
+
+ Display colored completion candidates in read-color.
+ * faces.el (defined-colors-with-face-attributes): new function;
+ like defined-colors but returned color names have suitable color
+ text properties
+ (read-color): use defined-colors-with-face-attributes when display
+ supports colors
+ Patch by Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
+
2009-12-28 Juanma Barranquero <lekktu@gmail.com>
Supersede color.diff settings in git log (bug#5211).
=== modified file 'lisp/faces.el'
--- lisp/faces.el 2009-11-13 22:19:45 +0000
+++ lisp/faces.el 2010-01-01 17:16:26 +0000
@@ -1647,6 +1647,32 @@
(mapcar 'car (tty-color-alist frame))))
(defalias 'x-defined-colors 'defined-colors)
+(defun defined-colors-with-face-attributes (&optional frame)
+ "Return a list of colors supported for a particular frame.
+See `defined-colors' for arguments and return value. In contrast
+to `define-colors' the elements of the returned list are color
+strings with text properties, that make the color names render
+with the color they represent as background color."
+ (mapcar
+ (lambda (color-name)
+ (let ((foreground (readable-foreground-color color-name))
+ (color (copy-sequence color-name)))
+ (propertize color 'face (list :foreground foreground
+ :background color))))
+ (defined-colors frame)))
+
+(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")))
+
(declare-function xw-color-defined-p "xfns.c" (color &optional frame))
(defun color-defined-p (color &optional frame)
@@ -1737,7 +1763,9 @@
(interactive "i\np\ni\np") ; Always convert to RGB interactively.
(let* ((completion-ignore-case t)
(colors (append '("foreground at point" "background at point")
- (defined-colors)))
+ (if (display-color-p)
+ (defined-colors-with-face-attributes)
+ (defined-colors))))
(color (completing-read (or prompt "Color (name or #R+G+B+): ")
colors))
hex-string)
^ permalink raw reply [flat|nested] 4+ messages in thread
* bug#5305: [patch] add defined-colors-with-face-attributes to faces.el
2010-01-03 21:02 bug#5305: [patch] add defined-colors-with-face-attributes to faces.el Jan Moringen
@ 2016-02-28 6:30 ` Lars Ingebrigtsen
2016-02-28 13:07 ` Jan Moringen
0 siblings, 1 reply; 4+ messages in thread
From: Lars Ingebrigtsen @ 2016-02-28 6:30 UTC (permalink / raw
To: Jan Moringen; +Cc: 5305
Jan Moringen <jan.moringen@uni-bielefeld.de> writes:
> in an application I wrote, the user is prompted for a color using
> `read-color'. The completion table used there presents color names.
> However, based on color names alone, I often found it hard to choose a
> color. Therefore I wrote `defined-colors-with-face-attributes' which
> is
> like `defined-colors' but adds text properties to the color names that
> make them render with the color they name as background. I also
> changed
> `read-color' to call the new function when a color display is
> available.
>
> I have tested the new behavior on X displays and TTYs and it seems to
> work. However, I could not test windows or other terminal types and/or
> other color depths.
I like it a lot, so I've applied it to the Emacs trunk. All the colour
combinations were legible on my screen, but perhaps some people have
screens where they may be less so, but I guess we'll find out.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 4+ messages in thread
* bug#5305: [patch] add defined-colors-with-face-attributes to faces.el
2016-02-28 6:30 ` Lars Ingebrigtsen
@ 2016-02-28 13:07 ` Jan Moringen
2016-02-29 2:32 ` Lars Ingebrigtsen
0 siblings, 1 reply; 4+ messages in thread
From: Jan Moringen @ 2016-02-28 13:07 UTC (permalink / raw
To: Lars Ingebrigtsen, Jan Moringen; +Cc: 5305
On Sun, 2016-02-28 at 17:30 +1100, Lars Ingebrigtsen wrote:
> Jan Moringen <jan.moringen@uni-bielefeld.de> writes:
>
> > ...
>
> I like it a lot, so I've applied it to the Emacs trunk. All the
> colour
> combinations were legible on my screen, but perhaps some people have
> screens where they may be less so, but I guess we'll find out.
Thanks for applying this, but http://git.savannah.gnu.org/cgit/emacs.gi
t/commit/?id=8ed026d6176d02412b6c48d9dfbd9f3a345a86a6 seems to show
duplicate definitions of the new functions. Maybe something went wrong
with applying the patch?
Kind regards,
Jan
^ permalink raw reply [flat|nested] 4+ messages in thread
* bug#5305: [patch] add defined-colors-with-face-attributes to faces.el
2016-02-28 13:07 ` Jan Moringen
@ 2016-02-29 2:32 ` Lars Ingebrigtsen
0 siblings, 0 replies; 4+ messages in thread
From: Lars Ingebrigtsen @ 2016-02-29 2:32 UTC (permalink / raw
To: Jan Moringen; +Cc: Jan Moringen, 5305
Jan Moringen <jmoringe@techfak.uni-bielefeld.de> writes:
> Thanks for applying this, but http://git.savannah.gnu.org/cgit/emacs.gi
> t/commit/?id=8ed026d6176d02412b6c48d9dfbd9f3a345a86a6 seems to show
> duplicate definitions of the new functions. Maybe something went wrong
> with applying the patch?
Thanks for noticing; I've now remove the duplicates. I must have
applied (parts of) the patch twice or something?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2016-02-29 2:32 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-01-03 21:02 bug#5305: [patch] add defined-colors-with-face-attributes to faces.el Jan Moringen
2016-02-28 6:30 ` Lars Ingebrigtsen
2016-02-28 13:07 ` Jan Moringen
2016-02-29 2:32 ` Lars Ingebrigtsen
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.