From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jan Moringen Newsgroups: gmane.emacs.bugs Subject: bug#5305: [patch] add defined-colors-with-face-attributes to faces.el Date: Sun, 03 Jan 2010 22:02:31 +0100 Message-ID: <27784_1262552552_ZZg0O2405RUGf.00_1262552551.3761.1645.camel@localhost.localdomain> Reply-To: Jan Moringen , 5305@debbugs.gnu.org NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="Boundary_(ID_+ISbvAAGj7WWdOZo3UULDw)" X-Trace: ger.gmane.org 1262713367 2379 80.91.229.12 (5 Jan 2010 17:42:47 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 5 Jan 2010 17:42:47 +0000 (UTC) To: bug-gnu-emacs@gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Jan 05 18:42:41 2010 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1NSDQV-0006T6-Lv for geb-bug-gnu-emacs@m.gmane.org; Tue, 05 Jan 2010 18:42:40 +0100 Original-Received: from localhost ([127.0.0.1]:34852 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NSDQW-0005cp-1Y for geb-bug-gnu-emacs@m.gmane.org; Tue, 05 Jan 2010 12:42:40 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1NSAIU-0002wp-QR for bug-gnu-emacs@gnu.org; Tue, 05 Jan 2010 09:22:10 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1NSAIQ-0002tO-FO for bug-gnu-emacs@gnu.org; Tue, 05 Jan 2010 09:22:10 -0500 Original-Received: from [199.232.76.173] (port=45121 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NSAIQ-0002tC-8t for bug-gnu-emacs@gnu.org; Tue, 05 Jan 2010 09:22:06 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:53597) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1NSAIO-0001ag-TJ for bug-gnu-emacs@gnu.org; Tue, 05 Jan 2010 09:22:06 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.69) (envelope-from ) id 1NSA5n-0003ig-W3; Tue, 05 Jan 2010 09:09:03 -0500 X-Loop: bug-gnu-emacs@gnu.org Mail-Followup-To: Jan Moringen , 5305@debbugs.gnu.org Resent-From: Jan Moringen Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-To: owner@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 05 Jan 2010 14:09:03 +0000 Resent-Message-ID: Resent-Sender: bug-gnu-emacs@gnu.org X-Emacs-PR-Message: report 5305 X-Emacs-PR-Package: emacs X-Emacs-PR-Keywords: Original-Received: via spool by submit@debbugs.gnu.org id=B.126270051714193 (code B ref -1); Tue, 05 Jan 2010 14:09:03 +0000 Original-Received: (at submit) by debbugs.gnu.org; 5 Jan 2010 14:08:37 +0000 Original-Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1NSA5M-0003go-N7 for submit@debbugs.gnu.org; Tue, 05 Jan 2010 09:08:37 -0500 Original-Received: from fencepost.gnu.org ([140.186.70.10]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1NRXb5-0001sF-54 for submit@debbugs.gnu.org; Sun, 03 Jan 2010 16:02:47 -0500 Original-Received: from mx10.gnu.org ([199.232.76.166]:37279) by fencepost.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1NRXb1-0007o8-21 for submit@debbugs.gnu.org; Sun, 03 Jan 2010 16:02:43 -0500 Original-Received: from Debian-exim by monty-python.gnu.org with spam-scanned (Exim 4.60) (envelope-from ) id 1NRXay-00016X-7n for submit@debbugs.gnu.org; Sun, 03 Jan 2010 16:02:42 -0500 Original-Received: from lists.gnu.org ([199.232.76.165]:49696) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1NRXay-00016J-0b for submit@debbugs.gnu.org; Sun, 03 Jan 2010 16:02:40 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1NRXax-0002mG-Jt for bug-gnu-emacs@gnu.org; Sun, 03 Jan 2010 16:02:39 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1NRXat-0002hb-Ag for bug-gnu-emacs@gnu.org; Sun, 03 Jan 2010 16:02:39 -0500 Original-Received: from [199.232.76.173] (port=45650 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NRXat-0002hJ-63 for bug-gnu-emacs@gnu.org; Sun, 03 Jan 2010 16:02:35 -0500 Original-Received: from mux2-unibi-smtp.hrz.uni-bielefeld.de ([129.70.204.73]:64191) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1NRXas-00014T-Mt for bug-gnu-emacs@gnu.org; Sun, 03 Jan 2010 16:02:35 -0500 Original-Received: from pmxchannel-daemon.mux2-unibi-smtp.hrz.uni-bielefeld.de by mux2-unibi-smtp.hrz.uni-bielefeld.de (Sun Java(tm) System Messaging Server 6.3-6.03 (built Mar 14 2008; 32bit)) id <0KVO00M00VS8ZY00@mux2-unibi-smtp.hrz.uni-bielefeld.de> for bug-gnu-emacs@gnu.org; Sun, 03 Jan 2010 22:02:33 +0100 (CET) Original-Received: from [192.168.2.102] ([92.39.21.54]) by mux2-unibi-smtp.hrz.uni-bielefeld.de (Sun Java(tm) System Messaging Server 6.3-6.03 (built Mar 14 2008; 32bit)) with ESMTPPSA id <0KVO0099MVS72K00@mux2-unibi-smtp.hrz.uni-bielefeld.de> for bug-gnu-emacs@gnu.org; Sun, 03 Jan 2010 22:02:32 +0100 (CET) X-Mailer: Evolution 2.29.3.2 X-EnvFrom: jan.moringen@uni-bielefeld.de X-PMX-Version: 5.5.1.360522, Antispam-Engine: 2.6.1.350677, Antispam-Data: 2010.1.3.205118, pmx7 X-Connecting-IP: 92.39.21.54 X-detected-operating-system: by monty-python.gnu.org: Solaris 10 (beta) X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-Spam-Score: -5.9 (-----) X-Mailman-Approved-At: Tue, 05 Jan 2010 09:08:26 -0500 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list X-Spam-Score: -5.9 (-----) Resent-Date: Tue, 05 Jan 2010 09:09:03 -0500 X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.6 (newer, 3) X-Mailman-Approved-At: Tue, 05 Jan 2010 12:42:10 -0500 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:33951 Archived-At: --Boundary_(ID_+ISbvAAGj7WWdOZo3UULDw) Content-type: text/plain; charset=UTF-8 Content-transfer-encoding: 7BIT 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 --Boundary_(ID_+ISbvAAGj7WWdOZo3UULDw) Content-type: text/plain; name=read-color-99203-merge-directive.txt; charset=UTF-8 Content-transfer-encoding: 7BIT Content-disposition: attachment; filename=read-color-99203-merge-directive.txt # 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 + 2009-12-28 Juanma Barranquero 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== --Boundary_(ID_+ISbvAAGj7WWdOZo3UULDw) Content-type: text/x-patch; name=read-color-99203.patch; charset=UTF-8 Content-transfer-encoding: 7BIT Content-disposition: attachment; filename=read-color-99203.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 + 2009-12-28 Juanma Barranquero 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) --Boundary_(ID_+ISbvAAGj7WWdOZo3UULDw)--