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