Function: read-face-attribute

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

Signature

(read-face-attribute FACE ATTRIBUTE &optional FRAME)

Documentation

Interactively read a new value for FACE's ATTRIBUTE.

Optional argument FRAME nil or unspecified means read an attribute value of a global face. Value is the new attribute value.

Source Code

;; Defined in /usr/src/emacs/lisp/faces.el.gz
;; FIXME this does allow you to enter the list forms of :box,
;; :stipple, or :underline, because face-valid-attribute-values does
;; not return those forms.
(defun read-face-attribute (face attribute &optional frame)
  "Interactively read a new value for FACE's ATTRIBUTE.
Optional argument FRAME nil or unspecified means read an attribute value
of a global face.  Value is the new attribute value."
  (let* ((old-value (face-attribute face attribute frame))
	 (attribute-name (face-descriptive-attribute-name attribute))
	 (valid (face-valid-attribute-values attribute frame))
	 new-value)
    ;; Represent complex attribute values as strings by printing them
    ;; out.  Stipple can be a vector; (WIDTH HEIGHT DATA).  Box can be
    ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
    ;; SHADOW)'.  Underline can be `(:color COLOR :style STYLE)'.
    (and (memq attribute '(:box :stipple :underline))
	 (or (consp old-value)
	     (vectorp old-value))
	 (setq old-value (prin1-to-string old-value)))
    (cond ((listp valid)
	   (let ((default
		   (or (car (rassoc old-value valid))
		       (format "%s" old-value))))
	     (setq new-value
                   (if (memq attribute '(:foreground :background))
                       (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))
		     (face-read-string face default attribute-name valid)))
	     (if (equal new-value default)
		 ;; Nothing changed, so don't bother with all the stuff
		 ;; below.  In particular, this avoids a non-tty color
		 ;; from being canonicalized for a tty when the user
		 ;; just uses the default.
		 (setq new-value old-value)
	       ;; Terminal frames can support colors that don't appear
	       ;; explicitly in VALID, using color approximation code
	       ;; in tty-colors.el.
	       (when (and (memq attribute '(:foreground :background))
			  (not (display-graphic-p frame))
			  (not (member new-value
				       '("unspecified"
					 "unspecified-fg" "unspecified-bg"))))
		 (setq new-value (car (tty-color-desc new-value frame))))
	       (when (assoc new-value valid)
		 (setq new-value (cdr (assoc new-value valid)))))))
	  ((eq valid 'integerp)
	   (setq new-value (face-read-integer face old-value attribute-name)))
	  (t (error "Internal error")))
    ;; Convert stipple and box value text we read back to a list or
    ;; vector if it looks like one.  This makes the assumption that a
    ;; pixmap file name won't start with an open-paren.
    (and (memq attribute '(:stipple :box :underline))
	 (stringp new-value)
	 (string-match-p "^[[(]" new-value)
	 (setq new-value (read new-value)))
    new-value))