From: Chong Yidong Date: Sun, 25 Nov 2012 04:50:20 +0000 (+0800) Subject: Revamp face-spec-set to be more analogous to setq for faces. X-Git-Tag: emacs-24.3.90~173^2~13^2~5 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1c4f115d4c4eb1aa71c25d21e8bdec2f8da97700;p=emacs.git Revamp face-spec-set to be more analogous to setq for faces. * lisp/faces.el (face-spec-set): Change the third arg to specify whether this function is being called via defface, customize, or a third party. Set the appropriate symbol properties. Clear the override spec if setting via Custom. Initialize face if necessary. (face-spec-recalc): Allow theme faces to completely replace the defface spec, in the same way as custom faces (Bug#8454). * lisp/cus-edit.el (custom-face-set, custom-face-mark-to-save) (custom-face-reset-saved, custom-face-mark-to-reset-standard): Simplify by using the new arg to face-spec-set. * lisp/cus-face.el (custom-declare-face): Move face initialization to face-spec-set. (custom-theme-set-faces): Don't initialize the face name here, as that is now done in face-spec-set. * lisp/emacs-lisp/lisp-mode.el (eval-defun-1): When evaluating defface, reset face-override-spec too, and use custom-declare-face. Fixes: debbugs:4988 --- diff --git a/etc/NEWS b/etc/NEWS index 6c01d2ef607..d8f5a3d0d09 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -84,6 +84,16 @@ spurious warnings about an unused var. * Lisp changes in Emacs 24.4 +** Face changes + +*** The `face-spec-set' is now analogous to `setq' for face specs. +Its third arg now accepts values specifying exactly which face spec to +set (defface, custom, or user spec), and it directly sets the relevant +property using the supplied face spec. + +*** Face specs set via Custom themes now replace the `defface' spec +rather than inheriting from it (as do face specs set via Customize). + ** time-to-seconds is not obsolete any more. ** New function special-form-p. ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 37291cfa774..2e7e6c5be50 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,25 @@ +2012-11-25 Chong Yidong + + * faces.el: Make face-spec-set more analogous to setq. + (face-spec-set): Change the third arg to specify whether this + function is being called via defface, customize, or a third party. + Set the appropriate symbol properties. Clear the override spec if + setting via Custom. Initialize face if necessary. (Bug#4988) + (face-spec-recalc): Allow theme faces to completely replace the + defface spec, in the same way as custom faces (Bug#8454). + + * cus-face.el (custom-declare-face): Move face initialization to + face-spec-set. + (custom-theme-set-faces): Don't initialize the face name here, as + that is now done in face-spec-set. + + * cus-edit.el (custom-face-set, custom-face-mark-to-save) + (custom-face-reset-saved, custom-face-mark-to-reset-standard): + Simplify by using the new arg to face-spec-set. + + * emacs-lisp/lisp-mode.el (eval-defun-1): When evaluating defface, + reset face-override-spec too, and use custom-declare-face. + 2012-11-24 Jan Djärv * term/ns-win.el (ns-initialize-window-system): Move creation of diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 8e06b16bd12..69e694bd14e 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -3679,15 +3679,10 @@ Optional EVENT is the location for the menu." (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) - (put symbol 'customized-face value) (custom-push-theme 'theme-face symbol 'user 'set value) - (if (face-spec-choose value) - (face-spec-set symbol value t) - ;; face-set-spec ignores empty attribute lists, so just give it - ;; something harmless instead. - (face-spec-set symbol '((t :foreground unspecified)) t)) - (put symbol 'customized-face-comment comment) + (face-spec-set symbol value 'customized-face) (put symbol 'face-comment comment) + (put symbol 'customized-face-comment comment) (custom-face-state-set widget) (custom-redraw-magic widget))) @@ -3696,20 +3691,14 @@ Optional EVENT is the location for the menu." (let* ((symbol (widget-value widget)) (value (custom-face-widget-to-spec widget)) (comment-widget (widget-get widget :comment-widget)) - (comment (widget-value comment-widget))) + (comment (widget-value comment-widget)) + (standard (eq (widget-get widget :custom-state) 'standard))) (when (equal comment "") (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) (custom-push-theme 'theme-face symbol 'user 'set value) - (if (face-spec-choose value) - (face-spec-set symbol value t) - ;; face-set-spec ignores empty attribute lists, so just give it - ;; something harmless instead. - (face-spec-set symbol '((t :foreground unspecified)) t)) - (unless (eq (widget-get widget :custom-state) 'standard) - (put symbol 'saved-face value)) - (put symbol 'customized-face nil) + (face-spec-set symbol value (if standard 'reset 'saved-face)) (put symbol 'face-comment comment) (put symbol 'customized-face-comment nil) (put symbol 'saved-face-comment comment))) @@ -3738,13 +3727,12 @@ uncustomized (themed or standard) face." (saved-face (get face 'saved-face)) (comment (get face 'saved-face-comment)) (comment-widget (widget-get widget :comment-widget))) - (put face 'customized-face nil) - (put face 'customized-face-comment nil) (custom-push-theme 'theme-face face 'user (if saved-face 'set 'reset) saved-face) - (face-spec-set face saved-face t) + (face-spec-set face saved-face 'saved-face) (put face 'face-comment comment) + (put face 'customized-face-comment nil) (widget-value-set child saved-face) ;; This call manages the comment visibility (widget-value-set comment-widget (or comment "")) @@ -3764,11 +3752,10 @@ redraw the widget immediately." (comment-widget (widget-get widget :comment-widget))) (unless value (user-error "No standard setting for this face")) - (put symbol 'customized-face nil) - (put symbol 'customized-face-comment nil) (custom-push-theme 'theme-face symbol 'user 'reset) - (face-spec-set symbol value t) - (custom-theme-recalc-face symbol) + (face-spec-set symbol value 'reset) + (put symbol 'face-comment nil) + (put symbol 'customized-face-comment nil) (if (and custom-reset-standard-faces-list (or (get symbol 'saved-face) (get symbol 'saved-face-comment))) ;; Do this later. @@ -3784,7 +3771,6 @@ redraw the widget immediately." (put symbol 'saved-face nil) (put symbol 'saved-face-comment nil) (custom-save-all)) - (put symbol 'face-comment nil) (widget-value-set child (custom-pre-filter-face-spec (list (list t (custom-face-attributes-get diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 06fd10149d3..bf18c917cff 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -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. @@ -343,10 +322,7 @@ 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'. +created now. SPEC itself is saved in FACE property `saved-face' and it is stored in FACE's list property `theme-face' \(using `custom-push-theme')." @@ -371,15 +347,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 diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 64aac4b81db..bc61a24d9dc 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -847,21 +847,8 @@ Reinitialize the face according to the `defface' specification." (setq face-new-frame-defaults (assq-delete-all face-symbol face-new-frame-defaults)) (put face-symbol 'face-defface-spec nil) - (put face-symbol 'face-documentation (nth 3 form)) - ;; Setting `customized-face' to the new spec after calling - ;; the form, but preserving the old saved spec in `saved-face', - ;; imitates the situation when the new face spec is set - ;; temporarily for the current session in the customize - ;; buffer, thus allowing `face-user-default-spec' to use the - ;; new customized spec instead of the saved spec. - ;; Resetting `saved-face' temporarily to nil is needed to let - ;; `defface' change the spec, regardless of a saved spec. - (prog1 `(prog1 ,form - (put ,(nth 1 form) 'saved-face - ',(get face-symbol 'saved-face)) - (put ,(nth 1 form) 'customized-face - ,(nth 2 form))) - (put face-symbol 'saved-face nil)))) + (put face-symbol 'face-override-spec nil)) + form) ((eq (car form) 'progn) (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) (t form))) diff --git a/lisp/faces.el b/lisp/faces.el index 928174c3954..2a0b77b19c4 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1587,44 +1587,79 @@ If SPEC is nil, return nil." (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 valus. + (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."