Commit 1c4f115d authored by Chong Yidong's avatar Chong Yidong
Browse files

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
parent 61d841dd
...@@ -84,6 +84,16 @@ spurious warnings about an unused var. ...@@ -84,6 +84,16 @@ spurious warnings about an unused var.
* Lisp changes in Emacs 24.4 * 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. ** time-to-seconds is not obsolete any more.
** New function special-form-p. ** New function special-form-p.
** Docstrings can be made dynamic by adding a `dynamic-docstring-function' ** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
......
2012-11-25 Chong Yidong <cyd@gnu.org>
* 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 <jan.h.d@swipnet.se> 2012-11-24 Jan Djärv <jan.h.d@swipnet.se>
   
* term/ns-win.el (ns-initialize-window-system): Move creation of * term/ns-win.el (ns-initialize-window-system): Move creation of
......
...@@ -3679,15 +3679,10 @@ Optional EVENT is the location for the menu." ...@@ -3679,15 +3679,10 @@ Optional EVENT is the location for the menu."
(setq comment nil) (setq comment nil)
;; Make the comment invisible by hand if it's empty ;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget)) (custom-comment-hide comment-widget))
(put symbol 'customized-face value)
(custom-push-theme 'theme-face symbol 'user 'set value) (custom-push-theme 'theme-face symbol 'user 'set value)
(if (face-spec-choose value) (face-spec-set symbol value 'customized-face)
(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)
(put symbol 'face-comment comment) (put symbol 'face-comment comment)
(put symbol 'customized-face-comment comment)
(custom-face-state-set widget) (custom-face-state-set widget)
(custom-redraw-magic widget))) (custom-redraw-magic widget)))
...@@ -3696,20 +3691,14 @@ Optional EVENT is the location for the menu." ...@@ -3696,20 +3691,14 @@ Optional EVENT is the location for the menu."
(let* ((symbol (widget-value widget)) (let* ((symbol (widget-value widget))
(value (custom-face-widget-to-spec widget)) (value (custom-face-widget-to-spec widget))
(comment-widget (widget-get widget :comment-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 "") (when (equal comment "")
(setq comment nil) (setq comment nil)
;; Make the comment invisible by hand if it's empty ;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget)) (custom-comment-hide comment-widget))
(custom-push-theme 'theme-face symbol 'user 'set value) (custom-push-theme 'theme-face symbol 'user 'set value)
(if (face-spec-choose value) (face-spec-set symbol value (if standard 'reset 'saved-face))
(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)
(put symbol 'face-comment comment) (put symbol 'face-comment comment)
(put symbol 'customized-face-comment nil) (put symbol 'customized-face-comment nil)
(put symbol 'saved-face-comment comment))) (put symbol 'saved-face-comment comment)))
...@@ -3738,13 +3727,12 @@ uncustomized (themed or standard) face." ...@@ -3738,13 +3727,12 @@ uncustomized (themed or standard) face."
(saved-face (get face 'saved-face)) (saved-face (get face 'saved-face))
(comment (get face 'saved-face-comment)) (comment (get face 'saved-face-comment))
(comment-widget (widget-get widget :comment-widget))) (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 (custom-push-theme 'theme-face face 'user
(if saved-face 'set 'reset) (if saved-face 'set 'reset)
saved-face) saved-face)
(face-spec-set face saved-face t) (face-spec-set face saved-face 'saved-face)
(put face 'face-comment comment) (put face 'face-comment comment)
(put face 'customized-face-comment nil)
(widget-value-set child saved-face) (widget-value-set child saved-face)
;; This call manages the comment visibility ;; This call manages the comment visibility
(widget-value-set comment-widget (or comment "")) (widget-value-set comment-widget (or comment ""))
...@@ -3764,11 +3752,10 @@ redraw the widget immediately." ...@@ -3764,11 +3752,10 @@ redraw the widget immediately."
(comment-widget (widget-get widget :comment-widget))) (comment-widget (widget-get widget :comment-widget)))
(unless value (unless value
(user-error "No standard setting for this face")) (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) (custom-push-theme 'theme-face symbol 'user 'reset)
(face-spec-set symbol value t) (face-spec-set symbol value 'reset)
(custom-theme-recalc-face symbol) (put symbol 'face-comment nil)
(put symbol 'customized-face-comment nil)
(if (and custom-reset-standard-faces-list (if (and custom-reset-standard-faces-list
(or (get symbol 'saved-face) (get symbol 'saved-face-comment))) (or (get symbol 'saved-face) (get symbol 'saved-face-comment)))
;; Do this later. ;; Do this later.
...@@ -3784,7 +3771,6 @@ redraw the widget immediately." ...@@ -3784,7 +3771,6 @@ redraw the widget immediately."
(put symbol 'saved-face nil) (put symbol 'saved-face nil)
(put symbol 'saved-face-comment nil) (put symbol 'saved-face-comment nil)
(custom-save-all)) (custom-save-all))
(put symbol 'face-comment nil)
(widget-value-set child (widget-value-set child
(custom-pre-filter-face-spec (custom-pre-filter-face-spec
(list (list t (custom-face-attributes-get (list (list t (custom-face-attributes-get
......
...@@ -32,35 +32,14 @@ ...@@ -32,35 +32,14 @@
;;; Declaring a face. ;;; Declaring a face.
(defun custom-declare-face (face spec doc &rest args) (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) (unless (get face 'face-defface-spec)
(let ((facep (facep face))) (face-spec-set face (purecopy spec) 'face-defface-spec)
(unless facep (push (cons 'defface face) current-load-list)
;; If the user has already created the face, respect that. (when doc
(let ((value (or (get face 'saved-face) spec)) (set-face-documentation face (purecopy doc)))
(have-window-system (memq initial-window-system '(x w32)))) (custom-handle-all-keywords face args 'custom-face)
;; Create global face. (run-hooks 'custom-define-hook))
(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) face)
;;; Face attributes. ;;; Face attributes.
...@@ -343,10 +322,7 @@ Several properties of THEME and FACE are used in the process: ...@@ -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 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 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 created 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 SPEC itself is saved in FACE property `saved-face' and it is stored in
FACE's list property `theme-face' \(using `custom-push-theme')." FACE's list property `theme-face' \(using `custom-push-theme')."
...@@ -371,15 +347,11 @@ 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)))) (when (not (and oldspec (eq 'user (caar oldspec))))
(put face 'saved-face spec) (put face 'saved-face spec)
(put face 'saved-face-comment comment)) (put face 'saved-face-comment comment))
;; Do this AFTER checking the `theme-face' property.
(custom-push-theme 'theme-face face theme 'set spec) (custom-push-theme 'theme-face face theme 'set spec)
(when (or now immediate) (when (or now immediate)
(put face 'force-face (if now 'rogue 'immediate))) (put face 'force-face (if now 'rogue 'immediate)))
(when (or now immediate (facep face)) (when (or now immediate (facep face))
(unless (facep face)
(make-empty-face face))
(put face 'face-comment comment) (put face 'face-comment comment)
(put face 'face-override-spec nil)
(face-spec-set face spec t)))))))) (face-spec-set face spec t))))))))
;; XEmacs compatibility function. In XEmacs, when you reset a Custom ;; XEmacs compatibility function. In XEmacs, when you reset a Custom
......
...@@ -847,21 +847,8 @@ Reinitialize the face according to the `defface' specification." ...@@ -847,21 +847,8 @@ Reinitialize the face according to the `defface' specification."
(setq face-new-frame-defaults (setq face-new-frame-defaults
(assq-delete-all face-symbol face-new-frame-defaults)) (assq-delete-all face-symbol face-new-frame-defaults))
(put face-symbol 'face-defface-spec nil) (put face-symbol 'face-defface-spec nil)
(put face-symbol 'face-documentation (nth 3 form)) (put face-symbol 'face-override-spec nil))
;; Setting `customized-face' to the new spec after calling form)
;; 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))))
((eq (car form) 'progn) ((eq (car form) 'progn)
(cons 'progn (mapcar 'eval-defun-1 (cdr form)))) (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
(t form))) (t form)))
......
...@@ -1587,44 +1587,79 @@ If SPEC is nil, return nil." ...@@ -1587,44 +1587,79 @@ If SPEC is nil, return nil."
(mapcar (lambda (x) (list (car x) 'unspecified)) (mapcar (lambda (x) (list (car x) 'unspecified))
face-attribute-name-alist))))) face-attribute-name-alist)))))
(defun face-spec-set (face spec &optional for-defface) (defun face-spec-set (face spec &optional spec-type)
"Set and apply the face spec for FACE. "Set the face spec SPEC for FACE.
If the optional argument FOR-DEFFACE is omitted or nil, set the See `defface' for the format of SPEC.
overriding spec to SPEC, recording it in the `face-override-spec'
property of 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
If FOR-DEFFACE is non-nil, set the base spec (the one set by set via `set-face-attribute').
`defface' and Custom). In this case, SPEC is ignored; the caller
is responsible for putting the face spec in the `saved-face', The argument SPEC-TYPE determines which spec to set:
`customized-face', or `face-defface-spec', as appropriate. nil or `face-override-spec' means the override spec (which is
usually what you want if calling this function outside of
The appearance of FACE is controlled by the base spec, by any Custom code);
custom theme specs on top of that, and by the overriding spec on `customized-face' or `saved-face' means the customized spec or
top of all the rest." the saved custom spec;
(if for-defface `face-defface-spec' means the default spec
;; When we reset the face based on its custom spec, then it is (usually set only via `defface');
;; unmodified as far as Custom is concerned. `reset' means to ignore SPEC, but clear the `customized-face'
(put (or (get face 'face-alias) face) 'face-modified nil) and `face-override-spec' specs;
;; When we change a face based on a spec from outside custom, Any other value means not to set any spec, but to run the
;; record it for future frames. function for its other effects.
(put (or (get face 'face-alias) face) 'face-override-spec spec))
;; Reset each frame according to the rules implied by all its specs. In addition to setting the face spec, this function defines FACE
(dolist (frame (frame-list)) as a valid face name if it is not already one, and (re)calculates
(face-spec-recalc face frame))) 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) (defun face-spec-recalc (face frame)
"Reset the face attributes of FACE on FRAME according to its specs. "Reset the face attributes of FACE on FRAME according to its specs.
This applies the defface/custom spec first, then the custom theme specs, This applies the defface/custom spec first, then the custom theme specs,
then the override spec." then the override spec."
(while (get face 'face-alias)
(setq face (get face 'face-alias)))
(face-spec-reset-face face frame) (face-spec-reset-face face frame)
(let ((face-sym (or (get face 'face-alias) face))) ;; If FACE is customized or themed, set the custom spec from
(or (get face 'customized-face) ;; `theme-face' records, which completely replace the defface spec
(get face 'saved-face) ;; rather than inheriting from it.
(face-spec-set-2 face frame (face-default-spec face))) (let ((theme-faces (get face 'theme-face)))
(let ((theme-faces (reverse (get face-sym 'theme-face)))) (if theme-faces
(dolist (spec theme-faces) (dolist (spec (reverse theme-faces))
(face-spec-set-2 face frame (cadr spec)))) (face-spec-set-2 face frame (cadr spec)))
(face-spec-set-2 face frame (get face-sym 'face-override-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) (defun face-spec-set-2 (face frame spec)
"Set the face attributes of FACE on FRAME according to SPEC." "Set the face attributes of FACE on FRAME according to SPEC."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment