From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jan Moringen Newsgroups: gmane.emacs.devel Subject: [PATCH] add defined-colors-with-face-attributes to faces.el Date: Fri, 01 Jan 2010 19:21:46 +0100 Message-ID: <28417_1262370107_ZZg0N5S7X6c9t.00_1262370106.3761.1186.camel@localhost.localdomain> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="Boundary_(ID_OtB2x8ydk+60tkIP0VOGwA)" X-Trace: ger.gmane.org 1262375414 17212 80.91.229.12 (1 Jan 2010 19:50:14 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 1 Jan 2010 19:50:14 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Jan 01 20:50:07 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1NQnVe-0004U7-QE for ged-emacs-devel@m.gmane.org; Fri, 01 Jan 2010 20:50:07 +0100 Original-Received: from localhost ([127.0.0.1]:34535 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NQnVe-0004Sh-O6 for ged-emacs-devel@m.gmane.org; Fri, 01 Jan 2010 14:50:06 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1NQm8J-0003Bh-Ta for emacs-devel@gnu.org; Fri, 01 Jan 2010 13:21:55 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1NQm8E-0003AP-Vs for emacs-devel@gnu.org; Fri, 01 Jan 2010 13:21:55 -0500 Original-Received: from [199.232.76.173] (port=56603 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NQm8E-0003AM-Sv for emacs-devel@gnu.org; Fri, 01 Jan 2010 13:21:50 -0500 Original-Received: from mux1-unibi-smtp.hrz.uni-bielefeld.de ([129.70.204.65]:33481) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1NQm8E-0003c2-B9 for emacs-devel@gnu.org; Fri, 01 Jan 2010 13:21:50 -0500 Original-Received: from pmxchannel-daemon.mux1-unibi-smtp.hrz.uni-bielefeld.de by mux1-unibi-smtp.hrz.uni-bielefeld.de (Sun Java(tm) System Messaging Server 6.3-6.03 (built Mar 14 2008; 32bit)) id <0KVK00400Z0BJ000@mux1-unibi-smtp.hrz.uni-bielefeld.de> for emacs-devel@gnu.org; Fri, 01 Jan 2010 19:21:47 +0100 (CET) Original-Received: from [192.168.2.102] ([212.100.63.206]) by mux1-unibi-smtp.hrz.uni-bielefeld.de (Sun Java(tm) System Messaging Server 6.3-6.03 (built Mar 14 2008; 32bit)) with ESMTPPSA id <0KVK00GZQZ0B3T80@mux1-unibi-smtp.hrz.uni-bielefeld.de> for emacs-devel@gnu.org; Fri, 01 Jan 2010 19:21:47 +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.1.180916, pmx7 X-Connecting-IP: 212.100.63.206 X-detected-operating-system: by monty-python.gnu.org: Solaris 10 (beta) X-Mailman-Approved-At: Fri, 01 Jan 2010 14:50:01 -0500 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:119222 Archived-At: --Boundary_(ID_OtB2x8ydk+60tkIP0VOGwA) 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_OtB2x8ydk+60tkIP0VOGwA) 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_OtB2x8ydk+60tkIP0VOGwA) 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_OtB2x8ydk+60tkIP0VOGwA)--