(face-spec-set): Third arg is now FOR-DEFFACE.

Use of frame as third arg is deprecated.
Handle `face-override-spec' property.
(face-spec-recalc): New function.
(face-spec-set-2): New function.
(frame-set-background-mode): Handle `face-override-spec' property.
Use `face-spec-recalc'.
(face-set-after-frame-default): Use `face-spec-recalc'.

1 files changed, 77 insertions, 42 deletions

diff --git a/lisp/faces.el b/lisp/faces.el
index 925b76844e..74d1a4e4f2 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1445,46 +1445,79 @@ If SPEC is nil, return nil."
       (setq attrs (cdr attrs)))))
 
 
-(defun face-spec-set (face spec &optional frame)
-  "Set FACE's attributes according to the first matching entry in SPEC.
-FRAME is the frame whose frame-local face is set.  FRAME nil means
-do it on all frames (and change the default for new frames).
-See `defface' for information about SPEC.  If SPEC is nil, do nothing."
-  (let ((attrs (face-spec-choose spec frame)))
-    (when spec
-      (face-spec-reset-face face (or frame t)))
-    (while attrs
-      (let ((attribute (car attrs))
-	    (value (car (cdr attrs))))
-	;; Support some old-style attribute names and values.
-	(case attribute
-	      (:bold (setq attribute :weight value (if value 'bold 'normal)))
-	      (:italic (setq attribute :slant value (if value 'italic 'normal)))
-	      ((:foreground :background)
-	       ;; Compatibility with 20.x.  Some bogus face specs seem to
-	       ;; exist containing things like `:foreground nil'.
-	       (if (null value) (setq value 'unspecified)))
-	      (t (unless (assq attribute face-x-resources)
-		   (setq attribute nil))))
-	(when attribute
-	  ;; If frame is nil, set the default for new frames.
-	  ;; Existing frames are handled below.
-	  (set-face-attribute face (or frame t) attribute value)))
-      (setq attrs (cdr (cdr attrs)))))
-  (unless frame
-    ;; When we reset the face based on its spec, then it is unmodified
-    ;; as far as Custom is concerned.
-    (put (or (get face 'face-alias) face) 'face-modified nil)
-;;;     ;; Clear all the new-frame defaults for this face.
+(defun face-spec-set (face spec &optional for-defface)
+  "Set FACE's face spec, which controls its appearance, to SPEC>
+If FOR-DEFFACE is t, set the base spec, the one that `defface'
+  and Custom set.  (In that case, the caller must put it in the
+  appropriate property, because that depends on the caller.)
+If FOR-DEFFACE is nil, set the overriding spec (and store it
+  in the `face-override-spec' property of FACE).
+
+The appearance of FACE is controlled by the base spec,
+by any custom theme specs on top of that, and by the
+the overriding spec on top of all the rest.
+
+FOR-DEFFACE can also be a frame, in which case we set the
+frame-specific attributes of FACE for that frame based on SPEC.
+That usage is deprecated.
+
+See `defface' for information about the format and meaning of SPEC."
+  (if (framep for-defface)
+      ;; Handle the deprecated case where third arg is a frame.
+      (face-spec-set-2 face for-defface spec)
+    (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))
+;;; RMS 29 dec 2007: Perhaps this code should be reinstated.
+;;; That depends on whether the overriding spec
+;;; or the default face attributes
+;;; should take priority.
+;;;     ;; Clear all the new-frame default attributes for this face.
 ;;;     ;; face-spec-reset-face won't do it right.
 ;;;     (let ((facevec (cdr (assq face face-new-frame-defaults))))
 ;;;       (dotimes (i (length facevec))
 ;;; 	(unless (= i 0)
 ;;; 	  (aset facevec i 'unspecified))))
-    ;; Set each frame according to the rules implied by SPEC.
+    ;; Reset each frame according to the rules implied by all its specs.
     (dolist (frame (frame-list))
-      (face-spec-set face spec frame))))
-
+      (face-spec-recalc face frame))))
+
+(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."
+  (face-spec-reset-face face frame)
+  (let ((face-sym (or (get face 'face-alias) face)))
+    (face-spec-set-2 face frame
+		     (face-user-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))))
+
+(defun face-spec-set-2 (face frame spec)
+  "Set the face attributes of FACE on FRAME according to SPEC."
+  (let* ((attrs (face-spec-choose spec frame)))
+    (while attrs
+      (let ((attribute (car attrs))
+	    (value (car (cdr attrs))))
+	;; Support some old-style attribute names and values.
+	(case attribute
+	  (:bold (setq attribute :weight value (if value 'bold 'normal)))
+	  (:italic (setq attribute :slant value (if value 'italic 'normal)))
+	  ((:foreground :background)
+	   ;; Compatibility with 20.x.  Some bogus face specs seem to
+	   ;; exist containing things like `:foreground nil'.
+	   (if (null value) (setq value 'unspecified)))
+	  (t (unless (assq attribute face-x-resources)
+	       (setq attribute nil))))
+	(when attribute
+	  (set-face-attribute face frame attribute value)))
+      (setq attrs (cdr (cdr attrs))))))
 
 (defun face-attr-match-p (face attrs &optional frame)
   "Return t if attributes of FACE match values in plist ATTRS.
@@ -1797,14 +1830,16 @@ according to the `background-mode' and `display-type' frame parameters."
       (let ((locally-modified-faces nil))
 	;; Before modifying the frame parameters, we collect a list of
 	;; faces that don't match what their face-spec says they should
-	;; look like; we then avoid changing these faces below.  A
-	;; negative list is used on the assumption that most faces will
+	;; look like; we then avoid changing these faces below.
+	;; These are the faces whose attributes were modified on FRAME.
+	;; We use a negative list on the assumption that most faces will
 	;; be unmodified, so we can avoid consing in the common case.
 	(dolist (face (face-list))
-	  (when (not (face-spec-match-p face
-					(face-user-default-spec face)
-					(selected-frame)))
-	    (push face locally-modified-faces)))
+	  (and (not (get face 'face-override-spec))
+	       (not (face-spec-match-p face
+				       (face-user-default-spec face)
+				       (selected-frame)))
+	       (push face locally-modified-faces)))
 	;; Now change to the new frame parameters
 	(modify-frame-parameters frame
 				 (list (cons 'background-mode bg-mode)
@@ -1813,7 +1848,7 @@ according to the `background-mode' and `display-type' frame parameters."
 	;; parameters, unless they have been locally modified.
 	(dolist (face (face-list))
 	  (unless (memq face locally-modified-faces)
-	    (face-spec-set face (face-user-default-spec face) frame)))))))
+	    (face-spec-recalc face frame)))))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1947,7 +1982,7 @@ Initialize colors of certain faces from frame parameters."
     (dolist (face (delq 'default (face-list)))
       (condition-case ()
 	  (progn
-	    (face-spec-set face (face-user-default-spec face) frame)
+	    (face-spec-recalc face frame)
 	    (if (memq (window-system frame) '(x w32 mac))
 		(make-face-x-resource-internal face frame))
 	    (internal-merge-in-global-face face frame))