diff lisp/prim/faces.el @ 106:8ff55ebd4be9 r20-1b5

Import from CVS: tag r20-1b5
author cvs
date Mon, 13 Aug 2007 09:17:26 +0200
parents cf808b4c4290
children 360340f9fd5f
line wrap: on
line diff
--- a/lisp/prim/faces.el	Mon Aug 13 09:16:54 2007 +0200
+++ b/lisp/prim/faces.el	Mon Aug 13 09:17:26 2007 +0200
@@ -1067,52 +1067,68 @@
   (font-proportional-p (face-font face) domain charset))
 
 
+(defvar init-face-from-resources t
+  "If non-nil, attempt to initialize faces from the reseource database.")
+
+(defun make-empty-face (name &optional doc-string temporary)
+  "Like `make-face', but doesn't query the reseource database."
+  (let ((init-face-from-resources nil))
+    (make-face name doc-string temporary)))
+
 (defun init-face-from-resources (face &optional locale)
   "Initialize FACE from the resource database.
 If LOCALE is specified, it should be a frame, device, or 'global, and
 the face will be resourced over that locale.  Otherwise, the face will
 be resourced over all possible locales (i.e. all frames, all devices,
 and 'global)."
-  (if (not locale)
-      (progn
-	(init-face-from-resources face 'global)
-	(let ((devices (device-list)))
-	  (while devices
-	    (init-face-from-resources face (car devices))
-	    (setq devices (cdr devices))))
-	(let ((frames (frame-list)))
-	  (while frames
-	    (init-face-from-resources face (car frames))
-	    (setq frames (cdr frames)))))
-    (let ((devtype (cond ((devicep locale) (device-type locale))
-			 ((framep locale) (frame-type locale))
-			 (t nil))))
-      (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype))
-	     (x-init-face-from-resources face locale))
-	    ((or (not devtype) (eq 'tty devtype))
-	     ;; Nothing to do for TTYs?
-	     )))))
+  (cond ((null init-face-from-resources)
+	 ;; Do nothing.
+	 )
+	((not locale)
+	 ;; Global, set for all frames.
+	 (progn
+	   (init-face-from-resources face 'global)
+	   (let ((devices (device-list)))
+	     (while devices
+	       (init-face-from-resources face (car devices))
+	       (setq devices (cdr devices))))
+	   (let ((frames (frame-list)))
+	     (while frames
+	       (init-face-from-resources face (car frames))
+	       (setq frames (cdr frames))))))
+	(t
+	 ;; Specific.
+	 (let ((devtype (cond ((devicep locale) (device-type locale))
+			      ((framep locale) (frame-type locale))
+			      (t nil))))
+	   (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype))
+		  (x-init-face-from-resources face locale))
+		 ((or (not devtype) (eq 'tty devtype))
+		  ;; Nothing to do for TTYs?
+		  ))))))
 
 (defun init-device-faces (device)
   ;; First, add any device-local face resources.
-  (loop for face in (face-list) do
-	(init-face-from-resources face device))
-  ;; Then do any device-specific initialization.
-  (cond ((eq 'x (device-type device))
-	 (x-init-device-faces device))
-	;; Nothing to do for TTYs?
-	)
-  (init-other-random-faces device))
+  (when init-face-from-resources
+    (loop for face in (face-list) do
+	  (init-face-from-resources face device))
+    ;; Then do any device-specific initialization.
+    (cond ((eq 'x (device-type device))
+	   (x-init-device-faces device))
+	  ;; Nothing to do for TTYs?
+	  )
+    (init-other-random-faces device)))
 
 (defun init-frame-faces (frame)
-  ;; First, add any frame-local face resources.
-  (loop for face in (face-list) do
-	(init-face-from-resources face frame))
-  ;; Then do any frame-specific initialization.
-  (cond ((eq 'x (frame-type frame))
-	 (x-init-frame-faces frame))
-	;; Is there anything which should be done for TTY's?
-	))
+  (when init-face-from-resources
+    ;; First, add any frame-local face resources.
+    (loop for face in (face-list) do
+	  (init-face-from-resources face frame))
+    ;; Then do any frame-specific initialization.
+    (cond ((eq 'x (frame-type frame))
+	   (x-init-frame-faces frame))
+	  ;; Is there anything which should be done for TTY's?
+	  )))
 
 ;; #### This is somewhat X-specific, and is called when the first
 ;; X device is created (even if there were TTY devices created