[Emacs-diffs] /srv/bzr/emacs/trunk r111005: Revamp face-spec-set to be more analogous to setq for faces.

[Chong Yidong]

------------------------------------------------------------
revno: 111005
fixes bug: http://debbugs.gnu.org/4988
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sun 2012-11-25 12:50:20 +0800
message:
  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.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/cus-edit.el
  lisp/cus-face.el
  lisp/emacs-lisp/lisp-mode.el
  lisp/faces.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2012-11-24 16:58:43 +0000
+++ b/etc/NEWS  2012-11-25 04:50:20 +0000
@@ -84,6 +84,16 @@
 
 * 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'

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-11-24 17:55:48 +0000
+++ b/lisp/ChangeLog    2012-11-25 04:50:20 +0000
@@ -1,3 +1,25 @@
+2012-11-25  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * term/ns-win.el (ns-initialize-window-system): Move creation of

=== modified file 'lisp/cus-edit.el'
--- a/lisp/cus-edit.el  2012-09-25 04:13:02 +0000
+++ b/lisp/cus-edit.el  2012-11-25 04:50:20 +0000
@@ -3679,15 +3679,10 @@
       (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))
+    (face-spec-set symbol value 'customized-face)
+    (put symbol 'face-comment comment)
     (put symbol 'customized-face-comment comment)
-    (put symbol 'face-comment comment)
     (custom-face-state-set widget)
     (custom-redraw-magic widget)))
 
@@ -3696,20 +3691,14 @@
   (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 @@
         (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 @@
         (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 @@
        (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

=== modified file 'lisp/cus-face.el'
--- a/lisp/cus-face.el  2012-08-21 21:41:35 +0000
+++ b/lisp/cus-face.el  2012-11-25 04:50:20 +0000
@@ -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 @@
 
 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 @@
            (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

=== modified file 'lisp/emacs-lisp/lisp-mode.el'
--- a/lisp/emacs-lisp/lisp-mode.el      2012-09-10 01:16:13 +0000
+++ b/lisp/emacs-lisp/lisp-mode.el      2012-11-25 04:50:20 +0000
@@ -847,21 +847,8 @@
           (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)))

=== modified file 'lisp/faces.el'
--- a/lisp/faces.el     2012-11-24 01:57:09 +0000
+++ b/lisp/faces.el     2012-11-25 04:50:20 +0000
@@ -1587,44 +1587,79 @@
                  (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."