From: Helmut Eller Date: Thu, 20 Jul 2023 14:27:34 +0000 (+0200) Subject: Improve interactive prompting for face colors X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5129ea4b0540a0df35be59cdaf2fe63260670e9f;p=emacs.git Improve interactive prompting for face colors When displaying the completion candidates, show how the face would look with the new foreground/background. * lisp/faces.el (faces--string-with-color): New helper, factored out from 'defined-colors-with-face-attributes'. (defined-colors-with-face-attributes): Use it. (read-color): Add optional argument FACE and pass it to 'faces--string-with-color.' (read-face-attribute): Call 'read-color' with more appropriate foreground and face arguments. * doc/lispref/minibuf.texi (High-Level Completion): Describe the intention behind the arguments FOREGROUND and FACE of 'read-color'. (Bug#64725) --- diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 31b020db57c..4ed36edb8c1 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1537,7 +1537,8 @@ that it uses the predicate @code{custom-variable-p} instead of @code{commandp}. @end defun -@deffn Command read-color &optional prompt convert allow-empty display +@deffn Command read-color &optional prompt convert allow-empty @ + display foreground face This function reads a string that is a color specification, either the color's name or an RGB hex value such as @code{#RRRGGGBBB}. It prompts with @var{prompt} (default: @code{"Color (name or #RGB triplet):"}) @@ -1557,6 +1558,11 @@ non-@code{nil} and the user enters null input. Interactively, or when @var{display} is non-@code{nil}, the return value is also displayed in the echo area. + +The optional arguments FOREGROUND and FACE control the appearence of +the completion candidates. The candidates are displayed like FACE but +with different colors. If FOREGROUND is non-@code{nil} the foreground +varies, otherwise the background. @end deffn See also the functions @code{read-coding-system} and diff --git a/lisp/faces.el b/lisp/faces.el index 44d64c743ba..4f51a031156 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1340,10 +1340,11 @@ of a global face. Value is the new attribute value." (format "%s" old-value)))) (setq new-value (if (memq attribute '(:foreground :background)) - (let ((color - (read-color - (format-prompt "%s for face `%s'" - default attribute-name face)))) + (let* ((prompt (format-prompt + "%s for face `%s'" + default attribute-name face)) + (fg (eq attribute ':foreground)) + (color (read-color prompt nil nil nil fg face))) (if (equal (string-trim color) "") default color)) @@ -1870,15 +1871,26 @@ to `defined-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 (if FOREGROUND is nil; otherwise use the foreground color)." - (mapcar - (lambda (color-name) - (let ((color (copy-sequence color-name))) - (propertize color 'face - (if foreground - (list :foreground color) - (list :foreground (readable-foreground-color color-name) - :background color))))) - (defined-colors frame))) + (mapcar (lambda (color-name) + (faces--string-with-color color-name color-name foreground)) + (defined-colors frame))) + +(defun faces--string-with-color (string color &optional foreground face) + "Return a copy of STRING with face attributes for COLOR. +Set the :background or :foreground attribute to COLOR, depending +on the argument FOREGROUND. + +The optional FACE argument controls the values for other +attributes." + (let* ((defaults (if face (list face) '())) + (colors (cond (foreground + (list :foreground color)) + (face + (list :background color)) + (t + (list :foreground (readable-foreground-color color) + :background color))))) + (propertize string 'face (cons colors defaults)))) (defun readable-foreground-color (color) "Return a readable foreground color for background COLOR. @@ -1987,7 +1999,7 @@ If omitted or nil, that stands for the selected frame's display." (> (tty-color-gray-shades display) 2))) (defun read-color (&optional prompt convert-to-RGB allow-empty-name msg - foreground) + foreground face) "Read a color name or RGB triplet. Completion is available for color names, but not for RGB triplets. @@ -2016,17 +2028,23 @@ to enter an empty color name (the empty string). Interactively, or with optional arg MSG non-nil, print the resulting color name in the echo area. -Interactively, displays a list of colored completions. If optional -argument FOREGROUND is non-nil, shows them as foregrounds, otherwise -as backgrounds." +Interactively, displays a list of colored completions. If +optional argument FOREGROUND is non-nil, shows them as +foregrounds, otherwise as backgrounds. The optional argument +FACE controls the default appearance." (interactive "i\np\ni\np") ; Always convert to RGB interactively. (let* ((completion-ignore-case t) - (colors (append '("foreground at point" "background at point") - (if allow-empty-name '("")) - (if (display-color-p) - (defined-colors-with-face-attributes - nil foreground) - (defined-colors)))) + (color-alist + `(("foreground at point" . ,(foreground-color-at-point)) + ("background at point" . ,(background-color-at-point)) + ,@(if allow-empty-name '(("" . unspecified))) + ,@(mapcar (lambda (c) (cons c c)) (defined-colors)))) + (colors (mapcar (lambda (pair) + (let* ((name (car pair)) + (color (cdr pair))) + (faces--string-with-color name color + foreground face))) + color-alist)) (color (completing-read (or prompt "Color (name or #RGB triplet): ") ;; Completing function for reading colors, accepting