annotate lisp/msw-faces.el @ 321:19dcec799385 r21-0-58

Import from CVS: tag r21-0-58
author cvs
date Mon, 13 Aug 2007 10:46:44 +0200
parents afd57c14dfc8
children cc15677e0335
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
1 ;;; msw-faces.el --- mswindows-specific face stuff.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
2
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
3 ;;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
4 ;;; Copyright (C) 1995, 1996 Ben Wing.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
5
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
6 ;; Author: Jamie Zawinski
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
7 ;; Modified by: Chuck Thompson
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
8 ;; Modified by: Ben Wing
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
9 ;; Modified by: Martin Buchholz
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
10 ;; Rewritten for mswindows by: Jonathan Harris
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
11
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
12 ;; This file is part of XEmacs.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
13
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
14 ;; XEmacs is free software; you can redistribute it and/or modify it
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
15 ;; under the terms of the GNU General Public License as published by
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
16 ;; the Free Software Foundation; either version 2, or (at your option)
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
17 ;; any later version.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
18
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
19 ;; XEmacs is distributed in the hope that it will be useful, but
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
22 ;; General Public License for more details.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
23
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
24 ;; You should have received a copy of the GNU General Public License
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
25 ;; along with XEmacs; see the file COPYING. If not, write to the
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
27 ;; Boston, MA 02111-1307, USA.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
28
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
29 ;; This file does the magic to parse mswindows font names, and make sure that
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
30 ;; the default and modeline attributes of new frames are specified enough.
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
31
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
32 ;;; Force creation of the default face font so that if it fails we get an
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
33 ;;; error now instead of a crash at frame creation.
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
34 (defun mswindows-init-device-faces (device)
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
35 (unless (face-font-instance 'default device)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
36 (error "Can't find a suitable default font")))
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
37
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
38
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
39 (defun mswindows-init-frame-faces (frame)
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
40 )
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
41
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
42
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
43 ;;; Fill in missing parts of a font spec. This is primarily intended as a
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
44 ;;; helper function for the functions below.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
45 ;;; mswindows fonts look like:
294
4b85ae5eabfb Import from CVS: tag r21-0b45
cvs
parents: 290
diff changeset
46 ;;; fontname[:[weight][ style][:pointsize[:effects]]][:charset]
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
47 ;;; A minimal mswindows font spec looks like:
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
48 ;;; Courier New
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
49 ;;; A maximal mswindows font spec looks like:
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
50 ;;; Courier New:Bold Italic:10:underline strikeout:Western
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
51 ;;; Missing parts of the font spec should be filled in with these values:
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
52 ;;; Courier New:Regular:10::Western
282
c42ec1d1cded Import from CVS: tag r21-0b39
cvs
parents: 280
diff changeset
53 (defun mswindows-font-canonicalize-name (font)
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
54 "Given a mswindows font or font name, this returns its name in
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
55 canonical form."
280
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
56 (if (or (font-instance-p font)
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
57 (stringp font))
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
58 (let ((name (if (font-instance-p font)
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
59 (font-instance-name font)
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
60 font)))
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
61 (cond ((string-match
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
62 "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$"
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
63 name) name)
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
64 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$"
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
65 name) (concat name ":Western"))
280
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
66 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name)
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
67 (concat name "::Western"))
280
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
68 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name)
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
69 (concat name ":10::Western"))
280
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 265
diff changeset
70 ((string-match "^[a-zA-Z ]+$" name)
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
71 (concat name ":Regular:10::Western"))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
72 (t "Courier New:Regular:10::Western")))))
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
73
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
74 (defun mswindows-make-font-bold (font &optional device)
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
75 "Given a mswindows font specification, this attempts to make a bold font.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
76 If it fails, it returns nil."
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
77 (if (font-instance-p font)
282
c42ec1d1cded Import from CVS: tag r21-0b39
cvs
parents: 280
diff changeset
78 (let ((name (mswindows-font-canonicalize-name font))
221
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
79 (oldwidth (font-instance-width font)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
80 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
221
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
81 (let ((newfont (make-font-instance
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
82 (concat (substring name 0 (match-beginning 1))
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
83 "Bold" (substring name (match-end 1)))
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
84 device t)))
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
85 ; Hack! on mswindows, bold fonts (even monospaced) are often wider than the
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
86 ; equivalent non-bold font. Making the bold font one point smaller usually
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
87 ; makes it the same width (maybe at the expense of making it one pixel shorter)
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
88 (if (font-instance-p newfont)
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
89 (if (> (font-instance-width newfont) oldwidth)
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
90 (mswindows-find-smaller-font newfont device)
221
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
91 newfont))))))
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
92
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
93 (defun mswindows-make-font-unbold (font &optional device)
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
94 "Given a mswindows font specification, this attempts to make a non-bold font.
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
95 If it fails, it returns nil."
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
96 (if (font-instance-p font)
282
c42ec1d1cded Import from CVS: tag r21-0b39
cvs
parents: 280
diff changeset
97 (let ((name (mswindows-font-canonicalize-name font)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
98 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
99 (make-font-instance (concat
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
100 (substring name 0 (match-beginning 1))
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
101 "Regular" (substring name (match-end 1)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
102 device t))))
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
103
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
104 (defun mswindows-make-font-italic (font &optional device)
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
105 "Given a mswindows font specification, this attempts to make an `italic'
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
106 font. If it fails, it returns nil."
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
107 (if (font-instance-p font)
282
c42ec1d1cded Import from CVS: tag r21-0b39
cvs
parents: 280
diff changeset
108 (let ((name (mswindows-font-canonicalize-name font)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
109 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
110 (make-font-instance (concat
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
111 (substring name 0 (match-beginning 1))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
112 "Italic" (substring name (match-end 1)))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
113 device t))))
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
114
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
115 (defun mswindows-make-font-unitalic (font &optional device)
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
116 "Given a mswindows font specification, this attempts to make a non-italic
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
117 font. If it fails, it returns nil."
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
118 (if (font-instance-p font)
282
c42ec1d1cded Import from CVS: tag r21-0b39
cvs
parents: 280
diff changeset
119 (let ((name (mswindows-font-canonicalize-name font)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
120 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
121 (make-font-instance (concat
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
122 (substring name 0 (match-beginning 1))
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
123 "Regular" (substring name (match-end 1)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
124 device t))))
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
125
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
126 (defun mswindows-make-font-bold-italic (font &optional device)
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
127 "Given a mswindows font specification, this attempts to make a `bold-italic'
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
128 font. If it fails, it returns nil."
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
129 (if (font-instance-p font)
282
c42ec1d1cded Import from CVS: tag r21-0b39
cvs
parents: 280
diff changeset
130 (let ((name (mswindows-font-canonicalize-name font))
221
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
131 (oldwidth (font-instance-width font)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
132 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
221
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
133 (let ((newfont (make-font-instance
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
134 (concat (substring name 0 (match-beginning 1))
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
135 "Bold Italic" (substring name (match-end 1)))
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
136 device t)))
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
137 ; Hack! on mswindows, bold fonts (even monospaced) are often wider than the
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
138 ; equivalent non-bold font. Making the bold font one point smaller usually
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
139 ; makes it the same width (maybe at the expense of making it one pixel shorter)
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
140 (if (font-instance-p newfont)
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
141 (if (> (font-instance-width newfont) oldwidth)
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 298
diff changeset
142 (mswindows-find-smaller-font newfont device)
221
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
143 newfont))))))
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
144
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
145 (defun mswindows-find-smaller-font (font &optional device)
221
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
146 "Loads a new version of the given font (or font name) 1 point smaller.
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
147 Returns the font if it succeeds, nil otherwise."
321
19dcec799385 Import from CVS: tag r21-0-58
cvs
parents: 318
diff changeset
148 (if (stringp font) (setq font (make-font-instance font device)))
19dcec799385 Import from CVS: tag r21-0-58
cvs
parents: 318
diff changeset
149 (if (font-instance-p font) (setq font (font-instance-truename font)))
19dcec799385 Import from CVS: tag r21-0-58
cvs
parents: 318
diff changeset
150 (if (stringp font) (setq font (make-font-instance font device)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
151 (if (font-instance-p font)
282
c42ec1d1cded Import from CVS: tag r21-0b39
cvs
parents: 280
diff changeset
152 (let (old-size (name (mswindows-font-canonicalize-name font)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
153 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
154 (setq old-size (string-to-int
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
155 (substring name (match-beginning 1) (match-end 1))))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
156 (if (> old-size 0)
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
157 (make-font-instance (concat
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
158 (substring name 0 (match-beginning 1))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
159 (int-to-string (- old-size 1))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
160 (substring name (match-end 1)))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
161 device t)))))
213
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
162
78f53ef88e17 Import from CVS: tag r20-4b5
cvs
parents:
diff changeset
163 (defun mswindows-find-larger-font (font &optional device)
221
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
164 "Loads a new version of the given font (or font name) 1 point larger.
6c0ae1f9357f Import from CVS: tag r20-4b9
cvs
parents: 215
diff changeset
165 Returns the font if it succeeds, nil otherwise."
321
19dcec799385 Import from CVS: tag r21-0-58
cvs
parents: 318
diff changeset
166 (if (stringp font) (setq font (make-font-instance font device)))
19dcec799385 Import from CVS: tag r21-0-58
cvs
parents: 318
diff changeset
167 (if (font-instance-p font) (setq font (font-instance-truename font)))
19dcec799385 Import from CVS: tag r21-0-58
cvs
parents: 318
diff changeset
168 (if (stringp font) (setq font (make-font-instance font device)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
169 (if (font-instance-p font)
282
c42ec1d1cded Import from CVS: tag r21-0b39
cvs
parents: 280
diff changeset
170 (let (old-size (name (mswindows-font-canonicalize-name font)))
215
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
171 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
172 (setq old-size (string-to-int
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
173 (substring name (match-beginning 1) (match-end 1))))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
174 (make-font-instance (concat
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
175 (substring name 0 (match-beginning 1))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
176 (int-to-string (+ old-size 1))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
177 (substring name (match-end 1)))
1f0dabaa0855 Import from CVS: tag r20-4b6
cvs
parents: 213
diff changeset
178 device t))))