Function: read-face-name

read-face-name is a byte-compiled function defined in faces.el.gz.

Signature

(read-face-name PROMPT &optional DEFAULT MULTIPLE)

Documentation

Read one or more face names, prompting with PROMPT.

PROMPT should not end in a space or a colon.

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.

Source Code

;; Defined in /usr/src/emacs/lisp/faces.el.gz
(defun read-face-name (prompt &optional default multiple)
  "Read one or more face names, prompting with PROMPT.
PROMPT should not end in a space or a colon.

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."
  (let (defaults)
    (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 and use them only in the
              ;; "future history" retrieved via `M-n M-n ...'.
              (setq defaults default 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-prompt prompt default)
                    (format "%s: " prompt)))
          (completion-extra-properties
           '(:affixation-function
             (lambda (faces)
               (mapcar
                (lambda (face)
                  (list face
                        (concat (propertize read-face-name-sample-text
                                            'face face)
                                "\t")
                        ""))
                faces))))
          aliasfaces nonaliasfaces faces)
      ;; Build up the completion tables.
      (mapatoms (lambda (s)
                  (if (facep s)
                      (if (get s 'face-alias)
                          (push (symbol-name s) aliasfaces)
                        (push (symbol-name s) nonaliasfaces)))))
      (if multiple
          (progn
            (dolist (face (completing-read-multiple
                           prompt
                           (completion-table-in-turn nonaliasfaces aliasfaces)
                           nil t nil 'face-name-history default))
              ;; Ignore elements that are not faces
              ;; (for example, because DEFAULT was "all faces")
              (if (facep face) (push (if (stringp face)
                                         (intern face)
                                       face)
                                     faces)))
            (nreverse faces))
        (let ((face (completing-read
                     prompt
                     (completion-table-in-turn nonaliasfaces aliasfaces)
                     nil t nil 'face-name-history defaults)))
          (when (facep face) (if (stringp face)
                                 (intern face)
                               face)))))))