X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/678fb7066698ebfe3aecba722294025ed26da01b..refs/heads/wip:/lisp/cus-face.el diff --git a/lisp/cus-face.el b/lisp/cus-face.el index d725111b6f..a9e6f3f5b5 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -1,6 +1,6 @@ ;;; cus-face.el --- customization support for faces ;; -;; Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc. +;; Copyright (C) 1996-1997, 1999-2014 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces @@ -32,35 +32,14 @@ ;;; Declaring a face. (defun custom-declare-face (face spec doc &rest args) - "Like `defface', but FACE is evaluated as a normal argument." + "Like `defface', but with FACE evaluated as a normal argument." (unless (get face 'face-defface-spec) - (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)))) - ;; Create global face. - (make-empty-face face) - ;; Create frame-local faces - (dolist (frame (frame-list)) - (face-spec-set-2 face frame value) - (when (memq (window-system frame) '(x w32 ns)) - (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) - ;; 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-spec-set face (purecopy spec) 'face-defface-spec) + (push (cons 'defface face) current-load-list) + (when doc + (set-face-documentation face (purecopy doc))) + (custom-handle-all-keywords face args 'custom-face) + (run-hooks 'custom-define-hook)) face) ;;; Face attributes. @@ -135,8 +114,37 @@ (choice :tag "Underline" :help-echo "Control text underlining." (const :tag "Off" nil) - (const :tag "On" t) - (color :tag "Colored"))) + (list :tag "On" + :value (:color foreground-color :style line) + (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)))) + ;; filter to make value suitable for customize + (lambda (real-value) + (and real-value + (let ((color + (or (and (consp real-value) (plist-get real-value :color)) + (and (stringp real-value) real-value) + 'foreground-color)) + (style + (or (and (consp real-value) (plist-get real-value :style)) + 'line))) + (list :color color :style style)))) + ;; filter to make customized-value suitable for storing + (lambda (cus-value) + (and cus-value + (let ((color (plist-get cus-value :color)) + (style (plist-get cus-value :style))) + (cond ((eq style 'line) + ;; Use simple value for default style + (if (eq color 'foreground-color) t color)) + (t + `(:color ,color :style ,style))))))) (:overline (choice :tag "Overline" @@ -210,6 +218,10 @@ (color :tag "Foreground" :help-echo "Set foreground color (name or #RRGGBB hex spec).")) + (:distant-foreground + (color :tag "Distant Foreground" + :help-echo "Set distant foreground color (name or #RRGGBB hex spec).")) + (:background (color :tag "Background" :help-echo "Set background color (name or #RRGGBB hex spec).")) @@ -277,50 +289,48 @@ If FRAME is nil, use the global defaults for FACE." ;;; Initializing. (defun custom-set-faces (&rest args) - "Initialize faces according to user preferences. -This associates the settings with the `user' theme. + "Apply a list of face specs for user customizations. +This works by calling `custom-theme-set-faces' for the `user' +theme, a special theme referring to settings made via Customize. 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." +See the documentation of `custom-theme-set-faces' for details." (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: + "Apply a list of face specs associated with theme THEME. +THEME should be a theme name (a symbol). The special theme named +`user' refers to user settings applied via Customize. + +The remaining ARGS should be a list where each entry is a list of +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. +FACE should be a face name (a symbol). If FACE is a face alias, +the setting refers to the parent face. -If NOW is present and non-nil, FACE is created now, according to SPEC. -COMMENT is a string comment about FACE. +SPEC should be a face spec. For details, see `defface'. -Several properties of THEME and FACE are used in the process: +NOW, if present and non-nil, forces the face settings to take +immediate effect in the Emacs display; in particular, FACE is +initialized as a face if it is not yet one. If NOW is omitted or +nil, the caller is responsible for making the settings take +effect later, by calling `custom-theme-recalc-face' or +`face-spec-recalc'. + +COMMENT is a string comment about FACE. -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'. +This function works by calling `custom-push-theme' to record each +SPEC in each FACE's `theme-face' property, and in THEME's +`theme-settings' property. If FACE has not already been +customized, it also stores SPEC in the `saved-face' property. -SPEC itself is saved in FACE property `saved-face' and it is stored in -FACE's list property `theme-face' \(using `custom-push-theme')." +If THEME has a non-nil `theme-immediate' property, this is +equivalent to providing the NOW argument to all faces in the +argument list." (custom-check-theme theme) (let ((immediate (get theme 'theme-immediate))) (dolist (entry args) @@ -342,15 +352,11 @@ FACE's list property `theme-face' \(using `custom-push-theme')." (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