X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmsw-faces.el;h=7c34cc7eee68174fa358c858660880ac6b958760;hb=b2e54f1836bb4b93d1f2da2550480e10652afa8f;hp=b2e52f4f433a944ea9b30b52d0aff34629de0bb6;hpb=72a705551741d6f85a40eea486c222bac482d8dc;p=chise%2Fxemacs-chise.git

diff --git a/lisp/msw-faces.el b/lisp/msw-faces.el
index b2e52f4..7c34cc7 100644
--- a/lisp/msw-faces.el
+++ b/lisp/msw-faces.el
@@ -29,16 +29,40 @@
 ;; This file does the magic to parse mswindows font names, and make sure that
 ;; the default and modeline attributes of new frames are specified enough.
 
-;;; Force creation of the default face font so that if it fails we get an
-;;; error now instead of a crash at frame creation.
 (defun mswindows-init-device-faces (device)
-  (unless (face-font-instance 'default device)
-    (error "Can't find a suitable default font")))
-
+  (let ((color-default (device-system-metric device 'color-default))
+	(color-3d-face (device-system-metric device 'color-3d-face)))
+    ; Force creation of the default face font so that if it fails we get
+    ; an error now instead of a crash at frame creation.
+    (unless (face-font-instance 'default device)
+      (error "Can't find a suitable default font"))
+    
+    (if (car color-default)
+	(set-face-foreground 'default (car color-default)) device)
+    (if (cdr color-default)
+	(set-face-background 'default (cdr color-default)) device)
+    (if (car color-3d-face)
+	(set-face-foreground 'gui-element (car color-3d-face)) device)
+    (if (cdr color-3d-face)
+	(set-face-background 'gui-element (cdr color-3d-face)) device)
+    (set-face-font 'gui-element "MS Sans Serif:Regular:8" device)))
 
 (defun mswindows-init-frame-faces (frame)
   )
 
+;; Other functions expect these regexps
+(defconst mswindows-font-regexp
+  (let
+      ((- 		":")
+       (fontname	"\\([a-zA-Z ]+\\)")
+       (weight	"\\([a-zA-Z]*\\)?")
+       (style	"\\( [a-zA-Z]*\\)?")
+       (pointsize	"\\([0-9]+\\)?")
+       (effects	"\\([a-zA-Z ]*\\)?")
+       (charset	"\\([a-zA-Z 0-9]*\\)")
+       )
+    (concat "^"
+	    fontname - weight style - pointsize - effects - charset "$")))
 
 ;;; Fill in missing parts of a font spec. This is primarily intended as a
 ;;; helper function for the functions below.
@@ -145,6 +169,9 @@ font. If it fails, it returns nil."
 (defun mswindows-find-smaller-font (font &optional device)
   "Loads a new version of the given font (or font name) 1 point smaller.
 Returns the font if it succeeds, nil otherwise."
+  (if (stringp font) (setq font (make-font-instance font device)))
+  (if (font-instance-p font) (setq font (font-instance-truename font)))
+  (if (stringp font) (setq font (make-font-instance font device)))
   (if (font-instance-p font)
       (let (old-size (name (mswindows-font-canonicalize-name font)))
 	(string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
@@ -160,6 +187,9 @@ Returns the font if it succeeds, nil otherwise."
 (defun mswindows-find-larger-font (font &optional device)
   "Loads a new version of the given font (or font name) 1 point larger.
 Returns the font if it succeeds, nil otherwise."
+  (if (stringp font) (setq font (make-font-instance font device)))
+  (if (font-instance-p font) (setq font (font-instance-truename font)))
+  (if (stringp font) (setq font (make-font-instance font device)))
   (if (font-instance-p font)
       (let (old-size (name (mswindows-font-canonicalize-name font)))
 	(string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)