X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b5188bcde8280375a922492f04a472ebeb4aa466..4532ac55a9f3f87863a4eb658845afa525fef410:/lisp/cus-face.el diff --git a/lisp/cus-face.el b/lisp/cus-face.el index f6b00ed17b..f1744cc9e6 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -1,10 +1,9 @@ ;;; cus-face.el --- customization support for faces ;; -;; Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces -;; Version: Emacs ;; This file is part of GNU Emacs. @@ -67,7 +66,7 @@ '((:family (string :tag "Font Family" :help-echo "Font family or fontset alias name.")) - + (:width (choice :tag "Width" :help-echo "Font width." @@ -87,7 +86,7 @@ (const :tag "ultracondensed" ultra-condensed) (const :tag "ultraexpanded" ultra-expanded) (const :tag "wide" extra-expanded))) - + (:height (choice :tag "Height" :help-echo "Face's font height." @@ -114,7 +113,7 @@ (const :tag "semilight" semi-light) (const :tag "ultralight" ultra-light) (const :tag "ultrabold" ultra-bold))) - + (:slant (choice :tag "Slant" :help-echo "Font slant." @@ -122,28 +121,28 @@ (const :tag "italic" italic) (const :tag "oblique" oblique) (const :tag "normal" normal))) - + (:underline (choice :tag "Underline" :help-echo "Control text underlining." (const :tag "Off" nil) (const :tag "On" t) (color :tag "Colored"))) - + (:overline (choice :tag "Overline" :help-echo "Control text overlining." (const :tag "Off" nil) (const :tag "On" t) (color :tag "Colored"))) - + (:strike-through (choice :tag "Strike-through" :help-echo "Control text strike-through." (const :tag "Off" nil) (const :tag "On" t) (color :tag "Colored"))) - + (:box ;; Fixme: this can probably be done better. (choice :tag "Box around text" @@ -191,21 +190,21 @@ (nconc (and lwidth `(:line-width ,lwidth)) (and color `(:color ,color)) (and style `(:style ,style))))))))) - + (:inverse-video (choice :tag "Inverse-video" :help-echo "Control whether text should be in inverse-video." (const :tag "Off" nil) (const :tag "On" t))) - + (:foreground (color :tag "Foreground" :help-echo "Set foreground color.")) - + (:background (color :tag "Background" :help-echo "Set background color.")) - + (:stipple (choice :tag "Stipple" :help-echo "Background bit-mask" @@ -231,7 +230,7 @@ (if (and (consp cus-value) (null (cdr cus-value))) (car cus-value) cus-value)))) - + "Alist of face attributes. The elements are of the form (KEY TYPE PRE-FILTER POST-FILTER), @@ -249,7 +248,6 @@ The POST-FILTER should also take a single argument, the value after being customized, and should return a value suitable for setting the given face attribute.") - (defun custom-face-attributes-get (face frame) "For FACE on FRAME, return an alternating list describing its attributes. The list has the form (KEYWORD VALUE KEYWORD VALUE...). @@ -272,36 +270,125 @@ If FRAME is nil, use the global defaults for FACE." ;;;###autoload (defun custom-set-faces (&rest args) "Initialize faces according to user preferences. +This associates the settings with the `user' theme. +The arguments should be a list where each entry has the form: + + (FACE SPEC [NOW [COMMENT]]) + +SPEC is stored as the saved value for FACE, as well as the value for the +`user' theme. The `user' theme is one of the default themes known to Emacs. +See `custom-known-themes' for more information on the known themes. +See `custom-theme-set-faces' for more information on the interplay +between themes and faces. +See `defface' for the format of SPEC. + +If NOW is present and non-nil, FACE is created now, according to SPEC. +COMMENT is a string comment about FACE." + (apply 'custom-theme-set-faces 'user args)) + +(defun custom-theme-set-faces (theme &rest args) + "Initialize faces for theme THEME. The arguments should be a list where each entry has the form: (FACE SPEC [NOW [COMMENT]]) -SPEC is stored as the saved value for FACE. +SPEC is stored as the saved value for FACE, as well as the value for the +`user' theme. The `user' theme is one of the default themes known to Emacs. +See `custom-known-themes' for more information on the known themes. +See `custom-theme-set-faces' for more information on the interplay +between themes and faces. +See `defface' for the format of SPEC. + If NOW is present and non-nil, FACE is created now, according to SPEC. COMMENT is a string comment about FACE. -See `defface' for the format of SPEC." - (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))) - (put face 'saved-face spec) - (put face 'saved-face-comment comment) - (when now - (put face 'force-face t)) - (when (or now (facep face)) - (put face 'face-comment comment) - (make-empty-face face) - (face-spec-set face spec)) +Several properties of THEME and FACE are used in the process: + +If THEME property `theme-immediate' is non-nil, this is equivalent of +providing the NOW argument to all faces in the argument list: FACE is +created now. The only difference is FACE property `force-face': if NOW +is non-nil, FACE property `force-face' is set to the symbol `rogue', else +if THEME property `theme-immediate' is non-nil, FACE property `force-face' +is set to the symbol `immediate'. + +SPEC itself is saved in FACE property `saved-face' and it is stored in +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))) + (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) + (face-spec-set face spec)) (setq args (cdr args))) ;; Old format, a plist of FACE SPEC pairs. (let ((face (nth 0 args)) (spec (nth 1 args))) - (put face 'saved-face spec)) - (setq args (cdr (cdr args))))))) + (put face 'saved-face spec) + (custom-push-theme 'theme-face face theme 'set spec)) + (setq args (cdr (cdr args)))))))) + +;;;###autoload +(defun custom-theme-face-value (face theme) + "Return spec of FACE in THEME if THEME modifies FACE. +Value is nil otherwise. The association between theme and spec for FACE +is stored in FACE's property `theme-face'. The appropriate face +is retrieved using `custom-theme-value'." + ;; Returns car because the value is stored inside a one element list + (car-safe (custom-theme-value theme (get face 'theme-face)))) + +(defun custom-theme-reset-internal-face (face to-theme) + "Reset FACE to the value defined by TO-THEME. +If FACE is not defined in TO-THEME, reset FACE to the standard +value. See `custom-theme-face-value'. The standard value is +stored in SYMBOL's property `face-defface-spec' by `defface'." + (let ((spec (custom-theme-face-value face to-theme)) + was-in-theme) + (setq was-in-theme spec) + (setq spec (or spec (get face 'face-defface-spec))) + (when spec + (put face 'save-face was-in-theme) + (when (or (get face 'force-face) (facep face)) + (unless (facep face) + (make-empty-face face)) + (face-spec-set face spec))) + spec)) + +;;;###autoload +(defun custom-theme-reset-faces (theme &rest args) + "Reset the value of the face to values previously defined. +Associate this setting with THEME. + +ARGS is a list of lists of the form + + (FACE TO-THEME) + +This means reset FACE to its value in TO-THEME." + (custom-check-theme theme) + (mapcar '(lambda (arg) + (apply 'custom-theme-reset-internal-face arg) + (custom-push-theme 'theme-face (car arg) theme 'reset (cadr arg))) + args)) + +;;;###autoload +(defun custom-reset-faces (&rest args) + "Reset the value of the face to values previously saved. +This is the setting assosiated the `user' theme. + +ARGS is defined as for `custom-theme-reset-faces'" + (apply 'custom-theme-reset-faces 'user args)) ;;; The End.