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