-;;; Face Utilities.
-
-(and (fboundp 'make-face)
- (make-face 'custom-face-empty))
-
-(defun custom-face-display-set (face spec &optional frame)
- "Set FACE to the attributes to the first matching entry in SPEC.
-Iff optional FRAME is non-nil, set it for that frame only.
-See `defface' for information about SPEC."
- (when (fboundp 'copy-face)
- (copy-face 'custom-face-empty face)
- (while spec
- (let* ((entry (car spec))
- (display (nth 0 entry))
- (atts (nth 1 entry)))
- (setq spec (cdr spec))
- (when (custom-display-match-frame display frame)
- (apply 'custom-face-attribites-set face frame atts)
- (setq spec nil))))))
-
-(defcustom custom-background-mode nil
- "The brightness of the background.
-Set this to the symbol dark if your background color is dark, light if
-your background is light, or nil (default) if you want Emacs to
-examine the brightness for you."
- :group 'customize
- :type '(choice (choice-item dark)
- (choice-item light)
- (choice-item :tag "default" nil)))
-
-(defun custom-display-match-frame (display frame)
- "Non-nil iff DISPLAY matches FRAME.
-If FRAME is nil, the current FRAME is used."
- ;; This is a kludge to get started, we really should use specifiers!
- (unless frame
- (setq frame (selected-frame)))
- (if (eq display t)
- t
- (let ((match t))
- (while (and display match)
- (let* ((entry (car display))
- (req (car entry))
- (options (cdr entry)))
- (setq display (cdr display))
- (cond ((eq req 'type)
- (let ((type (if (fboundp 'device-type)
- (device-type (frame-device frame))
- window-system)))
- (setq match (memq type options))))
- ((eq req 'class)
- (let ((class (if (fboundp 'device-class)
- (device-class (frame-device frame))
- (frame-property frame 'display-type))))
- (setq match (memq class options))))
- ((eq req 'background)
- (let ((background (or custom-background-mode
- (frame-property frame 'background-mode)
- (custom-background-mode))))
- (setq match (memq background options))))
- (t
- (error "Unknown req `%S' with options `%S'" req options)))))
- match)))
-
-(defconst custom-face-attributes
- '((:bold (toggle :format "Bold: %v") custom-set-face-bold)
- (:italic (toggle :format "Italic: %v") custom-set-face-italic)
- (:underline
- (toggle :format "Underline: %v") set-face-underline-p)
- (:foreground (color :tag "Foreground") set-face-foreground)
- (:background (color :tag "Background") set-face-background)
- (:stipple (editable-field :format "Stipple: %v") set-face-stipple))
- "Alist of face attributes.
-
-The elements are of the form (KEY TYPE SET) where KEY is a symbol
-identifying the attribute, TYPE is a widget type for editing the
-attibute, SET is a function for setting the attribute value.
-
-The SET function should take three arguments, the face to modify, the
-value of the attribute, and optionally the frame where the face should
-be changed.")
-
-(when (string-match "XEmacs" emacs-version)
- ;; Support for special XEmacs font attributes.
- (require 'font)
-
- (unless (fboundp 'face-font-name)
- (defun face-font-name (face &rest args)
- (apply 'face-font face args)))
-
- (defun set-face-font-size (face size &rest args)
- "Set the font of FACE to SIZE"
- (let* ((font (apply 'face-font-name face args))
- (fontobj (font-create-object font)))
- (set-font-size fontobj size)
- (apply 'set-face-font face fontobj args)))
-
- (defun set-face-font-family (face family &rest args)
- "Set the font of FACE to FAMILY"
- (let* ((font (apply 'face-font-name face args))
- (fontobj (font-create-object font)))
- (set-font-family fontobj family)
- (apply 'set-face-font face fontobj args)))
-
- (nconc custom-face-attributes
- '((:family (editable-field :format "Family: %v")
- set-face-font-family)
- (:size (editable-field :format "Size: %v")
- set-face-font-size))))
-
-(defun custom-face-attribites-set (face frame &rest atts)
- "For FACE on FRAME set the attributes [KEYWORD VALUE]....
-Each keyword should be listed in `custom-face-attributes'.
-
-If FRAME is nil, set the default face."
- (while atts
- (let* ((name (nth 0 atts))
- (value (nth 1 atts))
- (fun (nth 2 (assq name custom-face-attributes))))
- (setq atts (cdr (cdr atts)))
- (condition-case nil
- (funcall fun face value)
- (error nil)))))
-
-(defun custom-set-face-bold (face value &optional frame)
- "Set the bold property of FACE to VALUE."
- (if value
- (make-face-bold face frame)
- (make-face-unbold face frame)))
-
-(defun custom-set-face-italic (face value &optional frame)
- "Set the italic property of FACE to VALUE."
- (if value
- (make-face-italic face frame)
- (make-face-unitalic face frame)))
-
-;;;###autoload
-(defun custom-initialize-faces (&optional frame)
- "Initialize all custom faces for FRAME.
-If FRAME is nil or omitted, initialize them for all frames."
- (mapatoms (lambda (symbol)
- (let ((spec (or (get symbol 'saved-face)
- (get symbol 'factory-face))))
- (when spec
- (custom-face-display-set symbol spec frame))))))
-