From: Helmut Eller <eller.helmut@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 64725@debbugs.gnu.org
Subject: bug#64725: 30.0.50; set-face-foreground shows background colors
Date: Thu, 20 Jul 2023 16:34:34 +0200 [thread overview]
Message-ID: <m27cquird1.fsf@gmail.com> (raw)
In-Reply-To: <83lefb50lu.fsf@gnu.org> (Eli Zaretskii's message of "Wed, 19 Jul 2023 19:26:21 +0300")
[-- Attachment #1: Type: text/plain, Size: 490 bytes --]
On Wed, Jul 19 2023, Eli Zaretskii wrote:
> That's exactly what I meant: when you customize the foreground color
> of a face, show the candidates as text in that color on the background
> of the face's background color, and when you customize the background
> of a face, show the candidates as background with the text in the
> foreground color of the face. IOW, show the face with its both colors
> as it will look if this candidate is chosen.
OK. Here is a patch that should do this:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Improve-the-interactive-use-of-set-face-foreground.patch --]
[-- Type: text/x-diff, Size: 6567 bytes --]
From 69159b5ca0123692373a014ed19e01547c12449e Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 20 Jul 2023 16:27:34 +0200
Subject: [PATCH] Improve the interactive use of set-face-foreground
When displaying the completion candidates, show how the face would
look with the new foreground.
* 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.
---
doc/lispref/minibuf.texi | 8 ++++-
lisp/faces.el | 64 +++++++++++++++++++++++++---------------
2 files changed, 48 insertions(+), 24 deletions(-)
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index a861b8e910b..12ea7b12386 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1515,7 +1515,8 @@ High-Level Completion
@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):"})
@@ -1535,6 +1536,11 @@ High-Level Completion
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 @@ read-face-attribute
(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 @@ defined-colors-with-face-attributes
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 @@ display-grayscale-p
(> (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 @@ read-color
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
--
2.39.2
next prev parent reply other threads:[~2023-07-20 14:34 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-19 7:09 bug#64725: 30.0.50; set-face-foreground shows background colors Helmut Eller
2023-07-19 12:44 ` Eli Zaretskii
2023-07-19 15:45 ` Helmut Eller
2023-07-19 16:26 ` Eli Zaretskii
2023-07-20 14:34 ` Helmut Eller [this message]
2023-08-03 7:58 ` Eli Zaretskii
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m27cquird1.fsf@gmail.com \
--to=eller.helmut@gmail.com \
--cc=64725@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.