Contents in 1999-06-04-13 of release-21-2.

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

diff --git a/lisp/msw-faces.el b/lisp/msw-faces.el
index c393bdf..f4e4125 100644 (file)
--- a/lisp/msw-faces.el
+++ b/lisp/msw-faces.el
@@ -26,20 +26,32 @@
 ;; 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.
+;;; 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)
-  (set-face-font 'default 
-                '((mswindows default) . "Courier New:Regular:10") 'global)
-  )
+  (unless (face-font-instance 'default device)
+    (error "Can't find a suitable default font")))
 
 
 (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 +60,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 +75,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 +100,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 +111,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 +133,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 +152,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 +176,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)