-(defun read-face-name (prompt &optional default multiple)
- "Read one or more face names, defaulting to the face(s) at point.
-PROMPT should be a prompt string; it should not end in a space or
-a colon.
-
-The optional argument DEFAULT specifies the default face name(s)
-to return if the user just types RET. If its value is non-nil,
-it should be a list of face names (symbols); in that case, the
-default return value is the `car' of DEFAULT (if the argument
-MULTIPLE is non-nil), or DEFAULT (if MULTIPLE is nil). See below
-for the meaning of MULTIPLE.
-
-If DEFAULT is nil, the list of default face names is taken from
-the `read-face-name' property of the text at point, or, if that
-is nil, from the `face' property of the text at point.
-
-This function uses `completing-read-multiple' with \",\" as the
-separator character. Thus, the user may enter multiple face
-names, separated by commas. The optional argument MULTIPLE
-specifies the form of the return value. If MULTIPLE is non-nil,
-return a list of face names; if the user entered just one face
-name, the return value would be a list of one face name.
-Otherwise, return a single face name; if the user entered more
-than one face name, return only the first one."
- (let ((faceprop (or (get-char-property (point) 'read-face-name)
- (get-char-property (point) 'face)))
- (aliasfaces nil)
- (nonaliasfaces nil)
- faces)
- ;; Try to get a face name from the buffer.
- (if (memq (intern-soft (thing-at-point 'symbol)) (face-list))
- (setq faces (list (intern-soft (thing-at-point 'symbol)))))
- ;; Add the named faces that the `face' property uses.
- (if (and (listp faceprop)
- ;; Don't treat an attribute spec as a list of faces.
- (not (keywordp (car faceprop)))
- (not (memq (car faceprop) '(foreground-color background-color))))
- (dolist (f faceprop)
- (if (symbolp f)
- (push f faces)))
- (if (symbolp faceprop)
- (push faceprop faces)))
- (delete-dups faces)