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)
This commit is contained in:
Helmut Eller
Eli Zaretskii
parent
d727e8ee7c
commit
5129ea4b05
2 changed files with 48 additions and 24 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue