Make set-foreground-color display completions using foreground colors

* lisp/faces.el (defined-colors-with-face-attributes): Also create
colors for foregrounds (bug#33799).
(read-color): Also allow varying the foreground color.

* lisp/frame.el (set-foreground-color): Vary the foreground color.

diff --git a/lisp/faces.el b/lisp/faces.el
index a3a6f1b78ddea74f7b980ee7c6c39f24d511c1ae..a5aef757b1d12355c06304348bfa5ccc1f22f6cf 100644 (file)
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1795,18 +1795,21 @@ 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)
+(defun defined-colors-with-face-attributes (&optional frame foreground)
   "Return a list of colors supported for a particular frame.
 See `defined-colors' for arguments and return value. In contrast
 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."
+with the color they represent as background color (if FOREGROUND
+is nil; otherwise use the foreground 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))))
+     (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)))
 
 (defun readable-foreground-color (color)
@@ -1915,7 +1918,8 @@ If omitted or nil, that stands for the selected frame's display."
       (x-display-grayscale-p display)
     (> (tty-color-gray-shades display) 2)))
 
-(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
+(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg
+                            foreground)
   "Read a color name or RGB triplet.
 Completion is available for color names, but not for RGB triplets.
 
@@ -1942,13 +1946,18 @@ If optional arg ALLOW-EMPTY-NAME is non-nil, the user is allowed
 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."
+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."
   (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)
+                             (defined-colors-with-face-attributes
+                               nil foreground)
                            (defined-colors))))
         (color (completing-read
                 (or prompt "Color (name or #RGB triplet): ")

diff --git a/lisp/frame.el b/lisp/frame.el
index 146fe278b3e86b9caf884b83f73e2426ad21f12b..28601b81a48f6d2f6c112835f526377c5f9f11b2 100644 (file)
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1507,7 +1507,7 @@ To get the frame's current background color, use `frame-parameters'."
   "Set the foreground color of the selected frame to COLOR-NAME.
 When called interactively, prompt for the name of the color to use.
 To get the frame's current foreground color, use `frame-parameters'."
-  (interactive (list (read-color "Foreground color: ")))
+  (interactive (list (read-color "Foreground color: " nil nil nil t)))
   (modify-frame-parameters (selected-frame)
                           (list (cons 'foreground-color color-name)))
   (or window-system