"Read one or more face names, prompting with PROMPT.
PROMPT should not end in a space or a colon.
-Return DEFAULT if the user enters the empty string.
-If DEFAULT is non-nil, it should be a single face or a list of face names
-\(symbols or strings). In the latter case, return the `car' of DEFAULT
-\(if MULTIPLE is nil, see below), or DEFAULT (if MULTIPLE is non-nil).
-
-If MULTIPLE is non-nil, this function uses `completing-read-multiple'
-to read multiple faces with \"[ \\t]*,[ \\t]*\" as the separator regexp
-and it returns a list of face names. Otherwise, it reads and returns
-a single face name."
- (if (and default (not (stringp default)))
- (setq default
- (cond ((symbolp default)
- (symbol-name default))
- (multiple
- (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f))
- default ", "))
- ;; If we only want one, and the default is more than one,
- ;; discard the unwanted ones.
- (t (symbol-name (car default))))))
+If DEFAULT is non-nil, it should be a face (a symbol) or a face
+name (a string). It can also be a list of faces or face names.
+
+If MULTIPLE is non-nil, the return value from this function is a
+list of faces. Otherwise a single face is returned.
+
+If the user enter the empty string at the prompt, DEFAULT is
+returned after a possible transformation according to MULTIPLE.
+That is, if DEFAULT is a list and MULTIPLE is nil, the first
+element of DEFAULT is returned. If DEFAULT isn't a list, but
+MULTIPLE is non-nil, a one-element list containing DEFAULT is
+returned. Otherwise, DEFAULT is returned verbatim."
+ (unless (listp default)
+ (setq default (list default)))
+ (when default
+ (setq default
+ (if multiple
+ (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f))
+ default ", ")
+ ;; If we only want one, and the default is more than one,
+ ;; discard the unwanted ones.
+ (setq default (car default))
+ (if (symbolp default)
+ (symbol-name default)
+ default))))
(when (and default (not multiple))
(require 'crm)
;; For compatibility with `completing-read-multiple' use `crm-separator'
;; to define DEFAULT if MULTIPLE is nil.
(setq default (car (split-string default crm-separator t))))
+ ;; Older versions of `read-face-name' did not append ": " to the
+ ;; prompt, so there are third party libraries that have that in the
+ ;; prompt. If so, remove it.
+ (setq prompt (replace-regexp-in-string ": ?\\'" "" prompt))
(let ((prompt (if default
(format-message "%s (default `%s'): " prompt default)
(format "%s: " prompt)))
(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")))
+
(declare-function xw-color-defined-p "xfns.c" (color &optional frame))
(defun color-defined-p (color &optional frame)
(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)))
(defface variable-pitch
'((((type w32))
- ;; This is a kludgey workaround for an issue discussed in
+ ;; This is a kludgy workaround for an issue discussed in
;; http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00746.html.
:font "-outline-Arial-normal-normal-normal-sans-*-*-*-*-p-*-iso8859-1")
(t :family "Sans Serif"))
:group 'basic-faces
:version "22.1")
+(defface nobreak-hyphen
+ '((((background dark)) :foreground "cyan")
+ (((type pc)) :foreground "magenta")
+ (t :foreground "brown"))
+ "Face for displaying nobreak hyphens."
+ :group 'basic-faces
+ :version "25.2")
+
(defgroup mode-line-faces nil
"Faces used in the mode line."
:group 'mode-line
:version "24.1"
:group 'basic-faces)
+(defface read-multiple-choice-face
+ '((t (:inherit underline
+ :weight bold)))
+ "Face for the symbol name in Apropos output."
+ :group 'basic-faces
+ :version "25.2")
+
;; Faces for TTY menus.
(defface tty-menu-enabled-face
'((t