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