changeset 75696:97897143b20e

(face-set-after-frame-default): Compile attributes to be set by frame parameters before merging in X resources.
author Chong Yidong <cyd@stupidchicken.com>
date Tue, 06 Feb 2007 22:36:42 +0000
parents 4c06fd3ca88d
children 08bdbc5a6b1e
files lisp/faces.el
diffstat 1 files changed, 42 insertions(+), 29 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/faces.el	Tue Feb 06 22:36:16 2007 +0000
+++ b/lisp/faces.el	Tue Feb 06 22:36:42 2007 +0000
@@ -1754,35 +1754,48 @@
 			  (face-attribute 'default :weight t))
       (set-face-attribute 'default frame :width
 			  (face-attribute 'default :width t))))
-  (dolist (face (face-list))
-    ;; Don't let frame creation fail because of an invalid face spec.
-    (condition-case ()
-	(when (not (equal face 'default))
-	  (face-spec-set face (face-user-default-spec face) frame)
-	  (internal-merge-in-global-face face frame)
-	  (when (and (memq window-system '(x w32 mac))
-		     (or (not (boundp 'inhibit-default-face-x-resources))
-			 (not (eq face 'default))))
-	    (make-face-x-resource-internal face frame)))
-      (error nil)))
-  ;; Initialize attributes from frame parameters.
-  (let ((params '((foreground-color default :foreground)
-		  (background-color default :background)
-		  (border-color border :background)
-		  (cursor-color cursor :background)
-		  (scroll-bar-foreground scroll-bar :foreground)
-		  (scroll-bar-background scroll-bar :background)
-		  (mouse-color mouse :background))))
-    (dolist (param params)
-      (let ((frame-param (frame-parameter frame (nth 0 param)))
-	    (face (nth 1 param))
-	    (attr (nth 2 param)))
-	(when (and frame-param
-		   ;; Don't override face attributes explicitly
-		   ;; specified for new frames.
-		   (eq (face-attribute face attr t) 'unspecified))
-	  (set-face-attribute face frame attr frame-param))))))
-
+  ;; Find attributes that should be initialized from frame parameters.
+  (let ((face-params '((foreground-color default :foreground)
+		       (background-color default :background)
+		       (border-color border :background)
+		       (cursor-color cursor :background)
+		       (scroll-bar-foreground scroll-bar :foreground)
+		       (scroll-bar-background scroll-bar :background)
+		       (mouse-color mouse :background)))
+	apply-params)
+    (dolist (param face-params)
+      (let* ((value (frame-parameter frame (nth 0 param)))
+	     (face (nth 1 param))
+	     (attr (nth 2 param))
+	     (default-value (face-attribute face attr t)))
+	;; Compile a list of face attributes to set, but don't set
+	;; them yet.  The call to make-face-x-resource-internal,
+	;; below, can change frame parameters, and the final set of
+	;; frame parameters should be the ones acquired at this step.
+	(if (eq default-value 'unspecified)
+	    ;; The face spec does not specify a new-frame value for
+	    ;; this attribute.  Check if the existing frame parameter
+	    ;; specifies it.
+	    (if value
+		(push (list face frame attr value) apply-params))
+	  ;; The face spec specifies a value for this attribute, to be
+	  ;; applied to the face on all new frames.
+	  (push (list face frame attr default-value) apply-params))))
+    ;; Initialize faces from face specs and X resources.  The
+    ;; condition-case prevents invalid specs from causing frame
+    ;; creation to fail.
+    (dolist (face (delq 'default (face-list)))
+      (condition-case ()
+	  (progn
+	    (face-spec-set face (face-user-default-spec face) frame)
+	    (internal-merge-in-global-face face frame)
+	    (if (memq window-system '(x w32 mac))
+		(make-face-x-resource-internal face frame)))
+	(error nil)))
+    ;; Apply the attributes specified by frame parameters.  This
+    ;; rewrites parameters changed by make-face-x-resource-internal
+    (dolist (param apply-params)
+      (apply 'set-face-attribute param))))
 
 (defun tty-handle-reverse-video (frame parameters)
   "Handle the reverse-video frame parameter for terminal frames."