Drop FRAME_PTR typedef.
[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 (struct frame *, LOGFONT *, Lisp_Object);
103
104 static BYTE w32_antialias_type (Lisp_Object);
105 static Lisp_Object lispy_antialias_type (BYTE);
106
107 static Lisp_Object font_supported_scripts (FONTSIGNATURE *);
108 static int w32font_full_name (LOGFONT *, Lisp_Object, int, char *, int);
109 static void compute_metrics (HDC, struct w32font_info *, unsigned int,
110 struct w32_metric_cache *);
111
112 static Lisp_Object w32_registry (LONG, DWORD);
113
114 /* EnumFontFamiliesEx callbacks. */
115 static int CALLBACK add_font_entity_to_list (ENUMLOGFONTEX *,
116 NEWTEXTMETRICEX *,
117 DWORD, LPARAM);
118 static int CALLBACK add_one_font_entity_to_list (ENUMLOGFONTEX *,
119 NEWTEXTMETRICEX *,
120 DWORD, LPARAM);
121 static int CALLBACK add_font_name_to_list (ENUMLOGFONTEX *,
122 NEWTEXTMETRICEX *,
123 DWORD, LPARAM);
124
125 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
126 of what we really want. */
127 struct font_callback_data
128 {
129 /* The logfont we are matching against. EnumFontFamiliesEx only matches
130 face name and charset, so we need to manually match everything else
131 in the callback function. */
132 LOGFONT pattern;
133 /* The original font spec or entity. */
134 Lisp_Object orig_font_spec;
135 /* The frame the font is being loaded on. */
136 Lisp_Object frame;
137 /* The list to add matches to. */
138 Lisp_Object list;
139 /* Whether to match only opentype fonts. */
140 int opentype_only;
141 };
142
143 /* Handles the problem that EnumFontFamiliesEx will not return all
144 style variations if the font name is not specified. */
145 static void list_all_matching_fonts (struct font_callback_data *);
146
147 static BOOL g_b_init_is_w9x;
148 static BOOL g_b_init_get_outline_metrics_w;
149 static BOOL g_b_init_get_text_metrics_w;
150 static BOOL g_b_init_get_glyph_outline_w;
151 static BOOL g_b_init_get_glyph_outline_w;
152
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 (struct frame *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 (struct frame *f, Lisp_Object font_spec)
313 {
314 Lisp_Object fonts = w32font_list_internal (f, 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 (struct frame *f, Lisp_Object font_spec)
325 {
326 Lisp_Object entity = w32font_match_internal (f, 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 (struct frame *f)
336 {
337 Lisp_Object list = Qnil;
338 LOGFONT font_match_pattern;
339 HDC dc;
340
341 memset (&font_match_pattern, 0, sizeof (font_match_pattern));
342 font_match_pattern.lfCharSet = DEFAULT_CHARSET;
343
344 dc = get_frame_dc (f);
345
346 EnumFontFamiliesEx (dc, &font_match_pattern,
347 (FONTENUMPROC) add_font_name_to_list,
348 (LPARAM) &list, 0);
349 release_frame_dc (f, dc);
350
351 return list;
352 }
353
354 /* w32 implementation of open for font backend.
355 Open a font specified by FONT_ENTITY on frame F.
356 If the font is scalable, open it with PIXEL_SIZE. */
357 static Lisp_Object
358 w32font_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
359 {
360 Lisp_Object font_object
361 = font_make_object (VECSIZE (struct w32font_info),
362 font_entity, pixel_size);
363 struct w32font_info *w32_font
364 = (struct w32font_info *) XFONT_OBJECT (font_object);
365
366 ASET (font_object, FONT_TYPE_INDEX, Qgdi);
367
368 if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
369 {
370 return Qnil;
371 }
372
373 /* GDI backend does not use glyph indices. */
374 w32_font->glyph_idx = 0;
375
376 return font_object;
377 }
378
379 /* w32 implementation of close for font_backend.
380 Close FONT on frame F. */
381 void
382 w32font_close (struct frame *f, struct font *font)
383 {
384 int i;
385 struct w32font_info *w32_font = (struct w32font_info *) font;
386
387 /* Delete the GDI font object. */
388 DeleteObject (w32_font->hfont);
389
390 /* Free all the cached metrics. */
391 if (w32_font->cached_metrics)
392 {
393 for (i = 0; i < w32_font->n_cache_blocks; i++)
394 {
395 xfree (w32_font->cached_metrics[i]);
396 }
397 xfree (w32_font->cached_metrics);
398 w32_font->cached_metrics = NULL;
399 }
400 }
401
402 /* w32 implementation of has_char for font backend.
403 Optional.
404 If FONT_ENTITY has a glyph for character C (Unicode code point),
405 return 1. If not, return 0. If a font must be opened to check
406 it, return -1. */
407 int
408 w32font_has_char (Lisp_Object entity, int c)
409 {
410 /* We can't be certain about which characters a font will support until
411 we open it. Checking the scripts that the font supports turns out
412 to not be reliable. */
413 return -1;
414
415 #if 0
416 Lisp_Object supported_scripts, extra, script;
417 DWORD mask;
418
419 extra = AREF (entity, FONT_EXTRA_INDEX);
420 if (!CONSP (extra))
421 return -1;
422
423 supported_scripts = assq_no_quit (QCscript, extra);
424 /* If font doesn't claim to support any scripts, then we can't be certain
425 until we open it. */
426 if (!CONSP (supported_scripts))
427 return -1;
428
429 supported_scripts = XCDR (supported_scripts);
430
431 script = CHAR_TABLE_REF (Vchar_script_table, c);
432
433 /* If we don't know what script the character is from, then we can't be
434 certain until we open it. Also if the font claims support for the script
435 the character is from, it may only have partial coverage, so we still
436 can't be certain until we open the font. */
437 if (NILP (script) || memq_no_quit (script, supported_scripts))
438 return -1;
439
440 /* Font reports what scripts it supports, and none of them are the script
441 the character is from. But we still can't be certain, as some fonts
442 will contain some/most/all of the characters in that script without
443 claiming support for it. */
444 return -1;
445 #endif
446 }
447
448 /* w32 implementation of encode_char for font backend.
449 Return a glyph code of FONT for character C (Unicode code point).
450 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
451
452 For speed, the gdi backend uses Unicode (Emacs calls encode_char
453 far too often for it to be efficient). But we still need to detect
454 which characters are not supported by the font.
455 */
456 static unsigned
457 w32font_encode_char (struct font *font, int c)
458 {
459 struct w32font_info * w32_font = (struct w32font_info *)font;
460
461 if (c < w32_font->metrics.tmFirstChar
462 || c > w32_font->metrics.tmLastChar)
463 return FONT_INVALID_CODE;
464 else
465 return c;
466 }
467
468 /* w32 implementation of text_extents for font backend.
469 Perform the size computation of glyphs of FONT and fillin members
470 of METRICS. The glyphs are specified by their glyph codes in
471 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
472 case just return the overall width. */
473 int
474 w32font_text_extents (struct font *font, unsigned *code,
475 int nglyphs, struct font_metrics *metrics)
476 {
477 int i;
478 HFONT old_font = NULL;
479 HDC dc = NULL;
480 struct frame * f;
481 int total_width = 0;
482 WORD *wcode;
483 SIZE size;
484
485 struct w32font_info *w32_font = (struct w32font_info *) font;
486
487 if (metrics)
488 {
489 memset (metrics, 0, sizeof (struct font_metrics));
490 metrics->ascent = font->ascent;
491 metrics->descent = font->descent;
492
493 for (i = 0; i < nglyphs; i++)
494 {
495 struct w32_metric_cache *char_metric;
496 int block = *(code + i) / CACHE_BLOCKSIZE;
497 int pos_in_block = *(code + i) % CACHE_BLOCKSIZE;
498
499 if (block >= w32_font->n_cache_blocks)
500 {
501 if (!w32_font->cached_metrics)
502 w32_font->cached_metrics
503 = xmalloc ((block + 1)
504 * sizeof (struct w32_metric_cache *));
505 else
506 w32_font->cached_metrics
507 = xrealloc (w32_font->cached_metrics,
508 (block + 1)
509 * sizeof (struct w32_metric_cache *));
510 memset (w32_font->cached_metrics + w32_font->n_cache_blocks, 0,
511 ((block + 1 - w32_font->n_cache_blocks)
512 * sizeof (struct w32_metric_cache *)));
513 w32_font->n_cache_blocks = block + 1;
514 }
515
516 if (!w32_font->cached_metrics[block])
517 {
518 w32_font->cached_metrics[block]
519 = xzalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
520 }
521
522 char_metric = w32_font->cached_metrics[block] + pos_in_block;
523
524 if (char_metric->status == W32METRIC_NO_ATTEMPT)
525 {
526 if (dc == NULL)
527 {
528 /* TODO: Frames can come and go, and their fonts
529 outlive them. So we can't cache the frame in the
530 font structure. Use selected_frame until the API
531 is updated to pass in a frame. */
532 f = XFRAME (selected_frame);
533
534 dc = get_frame_dc (f);
535 old_font = SelectObject (dc, w32_font->hfont);
536 }
537 compute_metrics (dc, w32_font, *(code + i), char_metric);
538 }
539
540 if (char_metric->status == W32METRIC_SUCCESS)
541 {
542 metrics->lbearing = min (metrics->lbearing,
543 metrics->width + char_metric->lbearing);
544 metrics->rbearing = max (metrics->rbearing,
545 metrics->width + char_metric->rbearing);
546 metrics->width += char_metric->width;
547 }
548 else
549 /* If we couldn't get metrics for a char,
550 use alternative method. */
551 break;
552 }
553 /* If we got through everything, return. */
554 if (i == nglyphs)
555 {
556 if (dc != NULL)
557 {
558 /* Restore state and release DC. */
559 SelectObject (dc, old_font);
560 release_frame_dc (f, dc);
561 }
562
563 return metrics->width;
564 }
565 }
566
567 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
568 fallback on other methods that will at least give some of the metric
569 information. */
570
571 /* Make array big enough to hold surrogates. */
572 wcode = alloca (nglyphs * sizeof (WORD) * 2);
573 for (i = 0; i < nglyphs; i++)
574 {
575 if (code[i] < 0x10000)
576 wcode[i] = code[i];
577 else
578 {
579 DWORD surrogate = code[i] - 0x10000;
580
581 /* High surrogate: U+D800 - U+DBFF. */
582 wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
583 /* Low surrogate: U+DC00 - U+DFFF. */
584 wcode[i] = 0xDC00 + (surrogate & 0x03FF);
585 /* An extra glyph. wcode is already double the size of code to
586 cope with this. */
587 nglyphs++;
588 }
589 }
590
591 if (dc == NULL)
592 {
593 /* TODO: Frames can come and go, and their fonts outlive
594 them. So we can't cache the frame in the font structure. Use
595 selected_frame until the API is updated to pass in a
596 frame. */
597 f = XFRAME (selected_frame);
598
599 dc = get_frame_dc (f);
600 old_font = SelectObject (dc, w32_font->hfont);
601 }
602
603 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
604 {
605 total_width = size.cx;
606 }
607
608 /* On 95/98/ME, only some Unicode functions are available, so fallback
609 on doing a dummy draw to find the total width. */
610 if (!total_width)
611 {
612 RECT rect;
613 rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
614 DrawTextW (dc, wcode, nglyphs, &rect,
615 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
616 total_width = rect.right;
617 }
618
619 /* Give our best estimate of the metrics, based on what we know. */
620 if (metrics)
621 {
622 metrics->width = total_width - w32_font->metrics.tmOverhang;
623 metrics->lbearing = 0;
624 metrics->rbearing = total_width;
625 }
626
627 /* Restore state and release DC. */
628 SelectObject (dc, old_font);
629 release_frame_dc (f, dc);
630
631 return total_width;
632 }
633
634 /* w32 implementation of draw for font backend.
635 Optional.
636 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
637 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
638 fill the background in advance. It is assured that WITH_BACKGROUND
639 is false when (FROM > 0 || TO < S->nchars).
640
641 TODO: Currently this assumes that the colors and fonts are already
642 set in the DC. This seems to be true now, but maybe only due to
643 the old font code setting it up. It may be safer to resolve faces
644 and fonts in here and set them explicitly
645 */
646
647 int
648 w32font_draw (struct glyph_string *s, int from, int to,
649 int x, int y, bool with_background)
650 {
651 UINT options;
652 HRGN orig_clip = NULL;
653 int len = to - from;
654 struct w32font_info *w32font = (struct w32font_info *) s->font;
655
656 options = w32font->glyph_idx;
657
658 if (s->num_clips > 0)
659 {
660 HRGN new_clip = CreateRectRgnIndirect (s->clip);
661
662 /* Save clip region for later restoration. */
663 orig_clip = CreateRectRgn (0, 0, 0, 0);
664 if (!GetClipRgn (s->hdc, orig_clip))
665 {
666 DeleteObject (orig_clip);
667 orig_clip = NULL;
668 }
669
670 if (s->num_clips > 1)
671 {
672 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
673
674 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
675 DeleteObject (clip2);
676 }
677
678 SelectClipRgn (s->hdc, new_clip);
679 DeleteObject (new_clip);
680 }
681
682 /* Using OPAQUE background mode can clear more background than expected
683 when Cleartype is used. Draw the background manually to avoid this. */
684 SetBkMode (s->hdc, TRANSPARENT);
685 if (with_background)
686 {
687 HBRUSH brush;
688 RECT rect;
689 struct font *font = s->font;
690
691 brush = CreateSolidBrush (s->gc->background);
692 rect.left = x;
693 rect.top = y - font->ascent;
694 rect.right = x + s->width;
695 rect.bottom = y + font->descent;
696 FillRect (s->hdc, &rect, brush);
697 DeleteObject (brush);
698 }
699
700 if (s->padding_p)
701 {
702 int i;
703
704 for (i = 0; i < len; i++)
705 ExtTextOutW (s->hdc, x + i, y, options, NULL,
706 s->char2b + from + i, 1, NULL);
707 }
708 else
709 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, len, NULL);
710
711 /* Restore clip region. */
712 if (s->num_clips > 0)
713 SelectClipRgn (s->hdc, orig_clip);
714
715 if (orig_clip)
716 DeleteObject (orig_clip);
717
718 return len;
719 }
720
721 /* w32 implementation of free_entity for font backend.
722 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
723 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
724 static void
725 w32font_free_entity (Lisp_Object entity);
726 */
727
728 /* w32 implementation of prepare_face for font backend.
729 Optional (if FACE->extra is not used).
730 Prepare FACE for displaying characters by FONT on frame F by
731 storing some data in FACE->extra. If successful, return 0.
732 Otherwise, return -1.
733 static int
734 w32font_prepare_face (struct frame *f, struct face *face);
735 */
736 /* w32 implementation of done_face for font backend.
737 Optional.
738 Done FACE for displaying characters by FACE->font on frame F.
739 static void
740 w32font_done_face (struct frame *f, struct face *face); */
741
742 /* w32 implementation of get_bitmap for font backend.
743 Optional.
744 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
745 intended that this method is called from the other font-driver
746 for actual drawing.
747 static int
748 w32font_get_bitmap (struct font *font, unsigned code,
749 struct font_bitmap *bitmap, int bits_per_pixel);
750 */
751 /* w32 implementation of free_bitmap for font backend.
752 Optional.
753 Free bitmap data in BITMAP.
754 static void
755 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
756 */
757 /* w32 implementation of get_outline for font backend.
758 Optional.
759 Return an outline data for glyph-code CODE of FONT. The format
760 of the outline data depends on the font-driver.
761 static void *
762 w32font_get_outline (struct font *font, unsigned code);
763 */
764 /* w32 implementation of free_outline for font backend.
765 Optional.
766 Free OUTLINE (that is obtained by the above method).
767 static void
768 w32font_free_outline (struct font *font, void *outline);
769 */
770 /* w32 implementation of anchor_point for font backend.
771 Optional.
772 Get coordinates of the INDEXth anchor point of the glyph whose
773 code is CODE. Store the coordinates in *X and *Y. Return 0 if
774 the operations was successful. Otherwise return -1.
775 static int
776 w32font_anchor_point (struct font *font, unsigned code,
777 int index, int *x, int *y);
778 */
779 /* w32 implementation of otf_capability for font backend.
780 Optional.
781 Return a list describing which scripts/languages FONT
782 supports by which GSUB/GPOS features of OpenType tables.
783 static Lisp_Object
784 w32font_otf_capability (struct font *font);
785 */
786 /* w32 implementation of otf_drive for font backend.
787 Optional.
788 Apply FONT's OTF-FEATURES to the glyph string.
789
790 FEATURES specifies which OTF features to apply in this format:
791 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
792 See the documentation of `font-drive-otf' for the detail.
793
794 This method applies the specified features to the codes in the
795 elements of GSTRING-IN (between FROMth and TOth). The output
796 codes are stored in GSTRING-OUT at the IDXth element and the
797 following elements.
798
799 Return the number of output codes. If none of the features are
800 applicable to the input data, return 0. If GSTRING-OUT is too
801 short, return -1.
802 static int
803 w32font_otf_drive (struct font *font, Lisp_Object features,
804 Lisp_Object gstring_in, int from, int to,
805 Lisp_Object gstring_out, int idx,
806 bool alternate_subst);
807 */
808
809 /* Internal implementation of w32font_list.
810 Additional parameter opentype_only restricts the returned fonts to
811 opentype fonts, which can be used with the Uniscribe backend. */
812 Lisp_Object
813 w32font_list_internal (struct frame *f, Lisp_Object font_spec, int opentype_only)
814 {
815 struct font_callback_data match_data;
816 HDC dc;
817
818 match_data.orig_font_spec = font_spec;
819 match_data.list = Qnil;
820 XSETFRAME (match_data.frame, f);
821
822 memset (&match_data.pattern, 0, sizeof (LOGFONT));
823 fill_in_logfont (f, &match_data.pattern, font_spec);
824
825 /* If the charset is unrecognized, then we won't find a font, so don't
826 waste time looking for one. */
827 if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
828 {
829 Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
830 if (!NILP (spec_charset)
831 && !EQ (spec_charset, Qiso10646_1)
832 && !EQ (spec_charset, Qunicode_bmp)
833 && !EQ (spec_charset, Qunicode_sip)
834 && !EQ (spec_charset, Qunknown))
835 return Qnil;
836 }
837
838 match_data.opentype_only = opentype_only;
839 if (opentype_only)
840 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
841
842 if (match_data.pattern.lfFaceName[0] == '\0')
843 {
844 /* EnumFontFamiliesEx does not take other fields into account if
845 font name is blank, so need to use two passes. */
846 list_all_matching_fonts (&match_data);
847 }
848 else
849 {
850 dc = get_frame_dc (f);
851
852 EnumFontFamiliesEx (dc, &match_data.pattern,
853 (FONTENUMPROC) add_font_entity_to_list,
854 (LPARAM) &match_data, 0);
855 release_frame_dc (f, dc);
856 }
857
858 return match_data.list;
859 }
860
861 /* Internal implementation of w32font_match.
862 Additional parameter opentype_only restricts the returned fonts to
863 opentype fonts, which can be used with the Uniscribe backend. */
864 Lisp_Object
865 w32font_match_internal (struct frame *f, Lisp_Object font_spec, int opentype_only)
866 {
867 struct font_callback_data match_data;
868 HDC dc;
869
870 match_data.orig_font_spec = font_spec;
871 XSETFRAME (match_data.frame, f);
872 match_data.list = Qnil;
873
874 memset (&match_data.pattern, 0, sizeof (LOGFONT));
875 fill_in_logfont (f, &match_data.pattern, font_spec);
876
877 match_data.opentype_only = opentype_only;
878 if (opentype_only)
879 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
880
881 dc = get_frame_dc (f);
882
883 EnumFontFamiliesEx (dc, &match_data.pattern,
884 (FONTENUMPROC) add_one_font_entity_to_list,
885 (LPARAM) &match_data, 0);
886 release_frame_dc (f, dc);
887
888 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
889 }
890
891 int
892 w32font_open_internal (struct frame *f, Lisp_Object font_entity,
893 int pixel_size, Lisp_Object font_object)
894 {
895 int len, size;
896 LOGFONT logfont;
897 HDC dc;
898 HFONT hfont, old_font;
899 Lisp_Object val, extra;
900 struct w32font_info *w32_font;
901 struct font * font;
902 OUTLINETEXTMETRICW* metrics = NULL;
903
904 w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
905 font = (struct font *) w32_font;
906
907 if (!font)
908 return 0;
909
910 memset (&logfont, 0, sizeof (logfont));
911 fill_in_logfont (f, &logfont, font_entity);
912
913 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
914 limitations in bitmap fonts. */
915 val = AREF (font_entity, FONT_FOUNDRY_INDEX);
916 if (!EQ (val, Qraster))
917 logfont.lfOutPrecision = OUT_TT_PRECIS;
918
919 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
920 if (!size)
921 size = pixel_size;
922
923 logfont.lfHeight = -size;
924 hfont = CreateFontIndirect (&logfont);
925
926 if (hfont == NULL)
927 return 0;
928
929 /* Get the metrics for this font. */
930 dc = get_frame_dc (f);
931 old_font = SelectObject (dc, hfont);
932
933 /* Try getting the outline metrics (only works for truetype fonts). */
934 len = get_outline_metrics_w (dc, 0, NULL);
935 if (len)
936 {
937 metrics = (OUTLINETEXTMETRICW *) alloca (len);
938 if (get_outline_metrics_w (dc, len, metrics))
939 memcpy (&w32_font->metrics, &metrics->otmTextMetrics,
940 sizeof (TEXTMETRICW));
941 else
942 metrics = NULL;
943 }
944
945 if (!metrics)
946 get_text_metrics_w (dc, &w32_font->metrics);
947
948 w32_font->cached_metrics = NULL;
949 w32_font->n_cache_blocks = 0;
950
951 SelectObject (dc, old_font);
952 release_frame_dc (f, dc);
953
954 w32_font->hfont = hfont;
955
956 {
957 char *name;
958
959 /* We don't know how much space we need for the full name, so start with
960 96 bytes and go up in steps of 32. */
961 len = 96;
962 name = alloca (len);
963 while (name && w32font_full_name (&logfont, font_entity, pixel_size,
964 name, len) < 0)
965 {
966 len += 32;
967 name = alloca (len);
968 }
969 if (name)
970 font->props[FONT_FULLNAME_INDEX]
971 = DECODE_SYSTEM (build_string (name));
972 else
973 font->props[FONT_FULLNAME_INDEX]
974 = DECODE_SYSTEM (build_string (logfont.lfFaceName));
975 }
976
977 font->max_width = w32_font->metrics.tmMaxCharWidth;
978 /* Parts of Emacs display assume that height = ascent + descent...
979 so height is defined later, after ascent and descent.
980 font->height = w32_font->metrics.tmHeight
981 + w32_font->metrics.tmExternalLeading;
982 */
983
984 font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
985
986 font->vertical_centering = 0;
987 font->baseline_offset = 0;
988 font->relative_compose = 0;
989 font->default_ascent = w32_font->metrics.tmAscent;
990 font->font_encoder = NULL;
991 font->pixel_size = size;
992 font->driver = &w32font_driver;
993 /* Use format cached during list, as the information we have access to
994 here is incomplete. */
995 extra = AREF (font_entity, FONT_EXTRA_INDEX);
996 if (CONSP (extra))
997 {
998 val = assq_no_quit (QCformat, extra);
999 if (CONSP (val))
1000 font->props[FONT_FORMAT_INDEX] = XCDR (val);
1001 else
1002 font->props[FONT_FORMAT_INDEX] = Qunknown;
1003 }
1004 else
1005 font->props[FONT_FORMAT_INDEX] = Qunknown;
1006
1007 font->props[FONT_FILE_INDEX] = Qnil;
1008 font->encoding_charset = -1;
1009 font->repertory_charset = -1;
1010 /* TODO: do we really want the minimum width here, which could be negative? */
1011 font->min_width = font->space_width;
1012 font->ascent = w32_font->metrics.tmAscent;
1013 font->descent = w32_font->metrics.tmDescent;
1014 font->height = font->ascent + font->descent;
1015
1016 if (metrics)
1017 {
1018 font->underline_thickness = metrics->otmsUnderscoreSize;
1019 font->underline_position = -metrics->otmsUnderscorePosition;
1020 }
1021 else
1022 {
1023 font->underline_thickness = 0;
1024 font->underline_position = -1;
1025 }
1026
1027 /* For temporary compatibility with legacy code that expects the
1028 name to be usable in x-list-fonts. Eventually we expect to change
1029 x-list-fonts and other places that use fonts so that this can be
1030 an fcname or similar. */
1031 font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
1032
1033 return 1;
1034 }
1035
1036 /* Callback function for EnumFontFamiliesEx.
1037 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
1038 static int CALLBACK
1039 add_font_name_to_list (ENUMLOGFONTEX *logical_font,
1040 NEWTEXTMETRICEX *physical_font,
1041 DWORD font_type, LPARAM list_object)
1042 {
1043 Lisp_Object* list = (Lisp_Object *) list_object;
1044 Lisp_Object family;
1045
1046 /* Skip vertical fonts (intended only for printing) */
1047 if (logical_font->elfLogFont.lfFaceName[0] == '@')
1048 return 1;
1049
1050 family = intern_font_name (logical_font->elfLogFont.lfFaceName);
1051 if (! memq_no_quit (family, *list))
1052 *list = Fcons (family, *list);
1053
1054 return 1;
1055 }
1056
1057 static int w32_decode_weight (int);
1058 static int w32_encode_weight (int);
1059
1060 /* Convert an enumerated Windows font to an Emacs font entity. */
1061 static Lisp_Object
1062 w32_enumfont_pattern_entity (Lisp_Object frame,
1063 ENUMLOGFONTEX *logical_font,
1064 NEWTEXTMETRICEX *physical_font,
1065 DWORD font_type,
1066 LOGFONT *requested_font,
1067 Lisp_Object backend)
1068 {
1069 Lisp_Object entity, tem;
1070 LOGFONT *lf = (LOGFONT*) logical_font;
1071 BYTE generic_type;
1072 DWORD full_type = physical_font->ntmTm.ntmFlags;
1073
1074 entity = font_make_entity ();
1075
1076 ASET (entity, FONT_TYPE_INDEX, backend);
1077 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
1078 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
1079
1080 /* Foundry is difficult to get in readable form on Windows.
1081 But Emacs crashes if it is not set, so set it to something more
1082 generic. These values make xlfds compatible with Emacs 22. */
1083 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
1084 tem = Qraster;
1085 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
1086 tem = Qoutline;
1087 else
1088 tem = Qunknown;
1089
1090 ASET (entity, FONT_FOUNDRY_INDEX, tem);
1091
1092 /* Save the generic family in the extra info, as it is likely to be
1093 useful to users looking for a close match. */
1094 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
1095 if (generic_type == FF_DECORATIVE)
1096 tem = Qdecorative;
1097 else if (generic_type == FF_MODERN)
1098 tem = Qmono;
1099 else if (generic_type == FF_ROMAN)
1100 tem = Qserif;
1101 else if (generic_type == FF_SCRIPT)
1102 tem = Qscript;
1103 else if (generic_type == FF_SWISS)
1104 tem = Qsans;
1105 else
1106 tem = Qnil;
1107
1108 ASET (entity, FONT_ADSTYLE_INDEX, tem);
1109
1110 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
1111 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL));
1112 else
1113 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL));
1114
1115 if (requested_font->lfQuality != DEFAULT_QUALITY)
1116 {
1117 font_put_extra (entity, QCantialias,
1118 lispy_antialias_type (requested_font->lfQuality));
1119 }
1120 ASET (entity, FONT_FAMILY_INDEX,
1121 intern_font_name (lf->lfFaceName));
1122
1123 FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
1124 make_number (w32_decode_weight (lf->lfWeight)));
1125 FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
1126 make_number (lf->lfItalic ? 200 : 100));
1127 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1128 to get it. */
1129 FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100));
1130
1131 if (font_type & RASTER_FONTTYPE)
1132 ASET (entity, FONT_SIZE_INDEX,
1133 make_number (physical_font->ntmTm.tmHeight
1134 + physical_font->ntmTm.tmExternalLeading));
1135 else
1136 ASET (entity, FONT_SIZE_INDEX, make_number (0));
1137
1138 /* Cache Unicode codepoints covered by this font, as there is no other way
1139 of getting this information easily. */
1140 if (font_type & TRUETYPE_FONTTYPE)
1141 {
1142 tem = font_supported_scripts (&physical_font->ntmFontSig);
1143 if (!NILP (tem))
1144 font_put_extra (entity, QCscript, tem);
1145 }
1146
1147 /* This information is not fully available when opening fonts, so
1148 save it here. Only Windows 2000 and later return information
1149 about opentype and type1 fonts, so need a fallback for detecting
1150 truetype so that this information is not any worse than we could
1151 have obtained later. */
1152 if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
1153 tem = intern ("opentype");
1154 else if (font_type & TRUETYPE_FONTTYPE)
1155 tem = intern ("truetype");
1156 else if (full_type & NTM_PS_OPENTYPE)
1157 tem = intern ("postscript");
1158 else if (full_type & NTM_TYPE1)
1159 tem = intern ("type1");
1160 else if (font_type & RASTER_FONTTYPE)
1161 tem = intern ("w32bitmap");
1162 else
1163 tem = intern ("w32vector");
1164
1165 font_put_extra (entity, QCformat, tem);
1166
1167 return entity;
1168 }
1169
1170
1171 /* Convert generic families to the family portion of lfPitchAndFamily. */
1172 static BYTE
1173 w32_generic_family (Lisp_Object name)
1174 {
1175 /* Generic families. */
1176 if (EQ (name, Qmonospace) || EQ (name, Qmono))
1177 return FF_MODERN;
1178 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
1179 return FF_SWISS;
1180 else if (EQ (name, Qserif))
1181 return FF_ROMAN;
1182 else if (EQ (name, Qdecorative))
1183 return FF_DECORATIVE;
1184 else if (EQ (name, Qscript))
1185 return FF_SCRIPT;
1186 else
1187 return FF_DONTCARE;
1188 }
1189
1190 static int
1191 logfonts_match (LOGFONT *font, LOGFONT *pattern)
1192 {
1193 /* Only check height for raster fonts. */
1194 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
1195 && font->lfHeight != pattern->lfHeight)
1196 return 0;
1197
1198 /* Have some flexibility with weights. */
1199 if (pattern->lfWeight
1200 && ((font->lfWeight < (pattern->lfWeight - 150))
1201 || font->lfWeight > (pattern->lfWeight + 150)))
1202 return 0;
1203
1204 /* Charset and face should be OK. Italic has to be checked
1205 against the original spec, in case we don't have any preference. */
1206 return 1;
1207 }
1208
1209 /* Codepage Bitfields in FONTSIGNATURE struct. */
1210 #define CSB_JAPANESE (1 << 17)
1211 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1212 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1213
1214 static int
1215 font_matches_spec (DWORD type, NEWTEXTMETRICEX *font,
1216 Lisp_Object spec, Lisp_Object backend,
1217 LOGFONT *logfont)
1218 {
1219 Lisp_Object extra, val;
1220
1221 /* Check italic. Can't check logfonts, since it is a boolean field,
1222 so there is no difference between "non-italic" and "don't care". */
1223 {
1224 int slant = FONT_SLANT_NUMERIC (spec);
1225
1226 if (slant >= 0
1227 && ((slant > 150 && !font->ntmTm.tmItalic)
1228 || (slant <= 150 && font->ntmTm.tmItalic)))
1229 return 0;
1230 }
1231
1232 /* Check adstyle against generic family. */
1233 val = AREF (spec, FONT_ADSTYLE_INDEX);
1234 if (!NILP (val))
1235 {
1236 BYTE family = w32_generic_family (val);
1237 if (family != FF_DONTCARE
1238 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
1239 return 0;
1240 }
1241
1242 /* Check spacing */
1243 val = AREF (spec, FONT_SPACING_INDEX);
1244 if (INTEGERP (val))
1245 {
1246 int spacing = XINT (val);
1247 int proportional = (spacing < FONT_SPACING_MONO);
1248
1249 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
1250 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
1251 return 0;
1252 }
1253
1254 /* Check extra parameters. */
1255 for (extra = AREF (spec, FONT_EXTRA_INDEX);
1256 CONSP (extra); extra = XCDR (extra))
1257 {
1258 Lisp_Object extra_entry;
1259 extra_entry = XCAR (extra);
1260 if (CONSP (extra_entry))
1261 {
1262 Lisp_Object key = XCAR (extra_entry);
1263
1264 val = XCDR (extra_entry);
1265 if (EQ (key, QCscript) && SYMBOLP (val))
1266 {
1267 /* Only truetype fonts will have information about what
1268 scripts they support. This probably means the user
1269 will have to force Emacs to use raster, PostScript
1270 or ATM fonts for non-ASCII text. */
1271 if (type & TRUETYPE_FONTTYPE)
1272 {
1273 Lisp_Object support
1274 = font_supported_scripts (&font->ntmFontSig);
1275 if (! memq_no_quit (val, support))
1276 return 0;
1277
1278 /* Avoid using non-Japanese fonts for Japanese, even
1279 if they claim they are capable, due to known
1280 breakage in Vista and Windows 7 fonts
1281 (bug#6029). */
1282 if (EQ (val, Qkana)
1283 && (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET
1284 || !(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE)))
1285 return 0;
1286 }
1287 else
1288 {
1289 /* Return specific matches, but play it safe. Fonts
1290 that cover more than their charset would suggest
1291 are likely to be truetype or opentype fonts,
1292 covered above. */
1293 if (EQ (val, Qlatin))
1294 {
1295 /* Although every charset but symbol, thai and
1296 arabic contains the basic ASCII set of latin
1297 characters, Emacs expects much more. */
1298 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
1299 return 0;
1300 }
1301 else if (EQ (val, Qsymbol))
1302 {
1303 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
1304 return 0;
1305 }
1306 else if (EQ (val, Qcyrillic))
1307 {
1308 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
1309 return 0;
1310 }
1311 else if (EQ (val, Qgreek))
1312 {
1313 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
1314 return 0;
1315 }
1316 else if (EQ (val, Qarabic))
1317 {
1318 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
1319 return 0;
1320 }
1321 else if (EQ (val, Qhebrew))
1322 {
1323 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
1324 return 0;
1325 }
1326 else if (EQ (val, Qthai))
1327 {
1328 if (font->ntmTm.tmCharSet != THAI_CHARSET)
1329 return 0;
1330 }
1331 else if (EQ (val, Qkana))
1332 {
1333 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1334 return 0;
1335 }
1336 else if (EQ (val, Qbopomofo))
1337 {
1338 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1339 return 0;
1340 }
1341 else if (EQ (val, Qhangul))
1342 {
1343 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1344 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1345 return 0;
1346 }
1347 else if (EQ (val, Qhan))
1348 {
1349 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1350 && font->ntmTm.tmCharSet != GB2312_CHARSET
1351 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1352 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1353 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1354 return 0;
1355 }
1356 else
1357 /* Other scripts unlikely to be handled by non-truetype
1358 fonts. */
1359 return 0;
1360 }
1361 }
1362 else if (EQ (key, QClang) && SYMBOLP (val))
1363 {
1364 /* Just handle the CJK languages here, as the lang
1365 parameter is used to select a font with appropriate
1366 glyphs in the cjk unified ideographs block. Other fonts
1367 support for a language can be solely determined by
1368 its character coverage. */
1369 if (EQ (val, Qja))
1370 {
1371 if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1372 return 0;
1373 }
1374 else if (EQ (val, Qko))
1375 {
1376 if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
1377 return 0;
1378 }
1379 else if (EQ (val, Qzh))
1380 {
1381 if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
1382 return 0;
1383 }
1384 else
1385 /* Any other language, we don't recognize it. Only the above
1386 currently appear in fontset.el, so it isn't worth
1387 creating a mapping table of codepages/scripts to languages
1388 or opening the font to see if there are any language tags
1389 in it that the Windows API does not expose. Fontset
1390 spec should have a fallback, as some backends do
1391 not recognize language at all. */
1392 return 0;
1393 }
1394 else if (EQ (key, QCotf) && CONSP (val))
1395 {
1396 /* OTF features only supported by the uniscribe backend. */
1397 if (EQ (backend, Quniscribe))
1398 {
1399 if (!uniscribe_check_otf (logfont, val))
1400 return 0;
1401 }
1402 else
1403 return 0;
1404 }
1405 }
1406 }
1407 return 1;
1408 }
1409
1410 static int
1411 w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset)
1412 {
1413 DWORD subrange1 = coverage->fsUsb[1];
1414
1415 #define SUBRANGE1_HAN_MASK 0x08000000
1416 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1417 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1418
1419 if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET)
1420 {
1421 return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK;
1422 }
1423 else if (charset == SHIFTJIS_CHARSET)
1424 {
1425 return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK;
1426 }
1427 else if (charset == HANGEUL_CHARSET)
1428 {
1429 return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK;
1430 }
1431
1432 return 1;
1433 }
1434
1435 #ifndef WINDOWSNT
1436 #define _strlwr strlwr
1437 #endif /* !WINDOWSNT */
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 (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec)
1965 {
1966 Lisp_Object tmp, extra;
1967 int dpi = FRAME_RES_Y (f);
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 (XFRAME (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 struct frame *f = decode_window_system_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 }