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