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