1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 18:40:39 -08:00

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
This commit is contained in:
Chong Yidong 2012-11-25 12:50:20 +08:00
parent 61d841dd15
commit 1c4f115d4c
6 changed files with 117 additions and 105 deletions

View file

@ -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'

View file

@ -1,3 +1,25 @@
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

View file

@ -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."
(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."
(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."
(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."
(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

View file

@ -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
;; 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) (push (cons 'defface face) current-load-list)
(when (and doc (null (face-documentation face))) (when doc
(set-face-documentation face (purecopy doc))) (set-face-documentation face (purecopy doc)))
(custom-handle-all-keywords face args 'custom-face) (custom-handle-all-keywords face args 'custom-face)
(run-hooks 'custom-define-hook) (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:
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')."
(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

View file

@ -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)))

View file

@ -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.
If FOR-DEFFACE is non-nil, set the base spec (the one set by The appearance of each face is controlled by its spec, and by the
`defface' and Custom). In this case, SPEC is ignored; the caller internal face attributes (which can be frame-specific and can be
is responsible for putting the face spec in the `saved-face', set via `set-face-attribute').
`customized-face', or `face-defface-spec', as appropriate.
The appearance of FACE is controlled by the base spec, by any The argument SPEC-TYPE determines which spec to set:
custom theme specs on top of that, and by the overriding spec on nil or `face-override-spec' means the override spec (which is
top of all the rest." usually what you want if calling this function outside of
(if for-defface Custom code);
;; When we reset the face based on its custom spec, then it is `customized-face' or `saved-face' means the customized spec or
;; unmodified as far as Custom is concerned. the saved custom spec;
(put (or (get face 'face-alias) face) 'face-modified nil) `face-defface-spec' means the default spec
;; When we change a face based on a spec from outside custom, (usually set only via `defface');
;; record it for future frames. `reset' means to ignore SPEC, but clear the `customized-face'
(put (or (get face 'face-alias) face) 'face-override-spec spec)) and `face-override-spec' specs;
;; Reset each frame according to the rules implied by all its 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)) (dolist (frame (frame-list))
(face-spec-recalc face frame))) (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."