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