;;; msw-faces.el --- mswindows-specific face stuff.;;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.;;; Copyright (C) 1995, 1996 Ben Wing.;; Author: Jamie Zawinski;; Modified by: Chuck Thompson;; Modified by: Ben Wing;; Modified by: Martin Buchholz;; Rewritten for mswindows by: Jonathan Harris;; This file is part of XEmacs.;; XEmacs is free software; you can redistribute it and/or modify it;; under the terms of the GNU General Public License as published by;; the Free Software Foundation; either version 2, or (at your option);; any later version.;; XEmacs is distributed in the hope that it will be useful, but;; WITHOUT ANY WARRANTY; without even the implied warranty of;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU;; General Public License for more details.;; You should have received a copy of the GNU General Public License;; along with XEmacs; see the file COPYING. If not, write to the ;; 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.;;; Force creation of the default face font so that if it fails we get an;;; error now instead of a crash at frame creation.(defunmswindows-init-device-faces(device)(unless(face-font-instance'defaultdevice)(error"Can't find a suitable default font")))(defunmswindows-init-frame-faces(frame));;; Fill in missing parts of a font spec. This is primarily intended as a;;; helper function for the functions below.;;; mswindows fonts look like:;;; fontname[:[weight][ style][:pointsize[:effects]]][:charset];;; A minimal mswindows font spec looks like:;;; Courier New;;; A maximal mswindows font spec looks like:;;; Courier New:Bold Italic:10:underline strikeout:Western;;; Missing parts of the font spec should be filled in with these values:;;; Courier New:Regular:10::Western(defunmswindows-font-canonicalize-name(font)"Given a mswindows font or font name, this returns its name incanonical form."(if(or(font-instance-pfont)(stringpfont))(let((name(if(font-instance-pfont)(font-instance-namefont)font)))(cond((string-match"^[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)(concatname":Western"))((string-match"^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$"name)(concatname"::Western"))((string-match"^[a-zA-Z ]+:[a-zA-Z ]*$"name)(concatname":10::Western"))((string-match"^[a-zA-Z ]+$"name)(concatname":Regular:10::Western"))(t"Courier New:Regular:10::Western")))))(defunmswindows-make-font-bold(font&optionaldevice)"Given a mswindows font specification, this attempts to make a bold font.If it fails, it returns nil."(if(font-instance-pfont)(let((name(mswindows-font-canonicalize-namefont))(oldwidth(font-instance-widthfont)))(string-match"^[a-zA-Z ]+:\\([a-zA-Z ]*\\):"name)(let((newfont(make-font-instance(concat(substringname0(match-beginning1))"Bold"(substringname(match-end1)))devicet))); Hack! on mswindows, bold fonts (even monospaced) are often wider than the; equivalent non-bold font. Making the bold font one point smaller usually; makes it the same width (maybe at the expense of making it one pixel shorter)(if(font-instance-pnewfont)(if(>(font-instance-widthnewfont)oldwidth)(mswindows-find-smaller-fontnewfontdevice)newfont))))))(defunmswindows-make-font-unbold(font&optionaldevice)"Given a mswindows font specification, this attempts to make a non-bold font.If it fails, it returns nil."(if(font-instance-pfont)(let((name(mswindows-font-canonicalize-namefont)))(string-match"^[a-zA-Z ]+:\\([a-zA-Z ]*\\):"name)(make-font-instance(concat(substringname0(match-beginning1))"Regular"(substringname(match-end1)))devicet))))(defunmswindows-make-font-italic(font&optionaldevice)"Given a mswindows font specification, this attempts to make an `italic'font. If it fails, it returns nil."(if(font-instance-pfont)(let((name(mswindows-font-canonicalize-namefont)))(string-match"^[a-zA-Z ]+:\\([a-zA-Z ]*\\):"name)(make-font-instance(concat(substringname0(match-beginning1))"Italic"(substringname(match-end1)))devicet))))(defunmswindows-make-font-unitalic(font&optionaldevice)"Given a mswindows font specification, this attempts to make a non-italicfont. If it fails, it returns nil."(if(font-instance-pfont)(let((name(mswindows-font-canonicalize-namefont)))(string-match"^[a-zA-Z ]+:\\([a-zA-Z ]*\\):"name)(make-font-instance(concat(substringname0(match-beginning1))"Regular"(substringname(match-end1)))devicet))))(defunmswindows-make-font-bold-italic(font&optionaldevice)"Given a mswindows font specification, this attempts to make a `bold-italic'font. If it fails, it returns nil."(if(font-instance-pfont)(let((name(mswindows-font-canonicalize-namefont))(oldwidth(font-instance-widthfont)))(string-match"^[a-zA-Z ]+:\\([a-zA-Z ]*\\):"name)(let((newfont(make-font-instance(concat(substringname0(match-beginning1))"Bold Italic"(substringname(match-end1)))devicet))); Hack! on mswindows, bold fonts (even monospaced) are often wider than the; equivalent non-bold font. Making the bold font one point smaller usually; makes it the same width (maybe at the expense of making it one pixel shorter)(if(font-instance-pnewfont)(if(>(font-instance-widthnewfont)oldwidth)(mswindows-find-smaller-fontnewfontdevice)newfont))))))(defunmswindows-find-smaller-font(font&optionaldevice)"Loads a new version of the given font (or font name) 1 point smaller.Returns the font if it succeeds, nil otherwise."(if(stringpfont)(setqfont(make-font-instancefontdevice)))(if(font-instance-pfont)(setqfont(font-instance-truenamefont)))(if(stringpfont)(setqfont(make-font-instancefontdevice)))(if(font-instance-pfont)(let(old-size(name(mswindows-font-canonicalize-namefont)))(string-match"^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):"name)(setqold-size(string-to-int(substringname(match-beginning1)(match-end1))))(if(>old-size0)(make-font-instance(concat(substringname0(match-beginning1))(int-to-string(-old-size1))(substringname(match-end1)))devicet)))))(defunmswindows-find-larger-font(font&optionaldevice)"Loads a new version of the given font (or font name) 1 point larger.Returns the font if it succeeds, nil otherwise."(if(stringpfont)(setqfont(make-font-instancefontdevice)))(if(font-instance-pfont)(setqfont(font-instance-truenamefont)))(if(stringpfont)(setqfont(make-font-instancefontdevice)))(if(font-instance-pfont)(let(old-size(name(mswindows-font-canonicalize-namefont)))(string-match"^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):"name)(setqold-size(string-to-int(substringname(match-beginning1)(match-end1))))(make-font-instance(concat(substringname0(match-beginning1))(int-to-string(+old-size1))(substringname(match-end1)))devicet))))