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