From 8ed026d6176d02412b6c48d9dfbd9f3a345a86a6 Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Sun, 28 Feb 2016 17:27:23 +1100 Subject: [PATCH] Show the face colours when completing in `read-color' * lisp/faces.el (defined-colors-with-face-attributes): New function. (readable-foreground-color, defined-colors-with-face-attributes) (readable-foreground-color): Ditto. (read-color): Use them (bug#5305). --- lisp/faces.el | 62 +++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 58 insertions(+), 4 deletions(-) diff --git a/lisp/faces.el b/lisp/faces.el index bfb5d4c0f69..b5e9fdca08e 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1792,6 +1792,58 @@ If FRAME is nil, that stands for the selected frame." (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"))) + +(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) @@ -1896,22 +1948,24 @@ resulting color name in the echo area." (colors (or facemenu-color-alist (append '("foreground at point" "background at point") (if allow-empty-name '("")) - (defined-colors)))) + (if (display-color-p) + (defined-colors-with-face-attributes) + (defined-colors))))) (color (completing-read (or prompt "Color (name or #RGB triplet): ") ;; Completing function for reading colors, accepting ;; both color names and RGB triplets. (lambda (string pred flag) (cond - ((null flag) ; Try completion. + ((null flag) ; Try completion. (or (try-completion string colors pred) (if (color-defined-p string) string))) - ((eq flag t) ; List all completions. + ((eq flag t) ; List all completions. (or (all-completions string colors pred) (if (color-defined-p string) (list string)))) - ((eq flag 'lambda) ; Test completion. + ((eq flag 'lambda) ; Test completion. (or (member string colors) (color-defined-p string))))) nil t))) -- 2.39.2