* [PATCH] add defined-colors-with-face-attributes to faces.el
@ 2010-01-01 18:21 Jan Moringen
2010-01-01 20:13 ` Chong Yidong
0 siblings, 1 reply; 3+ messages in thread
From: Jan Moringen @ 2010-01-01 18:21 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 796 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] 3+ messages in thread
* Re: [PATCH] add defined-colors-with-face-attributes to faces.el
2010-01-01 18:21 [PATCH] add defined-colors-with-face-attributes to faces.el Jan Moringen
@ 2010-01-01 20:13 ` Chong Yidong
2010-01-03 17:07 ` Jan Moringen
0 siblings, 1 reply; 3+ messages in thread
From: Chong Yidong @ 2010-01-01 20:13 UTC (permalink / raw)
To: Jan Moringen; +Cc: emacs-devel
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.
>
> If this change is considered useful, I would like to contribute it. I
> have done the copyright assignment for Emacs.
We're in feature freeze at the moment, so come back after Emacs 23.2 is
released. In the meantime, you can send this to bug-gnu-emacs so that
the message is not lost.
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [PATCH] add defined-colors-with-face-attributes to faces.el
2010-01-01 20:13 ` Chong Yidong
@ 2010-01-03 17:07 ` Jan Moringen
0 siblings, 0 replies; 3+ messages in thread
From: Jan Moringen @ 2010-01-03 17:07 UTC (permalink / raw)
To: Chong Yidong; +Cc: emacs-devel
On Fri, 2010-01-01 at 15:13 -0500, Chong Yidong wrote:
> [...]
>
> We're in feature freeze at the moment, so come back after Emacs 23.2
> is
> released. In the meantime, you can send this to bug-gnu-emacs so that
> the message is not lost.
Thanks, I will do that.
Kind regards,
Jan
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2010-01-03 17:07 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-01-01 18:21 [PATCH] add defined-colors-with-face-attributes to faces.el Jan Moringen
2010-01-01 20:13 ` Chong Yidong
2010-01-03 17:07 ` Jan Moringen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).