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