;;; faces.el --- Lisp faces
-;; Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2013 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(defalias 'face-background-pixmap 'face-stipple)
-;; FIXME all of these -p functions ignore inheritance (cf face-stipple).
-;; Ie, a face that inherits from an underlined face but does not
-;; specify :underline will return nil.
-;; So these functions don't actually tell you anything about how the
-;; face will _appear_. So not very useful IMO.
-(defun face-underline-p (face &optional frame)
+(defun face-underline-p (face &optional frame inherit)
"Return non-nil if FACE specifies a non-nil underlining.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
- (face-attribute-specified-or (face-attribute face :underline frame) nil))
+If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'."
+ (face-attribute-specified-or
+ (face-attribute face :underline frame inherit) nil))
-(defun face-inverse-video-p (face &optional frame)
+(defun face-inverse-video-p (face &optional frame inherit)
"Return non-nil if FACE specifies a non-nil inverse-video.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
- (eq (face-attribute face :inverse-video frame) t))
+If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'."
+ (eq (face-attribute face :inverse-video frame inherit) t))
-(defun face-bold-p (face &optional frame)
+(defun face-bold-p (face &optional frame inherit)
"Return non-nil if the font of FACE is bold on FRAME.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'.
Use `face-attribute' for finer control."
- (let ((bold (face-attribute face :weight frame)))
+ (let ((bold (face-attribute face :weight frame inherit)))
(memq bold '(semi-bold bold extra-bold ultra-bold))))
-(defun face-italic-p (face &optional frame)
+(defun face-italic-p (face &optional frame inherit)
"Return non-nil if the font of FACE is italic on FRAME.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'.
Use `face-attribute' for finer control."
- (let ((italic (face-attribute face :slant frame)))
+ (let ((italic (face-attribute face :slant frame inherit)))
(memq italic '(italic oblique))))
'set-face-underline "24.3")
-(defun set-face-inverse-video-p (face inverse-video-p &optional frame)
+(defun set-face-inverse-video (face inverse-video-p &optional frame)
"Specify whether face FACE is in inverse video.
INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
(interactive
(let ((list (read-face-and-attribute :inverse-video)))
- (list (car list) (eq (car (cdr list)) t))))
+ (list (car list) (if (cadr list) t))))
(set-face-attribute face frame :inverse-video inverse-video-p))
+(define-obsolete-function-alias 'set-face-inverse-video-p
+ 'set-face-inverse-video "24.4")
-;; The -p suffix is a hostage to fortune. What if we want to extend
-;; this to allow more than boolean options? Exactly this happened
-;; to set-face-underline-p.
-(defun set-face-bold-p (face bold-p &optional frame)
+(defun set-face-bold (face bold-p &optional frame)
"Specify whether face FACE is bold.
BOLD-P non-nil means FACE should explicitly display bold.
BOLD-P nil means FACE should explicitly display non-bold.
(make-face-unbold face frame)
(make-face-bold face frame)))
+(define-obsolete-function-alias 'set-face-bold-p 'set-face-bold "24.4")
+
-(defun set-face-italic-p (face italic-p &optional frame)
+(defun set-face-italic (face italic-p &optional frame)
"Specify whether face FACE is italic.
ITALIC-P non-nil means FACE should explicitly display italic.
ITALIC-P nil means FACE should explicitly display non-italic.
(make-face-unitalic face frame)
(make-face-italic face frame)))
+(define-obsolete-function-alias 'set-face-italic-p 'set-face-italic "24.4")
+
(defalias 'set-face-background-pixmap 'set-face-stipple)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun read-face-name (prompt &optional default multiple)
- "Read a face, defaulting to the face or faces on the char after point.
-If it has the property `read-face-name', that overrides the `face' property.
-PROMPT should be a string that describes what the caller will do with the face;
-it should not end in a space.
+ "Read a face, defaulting to the face or faces at point.
+If the text at point has the property `read-face-name', that
+overrides the `face' property for determining the default.
+
+PROMPT should be a string that describes what the caller will do
+with the face; it should not end in a space.
+
+
+This function uses `completing-read-multiple' with \",\" as the
+separator character, i.e.
+
+
+
+
+
The optional argument DEFAULT provides the value to display in the
minibuffer prompt that is returned if the user just types RET
unless DEFAULT is a string (in which case nil is returned).
+
If MULTIPLE is non-nil, return a list of faces (possibly only one).
Otherwise, return a single face."
(let ((faceprop (or (get-char-property (point) 'read-face-name)
(mapcar (lambda (x) (list (car x) 'unspecified))
face-attribute-name-alist)))))
-(defun face-spec-set (face spec &optional for-defface)
- "Set and apply the face spec for FACE.
-If the optional argument FOR-DEFFACE is omitted or nil, set the
-overriding spec to SPEC, recording it in the `face-override-spec'
-property of FACE. See `defface' for the format of SPEC.
-
-If FOR-DEFFACE is non-nil, set the base spec (the one set by
-`defface' and Custom). In this case, SPEC is ignored; the caller
-is responsible for putting the face spec in the `saved-face',
-`customized-face', or `face-defface-spec', as appropriate.
-
-The appearance of FACE is controlled by the base spec, by any
-custom theme specs on top of that, and by the overriding spec on
-top of all the rest."
- (if for-defface
- ;; When we reset the face based on its custom spec, then it is
- ;; unmodified as far as Custom is concerned.
- (put (or (get face 'face-alias) face) 'face-modified nil)
- ;; When we change a face based on a spec from outside custom,
- ;; record it for future frames.
- (put (or (get face 'face-alias) face) 'face-override-spec spec))
- ;; Reset each frame according to the rules implied by all its specs.
- (dolist (frame (frame-list))
- (face-spec-recalc face frame)))
+(defun face-spec-set (face spec &optional spec-type)
+ "Set the face spec SPEC for FACE.
+See `defface' for the format of SPEC.
+
+The appearance of each face is controlled by its spec, and by the
+internal face attributes (which can be frame-specific and can be
+set via `set-face-attribute').
+
+The argument SPEC-TYPE determines which spec to set:
+ nil or `face-override-spec' means the override spec (which is
+ usually what you want if calling this function outside of
+ Custom code);
+ `customized-face' or `saved-face' means the customized spec or
+ the saved custom spec;
+ `face-defface-spec' means the default spec
+ (usually set only via `defface');
+ `reset' means to ignore SPEC, but clear the `customized-face'
+ and `face-override-spec' specs;
+Any other value means not to set any spec, but to run the
+function for its other effects.
+
+In addition to setting the face spec, this function defines FACE
+as a valid face name if it is not already one, and (re)calculates
+the face's attributes on existing frames."
+ (if (get face 'face-alias)
+ (setq face (get face 'face-alias)))
+ ;; Save SPEC to the relevant symbol property.
+ (unless spec-type
+ (setq spec-type 'face-override-spec))
+ (if (memq spec-type '(face-defface-spec face-override-spec
+ customized-face saved-face))
+ (put face spec-type spec))
+ (if (memq spec-type '(reset saved-face))
+ (put face 'customized-face nil))
+ ;; Setting the face spec via Custom empties out any override spec,
+ ;; similar to how setting a variable via Custom changes its values.
+ (if (memq spec-type '(customized-face saved-face reset))
+ (put face 'face-override-spec nil))
+ ;; If we reset the face based on its custom spec, it is unmodified
+ ;; as far as Custom is concerned.
+ (unless (eq face 'face-override-spec)
+ (put face 'face-modified nil))
+ (if (facep face)
+ ;; If the face already exists, recalculate it.
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame))
+ ;; Otherwise, initialize it on all frames.
+ (make-empty-face face)
+ (let ((value (face-user-default-spec face))
+ (have-window-system (memq initial-window-system '(x w32 ns))))
+ (dolist (frame (frame-list))
+ (face-spec-set-2 face frame value)
+ (when (memq (window-system frame) '(x w32 ns))
+ (setq have-window-system t)))
+ (if have-window-system
+ (make-face-x-resource-internal face)))))
(defun face-spec-recalc (face frame)
"Reset the face attributes of FACE on FRAME according to its specs.
This applies the defface/custom spec first, then the custom theme specs,
then the override spec."
+ (while (get face 'face-alias)
+ (setq face (get face 'face-alias)))
(face-spec-reset-face face frame)
- (let ((face-sym (or (get face 'face-alias) face)))
- (or (get face 'customized-face)
- (get face 'saved-face)
- (face-spec-set-2 face frame (face-default-spec face)))
- (let ((theme-faces (reverse (get face-sym 'theme-face))))
- (dolist (spec theme-faces)
- (face-spec-set-2 face frame (cadr spec))))
- (face-spec-set-2 face frame (get face-sym 'face-override-spec))))
+ ;; If FACE is customized or themed, set the custom spec from
+ ;; `theme-face' records, which completely replace the defface spec
+ ;; rather than inheriting from it.
+ (let ((theme-faces (get face 'theme-face)))
+ (if theme-faces
+ (dolist (spec (reverse theme-faces))
+ (face-spec-set-2 face frame (cadr spec)))
+ (face-spec-set-2 face frame (face-default-spec face))))
+ (face-spec-set-2 face frame (get face 'face-override-spec)))
(defun face-spec-set-2 (face frame spec)
"Set the face attributes of FACE on FRAME according to SPEC."
(declare-function xw-color-defined-p "xfns.c" (color &optional frame))
(defun color-defined-p (color &optional frame)
- "Return non-nil if color COLOR is supported on frame FRAME.
-If FRAME is omitted or nil, use the selected frame.
-If COLOR is the symbol `unspecified' or one of the strings
-\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
- (if (member color '(unspecified "unspecified-bg" "unspecified-fg"))
- nil
+ "Return non-nil if COLOR is supported on frame FRAME.
+COLOR should be a string naming a color (e.g. \"white\"), or a
+string specifying a color's RGB components (e.g. \"#ff12ec\"), or
+the symbol `unspecified'.
+
+This function returns nil if COLOR is the symbol `unspecified',
+or one of the strings \"unspecified-fg\" or \"unspecified-bg\".
+
+If FRAME is omitted or nil, use the selected frame."
+ (unless (member color '(unspecified "unspecified-bg" "unspecified-fg"))
(if (member (framep (or frame (selected-frame))) '(x w32 ns))
(xw-color-defined-p color frame)
(numberp (tty-color-translate color frame)))))
HCoop / bpt / emacs.git / blobdiff