;;; cus-face.el --- customization support for faces
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
(defun custom-declare-face (face spec doc &rest args)
"Like `defface', but FACE is evaluated as a normal argument."
(unless (get face 'face-defface-spec)
- (when (fboundp 'facep)
- (unless (facep face)
+ (let ((facep (facep face)))
+ (unless facep
;; If the user has already created the face, respect that.
(let ((value (or (get face 'saved-face) spec))
(have-window-system (memq initial-window-system '(x w32))))
(setq have-window-system t)))
;; When making a face after frames already exist
(if have-window-system
- (make-face-x-resource-internal face)))))
- ;; Don't record SPEC until we see it causes no errors.
- (put face 'face-defface-spec (purecopy spec))
- (push (cons 'defface face) current-load-list)
- (when (and doc (null (face-documentation face)))
- (set-face-documentation face (purecopy doc)))
- (custom-handle-all-keywords face args 'custom-face)
- (run-hooks 'custom-define-hook))
+ (make-face-x-resource-internal face))))
+ ;; Don't record SPEC until we see it causes no errors.
+ (put face 'face-defface-spec (purecopy spec))
+ (push (cons 'defface face) current-load-list)
+ (when (and doc (null (face-documentation face)))
+ (set-face-documentation face (purecopy doc)))
+ (custom-handle-all-keywords face args 'custom-face)
+ (run-hooks 'custom-define-hook)
+ ;; If the face had existing settings, recalculate it. For
+ ;; example, the user might load a theme with a face setting, and
+ ;; later load a library defining that face.
+ (if facep
+ (custom-theme-recalc-face face))))
face)
;;; Face attributes.
(choice :tag "Underline"
:help-echo "Control text underlining."
(const :tag "Off" nil)
- (const :tag "On" t)
- (color :tag "Colored")))
+ (list :tag "On"
+ (const :format "" :value :color)
+ (choice :tag "Color" (const :tag "Foreground Color" foreground-color) color)
+ (const :format "" :value :style)
+ (choice :tag "Style"
+ (const :tag "Line" line)
+ (const :tag "Wave" wave)))))
(:overline
(choice :tag "Overline"
FACE's list property `theme-face' \(using `custom-push-theme')."
(custom-check-theme theme)
(let ((immediate (get theme 'theme-immediate)))
- (while args
- (let ((entry (car args)))
- (if (listp entry)
- (let ((face (nth 0 entry))
- (spec (nth 1 entry))
- (now (nth 2 entry))
- (comment (nth 3 entry))
- oldspec)
- ;; If FACE is actually an alias, customize the face it
- ;; is aliased to.
- (if (get face 'face-alias)
- (setq face (get face 'face-alias)))
-
- (setq oldspec (get face 'theme-face))
- (when (not (and oldspec (eq 'user (caar oldspec))))
- (put face 'saved-face spec)
- (put face 'saved-face-comment comment))
-
- (custom-push-theme 'theme-face face theme 'set spec)
- (when (or now immediate)
- (put face 'force-face (if now 'rogue 'immediate)))
- (when (or now immediate (facep face))
- (unless (facep face)
- (make-empty-face face))
- (put face 'face-comment comment)
- (put face 'face-override-spec nil)
- (face-spec-set face spec t))
- (setq args (cdr args)))
- ;; Old format, a plist of FACE SPEC pairs.
- (let ((face (nth 0 args))
- (spec (nth 1 args)))
- (if (get face 'face-alias)
- (setq face (get face 'face-alias)))
- (put face 'saved-face spec)
- (custom-push-theme 'theme-face face theme 'set spec))
- (setq args (cdr (cdr args))))))))
-
-;; XEmacs compability function. In XEmacs, when you reset a Custom
+ (dolist (entry args)
+ (unless (listp entry)
+ (error "Incompatible Custom theme spec"))
+ (let ((face (car entry))
+ (spec (nth 1 entry)))
+ ;; If FACE is actually an alias, customize the face it
+ ;; is aliased to.
+ (if (get face 'face-alias)
+ (setq face (get face 'face-alias)))
+ (if custom--inhibit-theme-enable
+ ;; Just update theme settings.
+ (custom-push-theme 'theme-face face theme 'set spec)
+ ;; Update theme settings and set the face spec.
+ (let ((now (nth 2 entry))
+ (comment (nth 3 entry))
+ (oldspec (get face 'theme-face)))
+ (when (not (and oldspec (eq 'user (caar oldspec))))
+ (put face 'saved-face spec)
+ (put face 'saved-face-comment comment))
+ ;; Do this AFTER checking the `theme-face' property.
+ (custom-push-theme 'theme-face face theme 'set spec)
+ (when (or now immediate)
+ (put face 'force-face (if now 'rogue 'immediate)))
+ (when (or now immediate (facep face))
+ (unless (facep face)
+ (make-empty-face face))
+ (put face 'face-comment comment)
+ (put face 'face-override-spec nil)
+ (face-spec-set face spec t))))))))
+
+;; XEmacs compatibility function. In XEmacs, when you reset a Custom
;; Theme, you have to specify the theme to reset it to. We just apply
;; the next theme.
(defun custom-theme-reset-faces (theme &rest args)
(provide 'cus-face)
-;; arch-tag: 9a5c4b63-0d27-4c92-a5af-f2c7ed764c2b
;;; cus-face.el ends here
HCoop / bpt / emacs.git / blobdiff