remove Lisp_Free struct type
[bpt/emacs.git] / src / w32font.c
1 /* Font backend for the Microsoft Windows API.
2 Copyright (C) 2007-2014 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 #include <config.h>
20 #include <windows.h>
21 #include <stdio.h>
22 #include <math.h>
23 #include <ctype.h>
24 #include <commdlg.h>
25
26 #include "lisp.h"
27 #include "w32term.h"
28 #include "frame.h"
29 #include "dispextern.h"
30 #include "character.h"
31 #include "charset.h"
32 #include "coding.h"
33 #include "fontset.h"
34 #include "font.h"
35 #include "w32font.h"
36 #ifdef WINDOWSNT
37 #include "w32.h"
38 #endif
39
40 /* Cleartype available on Windows XP, cleartype_natural from XP SP1.
41 The latter does not try to fit cleartype smoothed fonts into the
42 same bounding box as the non-antialiased version of the font.
43 */
44 #ifndef CLEARTYPE_QUALITY
45 #define CLEARTYPE_QUALITY 5
46 #endif
47 #ifndef CLEARTYPE_NATURAL_QUALITY
48 #define CLEARTYPE_NATURAL_QUALITY 6
49 #endif
50
51 /* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
52 of MSVC headers. */
53 #ifndef VIETNAMESE_CHARSET
54 #define VIETNAMESE_CHARSET 163
55 #endif
56 #ifndef JOHAB_CHARSET
57 #define JOHAB_CHARSET 130
58 #endif
59
60 Lisp_Object Qgdi;
61 Lisp_Object Quniscribe;
62 static Lisp_Object QCformat;
63 static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif;
64 static Lisp_Object Qserif, Qscript, Qdecorative;
65 static Lisp_Object Qraster, Qoutline, Qunknown;
66
67 /* antialiasing */
68 static Lisp_Object Qstandard, Qsubpixel, Qnatural;
69
70 /* languages */
71 static Lisp_Object Qzh;
72
73 /* scripts */
74 static Lisp_Object Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
75 static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
76 static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
77 static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
78 static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
79 static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
80 static Lisp_Object Qkhmer, Qmongolian, Qbraille, Qhan;
81 static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
82 static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
83 static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
84 /* Not defined in characters.el, but referenced in fontset.el. */
85 static Lisp_Object Qbalinese, Qbuginese, Qbuhid, Qcuneiform, Qcypriot;
86 static Lisp_Object Qdeseret, Qglagolitic, Qgothic, Qhanunoo, Qkharoshthi;
87 static Lisp_Object Qlimbu, Qlinear_b, Qold_italic, Qold_persian, Qosmanya;
88 static Lisp_Object Qphags_pa, Qphoenician, Qshavian, Qsyloti_nagri;
89 static Lisp_Object Qtagalog, Qtagbanwa, Qtai_le, Qtifinagh, Qugaritic;
90
91 /* W32 charsets: for use in Vw32_charset_info_alist. */
92 static Lisp_Object Qw32_charset_ansi, Qw32_charset_default;
93 static Lisp_Object Qw32_charset_symbol, Qw32_charset_shiftjis;
94 static Lisp_Object Qw32_charset_hangeul, Qw32_charset_gb2312;
95 static Lisp_Object Qw32_charset_chinesebig5, Qw32_charset_oem;
96 static Lisp_Object Qw32_charset_easteurope, Qw32_charset_turkish;
97 static Lisp_Object Qw32_charset_baltic, Qw32_charset_russian;
98 static Lisp_Object Qw32_charset_arabic, Qw32_charset_greek;
99 static Lisp_Object Qw32_charset_hebrew, Qw32_charset_vietnamese;
100 static Lisp_Object Qw32_charset_thai, Qw32_charset_johab, Qw32_charset_mac;
101
102 /* Font spacing symbols - defined in font.c. */
103 extern Lisp_Object Qc, Qp, Qm;
104
105 static void fill_in_logfont (struct frame *, LOGFONT *, Lisp_Object);
106
107 static BYTE w32_antialias_type (Lisp_Object);
108 static Lisp_Object lispy_antialias_type (BYTE);
109
110 static Lisp_Object font_supported_scripts (FONTSIGNATURE *);
111 static int w32font_full_name (LOGFONT *, Lisp_Object, int, char *, int);
112 static void compute_metrics (HDC, struct w32font_info *, unsigned int,
113 struct w32_metric_cache *);
114
115 static Lisp_Object w32_registry (LONG, DWORD);
116
117 /* EnumFontFamiliesEx callbacks. */
118 static int CALLBACK add_font_entity_to_list (ENUMLOGFONTEX *,
119 NEWTEXTMETRICEX *,
120 DWORD, LPARAM);
121 static int CALLBACK add_one_font_entity_to_list (ENUMLOGFONTEX *,
122 NEWTEXTMETRICEX *,
123 DWORD, LPARAM);
124 static int CALLBACK add_font_name_to_list (ENUMLOGFONTEX *,
125 NEWTEXTMETRICEX *,
126 DWORD, LPARAM);
127
128 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
129 of what we really want. */
130 struct font_callback_data
131 {
132 /* The logfont we are matching against. EnumFontFamiliesEx only matches
133 face name and charset, so we need to manually match everything else
134 in the callback function. */
135 LOGFONT pattern;
136 /* The original font spec or entity. */
137 Lisp_Object orig_font_spec;
138 /* The frame the font is being loaded on. */
139 Lisp_Object frame;
140 /* The list to add matches to. */
141 Lisp_Object list;
142 /* Whether to match only opentype fonts. */
143 int opentype_only;
144 };
145
146 /* Handles the problem that EnumFontFamiliesEx will not return all
147 style variations if the font name is not specified. */
148 static void list_all_matching_fonts (struct font_callback_data *);
149
150 #ifdef WINDOWSNT
151
152 static BOOL g_b_init_get_outline_metrics_w;
153 static BOOL g_b_init_get_text_metrics_w;
154 static BOOL g_b_init_get_glyph_outline_w;
155 static BOOL g_b_init_get_glyph_outline_w;
156 static BOOL g_b_init_get_char_width_32_w;
157
158 typedef UINT (WINAPI * GetOutlineTextMetricsW_Proc) (
159 HDC hdc,
160 UINT cbData,
161 LPOUTLINETEXTMETRICW lpotmw);
162 typedef BOOL (WINAPI * GetTextMetricsW_Proc) (
163 HDC hdc,
164 LPTEXTMETRICW lptmw);
165 typedef DWORD (WINAPI * GetGlyphOutlineW_Proc) (
166 HDC hdc,
167 UINT uChar,
168 UINT uFormat,
169 LPGLYPHMETRICS lpgm,
170 DWORD cbBuffer,
171 LPVOID lpvBuffer,
172 const MAT2 *lpmat2);
173 typedef BOOL (WINAPI * GetCharWidth32W_Proc) (
174 HDC hdc,
175 UINT uFirstChar,
176 UINT uLastChar,
177 LPINT lpBuffer);
178
179 /* Several "wide" functions we use to support the font backends are
180 unavailable on Windows 9X, unless UNICOWS.DLL is installed (their
181 versions in the default libraries are non-functional stubs). On NT
182 and later systems, these functions are in GDI32.DLL. The following
183 helper function attempts to load UNICOWS.DLL on Windows 9X, and
184 refuses to let Emacs start up if that library is not found. On NT
185 and later versions, it simply loads GDI32.DLL, which should always
186 be available. */
187 static HMODULE
188 w32_load_unicows_or_gdi32 (void)
189 {
190 return maybe_load_unicows_dll ();
191 }
192
193 /* The following 3 functions call the problematic "wide" APIs via
194 function pointers, to avoid linking against the non-standard
195 libunicows on W9X. */
196 static UINT WINAPI
197 get_outline_metrics_w(HDC hdc, UINT cbData, LPOUTLINETEXTMETRICW lpotmw)
198 {
199 static GetOutlineTextMetricsW_Proc s_pfn_Get_Outline_Text_MetricsW = NULL;
200 HMODULE hm_unicows = NULL;
201 if (g_b_init_get_outline_metrics_w == 0)
202 {
203 g_b_init_get_outline_metrics_w = 1;
204 hm_unicows = w32_load_unicows_or_gdi32 ();
205 if (hm_unicows)
206 s_pfn_Get_Outline_Text_MetricsW = (GetOutlineTextMetricsW_Proc)
207 GetProcAddress (hm_unicows, "GetOutlineTextMetricsW");
208 }
209 eassert (s_pfn_Get_Outline_Text_MetricsW != NULL);
210 return s_pfn_Get_Outline_Text_MetricsW (hdc, cbData, lpotmw);
211 }
212
213 static BOOL WINAPI
214 get_text_metrics_w(HDC hdc, LPTEXTMETRICW lptmw)
215 {
216 static GetTextMetricsW_Proc s_pfn_Get_Text_MetricsW = NULL;
217 HMODULE hm_unicows = NULL;
218 if (g_b_init_get_text_metrics_w == 0)
219 {
220 g_b_init_get_text_metrics_w = 1;
221 hm_unicows = w32_load_unicows_or_gdi32 ();
222 if (hm_unicows)
223 s_pfn_Get_Text_MetricsW = (GetTextMetricsW_Proc)
224 GetProcAddress (hm_unicows, "GetTextMetricsW");
225 }
226 eassert (s_pfn_Get_Text_MetricsW != NULL);
227 return s_pfn_Get_Text_MetricsW (hdc, lptmw);
228 }
229
230 static DWORD WINAPI
231 get_glyph_outline_w (HDC hdc, UINT uChar, UINT uFormat, LPGLYPHMETRICS lpgm,
232 DWORD cbBuffer, LPVOID lpvBuffer, const MAT2 *lpmat2)
233 {
234 static GetGlyphOutlineW_Proc s_pfn_Get_Glyph_OutlineW = NULL;
235 HMODULE hm_unicows = NULL;
236 if (g_b_init_get_glyph_outline_w == 0)
237 {
238 g_b_init_get_glyph_outline_w = 1;
239 hm_unicows = w32_load_unicows_or_gdi32 ();
240 if (hm_unicows)
241 s_pfn_Get_Glyph_OutlineW = (GetGlyphOutlineW_Proc)
242 GetProcAddress (hm_unicows, "GetGlyphOutlineW");
243 }
244 eassert (s_pfn_Get_Glyph_OutlineW != NULL);
245 return s_pfn_Get_Glyph_OutlineW (hdc, uChar, uFormat, lpgm, cbBuffer,
246 lpvBuffer, lpmat2);
247 }
248
249 static DWORD WINAPI
250 get_char_width_32_w (HDC hdc, UINT uFirstChar, UINT uLastChar, LPINT lpBuffer)
251 {
252 static GetCharWidth32W_Proc s_pfn_Get_Char_Width_32W = NULL;
253 HMODULE hm_unicows = NULL;
254 if (g_b_init_get_char_width_32_w == 0)
255 {
256 g_b_init_get_char_width_32_w = 1;
257 hm_unicows = w32_load_unicows_or_gdi32 ();
258 if (hm_unicows)
259 s_pfn_Get_Char_Width_32W = (GetCharWidth32W_Proc)
260 GetProcAddress (hm_unicows, "GetCharWidth32W");
261 }
262 eassert (s_pfn_Get_Char_Width_32W != NULL);
263 return s_pfn_Get_Char_Width_32W (hdc, uFirstChar, uLastChar, lpBuffer);
264 }
265
266 #else /* Cygwin */
267
268 /* Cygwin doesn't support Windows 9X, and links against GDI32.DLL, so
269 it can just call these functions directly. */
270 #define get_outline_metrics_w(h,d,o) GetOutlineTextMetricsW(h,d,o)
271 #define get_text_metrics_w(h,t) GetTextMetricsW(h,t)
272 #define get_glyph_outline_w(h,uc,f,gm,b,v,m) \
273 GetGlyphOutlineW(h,uc,f,gm,b,v,m)
274 #define get_char_width_32_w(h,fc,lc,b) GetCharWidth32W(h,fc,lc,b)
275
276 #endif /* Cygwin */
277
278 static int
279 memq_no_quit (Lisp_Object elt, Lisp_Object list)
280 {
281 while (CONSP (list) && ! EQ (XCAR (list), elt))
282 list = XCDR (list);
283 return (CONSP (list));
284 }
285
286 Lisp_Object
287 intern_font_name (char * string)
288 {
289 Lisp_Object str = DECODE_SYSTEM (build_string (string));
290 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 get_outline for font backend.
761 Optional.
762 Return an outline data for glyph-code CODE of FONT. The format
763 of the outline data depends on the font-driver.
764 static void *
765 w32font_get_outline (struct font *font, unsigned code);
766 */
767 /* w32 implementation of free_outline for font backend.
768 Optional.
769 Free OUTLINE (that is obtained by the above method).
770 static void
771 w32font_free_outline (struct font *font, void *outline);
772 */
773 /* w32 implementation of anchor_point for font backend.
774 Optional.
775 Get coordinates of the INDEXth anchor point of the glyph whose
776 code is CODE. Store the coordinates in *X and *Y. Return 0 if
777 the operations was successful. Otherwise return -1.
778 static int
779 w32font_anchor_point (struct font *font, unsigned code,
780 int index, int *x, int *y);
781 */
782 /* w32 implementation of otf_capability for font backend.
783 Optional.
784 Return a list describing which scripts/languages FONT
785 supports by which GSUB/GPOS features of OpenType tables.
786 static Lisp_Object
787 w32font_otf_capability (struct font *font);
788 */
789 /* w32 implementation of otf_drive for font backend.
790 Optional.
791 Apply FONT's OTF-FEATURES to the glyph string.
792
793 FEATURES specifies which OTF features to apply in this format:
794 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
795 See the documentation of `font-drive-otf' for the detail.
796
797 This method applies the specified features to the codes in the
798 elements of GSTRING-IN (between FROMth and TOth). The output
799 codes are stored in GSTRING-OUT at the IDXth element and the
800 following elements.
801
802 Return the number of output codes. If none of the features are
803 applicable to the input data, return 0. If GSTRING-OUT is too
804 short, return -1.
805 static int
806 w32font_otf_drive (struct font *font, Lisp_Object features,
807 Lisp_Object gstring_in, int from, int to,
808 Lisp_Object gstring_out, int idx,
809 bool alternate_subst);
810 */
811
812 /* Internal implementation of w32font_list.
813 Additional parameter opentype_only restricts the returned fonts to
814 opentype fonts, which can be used with the Uniscribe backend. */
815 Lisp_Object
816 w32font_list_internal (struct frame *f, Lisp_Object font_spec, int opentype_only)
817 {
818 struct font_callback_data match_data;
819 HDC dc;
820
821 match_data.orig_font_spec = font_spec;
822 match_data.list = Qnil;
823 XSETFRAME (match_data.frame, f);
824
825 memset (&match_data.pattern, 0, sizeof (LOGFONT));
826 fill_in_logfont (f, &match_data.pattern, font_spec);
827
828 /* If the charset is unrecognized, then we won't find a font, so don't
829 waste time looking for one. */
830 if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
831 {
832 Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
833 if (!NILP (spec_charset)
834 && !EQ (spec_charset, Qiso10646_1)
835 && !EQ (spec_charset, Qunicode_bmp)
836 && !EQ (spec_charset, Qunicode_sip)
837 && !EQ (spec_charset, Qunknown))
838 return Qnil;
839 }
840
841 match_data.opentype_only = opentype_only;
842 if (opentype_only)
843 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
844
845 if (match_data.pattern.lfFaceName[0] == '\0')
846 {
847 /* EnumFontFamiliesEx does not take other fields into account if
848 font name is blank, so need to use two passes. */
849 list_all_matching_fonts (&match_data);
850 }
851 else
852 {
853 dc = get_frame_dc (f);
854
855 EnumFontFamiliesEx (dc, &match_data.pattern,
856 (FONTENUMPROC) add_font_entity_to_list,
857 (LPARAM) &match_data, 0);
858 release_frame_dc (f, dc);
859 }
860
861 return match_data.list;
862 }
863
864 /* Internal implementation of w32font_match.
865 Additional parameter opentype_only restricts the returned fonts to
866 opentype fonts, which can be used with the Uniscribe backend. */
867 Lisp_Object
868 w32font_match_internal (struct frame *f, Lisp_Object font_spec, int opentype_only)
869 {
870 struct font_callback_data match_data;
871 HDC dc;
872
873 match_data.orig_font_spec = font_spec;
874 XSETFRAME (match_data.frame, f);
875 match_data.list = Qnil;
876
877 memset (&match_data.pattern, 0, sizeof (LOGFONT));
878 fill_in_logfont (f, &match_data.pattern, font_spec);
879
880 match_data.opentype_only = opentype_only;
881 if (opentype_only)
882 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
883
884 dc = get_frame_dc (f);
885
886 EnumFontFamiliesEx (dc, &match_data.pattern,
887 (FONTENUMPROC) add_one_font_entity_to_list,
888 (LPARAM) &match_data, 0);
889 release_frame_dc (f, dc);
890
891 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
892 }
893
894 int
895 w32font_open_internal (struct frame *f, Lisp_Object font_entity,
896 int pixel_size, Lisp_Object font_object)
897 {
898 int len, size;
899 LOGFONT logfont;
900 HDC dc;
901 HFONT hfont, old_font;
902 Lisp_Object val, extra;
903 struct w32font_info *w32_font;
904 struct font * font;
905 OUTLINETEXTMETRICW* metrics = NULL;
906
907 w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
908 font = (struct font *) w32_font;
909
910 if (!font)
911 return 0;
912
913 memset (&logfont, 0, sizeof (logfont));
914 fill_in_logfont (f, &logfont, font_entity);
915
916 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
917 limitations in bitmap fonts. */
918 val = AREF (font_entity, FONT_FOUNDRY_INDEX);
919 if (!EQ (val, Qraster))
920 logfont.lfOutPrecision = OUT_TT_PRECIS;
921
922 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
923 if (!size)
924 size = pixel_size;
925
926 logfont.lfHeight = -size;
927 hfont = CreateFontIndirect (&logfont);
928
929 if (hfont == NULL)
930 return 0;
931
932 /* Get the metrics for this font. */
933 dc = get_frame_dc (f);
934 old_font = SelectObject (dc, hfont);
935
936 /* Try getting the outline metrics (only works for truetype fonts). */
937 len = get_outline_metrics_w (dc, 0, NULL);
938 if (len)
939 {
940 metrics = (OUTLINETEXTMETRICW *) alloca (len);
941 if (get_outline_metrics_w (dc, len, metrics))
942 memcpy (&w32_font->metrics, &metrics->otmTextMetrics,
943 sizeof (TEXTMETRICW));
944 else
945 metrics = NULL;
946 }
947
948 if (!metrics)
949 get_text_metrics_w (dc, &w32_font->metrics);
950
951 w32_font->cached_metrics = NULL;
952 w32_font->n_cache_blocks = 0;
953
954 SelectObject (dc, old_font);
955 release_frame_dc (f, dc);
956
957 w32_font->hfont = hfont;
958
959 {
960 char *name;
961
962 /* We don't know how much space we need for the full name, so start with
963 96 bytes and go up in steps of 32. */
964 len = 96;
965 name = alloca (len);
966 while (name && w32font_full_name (&logfont, font_entity, pixel_size,
967 name, len) < 0)
968 {
969 len += 32;
970 name = alloca (len);
971 }
972 if (name)
973 font->props[FONT_FULLNAME_INDEX]
974 = DECODE_SYSTEM (build_string (name));
975 else
976 font->props[FONT_FULLNAME_INDEX]
977 = DECODE_SYSTEM (build_string (logfont.lfFaceName));
978 }
979
980 font->max_width = w32_font->metrics.tmMaxCharWidth;
981 /* Parts of Emacs display assume that height = ascent + descent...
982 so height is defined later, after ascent and descent.
983 font->height = w32_font->metrics.tmHeight
984 + w32_font->metrics.tmExternalLeading;
985 */
986
987 font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
988
989 font->vertical_centering = 0;
990 font->baseline_offset = 0;
991 font->relative_compose = 0;
992 font->default_ascent = w32_font->metrics.tmAscent;
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 #ifndef WINDOWSNT
1438 #define _strlwr strlwr
1439 #endif /* !WINDOWSNT */
1440
1441 static int
1442 check_face_name (LOGFONT *font, char *full_name)
1443 {
1444 char full_iname[LF_FULLFACESIZE+1];
1445
1446 /* Just check for names known to cause problems, since the full name
1447 can contain expanded abbreviations, prefixed foundry, postfixed
1448 style, the latter of which sometimes differs from the style indicated
1449 in the shorter name (eg Lt becomes Light or even Extra Light) */
1450
1451 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1452 installed, we run into problems with the Uniscribe backend which tries
1453 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1454 with Arial's characteristics, since that attempt to use TrueType works
1455 some places, but not others. */
1456 if (!xstrcasecmp (font->lfFaceName, "helvetica"))
1457 {
1458 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1459 full_iname[LF_FULLFACESIZE] = 0;
1460 _strlwr (full_iname);
1461 return strstr ("helvetica", full_iname) != NULL;
1462 }
1463 /* Same for Helv. */
1464 if (!xstrcasecmp (font->lfFaceName, "helv"))
1465 {
1466 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1467 full_iname[LF_FULLFACESIZE] = 0;
1468 _strlwr (full_iname);
1469 return strstr ("helv", full_iname) != NULL;
1470 }
1471
1472 /* Since Times is mapped to Times New Roman, a substring
1473 match is not sufficient to filter out the bogus match. */
1474 else if (!xstrcasecmp (font->lfFaceName, "times"))
1475 return xstrcasecmp (full_name, "times") == 0;
1476
1477 return 1;
1478 }
1479
1480
1481 /* Callback function for EnumFontFamiliesEx.
1482 * Checks if a font matches everything we are trying to check against,
1483 * and if so, adds it to a list. Both the data we are checking against
1484 * and the list to which the fonts are added are passed in via the
1485 * lparam argument, in the form of a font_callback_data struct. */
1486 static int CALLBACK
1487 add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1488 NEWTEXTMETRICEX *physical_font,
1489 DWORD font_type, LPARAM lParam)
1490 {
1491 struct font_callback_data *match_data
1492 = (struct font_callback_data *) lParam;
1493 Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
1494 Lisp_Object entity;
1495
1496 int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1497 || physical_font->ntmFontSig.fsUsb[2]
1498 || physical_font->ntmFontSig.fsUsb[1]
1499 || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1500
1501 /* Skip non matching fonts. */
1502
1503 /* For uniscribe backend, consider only truetype or opentype fonts
1504 that have some Unicode coverage. */
1505 if (match_data->opentype_only
1506 && ((!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
1507 && !(font_type & TRUETYPE_FONTTYPE))
1508 || !is_unicode))
1509 return 1;
1510
1511 /* Ensure a match. */
1512 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1513 || !font_matches_spec (font_type, physical_font,
1514 match_data->orig_font_spec, backend,
1515 &logical_font->elfLogFont)
1516 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1517 match_data->pattern.lfCharSet))
1518 return 1;
1519
1520 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1521 We limit this to raster fonts, because the test can catch some
1522 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1523 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1524 therefore get through this test. Since full names can be prefixed
1525 by a foundry, we accept raster fonts if the font name is found
1526 anywhere within the full name. */
1527 if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
1528 && !strstr (logical_font->elfFullName,
1529 logical_font->elfLogFont.lfFaceName))
1530 /* Check for well known substitutions that mess things up in the
1531 presence of Type-1 fonts of the same name. */
1532 || (!check_face_name (&logical_font->elfLogFont,
1533 logical_font->elfFullName)))
1534 return 1;
1535
1536 /* Make a font entity for the font. */
1537 entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1538 physical_font, font_type,
1539 &match_data->pattern,
1540 backend);
1541
1542 if (!NILP (entity))
1543 {
1544 Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1545 FONT_REGISTRY_INDEX);
1546
1547 /* iso10646-1 fonts must contain Unicode mapping tables. */
1548 if (EQ (spec_charset, Qiso10646_1))
1549 {
1550 if (!is_unicode)
1551 return 1;
1552 }
1553 /* unicode-bmp fonts must contain characters from the BMP. */
1554 else if (EQ (spec_charset, Qunicode_bmp))
1555 {
1556 if (!physical_font->ntmFontSig.fsUsb[3]
1557 && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1558 && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1559 && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1560 return 1;
1561 }
1562 /* unicode-sip fonts must contain characters in Unicode plane 2.
1563 so look for bit 57 (surrogates) in the Unicode subranges, plus
1564 the bits for CJK ranges that include those characters. */
1565 else if (EQ (spec_charset, Qunicode_sip))
1566 {
1567 if (!(physical_font->ntmFontSig.fsUsb[1] & 0x02000000)
1568 || !(physical_font->ntmFontSig.fsUsb[1] & 0x28000000))
1569 return 1;
1570 }
1571
1572 /* This font matches. */
1573
1574 /* If registry was specified, ensure it is reported as the same. */
1575 if (!NILP (spec_charset))
1576 {
1577 /* Avoid using non-Japanese fonts for Japanese, even if they
1578 claim they are capable, due to known breakage in Vista
1579 and Windows 7 fonts (bug#6029). */
1580 if (logical_font->elfLogFont.lfCharSet == SHIFTJIS_CHARSET
1581 && !(physical_font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1582 return 1;
1583 else
1584 ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1585 }
1586 /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1587 fonts as Unicode and skip other charsets. */
1588 else if (match_data->opentype_only)
1589 {
1590 if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1591 || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1592 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1593 else
1594 return 1;
1595 }
1596
1597 /* Add this font to the list. */
1598 match_data->list = Fcons (entity, match_data->list);
1599 }
1600 return 1;
1601 }
1602
1603 /* Callback function for EnumFontFamiliesEx.
1604 * Terminates the search once we have a match. */
1605 static int CALLBACK
1606 add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1607 NEWTEXTMETRICEX *physical_font,
1608 DWORD font_type, LPARAM lParam)
1609 {
1610 struct font_callback_data *match_data
1611 = (struct font_callback_data *) lParam;
1612 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1613
1614 /* If we have a font in the list, terminate the search. */
1615 return NILP (match_data->list);
1616 }
1617
1618 /* Old function to convert from x to w32 charset, from w32fns.c. */
1619 static LONG
1620 x_to_w32_charset (char * lpcs)
1621 {
1622 Lisp_Object this_entry, w32_charset;
1623 char *charset;
1624 int len = strlen (lpcs);
1625
1626 /* Support "*-#nnn" format for unknown charsets. */
1627 if (strncmp (lpcs, "*-#", 3) == 0)
1628 return atoi (lpcs + 3);
1629
1630 /* All Windows fonts qualify as Unicode. */
1631 if (!strncmp (lpcs, "iso10646", 8))
1632 return DEFAULT_CHARSET;
1633
1634 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1635 charset = alloca (len + 1);
1636 strcpy (charset, lpcs);
1637 lpcs = strchr (charset, '*');
1638 if (lpcs)
1639 *lpcs = '\0';
1640
1641 /* Look through w32-charset-info-alist for the character set.
1642 Format of each entry is
1643 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1644 */
1645 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
1646
1647 if (NILP (this_entry))
1648 {
1649 /* At startup, we want iso8859-1 fonts to come up properly. */
1650 if (xstrcasecmp (charset, "iso8859-1") == 0)
1651 return ANSI_CHARSET;
1652 else
1653 return DEFAULT_CHARSET;
1654 }
1655
1656 w32_charset = Fcar (Fcdr (this_entry));
1657
1658 /* Translate Lisp symbol to number. */
1659 if (EQ (w32_charset, Qw32_charset_ansi))
1660 return ANSI_CHARSET;
1661 if (EQ (w32_charset, Qw32_charset_symbol))
1662 return SYMBOL_CHARSET;
1663 if (EQ (w32_charset, Qw32_charset_shiftjis))
1664 return SHIFTJIS_CHARSET;
1665 if (EQ (w32_charset, Qw32_charset_hangeul))
1666 return HANGEUL_CHARSET;
1667 if (EQ (w32_charset, Qw32_charset_chinesebig5))
1668 return CHINESEBIG5_CHARSET;
1669 if (EQ (w32_charset, Qw32_charset_gb2312))
1670 return GB2312_CHARSET;
1671 if (EQ (w32_charset, Qw32_charset_oem))
1672 return OEM_CHARSET;
1673 if (EQ (w32_charset, Qw32_charset_johab))
1674 return JOHAB_CHARSET;
1675 if (EQ (w32_charset, Qw32_charset_easteurope))
1676 return EASTEUROPE_CHARSET;
1677 if (EQ (w32_charset, Qw32_charset_turkish))
1678 return TURKISH_CHARSET;
1679 if (EQ (w32_charset, Qw32_charset_baltic))
1680 return BALTIC_CHARSET;
1681 if (EQ (w32_charset, Qw32_charset_russian))
1682 return RUSSIAN_CHARSET;
1683 if (EQ (w32_charset, Qw32_charset_arabic))
1684 return ARABIC_CHARSET;
1685 if (EQ (w32_charset, Qw32_charset_greek))
1686 return GREEK_CHARSET;
1687 if (EQ (w32_charset, Qw32_charset_hebrew))
1688 return HEBREW_CHARSET;
1689 if (EQ (w32_charset, Qw32_charset_vietnamese))
1690 return VIETNAMESE_CHARSET;
1691 if (EQ (w32_charset, Qw32_charset_thai))
1692 return THAI_CHARSET;
1693 if (EQ (w32_charset, Qw32_charset_mac))
1694 return MAC_CHARSET;
1695
1696 return DEFAULT_CHARSET;
1697 }
1698
1699
1700 /* Convert a Lisp font registry (symbol) to a windows charset. */
1701 static LONG
1702 registry_to_w32_charset (Lisp_Object charset)
1703 {
1704 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1705 || EQ (charset, Qunicode_sip))
1706 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1707 else if (EQ (charset, Qiso8859_1))
1708 return ANSI_CHARSET;
1709 else if (SYMBOLP (charset))
1710 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
1711 else
1712 return DEFAULT_CHARSET;
1713 }
1714
1715 /* Old function to convert from w32 to x charset, from w32fns.c. */
1716 static char *
1717 w32_to_x_charset (int fncharset, char *matching)
1718 {
1719 static char buf[32];
1720 Lisp_Object charset_type;
1721 int match_len = 0;
1722
1723 if (matching)
1724 {
1725 /* If fully specified, accept it as it is. Otherwise use a
1726 substring match. */
1727 char *wildcard = strchr (matching, '*');
1728 if (wildcard)
1729 *wildcard = '\0';
1730 else if (strchr (matching, '-'))
1731 return matching;
1732
1733 match_len = strlen (matching);
1734 }
1735
1736 switch (fncharset)
1737 {
1738 case ANSI_CHARSET:
1739 /* Handle startup case of w32-charset-info-alist not
1740 being set up yet. */
1741 if (NILP (Vw32_charset_info_alist))
1742 return "iso8859-1";
1743 charset_type = Qw32_charset_ansi;
1744 break;
1745 case DEFAULT_CHARSET:
1746 charset_type = Qw32_charset_default;
1747 break;
1748 case SYMBOL_CHARSET:
1749 charset_type = Qw32_charset_symbol;
1750 break;
1751 case SHIFTJIS_CHARSET:
1752 charset_type = Qw32_charset_shiftjis;
1753 break;
1754 case HANGEUL_CHARSET:
1755 charset_type = Qw32_charset_hangeul;
1756 break;
1757 case GB2312_CHARSET:
1758 charset_type = Qw32_charset_gb2312;
1759 break;
1760 case CHINESEBIG5_CHARSET:
1761 charset_type = Qw32_charset_chinesebig5;
1762 break;
1763 case OEM_CHARSET:
1764 charset_type = Qw32_charset_oem;
1765 break;
1766 case EASTEUROPE_CHARSET:
1767 charset_type = Qw32_charset_easteurope;
1768 break;
1769 case TURKISH_CHARSET:
1770 charset_type = Qw32_charset_turkish;
1771 break;
1772 case BALTIC_CHARSET:
1773 charset_type = Qw32_charset_baltic;
1774 break;
1775 case RUSSIAN_CHARSET:
1776 charset_type = Qw32_charset_russian;
1777 break;
1778 case ARABIC_CHARSET:
1779 charset_type = Qw32_charset_arabic;
1780 break;
1781 case GREEK_CHARSET:
1782 charset_type = Qw32_charset_greek;
1783 break;
1784 case HEBREW_CHARSET:
1785 charset_type = Qw32_charset_hebrew;
1786 break;
1787 case VIETNAMESE_CHARSET:
1788 charset_type = Qw32_charset_vietnamese;
1789 break;
1790 case THAI_CHARSET:
1791 charset_type = Qw32_charset_thai;
1792 break;
1793 case MAC_CHARSET:
1794 charset_type = Qw32_charset_mac;
1795 break;
1796 case JOHAB_CHARSET:
1797 charset_type = Qw32_charset_johab;
1798 break;
1799
1800 default:
1801 /* Encode numerical value of unknown charset. */
1802 sprintf (buf, "*-#%u", fncharset);
1803 return buf;
1804 }
1805
1806 {
1807 Lisp_Object rest;
1808 char * best_match = NULL;
1809 int matching_found = 0;
1810
1811 /* Look through w32-charset-info-alist for the character set.
1812 Prefer ISO codepages, and prefer lower numbers in the ISO
1813 range. Only return charsets for codepages which are installed.
1814
1815 Format of each entry is
1816 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1817 */
1818 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1819 {
1820 char * x_charset;
1821 Lisp_Object w32_charset;
1822 Lisp_Object codepage;
1823
1824 Lisp_Object this_entry = XCAR (rest);
1825
1826 /* Skip invalid entries in alist. */
1827 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1828 || !CONSP (XCDR (this_entry))
1829 || !SYMBOLP (XCAR (XCDR (this_entry))))
1830 continue;
1831
1832 x_charset = SDATA (XCAR (this_entry));
1833 w32_charset = XCAR (XCDR (this_entry));
1834 codepage = XCDR (XCDR (this_entry));
1835
1836 /* Look for Same charset and a valid codepage (or non-int
1837 which means ignore). */
1838 if (EQ (w32_charset, charset_type)
1839 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
1840 || IsValidCodePage (XINT (codepage))))
1841 {
1842 /* If we don't have a match already, then this is the
1843 best. */
1844 if (!best_match)
1845 {
1846 best_match = x_charset;
1847 if (matching && !strnicmp (x_charset, matching, match_len))
1848 matching_found = 1;
1849 }
1850 /* If we already found a match for MATCHING, then
1851 only consider other matches. */
1852 else if (matching_found
1853 && strnicmp (x_charset, matching, match_len))
1854 continue;
1855 /* If this matches what we want, and the best so far doesn't,
1856 then this is better. */
1857 else if (!matching_found && matching
1858 && !strnicmp (x_charset, matching, match_len))
1859 {
1860 best_match = x_charset;
1861 matching_found = 1;
1862 }
1863 /* If this is fully specified, and the best so far isn't,
1864 then this is better. */
1865 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1866 /* If this is an ISO codepage, and the best so far isn't,
1867 then this is better, but only if it fully specifies the
1868 encoding. */
1869 || (strnicmp (best_match, "iso", 3) != 0
1870 && strnicmp (x_charset, "iso", 3) == 0
1871 && strchr (x_charset, '-')))
1872 best_match = x_charset;
1873 /* If both are ISO8859 codepages, choose the one with the
1874 lowest number in the encoding field. */
1875 else if (strnicmp (best_match, "iso8859-", 8) == 0
1876 && strnicmp (x_charset, "iso8859-", 8) == 0)
1877 {
1878 int best_enc = atoi (best_match + 8);
1879 int this_enc = atoi (x_charset + 8);
1880 if (this_enc > 0 && this_enc < best_enc)
1881 best_match = x_charset;
1882 }
1883 }
1884 }
1885
1886 /* If no match, encode the numeric value. */
1887 if (!best_match)
1888 {
1889 sprintf (buf, "*-#%u", fncharset);
1890 return buf;
1891 }
1892
1893 strncpy (buf, best_match, 31);
1894 /* If the charset is not fully specified, put -0 on the end. */
1895 if (!strchr (best_match, '-'))
1896 {
1897 int pos = strlen (best_match);
1898 /* Charset specifiers shouldn't be very long. If it is a made
1899 up one, truncating it should not do any harm since it isn't
1900 recognized anyway. */
1901 if (pos > 29)
1902 pos = 29;
1903 strcpy (buf + pos, "-0");
1904 }
1905 buf[31] = '\0';
1906 return buf;
1907 }
1908 }
1909
1910 static Lisp_Object
1911 w32_registry (LONG w32_charset, DWORD font_type)
1912 {
1913 char *charset;
1914
1915 /* If charset is defaulted, charset is Unicode or unknown, depending on
1916 font type. */
1917 if (w32_charset == DEFAULT_CHARSET)
1918 return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
1919
1920 charset = w32_to_x_charset (w32_charset, NULL);
1921 return font_intern_prop (charset, strlen (charset), 1);
1922 }
1923
1924 static int
1925 w32_decode_weight (int fnweight)
1926 {
1927 if (fnweight >= FW_HEAVY) return 210;
1928 if (fnweight >= FW_EXTRABOLD) return 205;
1929 if (fnweight >= FW_BOLD) return 200;
1930 if (fnweight >= FW_SEMIBOLD) return 180;
1931 if (fnweight >= FW_NORMAL) return 100;
1932 if (fnweight >= FW_LIGHT) return 50;
1933 if (fnweight >= FW_EXTRALIGHT) return 40;
1934 if (fnweight > FW_THIN) return 20;
1935 return 0;
1936 }
1937
1938 static int
1939 w32_encode_weight (int n)
1940 {
1941 if (n >= 210) return FW_HEAVY;
1942 if (n >= 205) return FW_EXTRABOLD;
1943 if (n >= 200) return FW_BOLD;
1944 if (n >= 180) return FW_SEMIBOLD;
1945 if (n >= 100) return FW_NORMAL;
1946 if (n >= 50) return FW_LIGHT;
1947 if (n >= 40) return FW_EXTRALIGHT;
1948 if (n >= 20) return FW_THIN;
1949 return 0;
1950 }
1951
1952 /* Convert a Windows font weight into one of the weights supported
1953 by fontconfig (see font.c:font_parse_fcname). */
1954 static Lisp_Object
1955 w32_to_fc_weight (int n)
1956 {
1957 if (n >= FW_EXTRABOLD) return intern ("black");
1958 if (n >= FW_BOLD) return intern ("bold");
1959 if (n >= FW_SEMIBOLD) return intern ("demibold");
1960 if (n >= FW_NORMAL) return intern ("medium");
1961 return intern ("light");
1962 }
1963
1964 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1965 static void
1966 fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec)
1967 {
1968 Lisp_Object tmp, extra;
1969 int dpi = FRAME_RES_Y (f);
1970
1971 tmp = AREF (font_spec, FONT_DPI_INDEX);
1972 if (INTEGERP (tmp))
1973 {
1974 dpi = XINT (tmp);
1975 }
1976 else if (FLOATP (tmp))
1977 {
1978 dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
1979 }
1980
1981 /* Height */
1982 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1983 if (INTEGERP (tmp))
1984 logfont->lfHeight = -1 * XINT (tmp);
1985 else if (FLOATP (tmp))
1986 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
1987
1988 /* Escapement */
1989
1990 /* Orientation */
1991
1992 /* Weight */
1993 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1994 if (INTEGERP (tmp))
1995 logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
1996
1997 /* Italic */
1998 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1999 if (INTEGERP (tmp))
2000 {
2001 int slant = FONT_SLANT_NUMERIC (font_spec);
2002 logfont->lfItalic = slant > 150 ? 1 : 0;
2003 }
2004
2005 /* Underline */
2006
2007 /* Strikeout */
2008
2009 /* Charset */
2010 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
2011 if (! NILP (tmp))
2012 logfont->lfCharSet = registry_to_w32_charset (tmp);
2013 else
2014 logfont->lfCharSet = DEFAULT_CHARSET;
2015
2016 /* Out Precision */
2017
2018 /* Clip Precision */
2019
2020 /* Quality */
2021 logfont->lfQuality = DEFAULT_QUALITY;
2022
2023 /* Generic Family and Face Name */
2024 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
2025
2026 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
2027 if (! NILP (tmp))
2028 {
2029 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
2030 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
2031 ; /* Font name was generic, don't fill in font name. */
2032 /* Font families are interned, but allow for strings also in case of
2033 user input. */
2034 else if (SYMBOLP (tmp))
2035 {
2036 strncpy (logfont->lfFaceName,
2037 SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
2038 logfont->lfFaceName[LF_FACESIZE-1] = '\0';
2039 }
2040 }
2041
2042 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
2043 if (!NILP (tmp))
2044 {
2045 /* Override generic family. */
2046 BYTE family = w32_generic_family (tmp);
2047 if (family != FF_DONTCARE)
2048 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
2049 }
2050
2051 /* Set pitch based on the spacing property. */
2052 tmp = AREF (font_spec, FONT_SPACING_INDEX);
2053 if (INTEGERP (tmp))
2054 {
2055 int spacing = XINT (tmp);
2056 if (spacing < FONT_SPACING_MONO)
2057 logfont->lfPitchAndFamily
2058 = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
2059 else
2060 logfont->lfPitchAndFamily
2061 = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
2062 }
2063
2064 /* Process EXTRA info. */
2065 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
2066 CONSP (extra); extra = XCDR (extra))
2067 {
2068 tmp = XCAR (extra);
2069 if (CONSP (tmp))
2070 {
2071 Lisp_Object key, val;
2072 key = XCAR (tmp), val = XCDR (tmp);
2073 /* Only use QCscript if charset is not provided, or is Unicode
2074 and a single script is specified. This is rather crude,
2075 and is only used to narrow down the fonts returned where
2076 there is a definite match. Some scripts, such as latin, han,
2077 cjk-misc match multiple lfCharSet values, so we can't pre-filter
2078 them. */
2079 if (EQ (key, QCscript)
2080 && logfont->lfCharSet == DEFAULT_CHARSET
2081 && SYMBOLP (val))
2082 {
2083 if (EQ (val, Qgreek))
2084 logfont->lfCharSet = GREEK_CHARSET;
2085 else if (EQ (val, Qhangul))
2086 logfont->lfCharSet = HANGUL_CHARSET;
2087 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
2088 logfont->lfCharSet = SHIFTJIS_CHARSET;
2089 else if (EQ (val, Qbopomofo))
2090 logfont->lfCharSet = CHINESEBIG5_CHARSET;
2091 /* GB 18030 supports tibetan, yi, mongolian,
2092 fonts that support it should show up if we ask for
2093 GB2312 fonts. */
2094 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
2095 || EQ (val, Qmongolian))
2096 logfont->lfCharSet = GB2312_CHARSET;
2097 else if (EQ (val, Qhebrew))
2098 logfont->lfCharSet = HEBREW_CHARSET;
2099 else if (EQ (val, Qarabic))
2100 logfont->lfCharSet = ARABIC_CHARSET;
2101 else if (EQ (val, Qthai))
2102 logfont->lfCharSet = THAI_CHARSET;
2103 }
2104 else if (EQ (key, QCantialias) && SYMBOLP (val))
2105 {
2106 logfont->lfQuality = w32_antialias_type (val);
2107 }
2108 }
2109 }
2110 }
2111
2112 static void
2113 list_all_matching_fonts (struct font_callback_data *match_data)
2114 {
2115 HDC dc;
2116 Lisp_Object families = w32font_list_family (XFRAME (match_data->frame));
2117 struct frame *f = XFRAME (match_data->frame);
2118
2119 dc = get_frame_dc (f);
2120
2121 while (!NILP (families))
2122 {
2123 /* Only fonts from the current locale are given localized names
2124 on Windows, so we can keep backwards compatibility with
2125 Windows 9x/ME by using non-Unicode font enumeration without
2126 sacrificing internationalization here. */
2127 char *name;
2128 Lisp_Object family = CAR (families);
2129 families = CDR (families);
2130 if (NILP (family))
2131 continue;
2132 else if (SYMBOLP (family))
2133 name = SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
2134 else
2135 continue;
2136
2137 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2138 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2139
2140 EnumFontFamiliesEx (dc, &match_data->pattern,
2141 (FONTENUMPROC) add_font_entity_to_list,
2142 (LPARAM) match_data, 0);
2143 }
2144
2145 release_frame_dc (f, dc);
2146 }
2147
2148 static Lisp_Object
2149 lispy_antialias_type (BYTE type)
2150 {
2151 Lisp_Object lispy;
2152
2153 switch (type)
2154 {
2155 case NONANTIALIASED_QUALITY:
2156 lispy = Qnone;
2157 break;
2158 case ANTIALIASED_QUALITY:
2159 lispy = Qstandard;
2160 break;
2161 case CLEARTYPE_QUALITY:
2162 lispy = Qsubpixel;
2163 break;
2164 case CLEARTYPE_NATURAL_QUALITY:
2165 lispy = Qnatural;
2166 break;
2167 default:
2168 lispy = Qnil;
2169 break;
2170 }
2171 return lispy;
2172 }
2173
2174 /* Convert antialiasing symbols to lfQuality */
2175 static BYTE
2176 w32_antialias_type (Lisp_Object type)
2177 {
2178 if (EQ (type, Qnone))
2179 return NONANTIALIASED_QUALITY;
2180 else if (EQ (type, Qstandard))
2181 return ANTIALIASED_QUALITY;
2182 else if (EQ (type, Qsubpixel))
2183 return CLEARTYPE_QUALITY;
2184 else if (EQ (type, Qnatural))
2185 return CLEARTYPE_NATURAL_QUALITY;
2186 else
2187 return DEFAULT_QUALITY;
2188 }
2189
2190 /* Return a list of all the scripts that the font supports. */
2191 static Lisp_Object
2192 font_supported_scripts (FONTSIGNATURE * sig)
2193 {
2194 DWORD * subranges = sig->fsUsb;
2195 Lisp_Object supported = Qnil;
2196
2197 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2198 #define SUBRANGE(n,sym) \
2199 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2200 supported = Fcons ((sym), supported)
2201
2202 /* Match multiple subranges. SYM is set if any MASK bit is set in
2203 subranges[0 - 3]. */
2204 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2205 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2206 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2207 supported = Fcons ((sym), supported)
2208
2209 SUBRANGE (0, Qlatin);
2210 /* The following count as latin too, ASCII should be present in these fonts,
2211 so don't need to mark them separately. */
2212 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2213 SUBRANGE (4, Qphonetic);
2214 /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */
2215 SUBRANGE (7, Qgreek);
2216 SUBRANGE (8, Qcoptic);
2217 SUBRANGE (9, Qcyrillic);
2218 SUBRANGE (10, Qarmenian);
2219 SUBRANGE (11, Qhebrew);
2220 /* 12: Vai. */
2221 SUBRANGE (13, Qarabic);
2222 SUBRANGE (14, Qnko);
2223 SUBRANGE (15, Qdevanagari);
2224 SUBRANGE (16, Qbengali);
2225 SUBRANGE (17, Qgurmukhi);
2226 SUBRANGE (18, Qgujarati);
2227 SUBRANGE (19, Qoriya);
2228 SUBRANGE (20, Qtamil);
2229 SUBRANGE (21, Qtelugu);
2230 SUBRANGE (22, Qkannada);
2231 SUBRANGE (23, Qmalayalam);
2232 SUBRANGE (24, Qthai);
2233 SUBRANGE (25, Qlao);
2234 SUBRANGE (26, Qgeorgian);
2235 SUBRANGE (27, Qbalinese);
2236 /* 28: Hangul Jamo. */
2237 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2238 /* 32-47: Symbols (defined below). */
2239 SUBRANGE (48, Qcjk_misc);
2240 /* Match either 49: katakana or 50: hiragana for kana. */
2241 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
2242 SUBRANGE (51, Qbopomofo);
2243 /* 52: Compatibility Jamo */
2244 SUBRANGE (53, Qphags_pa);
2245 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2246 SUBRANGE (56, Qhangul);
2247 /* 57: Surrogates. */
2248 SUBRANGE (58, Qphoenician);
2249 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
2250 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2251 SUBRANGE (59, Qkanbun); /* And this. */
2252 /* 60: Private use, 61: CJK strokes and compatibility. */
2253 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2254 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2255 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2256 /* 69: Specials. */
2257 SUBRANGE (70, Qtibetan);
2258 SUBRANGE (71, Qsyriac);
2259 SUBRANGE (72, Qthaana);
2260 SUBRANGE (73, Qsinhala);
2261 SUBRANGE (74, Qmyanmar);
2262 SUBRANGE (75, Qethiopic);
2263 SUBRANGE (76, Qcherokee);
2264 SUBRANGE (77, Qcanadian_aboriginal);
2265 SUBRANGE (78, Qogham);
2266 SUBRANGE (79, Qrunic);
2267 SUBRANGE (80, Qkhmer);
2268 SUBRANGE (81, Qmongolian);
2269 SUBRANGE (82, Qbraille);
2270 SUBRANGE (83, Qyi);
2271 SUBRANGE (84, Qbuhid);
2272 SUBRANGE (84, Qhanunoo);
2273 SUBRANGE (84, Qtagalog);
2274 SUBRANGE (84, Qtagbanwa);
2275 SUBRANGE (85, Qold_italic);
2276 SUBRANGE (86, Qgothic);
2277 SUBRANGE (87, Qdeseret);
2278 SUBRANGE (88, Qbyzantine_musical_symbol);
2279 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
2280 SUBRANGE (89, Qmathematical);
2281 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2282 SUBRANGE (93, Qlimbu);
2283 SUBRANGE (94, Qtai_le);
2284 /* 95: New Tai Le */
2285 SUBRANGE (90, Qbuginese);
2286 SUBRANGE (97, Qglagolitic);
2287 SUBRANGE (98, Qtifinagh);
2288 /* 99: Yijing Hexagrams. */
2289 SUBRANGE (100, Qsyloti_nagri);
2290 SUBRANGE (101, Qlinear_b);
2291 /* 102: Ancient Greek Numbers. */
2292 SUBRANGE (103, Qugaritic);
2293 SUBRANGE (104, Qold_persian);
2294 SUBRANGE (105, Qshavian);
2295 SUBRANGE (106, Qosmanya);
2296 SUBRANGE (107, Qcypriot);
2297 SUBRANGE (108, Qkharoshthi);
2298 /* 109: Tai Xuan Jing. */
2299 SUBRANGE (110, Qcuneiform);
2300 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2301 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2302 SUBRANGE (118, Qcham);
2303 /* 119: Ancient symbols, 120: Phaistos Disc. */
2304 /* 121: Carian, Lycian, Lydian, 122: Dominoes, Mahjong tiles. */
2305 /* 123-127: Reserved. */
2306
2307 /* There isn't really a main symbol range, so include symbol if any
2308 relevant range is set. */
2309 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2310
2311 /* Missing: Tai Viet (U+AA80-U+AADF). */
2312 #undef SUBRANGE
2313 #undef MASK_ANY
2314
2315 return supported;
2316 }
2317
2318 /* Generate a full name for a Windows font.
2319 The full name is in fcname format, with weight, slant and antialiasing
2320 specified if they are not "normal". */
2321 static int
2322 w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
2323 int pixel_size, char *name, int nbytes)
2324 {
2325 int len, height, outline;
2326 char *p;
2327 Lisp_Object antialiasing, weight = Qnil;
2328
2329 len = strlen (font->lfFaceName);
2330
2331 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2332
2333 /* Represent size of scalable fonts by point size. But use pixelsize for
2334 raster fonts to indicate that they are exactly that size. */
2335 if (outline)
2336 len += 11; /* -SIZE */
2337 else
2338 len += 21;
2339
2340 if (font->lfItalic)
2341 len += 7; /* :italic */
2342
2343 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2344 {
2345 weight = w32_to_fc_weight (font->lfWeight);
2346 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
2347 }
2348
2349 antialiasing = lispy_antialias_type (font->lfQuality);
2350 if (! NILP (antialiasing))
2351 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2352
2353 /* Check that the buffer is big enough */
2354 if (len > nbytes)
2355 return -1;
2356
2357 p = name;
2358 p += sprintf (p, "%s", font->lfFaceName);
2359
2360 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2361
2362 if (height > 0)
2363 {
2364 if (outline)
2365 {
2366 float pointsize = height * 72.0 / one_w32_display_info.resy;
2367 /* Round to nearest half point. floor is used, since round is not
2368 supported in MS library. */
2369 pointsize = floor (pointsize * 2 + 0.5) / 2;
2370 p += sprintf (p, "-%1.1f", pointsize);
2371 }
2372 else
2373 p += sprintf (p, ":pixelsize=%d", height);
2374 }
2375
2376 if (SYMBOLP (weight) && ! NILP (weight))
2377 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2378
2379 if (font->lfItalic)
2380 p += sprintf (p, ":italic");
2381
2382 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2383 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2384
2385 return (p - name);
2386 }
2387
2388 /* Convert a logfont and point size into a fontconfig style font name.
2389 POINTSIZE is in tenths of points.
2390 If SIZE indicates the size of buffer FCNAME, into which the font name
2391 is written. If the buffer is not large enough to contain the name,
2392 the function returns -1, otherwise it returns the number of bytes
2393 written to FCNAME. */
2394 static int
2395 logfont_to_fcname (LOGFONT* font, int pointsize, char *fcname, int size)
2396 {
2397 int len, height;
2398 char *p = fcname;
2399 Lisp_Object weight = Qnil;
2400
2401 len = strlen (font->lfFaceName) + 2;
2402 height = pointsize / 10;
2403 while (height /= 10)
2404 len++;
2405
2406 if (pointsize % 10)
2407 len += 2;
2408
2409 if (font->lfItalic)
2410 len += 7; /* :italic */
2411 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2412 {
2413 weight = w32_to_fc_weight (font->lfWeight);
2414 len += SBYTES (SYMBOL_NAME (weight)) + 1;
2415 }
2416
2417 if (len > size)
2418 return -1;
2419
2420 p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2421 if (pointsize % 10)
2422 p += sprintf (p, ".%d", pointsize % 10);
2423
2424 if (SYMBOLP (weight) && !NILP (weight))
2425 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2426
2427 if (font->lfItalic)
2428 p += sprintf (p, ":italic");
2429
2430 return (p - fcname);
2431 }
2432
2433 static void
2434 compute_metrics (HDC dc, struct w32font_info *w32_font, unsigned int code,
2435 struct w32_metric_cache *metrics)
2436 {
2437 GLYPHMETRICS gm;
2438 MAT2 transform;
2439 unsigned int options = GGO_METRICS;
2440 INT width;
2441
2442 if (w32_font->glyph_idx)
2443 options |= GGO_GLYPH_INDEX;
2444
2445 memset (&transform, 0, sizeof (transform));
2446 transform.eM11.value = 1;
2447 transform.eM22.value = 1;
2448
2449 if (get_glyph_outline_w (dc, code, options, &gm, 0, NULL, &transform)
2450 != GDI_ERROR)
2451 {
2452 metrics->lbearing = gm.gmptGlyphOrigin.x;
2453 metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2454 metrics->width = gm.gmCellIncX;
2455 metrics->status = W32METRIC_SUCCESS;
2456 }
2457 else if (get_char_width_32_w (dc, code, code, &width) != 0)
2458 {
2459 metrics->lbearing = 0;
2460 metrics->rbearing = width;
2461 metrics->width = width;
2462 metrics->status = W32METRIC_SUCCESS;
2463 }
2464 else
2465 metrics->status = W32METRIC_FAIL;
2466 }
2467
2468 DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2469 doc: /* Read a font name using a W32 font selection dialog.
2470 Return fontconfig style font string corresponding to the selection.
2471
2472 If FRAME is omitted or nil, it defaults to the selected frame.
2473 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2474 in the font selection dialog. */)
2475 (Lisp_Object frame, Lisp_Object exclude_proportional)
2476 {
2477 struct frame *f = decode_window_system_frame (frame);
2478 CHOOSEFONT cf;
2479 LOGFONT lf;
2480 TEXTMETRIC tm;
2481 HDC hdc;
2482 HANDLE oldobj;
2483 char buf[100];
2484
2485 memset (&cf, 0, sizeof (cf));
2486 memset (&lf, 0, sizeof (lf));
2487
2488 cf.lStructSize = sizeof (cf);
2489 cf.hwndOwner = FRAME_W32_WINDOW (f);
2490 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2491
2492 /* If exclude_proportional is non-nil, limit the selection to
2493 monospaced fonts. */
2494 if (!NILP (exclude_proportional))
2495 cf.Flags |= CF_FIXEDPITCHONLY;
2496
2497 cf.lpLogFont = &lf;
2498
2499 /* Initialize as much of the font details as we can from the current
2500 default font. */
2501 hdc = GetDC (FRAME_W32_WINDOW (f));
2502 oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
2503 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2504 if (GetTextMetrics (hdc, &tm))
2505 {
2506 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2507 lf.lfWeight = tm.tmWeight;
2508 lf.lfItalic = tm.tmItalic;
2509 lf.lfUnderline = tm.tmUnderlined;
2510 lf.lfStrikeOut = tm.tmStruckOut;
2511 lf.lfCharSet = tm.tmCharSet;
2512 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2513 }
2514 SelectObject (hdc, oldobj);
2515 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2516
2517 if (!ChooseFont (&cf)
2518 || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
2519 return Qnil;
2520
2521 return DECODE_SYSTEM (build_string (buf));
2522 }
2523
2524 static const char *const w32font_booleans [] = {
2525 NULL,
2526 };
2527
2528 static const char *const w32font_non_booleans [] = {
2529 ":script",
2530 ":antialias",
2531 ":style",
2532 NULL,
2533 };
2534
2535 static void
2536 w32font_filter_properties (Lisp_Object font, Lisp_Object alist)
2537 {
2538 font_filter_properties (font, alist, w32font_booleans, w32font_non_booleans);
2539 }
2540
2541 struct font_driver w32font_driver =
2542 {
2543 LISP_INITIALLY_ZERO, /* Qgdi */
2544 0, /* case insensitive */
2545 w32font_get_cache,
2546 w32font_list,
2547 w32font_match,
2548 w32font_list_family,
2549 NULL, /* free_entity */
2550 w32font_open,
2551 w32font_close,
2552 NULL, /* prepare_face */
2553 NULL, /* done_face */
2554 w32font_has_char,
2555 w32font_encode_char,
2556 w32font_text_extents,
2557 w32font_draw,
2558 NULL, /* get_bitmap */
2559 NULL, /* free_bitmap */
2560 NULL, /* get_outline */
2561 NULL, /* free_outline */
2562 NULL, /* anchor_point */
2563 NULL, /* otf_capability */
2564 NULL, /* otf_drive */
2565 NULL, /* start_for_frame */
2566 NULL, /* end_for_frame */
2567 NULL, /* shape */
2568 NULL, /* check */
2569 NULL, /* get_variation_glyphs */
2570 w32font_filter_properties,
2571 NULL, /* cached_font_ok */
2572 };
2573
2574
2575 /* Initialize state that does not change between invocations. This is only
2576 called when Emacs is dumped. */
2577 void
2578 syms_of_w32font (void)
2579 {
2580 DEFSYM (Qgdi, "gdi");
2581 DEFSYM (Quniscribe, "uniscribe");
2582 DEFSYM (QCformat, ":format");
2583
2584 /* Generic font families. */
2585 DEFSYM (Qmonospace, "monospace");
2586 DEFSYM (Qserif, "serif");
2587 DEFSYM (Qsansserif, "sansserif");
2588 DEFSYM (Qscript, "script");
2589 DEFSYM (Qdecorative, "decorative");
2590 /* Aliases. */
2591 DEFSYM (Qsans_serif, "sans_serif");
2592 DEFSYM (Qsans, "sans");
2593 DEFSYM (Qmono, "mono");
2594
2595 /* Fake foundries. */
2596 DEFSYM (Qraster, "raster");
2597 DEFSYM (Qoutline, "outline");
2598 DEFSYM (Qunknown, "unknown");
2599
2600 /* Antialiasing. */
2601 DEFSYM (Qstandard, "standard");
2602 DEFSYM (Qsubpixel, "subpixel");
2603 DEFSYM (Qnatural, "natural");
2604
2605 /* Languages */
2606 DEFSYM (Qzh, "zh");
2607
2608 /* Scripts */
2609 DEFSYM (Qlatin, "latin");
2610 DEFSYM (Qgreek, "greek");
2611 DEFSYM (Qcoptic, "coptic");
2612 DEFSYM (Qcyrillic, "cyrillic");
2613 DEFSYM (Qarmenian, "armenian");
2614 DEFSYM (Qhebrew, "hebrew");
2615 DEFSYM (Qarabic, "arabic");
2616 DEFSYM (Qsyriac, "syriac");
2617 DEFSYM (Qnko, "nko");
2618 DEFSYM (Qthaana, "thaana");
2619 DEFSYM (Qdevanagari, "devanagari");
2620 DEFSYM (Qbengali, "bengali");
2621 DEFSYM (Qgurmukhi, "gurmukhi");
2622 DEFSYM (Qgujarati, "gujarati");
2623 DEFSYM (Qoriya, "oriya");
2624 DEFSYM (Qtamil, "tamil");
2625 DEFSYM (Qtelugu, "telugu");
2626 DEFSYM (Qkannada, "kannada");
2627 DEFSYM (Qmalayalam, "malayalam");
2628 DEFSYM (Qsinhala, "sinhala");
2629 DEFSYM (Qthai, "thai");
2630 DEFSYM (Qlao, "lao");
2631 DEFSYM (Qtibetan, "tibetan");
2632 DEFSYM (Qmyanmar, "myanmar");
2633 DEFSYM (Qgeorgian, "georgian");
2634 DEFSYM (Qhangul, "hangul");
2635 DEFSYM (Qethiopic, "ethiopic");
2636 DEFSYM (Qcherokee, "cherokee");
2637 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2638 DEFSYM (Qogham, "ogham");
2639 DEFSYM (Qrunic, "runic");
2640 DEFSYM (Qkhmer, "khmer");
2641 DEFSYM (Qmongolian, "mongolian");
2642 DEFSYM (Qbraille, "braille");
2643 DEFSYM (Qhan, "han");
2644 DEFSYM (Qideographic_description, "ideographic-description");
2645 DEFSYM (Qcjk_misc, "cjk-misc");
2646 DEFSYM (Qkana, "kana");
2647 DEFSYM (Qbopomofo, "bopomofo");
2648 DEFSYM (Qkanbun, "kanbun");
2649 DEFSYM (Qyi, "yi");
2650 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2651 DEFSYM (Qmusical_symbol, "musical-symbol");
2652 DEFSYM (Qmathematical, "mathematical");
2653 DEFSYM (Qcham, "cham");
2654 DEFSYM (Qphonetic, "phonetic");
2655 DEFSYM (Qbalinese, "balinese");
2656 DEFSYM (Qbuginese, "buginese");
2657 DEFSYM (Qbuhid, "buhid");
2658 DEFSYM (Qcuneiform, "cuneiform");
2659 DEFSYM (Qcypriot, "cypriot");
2660 DEFSYM (Qdeseret, "deseret");
2661 DEFSYM (Qglagolitic, "glagolitic");
2662 DEFSYM (Qgothic, "gothic");
2663 DEFSYM (Qhanunoo, "hanunoo");
2664 DEFSYM (Qkharoshthi, "kharoshthi");
2665 DEFSYM (Qlimbu, "limbu");
2666 DEFSYM (Qlinear_b, "linear_b");
2667 DEFSYM (Qold_italic, "old_italic");
2668 DEFSYM (Qold_persian, "old_persian");
2669 DEFSYM (Qosmanya, "osmanya");
2670 DEFSYM (Qphags_pa, "phags-pa");
2671 DEFSYM (Qphoenician, "phoenician");
2672 DEFSYM (Qshavian, "shavian");
2673 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2674 DEFSYM (Qtagalog, "tagalog");
2675 DEFSYM (Qtagbanwa, "tagbanwa");
2676 DEFSYM (Qtai_le, "tai_le");
2677 DEFSYM (Qtifinagh, "tifinagh");
2678 DEFSYM (Qugaritic, "ugaritic");
2679
2680 /* W32 font encodings. */
2681 DEFVAR_LISP ("w32-charset-info-alist",
2682 Vw32_charset_info_alist,
2683 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2684 Each entry should be of the form:
2685
2686 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2687
2688 where CHARSET_NAME is a string used in font names to identify the charset,
2689 WINDOWS_CHARSET is a symbol that can be one of:
2690
2691 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2692 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2693 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2694 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2695 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2696 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2697 or w32-charset-oem.
2698
2699 CODEPAGE should be an integer specifying the codepage that should be used
2700 to display the character set, t to do no translation and output as Unicode,
2701 or nil to do no translation and output as 8 bit (or multibyte on far-east
2702 versions of Windows) characters. */);
2703 Vw32_charset_info_alist = Qnil;
2704
2705 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2706 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2707 DEFSYM (Qw32_charset_default, "w32-charset-default");
2708 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2709 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2710 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2711 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2712 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2713 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2714 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2715 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2716 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2717 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2718 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2719 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2720 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2721 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2722 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2723 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2724
2725 defsubr (&Sx_select_font);
2726
2727 w32font_driver.type = Qgdi;
2728 register_font_driver (&w32font_driver, NULL);
2729 }
2730
2731 void
2732 globals_of_w32font (void)
2733 {
2734 #ifdef WINDOWSNT
2735 g_b_init_get_outline_metrics_w = 0;
2736 g_b_init_get_text_metrics_w = 0;
2737 g_b_init_get_glyph_outline_w = 0;
2738 g_b_init_get_char_width_32_w = 0;
2739 #endif
2740 }