;;; 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
;; This is defined originally in xfaces.c.
(defcustom face-font-registry-alternatives
(mapcar (lambda (arg) (mapcar 'purecopy arg))
- (if (eq system-type 'windows-nt)
+ (if (featurep 'w32)
'(("iso8859-1" "ms-oemlatin")
("gb2312.1980" "gb2312" "gbk" "gb18030")
("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
(defalias 'face-background-pixmap 'face-stipple)
-(defun face-underline-p (face &optional frame)
- "Return non-nil if FACE is underlined.
+(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."
- (eq (face-attribute face :underline frame) t))
+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)
- "Return non-nil if FACE is in inverse video on 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-attribute face frame :stipple (or stipple 'unspecified)))
-(defun set-face-underline-p (face underline &optional frame)
+(defun set-face-underline (face underline &optional frame)
"Specify whether face FACE is underlined.
UNDERLINE nil means FACE explicitly doesn't underline.
-UNDERLINE non-nil means FACE explicitly does underlining
-with the same of the foreground color.
-If UNDERLINE is a string, underline with the color named UNDERLINE.
+UNDERLINE t means FACE underlines with its foreground color.
+If UNDERLINE is a string, underline with that color.
+
+UNDERLINE may also be a list of the form (:color COLOR :style STYLE),
+where COLOR is a string or `foreground-color', and STYLE is either
+`line' or `wave'. :color may be omitted, which means to use the
+foreground color. :style may be omitted, which means to use a line.
+
FRAME nil or not specified means change face on all frames.
Use `set-face-attribute' to ``unspecify'' underlining."
- (interactive
- (let ((list (read-face-and-attribute :underline)))
- (list (car list) (eq (car (cdr list)) t))))
+ (interactive (read-face-and-attribute :underline))
(set-face-attribute face frame :underline underline))
-(define-obsolete-function-alias 'set-face-underline
- 'set-face-underline-p "22.1")
+(define-obsolete-function-alias 'set-face-underline-p
+ '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")
-(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)
(string-to-number new-value)))))
+;; 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
;; 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)'.
- (when (and (or (eq attribute :stipple)
- (eq attribute :box))
- (or (consp old-value)
- (vectorp old-value)))
- (setq old-value (prin1-to-string old-value)))
+ ;; 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))
;; 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.
- (when (and (or (eq attribute :stipple)
- (eq attribute :box))
- (stringp new-value)
- (string-match "^[[(]" new-value))
- (setq new-value (read new-value)))
+ (and (memq attribute '(:stipple :box :underline))
+ (stringp new-value)
+ (string-match "^[[(]" new-value)
+ (setq new-value (read new-value)))
new-value))
(declare-function fontset-list "fontset.c" ())
(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)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare-function x-parse-geometry "frame.c" (string))
+(defvar x-display-name)
(defun x-handle-named-frame-geometry (parameters)
"Add geometry parameters for a named frame to parameter list PARAMETERS.
:version "21.1"
:group 'mode-line-faces
:group 'basic-faces)
-;; No need to define aliases of this form for new faces.
-(define-obsolete-face-alias 'modeline 'mode-line "21.1")
(defface mode-line-inactive
'((default
:group 'menu
:group 'basic-faces)
-(defface help-argument-name '((((supports :slant italic)) :inherit italic))
+(defface help-argument-name '((t :inherit italic))
"Face to highlight argument names in *Help* buffers."
:group 'help)
(car fonts))
(cdr (assq 'font (frame-parameters (selected-frame))))))
+(defcustom font-list-limit 100
+ "This variable is obsolete and has no effect."
+ :type 'integer
+ :group 'display)
+(make-obsolete-variable 'font-list-limit nil "24.3")
+
(provide 'faces)
;;; faces.el ends here
HCoop / bpt / emacs.git / blobdiff