Update copyright notices for 2013.
[bpt/emacs.git] / 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 (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 #ifndef WINDOWSNT
1439 #define _strlwr strlwr
1440 #endif /* !WINDOWSNT */
1441
1442 static int
1443 check_face_name (LOGFONT *font, char *full_name)
1444 {
1445 char full_iname[LF_FULLFACESIZE+1];
1446
1447 /* Just check for names known to cause problems, since the full name
1448 can contain expanded abbreviations, prefixed foundry, postfixed
1449 style, the latter of which sometimes differs from the style indicated
1450 in the shorter name (eg Lt becomes Light or even Extra Light) */
1451
1452 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1453 installed, we run into problems with the Uniscribe backend which tries
1454 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1455 with Arial's characteristics, since that attempt to use TrueType works
1456 some places, but not others. */
1457 if (!xstrcasecmp (font->lfFaceName, "helvetica"))
1458 {
1459 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1460 full_iname[LF_FULLFACESIZE] = 0;
1461 _strlwr (full_iname);
1462 return strstr ("helvetica", full_iname) != NULL;
1463 }
1464 /* Same for Helv. */
1465 if (!xstrcasecmp (font->lfFaceName, "helv"))
1466 {
1467 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1468 full_iname[LF_FULLFACESIZE] = 0;
1469 _strlwr (full_iname);
1470 return strstr ("helv", full_iname) != NULL;
1471 }
1472
1473 /* Since Times is mapped to Times New Roman, a substring
1474 match is not sufficient to filter out the bogus match. */
1475 else if (!xstrcasecmp (font->lfFaceName, "times"))
1476 return xstrcasecmp (full_name, "times") == 0;
1477
1478 return 1;
1479 }
1480
1481
1482 /* Callback function for EnumFontFamiliesEx.
1483 * Checks if a font matches everything we are trying to check against,
1484 * and if so, adds it to a list. Both the data we are checking against
1485 * and the list to which the fonts are added are passed in via the
1486 * lparam argument, in the form of a font_callback_data struct. */
1487 static int CALLBACK
1488 add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1489 NEWTEXTMETRICEX *physical_font,
1490 DWORD font_type, LPARAM lParam)
1491 {
1492 struct font_callback_data *match_data
1493 = (struct font_callback_data *) lParam;
1494 Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
1495 Lisp_Object entity;
1496
1497 int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1498 || physical_font->ntmFontSig.fsUsb[2]
1499 || physical_font->ntmFontSig.fsUsb[1]
1500 || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1501
1502 /* Skip non matching fonts. */
1503
1504 /* For uniscribe backend, consider only truetype or opentype fonts
1505 that have some Unicode coverage. */
1506 if (match_data->opentype_only
1507 && ((!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
1508 && !(font_type & TRUETYPE_FONTTYPE))
1509 || !is_unicode))
1510 return 1;
1511
1512 /* Ensure a match. */
1513 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1514 || !font_matches_spec (font_type, physical_font,
1515 match_data->orig_font_spec, backend,
1516 &logical_font->elfLogFont)
1517 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1518 match_data->pattern.lfCharSet))
1519 return 1;
1520
1521 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1522 We limit this to raster fonts, because the test can catch some
1523 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1524 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1525 therefore get through this test. Since full names can be prefixed
1526 by a foundry, we accept raster fonts if the font name is found
1527 anywhere within the full name. */
1528 if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
1529 && !strstr (logical_font->elfFullName,
1530 logical_font->elfLogFont.lfFaceName))
1531 /* Check for well known substitutions that mess things up in the
1532 presence of Type-1 fonts of the same name. */
1533 || (!check_face_name (&logical_font->elfLogFont,
1534 logical_font->elfFullName)))
1535 return 1;
1536
1537 /* Make a font entity for the font. */
1538 entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1539 physical_font, font_type,
1540 &match_data->pattern,
1541 backend);
1542
1543 if (!NILP (entity))
1544 {
1545 Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1546 FONT_REGISTRY_INDEX);
1547
1548 /* iso10646-1 fonts must contain Unicode mapping tables. */
1549 if (EQ (spec_charset, Qiso10646_1))
1550 {
1551 if (!is_unicode)
1552 return 1;
1553 }
1554 /* unicode-bmp fonts must contain characters from the BMP. */
1555 else if (EQ (spec_charset, Qunicode_bmp))
1556 {
1557 if (!physical_font->ntmFontSig.fsUsb[3]
1558 && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1559 && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1560 && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1561 return 1;
1562 }
1563 /* unicode-sip fonts must contain characters in Unicode plane 2.
1564 so look for bit 57 (surrogates) in the Unicode subranges, plus
1565 the bits for CJK ranges that include those characters. */
1566 else if (EQ (spec_charset, Qunicode_sip))
1567 {
1568 if (!(physical_font->ntmFontSig.fsUsb[1] & 0x02000000)
1569 || !(physical_font->ntmFontSig.fsUsb[1] & 0x28000000))
1570 return 1;
1571 }
1572
1573 /* This font matches. */
1574
1575 /* If registry was specified, ensure it is reported as the same. */
1576 if (!NILP (spec_charset))
1577 {
1578 /* Avoid using non-Japanese fonts for Japanese, even if they
1579 claim they are capable, due to known breakage in Vista
1580 and Windows 7 fonts (bug#6029). */
1581 if (logical_font->elfLogFont.lfCharSet == SHIFTJIS_CHARSET
1582 && !(physical_font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1583 return 1;
1584 else
1585 ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1586 }
1587 /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1588 fonts as Unicode and skip other charsets. */
1589 else if (match_data->opentype_only)
1590 {
1591 if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1592 || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1593 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1594 else
1595 return 1;
1596 }
1597
1598 /* Add this font to the list. */
1599 match_data->list = Fcons (entity, match_data->list);
1600 }
1601 return 1;
1602 }
1603
1604 /* Callback function for EnumFontFamiliesEx.
1605 * Terminates the search once we have a match. */
1606 static int CALLBACK
1607 add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1608 NEWTEXTMETRICEX *physical_font,
1609 DWORD font_type, LPARAM lParam)
1610 {
1611 struct font_callback_data *match_data
1612 = (struct font_callback_data *) lParam;
1613 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1614
1615 /* If we have a font in the list, terminate the search. */
1616 return NILP (match_data->list);
1617 }
1618
1619 /* Old function to convert from x to w32 charset, from w32fns.c. */
1620 static LONG
1621 x_to_w32_charset (char * lpcs)
1622 {
1623 Lisp_Object this_entry, w32_charset;
1624 char *charset;
1625 int len = strlen (lpcs);
1626
1627 /* Support "*-#nnn" format for unknown charsets. */
1628 if (strncmp (lpcs, "*-#", 3) == 0)
1629 return atoi (lpcs + 3);
1630
1631 /* All Windows fonts qualify as Unicode. */
1632 if (!strncmp (lpcs, "iso10646", 8))
1633 return DEFAULT_CHARSET;
1634
1635 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1636 charset = alloca (len + 1);
1637 strcpy (charset, lpcs);
1638 lpcs = strchr (charset, '*');
1639 if (lpcs)
1640 *lpcs = '\0';
1641
1642 /* Look through w32-charset-info-alist for the character set.
1643 Format of each entry is
1644 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1645 */
1646 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
1647
1648 if (NILP (this_entry))
1649 {
1650 /* At startup, we want iso8859-1 fonts to come up properly. */
1651 if (xstrcasecmp (charset, "iso8859-1") == 0)
1652 return ANSI_CHARSET;
1653 else
1654 return DEFAULT_CHARSET;
1655 }
1656
1657 w32_charset = Fcar (Fcdr (this_entry));
1658
1659 /* Translate Lisp symbol to number. */
1660 if (EQ (w32_charset, Qw32_charset_ansi))
1661 return ANSI_CHARSET;
1662 if (EQ (w32_charset, Qw32_charset_symbol))
1663 return SYMBOL_CHARSET;
1664 if (EQ (w32_charset, Qw32_charset_shiftjis))
1665 return SHIFTJIS_CHARSET;
1666 if (EQ (w32_charset, Qw32_charset_hangeul))
1667 return HANGEUL_CHARSET;
1668 if (EQ (w32_charset, Qw32_charset_chinesebig5))
1669 return CHINESEBIG5_CHARSET;
1670 if (EQ (w32_charset, Qw32_charset_gb2312))
1671 return GB2312_CHARSET;
1672 if (EQ (w32_charset, Qw32_charset_oem))
1673 return OEM_CHARSET;
1674 if (EQ (w32_charset, Qw32_charset_johab))
1675 return JOHAB_CHARSET;
1676 if (EQ (w32_charset, Qw32_charset_easteurope))
1677 return EASTEUROPE_CHARSET;
1678 if (EQ (w32_charset, Qw32_charset_turkish))
1679 return TURKISH_CHARSET;
1680 if (EQ (w32_charset, Qw32_charset_baltic))
1681 return BALTIC_CHARSET;
1682 if (EQ (w32_charset, Qw32_charset_russian))
1683 return RUSSIAN_CHARSET;
1684 if (EQ (w32_charset, Qw32_charset_arabic))
1685 return ARABIC_CHARSET;
1686 if (EQ (w32_charset, Qw32_charset_greek))
1687 return GREEK_CHARSET;
1688 if (EQ (w32_charset, Qw32_charset_hebrew))
1689 return HEBREW_CHARSET;
1690 if (EQ (w32_charset, Qw32_charset_vietnamese))
1691 return VIETNAMESE_CHARSET;
1692 if (EQ (w32_charset, Qw32_charset_thai))
1693 return THAI_CHARSET;
1694 if (EQ (w32_charset, Qw32_charset_mac))
1695 return MAC_CHARSET;
1696
1697 return DEFAULT_CHARSET;
1698 }
1699
1700
1701 /* Convert a Lisp font registry (symbol) to a windows charset. */
1702 static LONG
1703 registry_to_w32_charset (Lisp_Object charset)
1704 {
1705 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1706 || EQ (charset, Qunicode_sip))
1707 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1708 else if (EQ (charset, Qiso8859_1))
1709 return ANSI_CHARSET;
1710 else if (SYMBOLP (charset))
1711 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
1712 else
1713 return DEFAULT_CHARSET;
1714 }
1715
1716 /* Old function to convert from w32 to x charset, from w32fns.c. */
1717 static char *
1718 w32_to_x_charset (int fncharset, char *matching)
1719 {
1720 static char buf[32];
1721 Lisp_Object charset_type;
1722 int match_len = 0;
1723
1724 if (matching)
1725 {
1726 /* If fully specified, accept it as it is. Otherwise use a
1727 substring match. */
1728 char *wildcard = strchr (matching, '*');
1729 if (wildcard)
1730 *wildcard = '\0';
1731 else if (strchr (matching, '-'))
1732 return matching;
1733
1734 match_len = strlen (matching);
1735 }
1736
1737 switch (fncharset)
1738 {
1739 case ANSI_CHARSET:
1740 /* Handle startup case of w32-charset-info-alist not
1741 being set up yet. */
1742 if (NILP (Vw32_charset_info_alist))
1743 return "iso8859-1";
1744 charset_type = Qw32_charset_ansi;
1745 break;
1746 case DEFAULT_CHARSET:
1747 charset_type = Qw32_charset_default;
1748 break;
1749 case SYMBOL_CHARSET:
1750 charset_type = Qw32_charset_symbol;
1751 break;
1752 case SHIFTJIS_CHARSET:
1753 charset_type = Qw32_charset_shiftjis;
1754 break;
1755 case HANGEUL_CHARSET:
1756 charset_type = Qw32_charset_hangeul;
1757 break;
1758 case GB2312_CHARSET:
1759 charset_type = Qw32_charset_gb2312;
1760 break;
1761 case CHINESEBIG5_CHARSET:
1762 charset_type = Qw32_charset_chinesebig5;
1763 break;
1764 case OEM_CHARSET:
1765 charset_type = Qw32_charset_oem;
1766 break;
1767 case EASTEUROPE_CHARSET:
1768 charset_type = Qw32_charset_easteurope;
1769 break;
1770 case TURKISH_CHARSET:
1771 charset_type = Qw32_charset_turkish;
1772 break;
1773 case BALTIC_CHARSET:
1774 charset_type = Qw32_charset_baltic;
1775 break;
1776 case RUSSIAN_CHARSET:
1777 charset_type = Qw32_charset_russian;
1778 break;
1779 case ARABIC_CHARSET:
1780 charset_type = Qw32_charset_arabic;
1781 break;
1782 case GREEK_CHARSET:
1783 charset_type = Qw32_charset_greek;
1784 break;
1785 case HEBREW_CHARSET:
1786 charset_type = Qw32_charset_hebrew;
1787 break;
1788 case VIETNAMESE_CHARSET:
1789 charset_type = Qw32_charset_vietnamese;
1790 break;
1791 case THAI_CHARSET:
1792 charset_type = Qw32_charset_thai;
1793 break;
1794 case MAC_CHARSET:
1795 charset_type = Qw32_charset_mac;
1796 break;
1797 case JOHAB_CHARSET:
1798 charset_type = Qw32_charset_johab;
1799 break;
1800
1801 default:
1802 /* Encode numerical value of unknown charset. */
1803 sprintf (buf, "*-#%u", fncharset);
1804 return buf;
1805 }
1806
1807 {
1808 Lisp_Object rest;
1809 char * best_match = NULL;
1810 int matching_found = 0;
1811
1812 /* Look through w32-charset-info-alist for the character set.
1813 Prefer ISO codepages, and prefer lower numbers in the ISO
1814 range. Only return charsets for codepages which are installed.
1815
1816 Format of each entry is
1817 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1818 */
1819 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1820 {
1821 char * x_charset;
1822 Lisp_Object w32_charset;
1823 Lisp_Object codepage;
1824
1825 Lisp_Object this_entry = XCAR (rest);
1826
1827 /* Skip invalid entries in alist. */
1828 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1829 || !CONSP (XCDR (this_entry))
1830 || !SYMBOLP (XCAR (XCDR (this_entry))))
1831 continue;
1832
1833 x_charset = SDATA (XCAR (this_entry));
1834 w32_charset = XCAR (XCDR (this_entry));
1835 codepage = XCDR (XCDR (this_entry));
1836
1837 /* Look for Same charset and a valid codepage (or non-int
1838 which means ignore). */
1839 if (EQ (w32_charset, charset_type)
1840 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
1841 || IsValidCodePage (XINT (codepage))))
1842 {
1843 /* If we don't have a match already, then this is the
1844 best. */
1845 if (!best_match)
1846 {
1847 best_match = x_charset;
1848 if (matching && !strnicmp (x_charset, matching, match_len))
1849 matching_found = 1;
1850 }
1851 /* If we already found a match for MATCHING, then
1852 only consider other matches. */
1853 else if (matching_found
1854 && strnicmp (x_charset, matching, match_len))
1855 continue;
1856 /* If this matches what we want, and the best so far doesn't,
1857 then this is better. */
1858 else if (!matching_found && matching
1859 && !strnicmp (x_charset, matching, match_len))
1860 {
1861 best_match = x_charset;
1862 matching_found = 1;
1863 }
1864 /* If this is fully specified, and the best so far isn't,
1865 then this is better. */
1866 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1867 /* If this is an ISO codepage, and the best so far isn't,
1868 then this is better, but only if it fully specifies the
1869 encoding. */
1870 || (strnicmp (best_match, "iso", 3) != 0
1871 && strnicmp (x_charset, "iso", 3) == 0
1872 && strchr (x_charset, '-')))
1873 best_match = x_charset;
1874 /* If both are ISO8859 codepages, choose the one with the
1875 lowest number in the encoding field. */
1876 else if (strnicmp (best_match, "iso8859-", 8) == 0
1877 && strnicmp (x_charset, "iso8859-", 8) == 0)
1878 {
1879 int best_enc = atoi (best_match + 8);
1880 int this_enc = atoi (x_charset + 8);
1881 if (this_enc > 0 && this_enc < best_enc)
1882 best_match = x_charset;
1883 }
1884 }
1885 }
1886
1887 /* If no match, encode the numeric value. */
1888 if (!best_match)
1889 {
1890 sprintf (buf, "*-#%u", fncharset);
1891 return buf;
1892 }
1893
1894 strncpy (buf, best_match, 31);
1895 /* If the charset is not fully specified, put -0 on the end. */
1896 if (!strchr (best_match, '-'))
1897 {
1898 int pos = strlen (best_match);
1899 /* Charset specifiers shouldn't be very long. If it is a made
1900 up one, truncating it should not do any harm since it isn't
1901 recognized anyway. */
1902 if (pos > 29)
1903 pos = 29;
1904 strcpy (buf + pos, "-0");
1905 }
1906 buf[31] = '\0';
1907 return buf;
1908 }
1909 }
1910
1911 static Lisp_Object
1912 w32_registry (LONG w32_charset, DWORD font_type)
1913 {
1914 char *charset;
1915
1916 /* If charset is defaulted, charset is Unicode or unknown, depending on
1917 font type. */
1918 if (w32_charset == DEFAULT_CHARSET)
1919 return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
1920
1921 charset = w32_to_x_charset (w32_charset, NULL);
1922 return font_intern_prop (charset, strlen (charset), 1);
1923 }
1924
1925 static int
1926 w32_decode_weight (int fnweight)
1927 {
1928 if (fnweight >= FW_HEAVY) return 210;
1929 if (fnweight >= FW_EXTRABOLD) return 205;
1930 if (fnweight >= FW_BOLD) return 200;
1931 if (fnweight >= FW_SEMIBOLD) return 180;
1932 if (fnweight >= FW_NORMAL) return 100;
1933 if (fnweight >= FW_LIGHT) return 50;
1934 if (fnweight >= FW_EXTRALIGHT) return 40;
1935 if (fnweight > FW_THIN) return 20;
1936 return 0;
1937 }
1938
1939 static int
1940 w32_encode_weight (int n)
1941 {
1942 if (n >= 210) return FW_HEAVY;
1943 if (n >= 205) return FW_EXTRABOLD;
1944 if (n >= 200) return FW_BOLD;
1945 if (n >= 180) return FW_SEMIBOLD;
1946 if (n >= 100) return FW_NORMAL;
1947 if (n >= 50) return FW_LIGHT;
1948 if (n >= 40) return FW_EXTRALIGHT;
1949 if (n >= 20) return FW_THIN;
1950 return 0;
1951 }
1952
1953 /* Convert a Windows font weight into one of the weights supported
1954 by fontconfig (see font.c:font_parse_fcname). */
1955 static Lisp_Object
1956 w32_to_fc_weight (int n)
1957 {
1958 if (n >= FW_EXTRABOLD) return intern ("black");
1959 if (n >= FW_BOLD) return intern ("bold");
1960 if (n >= FW_SEMIBOLD) return intern ("demibold");
1961 if (n >= FW_NORMAL) return intern ("medium");
1962 return intern ("light");
1963 }
1964
1965 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1966 static void
1967 fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
1968 {
1969 Lisp_Object tmp, extra;
1970 int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
1971
1972 tmp = AREF (font_spec, FONT_DPI_INDEX);
1973 if (INTEGERP (tmp))
1974 {
1975 dpi = XINT (tmp);
1976 }
1977 else if (FLOATP (tmp))
1978 {
1979 dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
1980 }
1981
1982 /* Height */
1983 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1984 if (INTEGERP (tmp))
1985 logfont->lfHeight = -1 * XINT (tmp);
1986 else if (FLOATP (tmp))
1987 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
1988
1989 /* Escapement */
1990
1991 /* Orientation */
1992
1993 /* Weight */
1994 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1995 if (INTEGERP (tmp))
1996 logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
1997
1998 /* Italic */
1999 tmp = AREF (font_spec, FONT_SLANT_INDEX);
2000 if (INTEGERP (tmp))
2001 {
2002 int slant = FONT_SLANT_NUMERIC (font_spec);
2003 logfont->lfItalic = slant > 150 ? 1 : 0;
2004 }
2005
2006 /* Underline */
2007
2008 /* Strikeout */
2009
2010 /* Charset */
2011 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
2012 if (! NILP (tmp))
2013 logfont->lfCharSet = registry_to_w32_charset (tmp);
2014 else
2015 logfont->lfCharSet = DEFAULT_CHARSET;
2016
2017 /* Out Precision */
2018
2019 /* Clip Precision */
2020
2021 /* Quality */
2022 logfont->lfQuality = DEFAULT_QUALITY;
2023
2024 /* Generic Family and Face Name */
2025 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
2026
2027 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
2028 if (! NILP (tmp))
2029 {
2030 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
2031 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
2032 ; /* Font name was generic, don't fill in font name. */
2033 /* Font families are interned, but allow for strings also in case of
2034 user input. */
2035 else if (SYMBOLP (tmp))
2036 {
2037 strncpy (logfont->lfFaceName,
2038 SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
2039 logfont->lfFaceName[LF_FACESIZE-1] = '\0';
2040 }
2041 }
2042
2043 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
2044 if (!NILP (tmp))
2045 {
2046 /* Override generic family. */
2047 BYTE family = w32_generic_family (tmp);
2048 if (family != FF_DONTCARE)
2049 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
2050 }
2051
2052 /* Set pitch based on the spacing property. */
2053 tmp = AREF (font_spec, FONT_SPACING_INDEX);
2054 if (INTEGERP (tmp))
2055 {
2056 int spacing = XINT (tmp);
2057 if (spacing < FONT_SPACING_MONO)
2058 logfont->lfPitchAndFamily
2059 = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
2060 else
2061 logfont->lfPitchAndFamily
2062 = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
2063 }
2064
2065 /* Process EXTRA info. */
2066 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
2067 CONSP (extra); extra = XCDR (extra))
2068 {
2069 tmp = XCAR (extra);
2070 if (CONSP (tmp))
2071 {
2072 Lisp_Object key, val;
2073 key = XCAR (tmp), val = XCDR (tmp);
2074 /* Only use QCscript if charset is not provided, or is Unicode
2075 and a single script is specified. This is rather crude,
2076 and is only used to narrow down the fonts returned where
2077 there is a definite match. Some scripts, such as latin, han,
2078 cjk-misc match multiple lfCharSet values, so we can't pre-filter
2079 them. */
2080 if (EQ (key, QCscript)
2081 && logfont->lfCharSet == DEFAULT_CHARSET
2082 && SYMBOLP (val))
2083 {
2084 if (EQ (val, Qgreek))
2085 logfont->lfCharSet = GREEK_CHARSET;
2086 else if (EQ (val, Qhangul))
2087 logfont->lfCharSet = HANGUL_CHARSET;
2088 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
2089 logfont->lfCharSet = SHIFTJIS_CHARSET;
2090 else if (EQ (val, Qbopomofo))
2091 logfont->lfCharSet = CHINESEBIG5_CHARSET;
2092 /* GB 18030 supports tibetan, yi, mongolian,
2093 fonts that support it should show up if we ask for
2094 GB2312 fonts. */
2095 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
2096 || EQ (val, Qmongolian))
2097 logfont->lfCharSet = GB2312_CHARSET;
2098 else if (EQ (val, Qhebrew))
2099 logfont->lfCharSet = HEBREW_CHARSET;
2100 else if (EQ (val, Qarabic))
2101 logfont->lfCharSet = ARABIC_CHARSET;
2102 else if (EQ (val, Qthai))
2103 logfont->lfCharSet = THAI_CHARSET;
2104 }
2105 else if (EQ (key, QCantialias) && SYMBOLP (val))
2106 {
2107 logfont->lfQuality = w32_antialias_type (val);
2108 }
2109 }
2110 }
2111 }
2112
2113 static void
2114 list_all_matching_fonts (struct font_callback_data *match_data)
2115 {
2116 HDC dc;
2117 Lisp_Object families = w32font_list_family (match_data->frame);
2118 struct frame *f = XFRAME (match_data->frame);
2119
2120 dc = get_frame_dc (f);
2121
2122 while (!NILP (families))
2123 {
2124 /* Only fonts from the current locale are given localized names
2125 on Windows, so we can keep backwards compatibility with
2126 Windows 9x/ME by using non-Unicode font enumeration without
2127 sacrificing internationalization here. */
2128 char *name;
2129 Lisp_Object family = CAR (families);
2130 families = CDR (families);
2131 if (NILP (family))
2132 continue;
2133 else if (SYMBOLP (family))
2134 name = SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
2135 else
2136 continue;
2137
2138 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2139 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2140
2141 EnumFontFamiliesEx (dc, &match_data->pattern,
2142 (FONTENUMPROC) add_font_entity_to_list,
2143 (LPARAM) match_data, 0);
2144 }
2145
2146 release_frame_dc (f, dc);
2147 }
2148
2149 static Lisp_Object
2150 lispy_antialias_type (BYTE type)
2151 {
2152 Lisp_Object lispy;
2153
2154 switch (type)
2155 {
2156 case NONANTIALIASED_QUALITY:
2157 lispy = Qnone;
2158 break;
2159 case ANTIALIASED_QUALITY:
2160 lispy = Qstandard;
2161 break;
2162 case CLEARTYPE_QUALITY:
2163 lispy = Qsubpixel;
2164 break;
2165 case CLEARTYPE_NATURAL_QUALITY:
2166 lispy = Qnatural;
2167 break;
2168 default:
2169 lispy = Qnil;
2170 break;
2171 }
2172 return lispy;
2173 }
2174
2175 /* Convert antialiasing symbols to lfQuality */
2176 static BYTE
2177 w32_antialias_type (Lisp_Object type)
2178 {
2179 if (EQ (type, Qnone))
2180 return NONANTIALIASED_QUALITY;
2181 else if (EQ (type, Qstandard))
2182 return ANTIALIASED_QUALITY;
2183 else if (EQ (type, Qsubpixel))
2184 return CLEARTYPE_QUALITY;
2185 else if (EQ (type, Qnatural))
2186 return CLEARTYPE_NATURAL_QUALITY;
2187 else
2188 return DEFAULT_QUALITY;
2189 }
2190
2191 /* Return a list of all the scripts that the font supports. */
2192 static Lisp_Object
2193 font_supported_scripts (FONTSIGNATURE * sig)
2194 {
2195 DWORD * subranges = sig->fsUsb;
2196 Lisp_Object supported = Qnil;
2197
2198 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2199 #define SUBRANGE(n,sym) \
2200 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2201 supported = Fcons ((sym), supported)
2202
2203 /* Match multiple subranges. SYM is set if any MASK bit is set in
2204 subranges[0 - 3]. */
2205 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2206 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2207 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2208 supported = Fcons ((sym), supported)
2209
2210 SUBRANGE (0, Qlatin);
2211 /* The following count as latin too, ASCII should be present in these fonts,
2212 so don't need to mark them separately. */
2213 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2214 SUBRANGE (4, Qphonetic);
2215 /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */
2216 SUBRANGE (7, Qgreek);
2217 SUBRANGE (8, Qcoptic);
2218 SUBRANGE (9, Qcyrillic);
2219 SUBRANGE (10, Qarmenian);
2220 SUBRANGE (11, Qhebrew);
2221 /* 12: Vai. */
2222 SUBRANGE (13, Qarabic);
2223 SUBRANGE (14, Qnko);
2224 SUBRANGE (15, Qdevanagari);
2225 SUBRANGE (16, Qbengali);
2226 SUBRANGE (17, Qgurmukhi);
2227 SUBRANGE (18, Qgujarati);
2228 SUBRANGE (19, Qoriya);
2229 SUBRANGE (20, Qtamil);
2230 SUBRANGE (21, Qtelugu);
2231 SUBRANGE (22, Qkannada);
2232 SUBRANGE (23, Qmalayalam);
2233 SUBRANGE (24, Qthai);
2234 SUBRANGE (25, Qlao);
2235 SUBRANGE (26, Qgeorgian);
2236 SUBRANGE (27, Qbalinese);
2237 /* 28: Hangul Jamo. */
2238 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2239 /* 32-47: Symbols (defined below). */
2240 SUBRANGE (48, Qcjk_misc);
2241 /* Match either 49: katakana or 50: hiragana for kana. */
2242 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
2243 SUBRANGE (51, Qbopomofo);
2244 /* 52: Compatibility Jamo */
2245 SUBRANGE (53, Qphags_pa);
2246 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2247 SUBRANGE (56, Qhangul);
2248 /* 57: Surrogates. */
2249 SUBRANGE (58, Qphoenician);
2250 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
2251 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2252 SUBRANGE (59, Qkanbun); /* And this. */
2253 /* 60: Private use, 61: CJK strokes and compatibility. */
2254 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2255 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2256 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2257 /* 69: Specials. */
2258 SUBRANGE (70, Qtibetan);
2259 SUBRANGE (71, Qsyriac);
2260 SUBRANGE (72, Qthaana);
2261 SUBRANGE (73, Qsinhala);
2262 SUBRANGE (74, Qmyanmar);
2263 SUBRANGE (75, Qethiopic);
2264 SUBRANGE (76, Qcherokee);
2265 SUBRANGE (77, Qcanadian_aboriginal);
2266 SUBRANGE (78, Qogham);
2267 SUBRANGE (79, Qrunic);
2268 SUBRANGE (80, Qkhmer);
2269 SUBRANGE (81, Qmongolian);
2270 SUBRANGE (82, Qbraille);
2271 SUBRANGE (83, Qyi);
2272 SUBRANGE (84, Qbuhid);
2273 SUBRANGE (84, Qhanunoo);
2274 SUBRANGE (84, Qtagalog);
2275 SUBRANGE (84, Qtagbanwa);
2276 SUBRANGE (85, Qold_italic);
2277 SUBRANGE (86, Qgothic);
2278 SUBRANGE (87, Qdeseret);
2279 SUBRANGE (88, Qbyzantine_musical_symbol);
2280 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
2281 SUBRANGE (89, Qmathematical);
2282 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2283 SUBRANGE (93, Qlimbu);
2284 SUBRANGE (94, Qtai_le);
2285 /* 95: New Tai Le */
2286 SUBRANGE (90, Qbuginese);
2287 SUBRANGE (97, Qglagolitic);
2288 SUBRANGE (98, Qtifinagh);
2289 /* 99: Yijing Hexagrams. */
2290 SUBRANGE (100, Qsyloti_nagri);
2291 SUBRANGE (101, Qlinear_b);
2292 /* 102: Ancient Greek Numbers. */
2293 SUBRANGE (103, Qugaritic);
2294 SUBRANGE (104, Qold_persian);
2295 SUBRANGE (105, Qshavian);
2296 SUBRANGE (106, Qosmanya);
2297 SUBRANGE (107, Qcypriot);
2298 SUBRANGE (108, Qkharoshthi);
2299 /* 109: Tai Xuan Jing. */
2300 SUBRANGE (110, Qcuneiform);
2301 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2302 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2303 SUBRANGE (118, Qcham);
2304 /* 119: Ancient symbols, 120: Phaistos Disc. */
2305 /* 121: Carian, Lycian, Lydian, 122: Dominoes, Mahjong tiles. */
2306 /* 123-127: Reserved. */
2307
2308 /* There isn't really a main symbol range, so include symbol if any
2309 relevant range is set. */
2310 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2311
2312 /* Missing: Tai Viet (U+AA80-U+AADF). */
2313 #undef SUBRANGE
2314 #undef MASK_ANY
2315
2316 return supported;
2317 }
2318
2319 /* Generate a full name for a Windows font.
2320 The full name is in fcname format, with weight, slant and antialiasing
2321 specified if they are not "normal". */
2322 static int
2323 w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
2324 int pixel_size, char *name, int nbytes)
2325 {
2326 int len, height, outline;
2327 char *p;
2328 Lisp_Object antialiasing, weight = Qnil;
2329
2330 len = strlen (font->lfFaceName);
2331
2332 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2333
2334 /* Represent size of scalable fonts by point size. But use pixelsize for
2335 raster fonts to indicate that they are exactly that size. */
2336 if (outline)
2337 len += 11; /* -SIZE */
2338 else
2339 len += 21;
2340
2341 if (font->lfItalic)
2342 len += 7; /* :italic */
2343
2344 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2345 {
2346 weight = w32_to_fc_weight (font->lfWeight);
2347 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
2348 }
2349
2350 antialiasing = lispy_antialias_type (font->lfQuality);
2351 if (! NILP (antialiasing))
2352 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2353
2354 /* Check that the buffer is big enough */
2355 if (len > nbytes)
2356 return -1;
2357
2358 p = name;
2359 p += sprintf (p, "%s", font->lfFaceName);
2360
2361 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2362
2363 if (height > 0)
2364 {
2365 if (outline)
2366 {
2367 float pointsize = height * 72.0 / one_w32_display_info.resy;
2368 /* Round to nearest half point. floor is used, since round is not
2369 supported in MS library. */
2370 pointsize = floor (pointsize * 2 + 0.5) / 2;
2371 p += sprintf (p, "-%1.1f", pointsize);
2372 }
2373 else
2374 p += sprintf (p, ":pixelsize=%d", height);
2375 }
2376
2377 if (SYMBOLP (weight) && ! NILP (weight))
2378 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2379
2380 if (font->lfItalic)
2381 p += sprintf (p, ":italic");
2382
2383 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2384 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2385
2386 return (p - name);
2387 }
2388
2389 /* Convert a logfont and point size into a fontconfig style font name.
2390 POINTSIZE is in tenths of points.
2391 If SIZE indicates the size of buffer FCNAME, into which the font name
2392 is written. If the buffer is not large enough to contain the name,
2393 the function returns -1, otherwise it returns the number of bytes
2394 written to FCNAME. */
2395 static int
2396 logfont_to_fcname (LOGFONT* font, int pointsize, char *fcname, int size)
2397 {
2398 int len, height;
2399 char *p = fcname;
2400 Lisp_Object weight = Qnil;
2401
2402 len = strlen (font->lfFaceName) + 2;
2403 height = pointsize / 10;
2404 while (height /= 10)
2405 len++;
2406
2407 if (pointsize % 10)
2408 len += 2;
2409
2410 if (font->lfItalic)
2411 len += 7; /* :italic */
2412 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2413 {
2414 weight = w32_to_fc_weight (font->lfWeight);
2415 len += SBYTES (SYMBOL_NAME (weight)) + 1;
2416 }
2417
2418 if (len > size)
2419 return -1;
2420
2421 p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2422 if (pointsize % 10)
2423 p += sprintf (p, ".%d", pointsize % 10);
2424
2425 if (SYMBOLP (weight) && !NILP (weight))
2426 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2427
2428 if (font->lfItalic)
2429 p += sprintf (p, ":italic");
2430
2431 return (p - fcname);
2432 }
2433
2434 static void
2435 compute_metrics (HDC dc, struct w32font_info *w32_font, unsigned int code,
2436 struct w32_metric_cache *metrics)
2437 {
2438 GLYPHMETRICS gm;
2439 MAT2 transform;
2440 unsigned int options = GGO_METRICS;
2441
2442 if (w32_font->glyph_idx)
2443 options |= GGO_GLYPH_INDEX;
2444
2445 memset (&transform, 0, sizeof (transform));
2446 transform.eM11.value = 1;
2447 transform.eM22.value = 1;
2448
2449 if (get_glyph_outline_w (dc, code, options, &gm, 0, NULL, &transform)
2450 != GDI_ERROR)
2451 {
2452 metrics->lbearing = gm.gmptGlyphOrigin.x;
2453 metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2454 metrics->width = gm.gmCellIncX;
2455 metrics->status = W32METRIC_SUCCESS;
2456 }
2457 else
2458 metrics->status = W32METRIC_FAIL;
2459 }
2460
2461 DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2462 doc: /* Read a font name using a W32 font selection dialog.
2463 Return fontconfig style font string corresponding to the selection.
2464
2465 If FRAME is omitted or nil, it defaults to the selected frame.
2466 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2467 in the font selection dialog. */)
2468 (Lisp_Object frame, Lisp_Object exclude_proportional)
2469 {
2470 FRAME_PTR f = check_x_frame (frame);
2471 CHOOSEFONT cf;
2472 LOGFONT lf;
2473 TEXTMETRIC tm;
2474 HDC hdc;
2475 HANDLE oldobj;
2476 char buf[100];
2477
2478 memset (&cf, 0, sizeof (cf));
2479 memset (&lf, 0, sizeof (lf));
2480
2481 cf.lStructSize = sizeof (cf);
2482 cf.hwndOwner = FRAME_W32_WINDOW (f);
2483 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2484
2485 /* If exclude_proportional is non-nil, limit the selection to
2486 monospaced fonts. */
2487 if (!NILP (exclude_proportional))
2488 cf.Flags |= CF_FIXEDPITCHONLY;
2489
2490 cf.lpLogFont = &lf;
2491
2492 /* Initialize as much of the font details as we can from the current
2493 default font. */
2494 hdc = GetDC (FRAME_W32_WINDOW (f));
2495 oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
2496 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2497 if (GetTextMetrics (hdc, &tm))
2498 {
2499 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2500 lf.lfWeight = tm.tmWeight;
2501 lf.lfItalic = tm.tmItalic;
2502 lf.lfUnderline = tm.tmUnderlined;
2503 lf.lfStrikeOut = tm.tmStruckOut;
2504 lf.lfCharSet = tm.tmCharSet;
2505 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2506 }
2507 SelectObject (hdc, oldobj);
2508 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2509
2510 if (!ChooseFont (&cf)
2511 || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
2512 return Qnil;
2513
2514 return DECODE_SYSTEM (build_string (buf));
2515 }
2516
2517 static const char *const w32font_booleans [] = {
2518 NULL,
2519 };
2520
2521 static const char *const w32font_non_booleans [] = {
2522 ":script",
2523 ":antialias",
2524 ":style",
2525 NULL,
2526 };
2527
2528 static void
2529 w32font_filter_properties (Lisp_Object font, Lisp_Object alist)
2530 {
2531 font_filter_properties (font, alist, w32font_booleans, w32font_non_booleans);
2532 }
2533
2534 struct font_driver w32font_driver =
2535 {
2536 0, /* Qgdi */
2537 0, /* case insensitive */
2538 w32font_get_cache,
2539 w32font_list,
2540 w32font_match,
2541 w32font_list_family,
2542 NULL, /* free_entity */
2543 w32font_open,
2544 w32font_close,
2545 NULL, /* prepare_face */
2546 NULL, /* done_face */
2547 w32font_has_char,
2548 w32font_encode_char,
2549 w32font_text_extents,
2550 w32font_draw,
2551 NULL, /* get_bitmap */
2552 NULL, /* free_bitmap */
2553 NULL, /* get_outline */
2554 NULL, /* free_outline */
2555 NULL, /* anchor_point */
2556 NULL, /* otf_capability */
2557 NULL, /* otf_drive */
2558 NULL, /* start_for_frame */
2559 NULL, /* end_for_frame */
2560 NULL, /* shape */
2561 NULL, /* check */
2562 NULL, /* get_variation_glyphs */
2563 w32font_filter_properties,
2564 NULL, /* cached_font_ok */
2565 };
2566
2567
2568 /* Initialize state that does not change between invocations. This is only
2569 called when Emacs is dumped. */
2570 void
2571 syms_of_w32font (void)
2572 {
2573 DEFSYM (Qgdi, "gdi");
2574 DEFSYM (Quniscribe, "uniscribe");
2575 DEFSYM (QCformat, ":format");
2576
2577 /* Generic font families. */
2578 DEFSYM (Qmonospace, "monospace");
2579 DEFSYM (Qserif, "serif");
2580 DEFSYM (Qsansserif, "sansserif");
2581 DEFSYM (Qscript, "script");
2582 DEFSYM (Qdecorative, "decorative");
2583 /* Aliases. */
2584 DEFSYM (Qsans_serif, "sans_serif");
2585 DEFSYM (Qsans, "sans");
2586 DEFSYM (Qmono, "mono");
2587
2588 /* Fake foundries. */
2589 DEFSYM (Qraster, "raster");
2590 DEFSYM (Qoutline, "outline");
2591 DEFSYM (Qunknown, "unknown");
2592
2593 /* Antialiasing. */
2594 DEFSYM (Qstandard, "standard");
2595 DEFSYM (Qsubpixel, "subpixel");
2596 DEFSYM (Qnatural, "natural");
2597
2598 /* Languages */
2599 DEFSYM (Qzh, "zh");
2600
2601 /* Scripts */
2602 DEFSYM (Qlatin, "latin");
2603 DEFSYM (Qgreek, "greek");
2604 DEFSYM (Qcoptic, "coptic");
2605 DEFSYM (Qcyrillic, "cyrillic");
2606 DEFSYM (Qarmenian, "armenian");
2607 DEFSYM (Qhebrew, "hebrew");
2608 DEFSYM (Qarabic, "arabic");
2609 DEFSYM (Qsyriac, "syriac");
2610 DEFSYM (Qnko, "nko");
2611 DEFSYM (Qthaana, "thaana");
2612 DEFSYM (Qdevanagari, "devanagari");
2613 DEFSYM (Qbengali, "bengali");
2614 DEFSYM (Qgurmukhi, "gurmukhi");
2615 DEFSYM (Qgujarati, "gujarati");
2616 DEFSYM (Qoriya, "oriya");
2617 DEFSYM (Qtamil, "tamil");
2618 DEFSYM (Qtelugu, "telugu");
2619 DEFSYM (Qkannada, "kannada");
2620 DEFSYM (Qmalayalam, "malayalam");
2621 DEFSYM (Qsinhala, "sinhala");
2622 DEFSYM (Qthai, "thai");
2623 DEFSYM (Qlao, "lao");
2624 DEFSYM (Qtibetan, "tibetan");
2625 DEFSYM (Qmyanmar, "myanmar");
2626 DEFSYM (Qgeorgian, "georgian");
2627 DEFSYM (Qhangul, "hangul");
2628 DEFSYM (Qethiopic, "ethiopic");
2629 DEFSYM (Qcherokee, "cherokee");
2630 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2631 DEFSYM (Qogham, "ogham");
2632 DEFSYM (Qrunic, "runic");
2633 DEFSYM (Qkhmer, "khmer");
2634 DEFSYM (Qmongolian, "mongolian");
2635 DEFSYM (Qbraille, "braille");
2636 DEFSYM (Qhan, "han");
2637 DEFSYM (Qideographic_description, "ideographic-description");
2638 DEFSYM (Qcjk_misc, "cjk-misc");
2639 DEFSYM (Qkana, "kana");
2640 DEFSYM (Qbopomofo, "bopomofo");
2641 DEFSYM (Qkanbun, "kanbun");
2642 DEFSYM (Qyi, "yi");
2643 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2644 DEFSYM (Qmusical_symbol, "musical-symbol");
2645 DEFSYM (Qmathematical, "mathematical");
2646 DEFSYM (Qcham, "cham");
2647 DEFSYM (Qphonetic, "phonetic");
2648 DEFSYM (Qbalinese, "balinese");
2649 DEFSYM (Qbuginese, "buginese");
2650 DEFSYM (Qbuhid, "buhid");
2651 DEFSYM (Qcuneiform, "cuneiform");
2652 DEFSYM (Qcypriot, "cypriot");
2653 DEFSYM (Qdeseret, "deseret");
2654 DEFSYM (Qglagolitic, "glagolitic");
2655 DEFSYM (Qgothic, "gothic");
2656 DEFSYM (Qhanunoo, "hanunoo");
2657 DEFSYM (Qkharoshthi, "kharoshthi");
2658 DEFSYM (Qlimbu, "limbu");
2659 DEFSYM (Qlinear_b, "linear_b");
2660 DEFSYM (Qold_italic, "old_italic");
2661 DEFSYM (Qold_persian, "old_persian");
2662 DEFSYM (Qosmanya, "osmanya");
2663 DEFSYM (Qphags_pa, "phags-pa");
2664 DEFSYM (Qphoenician, "phoenician");
2665 DEFSYM (Qshavian, "shavian");
2666 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2667 DEFSYM (Qtagalog, "tagalog");
2668 DEFSYM (Qtagbanwa, "tagbanwa");
2669 DEFSYM (Qtai_le, "tai_le");
2670 DEFSYM (Qtifinagh, "tifinagh");
2671 DEFSYM (Qugaritic, "ugaritic");
2672
2673 /* W32 font encodings. */
2674 DEFVAR_LISP ("w32-charset-info-alist",
2675 Vw32_charset_info_alist,
2676 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2677 Each entry should be of the form:
2678
2679 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2680
2681 where CHARSET_NAME is a string used in font names to identify the charset,
2682 WINDOWS_CHARSET is a symbol that can be one of:
2683
2684 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2685 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2686 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2687 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2688 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2689 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2690 or w32-charset-oem.
2691
2692 CODEPAGE should be an integer specifying the codepage that should be used
2693 to display the character set, t to do no translation and output as Unicode,
2694 or nil to do no translation and output as 8 bit (or multibyte on far-east
2695 versions of Windows) characters. */);
2696 Vw32_charset_info_alist = Qnil;
2697
2698 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2699 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2700 DEFSYM (Qw32_charset_default, "w32-charset-default");
2701 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2702 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2703 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2704 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2705 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2706 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2707 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2708 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2709 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2710 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2711 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2712 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2713 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2714 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2715 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2716 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2717
2718 defsubr (&Sx_select_font);
2719
2720 w32font_driver.type = Qgdi;
2721 register_font_driver (&w32font_driver, NULL);
2722 }
2723
2724 void
2725 globals_of_w32font (void)
2726 {
2727 g_b_init_is_w9x = 0;
2728 g_b_init_get_outline_metrics_w = 0;
2729 g_b_init_get_text_metrics_w = 0;
2730 g_b_init_get_glyph_outline_w = 0;
2731 }