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