XEmacs 21.2.33 "Melpomene".

[chise/xemacs-chise.git.1] / lisp / faces.el

diff --git a/lisp/faces.el b/lisp/faces.el
index 90fe697..616c510 100644 (file)
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -31,7 +31,7 @@
 ;; This file is dumped with XEmacs.
 
 ;; face implementation #1 (used Lisp vectors and parallel C vectors;
-;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@netscape.com>
+;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@jwz.org>
 ;; pre Lucid-Emacs 19.0.
 
 ;; face implementation #2 (used one face object per frame per face)
@@ -1360,6 +1360,24 @@ If FRAME is nil or omitted, initialize them for all frames."
                 (get-custom-frame-properties frame))
     (initialize-custom-faces frame)))
 
+(defun startup-initialize-custom-faces ()
+  "Reset faces created by defface.  Only called at startup.
+Don't use this function in your program."
+  (when default-custom-frame-properties
+    ;; Reset default value to the actual frame, not stream.
+    (setq default-custom-frame-properties
+         (extract-custom-frame-properties (selected-frame)))
+    ;; like initialize-custom-faces but removes property first.
+    (mapc (lambda (symbol)
+           (let ((spec (or (get symbol 'saved-face)
+                           (get symbol 'face-defface-spec))))
+             (when spec
+               ;; Reset faces created during auto-autoloads loading.
+               (reset-face symbol)
+               ;; And set it according to the spec.
+               (face-display-set symbol spec nil))))
+         (face-list))))
+
 \f
 (defun make-empty-face (name &optional doc-string temporary)
   "Like `make-face', but doesn't query the resource database."
@@ -1521,7 +1539,7 @@ you want to add code to do stuff like this, use the create-device-hook."
   ;; It's unreasonable to expect to be able to make a font italic all
   ;; the time.  For many languages, italic is an alien concept.
   ;; Basically, because italic is not a globally meaningful concept,
-  ;; the use of the italic face should really be oboleted.
+  ;; the use of the italic face should really be obsoleted.
 
   ;; I disagree with above.  In many languages, the concept of capital
   ;; letters is just as alien, and yet we use them.  Italic is here to
@@ -1571,14 +1589,17 @@ you want to add code to do stuff like this, use the create-device-hook."
                         nil 'append))
   )
 
-;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones.
+;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle
+;; Jones and Hrvoje Niksic.
 (defun set-face-stipple (face pixmap &optional frame)
   "Change the stipple pixmap of FACE to PIXMAP.
 This is an Emacs compatibility function; consider using
 set-face-background-pixmap instead.
 
 PIXMAP should be a string, the name of a file of pixmap data.
-The directories listed in the `x-bitmap-file-path' variable are searched.
+The directories listed in the variables `x-bitmap-file-path' and
+`mswindows-bitmap-file-path' under X and MS Windows respectively
+are searched.
 
 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT
 DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is
@@ -1589,20 +1610,33 @@ If the optional FRAME argument is provided, change only
 in that frame; otherwise change each frame."
   (while (not (find-face face))
     (setq face (signal 'wrong-type-argument (list 'facep face))))
-  (locate-file pixmap x-bitmap-file-path '(".xbm" ""))
-  (while (cond ((stringp pixmap)
-               (unless (file-readable-p pixmap)
-                 (setq pixmap `[xbm :file ,pixmap]))
-               nil)
-              ((and (consp pixmap) (= (length pixmap) 3))
-               (setq pixmap `[xbm :data ,pixmap])
-               nil)
-              (t t))
-    (setq pixmap (signal 'wrong-type-argument
-                        (list 'stipple-pixmap-p pixmap))))
-  (while (and frame (not (framep frame)))
-    (setq frame (signal 'wrong-type-argument (list 'framep frame))))
-  (set-face-background-pixmap face pixmap frame))
+  (let ((bitmap-path (ecase (console-type)
+                      (x         x-bitmap-file-path)
+                      (mswindows mswindows-bitmap-file-path)))
+       instantiator)
+    (while
+       (null
+        (setq instantiator
+              (cond ((stringp pixmap)
+                     (let ((file (if (file-name-absolute-p pixmap)
+                                     pixmap
+                                   (locate-file pixmap bitmap-path
+                                                '(".xbm" "")))))
+                       (and file
+                            `[xbm :file ,file])))
+                    ((and (listp pixmap) (= (length pixmap) 3))
+                     `[xbm :data ,pixmap])
+                    (t nil))))
+      ;; We're signaling a continuable error; let's make sure the
+      ;; function `stipple-pixmap-p' at least exists.
+      (flet ((stipple-pixmap-p (pixmap)
+              (or (stringp pixmap)
+                  (and (listp pixmap) (= (length pixmap) 3)))))
+       (setq pixmap (signal 'wrong-type-argument
+                            (list 'stipple-pixmap-p pixmap)))))
+    (while (and frame (not (framep frame)))
+      (setq frame (signal 'wrong-type-argument (list 'framep frame))))
+    (set-face-background-pixmap face instantiator frame)))
 
 \f
 ;; Create the remaining standard faces now.  This way, packages that we dump