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.
* 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'
......
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>
* term/ns-win.el (ns-initialize-window-system): Move creation of
......
......@@ -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
......
......@@ -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
......
......@@ -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)))
......
......@@ -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."
......
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