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