]> code.delx.au - gnu-emacs/blob - src/w32font.c
Update copyright year to 2015
[gnu-emacs] / src / w32font.c
1 /* Font backend for the Microsoft Windows API.
2 Copyright (C) 2007-2015 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 #include <config.h>
20 #include <windows.h>
21 #include <stdio.h>
22 #include <math.h>
23 #include <ctype.h>
24 #include <commdlg.h>
25
26 #include "lisp.h"
27 #include "w32term.h"
28 #include "frame.h"
29 #include "dispextern.h"
30 #include "character.h"
31 #include "charset.h"
32 #include "coding.h"
33 #include "fontset.h"
34 #include "font.h"
35 #include "w32font.h"
36 #ifdef WINDOWSNT
37 #include "w32.h"
38 #endif
39
40 /* Cleartype available on Windows XP, cleartype_natural from XP SP1.
41 The latter does not try to fit cleartype smoothed fonts into the
42 same bounding box as the non-antialiased version of the font.
43 */
44 #ifndef CLEARTYPE_QUALITY
45 #define CLEARTYPE_QUALITY 5
46 #endif
47 #ifndef CLEARTYPE_NATURAL_QUALITY
48 #define CLEARTYPE_NATURAL_QUALITY 6
49 #endif
50
51 /* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
52 of MSVC headers. */
53 #ifndef VIETNAMESE_CHARSET
54 #define VIETNAMESE_CHARSET 163
55 #endif
56 #ifndef JOHAB_CHARSET
57 #define JOHAB_CHARSET 130
58 #endif
59
60 Lisp_Object Qgdi;
61 Lisp_Object Quniscribe;
62 static Lisp_Object QCformat;
63 static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif;
64 static Lisp_Object Qserif, Qscript, Qdecorative;
65 static Lisp_Object Qraster, Qoutline, Qunknown;
66
67 /* antialiasing */
68 static Lisp_Object Qstandard, Qsubpixel, Qnatural;
69
70 /* languages */
71 static Lisp_Object Qzh;
72
73 /* scripts */
74 static Lisp_Object Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
75 static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
76 static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
77 static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
78 static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
79 static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
80 static Lisp_Object Qkhmer, Qmongolian, Qbraille, Qhan;
81 static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
82 static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
83 static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
84 /* Not defined in characters.el, but referenced in fontset.el. */
85 static Lisp_Object Qbalinese, Qbuginese, Qbuhid, Qcuneiform, Qcypriot;
86 static Lisp_Object Qdeseret, Qglagolitic, Qgothic, Qhanunoo, Qkharoshthi;
87 static Lisp_Object Qlimbu, Qlinear_b, Qold_italic, Qold_persian, Qosmanya;
88 static Lisp_Object Qphags_pa, Qphoenician, Qshavian, Qsyloti_nagri;
89 static Lisp_Object Qtagalog, Qtagbanwa, Qtai_le, Qtifinagh, Qugaritic;
90
91 /* W32 charsets: for use in Vw32_charset_info_alist. */
92 static Lisp_Object Qw32_charset_ansi, Qw32_charset_default;
93 static Lisp_Object Qw32_charset_symbol, Qw32_charset_shiftjis;
94 static Lisp_Object Qw32_charset_hangeul, Qw32_charset_gb2312;
95 static Lisp_Object Qw32_charset_chinesebig5, Qw32_charset_oem;
96 static Lisp_Object Qw32_charset_easteurope, Qw32_charset_turkish;
97 static Lisp_Object Qw32_charset_baltic, Qw32_charset_russian;
98 static Lisp_Object Qw32_charset_arabic, Qw32_charset_greek;
99 static Lisp_Object Qw32_charset_hebrew, Qw32_charset_vietnamese;
100 static Lisp_Object Qw32_charset_thai, Qw32_charset_johab, Qw32_charset_mac;
101
102 /* Font spacing symbols - defined in font.c. */
103 extern Lisp_Object Qc, Qp, Qm;
104
105 static void fill_in_logfont (struct frame *, LOGFONT *, Lisp_Object);
106
107 static BYTE w32_antialias_type (Lisp_Object);
108 static Lisp_Object lispy_antialias_type (BYTE);
109
110 static Lisp_Object font_supported_scripts (FONTSIGNATURE *);
111 static int w32font_full_name (LOGFONT *, Lisp_Object, int, char *, int);
112 static void compute_metrics (HDC, struct w32font_info *, unsigned int,
113 struct w32_metric_cache *);
114
115 static Lisp_Object w32_registry (LONG, DWORD);
116
117 /* EnumFontFamiliesEx callbacks. */
118 static int CALLBACK ALIGN_STACK add_font_entity_to_list (ENUMLOGFONTEX *,
119 NEWTEXTMETRICEX *,
120 DWORD, LPARAM);
121 static int CALLBACK ALIGN_STACK add_one_font_entity_to_list (ENUMLOGFONTEX *,
122 NEWTEXTMETRICEX *,
123 DWORD, LPARAM);
124 static int CALLBACK ALIGN_STACK add_font_name_to_list (ENUMLOGFONTEX *,
125 NEWTEXTMETRICEX *,
126 DWORD, LPARAM);
127
128 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
129 of what we really want. */
130 struct font_callback_data
131 {
132 /* The logfont we are matching against. EnumFontFamiliesEx only matches
133 face name and charset, so we need to manually match everything else
134 in the callback function. */
135 LOGFONT pattern;
136 /* The original font spec or entity. */
137 Lisp_Object orig_font_spec;
138 /* The frame the font is being loaded on. */
139 Lisp_Object frame;
140 /* The list to add matches to. */
141 Lisp_Object list;
142 /* Whether to match only opentype fonts. */
143 int opentype_only;
144 };
145
146 /* Handles the problem that EnumFontFamiliesEx will not return all
147 style variations if the font name is not specified. */
148 static void list_all_matching_fonts (struct font_callback_data *);
149
150 #ifdef WINDOWSNT
151
152 static BOOL g_b_init_get_outline_metrics_w;
153 static BOOL g_b_init_get_text_metrics_w;
154 static BOOL g_b_init_get_glyph_outline_w;
155 static BOOL g_b_init_get_glyph_outline_w;
156 static BOOL g_b_init_get_char_width_32_w;
157
158 typedef UINT (WINAPI * GetOutlineTextMetricsW_Proc) (
159 HDC hdc,
160 UINT cbData,
161 LPOUTLINETEXTMETRICW lpotmw);
162 typedef BOOL (WINAPI * GetTextMetricsW_Proc) (
163 HDC hdc,
164 LPTEXTMETRICW lptmw);
165 typedef DWORD (WINAPI * GetGlyphOutlineW_Proc) (
166 HDC hdc,
167 UINT uChar,
168 UINT uFormat,
169 LPGLYPHMETRICS lpgm,
170 DWORD cbBuffer,
171 LPVOID lpvBuffer,
172 const MAT2 *lpmat2);
173 typedef BOOL (WINAPI * GetCharWidth32W_Proc) (
174 HDC hdc,
175 UINT uFirstChar,
176 UINT uLastChar,
177 LPINT lpBuffer);
178
179 /* Several "wide" functions we use to support the font backends are
180 unavailable on Windows 9X, unless UNICOWS.DLL is installed (their
181 versions in the default libraries are non-functional stubs). On NT
182 and later systems, these functions are in GDI32.DLL. The following
183 helper function attempts to load UNICOWS.DLL on Windows 9X, and
184 refuses to let Emacs start up if that library is not found. On NT
185 and later versions, it simply loads GDI32.DLL, which should always
186 be available. */
187 static HMODULE
188 w32_load_unicows_or_gdi32 (void)
189 {
190 return maybe_load_unicows_dll ();
191 }
192
193 /* The following 3 functions call the problematic "wide" APIs via
194 function pointers, to avoid linking against the non-standard
195 libunicows on W9X. */
196 static UINT WINAPI
197 get_outline_metrics_w(HDC hdc, UINT cbData, LPOUTLINETEXTMETRICW lpotmw)
198 {
199 static GetOutlineTextMetricsW_Proc s_pfn_Get_Outline_Text_MetricsW = NULL;
200 HMODULE hm_unicows = NULL;
201 if (g_b_init_get_outline_metrics_w == 0)
202 {
203 g_b_init_get_outline_metrics_w = 1;
204 hm_unicows = w32_load_unicows_or_gdi32 ();
205 if (hm_unicows)
206 s_pfn_Get_Outline_Text_MetricsW = (GetOutlineTextMetricsW_Proc)
207 GetProcAddress (hm_unicows, "GetOutlineTextMetricsW");
208 }
209 eassert (s_pfn_Get_Outline_Text_MetricsW != NULL);
210 return s_pfn_Get_Outline_Text_MetricsW (hdc, cbData, lpotmw);
211 }
212
213 static BOOL WINAPI
214 get_text_metrics_w(HDC hdc, LPTEXTMETRICW lptmw)
215 {
216 static GetTextMetricsW_Proc s_pfn_Get_Text_MetricsW = NULL;
217 HMODULE hm_unicows = NULL;
218 if (g_b_init_get_text_metrics_w == 0)
219 {
220 g_b_init_get_text_metrics_w = 1;
221 hm_unicows = w32_load_unicows_or_gdi32 ();
222 if (hm_unicows)
223 s_pfn_Get_Text_MetricsW = (GetTextMetricsW_Proc)
224 GetProcAddress (hm_unicows, "GetTextMetricsW");
225 }
226 eassert (s_pfn_Get_Text_MetricsW != NULL);
227 return s_pfn_Get_Text_MetricsW (hdc, lptmw);
228 }
229
230 static DWORD WINAPI
231 get_glyph_outline_w (HDC hdc, UINT uChar, UINT uFormat, LPGLYPHMETRICS lpgm,
232 DWORD cbBuffer, LPVOID lpvBuffer, const MAT2 *lpmat2)
233 {
234 static GetGlyphOutlineW_Proc s_pfn_Get_Glyph_OutlineW = NULL;
235 HMODULE hm_unicows = NULL;
236 if (g_b_init_get_glyph_outline_w == 0)
237 {
238 g_b_init_get_glyph_outline_w = 1;
239 hm_unicows = w32_load_unicows_or_gdi32 ();
240 if (hm_unicows)
241 s_pfn_Get_Glyph_OutlineW = (GetGlyphOutlineW_Proc)
242 GetProcAddress (hm_unicows, "GetGlyphOutlineW");
243 }
244 eassert (s_pfn_Get_Glyph_OutlineW != NULL);
245 return s_pfn_Get_Glyph_OutlineW (hdc, uChar, uFormat, lpgm, cbBuffer,
246 lpvBuffer, lpmat2);
247 }
248
249 static DWORD WINAPI
250 get_char_width_32_w (HDC hdc, UINT uFirstChar, UINT uLastChar, LPINT lpBuffer)
251 {
252 static GetCharWidth32W_Proc s_pfn_Get_Char_Width_32W = NULL;
253 HMODULE hm_unicows = NULL;
254 if (g_b_init_get_char_width_32_w == 0)
255 {
256 g_b_init_get_char_width_32_w = 1;
257 hm_unicows = w32_load_unicows_or_gdi32 ();
258 if (hm_unicows)
259 s_pfn_Get_Char_Width_32W = (GetCharWidth32W_Proc)
260 GetProcAddress (hm_unicows, "GetCharWidth32W");
261 }
262 eassert (s_pfn_Get_Char_Width_32W != NULL);
263 return s_pfn_Get_Char_Width_32W (hdc, uFirstChar, uLastChar, lpBuffer);
264 }
265
266 #else /* Cygwin */
267
268 /* Cygwin doesn't support Windows 9X, and links against GDI32.DLL, so
269 it can just call these functions directly. */
270 #define get_outline_metrics_w(h,d,o) GetOutlineTextMetricsW(h,d,o)
271 #define get_text_metrics_w(h,t) GetTextMetricsW(h,t)
272 #define get_glyph_outline_w(h,uc,f,gm,b,v,m) \
273 GetGlyphOutlineW(h,uc,f,gm,b,v,m)
274 #define get_char_width_32_w(h,fc,lc,b) GetCharWidth32W(h,fc,lc,b)
275
276 #endif /* Cygwin */
277
278 static int
279 memq_no_quit (Lisp_Object elt, Lisp_Object list)
280 {
281 while (CONSP (list) && ! EQ (XCAR (list), elt))
282 list = XCDR (list);
283 return (CONSP (list));
284 }
285
286 Lisp_Object
287 intern_font_name (char * string)
288 {
289 Lisp_Object str = DECODE_SYSTEM (build_string (string));
290 ptrdiff_t len = SCHARS (str);
291 Lisp_Object obarray = check_obarray (Vobarray);
292 Lisp_Object tem = oblookup (obarray, SDATA (str), len, len);
293 /* This code is similar to intern function from lread.c. */
294 return SYMBOLP (tem) ? tem : intern_driver (str, obarray, XINT (tem));
295 }
296
297 /* w32 implementation of get_cache for font backend.
298 Return a cache of font-entities on FRAME. The cache must be a
299 cons whose cdr part is the actual cache area. */
300 Lisp_Object
301 w32font_get_cache (struct frame *f)
302 {
303 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
304
305 return (dpyinfo->name_list_element);
306 }
307
308 /* w32 implementation of list for font backend.
309 List fonts exactly matching with FONT_SPEC on FRAME. The value
310 is a vector of font-entities. This is the sole API that
311 allocates font-entities. */
312 static Lisp_Object
313 w32font_list (struct frame *f, Lisp_Object font_spec)
314 {
315 Lisp_Object fonts = w32font_list_internal (f, font_spec, 0);
316 FONT_ADD_LOG ("w32font-list", font_spec, fonts);
317 return fonts;
318 }
319
320 /* w32 implementation of match for font backend.
321 Return a font entity most closely matching with FONT_SPEC on
322 FRAME. The closeness is determined by the font backend, thus
323 `face-font-selection-order' is ignored here. */
324 static Lisp_Object
325 w32font_match (struct frame *f, Lisp_Object font_spec)
326 {
327 Lisp_Object entity = w32font_match_internal (f, font_spec, 0);
328 FONT_ADD_LOG ("w32font-match", font_spec, entity);
329 return entity;
330 }
331
332 /* w32 implementation of list_family for font backend.
333 List available families. The value is a list of family names
334 (symbols). */
335 static Lisp_Object
336 w32font_list_family (struct frame *f)
337 {
338 Lisp_Object list = Qnil;
339 LOGFONT font_match_pattern;
340 HDC dc;
341
342 memset (&font_match_pattern, 0, sizeof (font_match_pattern));
343 font_match_pattern.lfCharSet = DEFAULT_CHARSET;
344
345 dc = get_frame_dc (f);
346
347 EnumFontFamiliesEx (dc, &font_match_pattern,
348 (FONTENUMPROC) add_font_name_to_list,
349 (LPARAM) &list, 0);
350 release_frame_dc (f, dc);
351
352 return list;
353 }
354
355 /* w32 implementation of open for font backend.
356 Open a font specified by FONT_ENTITY on frame F.
357 If the font is scalable, open it with PIXEL_SIZE. */
358 static Lisp_Object
359 w32font_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
360 {
361 Lisp_Object font_object
362 = font_make_object (VECSIZE (struct w32font_info),
363 font_entity, pixel_size);
364 struct w32font_info *w32_font
365 = (struct w32font_info *) XFONT_OBJECT (font_object);
366
367 ASET (font_object, FONT_TYPE_INDEX, Qgdi);
368
369 if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
370 {
371 return Qnil;
372 }
373
374 /* GDI backend does not use glyph indices. */
375 w32_font->glyph_idx = 0;
376
377 return font_object;
378 }
379
380 /* w32 implementation of close for font_backend. */
381 void
382 w32font_close (struct font *font)
383 {
384 struct w32font_info *w32_font = (struct w32font_info *) font;
385
386 if (w32_font->hfont)
387 {
388 /* Delete the GDI font object. */
389 DeleteObject (w32_font->hfont);
390 w32_font->hfont = NULL;
391
392 /* Free all the cached metrics. */
393 if (w32_font->cached_metrics)
394 {
395 int i;
396
397 for (i = 0; i < w32_font->n_cache_blocks; i++)
398 xfree (w32_font->cached_metrics[i]);
399 xfree (w32_font->cached_metrics);
400 w32_font->cached_metrics = NULL;
401 }
402 }
403 }
404
405 /* w32 implementation of has_char for font backend.
406 Optional.
407 If FONT_ENTITY has a glyph for character C (Unicode code point),
408 return 1. If not, return 0. If a font must be opened to check
409 it, return -1. */
410 int
411 w32font_has_char (Lisp_Object entity, int c)
412 {
413 /* We can't be certain about which characters a font will support until
414 we open it. Checking the scripts that the font supports turns out
415 to not be reliable. */
416 return -1;
417
418 #if 0
419 Lisp_Object supported_scripts, extra, script;
420 DWORD mask;
421
422 extra = AREF (entity, FONT_EXTRA_INDEX);
423 if (!CONSP (extra))
424 return -1;
425
426 supported_scripts = assq_no_quit (QCscript, extra);
427 /* If font doesn't claim to support any scripts, then we can't be certain
428 until we open it. */
429 if (!CONSP (supported_scripts))
430 return -1;
431
432 supported_scripts = XCDR (supported_scripts);
433
434 script = CHAR_TABLE_REF (Vchar_script_table, c);
435
436 /* If we don't know what script the character is from, then we can't be
437 certain until we open it. Also if the font claims support for the script
438 the character is from, it may only have partial coverage, so we still
439 can't be certain until we open the font. */
440 if (NILP (script) || memq_no_quit (script, supported_scripts))
441 return -1;
442
443 /* Font reports what scripts it supports, and none of them are the script
444 the character is from. But we still can't be certain, as some fonts
445 will contain some/most/all of the characters in that script without
446 claiming support for it. */
447 return -1;
448 #endif
449 }
450
451 /* w32 implementation of encode_char for font backend.
452 Return a glyph code of FONT for character C (Unicode code point).
453 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
454
455 For speed, the gdi backend uses Unicode (Emacs calls encode_char
456 far too often for it to be efficient). But we still need to detect
457 which characters are not supported by the font.
458 */
459 static unsigned
460 w32font_encode_char (struct font *font, int c)
461 {
462 struct w32font_info * w32_font = (struct w32font_info *)font;
463
464 if (c < w32_font->metrics.tmFirstChar
465 || c > w32_font->metrics.tmLastChar)
466 return FONT_INVALID_CODE;
467 else
468 return c;
469 }
470
471 /* w32 implementation of text_extents for font backend.
472 Perform the size computation of glyphs of FONT and fillin members
473 of METRICS. The glyphs are specified by their glyph codes in
474 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
475 case just return the overall width. */
476 void
477 w32font_text_extents (struct font *font, unsigned *code,
478 int nglyphs, struct font_metrics *metrics)
479 {
480 int i;
481 HFONT old_font = NULL;
482 HDC dc = NULL;
483 struct frame * f;
484 int total_width = 0;
485 WORD *wcode;
486 SIZE size;
487
488 struct w32font_info *w32_font = (struct w32font_info *) font;
489
490 memset (metrics, 0, sizeof (struct font_metrics));
491 metrics->ascent = font->ascent;
492 metrics->descent = font->descent;
493
494 for (i = 0; i < nglyphs; i++)
495 {
496 struct w32_metric_cache *char_metric;
497 int block = *(code + i) / CACHE_BLOCKSIZE;
498 int pos_in_block = *(code + i) % CACHE_BLOCKSIZE;
499
500 if (block >= w32_font->n_cache_blocks)
501 {
502 if (!w32_font->cached_metrics)
503 w32_font->cached_metrics
504 = xmalloc ((block + 1)
505 * sizeof (struct w32_metric_cache *));
506 else
507 w32_font->cached_metrics
508 = xrealloc (w32_font->cached_metrics,
509 (block + 1)
510 * sizeof (struct w32_metric_cache *));
511 memset (w32_font->cached_metrics + w32_font->n_cache_blocks, 0,
512 ((block + 1 - w32_font->n_cache_blocks)
513 * sizeof (struct w32_metric_cache *)));
514 w32_font->n_cache_blocks = block + 1;
515 }
516
517 if (!w32_font->cached_metrics[block])
518 {
519 w32_font->cached_metrics[block]
520 = xzalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
521 }
522
523 char_metric = w32_font->cached_metrics[block] + pos_in_block;
524
525 if (char_metric->status == W32METRIC_NO_ATTEMPT)
526 {
527 if (dc == NULL)
528 {
529 /* TODO: Frames can come and go, and their fonts
530 outlive them. So we can't cache the frame in the
531 font structure. Use selected_frame until the API
532 is updated to pass in a frame. */
533 f = XFRAME (selected_frame);
534
535 dc = get_frame_dc (f);
536 old_font = SelectObject (dc, w32_font->hfont);
537 }
538 compute_metrics (dc, w32_font, *(code + i), char_metric);
539 }
540
541 if (char_metric->status == W32METRIC_SUCCESS)
542 {
543 metrics->lbearing = min (metrics->lbearing,
544 metrics->width + char_metric->lbearing);
545 metrics->rbearing = max (metrics->rbearing,
546 metrics->width + char_metric->rbearing);
547 metrics->width += char_metric->width;
548 }
549 else
550 /* If we couldn't get metrics for a char,
551 use alternative method. */
552 break;
553 }
554 /* If we got through everything, return. */
555 if (i == nglyphs)
556 {
557 if (dc != NULL)
558 {
559 /* Restore state and release DC. */
560 SelectObject (dc, old_font);
561 release_frame_dc (f, dc);
562 }
563 return;
564 }
565
566 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
567 fallback on other methods that will at least give some of the metric
568 information. */
569
570 /* Make array big enough to hold surrogates. */
571 wcode = alloca (nglyphs * sizeof (WORD) * 2);
572 for (i = 0; i < nglyphs; i++)
573 {
574 if (code[i] < 0x10000)
575 wcode[i] = code[i];
576 else
577 {
578 DWORD surrogate = code[i] - 0x10000;
579
580 /* High surrogate: U+D800 - U+DBFF. */
581 wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
582 /* Low surrogate: U+DC00 - U+DFFF. */
583 wcode[i] = 0xDC00 + (surrogate & 0x03FF);
584 /* An extra glyph. wcode is already double the size of code to
585 cope with this. */
586 nglyphs++;
587 }
588 }
589
590 if (dc == NULL)
591 {
592 /* TODO: Frames can come and go, and their fonts outlive
593 them. So we can't cache the frame in the font structure. Use
594 selected_frame until the API is updated to pass in a
595 frame. */
596 f = XFRAME (selected_frame);
597
598 dc = get_frame_dc (f);
599 old_font = SelectObject (dc, w32_font->hfont);
600 }
601
602 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
603 {
604 total_width = size.cx;
605 }
606
607 /* On 95/98/ME, only some Unicode functions are available, so fallback
608 on doing a dummy draw to find the total width. */
609 if (!total_width)
610 {
611 RECT rect;
612 rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
613 DrawTextW (dc, wcode, nglyphs, &rect,
614 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
615 total_width = rect.right;
616 }
617
618 /* Give our best estimate of the metrics, based on what we know. */
619 metrics->width = total_width - w32_font->metrics.tmOverhang;
620 metrics->lbearing = 0;
621 metrics->rbearing = total_width;
622
623 /* Restore state and release DC. */
624 SelectObject (dc, old_font);
625 release_frame_dc (f, dc);
626 }
627
628 /* w32 implementation of draw for font backend.
629 Optional.
630 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
631 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
632 fill the background in advance. It is assured that WITH_BACKGROUND
633 is false when (FROM > 0 || TO < S->nchars).
634
635 TODO: Currently this assumes that the colors and fonts are already
636 set in the DC. This seems to be true now, but maybe only due to
637 the old font code setting it up. It may be safer to resolve faces
638 and fonts in here and set them explicitly
639 */
640
641 int
642 w32font_draw (struct glyph_string *s, int from, int to,
643 int x, int y, bool with_background)
644 {
645 UINT options;
646 HRGN orig_clip = NULL;
647 int len = to - from;
648 struct w32font_info *w32font = (struct w32font_info *) s->font;
649
650 options = w32font->glyph_idx;
651
652 if (s->num_clips > 0)
653 {
654 HRGN new_clip = CreateRectRgnIndirect (s->clip);
655
656 /* Save clip region for later restoration. */
657 orig_clip = CreateRectRgn (0, 0, 0, 0);
658 if (!GetClipRgn (s->hdc, orig_clip))
659 {
660 DeleteObject (orig_clip);
661 orig_clip = NULL;
662 }
663
664 if (s->num_clips > 1)
665 {
666 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
667
668 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
669 DeleteObject (clip2);
670 }
671
672 SelectClipRgn (s->hdc, new_clip);
673 DeleteObject (new_clip);
674 }
675
676 /* Using OPAQUE background mode can clear more background than expected
677 when Cleartype is used. Draw the background manually to avoid this. */
678 SetBkMode (s->hdc, TRANSPARENT);
679 if (with_background)
680 {
681 HBRUSH brush;
682 RECT rect;
683 struct font *font = s->font;
684
685 brush = CreateSolidBrush (s->gc->background);
686 rect.left = x;
687 rect.top = y - font->ascent;
688 rect.right = x + s->width;
689 rect.bottom = y + font->descent;
690 FillRect (s->hdc, &rect, brush);
691 DeleteObject (brush);
692 }
693
694 if (s->padding_p)
695 {
696 int i;
697
698 for (i = 0; i < len; i++)
699 ExtTextOutW (s->hdc, x + i, y, options, NULL,
700 s->char2b + from + i, 1, NULL);
701 }
702 else
703 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, len, NULL);
704
705 /* Restore clip region. */
706 if (s->num_clips > 0)
707 SelectClipRgn (s->hdc, orig_clip);
708
709 if (orig_clip)
710 DeleteObject (orig_clip);
711
712 return len;
713 }
714
715 /* w32 implementation of free_entity for font backend.
716 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
717 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
718 static void
719 w32font_free_entity (Lisp_Object entity);
720 */
721
722 /* w32 implementation of prepare_face for font backend.
723 Optional (if FACE->extra is not used).
724 Prepare FACE for displaying characters by FONT on frame F by
725 storing some data in FACE->extra. If successful, return 0.
726 Otherwise, return -1.
727 static int
728 w32font_prepare_face (struct frame *f, struct face *face);
729 */
730 /* w32 implementation of done_face for font backend.
731 Optional.
732 Done FACE for displaying characters by FACE->font on frame F.
733 static void
734 w32font_done_face (struct frame *f, struct face *face); */
735
736 /* w32 implementation of get_bitmap for font backend.
737 Optional.
738 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
739 intended that this method is called from the other font-driver
740 for actual drawing.
741 static int
742 w32font_get_bitmap (struct font *font, unsigned code,
743 struct font_bitmap *bitmap, int bits_per_pixel);
744 */
745 /* w32 implementation of free_bitmap for font backend.
746 Optional.
747 Free bitmap data in BITMAP.
748 static void
749 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
750 */
751 /* w32 implementation of anchor_point for font backend.
752 Optional.
753 Get coordinates of the INDEXth anchor point of the glyph whose
754 code is CODE. Store the coordinates in *X and *Y. Return 0 if
755 the operations was successful. Otherwise return -1.
756 static int
757 w32font_anchor_point (struct font *font, unsigned code,
758 int index, int *x, int *y);
759 */
760 /* w32 implementation of otf_capability for font backend.
761 Optional.
762 Return a list describing which scripts/languages FONT
763 supports by which GSUB/GPOS features of OpenType tables.
764 static Lisp_Object
765 w32font_otf_capability (struct font *font);
766 */
767 /* w32 implementation of otf_drive for font backend.
768 Optional.
769 Apply FONT's OTF-FEATURES to the glyph string.
770
771 FEATURES specifies which OTF features to apply in this format:
772 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
773 See the documentation of `font-drive-otf' for the detail.
774
775 This method applies the specified features to the codes in the
776 elements of GSTRING-IN (between FROMth and TOth). The output
777 codes are stored in GSTRING-OUT at the IDXth element and the
778 following elements.
779
780 Return the number of output codes. If none of the features are
781 applicable to the input data, return 0. If GSTRING-OUT is too
782 short, return -1.
783 static int
784 w32font_otf_drive (struct font *font, Lisp_Object features,
785 Lisp_Object gstring_in, int from, int to,
786 Lisp_Object gstring_out, int idx,
787 bool alternate_subst);
788 */
789
790 /* Internal implementation of w32font_list.
791 Additional parameter opentype_only restricts the returned fonts to
792 opentype fonts, which can be used with the Uniscribe backend. */
793 Lisp_Object
794 w32font_list_internal (struct frame *f, Lisp_Object font_spec, int opentype_only)
795 {
796 struct font_callback_data match_data;
797 HDC dc;
798
799 match_data.orig_font_spec = font_spec;
800 match_data.list = Qnil;
801 XSETFRAME (match_data.frame, f);
802
803 memset (&match_data.pattern, 0, sizeof (LOGFONT));
804 fill_in_logfont (f, &match_data.pattern, font_spec);
805
806 /* If the charset is unrecognized, then we won't find a font, so don't
807 waste time looking for one. */
808 if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
809 {
810 Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
811 if (!NILP (spec_charset)
812 && !EQ (spec_charset, Qiso10646_1)
813 && !EQ (spec_charset, Qunicode_bmp)
814 && !EQ (spec_charset, Qunicode_sip)
815 && !EQ (spec_charset, Qunknown))
816 return Qnil;
817 }
818
819 match_data.opentype_only = opentype_only;
820 if (opentype_only)
821 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
822
823 if (match_data.pattern.lfFaceName[0] == '\0')
824 {
825 /* EnumFontFamiliesEx does not take other fields into account if
826 font name is blank, so need to use two passes. */
827 list_all_matching_fonts (&match_data);
828 }
829 else
830 {
831 dc = get_frame_dc (f);
832
833 EnumFontFamiliesEx (dc, &match_data.pattern,
834 (FONTENUMPROC) add_font_entity_to_list,
835 (LPARAM) &match_data, 0);
836 release_frame_dc (f, dc);
837 }
838
839 return match_data.list;
840 }
841
842 /* Internal implementation of w32font_match.
843 Additional parameter opentype_only restricts the returned fonts to
844 opentype fonts, which can be used with the Uniscribe backend. */
845 Lisp_Object
846 w32font_match_internal (struct frame *f, Lisp_Object font_spec, int opentype_only)
847 {
848 struct font_callback_data match_data;
849 HDC dc;
850
851 match_data.orig_font_spec = font_spec;
852 XSETFRAME (match_data.frame, f);
853 match_data.list = Qnil;
854
855 memset (&match_data.pattern, 0, sizeof (LOGFONT));
856 fill_in_logfont (f, &match_data.pattern, font_spec);
857
858 match_data.opentype_only = opentype_only;
859 if (opentype_only)
860 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
861
862 dc = get_frame_dc (f);
863
864 EnumFontFamiliesEx (dc, &match_data.pattern,
865 (FONTENUMPROC) add_one_font_entity_to_list,
866 (LPARAM) &match_data, 0);
867 release_frame_dc (f, dc);
868
869 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
870 }
871
872 int
873 w32font_open_internal (struct frame *f, Lisp_Object font_entity,
874 int pixel_size, Lisp_Object font_object)
875 {
876 int len, size;
877 LOGFONT logfont;
878 HDC dc;
879 HFONT hfont, old_font;
880 Lisp_Object val;
881 struct w32font_info *w32_font;
882 struct font * font;
883 OUTLINETEXTMETRICW* metrics = NULL;
884
885 w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
886 font = (struct font *) w32_font;
887
888 if (!font)
889 return 0;
890
891 memset (&logfont, 0, sizeof (logfont));
892 fill_in_logfont (f, &logfont, font_entity);
893
894 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
895 limitations in bitmap fonts. */
896 val = AREF (font_entity, FONT_FOUNDRY_INDEX);
897 if (!EQ (val, Qraster))
898 logfont.lfOutPrecision = OUT_TT_PRECIS;
899
900 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
901 if (!size)
902 size = pixel_size;
903
904 logfont.lfHeight = -size;
905 hfont = CreateFontIndirect (&logfont);
906
907 if (hfont == NULL)
908 return 0;
909
910 /* Get the metrics for this font. */
911 dc = get_frame_dc (f);
912 old_font = SelectObject (dc, hfont);
913
914 /* Try getting the outline metrics (only works for truetype fonts). */
915 len = get_outline_metrics_w (dc, 0, NULL);
916 if (len)
917 {
918 metrics = (OUTLINETEXTMETRICW *) alloca (len);
919 if (get_outline_metrics_w (dc, len, metrics))
920 memcpy (&w32_font->metrics, &metrics->otmTextMetrics,
921 sizeof (TEXTMETRICW));
922 else
923 metrics = NULL;
924 }
925
926 if (!metrics)
927 get_text_metrics_w (dc, &w32_font->metrics);
928
929 w32_font->cached_metrics = NULL;
930 w32_font->n_cache_blocks = 0;
931
932 SelectObject (dc, old_font);
933 release_frame_dc (f, dc);
934
935 w32_font->hfont = hfont;
936
937 {
938 char *name;
939
940 /* We don't know how much space we need for the full name, so start with
941 96 bytes and go up in steps of 32. */
942 len = 96;
943 name = alloca (len);
944 while (name && w32font_full_name (&logfont, font_entity, pixel_size,
945 name, len) < 0)
946 {
947 len += 32;
948 name = alloca (len);
949 }
950 if (name)
951 font->props[FONT_FULLNAME_INDEX]
952 = DECODE_SYSTEM (build_string (name));
953 else
954 font->props[FONT_FULLNAME_INDEX]
955 = DECODE_SYSTEM (build_string (logfont.lfFaceName));
956 }
957
958 font->max_width = w32_font->metrics.tmMaxCharWidth;
959 /* Parts of Emacs display assume that height = ascent + descent...
960 so height is defined later, after ascent and descent.
961 font->height = w32_font->metrics.tmHeight
962 + w32_font->metrics.tmExternalLeading;
963 */
964
965 font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
966
967 font->vertical_centering = 0;
968 font->baseline_offset = 0;
969 font->relative_compose = 0;
970 font->default_ascent = w32_font->metrics.tmAscent;
971 font->pixel_size = size;
972 font->driver = &w32font_driver;
973 font->encoding_charset = -1;
974 font->repertory_charset = -1;
975 /* TODO: do we really want the minimum width here, which could be negative? */
976 font->min_width = font->space_width;
977 font->ascent = w32_font->metrics.tmAscent;
978 font->descent = w32_font->metrics.tmDescent;
979 font->height = font->ascent + font->descent;
980
981 if (metrics)
982 {
983 font->underline_thickness = metrics->otmsUnderscoreSize;
984 font->underline_position = -metrics->otmsUnderscorePosition;
985 }
986 else
987 {
988 font->underline_thickness = 0;
989 font->underline_position = -1;
990 }
991
992 /* For temporary compatibility with legacy code that expects the
993 name to be usable in x-list-fonts. Eventually we expect to change
994 x-list-fonts and other places that use fonts so that this can be
995 an fcname or similar. */
996 font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
997
998 return 1;
999 }
1000
1001 /* Callback function for EnumFontFamiliesEx.
1002 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
1003 static int CALLBACK ALIGN_STACK
1004 add_font_name_to_list (ENUMLOGFONTEX *logical_font,
1005 NEWTEXTMETRICEX *physical_font,
1006 DWORD font_type, LPARAM list_object)
1007 {
1008 Lisp_Object* list = (Lisp_Object *) list_object;
1009 Lisp_Object family;
1010
1011 /* Skip vertical fonts (intended only for printing) */
1012 if (logical_font->elfLogFont.lfFaceName[0] == '@')
1013 return 1;
1014
1015 family = intern_font_name (logical_font->elfLogFont.lfFaceName);
1016 if (! memq_no_quit (family, *list))
1017 *list = Fcons (family, *list);
1018
1019 return 1;
1020 }
1021
1022 static int w32_decode_weight (int);
1023 static int w32_encode_weight (int);
1024
1025 /* Convert an enumerated Windows font to an Emacs font entity. */
1026 static Lisp_Object
1027 w32_enumfont_pattern_entity (Lisp_Object frame,
1028 ENUMLOGFONTEX *logical_font,
1029 NEWTEXTMETRICEX *physical_font,
1030 DWORD font_type,
1031 LOGFONT *requested_font,
1032 Lisp_Object backend)
1033 {
1034 Lisp_Object entity, tem;
1035 LOGFONT *lf = (LOGFONT*) logical_font;
1036 BYTE generic_type;
1037 DWORD full_type = physical_font->ntmTm.ntmFlags;
1038
1039 entity = font_make_entity ();
1040
1041 ASET (entity, FONT_TYPE_INDEX, backend);
1042 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
1043 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
1044
1045 /* Foundry is difficult to get in readable form on Windows.
1046 But Emacs crashes if it is not set, so set it to something more
1047 generic. These values make xlfds compatible with Emacs 22. */
1048 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
1049 tem = Qraster;
1050 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
1051 tem = Qoutline;
1052 else
1053 tem = Qunknown;
1054
1055 ASET (entity, FONT_FOUNDRY_INDEX, tem);
1056
1057 /* Save the generic family in the extra info, as it is likely to be
1058 useful to users looking for a close match. */
1059 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
1060 if (generic_type == FF_DECORATIVE)
1061 tem = Qdecorative;
1062 else if (generic_type == FF_MODERN)
1063 tem = Qmono;
1064 else if (generic_type == FF_ROMAN)
1065 tem = Qserif;
1066 else if (generic_type == FF_SCRIPT)
1067 tem = Qscript;
1068 else if (generic_type == FF_SWISS)
1069 tem = Qsans;
1070 else
1071 tem = Qnil;
1072
1073 ASET (entity, FONT_ADSTYLE_INDEX, tem);
1074
1075 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
1076 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL));
1077 else
1078 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL));
1079
1080 if (requested_font->lfQuality != DEFAULT_QUALITY)
1081 {
1082 font_put_extra (entity, QCantialias,
1083 lispy_antialias_type (requested_font->lfQuality));
1084 }
1085 ASET (entity, FONT_FAMILY_INDEX,
1086 intern_font_name (lf->lfFaceName));
1087
1088 FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
1089 make_number (w32_decode_weight (lf->lfWeight)));
1090 FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
1091 make_number (lf->lfItalic ? 200 : 100));
1092 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1093 to get it. */
1094 FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100));
1095
1096 if (font_type & RASTER_FONTTYPE)
1097 ASET (entity, FONT_SIZE_INDEX,
1098 make_number (physical_font->ntmTm.tmHeight
1099 + physical_font->ntmTm.tmExternalLeading));
1100 else
1101 ASET (entity, FONT_SIZE_INDEX, make_number (0));
1102
1103 /* Cache Unicode codepoints covered by this font, as there is no other way
1104 of getting this information easily. */
1105 if (font_type & TRUETYPE_FONTTYPE)
1106 {
1107 tem = font_supported_scripts (&physical_font->ntmFontSig);
1108 if (!NILP (tem))
1109 font_put_extra (entity, QCscript, tem);
1110 }
1111
1112 /* This information is not fully available when opening fonts, so
1113 save it here. Only Windows 2000 and later return information
1114 about opentype and type1 fonts, so need a fallback for detecting
1115 truetype so that this information is not any worse than we could
1116 have obtained later. */
1117 if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
1118 tem = intern ("opentype");
1119 else if (font_type & TRUETYPE_FONTTYPE)
1120 tem = intern ("truetype");
1121 else if (full_type & NTM_PS_OPENTYPE)
1122 tem = intern ("postscript");
1123 else if (full_type & NTM_TYPE1)
1124 tem = intern ("type1");
1125 else if (font_type & RASTER_FONTTYPE)
1126 tem = intern ("w32bitmap");
1127 else
1128 tem = intern ("w32vector");
1129
1130 font_put_extra (entity, QCformat, tem);
1131
1132 return entity;
1133 }
1134
1135
1136 /* Convert generic families to the family portion of lfPitchAndFamily. */
1137 static BYTE
1138 w32_generic_family (Lisp_Object name)
1139 {
1140 /* Generic families. */
1141 if (EQ (name, Qmonospace) || EQ (name, Qmono))
1142 return FF_MODERN;
1143 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
1144 return FF_SWISS;
1145 else if (EQ (name, Qserif))
1146 return FF_ROMAN;
1147 else if (EQ (name, Qdecorative))
1148 return FF_DECORATIVE;
1149 else if (EQ (name, Qscript))
1150 return FF_SCRIPT;
1151 else
1152 return FF_DONTCARE;
1153 }
1154
1155 static int
1156 logfonts_match (LOGFONT *font, LOGFONT *pattern)
1157 {
1158 /* Only check height for raster fonts. */
1159 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
1160 && font->lfHeight != pattern->lfHeight)
1161 return 0;
1162
1163 /* Have some flexibility with weights. */
1164 if (pattern->lfWeight
1165 && ((font->lfWeight < (pattern->lfWeight - 150))
1166 || font->lfWeight > (pattern->lfWeight + 150)))
1167 return 0;
1168
1169 /* Charset and face should be OK. Italic has to be checked
1170 against the original spec, in case we don't have any preference. */
1171 return 1;
1172 }
1173
1174 /* Codepage Bitfields in FONTSIGNATURE struct. */
1175 #define CSB_JAPANESE (1 << 17)
1176 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1177 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1178
1179 static int
1180 font_matches_spec (DWORD type, NEWTEXTMETRICEX *font,
1181 Lisp_Object spec, Lisp_Object backend,
1182 LOGFONT *logfont)
1183 {
1184 Lisp_Object extra, val;
1185
1186 /* Check italic. Can't check logfonts, since it is a boolean field,
1187 so there is no difference between "non-italic" and "don't care". */
1188 {
1189 int slant = FONT_SLANT_NUMERIC (spec);
1190
1191 if (slant >= 0
1192 && ((slant > 150 && !font->ntmTm.tmItalic)
1193 || (slant <= 150 && font->ntmTm.tmItalic)))
1194 return 0;
1195 }
1196
1197 /* Check adstyle against generic family. */
1198 val = AREF (spec, FONT_ADSTYLE_INDEX);
1199 if (!NILP (val))
1200 {
1201 BYTE family = w32_generic_family (val);
1202 if (family != FF_DONTCARE
1203 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
1204 return 0;
1205 }
1206
1207 /* Check spacing */
1208 val = AREF (spec, FONT_SPACING_INDEX);
1209 if (INTEGERP (val))
1210 {
1211 int spacing = XINT (val);
1212 int proportional = (spacing < FONT_SPACING_MONO);
1213
1214 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
1215 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
1216 return 0;
1217 }
1218
1219 /* Check extra parameters. */
1220 for (extra = AREF (spec, FONT_EXTRA_INDEX);
1221 CONSP (extra); extra = XCDR (extra))
1222 {
1223 Lisp_Object extra_entry;
1224 extra_entry = XCAR (extra);
1225 if (CONSP (extra_entry))
1226 {
1227 Lisp_Object key = XCAR (extra_entry);
1228
1229 val = XCDR (extra_entry);
1230 if (EQ (key, QCscript) && SYMBOLP (val))
1231 {
1232 /* Only truetype fonts will have information about what
1233 scripts they support. This probably means the user
1234 will have to force Emacs to use raster, PostScript
1235 or ATM fonts for non-ASCII text. */
1236 if (type & TRUETYPE_FONTTYPE)
1237 {
1238 Lisp_Object support
1239 = font_supported_scripts (&font->ntmFontSig);
1240 if (! memq_no_quit (val, support))
1241 return 0;
1242
1243 /* Avoid using non-Japanese fonts for Japanese, even
1244 if they claim they are capable, due to known
1245 breakage in Vista and Windows 7 fonts
1246 (bug#6029). */
1247 if (EQ (val, Qkana)
1248 && (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET
1249 || !(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE)))
1250 return 0;
1251 }
1252 else
1253 {
1254 /* Return specific matches, but play it safe. Fonts
1255 that cover more than their charset would suggest
1256 are likely to be truetype or opentype fonts,
1257 covered above. */
1258 if (EQ (val, Qlatin))
1259 {
1260 /* Although every charset but symbol, thai and
1261 arabic contains the basic ASCII set of latin
1262 characters, Emacs expects much more. */
1263 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
1264 return 0;
1265 }
1266 else if (EQ (val, Qsymbol))
1267 {
1268 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
1269 return 0;
1270 }
1271 else if (EQ (val, Qcyrillic))
1272 {
1273 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
1274 return 0;
1275 }
1276 else if (EQ (val, Qgreek))
1277 {
1278 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
1279 return 0;
1280 }
1281 else if (EQ (val, Qarabic))
1282 {
1283 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
1284 return 0;
1285 }
1286 else if (EQ (val, Qhebrew))
1287 {
1288 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
1289 return 0;
1290 }
1291 else if (EQ (val, Qthai))
1292 {
1293 if (font->ntmTm.tmCharSet != THAI_CHARSET)
1294 return 0;
1295 }
1296 else if (EQ (val, Qkana))
1297 {
1298 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1299 return 0;
1300 }
1301 else if (EQ (val, Qbopomofo))
1302 {
1303 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1304 return 0;
1305 }
1306 else if (EQ (val, Qhangul))
1307 {
1308 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1309 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1310 return 0;
1311 }
1312 else if (EQ (val, Qhan))
1313 {
1314 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1315 && font->ntmTm.tmCharSet != GB2312_CHARSET
1316 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1317 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1318 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1319 return 0;
1320 }
1321 else
1322 /* Other scripts unlikely to be handled by non-truetype
1323 fonts. */
1324 return 0;
1325 }
1326 }
1327 else if (EQ (key, QClang) && SYMBOLP (val))
1328 {
1329 /* Just handle the CJK languages here, as the lang
1330 parameter is used to select a font with appropriate
1331 glyphs in the cjk unified ideographs block. Other fonts
1332 support for a language can be solely determined by
1333 its character coverage. */
1334 if (EQ (val, Qja))
1335 {
1336 if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1337 return 0;
1338 }
1339 else if (EQ (val, Qko))
1340 {
1341 if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
1342 return 0;
1343 }
1344 else if (EQ (val, Qzh))
1345 {
1346 if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
1347 return 0;
1348 }
1349 else
1350 /* Any other language, we don't recognize it. Only the above
1351 currently appear in fontset.el, so it isn't worth
1352 creating a mapping table of codepages/scripts to languages
1353 or opening the font to see if there are any language tags
1354 in it that the Windows API does not expose. Fontset
1355 spec should have a fallback, as some backends do
1356 not recognize language at all. */
1357 return 0;
1358 }
1359 else if (EQ (key, QCotf) && CONSP (val))
1360 {
1361 /* OTF features only supported by the uniscribe backend. */
1362 if (EQ (backend, Quniscribe))
1363 {
1364 if (!uniscribe_check_otf (logfont, val))
1365 return 0;
1366 }
1367 else
1368 return 0;
1369 }
1370 }
1371 }
1372 return 1;
1373 }
1374
1375 static int
1376 w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset)
1377 {
1378 DWORD subrange1 = coverage->fsUsb[1];
1379
1380 #define SUBRANGE1_HAN_MASK 0x08000000
1381 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1382 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1383
1384 if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET)
1385 {
1386 return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK;
1387 }
1388 else if (charset == SHIFTJIS_CHARSET)
1389 {
1390 return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK;
1391 }
1392 else if (charset == HANGEUL_CHARSET)
1393 {
1394 return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK;
1395 }
1396
1397 return 1;
1398 }
1399
1400 #ifndef WINDOWSNT
1401 #define _strlwr strlwr
1402 #endif /* !WINDOWSNT */
1403
1404 static int
1405 check_face_name (LOGFONT *font, char *full_name)
1406 {
1407 char full_iname[LF_FULLFACESIZE+1];
1408
1409 /* Just check for names known to cause problems, since the full name
1410 can contain expanded abbreviations, prefixed foundry, postfixed
1411 style, the latter of which sometimes differs from the style indicated
1412 in the shorter name (eg Lt becomes Light or even Extra Light) */
1413
1414 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1415 installed, we run into problems with the Uniscribe backend which tries
1416 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1417 with Arial's characteristics, since that attempt to use TrueType works
1418 some places, but not others. */
1419 if (!xstrcasecmp (font->lfFaceName, "helvetica"))
1420 {
1421 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1422 full_iname[LF_FULLFACESIZE] = 0;
1423 _strlwr (full_iname);
1424 return strstr ("helvetica", full_iname) != NULL;
1425 }
1426 /* Same for Helv. */
1427 if (!xstrcasecmp (font->lfFaceName, "helv"))
1428 {
1429 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1430 full_iname[LF_FULLFACESIZE] = 0;
1431 _strlwr (full_iname);
1432 return strstr ("helv", full_iname) != NULL;
1433 }
1434
1435 /* Since Times is mapped to Times New Roman, a substring
1436 match is not sufficient to filter out the bogus match. */
1437 else if (!xstrcasecmp (font->lfFaceName, "times"))
1438 return xstrcasecmp (full_name, "times") == 0;
1439
1440 return 1;
1441 }
1442
1443
1444 /* Callback function for EnumFontFamiliesEx.
1445 * Checks if a font matches everything we are trying to check against,
1446 * and if so, adds it to a list. Both the data we are checking against
1447 * and the list to which the fonts are added are passed in via the
1448 * lparam argument, in the form of a font_callback_data struct. */
1449 static int CALLBACK ALIGN_STACK
1450 add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1451 NEWTEXTMETRICEX *physical_font,
1452 DWORD font_type, LPARAM lParam)
1453 {
1454 struct font_callback_data *match_data
1455 = (struct font_callback_data *) lParam;
1456 Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
1457 Lisp_Object entity;
1458
1459 int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1460 || physical_font->ntmFontSig.fsUsb[2]
1461 || physical_font->ntmFontSig.fsUsb[1]
1462 || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1463
1464 /* Skip non matching fonts. */
1465
1466 /* For uniscribe backend, consider only truetype or opentype fonts
1467 that have some Unicode coverage. */
1468 if (match_data->opentype_only
1469 && ((!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
1470 && !(font_type & TRUETYPE_FONTTYPE))
1471 || !is_unicode))
1472 return 1;
1473
1474 /* Ensure a match. */
1475 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1476 || !font_matches_spec (font_type, physical_font,
1477 match_data->orig_font_spec, backend,
1478 &logical_font->elfLogFont)
1479 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1480 match_data->pattern.lfCharSet))
1481 return 1;
1482
1483 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1484 We limit this to raster fonts, because the test can catch some
1485 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1486 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1487 therefore get through this test. Since full names can be prefixed
1488 by a foundry, we accept raster fonts if the font name is found
1489 anywhere within the full name. */
1490 if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
1491 && !strstr (logical_font->elfFullName,
1492 logical_font->elfLogFont.lfFaceName))
1493 /* Check for well known substitutions that mess things up in the
1494 presence of Type-1 fonts of the same name. */
1495 || (!check_face_name (&logical_font->elfLogFont,
1496 logical_font->elfFullName)))
1497 return 1;
1498
1499 /* Make a font entity for the font. */
1500 entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1501 physical_font, font_type,
1502 &match_data->pattern,
1503 backend);
1504
1505 if (!NILP (entity))
1506 {
1507 Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1508 FONT_REGISTRY_INDEX);
1509
1510 /* iso10646-1 fonts must contain Unicode mapping tables. */
1511 if (EQ (spec_charset, Qiso10646_1))
1512 {
1513 if (!is_unicode)
1514 return 1;
1515 }
1516 /* unicode-bmp fonts must contain characters from the BMP. */
1517 else if (EQ (spec_charset, Qunicode_bmp))
1518 {
1519 if (!physical_font->ntmFontSig.fsUsb[3]
1520 && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1521 && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1522 && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1523 return 1;
1524 }
1525 /* unicode-sip fonts must contain characters in Unicode plane 2.
1526 so look for bit 57 (surrogates) in the Unicode subranges, plus
1527 the bits for CJK ranges that include those characters. */
1528 else if (EQ (spec_charset, Qunicode_sip))
1529 {
1530 if (!(physical_font->ntmFontSig.fsUsb[1] & 0x02000000)
1531 || !(physical_font->ntmFontSig.fsUsb[1] & 0x28000000))
1532 return 1;
1533 }
1534
1535 /* This font matches. */
1536
1537 /* If registry was specified, ensure it is reported as the same. */
1538 if (!NILP (spec_charset))
1539 {
1540 /* Avoid using non-Japanese fonts for Japanese, even if they
1541 claim they are capable, due to known breakage in Vista
1542 and Windows 7 fonts (bug#6029). */
1543 if (logical_font->elfLogFont.lfCharSet == SHIFTJIS_CHARSET
1544 && !(physical_font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1545 return 1;
1546 else
1547 ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1548 }
1549 /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1550 fonts as Unicode and skip other charsets. */
1551 else if (match_data->opentype_only)
1552 {
1553 if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1554 || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1555 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1556 else
1557 return 1;
1558 }
1559
1560 /* Add this font to the list. */
1561 match_data->list = Fcons (entity, match_data->list);
1562 }
1563 return 1;
1564 }
1565
1566 /* Callback function for EnumFontFamiliesEx.
1567 * Terminates the search once we have a match. */
1568 static int CALLBACK ALIGN_STACK
1569 add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1570 NEWTEXTMETRICEX *physical_font,
1571 DWORD font_type, LPARAM lParam)
1572 {
1573 struct font_callback_data *match_data
1574 = (struct font_callback_data *) lParam;
1575 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1576
1577 /* If we have a font in the list, terminate the search. */
1578 return NILP (match_data->list);
1579 }
1580
1581 /* Old function to convert from x to w32 charset, from w32fns.c. */
1582 static LONG
1583 x_to_w32_charset (char * lpcs)
1584 {
1585 Lisp_Object this_entry, w32_charset;
1586 char *charset;
1587 int len = strlen (lpcs);
1588
1589 /* Support "*-#nnn" format for unknown charsets. */
1590 if (strncmp (lpcs, "*-#", 3) == 0)
1591 return atoi (lpcs + 3);
1592
1593 /* All Windows fonts qualify as Unicode. */
1594 if (!strncmp (lpcs, "iso10646", 8))
1595 return DEFAULT_CHARSET;
1596
1597 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1598 charset = alloca (len + 1);
1599 strcpy (charset, lpcs);
1600 lpcs = strchr (charset, '*');
1601 if (lpcs)
1602 *lpcs = '\0';
1603
1604 /* Look through w32-charset-info-alist for the character set.
1605 Format of each entry is
1606 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1607 */
1608 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
1609
1610 if (NILP (this_entry))
1611 {
1612 /* At startup, we want iso8859-1 fonts to come up properly. */
1613 if (xstrcasecmp (charset, "iso8859-1") == 0)
1614 return ANSI_CHARSET;
1615 else
1616 return DEFAULT_CHARSET;
1617 }
1618
1619 w32_charset = Fcar (Fcdr (this_entry));
1620
1621 /* Translate Lisp symbol to number. */
1622 if (EQ (w32_charset, Qw32_charset_ansi))
1623 return ANSI_CHARSET;
1624 if (EQ (w32_charset, Qw32_charset_symbol))
1625 return SYMBOL_CHARSET;
1626 if (EQ (w32_charset, Qw32_charset_shiftjis))
1627 return SHIFTJIS_CHARSET;
1628 if (EQ (w32_charset, Qw32_charset_hangeul))
1629 return HANGEUL_CHARSET;
1630 if (EQ (w32_charset, Qw32_charset_chinesebig5))
1631 return CHINESEBIG5_CHARSET;
1632 if (EQ (w32_charset, Qw32_charset_gb2312))
1633 return GB2312_CHARSET;
1634 if (EQ (w32_charset, Qw32_charset_oem))
1635 return OEM_CHARSET;
1636 if (EQ (w32_charset, Qw32_charset_johab))
1637 return JOHAB_CHARSET;
1638 if (EQ (w32_charset, Qw32_charset_easteurope))
1639 return EASTEUROPE_CHARSET;
1640 if (EQ (w32_charset, Qw32_charset_turkish))
1641 return TURKISH_CHARSET;
1642 if (EQ (w32_charset, Qw32_charset_baltic))
1643 return BALTIC_CHARSET;
1644 if (EQ (w32_charset, Qw32_charset_russian))
1645 return RUSSIAN_CHARSET;
1646 if (EQ (w32_charset, Qw32_charset_arabic))
1647 return ARABIC_CHARSET;
1648 if (EQ (w32_charset, Qw32_charset_greek))
1649 return GREEK_CHARSET;
1650 if (EQ (w32_charset, Qw32_charset_hebrew))
1651 return HEBREW_CHARSET;
1652 if (EQ (w32_charset, Qw32_charset_vietnamese))
1653 return VIETNAMESE_CHARSET;
1654 if (EQ (w32_charset, Qw32_charset_thai))
1655 return THAI_CHARSET;
1656 if (EQ (w32_charset, Qw32_charset_mac))
1657 return MAC_CHARSET;
1658
1659 return DEFAULT_CHARSET;
1660 }
1661
1662
1663 /* Convert a Lisp font registry (symbol) to a windows charset. */
1664 static LONG
1665 registry_to_w32_charset (Lisp_Object charset)
1666 {
1667 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1668 || EQ (charset, Qunicode_sip))
1669 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1670 else if (EQ (charset, Qiso8859_1))
1671 return ANSI_CHARSET;
1672 else if (SYMBOLP (charset))
1673 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
1674 else
1675 return DEFAULT_CHARSET;
1676 }
1677
1678 /* Old function to convert from w32 to x charset, from w32fns.c. */
1679 static char *
1680 w32_to_x_charset (int fncharset, char *matching)
1681 {
1682 static char buf[32];
1683 Lisp_Object charset_type;
1684 int match_len = 0;
1685
1686 if (matching)
1687 {
1688 /* If fully specified, accept it as it is. Otherwise use a
1689 substring match. */
1690 char *wildcard = strchr (matching, '*');
1691 if (wildcard)
1692 *wildcard = '\0';
1693 else if (strchr (matching, '-'))
1694 return matching;
1695
1696 match_len = strlen (matching);
1697 }
1698
1699 switch (fncharset)
1700 {
1701 case ANSI_CHARSET:
1702 /* Handle startup case of w32-charset-info-alist not
1703 being set up yet. */
1704 if (NILP (Vw32_charset_info_alist))
1705 return "iso8859-1";
1706 charset_type = Qw32_charset_ansi;
1707 break;
1708 case DEFAULT_CHARSET:
1709 charset_type = Qw32_charset_default;
1710 break;
1711 case SYMBOL_CHARSET:
1712 charset_type = Qw32_charset_symbol;
1713 break;
1714 case SHIFTJIS_CHARSET:
1715 charset_type = Qw32_charset_shiftjis;
1716 break;
1717 case HANGEUL_CHARSET:
1718 charset_type = Qw32_charset_hangeul;
1719 break;
1720 case GB2312_CHARSET:
1721 charset_type = Qw32_charset_gb2312;
1722 break;
1723 case CHINESEBIG5_CHARSET:
1724 charset_type = Qw32_charset_chinesebig5;
1725 break;
1726 case OEM_CHARSET:
1727 charset_type = Qw32_charset_oem;
1728 break;
1729 case EASTEUROPE_CHARSET:
1730 charset_type = Qw32_charset_easteurope;
1731 break;
1732 case TURKISH_CHARSET:
1733 charset_type = Qw32_charset_turkish;
1734 break;
1735 case BALTIC_CHARSET:
1736 charset_type = Qw32_charset_baltic;
1737 break;
1738 case RUSSIAN_CHARSET:
1739 charset_type = Qw32_charset_russian;
1740 break;
1741 case ARABIC_CHARSET:
1742 charset_type = Qw32_charset_arabic;
1743 break;
1744 case GREEK_CHARSET:
1745 charset_type = Qw32_charset_greek;
1746 break;
1747 case HEBREW_CHARSET:
1748 charset_type = Qw32_charset_hebrew;
1749 break;
1750 case VIETNAMESE_CHARSET:
1751 charset_type = Qw32_charset_vietnamese;
1752 break;
1753 case THAI_CHARSET:
1754 charset_type = Qw32_charset_thai;
1755 break;
1756 case MAC_CHARSET:
1757 charset_type = Qw32_charset_mac;
1758 break;
1759 case JOHAB_CHARSET:
1760 charset_type = Qw32_charset_johab;
1761 break;
1762
1763 default:
1764 /* Encode numerical value of unknown charset. */
1765 sprintf (buf, "*-#%u", fncharset);
1766 return buf;
1767 }
1768
1769 {
1770 Lisp_Object rest;
1771 char * best_match = NULL;
1772 int matching_found = 0;
1773
1774 /* Look through w32-charset-info-alist for the character set.
1775 Prefer ISO codepages, and prefer lower numbers in the ISO
1776 range. Only return charsets for codepages which are installed.
1777
1778 Format of each entry is
1779 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1780 */
1781 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1782 {
1783 char * x_charset;
1784 Lisp_Object w32_charset;
1785 Lisp_Object codepage;
1786
1787 Lisp_Object this_entry = XCAR (rest);
1788
1789 /* Skip invalid entries in alist. */
1790 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1791 || !CONSP (XCDR (this_entry))
1792 || !SYMBOLP (XCAR (XCDR (this_entry))))
1793 continue;
1794
1795 x_charset = SDATA (XCAR (this_entry));
1796 w32_charset = XCAR (XCDR (this_entry));
1797 codepage = XCDR (XCDR (this_entry));
1798
1799 /* Look for Same charset and a valid codepage (or non-int
1800 which means ignore). */
1801 if (EQ (w32_charset, charset_type)
1802 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
1803 || IsValidCodePage (XINT (codepage))))
1804 {
1805 /* If we don't have a match already, then this is the
1806 best. */
1807 if (!best_match)
1808 {
1809 best_match = x_charset;
1810 if (matching && !strnicmp (x_charset, matching, match_len))
1811 matching_found = 1;
1812 }
1813 /* If we already found a match for MATCHING, then
1814 only consider other matches. */
1815 else if (matching_found
1816 && strnicmp (x_charset, matching, match_len))
1817 continue;
1818 /* If this matches what we want, and the best so far doesn't,
1819 then this is better. */
1820 else if (!matching_found && matching
1821 && !strnicmp (x_charset, matching, match_len))
1822 {
1823 best_match = x_charset;
1824 matching_found = 1;
1825 }
1826 /* If this is fully specified, and the best so far isn't,
1827 then this is better. */
1828 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1829 /* If this is an ISO codepage, and the best so far isn't,
1830 then this is better, but only if it fully specifies the
1831 encoding. */
1832 || (strnicmp (best_match, "iso", 3) != 0
1833 && strnicmp (x_charset, "iso", 3) == 0
1834 && strchr (x_charset, '-')))
1835 best_match = x_charset;
1836 /* If both are ISO8859 codepages, choose the one with the
1837 lowest number in the encoding field. */
1838 else if (strnicmp (best_match, "iso8859-", 8) == 0
1839 && strnicmp (x_charset, "iso8859-", 8) == 0)
1840 {
1841 int best_enc = atoi (best_match + 8);
1842 int this_enc = atoi (x_charset + 8);
1843 if (this_enc > 0 && this_enc < best_enc)
1844 best_match = x_charset;
1845 }
1846 }
1847 }
1848
1849 /* If no match, encode the numeric value. */
1850 if (!best_match)
1851 {
1852 sprintf (buf, "*-#%u", fncharset);
1853 return buf;
1854 }
1855
1856 strncpy (buf, best_match, 31);
1857 /* If the charset is not fully specified, put -0 on the end. */
1858 if (!strchr (best_match, '-'))
1859 {
1860 int pos = strlen (best_match);
1861 /* Charset specifiers shouldn't be very long. If it is a made
1862 up one, truncating it should not do any harm since it isn't
1863 recognized anyway. */
1864 if (pos > 29)
1865 pos = 29;
1866 strcpy (buf + pos, "-0");
1867 }
1868 buf[31] = '\0';
1869 return buf;
1870 }
1871 }
1872
1873 static Lisp_Object
1874 w32_registry (LONG w32_charset, DWORD font_type)
1875 {
1876 char *charset;
1877
1878 /* If charset is defaulted, charset is Unicode or unknown, depending on
1879 font type. */
1880 if (w32_charset == DEFAULT_CHARSET)
1881 return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
1882
1883 charset = w32_to_x_charset (w32_charset, NULL);
1884 return font_intern_prop (charset, strlen (charset), 1);
1885 }
1886
1887 static int
1888 w32_decode_weight (int fnweight)
1889 {
1890 if (fnweight >= FW_HEAVY) return 210;
1891 if (fnweight >= FW_EXTRABOLD) return 205;
1892 if (fnweight >= FW_BOLD) return 200;
1893 if (fnweight >= FW_SEMIBOLD) return 180;
1894 if (fnweight >= FW_NORMAL) return 100;
1895 if (fnweight >= FW_LIGHT) return 50;
1896 if (fnweight >= FW_EXTRALIGHT) return 40;
1897 if (fnweight > FW_THIN) return 20;
1898 return 0;
1899 }
1900
1901 static int
1902 w32_encode_weight (int n)
1903 {
1904 if (n >= 210) return FW_HEAVY;
1905 if (n >= 205) return FW_EXTRABOLD;
1906 if (n >= 200) return FW_BOLD;
1907 if (n >= 180) return FW_SEMIBOLD;
1908 if (n >= 100) return FW_NORMAL;
1909 if (n >= 50) return FW_LIGHT;
1910 if (n >= 40) return FW_EXTRALIGHT;
1911 if (n >= 20) return FW_THIN;
1912 return 0;
1913 }
1914
1915 /* Convert a Windows font weight into one of the weights supported
1916 by fontconfig (see font.c:font_parse_fcname). */
1917 static Lisp_Object
1918 w32_to_fc_weight (int n)
1919 {
1920 if (n >= FW_EXTRABOLD) return intern ("black");
1921 if (n >= FW_BOLD) return intern ("bold");
1922 if (n >= FW_SEMIBOLD) return intern ("demibold");
1923 if (n >= FW_NORMAL) return intern ("medium");
1924 return intern ("light");
1925 }
1926
1927 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1928 static void
1929 fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec)
1930 {
1931 Lisp_Object tmp, extra;
1932 int dpi = FRAME_RES_Y (f);
1933
1934 tmp = AREF (font_spec, FONT_DPI_INDEX);
1935 if (INTEGERP (tmp))
1936 {
1937 dpi = XINT (tmp);
1938 }
1939 else if (FLOATP (tmp))
1940 {
1941 dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
1942 }
1943
1944 /* Height */
1945 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1946 if (INTEGERP (tmp))
1947 logfont->lfHeight = -1 * XINT (tmp);
1948 else if (FLOATP (tmp))
1949 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
1950
1951 /* Escapement */
1952
1953 /* Orientation */
1954
1955 /* Weight */
1956 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1957 if (INTEGERP (tmp))
1958 logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
1959
1960 /* Italic */
1961 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1962 if (INTEGERP (tmp))
1963 {
1964 int slant = FONT_SLANT_NUMERIC (font_spec);
1965 logfont->lfItalic = slant > 150 ? 1 : 0;
1966 }
1967
1968 /* Underline */
1969
1970 /* Strikeout */
1971
1972 /* Charset */
1973 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
1974 if (! NILP (tmp))
1975 logfont->lfCharSet = registry_to_w32_charset (tmp);
1976 else
1977 logfont->lfCharSet = DEFAULT_CHARSET;
1978
1979 /* Out Precision */
1980
1981 /* Clip Precision */
1982
1983 /* Quality */
1984 logfont->lfQuality = DEFAULT_QUALITY;
1985
1986 /* Generic Family and Face Name */
1987 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
1988
1989 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
1990 if (! NILP (tmp))
1991 {
1992 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
1993 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
1994 ; /* Font name was generic, don't fill in font name. */
1995 /* Font families are interned, but allow for strings also in case of
1996 user input. */
1997 else if (SYMBOLP (tmp))
1998 {
1999 strncpy (logfont->lfFaceName,
2000 SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
2001 logfont->lfFaceName[LF_FACESIZE-1] = '\0';
2002 }
2003 }
2004
2005 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
2006 if (!NILP (tmp))
2007 {
2008 /* Override generic family. */
2009 BYTE family = w32_generic_family (tmp);
2010 if (family != FF_DONTCARE)
2011 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
2012 }
2013
2014 /* Set pitch based on the spacing property. */
2015 tmp = AREF (font_spec, FONT_SPACING_INDEX);
2016 if (INTEGERP (tmp))
2017 {
2018 int spacing = XINT (tmp);
2019 if (spacing < FONT_SPACING_MONO)
2020 logfont->lfPitchAndFamily
2021 = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
2022 else
2023 logfont->lfPitchAndFamily
2024 = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
2025 }
2026
2027 /* Process EXTRA info. */
2028 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
2029 CONSP (extra); extra = XCDR (extra))
2030 {
2031 tmp = XCAR (extra);
2032 if (CONSP (tmp))
2033 {
2034 Lisp_Object key, val;
2035 key = XCAR (tmp), val = XCDR (tmp);
2036 /* Only use QCscript if charset is not provided, or is Unicode
2037 and a single script is specified. This is rather crude,
2038 and is only used to narrow down the fonts returned where
2039 there is a definite match. Some scripts, such as latin, han,
2040 cjk-misc match multiple lfCharSet values, so we can't pre-filter
2041 them. */
2042 if (EQ (key, QCscript)
2043 && logfont->lfCharSet == DEFAULT_CHARSET
2044 && SYMBOLP (val))
2045 {
2046 if (EQ (val, Qgreek))
2047 logfont->lfCharSet = GREEK_CHARSET;
2048 else if (EQ (val, Qhangul))
2049 logfont->lfCharSet = HANGUL_CHARSET;
2050 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
2051 logfont->lfCharSet = SHIFTJIS_CHARSET;
2052 else if (EQ (val, Qbopomofo))
2053 logfont->lfCharSet = CHINESEBIG5_CHARSET;
2054 /* GB 18030 supports tibetan, yi, mongolian,
2055 fonts that support it should show up if we ask for
2056 GB2312 fonts. */
2057 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
2058 || EQ (val, Qmongolian))
2059 logfont->lfCharSet = GB2312_CHARSET;
2060 else if (EQ (val, Qhebrew))
2061 logfont->lfCharSet = HEBREW_CHARSET;
2062 else if (EQ (val, Qarabic))
2063 logfont->lfCharSet = ARABIC_CHARSET;
2064 else if (EQ (val, Qthai))
2065 logfont->lfCharSet = THAI_CHARSET;
2066 }
2067 else if (EQ (key, QCantialias) && SYMBOLP (val))
2068 {
2069 logfont->lfQuality = w32_antialias_type (val);
2070 }
2071 }
2072 }
2073 }
2074
2075 static void
2076 list_all_matching_fonts (struct font_callback_data *match_data)
2077 {
2078 HDC dc;
2079 Lisp_Object families = w32font_list_family (XFRAME (match_data->frame));
2080 struct frame *f = XFRAME (match_data->frame);
2081
2082 dc = get_frame_dc (f);
2083
2084 while (!NILP (families))
2085 {
2086 /* Only fonts from the current locale are given localized names
2087 on Windows, so we can keep backwards compatibility with
2088 Windows 9x/ME by using non-Unicode font enumeration without
2089 sacrificing internationalization here. */
2090 char *name;
2091 Lisp_Object family = CAR (families);
2092 families = CDR (families);
2093 if (NILP (family))
2094 continue;
2095 else if (SYMBOLP (family))
2096 name = SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
2097 else
2098 continue;
2099
2100 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2101 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2102
2103 EnumFontFamiliesEx (dc, &match_data->pattern,
2104 (FONTENUMPROC) add_font_entity_to_list,
2105 (LPARAM) match_data, 0);
2106 }
2107
2108 release_frame_dc (f, dc);
2109 }
2110
2111 static Lisp_Object
2112 lispy_antialias_type (BYTE type)
2113 {
2114 Lisp_Object lispy;
2115
2116 switch (type)
2117 {
2118 case NONANTIALIASED_QUALITY:
2119 lispy = Qnone;
2120 break;
2121 case ANTIALIASED_QUALITY:
2122 lispy = Qstandard;
2123 break;
2124 case CLEARTYPE_QUALITY:
2125 lispy = Qsubpixel;
2126 break;
2127 case CLEARTYPE_NATURAL_QUALITY:
2128 lispy = Qnatural;
2129 break;
2130 default:
2131 lispy = Qnil;
2132 break;
2133 }
2134 return lispy;
2135 }
2136
2137 /* Convert antialiasing symbols to lfQuality */
2138 static BYTE
2139 w32_antialias_type (Lisp_Object type)
2140 {
2141 if (EQ (type, Qnone))
2142 return NONANTIALIASED_QUALITY;
2143 else if (EQ (type, Qstandard))
2144 return ANTIALIASED_QUALITY;
2145 else if (EQ (type, Qsubpixel))
2146 return CLEARTYPE_QUALITY;
2147 else if (EQ (type, Qnatural))
2148 return CLEARTYPE_NATURAL_QUALITY;
2149 else
2150 return DEFAULT_QUALITY;
2151 }
2152
2153 /* Return a list of all the scripts that the font supports. */
2154 static Lisp_Object
2155 font_supported_scripts (FONTSIGNATURE * sig)
2156 {
2157 DWORD * subranges = sig->fsUsb;
2158 Lisp_Object supported = Qnil;
2159
2160 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2161 #define SUBRANGE(n,sym) \
2162 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2163 supported = Fcons ((sym), supported)
2164
2165 /* Match multiple subranges. SYM is set if any MASK bit is set in
2166 subranges[0 - 3]. */
2167 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2168 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2169 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2170 supported = Fcons ((sym), supported)
2171
2172 SUBRANGE (0, Qlatin);
2173 /* The following count as latin too, ASCII should be present in these fonts,
2174 so don't need to mark them separately. */
2175 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2176 SUBRANGE (4, Qphonetic);
2177 /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */
2178 SUBRANGE (7, Qgreek);
2179 SUBRANGE (8, Qcoptic);
2180 SUBRANGE (9, Qcyrillic);
2181 SUBRANGE (10, Qarmenian);
2182 SUBRANGE (11, Qhebrew);
2183 /* 12: Vai. */
2184 SUBRANGE (13, Qarabic);
2185 SUBRANGE (14, Qnko);
2186 SUBRANGE (15, Qdevanagari);
2187 SUBRANGE (16, Qbengali);
2188 SUBRANGE (17, Qgurmukhi);
2189 SUBRANGE (18, Qgujarati);
2190 SUBRANGE (19, Qoriya);
2191 SUBRANGE (20, Qtamil);
2192 SUBRANGE (21, Qtelugu);
2193 SUBRANGE (22, Qkannada);
2194 SUBRANGE (23, Qmalayalam);
2195 SUBRANGE (24, Qthai);
2196 SUBRANGE (25, Qlao);
2197 SUBRANGE (26, Qgeorgian);
2198 SUBRANGE (27, Qbalinese);
2199 /* 28: Hangul Jamo. */
2200 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2201 /* 32-47: Symbols (defined below). */
2202 SUBRANGE (48, Qcjk_misc);
2203 /* Match either 49: katakana or 50: hiragana for kana. */
2204 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
2205 SUBRANGE (51, Qbopomofo);
2206 /* 52: Compatibility Jamo */
2207 SUBRANGE (53, Qphags_pa);
2208 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2209 SUBRANGE (56, Qhangul);
2210 /* 57: Surrogates. */
2211 SUBRANGE (58, Qphoenician);
2212 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
2213 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2214 SUBRANGE (59, Qkanbun); /* And this. */
2215 /* 60: Private use, 61: CJK strokes and compatibility. */
2216 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2217 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2218 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2219 /* 69: Specials. */
2220 SUBRANGE (70, Qtibetan);
2221 SUBRANGE (71, Qsyriac);
2222 SUBRANGE (72, Qthaana);
2223 SUBRANGE (73, Qsinhala);
2224 SUBRANGE (74, Qmyanmar);
2225 SUBRANGE (75, Qethiopic);
2226 SUBRANGE (76, Qcherokee);
2227 SUBRANGE (77, Qcanadian_aboriginal);
2228 SUBRANGE (78, Qogham);
2229 SUBRANGE (79, Qrunic);
2230 SUBRANGE (80, Qkhmer);
2231 SUBRANGE (81, Qmongolian);
2232 SUBRANGE (82, Qbraille);
2233 SUBRANGE (83, Qyi);
2234 SUBRANGE (84, Qbuhid);
2235 SUBRANGE (84, Qhanunoo);
2236 SUBRANGE (84, Qtagalog);
2237 SUBRANGE (84, Qtagbanwa);
2238 SUBRANGE (85, Qold_italic);
2239 SUBRANGE (86, Qgothic);
2240 SUBRANGE (87, Qdeseret);
2241 SUBRANGE (88, Qbyzantine_musical_symbol);
2242 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
2243 SUBRANGE (89, Qmathematical);
2244 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2245 SUBRANGE (93, Qlimbu);
2246 SUBRANGE (94, Qtai_le);
2247 /* 95: New Tai Le */
2248 SUBRANGE (90, Qbuginese);
2249 SUBRANGE (97, Qglagolitic);
2250 SUBRANGE (98, Qtifinagh);
2251 /* 99: Yijing Hexagrams. */
2252 SUBRANGE (100, Qsyloti_nagri);
2253 SUBRANGE (101, Qlinear_b);
2254 /* 102: Ancient Greek Numbers. */
2255 SUBRANGE (103, Qugaritic);
2256 SUBRANGE (104, Qold_persian);
2257 SUBRANGE (105, Qshavian);
2258 SUBRANGE (106, Qosmanya);
2259 SUBRANGE (107, Qcypriot);
2260 SUBRANGE (108, Qkharoshthi);
2261 /* 109: Tai Xuan Jing. */
2262 SUBRANGE (110, Qcuneiform);
2263 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2264 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2265 SUBRANGE (118, Qcham);
2266 /* 119: Ancient symbols, 120: Phaistos Disc. */
2267 /* 121: Carian, Lycian, Lydian, 122: Dominoes, Mahjong tiles. */
2268 /* 123-127: Reserved. */
2269
2270 /* There isn't really a main symbol range, so include symbol if any
2271 relevant range is set. */
2272 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2273
2274 /* Missing: Tai Viet (U+AA80-U+AADF). */
2275 #undef SUBRANGE
2276 #undef MASK_ANY
2277
2278 return supported;
2279 }
2280
2281 /* Generate a full name for a Windows font.
2282 The full name is in fcname format, with weight, slant and antialiasing
2283 specified if they are not "normal". */
2284 static int
2285 w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
2286 int pixel_size, char *name, int nbytes)
2287 {
2288 int len, height, outline;
2289 char *p;
2290 Lisp_Object antialiasing, weight = Qnil;
2291
2292 len = strlen (font->lfFaceName);
2293
2294 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2295
2296 /* Represent size of scalable fonts by point size. But use pixelsize for
2297 raster fonts to indicate that they are exactly that size. */
2298 if (outline)
2299 len += 11; /* -SIZE */
2300 else
2301 len += 21;
2302
2303 if (font->lfItalic)
2304 len += 7; /* :italic */
2305
2306 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2307 {
2308 weight = w32_to_fc_weight (font->lfWeight);
2309 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
2310 }
2311
2312 antialiasing = lispy_antialias_type (font->lfQuality);
2313 if (! NILP (antialiasing))
2314 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2315
2316 /* Check that the buffer is big enough */
2317 if (len > nbytes)
2318 return -1;
2319
2320 p = name;
2321 p += sprintf (p, "%s", font->lfFaceName);
2322
2323 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2324
2325 if (height > 0)
2326 {
2327 if (outline)
2328 {
2329 float pointsize = height * 72.0 / one_w32_display_info.resy;
2330 /* Round to nearest half point. floor is used, since round is not
2331 supported in MS library. */
2332 pointsize = floor (pointsize * 2 + 0.5) / 2;
2333 p += sprintf (p, "-%1.1f", pointsize);
2334 }
2335 else
2336 p += sprintf (p, ":pixelsize=%d", height);
2337 }
2338
2339 if (SYMBOLP (weight) && ! NILP (weight))
2340 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2341
2342 if (font->lfItalic)
2343 p += sprintf (p, ":italic");
2344
2345 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2346 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2347
2348 return (p - name);
2349 }
2350
2351 /* Convert a logfont and point size into a fontconfig style font name.
2352 POINTSIZE is in tenths of points.
2353 If SIZE indicates the size of buffer FCNAME, into which the font name
2354 is written. If the buffer is not large enough to contain the name,
2355 the function returns -1, otherwise it returns the number of bytes
2356 written to FCNAME. */
2357 static int
2358 logfont_to_fcname (LOGFONT* font, int pointsize, char *fcname, int size)
2359 {
2360 int len, height;
2361 char *p = fcname;
2362 Lisp_Object weight = Qnil;
2363
2364 len = strlen (font->lfFaceName) + 2;
2365 height = pointsize / 10;
2366 while (height /= 10)
2367 len++;
2368
2369 if (pointsize % 10)
2370 len += 2;
2371
2372 if (font->lfItalic)
2373 len += 7; /* :italic */
2374 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2375 {
2376 weight = w32_to_fc_weight (font->lfWeight);
2377 len += SBYTES (SYMBOL_NAME (weight)) + 1;
2378 }
2379
2380 if (len > size)
2381 return -1;
2382
2383 p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2384 if (pointsize % 10)
2385 p += sprintf (p, ".%d", pointsize % 10);
2386
2387 if (SYMBOLP (weight) && !NILP (weight))
2388 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2389
2390 if (font->lfItalic)
2391 p += sprintf (p, ":italic");
2392
2393 return (p - fcname);
2394 }
2395
2396 static void
2397 compute_metrics (HDC dc, struct w32font_info *w32_font, unsigned int code,
2398 struct w32_metric_cache *metrics)
2399 {
2400 GLYPHMETRICS gm;
2401 MAT2 transform;
2402 unsigned int options = GGO_METRICS;
2403 INT width;
2404
2405 if (w32_font->glyph_idx)
2406 options |= GGO_GLYPH_INDEX;
2407
2408 memset (&transform, 0, sizeof (transform));
2409 transform.eM11.value = 1;
2410 transform.eM22.value = 1;
2411
2412 if (get_glyph_outline_w (dc, code, options, &gm, 0, NULL, &transform)
2413 != GDI_ERROR)
2414 {
2415 metrics->lbearing = gm.gmptGlyphOrigin.x;
2416 metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2417 metrics->width = gm.gmCellIncX;
2418 metrics->status = W32METRIC_SUCCESS;
2419 }
2420 else if (get_char_width_32_w (dc, code, code, &width) != 0)
2421 {
2422 metrics->lbearing = 0;
2423 metrics->rbearing = width;
2424 metrics->width = width;
2425 metrics->status = W32METRIC_SUCCESS;
2426 }
2427 else
2428 metrics->status = W32METRIC_FAIL;
2429 }
2430
2431 DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2432 doc: /* Read a font name using a W32 font selection dialog.
2433 Return fontconfig style font string corresponding to the selection.
2434
2435 If FRAME is omitted or nil, it defaults to the selected frame.
2436 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2437 in the font selection dialog. */)
2438 (Lisp_Object frame, Lisp_Object exclude_proportional)
2439 {
2440 struct frame *f = decode_window_system_frame (frame);
2441 CHOOSEFONT cf;
2442 LOGFONT lf;
2443 TEXTMETRIC tm;
2444 HDC hdc;
2445 HANDLE oldobj;
2446 char buf[100];
2447
2448 memset (&cf, 0, sizeof (cf));
2449 memset (&lf, 0, sizeof (lf));
2450
2451 cf.lStructSize = sizeof (cf);
2452 cf.hwndOwner = FRAME_W32_WINDOW (f);
2453 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2454
2455 /* If exclude_proportional is non-nil, limit the selection to
2456 monospaced fonts. */
2457 if (!NILP (exclude_proportional))
2458 cf.Flags |= CF_FIXEDPITCHONLY;
2459
2460 cf.lpLogFont = &lf;
2461
2462 /* Initialize as much of the font details as we can from the current
2463 default font. */
2464 hdc = GetDC (FRAME_W32_WINDOW (f));
2465 oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
2466 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2467 if (GetTextMetrics (hdc, &tm))
2468 {
2469 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2470 lf.lfWeight = tm.tmWeight;
2471 lf.lfItalic = tm.tmItalic;
2472 lf.lfUnderline = tm.tmUnderlined;
2473 lf.lfStrikeOut = tm.tmStruckOut;
2474 lf.lfCharSet = tm.tmCharSet;
2475 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2476 }
2477 SelectObject (hdc, oldobj);
2478 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2479
2480 if (!ChooseFont (&cf)
2481 || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
2482 return Qnil;
2483
2484 return DECODE_SYSTEM (build_string (buf));
2485 }
2486
2487 static const char *const w32font_booleans [] = {
2488 NULL,
2489 };
2490
2491 static const char *const w32font_non_booleans [] = {
2492 ":script",
2493 ":antialias",
2494 ":style",
2495 NULL,
2496 };
2497
2498 static void
2499 w32font_filter_properties (Lisp_Object font, Lisp_Object alist)
2500 {
2501 font_filter_properties (font, alist, w32font_booleans, w32font_non_booleans);
2502 }
2503
2504 struct font_driver w32font_driver =
2505 {
2506 LISP_INITIALLY_ZERO, /* Qgdi */
2507 0, /* case insensitive */
2508 w32font_get_cache,
2509 w32font_list,
2510 w32font_match,
2511 w32font_list_family,
2512 NULL, /* free_entity */
2513 w32font_open,
2514 w32font_close,
2515 NULL, /* prepare_face */
2516 NULL, /* done_face */
2517 w32font_has_char,
2518 w32font_encode_char,
2519 w32font_text_extents,
2520 w32font_draw,
2521 NULL, /* get_bitmap */
2522 NULL, /* free_bitmap */
2523 NULL, /* anchor_point */
2524 NULL, /* otf_capability */
2525 NULL, /* otf_drive */
2526 NULL, /* start_for_frame */
2527 NULL, /* end_for_frame */
2528 NULL, /* shape */
2529 NULL, /* check */
2530 NULL, /* get_variation_glyphs */
2531 w32font_filter_properties,
2532 NULL, /* cached_font_ok */
2533 };
2534
2535
2536 /* Initialize state that does not change between invocations. This is only
2537 called when Emacs is dumped. */
2538 void
2539 syms_of_w32font (void)
2540 {
2541 DEFSYM (Qgdi, "gdi");
2542 DEFSYM (Quniscribe, "uniscribe");
2543 DEFSYM (QCformat, ":format");
2544
2545 /* Generic font families. */
2546 DEFSYM (Qmonospace, "monospace");
2547 DEFSYM (Qserif, "serif");
2548 DEFSYM (Qsansserif, "sansserif");
2549 DEFSYM (Qscript, "script");
2550 DEFSYM (Qdecorative, "decorative");
2551 /* Aliases. */
2552 DEFSYM (Qsans_serif, "sans_serif");
2553 DEFSYM (Qsans, "sans");
2554 DEFSYM (Qmono, "mono");
2555
2556 /* Fake foundries. */
2557 DEFSYM (Qraster, "raster");
2558 DEFSYM (Qoutline, "outline");
2559 DEFSYM (Qunknown, "unknown");
2560
2561 /* Antialiasing. */
2562 DEFSYM (Qstandard, "standard");
2563 DEFSYM (Qsubpixel, "subpixel");
2564 DEFSYM (Qnatural, "natural");
2565
2566 /* Languages */
2567 DEFSYM (Qzh, "zh");
2568
2569 /* Scripts */
2570 DEFSYM (Qlatin, "latin");
2571 DEFSYM (Qgreek, "greek");
2572 DEFSYM (Qcoptic, "coptic");
2573 DEFSYM (Qcyrillic, "cyrillic");
2574 DEFSYM (Qarmenian, "armenian");
2575 DEFSYM (Qhebrew, "hebrew");
2576 DEFSYM (Qarabic, "arabic");
2577 DEFSYM (Qsyriac, "syriac");
2578 DEFSYM (Qnko, "nko");
2579 DEFSYM (Qthaana, "thaana");
2580 DEFSYM (Qdevanagari, "devanagari");
2581 DEFSYM (Qbengali, "bengali");
2582 DEFSYM (Qgurmukhi, "gurmukhi");
2583 DEFSYM (Qgujarati, "gujarati");
2584 DEFSYM (Qoriya, "oriya");
2585 DEFSYM (Qtamil, "tamil");
2586 DEFSYM (Qtelugu, "telugu");
2587 DEFSYM (Qkannada, "kannada");
2588 DEFSYM (Qmalayalam, "malayalam");
2589 DEFSYM (Qsinhala, "sinhala");
2590 DEFSYM (Qthai, "thai");
2591 DEFSYM (Qlao, "lao");
2592 DEFSYM (Qtibetan, "tibetan");
2593 DEFSYM (Qmyanmar, "myanmar");
2594 DEFSYM (Qgeorgian, "georgian");
2595 DEFSYM (Qhangul, "hangul");
2596 DEFSYM (Qethiopic, "ethiopic");
2597 DEFSYM (Qcherokee, "cherokee");
2598 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2599 DEFSYM (Qogham, "ogham");
2600 DEFSYM (Qrunic, "runic");
2601 DEFSYM (Qkhmer, "khmer");
2602 DEFSYM (Qmongolian, "mongolian");
2603 DEFSYM (Qbraille, "braille");
2604 DEFSYM (Qhan, "han");
2605 DEFSYM (Qideographic_description, "ideographic-description");
2606 DEFSYM (Qcjk_misc, "cjk-misc");
2607 DEFSYM (Qkana, "kana");
2608 DEFSYM (Qbopomofo, "bopomofo");
2609 DEFSYM (Qkanbun, "kanbun");
2610 DEFSYM (Qyi, "yi");
2611 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2612 DEFSYM (Qmusical_symbol, "musical-symbol");
2613 DEFSYM (Qmathematical, "mathematical");
2614 DEFSYM (Qcham, "cham");
2615 DEFSYM (Qphonetic, "phonetic");
2616 DEFSYM (Qbalinese, "balinese");
2617 DEFSYM (Qbuginese, "buginese");
2618 DEFSYM (Qbuhid, "buhid");
2619 DEFSYM (Qcuneiform, "cuneiform");
2620 DEFSYM (Qcypriot, "cypriot");
2621 DEFSYM (Qdeseret, "deseret");
2622 DEFSYM (Qglagolitic, "glagolitic");
2623 DEFSYM (Qgothic, "gothic");
2624 DEFSYM (Qhanunoo, "hanunoo");
2625 DEFSYM (Qkharoshthi, "kharoshthi");
2626 DEFSYM (Qlimbu, "limbu");
2627 DEFSYM (Qlinear_b, "linear_b");
2628 DEFSYM (Qold_italic, "old_italic");
2629 DEFSYM (Qold_persian, "old_persian");
2630 DEFSYM (Qosmanya, "osmanya");
2631 DEFSYM (Qphags_pa, "phags-pa");
2632 DEFSYM (Qphoenician, "phoenician");
2633 DEFSYM (Qshavian, "shavian");
2634 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2635 DEFSYM (Qtagalog, "tagalog");
2636 DEFSYM (Qtagbanwa, "tagbanwa");
2637 DEFSYM (Qtai_le, "tai_le");
2638 DEFSYM (Qtifinagh, "tifinagh");
2639 DEFSYM (Qugaritic, "ugaritic");
2640
2641 /* W32 font encodings. */
2642 DEFVAR_LISP ("w32-charset-info-alist",
2643 Vw32_charset_info_alist,
2644 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2645 Each entry should be of the form:
2646
2647 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2648
2649 where CHARSET_NAME is a string used in font names to identify the charset,
2650 WINDOWS_CHARSET is a symbol that can be one of:
2651
2652 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2653 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2654 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2655 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2656 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2657 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2658 or w32-charset-oem.
2659
2660 CODEPAGE should be an integer specifying the codepage that should be used
2661 to display the character set, t to do no translation and output as Unicode,
2662 or nil to do no translation and output as 8 bit (or multibyte on far-east
2663 versions of Windows) characters. */);
2664 Vw32_charset_info_alist = Qnil;
2665
2666 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2667 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2668 DEFSYM (Qw32_charset_default, "w32-charset-default");
2669 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2670 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2671 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2672 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2673 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2674 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2675 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2676 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2677 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2678 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2679 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2680 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2681 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2682 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2683 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2684 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2685
2686 defsubr (&Sx_select_font);
2687
2688 w32font_driver.type = Qgdi;
2689 register_font_driver (&w32font_driver, NULL);
2690 }
2691
2692 void
2693 globals_of_w32font (void)
2694 {
2695 #ifdef WINDOWSNT
2696 g_b_init_get_outline_metrics_w = 0;
2697 g_b_init_get_text_metrics_w = 0;
2698 g_b_init_get_glyph_outline_w = 0;
2699 g_b_init_get_char_width_32_w = 0;
2700 #endif
2701 }