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