mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00: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
parent
61d841dd15
commit
1c4f115d4c
10
etc/NEWS
10
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'
|
||||
|
||||
@ -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>
|
||||
|
||||
* 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))
|
||||
(face-spec-set face (purecopy spec) 'face-defface-spec)
|
||||
(push (cons 'defface face) current-load-list)
|
||||
(when (and doc (null (face-documentation face)))
|
||||
(when doc
|
||||
(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))))
|
||||
(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.
|
||||
(defun face-spec-set (face spec &optional spec-type)
|
||||
"Set the face spec SPEC for 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 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 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.
|
||||
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)))
|
||||
(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."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user