Mercurial > hg > xemacs-beta
comparison src/objects-w32.c @ 209:41ff10fd062f r20-4b3
Import from CVS: tag r20-4b3
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:04:58 +0200 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
208:f427b8ec4379 | 209:41ff10fd062f |
---|---|
1 /* win32-specific Lisp objects. | |
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc. | |
3 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
4 Copyright (C) 1995 Tinker Systems. | |
5 Copyright (C) 1995, 1996 Ben Wing. | |
6 Copyright (C) 1995 Sun Microsystems, Inc. | |
7 Copyright (C) 1997 Jonathan Harris. | |
8 | |
9 This file is part of XEmacs. | |
10 | |
11 XEmacs is free software; you can redistribute it and/or modify it | |
12 under the terms of the GNU General Public License as published by the | |
13 Free Software Foundation; either version 2, or (at your option) any | |
14 later version. | |
15 | |
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
19 for more details. | |
20 | |
21 You should have received a copy of the GNU General Public License | |
22 along with XEmacs; see the file COPYING. If not, write to | |
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 Boston, MA 02111-1307, USA. */ | |
25 | |
26 /* Synched up with: Not in FSF. */ | |
27 | |
28 /* Authorship: | |
29 | |
30 Jamie Zawinski, Chuck Thompson, Ben Wing | |
31 Rewritten for win32 by Jonathan Harris, November 1997 for 20.4. | |
32 */ | |
33 | |
34 | |
35 /* TODO: palette handling */ | |
36 | |
37 #include <config.h> | |
38 #include "lisp.h" | |
39 | |
40 #include "console-w32.h" | |
41 #include "objects-w32.h" | |
42 | |
43 #ifdef MULE | |
44 #include "mule-charset.h" | |
45 #endif | |
46 | |
47 #include "buffer.h" | |
48 #include "device.h" | |
49 #include "insdel.h" | |
50 | |
51 #include "windows.h" | |
52 | |
53 typedef struct colormap_t | |
54 { | |
55 char *name; | |
56 COLORREF colorref; | |
57 } colormap_t; | |
58 | |
59 static colormap_t w32_X_color_map[] = | |
60 { | |
61 {"snow" , PALETTERGB (255,250,250)}, | |
62 {"ghost white" , PALETTERGB (248,248,255)}, | |
63 {"GhostWhite" , PALETTERGB (248,248,255)}, | |
64 {"white smoke" , PALETTERGB (245,245,245)}, | |
65 {"WhiteSmoke" , PALETTERGB (245,245,245)}, | |
66 {"gainsboro" , PALETTERGB (220,220,220)}, | |
67 {"floral white" , PALETTERGB (255,250,240)}, | |
68 {"FloralWhite" , PALETTERGB (255,250,240)}, | |
69 {"old lace" , PALETTERGB (253,245,230)}, | |
70 {"OldLace" , PALETTERGB (253,245,230)}, | |
71 {"linen" , PALETTERGB (250,240,230)}, | |
72 {"antique white" , PALETTERGB (250,235,215)}, | |
73 {"AntiqueWhite" , PALETTERGB (250,235,215)}, | |
74 {"papaya whip" , PALETTERGB (255,239,213)}, | |
75 {"PapayaWhip" , PALETTERGB (255,239,213)}, | |
76 {"blanched almond" , PALETTERGB (255,235,205)}, | |
77 {"BlanchedAlmond" , PALETTERGB (255,235,205)}, | |
78 {"bisque" , PALETTERGB (255,228,196)}, | |
79 {"peach puff" , PALETTERGB (255,218,185)}, | |
80 {"PeachPuff" , PALETTERGB (255,218,185)}, | |
81 {"navajo white" , PALETTERGB (255,222,173)}, | |
82 {"NavajoWhite" , PALETTERGB (255,222,173)}, | |
83 {"moccasin" , PALETTERGB (255,228,181)}, | |
84 {"cornsilk" , PALETTERGB (255,248,220)}, | |
85 {"ivory" , PALETTERGB (255,255,240)}, | |
86 {"lemon chiffon" , PALETTERGB (255,250,205)}, | |
87 {"LemonChiffon" , PALETTERGB (255,250,205)}, | |
88 {"seashell" , PALETTERGB (255,245,238)}, | |
89 {"honeydew" , PALETTERGB (240,255,240)}, | |
90 {"mint cream" , PALETTERGB (245,255,250)}, | |
91 {"MintCream" , PALETTERGB (245,255,250)}, | |
92 {"azure" , PALETTERGB (240,255,255)}, | |
93 {"alice blue" , PALETTERGB (240,248,255)}, | |
94 {"AliceBlue" , PALETTERGB (240,248,255)}, | |
95 {"lavender" , PALETTERGB (230,230,250)}, | |
96 {"lavender blush" , PALETTERGB (255,240,245)}, | |
97 {"LavenderBlush" , PALETTERGB (255,240,245)}, | |
98 {"misty rose" , PALETTERGB (255,228,225)}, | |
99 {"MistyRose" , PALETTERGB (255,228,225)}, | |
100 {"white" , PALETTERGB (255,255,255)}, | |
101 {"black" , PALETTERGB ( 0, 0, 0)}, | |
102 {"dark slate gray" , PALETTERGB ( 47, 79, 79)}, | |
103 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)}, | |
104 {"dark slate grey" , PALETTERGB ( 47, 79, 79)}, | |
105 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)}, | |
106 {"dim gray" , PALETTERGB (105,105,105)}, | |
107 {"DimGray" , PALETTERGB (105,105,105)}, | |
108 {"dim grey" , PALETTERGB (105,105,105)}, | |
109 {"DimGrey" , PALETTERGB (105,105,105)}, | |
110 {"slate gray" , PALETTERGB (112,128,144)}, | |
111 {"SlateGray" , PALETTERGB (112,128,144)}, | |
112 {"slate grey" , PALETTERGB (112,128,144)}, | |
113 {"SlateGrey" , PALETTERGB (112,128,144)}, | |
114 {"light slate gray" , PALETTERGB (119,136,153)}, | |
115 {"LightSlateGray" , PALETTERGB (119,136,153)}, | |
116 {"light slate grey" , PALETTERGB (119,136,153)}, | |
117 {"LightSlateGrey" , PALETTERGB (119,136,153)}, | |
118 {"gray" , PALETTERGB (190,190,190)}, | |
119 {"grey" , PALETTERGB (190,190,190)}, | |
120 {"light grey" , PALETTERGB (211,211,211)}, | |
121 {"LightGrey" , PALETTERGB (211,211,211)}, | |
122 {"light gray" , PALETTERGB (211,211,211)}, | |
123 {"LightGray" , PALETTERGB (211,211,211)}, | |
124 {"midnight blue" , PALETTERGB ( 25, 25,112)}, | |
125 {"MidnightBlue" , PALETTERGB ( 25, 25,112)}, | |
126 {"navy" , PALETTERGB ( 0, 0,128)}, | |
127 {"navy blue" , PALETTERGB ( 0, 0,128)}, | |
128 {"NavyBlue" , PALETTERGB ( 0, 0,128)}, | |
129 {"cornflower blue" , PALETTERGB (100,149,237)}, | |
130 {"CornflowerBlue" , PALETTERGB (100,149,237)}, | |
131 {"dark slate blue" , PALETTERGB ( 72, 61,139)}, | |
132 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)}, | |
133 {"slate blue" , PALETTERGB (106, 90,205)}, | |
134 {"SlateBlue" , PALETTERGB (106, 90,205)}, | |
135 {"medium slate blue" , PALETTERGB (123,104,238)}, | |
136 {"MediumSlateBlue" , PALETTERGB (123,104,238)}, | |
137 {"light slate blue" , PALETTERGB (132,112,255)}, | |
138 {"LightSlateBlue" , PALETTERGB (132,112,255)}, | |
139 {"medium blue" , PALETTERGB ( 0, 0,205)}, | |
140 {"MediumBlue" , PALETTERGB ( 0, 0,205)}, | |
141 {"royal blue" , PALETTERGB ( 65,105,225)}, | |
142 {"RoyalBlue" , PALETTERGB ( 65,105,225)}, | |
143 {"blue" , PALETTERGB ( 0, 0,255)}, | |
144 {"dodger blue" , PALETTERGB ( 30,144,255)}, | |
145 {"DodgerBlue" , PALETTERGB ( 30,144,255)}, | |
146 {"deep sky blue" , PALETTERGB ( 0,191,255)}, | |
147 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)}, | |
148 {"sky blue" , PALETTERGB (135,206,235)}, | |
149 {"SkyBlue" , PALETTERGB (135,206,235)}, | |
150 {"light sky blue" , PALETTERGB (135,206,250)}, | |
151 {"LightSkyBlue" , PALETTERGB (135,206,250)}, | |
152 {"steel blue" , PALETTERGB ( 70,130,180)}, | |
153 {"SteelBlue" , PALETTERGB ( 70,130,180)}, | |
154 {"light steel blue" , PALETTERGB (176,196,222)}, | |
155 {"LightSteelBlue" , PALETTERGB (176,196,222)}, | |
156 {"light blue" , PALETTERGB (173,216,230)}, | |
157 {"LightBlue" , PALETTERGB (173,216,230)}, | |
158 {"powder blue" , PALETTERGB (176,224,230)}, | |
159 {"PowderBlue" , PALETTERGB (176,224,230)}, | |
160 {"pale turquoise" , PALETTERGB (175,238,238)}, | |
161 {"PaleTurquoise" , PALETTERGB (175,238,238)}, | |
162 {"dark turquoise" , PALETTERGB ( 0,206,209)}, | |
163 {"DarkTurquoise" , PALETTERGB ( 0,206,209)}, | |
164 {"medium turquoise" , PALETTERGB ( 72,209,204)}, | |
165 {"MediumTurquoise" , PALETTERGB ( 72,209,204)}, | |
166 {"turquoise" , PALETTERGB ( 64,224,208)}, | |
167 {"cyan" , PALETTERGB ( 0,255,255)}, | |
168 {"light cyan" , PALETTERGB (224,255,255)}, | |
169 {"LightCyan" , PALETTERGB (224,255,255)}, | |
170 {"cadet blue" , PALETTERGB ( 95,158,160)}, | |
171 {"CadetBlue" , PALETTERGB ( 95,158,160)}, | |
172 {"medium aquamarine" , PALETTERGB (102,205,170)}, | |
173 {"MediumAquamarine" , PALETTERGB (102,205,170)}, | |
174 {"aquamarine" , PALETTERGB (127,255,212)}, | |
175 {"dark green" , PALETTERGB ( 0,100, 0)}, | |
176 {"DarkGreen" , PALETTERGB ( 0,100, 0)}, | |
177 {"dark olive green" , PALETTERGB ( 85,107, 47)}, | |
178 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)}, | |
179 {"dark sea green" , PALETTERGB (143,188,143)}, | |
180 {"DarkSeaGreen" , PALETTERGB (143,188,143)}, | |
181 {"sea green" , PALETTERGB ( 46,139, 87)}, | |
182 {"SeaGreen" , PALETTERGB ( 46,139, 87)}, | |
183 {"medium sea green" , PALETTERGB ( 60,179,113)}, | |
184 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)}, | |
185 {"light sea green" , PALETTERGB ( 32,178,170)}, | |
186 {"LightSeaGreen" , PALETTERGB ( 32,178,170)}, | |
187 {"pale green" , PALETTERGB (152,251,152)}, | |
188 {"PaleGreen" , PALETTERGB (152,251,152)}, | |
189 {"spring green" , PALETTERGB ( 0,255,127)}, | |
190 {"SpringGreen" , PALETTERGB ( 0,255,127)}, | |
191 {"lawn green" , PALETTERGB (124,252, 0)}, | |
192 {"LawnGreen" , PALETTERGB (124,252, 0)}, | |
193 {"green" , PALETTERGB ( 0,255, 0)}, | |
194 {"chartreuse" , PALETTERGB (127,255, 0)}, | |
195 {"medium spring green" , PALETTERGB ( 0,250,154)}, | |
196 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)}, | |
197 {"green yellow" , PALETTERGB (173,255, 47)}, | |
198 {"GreenYellow" , PALETTERGB (173,255, 47)}, | |
199 {"lime green" , PALETTERGB ( 50,205, 50)}, | |
200 {"LimeGreen" , PALETTERGB ( 50,205, 50)}, | |
201 {"yellow green" , PALETTERGB (154,205, 50)}, | |
202 {"YellowGreen" , PALETTERGB (154,205, 50)}, | |
203 {"forest green" , PALETTERGB ( 34,139, 34)}, | |
204 {"ForestGreen" , PALETTERGB ( 34,139, 34)}, | |
205 {"olive drab" , PALETTERGB (107,142, 35)}, | |
206 {"OliveDrab" , PALETTERGB (107,142, 35)}, | |
207 {"dark khaki" , PALETTERGB (189,183,107)}, | |
208 {"DarkKhaki" , PALETTERGB (189,183,107)}, | |
209 {"khaki" , PALETTERGB (240,230,140)}, | |
210 {"pale goldenrod" , PALETTERGB (238,232,170)}, | |
211 {"PaleGoldenrod" , PALETTERGB (238,232,170)}, | |
212 {"light goldenrod yellow" , PALETTERGB (250,250,210)}, | |
213 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)}, | |
214 {"light yellow" , PALETTERGB (255,255,224)}, | |
215 {"LightYellow" , PALETTERGB (255,255,224)}, | |
216 {"yellow" , PALETTERGB (255,255, 0)}, | |
217 {"gold" , PALETTERGB (255,215, 0)}, | |
218 {"light goldenrod" , PALETTERGB (238,221,130)}, | |
219 {"LightGoldenrod" , PALETTERGB (238,221,130)}, | |
220 {"goldenrod" , PALETTERGB (218,165, 32)}, | |
221 {"dark goldenrod" , PALETTERGB (184,134, 11)}, | |
222 {"DarkGoldenrod" , PALETTERGB (184,134, 11)}, | |
223 {"rosy brown" , PALETTERGB (188,143,143)}, | |
224 {"RosyBrown" , PALETTERGB (188,143,143)}, | |
225 {"indian red" , PALETTERGB (205, 92, 92)}, | |
226 {"IndianRed" , PALETTERGB (205, 92, 92)}, | |
227 {"saddle brown" , PALETTERGB (139, 69, 19)}, | |
228 {"SaddleBrown" , PALETTERGB (139, 69, 19)}, | |
229 {"sienna" , PALETTERGB (160, 82, 45)}, | |
230 {"peru" , PALETTERGB (205,133, 63)}, | |
231 {"burlywood" , PALETTERGB (222,184,135)}, | |
232 {"beige" , PALETTERGB (245,245,220)}, | |
233 {"wheat" , PALETTERGB (245,222,179)}, | |
234 {"sandy brown" , PALETTERGB (244,164, 96)}, | |
235 {"SandyBrown" , PALETTERGB (244,164, 96)}, | |
236 {"tan" , PALETTERGB (210,180,140)}, | |
237 {"chocolate" , PALETTERGB (210,105, 30)}, | |
238 {"firebrick" , PALETTERGB (178, 34, 34)}, | |
239 {"brown" , PALETTERGB (165, 42, 42)}, | |
240 {"dark salmon" , PALETTERGB (233,150,122)}, | |
241 {"DarkSalmon" , PALETTERGB (233,150,122)}, | |
242 {"salmon" , PALETTERGB (250,128,114)}, | |
243 {"light salmon" , PALETTERGB (255,160,122)}, | |
244 {"LightSalmon" , PALETTERGB (255,160,122)}, | |
245 {"orange" , PALETTERGB (255,165, 0)}, | |
246 {"dark orange" , PALETTERGB (255,140, 0)}, | |
247 {"DarkOrange" , PALETTERGB (255,140, 0)}, | |
248 {"coral" , PALETTERGB (255,127, 80)}, | |
249 {"light coral" , PALETTERGB (240,128,128)}, | |
250 {"LightCoral" , PALETTERGB (240,128,128)}, | |
251 {"tomato" , PALETTERGB (255, 99, 71)}, | |
252 {"orange red" , PALETTERGB (255, 69, 0)}, | |
253 {"OrangeRed" , PALETTERGB (255, 69, 0)}, | |
254 {"red" , PALETTERGB (255, 0, 0)}, | |
255 {"hot pink" , PALETTERGB (255,105,180)}, | |
256 {"HotPink" , PALETTERGB (255,105,180)}, | |
257 {"deep pink" , PALETTERGB (255, 20,147)}, | |
258 {"DeepPink" , PALETTERGB (255, 20,147)}, | |
259 {"pink" , PALETTERGB (255,192,203)}, | |
260 {"light pink" , PALETTERGB (255,182,193)}, | |
261 {"LightPink" , PALETTERGB (255,182,193)}, | |
262 {"pale violet red" , PALETTERGB (219,112,147)}, | |
263 {"PaleVioletRed" , PALETTERGB (219,112,147)}, | |
264 {"maroon" , PALETTERGB (176, 48, 96)}, | |
265 {"medium violet red" , PALETTERGB (199, 21,133)}, | |
266 {"MediumVioletRed" , PALETTERGB (199, 21,133)}, | |
267 {"violet red" , PALETTERGB (208, 32,144)}, | |
268 {"VioletRed" , PALETTERGB (208, 32,144)}, | |
269 {"magenta" , PALETTERGB (255, 0,255)}, | |
270 {"violet" , PALETTERGB (238,130,238)}, | |
271 {"plum" , PALETTERGB (221,160,221)}, | |
272 {"orchid" , PALETTERGB (218,112,214)}, | |
273 {"medium orchid" , PALETTERGB (186, 85,211)}, | |
274 {"MediumOrchid" , PALETTERGB (186, 85,211)}, | |
275 {"dark orchid" , PALETTERGB (153, 50,204)}, | |
276 {"DarkOrchid" , PALETTERGB (153, 50,204)}, | |
277 {"dark violet" , PALETTERGB (148, 0,211)}, | |
278 {"DarkViolet" , PALETTERGB (148, 0,211)}, | |
279 {"blue violet" , PALETTERGB (138, 43,226)}, | |
280 {"BlueViolet" , PALETTERGB (138, 43,226)}, | |
281 {"purple" , PALETTERGB (160, 32,240)}, | |
282 {"medium purple" , PALETTERGB (147,112,219)}, | |
283 {"MediumPurple" , PALETTERGB (147,112,219)}, | |
284 {"thistle" , PALETTERGB (216,191,216)}, | |
285 {"gray0" , PALETTERGB ( 0, 0, 0)}, | |
286 {"grey0" , PALETTERGB ( 0, 0, 0)}, | |
287 {"dark grey" , PALETTERGB (169,169,169)}, | |
288 {"DarkGrey" , PALETTERGB (169,169,169)}, | |
289 {"dark gray" , PALETTERGB (169,169,169)}, | |
290 {"DarkGray" , PALETTERGB (169,169,169)}, | |
291 {"dark blue" , PALETTERGB ( 0, 0,139)}, | |
292 {"DarkBlue" , PALETTERGB ( 0, 0,139)}, | |
293 {"dark cyan" , PALETTERGB ( 0,139,139)}, | |
294 {"DarkCyan" , PALETTERGB ( 0,139,139)}, | |
295 {"dark magenta" , PALETTERGB (139, 0,139)}, | |
296 {"DarkMagenta" , PALETTERGB (139, 0,139)}, | |
297 {"dark red" , PALETTERGB (139, 0, 0)}, | |
298 {"DarkRed" , PALETTERGB (139, 0, 0)}, | |
299 {"light green" , PALETTERGB (144,238,144)}, | |
300 {"LightGreen" , PALETTERGB (144,238,144)}, | |
301 }; | |
302 | |
303 static COLORREF | |
304 w32_string_to_color(CONST char *name) | |
305 { | |
306 int color, i; | |
307 | |
308 if (*name == '#') | |
309 { | |
310 /* w32 numeric names look like "#BBGGRR" */ | |
311 if (strlen(name)!=7) | |
312 return (-1); | |
313 for (i=1; i<7; i++) | |
314 if (!isxdigit(name[i])) | |
315 return(-1); | |
316 if (sscanf(name+1, "%x", &color) == 1) | |
317 return(0x02000000 | color); /* See PALETTERGB in docs */ | |
318 } | |
319 else | |
320 { | |
321 for(i=0; i<(sizeof(w32_X_color_map)/sizeof(colormap_t)); i++) | |
322 if (!stricmp(name, w32_X_color_map[i].name)) | |
323 return (w32_X_color_map[i].colorref); | |
324 } | |
325 return(-1); | |
326 } | |
327 | |
328 static int | |
329 w32_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, | |
330 Lisp_Object device, Error_behavior errb) | |
331 { | |
332 CONST char *extname; | |
333 COLORREF color; | |
334 | |
335 GET_C_STRING_CTEXT_DATA_ALLOCA (name, extname); | |
336 color = w32_string_to_color(extname); | |
337 if (color != -1) | |
338 { | |
339 c->data = xnew (struct w32_color_instance_data); | |
340 COLOR_INSTANCE_W32_COLOR (c) = color; | |
341 COLOR_INSTANCE_W32_BRUSH (c) = CreateSolidBrush (color); | |
342 return 1; | |
343 } | |
344 maybe_signal_simple_error ("unrecognized color", name, Qcolor, errb); | |
345 return(0); | |
346 } | |
347 | |
348 static void | |
349 w32_mark_color_instance (struct Lisp_Color_Instance *c, | |
350 void (*markobj) (Lisp_Object)) | |
351 { | |
352 } | |
353 | |
354 static void | |
355 w32_print_color_instance (struct Lisp_Color_Instance *c, | |
356 Lisp_Object printcharfun, | |
357 int escapeflag) | |
358 { | |
359 char buf[32]; | |
360 COLORREF color = COLOR_INSTANCE_W32_COLOR (c); | |
361 sprintf (buf, " %06ld=(%02X,%02X,%02X)", color & 0xffffff, | |
362 GetRValue(color), GetGValue(color), GetBValue(color)); | |
363 write_c_string (buf, printcharfun); | |
364 } | |
365 | |
366 static void | |
367 w32_finalize_color_instance (struct Lisp_Color_Instance *c) | |
368 { | |
369 if (c->data) | |
370 { | |
371 DeleteObject (COLOR_INSTANCE_W32_BRUSH (c)); | |
372 xfree (c->data); | |
373 c->data = 0; | |
374 } | |
375 } | |
376 | |
377 static int | |
378 w32_color_instance_equal (struct Lisp_Color_Instance *c1, | |
379 struct Lisp_Color_Instance *c2, | |
380 int depth) | |
381 { | |
382 return (COLOR_INSTANCE_W32_COLOR(c1) == COLOR_INSTANCE_W32_COLOR(c2)); | |
383 } | |
384 | |
385 static unsigned long | |
386 w32_color_instance_hash (struct Lisp_Color_Instance *c, int depth) | |
387 { | |
388 return LISP_HASH (COLOR_INSTANCE_W32_COLOR(c)); | |
389 } | |
390 | |
391 static Lisp_Object | |
392 w32_color_instance_rgb_components (struct Lisp_Color_Instance *c) | |
393 { | |
394 COLORREF color = COLOR_INSTANCE_W32_COLOR (c); | |
395 return (list3 (make_int (GetRValue(color)), | |
396 make_int (GetGValue(color)), | |
397 make_int (GetBValue(color)))); | |
398 } | |
399 | |
400 static int | |
401 w32_valid_color_name_p (struct device *d, Lisp_Object color) | |
402 { | |
403 CONST char *extname; | |
404 | |
405 GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname); | |
406 return (w32_string_to_color(extname)!=-1); | |
407 } | |
408 | |
409 | |
410 | |
411 static void | |
412 w32_finalize_font_instance (struct Lisp_Font_Instance *f) | |
413 { | |
414 if (f->data) | |
415 { | |
416 DeleteObject(f->data); | |
417 f->data=0; | |
418 } | |
419 } | |
420 | |
421 static int | |
422 w32_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name, | |
423 Lisp_Object device, Error_behavior errb) | |
424 { | |
425 CONST char *extname; | |
426 LOGFONT logfont; | |
427 int fields; | |
428 int pt; | |
429 char fontname[LF_FACESIZE], weight[32], *style, points[8], effects[32], charset[32]; | |
430 | |
431 GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname); | |
432 | |
433 /* | |
434 * w32 fonts look like: | |
435 * fontname[:[weight ][style][:pointsize[:effects[:charset]]]] | |
436 * The font name field shouldn't be empty. | |
437 * XXX Windows will substitute a default (monospace) font if the font name | |
438 * specifies a non-existent font. We don't catch this. | |
439 * effects and charset are currently ignored. | |
440 * | |
441 * ie: | |
442 * Lucida Console:Regular:10 | |
443 * minimal: | |
444 * Courier New | |
445 * maximal: | |
446 * Courier New:Bold Italic:10:underline strikeout:ansi | |
447 */ | |
448 fields = sscanf (extname, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s", | |
449 fontname, weight, points, effects, charset); | |
450 | |
451 if (fields<0) | |
452 { | |
453 maybe_signal_simple_error ("Invalid font", f->name, Qfont, errb); | |
454 return (0); | |
455 } | |
456 | |
457 if (fields>0 && strlen(fontname)) | |
458 { | |
459 strncpy (logfont.lfFaceName, fontname, LF_FACESIZE); | |
460 logfont.lfFaceName[LF_FACESIZE-1] = 0; | |
461 } | |
462 else | |
463 { | |
464 maybe_signal_simple_error ("Must specify a font name", f->name, Qfont, errb); | |
465 return (0); | |
466 } | |
467 | |
468 if (fields > 1 && strlen(weight)) | |
469 { | |
470 char *c; | |
471 /* Maybe split weight into weight and style */ | |
472 if (c=strchr(weight, ' ')) | |
473 { | |
474 *c = '\0'; | |
475 style = c+1; | |
476 } | |
477 else | |
478 style = NULL; | |
479 | |
480 /* weight: Most-often used (maybe) first */ | |
481 if (stricmp (weight,"regular") == 0) | |
482 logfont.lfWeight = FW_REGULAR; | |
483 else if (stricmp (weight,"normal") == 0) | |
484 logfont.lfWeight = FW_NORMAL; | |
485 else if (stricmp (weight,"bold") == 0) | |
486 logfont.lfWeight = FW_BOLD; | |
487 else if (stricmp (weight,"medium") == 0) | |
488 logfont.lfWeight = FW_MEDIUM; | |
489 else if (stricmp (weight,"italic") == 0) /* Hack for early exit */ | |
490 { | |
491 logfont.lfWeight = FW_NORMAL; | |
492 style=weight; | |
493 } | |
494 /* the rest */ | |
495 else if (stricmp (weight,"black") == 0) | |
496 logfont.lfWeight = FW_BLACK; | |
497 else if (stricmp (weight,"heavy") == 0) | |
498 logfont.lfWeight = FW_HEAVY; | |
499 else if (stricmp (weight,"ultrabold") == 0) | |
500 logfont.lfWeight = FW_ULTRABOLD; | |
501 else if (stricmp (weight,"extrabold") == 0) | |
502 logfont.lfWeight = FW_EXTRABOLD; | |
503 else if (stricmp (weight,"demibold") == 0) | |
504 logfont.lfWeight = FW_SEMIBOLD; | |
505 else if (stricmp (weight,"semibold") == 0) | |
506 logfont.lfWeight = FW_SEMIBOLD; | |
507 else if (stricmp (weight,"light") == 0) | |
508 logfont.lfWeight = FW_LIGHT; | |
509 else if (stricmp (weight,"ultralight") == 0) | |
510 logfont.lfWeight = FW_ULTRALIGHT; | |
511 else if (stricmp (weight,"extralight") == 0) | |
512 logfont.lfWeight = FW_EXTRALIGHT; | |
513 else if (stricmp (weight,"thin") == 0) | |
514 logfont.lfWeight = FW_THIN; | |
515 else | |
516 { | |
517 logfont.lfWeight = FW_NORMAL; | |
518 if (!style) | |
519 style = weight; /* May have specified a style without a weight */ | |
520 else | |
521 { | |
522 maybe_signal_simple_error ("Invalid font weight", f->name, Qfont, errb); | |
523 return (0); /* Invalid weight */ | |
524 } | |
525 } | |
526 | |
527 if (style) | |
528 { | |
529 /* XXX what about oblique? */ | |
530 if (stricmp (style,"italic") == 0) | |
531 logfont.lfItalic = TRUE; | |
532 else if (stricmp (style,"roman") == 0) | |
533 logfont.lfItalic = FALSE; | |
534 else | |
535 { | |
536 maybe_signal_simple_error ("Invalid font weight or style", f->name, Qfont, errb); | |
537 return (0); /* Invalid weight or style */ | |
538 } | |
539 } | |
540 else | |
541 { | |
542 logfont.lfItalic = FALSE; | |
543 } | |
544 | |
545 } | |
546 else | |
547 { | |
548 logfont.lfWeight = FW_NORMAL; | |
549 logfont.lfItalic = FALSE; | |
550 } | |
551 | |
552 /* XXX Should we reject strings that don't specify a size? */ | |
553 if (fields < 3 || !strlen(points) || (pt=atoi(points))==0) | |
554 pt = 10; | |
555 | |
556 /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */ | |
557 logfont.lfHeight = -MulDiv(pt, DEVICE_W32_LOGPIXELSY(XDEVICE (device)), 72); | |
558 logfont.lfWidth = 0; | |
559 | |
560 /* Default to monospaced if the specified font name is not found */ | |
561 logfont.lfPitchAndFamily = FF_MODERN; | |
562 | |
563 /* XXX: FIXME? */ | |
564 logfont.lfUnderline = FALSE; | |
565 logfont.lfStrikeOut = FALSE; | |
566 | |
567 /* XXX: FIXME: we ignore charset */ | |
568 logfont.lfCharSet = DEFAULT_CHARSET; | |
569 | |
570 /* Misc crud */ | |
571 logfont.lfEscapement = logfont.lfOrientation = 0; | |
572 #if 1 | |
573 logfont.lfOutPrecision = OUT_DEFAULT_PRECIS; | |
574 logfont.lfClipPrecision = CLIP_DEFAULT_PRECIS; | |
575 logfont.lfQuality = DEFAULT_QUALITY; | |
576 #else | |
577 logfont.lfOutPrecision = OUT_STROKE_PRECIS; | |
578 logfont.lfClipPrecision = CLIP_STROKE_PRECIS; | |
579 logfont.lfQuality = PROOF_QUALITY; | |
580 #endif | |
581 | |
582 if ((f->data = CreateFontIndirect(&logfont)) == NULL) | |
583 { | |
584 maybe_signal_simple_error ("Couldn't create font", f->name, Qfont, errb); | |
585 return 0; | |
586 } | |
587 | |
588 /* Have to apply Font to a GC to get its values. | |
589 * We'll borrow the desktop window becuase its the only window that we | |
590 * know about that is guaranteed to exist when this gets called | |
591 */ | |
592 { | |
593 HWND hwnd; | |
594 HDC hdc; | |
595 HFONT holdfont; | |
596 TEXTMETRIC metrics; | |
597 | |
598 hwnd = GetDesktopWindow(); | |
599 assert(hdc = GetDC(hwnd)); /* XXX FIXME: can this temporarily fail? */ | |
600 holdfont = SelectObject(hdc, f->data); | |
601 if (!holdfont) | |
602 { | |
603 w32_finalize_font_instance (f); | |
604 maybe_signal_simple_error ("Couldn't map font", f->name, Qfont, errb); | |
605 return 0; | |
606 } | |
607 GetTextMetrics(hdc, &metrics); | |
608 SelectObject(hdc, holdfont); | |
609 ReleaseDC(hwnd, hdc); | |
610 f->width = metrics.tmAveCharWidth; | |
611 f->height = metrics.tmHeight; | |
612 f->ascent = metrics.tmAscent; | |
613 f->descent = metrics.tmDescent; | |
614 f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH); | |
615 } | |
616 | |
617 return 1; | |
618 } | |
619 | |
620 static void | |
621 w32_mark_font_instance (struct Lisp_Font_Instance *f, | |
622 void (*markobj) (Lisp_Object)) | |
623 { | |
624 } | |
625 | |
626 static void | |
627 w32_print_font_instance (struct Lisp_Font_Instance *f, | |
628 Lisp_Object printcharfun, | |
629 int escapeflag) | |
630 { | |
631 } | |
632 | |
633 static Lisp_Object | |
634 w32_list_fonts (Lisp_Object pattern, Lisp_Object device) | |
635 { | |
636 /* XXX Implement me */ | |
637 return list1 (build_string ("Courier New:Regular:10")); | |
638 } | |
639 | |
640 | |
641 | |
642 /************************************************************************/ | |
643 /* initialization */ | |
644 /************************************************************************/ | |
645 | |
646 void | |
647 syms_of_objects_w32 (void) | |
648 { | |
649 } | |
650 | |
651 void | |
652 console_type_create_objects_w32 (void) | |
653 { | |
654 /* object methods */ | |
655 CONSOLE_HAS_METHOD (w32, initialize_color_instance); | |
656 /* CONSOLE_HAS_METHOD (w32, mark_color_instance); */ | |
657 CONSOLE_HAS_METHOD (w32, print_color_instance); | |
658 CONSOLE_HAS_METHOD (w32, finalize_color_instance); | |
659 CONSOLE_HAS_METHOD (w32, color_instance_equal); | |
660 CONSOLE_HAS_METHOD (w32, color_instance_hash); | |
661 CONSOLE_HAS_METHOD (w32, color_instance_rgb_components); | |
662 CONSOLE_HAS_METHOD (w32, valid_color_name_p); | |
663 | |
664 CONSOLE_HAS_METHOD (w32, initialize_font_instance); | |
665 /* CONSOLE_HAS_METHOD (w32, mark_font_instance); */ | |
666 CONSOLE_HAS_METHOD (w32, print_font_instance); | |
667 CONSOLE_HAS_METHOD (w32, finalize_font_instance); | |
668 /* CONSOLE_HAS_METHOD (w32, font_instance_truename); */ | |
669 CONSOLE_HAS_METHOD (w32, list_fonts); | |
670 #ifdef MULE | |
671 CONSOLE_HAS_METHOD (w32, font_spec_matches_charset); | |
672 CONSOLE_HAS_METHOD (w32, find_charset_font); | |
673 #endif | |
674 } | |
675 | |
676 void | |
677 vars_of_objects_w32 (void) | |
678 { | |
679 } |