X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmsw-faces.el;h=7c34cc7eee68174fa358c858660880ac6b958760;hb=bbeb2495812aebfcba6dbe12c26fbb14f5a702c6;hp=c393bdfa06299fa83a27f29d3916d91178fd59ce;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/msw-faces.el b/lisp/msw-faces.el index c393bdf..7c34cc7 100644 --- a/lisp/msw-faces.el +++ b/lisp/msw-faces.el @@ -26,20 +26,43 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;; 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. +;; 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. -;;; ensure that the default face has some reasonable fallbacks if nothing -;;; else is specified. (defun mswindows-init-device-faces (device) - (set-face-font 'default - '((mswindows default) . "Courier New:Regular:10") 'global) - ) - + (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. @@ -48,12 +71,12 @@ ;;; A minimal mswindows font spec looks like: ;;; Courier New ;;; A maximal mswindows font spec looks like: -;;; Courier New:Bold Italic:10:underline strikeout:western +;;; Courier New:Bold Italic:10:underline strikeout:Western ;;; Missing parts of the font spec should be filled in with these values: -;;; Courier New:Normal:10::western +;;; Courier New:Regular:10::Western (defun mswindows-font-canonicalize-name (font) - "Given a mswindows font or font specification, this returns its -specification in canonical form." + "Given a mswindows font or font name, this returns its name in +canonical form." (if (or (font-instance-p font) (stringp font)) (let ((name (if (font-instance-p font) @@ -63,14 +86,14 @@ specification in canonical form." "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$" name) name) ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$" - name) (concat name ":western")) + name) (concat name ":Western")) ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name) - (concat name "::western")) + (concat name "::Western")) ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name) - (concat name ":10::western")) + (concat name ":10::Western")) ((string-match "^[a-zA-Z ]+$" name) - (concat name ":Normal:10::western")) - (t "Courier New:Normal:10::western"))))) + (concat name ":Regular:10::Western")) + (t "Courier New:Regular:10::Western"))))) (defun mswindows-make-font-bold (font &optional device) "Given a mswindows font specification, this attempts to make a bold font. @@ -88,7 +111,7 @@ If it fails, it returns nil." ; makes it the same width (maybe at the expense of making it one pixel shorter) (if (font-instance-p newfont) (if (> (font-instance-width newfont) oldwidth) - (mswindows-find-smaller-font newfont) + (mswindows-find-smaller-font newfont device) newfont)))))) (defun mswindows-make-font-unbold (font &optional device) @@ -99,7 +122,7 @@ If it fails, it returns nil." (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) (make-font-instance (concat (substring name 0 (match-beginning 1)) - "Normal" (substring name (match-end 1))) + "Regular" (substring name (match-end 1))) device t)))) (defun mswindows-make-font-italic (font &optional device) @@ -121,7 +144,7 @@ font. If it fails, it returns nil." (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) (make-font-instance (concat (substring name 0 (match-beginning 1)) - "Normal" (substring name (match-end 1))) + "Regular" (substring name (match-end 1))) device t)))) (defun mswindows-make-font-bold-italic (font &optional device) @@ -140,12 +163,15 @@ font. If it fails, it returns nil." ; makes it the same width (maybe at the expense of making it one pixel shorter) (if (font-instance-p newfont) (if (> (font-instance-width newfont) oldwidth) - (mswindows-find-smaller-font newfont) + (mswindows-find-smaller-font newfont device) newfont)))))) (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) @@ -161,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)