X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmsw-faces.el;h=7c34cc7eee68174fa358c858660880ac6b958760;hb=528ca5c9afc87d2d698ce64b29cc9b069d09894f;hp=e77f415fc57a51acba89725c99cb810f2cb0acb6;hpb=fc475e6669a613cd6d98eb5511c749a23b63c7ac;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/msw-faces.el b/lisp/msw-faces.el index e77f415..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.