]> code.delx.au - gnu-emacs/blob - src/w32font.c
2b6f61094544145480ba6c23df7e0afe2d023423
[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 "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 return Qnil;
801 }
802
803 match_data.opentype_only = opentype_only;
804 if (opentype_only)
805 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
806
807 if (match_data.pattern.lfFaceName[0] == '\0')
808 {
809 /* EnumFontFamiliesEx does not take other fields into account if
810 font name is blank, so need to use two passes. */
811 list_all_matching_fonts (&match_data);
812 }
813 else
814 {
815 dc = get_frame_dc (f);
816
817 EnumFontFamiliesEx (dc, &match_data.pattern,
818 (FONTENUMPROC) add_font_entity_to_list,
819 (LPARAM) &match_data, 0);
820 release_frame_dc (f, dc);
821 }
822
823 return match_data.list;
824 }
825
826 /* Internal implementation of w32font_match.
827 Additional parameter opentype_only restricts the returned fonts to
828 opentype fonts, which can be used with the Uniscribe backend. */
829 Lisp_Object
830 w32font_match_internal (struct frame *f, Lisp_Object font_spec,
831 bool opentype_only)
832 {
833 struct font_callback_data match_data;
834 HDC dc;
835
836 match_data.orig_font_spec = font_spec;
837 XSETFRAME (match_data.frame, f);
838 match_data.list = Qnil;
839
840 memset (&match_data.pattern, 0, sizeof (LOGFONT));
841 fill_in_logfont (f, &match_data.pattern, font_spec);
842
843 match_data.opentype_only = opentype_only;
844 if (opentype_only)
845 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
846
847 dc = get_frame_dc (f);
848
849 EnumFontFamiliesEx (dc, &match_data.pattern,
850 (FONTENUMPROC) add_one_font_entity_to_list,
851 (LPARAM) &match_data, 0);
852 release_frame_dc (f, dc);
853
854 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
855 }
856
857 int
858 w32font_open_internal (struct frame *f, Lisp_Object font_entity,
859 int pixel_size, Lisp_Object font_object)
860 {
861 int len, size;
862 LOGFONT logfont;
863 HDC dc;
864 HFONT hfont, old_font;
865 Lisp_Object val;
866 struct w32font_info *w32_font;
867 struct font * font;
868 OUTLINETEXTMETRICW* metrics = NULL;
869
870 w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
871 font = (struct font *) w32_font;
872
873 if (!font)
874 return 0;
875
876 memset (&logfont, 0, sizeof (logfont));
877 fill_in_logfont (f, &logfont, font_entity);
878
879 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
880 limitations in bitmap fonts. */
881 val = AREF (font_entity, FONT_FOUNDRY_INDEX);
882 if (!EQ (val, Qraster))
883 logfont.lfOutPrecision = OUT_TT_PRECIS;
884
885 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
886 if (!size)
887 size = pixel_size;
888
889 logfont.lfHeight = -size;
890 hfont = CreateFontIndirect (&logfont);
891
892 if (hfont == NULL)
893 return 0;
894
895 /* Get the metrics for this font. */
896 dc = get_frame_dc (f);
897 old_font = SelectObject (dc, hfont);
898
899 /* Try getting the outline metrics (only works for truetype fonts). */
900 len = get_outline_metrics_w (dc, 0, NULL);
901 if (len)
902 {
903 metrics = (OUTLINETEXTMETRICW *) alloca (len);
904 if (get_outline_metrics_w (dc, len, metrics))
905 memcpy (&w32_font->metrics, &metrics->otmTextMetrics,
906 sizeof (TEXTMETRICW));
907 else
908 metrics = NULL;
909 }
910
911 if (!metrics)
912 get_text_metrics_w (dc, &w32_font->metrics);
913
914 w32_font->cached_metrics = NULL;
915 w32_font->n_cache_blocks = 0;
916
917 SelectObject (dc, old_font);
918 release_frame_dc (f, dc);
919
920 w32_font->hfont = hfont;
921
922 {
923 char *name;
924
925 /* We don't know how much space we need for the full name, so start with
926 96 bytes and go up in steps of 32. */
927 len = 96;
928 name = alloca (len);
929 while (name && w32font_full_name (&logfont, font_entity, pixel_size,
930 name, len) < 0)
931 {
932 len += 32;
933 name = alloca (len);
934 }
935 if (name)
936 font->props[FONT_FULLNAME_INDEX]
937 = DECODE_SYSTEM (build_string (name));
938 else
939 font->props[FONT_FULLNAME_INDEX]
940 = DECODE_SYSTEM (build_string (logfont.lfFaceName));
941 }
942
943 font->max_width = w32_font->metrics.tmMaxCharWidth;
944 /* Parts of Emacs display assume that height = ascent + descent...
945 so height is defined later, after ascent and descent.
946 font->height = w32_font->metrics.tmHeight
947 + w32_font->metrics.tmExternalLeading;
948 */
949
950 font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
951
952 font->vertical_centering = 0;
953 font->baseline_offset = 0;
954 font->relative_compose = 0;
955 font->default_ascent = w32_font->metrics.tmAscent;
956 font->pixel_size = size;
957 font->driver = &w32font_driver;
958 font->encoding_charset = -1;
959 font->repertory_charset = -1;
960 /* TODO: do we really want the minimum width here, which could be negative? */
961 font->min_width = font->space_width;
962 font->ascent = w32_font->metrics.tmAscent;
963 font->descent = w32_font->metrics.tmDescent;
964 font->height = font->ascent + font->descent;
965
966 if (metrics)
967 {
968 font->underline_thickness = metrics->otmsUnderscoreSize;
969 font->underline_position = -metrics->otmsUnderscorePosition;
970 }
971 else
972 {
973 font->underline_thickness = 0;
974 font->underline_position = -1;
975 }
976
977 /* For temporary compatibility with legacy code that expects the
978 name to be usable in x-list-fonts. Eventually we expect to change
979 x-list-fonts and other places that use fonts so that this can be
980 an fcname or similar. */
981 font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
982
983 return 1;
984 }
985
986 /* Callback function for EnumFontFamiliesEx.
987 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
988 static int CALLBACK ALIGN_STACK
989 add_font_name_to_list (ENUMLOGFONTEX *logical_font,
990 NEWTEXTMETRICEX *physical_font,
991 DWORD font_type, LPARAM list_object)
992 {
993 Lisp_Object* list = (Lisp_Object *) list_object;
994 Lisp_Object family;
995
996 /* Skip vertical fonts (intended only for printing) */
997 if (logical_font->elfLogFont.lfFaceName[0] == '@')
998 return 1;
999
1000 family = intern_font_name (logical_font->elfLogFont.lfFaceName);
1001 if (! memq_no_quit (family, *list))
1002 *list = Fcons (family, *list);
1003
1004 return 1;
1005 }
1006
1007 static int w32_decode_weight (int);
1008 static int w32_encode_weight (int);
1009
1010 /* Convert an enumerated Windows font to an Emacs font entity. */
1011 static Lisp_Object
1012 w32_enumfont_pattern_entity (Lisp_Object frame,
1013 ENUMLOGFONTEX *logical_font,
1014 NEWTEXTMETRICEX *physical_font,
1015 DWORD font_type,
1016 LOGFONT *requested_font,
1017 Lisp_Object backend)
1018 {
1019 Lisp_Object entity, tem;
1020 LOGFONT *lf = (LOGFONT*) logical_font;
1021 BYTE generic_type;
1022 DWORD full_type = physical_font->ntmTm.ntmFlags;
1023
1024 entity = font_make_entity ();
1025
1026 ASET (entity, FONT_TYPE_INDEX, backend);
1027 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
1028 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
1029
1030 /* Foundry is difficult to get in readable form on Windows.
1031 But Emacs crashes if it is not set, so set it to something more
1032 generic. These values make xlfds compatible with Emacs 22. */
1033 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
1034 tem = Qraster;
1035 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
1036 tem = Qoutline;
1037 else
1038 tem = Qunknown;
1039
1040 ASET (entity, FONT_FOUNDRY_INDEX, tem);
1041
1042 /* Save the generic family in the extra info, as it is likely to be
1043 useful to users looking for a close match. */
1044 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
1045 if (generic_type == FF_DECORATIVE)
1046 tem = Qdecorative;
1047 else if (generic_type == FF_MODERN)
1048 tem = Qmono;
1049 else if (generic_type == FF_ROMAN)
1050 tem = Qserif;
1051 else if (generic_type == FF_SCRIPT)
1052 tem = Qscript;
1053 else if (generic_type == FF_SWISS)
1054 tem = Qsans;
1055 else
1056 tem = Qnil;
1057
1058 ASET (entity, FONT_ADSTYLE_INDEX, tem);
1059
1060 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
1061 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL));
1062 else
1063 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL));
1064
1065 if (requested_font->lfQuality != DEFAULT_QUALITY)
1066 {
1067 font_put_extra (entity, QCantialias,
1068 lispy_antialias_type (requested_font->lfQuality));
1069 }
1070 ASET (entity, FONT_FAMILY_INDEX,
1071 intern_font_name (lf->lfFaceName));
1072
1073 FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
1074 make_number (w32_decode_weight (lf->lfWeight)));
1075 FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
1076 make_number (lf->lfItalic ? 200 : 100));
1077 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1078 to get it. */
1079 FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100));
1080
1081 if (font_type & RASTER_FONTTYPE)
1082 ASET (entity, FONT_SIZE_INDEX,
1083 make_number (physical_font->ntmTm.tmHeight
1084 + physical_font->ntmTm.tmExternalLeading));
1085 else
1086 ASET (entity, FONT_SIZE_INDEX, make_number (0));
1087
1088 /* Cache Unicode codepoints covered by this font, as there is no other way
1089 of getting this information easily. */
1090 if (font_type & TRUETYPE_FONTTYPE)
1091 {
1092 tem = font_supported_scripts (&physical_font->ntmFontSig);
1093 if (!NILP (tem))
1094 font_put_extra (entity, QCscript, tem);
1095 }
1096
1097 /* This information is not fully available when opening fonts, so
1098 save it here. Only Windows 2000 and later return information
1099 about opentype and type1 fonts, so need a fallback for detecting
1100 truetype so that this information is not any worse than we could
1101 have obtained later. */
1102 if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
1103 tem = Qopentype;
1104 else if (font_type & TRUETYPE_FONTTYPE)
1105 tem = intern ("truetype");
1106 else if (full_type & NTM_PS_OPENTYPE)
1107 tem = Qpostscript;
1108 else if (full_type & NTM_TYPE1)
1109 tem = intern ("type1");
1110 else if (font_type & RASTER_FONTTYPE)
1111 tem = intern ("w32bitmap");
1112 else
1113 tem = intern ("w32vector");
1114
1115 font_put_extra (entity, QCformat, tem);
1116
1117 return entity;
1118 }
1119
1120
1121 /* Convert generic families to the family portion of lfPitchAndFamily. */
1122 static BYTE
1123 w32_generic_family (Lisp_Object name)
1124 {
1125 /* Generic families. */
1126 if (EQ (name, Qmonospace) || EQ (name, Qmono))
1127 return FF_MODERN;
1128 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
1129 return FF_SWISS;
1130 else if (EQ (name, Qserif))
1131 return FF_ROMAN;
1132 else if (EQ (name, Qdecorative))
1133 return FF_DECORATIVE;
1134 else if (EQ (name, Qscript))
1135 return FF_SCRIPT;
1136 else
1137 return FF_DONTCARE;
1138 }
1139
1140 static int
1141 logfonts_match (LOGFONT *font, LOGFONT *pattern)
1142 {
1143 /* Only check height for raster fonts. */
1144 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
1145 && font->lfHeight != pattern->lfHeight)
1146 return 0;
1147
1148 /* Have some flexibility with weights. */
1149 if (pattern->lfWeight
1150 && ((font->lfWeight < (pattern->lfWeight - 150))
1151 || font->lfWeight > (pattern->lfWeight + 150)))
1152 return 0;
1153
1154 /* Charset and face should be OK. Italic has to be checked
1155 against the original spec, in case we don't have any preference. */
1156 return 1;
1157 }
1158
1159 /* Codepage Bitfields in FONTSIGNATURE struct. */
1160 #define CSB_JAPANESE (1 << 17)
1161 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1162 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1163
1164 static int
1165 font_matches_spec (DWORD type, NEWTEXTMETRICEX *font,
1166 Lisp_Object spec, Lisp_Object backend,
1167 LOGFONT *logfont)
1168 {
1169 Lisp_Object extra, val;
1170
1171 /* Check italic. Can't check logfonts, since it is a boolean field,
1172 so there is no difference between "non-italic" and "don't care". */
1173 {
1174 int slant = FONT_SLANT_NUMERIC (spec);
1175
1176 if (slant >= 0
1177 && ((slant > 150 && !font->ntmTm.tmItalic)
1178 || (slant <= 150 && font->ntmTm.tmItalic)))
1179 return 0;
1180 }
1181
1182 /* Check adstyle against generic family. */
1183 val = AREF (spec, FONT_ADSTYLE_INDEX);
1184 if (!NILP (val))
1185 {
1186 BYTE family = w32_generic_family (val);
1187 if (family != FF_DONTCARE
1188 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
1189 return 0;
1190 }
1191
1192 /* Check spacing */
1193 val = AREF (spec, FONT_SPACING_INDEX);
1194 if (INTEGERP (val))
1195 {
1196 int spacing = XINT (val);
1197 int proportional = (spacing < FONT_SPACING_MONO);
1198
1199 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
1200 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
1201 return 0;
1202 }
1203
1204 /* Check extra parameters. */
1205 for (extra = AREF (spec, FONT_EXTRA_INDEX);
1206 CONSP (extra); extra = XCDR (extra))
1207 {
1208 Lisp_Object extra_entry;
1209 extra_entry = XCAR (extra);
1210 if (CONSP (extra_entry))
1211 {
1212 Lisp_Object key = XCAR (extra_entry);
1213
1214 val = XCDR (extra_entry);
1215 if (EQ (key, QCscript) && SYMBOLP (val))
1216 {
1217 /* Only truetype fonts will have information about what
1218 scripts they support. This probably means the user
1219 will have to force Emacs to use raster, PostScript
1220 or ATM fonts for non-ASCII text. */
1221 if (type & TRUETYPE_FONTTYPE)
1222 {
1223 Lisp_Object support
1224 = font_supported_scripts (&font->ntmFontSig);
1225 if (! memq_no_quit (val, support))
1226 return 0;
1227
1228 /* Avoid using non-Japanese fonts for Japanese, even
1229 if they claim they are capable, due to known
1230 breakage in Vista and Windows 7 fonts
1231 (bug#6029). */
1232 if (EQ (val, Qkana)
1233 && (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET
1234 || !(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE)))
1235 return 0;
1236 }
1237 else
1238 {
1239 /* Return specific matches, but play it safe. Fonts
1240 that cover more than their charset would suggest
1241 are likely to be truetype or opentype fonts,
1242 covered above. */
1243 if (EQ (val, Qlatin))
1244 {
1245 /* Although every charset but symbol, thai and
1246 arabic contains the basic ASCII set of latin
1247 characters, Emacs expects much more. */
1248 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
1249 return 0;
1250 }
1251 else if (EQ (val, Qsymbol))
1252 {
1253 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
1254 return 0;
1255 }
1256 else if (EQ (val, Qcyrillic))
1257 {
1258 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
1259 return 0;
1260 }
1261 else if (EQ (val, Qgreek))
1262 {
1263 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
1264 return 0;
1265 }
1266 else if (EQ (val, Qarabic))
1267 {
1268 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
1269 return 0;
1270 }
1271 else if (EQ (val, Qhebrew))
1272 {
1273 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
1274 return 0;
1275 }
1276 else if (EQ (val, Qthai))
1277 {
1278 if (font->ntmTm.tmCharSet != THAI_CHARSET)
1279 return 0;
1280 }
1281 else if (EQ (val, Qkana))
1282 {
1283 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1284 return 0;
1285 }
1286 else if (EQ (val, Qbopomofo))
1287 {
1288 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1289 return 0;
1290 }
1291 else if (EQ (val, Qhangul))
1292 {
1293 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1294 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1295 return 0;
1296 }
1297 else if (EQ (val, Qhan))
1298 {
1299 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1300 && font->ntmTm.tmCharSet != GB2312_CHARSET
1301 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1302 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1303 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1304 return 0;
1305 }
1306 else
1307 /* Other scripts unlikely to be handled by non-truetype
1308 fonts. */
1309 return 0;
1310 }
1311 }
1312 else if (EQ (key, QClang) && SYMBOLP (val))
1313 {
1314 /* Just handle the CJK languages here, as the lang
1315 parameter is used to select a font with appropriate
1316 glyphs in the cjk unified ideographs block. Other fonts
1317 support for a language can be solely determined by
1318 its character coverage. */
1319 if (EQ (val, Qja))
1320 {
1321 if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1322 return 0;
1323 }
1324 else if (EQ (val, Qko))
1325 {
1326 if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
1327 return 0;
1328 }
1329 else if (EQ (val, Qzh))
1330 {
1331 if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
1332 return 0;
1333 }
1334 else
1335 /* Any other language, we don't recognize it. Only the above
1336 currently appear in fontset.el, so it isn't worth
1337 creating a mapping table of codepages/scripts to languages
1338 or opening the font to see if there are any language tags
1339 in it that the Windows API does not expose. Fontset
1340 spec should have a fallback, as some backends do
1341 not recognize language at all. */
1342 return 0;
1343 }
1344 else if (EQ (key, QCotf) && CONSP (val))
1345 {
1346 /* OTF features only supported by the uniscribe backend. */
1347 if (EQ (backend, Quniscribe))
1348 {
1349 if (!uniscribe_check_otf (logfont, val))
1350 return 0;
1351 }
1352 else
1353 return 0;
1354 }
1355 }
1356 }
1357 return 1;
1358 }
1359
1360 static int
1361 w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset)
1362 {
1363 DWORD subrange1 = coverage->fsUsb[1];
1364
1365 #define SUBRANGE1_HAN_MASK 0x08000000
1366 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1367 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1368
1369 if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET)
1370 {
1371 return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK;
1372 }
1373 else if (charset == SHIFTJIS_CHARSET)
1374 {
1375 return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK;
1376 }
1377 else if (charset == HANGEUL_CHARSET)
1378 {
1379 return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK;
1380 }
1381
1382 return 1;
1383 }
1384
1385 #ifndef WINDOWSNT
1386 #define _strlwr strlwr
1387 #endif /* !WINDOWSNT */
1388
1389 static int
1390 check_face_name (LOGFONT *font, char *full_name)
1391 {
1392 char full_iname[LF_FULLFACESIZE+1];
1393
1394 /* Just check for names known to cause problems, since the full name
1395 can contain expanded abbreviations, prefixed foundry, postfixed
1396 style, the latter of which sometimes differs from the style indicated
1397 in the shorter name (eg Lt becomes Light or even Extra Light) */
1398
1399 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1400 installed, we run into problems with the Uniscribe backend which tries
1401 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1402 with Arial's characteristics, since that attempt to use TrueType works
1403 some places, but not others. */
1404 if (!xstrcasecmp (font->lfFaceName, "helvetica"))
1405 {
1406 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1407 full_iname[LF_FULLFACESIZE] = 0;
1408 _strlwr (full_iname);
1409 return strstr ("helvetica", full_iname) != NULL;
1410 }
1411 /* Same for Helv. */
1412 if (!xstrcasecmp (font->lfFaceName, "helv"))
1413 {
1414 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1415 full_iname[LF_FULLFACESIZE] = 0;
1416 _strlwr (full_iname);
1417 return strstr ("helv", full_iname) != NULL;
1418 }
1419
1420 /* Since Times is mapped to Times New Roman, a substring
1421 match is not sufficient to filter out the bogus match. */
1422 else if (!xstrcasecmp (font->lfFaceName, "times"))
1423 return xstrcasecmp (full_name, "times") == 0;
1424
1425 return 1;
1426 }
1427
1428
1429 /* Callback function for EnumFontFamiliesEx.
1430 * Checks if a font matches everything we are trying to check against,
1431 * and if so, adds it to a list. Both the data we are checking against
1432 * and the list to which the fonts are added are passed in via the
1433 * lparam argument, in the form of a font_callback_data struct. */
1434 static int CALLBACK ALIGN_STACK
1435 add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1436 NEWTEXTMETRICEX *physical_font,
1437 DWORD font_type, LPARAM lParam)
1438 {
1439 struct font_callback_data *match_data
1440 = (struct font_callback_data *) lParam;
1441 Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
1442 Lisp_Object entity;
1443
1444 int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1445 || physical_font->ntmFontSig.fsUsb[2]
1446 || physical_font->ntmFontSig.fsUsb[1]
1447 || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1448
1449 /* Skip non matching fonts. */
1450
1451 /* For uniscribe backend, consider only truetype or opentype fonts
1452 that have some Unicode coverage. */
1453 if (match_data->opentype_only
1454 && ((!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
1455 && !(font_type & TRUETYPE_FONTTYPE))
1456 || !is_unicode))
1457 return 1;
1458
1459 /* Ensure a match. */
1460 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1461 || !font_matches_spec (font_type, physical_font,
1462 match_data->orig_font_spec, backend,
1463 &logical_font->elfLogFont)
1464 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1465 match_data->pattern.lfCharSet))
1466 return 1;
1467
1468 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1469 We limit this to raster fonts, because the test can catch some
1470 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1471 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1472 therefore get through this test. Since full names can be prefixed
1473 by a foundry, we accept raster fonts if the font name is found
1474 anywhere within the full name. */
1475 if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
1476 && !strstr ((char *)logical_font->elfFullName,
1477 logical_font->elfLogFont.lfFaceName))
1478 /* Check for well known substitutions that mess things up in the
1479 presence of Type-1 fonts of the same name. */
1480 || (!check_face_name (&logical_font->elfLogFont,
1481 (char *)logical_font->elfFullName)))
1482 return 1;
1483
1484 /* Make a font entity for the font. */
1485 entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1486 physical_font, font_type,
1487 &match_data->pattern,
1488 backend);
1489
1490 if (!NILP (entity))
1491 {
1492 Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1493 FONT_REGISTRY_INDEX);
1494
1495 /* iso10646-1 fonts must contain Unicode mapping tables. */
1496 if (EQ (spec_charset, Qiso10646_1))
1497 {
1498 if (!is_unicode)
1499 return 1;
1500 }
1501 /* unicode-bmp fonts must contain characters from the BMP. */
1502 else if (EQ (spec_charset, Qunicode_bmp))
1503 {
1504 if (!physical_font->ntmFontSig.fsUsb[3]
1505 && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1506 && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1507 && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1508 return 1;
1509 }
1510 /* unicode-sip fonts must contain characters in Unicode plane 2.
1511 so look for bit 57 (surrogates) in the Unicode subranges, plus
1512 the bits for CJK ranges that include those characters. */
1513 else if (EQ (spec_charset, Qunicode_sip))
1514 {
1515 if (!(physical_font->ntmFontSig.fsUsb[1] & 0x02000000)
1516 || !(physical_font->ntmFontSig.fsUsb[1] & 0x28000000))
1517 return 1;
1518 }
1519
1520 /* This font matches. */
1521
1522 /* If registry was specified, ensure it is reported as the same. */
1523 if (!NILP (spec_charset))
1524 {
1525 /* Avoid using non-Japanese fonts for Japanese, even if they
1526 claim they are capable, due to known breakage in Vista
1527 and Windows 7 fonts (bug#6029). */
1528 if (logical_font->elfLogFont.lfCharSet == SHIFTJIS_CHARSET
1529 && !(physical_font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1530 return 1;
1531 else
1532 ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1533 }
1534 /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1535 fonts as Unicode and skip other charsets. */
1536 else if (match_data->opentype_only)
1537 {
1538 if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1539 || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1540 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1541 else
1542 return 1;
1543 }
1544
1545 /* Add this font to the list. */
1546 match_data->list = Fcons (entity, match_data->list);
1547 }
1548 return 1;
1549 }
1550
1551 /* Callback function for EnumFontFamiliesEx.
1552 * Terminates the search once we have a match. */
1553 static int CALLBACK ALIGN_STACK
1554 add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1555 NEWTEXTMETRICEX *physical_font,
1556 DWORD font_type, LPARAM lParam)
1557 {
1558 struct font_callback_data *match_data
1559 = (struct font_callback_data *) lParam;
1560 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1561
1562 /* If we have a font in the list, terminate the search. */
1563 return NILP (match_data->list);
1564 }
1565
1566 /* Old function to convert from x to w32 charset, from w32fns.c. */
1567 static LONG
1568 x_to_w32_charset (char * lpcs)
1569 {
1570 Lisp_Object this_entry, w32_charset;
1571 char *charset;
1572 int len = strlen (lpcs);
1573
1574 /* Support "*-#nnn" format for unknown charsets. */
1575 if (strncmp (lpcs, "*-#", 3) == 0)
1576 return atoi (lpcs + 3);
1577
1578 /* All Windows fonts qualify as Unicode. */
1579 if (!strncmp (lpcs, "iso10646", 8))
1580 return DEFAULT_CHARSET;
1581
1582 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1583 charset = alloca (len + 1);
1584 strcpy (charset, lpcs);
1585 lpcs = strchr (charset, '*');
1586 if (lpcs)
1587 *lpcs = '\0';
1588
1589 /* Look through w32-charset-info-alist for the character set.
1590 Format of each entry is
1591 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1592 */
1593 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
1594
1595 if (NILP (this_entry))
1596 {
1597 /* At startup, we want iso8859-1 fonts to come up properly. */
1598 if (xstrcasecmp (charset, "iso8859-1") == 0)
1599 return ANSI_CHARSET;
1600 else
1601 return DEFAULT_CHARSET;
1602 }
1603
1604 w32_charset = Fcar (Fcdr (this_entry));
1605
1606 /* Translate Lisp symbol to number. */
1607 if (EQ (w32_charset, Qw32_charset_ansi))
1608 return ANSI_CHARSET;
1609 if (EQ (w32_charset, Qw32_charset_symbol))
1610 return SYMBOL_CHARSET;
1611 if (EQ (w32_charset, Qw32_charset_shiftjis))
1612 return SHIFTJIS_CHARSET;
1613 if (EQ (w32_charset, Qw32_charset_hangeul))
1614 return HANGEUL_CHARSET;
1615 if (EQ (w32_charset, Qw32_charset_chinesebig5))
1616 return CHINESEBIG5_CHARSET;
1617 if (EQ (w32_charset, Qw32_charset_gb2312))
1618 return GB2312_CHARSET;
1619 if (EQ (w32_charset, Qw32_charset_oem))
1620 return OEM_CHARSET;
1621 if (EQ (w32_charset, Qw32_charset_johab))
1622 return JOHAB_CHARSET;
1623 if (EQ (w32_charset, Qw32_charset_easteurope))
1624 return EASTEUROPE_CHARSET;
1625 if (EQ (w32_charset, Qw32_charset_turkish))
1626 return TURKISH_CHARSET;
1627 if (EQ (w32_charset, Qw32_charset_baltic))
1628 return BALTIC_CHARSET;
1629 if (EQ (w32_charset, Qw32_charset_russian))
1630 return RUSSIAN_CHARSET;
1631 if (EQ (w32_charset, Qw32_charset_arabic))
1632 return ARABIC_CHARSET;
1633 if (EQ (w32_charset, Qw32_charset_greek))
1634 return GREEK_CHARSET;
1635 if (EQ (w32_charset, Qw32_charset_hebrew))
1636 return HEBREW_CHARSET;
1637 if (EQ (w32_charset, Qw32_charset_vietnamese))
1638 return VIETNAMESE_CHARSET;
1639 if (EQ (w32_charset, Qw32_charset_thai))
1640 return THAI_CHARSET;
1641 if (EQ (w32_charset, Qw32_charset_mac))
1642 return MAC_CHARSET;
1643
1644 return DEFAULT_CHARSET;
1645 }
1646
1647
1648 /* Convert a Lisp font registry (symbol) to a windows charset. */
1649 static LONG
1650 registry_to_w32_charset (Lisp_Object charset)
1651 {
1652 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1653 || EQ (charset, Qunicode_sip))
1654 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1655 else if (EQ (charset, Qiso8859_1))
1656 return ANSI_CHARSET;
1657 else if (SYMBOLP (charset))
1658 return x_to_w32_charset (SSDATA (SYMBOL_NAME (charset)));
1659 else
1660 return DEFAULT_CHARSET;
1661 }
1662
1663 /* Old function to convert from w32 to x charset, from w32fns.c. */
1664 static char *
1665 w32_to_x_charset (int fncharset, char *matching)
1666 {
1667 static char buf[32];
1668 Lisp_Object charset_type;
1669 int match_len = 0;
1670
1671 if (matching)
1672 {
1673 /* If fully specified, accept it as it is. Otherwise use a
1674 substring match. */
1675 char *wildcard = strchr (matching, '*');
1676 if (wildcard)
1677 *wildcard = '\0';
1678 else if (strchr (matching, '-'))
1679 return matching;
1680
1681 match_len = strlen (matching);
1682 }
1683
1684 switch (fncharset)
1685 {
1686 case ANSI_CHARSET:
1687 /* Handle startup case of w32-charset-info-alist not
1688 being set up yet. */
1689 if (NILP (Vw32_charset_info_alist))
1690 return "iso8859-1";
1691 charset_type = Qw32_charset_ansi;
1692 break;
1693 case DEFAULT_CHARSET:
1694 charset_type = Qw32_charset_default;
1695 break;
1696 case SYMBOL_CHARSET:
1697 charset_type = Qw32_charset_symbol;
1698 break;
1699 case SHIFTJIS_CHARSET:
1700 charset_type = Qw32_charset_shiftjis;
1701 break;
1702 case HANGEUL_CHARSET:
1703 charset_type = Qw32_charset_hangeul;
1704 break;
1705 case GB2312_CHARSET:
1706 charset_type = Qw32_charset_gb2312;
1707 break;
1708 case CHINESEBIG5_CHARSET:
1709 charset_type = Qw32_charset_chinesebig5;
1710 break;
1711 case OEM_CHARSET:
1712 charset_type = Qw32_charset_oem;
1713 break;
1714 case EASTEUROPE_CHARSET:
1715 charset_type = Qw32_charset_easteurope;
1716 break;
1717 case TURKISH_CHARSET:
1718 charset_type = Qw32_charset_turkish;
1719 break;
1720 case BALTIC_CHARSET:
1721 charset_type = Qw32_charset_baltic;
1722 break;
1723 case RUSSIAN_CHARSET:
1724 charset_type = Qw32_charset_russian;
1725 break;
1726 case ARABIC_CHARSET:
1727 charset_type = Qw32_charset_arabic;
1728 break;
1729 case GREEK_CHARSET:
1730 charset_type = Qw32_charset_greek;
1731 break;
1732 case HEBREW_CHARSET:
1733 charset_type = Qw32_charset_hebrew;
1734 break;
1735 case VIETNAMESE_CHARSET:
1736 charset_type = Qw32_charset_vietnamese;
1737 break;
1738 case THAI_CHARSET:
1739 charset_type = Qw32_charset_thai;
1740 break;
1741 case MAC_CHARSET:
1742 charset_type = Qw32_charset_mac;
1743 break;
1744 case JOHAB_CHARSET:
1745 charset_type = Qw32_charset_johab;
1746 break;
1747
1748 default:
1749 /* Encode numerical value of unknown charset. */
1750 sprintf (buf, "*-#%u", fncharset);
1751 return buf;
1752 }
1753
1754 {
1755 Lisp_Object rest;
1756 char * best_match = NULL;
1757 int matching_found = 0;
1758
1759 /* Look through w32-charset-info-alist for the character set.
1760 Prefer ISO codepages, and prefer lower numbers in the ISO
1761 range. Only return charsets for codepages which are installed.
1762
1763 Format of each entry is
1764 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1765 */
1766 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1767 {
1768 char * x_charset;
1769 Lisp_Object w32_charset;
1770 Lisp_Object codepage;
1771
1772 Lisp_Object this_entry = XCAR (rest);
1773
1774 /* Skip invalid entries in alist. */
1775 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1776 || !CONSP (XCDR (this_entry))
1777 || !SYMBOLP (XCAR (XCDR (this_entry))))
1778 continue;
1779
1780 x_charset = SSDATA (XCAR (this_entry));
1781 w32_charset = XCAR (XCDR (this_entry));
1782 codepage = XCDR (XCDR (this_entry));
1783
1784 /* Look for Same charset and a valid codepage (or non-int
1785 which means ignore). */
1786 if (EQ (w32_charset, charset_type)
1787 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
1788 || IsValidCodePage (XINT (codepage))))
1789 {
1790 /* If we don't have a match already, then this is the
1791 best. */
1792 if (!best_match)
1793 {
1794 best_match = x_charset;
1795 if (matching && !strnicmp (x_charset, matching, match_len))
1796 matching_found = 1;
1797 }
1798 /* If we already found a match for MATCHING, then
1799 only consider other matches. */
1800 else if (matching_found
1801 && strnicmp (x_charset, matching, match_len))
1802 continue;
1803 /* If this matches what we want, and the best so far doesn't,
1804 then this is better. */
1805 else if (!matching_found && matching
1806 && !strnicmp (x_charset, matching, match_len))
1807 {
1808 best_match = x_charset;
1809 matching_found = 1;
1810 }
1811 /* If this is fully specified, and the best so far isn't,
1812 then this is better. */
1813 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1814 /* If this is an ISO codepage, and the best so far isn't,
1815 then this is better, but only if it fully specifies the
1816 encoding. */
1817 || (strnicmp (best_match, "iso", 3) != 0
1818 && strnicmp (x_charset, "iso", 3) == 0
1819 && strchr (x_charset, '-')))
1820 best_match = x_charset;
1821 /* If both are ISO8859 codepages, choose the one with the
1822 lowest number in the encoding field. */
1823 else if (strnicmp (best_match, "iso8859-", 8) == 0
1824 && strnicmp (x_charset, "iso8859-", 8) == 0)
1825 {
1826 int best_enc = atoi (best_match + 8);
1827 int this_enc = atoi (x_charset + 8);
1828 if (this_enc > 0 && this_enc < best_enc)
1829 best_match = x_charset;
1830 }
1831 }
1832 }
1833
1834 /* If no match, encode the numeric value. */
1835 if (!best_match)
1836 {
1837 sprintf (buf, "*-#%u", fncharset);
1838 return buf;
1839 }
1840
1841 strncpy (buf, best_match, 31);
1842 /* If the charset is not fully specified, put -0 on the end. */
1843 if (!strchr (best_match, '-'))
1844 {
1845 int pos = strlen (best_match);
1846 /* Charset specifiers shouldn't be very long. If it is a made
1847 up one, truncating it should not do any harm since it isn't
1848 recognized anyway. */
1849 if (pos > 29)
1850 pos = 29;
1851 strcpy (buf + pos, "-0");
1852 }
1853 buf[31] = '\0';
1854 return buf;
1855 }
1856 }
1857
1858 static Lisp_Object
1859 w32_registry (LONG w32_charset, DWORD font_type)
1860 {
1861 char *charset;
1862
1863 /* If charset is defaulted, charset is Unicode or unknown, depending on
1864 font type. */
1865 if (w32_charset == DEFAULT_CHARSET)
1866 return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
1867
1868 charset = w32_to_x_charset (w32_charset, NULL);
1869 return font_intern_prop (charset, strlen (charset), 1);
1870 }
1871
1872 static int
1873 w32_decode_weight (int fnweight)
1874 {
1875 if (fnweight >= FW_HEAVY) return 210;
1876 if (fnweight >= FW_EXTRABOLD) return 205;
1877 if (fnweight >= FW_BOLD) return 200;
1878 if (fnweight >= FW_SEMIBOLD) return 180;
1879 if (fnweight >= FW_NORMAL) return 100;
1880 if (fnweight >= FW_LIGHT) return 50;
1881 if (fnweight >= FW_EXTRALIGHT) return 40;
1882 if (fnweight > FW_THIN) return 20;
1883 return 0;
1884 }
1885
1886 static int
1887 w32_encode_weight (int n)
1888 {
1889 if (n >= 210) return FW_HEAVY;
1890 if (n >= 205) return FW_EXTRABOLD;
1891 if (n >= 200) return FW_BOLD;
1892 if (n >= 180) return FW_SEMIBOLD;
1893 if (n >= 100) return FW_NORMAL;
1894 if (n >= 50) return FW_LIGHT;
1895 if (n >= 40) return FW_EXTRALIGHT;
1896 if (n >= 20) return FW_THIN;
1897 return 0;
1898 }
1899
1900 /* Convert a Windows font weight into one of the weights supported
1901 by fontconfig (see font.c:font_parse_fcname). */
1902 static Lisp_Object
1903 w32_to_fc_weight (int n)
1904 {
1905 if (n >= FW_EXTRABOLD) return intern ("black");
1906 if (n >= FW_BOLD) return Qbold;
1907 if (n >= FW_SEMIBOLD) return intern ("demibold");
1908 if (n >= FW_NORMAL) return intern ("medium");
1909 return Qlight;
1910 }
1911
1912 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1913 static void
1914 fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec)
1915 {
1916 Lisp_Object tmp, extra;
1917 int dpi = FRAME_RES_Y (f);
1918
1919 tmp = AREF (font_spec, FONT_DPI_INDEX);
1920 if (INTEGERP (tmp))
1921 {
1922 dpi = XINT (tmp);
1923 }
1924 else if (FLOATP (tmp))
1925 {
1926 dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
1927 }
1928
1929 /* Height */
1930 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1931 if (INTEGERP (tmp))
1932 logfont->lfHeight = -1 * XINT (tmp);
1933 else if (FLOATP (tmp))
1934 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
1935
1936 /* Escapement */
1937
1938 /* Orientation */
1939
1940 /* Weight */
1941 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1942 if (INTEGERP (tmp))
1943 logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
1944
1945 /* Italic */
1946 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1947 if (INTEGERP (tmp))
1948 {
1949 int slant = FONT_SLANT_NUMERIC (font_spec);
1950 logfont->lfItalic = slant > 150 ? 1 : 0;
1951 }
1952
1953 /* Underline */
1954
1955 /* Strikeout */
1956
1957 /* Charset */
1958 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
1959 if (! NILP (tmp))
1960 logfont->lfCharSet = registry_to_w32_charset (tmp);
1961 else
1962 logfont->lfCharSet = DEFAULT_CHARSET;
1963
1964 /* Out Precision */
1965
1966 /* Clip Precision */
1967
1968 /* Quality */
1969 logfont->lfQuality = DEFAULT_QUALITY;
1970
1971 /* Generic Family and Face Name */
1972 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
1973
1974 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
1975 if (! NILP (tmp))
1976 {
1977 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
1978 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
1979 ; /* Font name was generic, don't fill in font name. */
1980 /* Font families are interned, but allow for strings also in case of
1981 user input. */
1982 else if (SYMBOLP (tmp))
1983 {
1984 strncpy (logfont->lfFaceName,
1985 SSDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
1986 logfont->lfFaceName[LF_FACESIZE-1] = '\0';
1987 }
1988 }
1989
1990 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
1991 if (!NILP (tmp))
1992 {
1993 /* Override generic family. */
1994 BYTE family = w32_generic_family (tmp);
1995 if (family != FF_DONTCARE)
1996 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
1997 }
1998
1999 /* Set pitch based on the spacing property. */
2000 tmp = AREF (font_spec, FONT_SPACING_INDEX);
2001 if (INTEGERP (tmp))
2002 {
2003 int spacing = XINT (tmp);
2004 if (spacing < FONT_SPACING_MONO)
2005 logfont->lfPitchAndFamily
2006 = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
2007 else
2008 logfont->lfPitchAndFamily
2009 = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
2010 }
2011
2012 /* Process EXTRA info. */
2013 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
2014 CONSP (extra); extra = XCDR (extra))
2015 {
2016 tmp = XCAR (extra);
2017 if (CONSP (tmp))
2018 {
2019 Lisp_Object key, val;
2020 key = XCAR (tmp), val = XCDR (tmp);
2021 /* Only use QCscript if charset is not provided, or is Unicode
2022 and a single script is specified. This is rather crude,
2023 and is only used to narrow down the fonts returned where
2024 there is a definite match. Some scripts, such as latin, han,
2025 cjk-misc match multiple lfCharSet values, so we can't pre-filter
2026 them. */
2027 if (EQ (key, QCscript)
2028 && logfont->lfCharSet == DEFAULT_CHARSET
2029 && SYMBOLP (val))
2030 {
2031 if (EQ (val, Qgreek))
2032 logfont->lfCharSet = GREEK_CHARSET;
2033 else if (EQ (val, Qhangul))
2034 logfont->lfCharSet = HANGUL_CHARSET;
2035 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
2036 logfont->lfCharSet = SHIFTJIS_CHARSET;
2037 else if (EQ (val, Qbopomofo))
2038 logfont->lfCharSet = CHINESEBIG5_CHARSET;
2039 /* GB 18030 supports tibetan, yi, mongolian,
2040 fonts that support it should show up if we ask for
2041 GB2312 fonts. */
2042 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
2043 || EQ (val, Qmongolian))
2044 logfont->lfCharSet = GB2312_CHARSET;
2045 else if (EQ (val, Qhebrew))
2046 logfont->lfCharSet = HEBREW_CHARSET;
2047 else if (EQ (val, Qarabic))
2048 logfont->lfCharSet = ARABIC_CHARSET;
2049 else if (EQ (val, Qthai))
2050 logfont->lfCharSet = THAI_CHARSET;
2051 }
2052 else if (EQ (key, QCantialias) && SYMBOLP (val))
2053 {
2054 logfont->lfQuality = w32_antialias_type (val);
2055 }
2056 }
2057 }
2058 }
2059
2060 static void
2061 list_all_matching_fonts (struct font_callback_data *match_data)
2062 {
2063 HDC dc;
2064 Lisp_Object families = w32font_list_family (XFRAME (match_data->frame));
2065 struct frame *f = XFRAME (match_data->frame);
2066
2067 dc = get_frame_dc (f);
2068
2069 while (!NILP (families))
2070 {
2071 /* Only fonts from the current locale are given localized names
2072 on Windows, so we can keep backwards compatibility with
2073 Windows 9x/ME by using non-Unicode font enumeration without
2074 sacrificing internationalization here. */
2075 char *name;
2076 Lisp_Object family = CAR (families);
2077 families = CDR (families);
2078 if (NILP (family))
2079 continue;
2080 else if (SYMBOLP (family))
2081 name = SSDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
2082 else
2083 continue;
2084
2085 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2086 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2087
2088 EnumFontFamiliesEx (dc, &match_data->pattern,
2089 (FONTENUMPROC) add_font_entity_to_list,
2090 (LPARAM) match_data, 0);
2091 }
2092
2093 release_frame_dc (f, dc);
2094 }
2095
2096 static Lisp_Object
2097 lispy_antialias_type (BYTE type)
2098 {
2099 Lisp_Object lispy;
2100
2101 switch (type)
2102 {
2103 case NONANTIALIASED_QUALITY:
2104 lispy = Qnone;
2105 break;
2106 case ANTIALIASED_QUALITY:
2107 lispy = Qstandard;
2108 break;
2109 case CLEARTYPE_QUALITY:
2110 lispy = Qsubpixel;
2111 break;
2112 case CLEARTYPE_NATURAL_QUALITY:
2113 lispy = Qnatural;
2114 break;
2115 default:
2116 lispy = Qnil;
2117 break;
2118 }
2119 return lispy;
2120 }
2121
2122 /* Convert antialiasing symbols to lfQuality */
2123 static BYTE
2124 w32_antialias_type (Lisp_Object type)
2125 {
2126 if (EQ (type, Qnone))
2127 return NONANTIALIASED_QUALITY;
2128 else if (EQ (type, Qstandard))
2129 return ANTIALIASED_QUALITY;
2130 else if (EQ (type, Qsubpixel))
2131 return CLEARTYPE_QUALITY;
2132 else if (EQ (type, Qnatural))
2133 return CLEARTYPE_NATURAL_QUALITY;
2134 else
2135 return DEFAULT_QUALITY;
2136 }
2137
2138 /* Return a list of all the scripts that the font supports. */
2139 static Lisp_Object
2140 font_supported_scripts (FONTSIGNATURE * sig)
2141 {
2142 DWORD * subranges = sig->fsUsb;
2143 Lisp_Object supported = Qnil;
2144
2145 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2146 #define SUBRANGE(n,sym) \
2147 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2148 supported = Fcons ((sym), supported)
2149
2150 /* Match multiple subranges. SYM is set if any MASK bit is set in
2151 subranges[0 - 3]. */
2152 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2153 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2154 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2155 supported = Fcons ((sym), supported)
2156
2157 SUBRANGE (0, Qlatin);
2158 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2159 /* Most fonts that support Latin will have good coverage of the
2160 Extended blocks, so in practice marking them below is not really
2161 needed, or useful: if a font claims support for, say, Latin
2162 Extended-B, but does not contain glyphs for some of the
2163 characters in the range, the user will have to augment her
2164 fontset to display those few characters. But we mark these
2165 subranges here anyway, for the marginal use cases where they
2166 might make a difference. */
2167 SUBRANGE (1, Qlatin);
2168 SUBRANGE (2, Qlatin);
2169 SUBRANGE (3, Qlatin);
2170 SUBRANGE (4, Qphonetic);
2171 /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */
2172 SUBRANGE (7, Qgreek);
2173 SUBRANGE (8, Qcoptic);
2174 SUBRANGE (9, Qcyrillic);
2175 SUBRANGE (10, Qarmenian);
2176 SUBRANGE (11, Qhebrew);
2177 /* Bit 12 is rather useless if the user has Hebrew fonts installed,
2178 because apparently at some point in the past bit 12 was "Hebrew
2179 Extended", and many Hebrew fonts still have this bit set. The
2180 only workaround is to customize fontsets to use fonts like Ebrima
2181 or Quivira. */
2182 SUBRANGE (12, Qvai);
2183 SUBRANGE (13, Qarabic);
2184 SUBRANGE (14, Qnko);
2185 SUBRANGE (15, Qdevanagari);
2186 SUBRANGE (16, Qbengali);
2187 SUBRANGE (17, Qgurmukhi);
2188 SUBRANGE (18, Qgujarati);
2189 SUBRANGE (19, Qoriya);
2190 SUBRANGE (20, Qtamil);
2191 SUBRANGE (21, Qtelugu);
2192 SUBRANGE (22, Qkannada);
2193 SUBRANGE (23, Qmalayalam);
2194 SUBRANGE (24, Qthai);
2195 SUBRANGE (25, Qlao);
2196 SUBRANGE (26, Qgeorgian);
2197 SUBRANGE (27, Qbalinese);
2198 /* 28: Hangul Jamo -- covered by the default fontset. */
2199 /* 29: Latin Extended, 30: Greek Extended -- covered above. */
2200 /* 31: Supplemental Punctuation -- most probably be masked by
2201 Courier New, so fontset customization is needed. */
2202 SUBRANGE (31, Qsymbol);
2203 /* 32-47: Symbols (defined below). */
2204 SUBRANGE (48, Qcjk_misc);
2205 /* Match either 49: katakana or 50: hiragana for kana. */
2206 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
2207 SUBRANGE (51, Qbopomofo);
2208 /* 52: Compatibility Jamo */
2209 SUBRANGE (53, Qphags_pa);
2210 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2211 SUBRANGE (56, Qhangul);
2212 /* 57: Surrogates. */
2213 SUBRANGE (58, Qphoenician);
2214 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
2215 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2216 SUBRANGE (59, Qkanbun); /* And this. */
2217 /* These are covered well either by the default Courier New or by
2218 CJK fonts that are set up specially in the default fontset. So
2219 marking them here wouldn't be useful. */
2220 /* 60: Private use, 61: CJK strokes and compatibility. */
2221 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2222 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2223 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2224 /* 69: Specials. */
2225 SUBRANGE (70, Qtibetan);
2226 SUBRANGE (71, Qsyriac);
2227 SUBRANGE (72, Qthaana);
2228 SUBRANGE (73, Qsinhala);
2229 SUBRANGE (74, Qmyanmar);
2230 SUBRANGE (75, Qethiopic);
2231 SUBRANGE (76, Qcherokee);
2232 SUBRANGE (77, Qcanadian_aboriginal);
2233 SUBRANGE (78, Qogham);
2234 SUBRANGE (79, Qrunic);
2235 SUBRANGE (80, Qkhmer);
2236 SUBRANGE (81, Qmongolian);
2237 SUBRANGE (82, Qbraille);
2238 SUBRANGE (83, Qyi);
2239 SUBRANGE (84, Qbuhid);
2240 SUBRANGE (84, Qhanunoo);
2241 SUBRANGE (84, Qtagalog);
2242 SUBRANGE (84, Qtagbanwa);
2243 SUBRANGE (85, Qold_italic);
2244 SUBRANGE (86, Qgothic);
2245 SUBRANGE (87, Qdeseret);
2246 SUBRANGE (88, Qbyzantine_musical_symbol);
2247 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
2248 SUBRANGE (89, Qmathematical_bold); /* See fontset.el:setup-default-fontset. */
2249 SUBRANGE (89, Qmathematical_italic);
2250 SUBRANGE (89, Qmathematical_bold_italic);
2251 SUBRANGE (89, Qmathematical_script);
2252 SUBRANGE (89, Qmathematical_bold_script);
2253 SUBRANGE (89, Qmathematical_fraktur);
2254 SUBRANGE (89, Qmathematical_double_struck);
2255 SUBRANGE (89, Qmathematical_bold_fraktur);
2256 SUBRANGE (89, Qmathematical_sans_serif);
2257 SUBRANGE (89, Qmathematical_sans_serif_bold);
2258 SUBRANGE (89, Qmathematical_sans_serif_italic);
2259 SUBRANGE (89, Qmathematical_sans_serif_bold_italic);
2260 SUBRANGE (89, Qmathematical_monospace);
2261 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2262 SUBRANGE (93, Qlimbu);
2263 SUBRANGE (94, Qtai_le);
2264 SUBRANGE (95, Qtai_le);
2265 SUBRANGE (96, Qbuginese);
2266 SUBRANGE (97, Qglagolitic);
2267 SUBRANGE (98, Qtifinagh);
2268 /* 99: Yijing Hexagrams. */
2269 SUBRANGE (99, Qhan);
2270 SUBRANGE (100, Qsyloti_nagri);
2271 SUBRANGE (101, Qlinear_b);
2272 SUBRANGE (102, Qancient_greek_number);
2273 SUBRANGE (103, Qugaritic);
2274 SUBRANGE (104, Qold_persian);
2275 SUBRANGE (105, Qshavian);
2276 SUBRANGE (106, Qosmanya);
2277 SUBRANGE (107, Qcypriot);
2278 SUBRANGE (108, Qkharoshthi);
2279 SUBRANGE (109, Qtai_xuan_jing_symbol);
2280 SUBRANGE (110, Qcuneiform);
2281 SUBRANGE (111, Qcounting_rod_numeral);
2282 SUBRANGE (112, Qsundanese);
2283 SUBRANGE (113, Qlepcha);
2284 SUBRANGE (114, Qol_chiki);
2285 SUBRANGE (115, Qsaurashtra);
2286 SUBRANGE (116, Qkayah_li);
2287 SUBRANGE (117, Qrejang);
2288 SUBRANGE (118, Qcham);
2289 SUBRANGE (119, Qancient_symbol);
2290 SUBRANGE (120, Qphaistos_disc);
2291 SUBRANGE (121, Qlycian);
2292 SUBRANGE (121, Qcarian);
2293 SUBRANGE (121, Qlydian);
2294 SUBRANGE (122, Qdomino_tile);
2295 SUBRANGE (122, Qmahjong_tile);
2296 /* 123-127: Reserved. */
2297
2298 /* There isn't really a main symbol range, so include symbol if any
2299 relevant range is set. */
2300 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2301
2302 /* Missing: Tai Viet (U+AA80-U+AADF). */
2303 #undef SUBRANGE
2304 #undef MASK_ANY
2305
2306 return supported;
2307 }
2308
2309 /* Generate a full name for a Windows font.
2310 The full name is in fcname format, with weight, slant and antialiasing
2311 specified if they are not "normal". */
2312 static int
2313 w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
2314 int pixel_size, char *name, int nbytes)
2315 {
2316 int len, height, outline;
2317 char *p;
2318 Lisp_Object antialiasing, weight = Qnil;
2319
2320 len = strlen (font->lfFaceName);
2321
2322 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2323
2324 /* Represent size of scalable fonts by point size. But use pixelsize for
2325 raster fonts to indicate that they are exactly that size. */
2326 if (outline)
2327 len += 11; /* -SIZE */
2328 else
2329 len += 21;
2330
2331 if (font->lfItalic)
2332 len += 7; /* :italic */
2333
2334 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2335 {
2336 weight = w32_to_fc_weight (font->lfWeight);
2337 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
2338 }
2339
2340 antialiasing = lispy_antialias_type (font->lfQuality);
2341 if (! NILP (antialiasing))
2342 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2343
2344 /* Check that the buffer is big enough */
2345 if (len > nbytes)
2346 return -1;
2347
2348 p = name;
2349 p += sprintf (p, "%s", font->lfFaceName);
2350
2351 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2352
2353 if (height > 0)
2354 {
2355 if (outline)
2356 {
2357 float pointsize = height * 72.0 / one_w32_display_info.resy;
2358 /* Round to nearest half point. floor is used, since round is not
2359 supported in MS library. */
2360 pointsize = floor (pointsize * 2 + 0.5) / 2;
2361 p += sprintf (p, "-%1.1f", pointsize);
2362 }
2363 else
2364 p += sprintf (p, ":pixelsize=%d", height);
2365 }
2366
2367 if (SYMBOLP (weight) && ! NILP (weight))
2368 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2369
2370 if (font->lfItalic)
2371 p += sprintf (p, ":italic");
2372
2373 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2374 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2375
2376 return (p - name);
2377 }
2378
2379 /* Convert a logfont and point size into a fontconfig style font name.
2380 POINTSIZE is in tenths of points.
2381 If SIZE indicates the size of buffer FCNAME, into which the font name
2382 is written. If the buffer is not large enough to contain the name,
2383 the function returns -1, otherwise it returns the number of bytes
2384 written to FCNAME. */
2385 static int
2386 logfont_to_fcname (LOGFONT* font, int pointsize, char *fcname, int size)
2387 {
2388 int len, height;
2389 char *p = fcname;
2390 Lisp_Object weight = Qnil;
2391
2392 len = strlen (font->lfFaceName) + 2;
2393 height = pointsize / 10;
2394 while (height /= 10)
2395 len++;
2396
2397 if (pointsize % 10)
2398 len += 2;
2399
2400 if (font->lfItalic)
2401 len += 7; /* :italic */
2402 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2403 {
2404 weight = w32_to_fc_weight (font->lfWeight);
2405 len += SBYTES (SYMBOL_NAME (weight)) + 1;
2406 }
2407
2408 if (len > size)
2409 return -1;
2410
2411 p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2412 if (pointsize % 10)
2413 p += sprintf (p, ".%d", pointsize % 10);
2414
2415 if (SYMBOLP (weight) && !NILP (weight))
2416 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2417
2418 if (font->lfItalic)
2419 p += sprintf (p, ":italic");
2420
2421 return (p - fcname);
2422 }
2423
2424 static void
2425 compute_metrics (HDC dc, struct w32font_info *w32_font, unsigned int code,
2426 struct w32_metric_cache *metrics)
2427 {
2428 GLYPHMETRICS gm;
2429 MAT2 transform;
2430 unsigned int options = GGO_METRICS;
2431 INT width;
2432
2433 if (w32_font->glyph_idx)
2434 options |= GGO_GLYPH_INDEX;
2435
2436 memset (&transform, 0, sizeof (transform));
2437 transform.eM11.value = 1;
2438 transform.eM22.value = 1;
2439
2440 if (get_glyph_outline_w (dc, code, options, &gm, 0, NULL, &transform)
2441 != GDI_ERROR)
2442 {
2443 metrics->lbearing = gm.gmptGlyphOrigin.x;
2444 metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2445 metrics->width = gm.gmCellIncX;
2446 metrics->ascent = gm.gmptGlyphOrigin.y;
2447 metrics->descent = gm.gmBlackBoxY - gm.gmptGlyphOrigin.y;
2448 metrics->status = W32METRIC_SUCCESS;
2449 }
2450 else if (get_char_width_32_w (dc, code, code, &width) != 0)
2451 {
2452 metrics->lbearing = 0;
2453 metrics->rbearing = width;
2454 metrics->width = width;
2455 metrics->ascent = w32_font->font.ascent;
2456 metrics->descent = w32_font->font.descent;
2457 metrics->status = W32METRIC_SUCCESS;
2458 }
2459 else
2460 metrics->status = W32METRIC_FAIL;
2461 }
2462
2463 DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2464 doc: /* Read a font name using a W32 font selection dialog.
2465 Return fontconfig style font string corresponding to the selection.
2466
2467 If FRAME is omitted or nil, it defaults to the selected frame.
2468 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2469 in the font selection dialog. */)
2470 (Lisp_Object frame, Lisp_Object exclude_proportional)
2471 {
2472 struct frame *f = decode_window_system_frame (frame);
2473 CHOOSEFONT cf;
2474 LOGFONT lf;
2475 TEXTMETRIC tm;
2476 HDC hdc;
2477 HANDLE oldobj;
2478 char buf[100];
2479
2480 memset (&cf, 0, sizeof (cf));
2481 memset (&lf, 0, sizeof (lf));
2482
2483 cf.lStructSize = sizeof (cf);
2484 cf.hwndOwner = FRAME_W32_WINDOW (f);
2485 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2486
2487 /* If exclude_proportional is non-nil, limit the selection to
2488 monospaced fonts. */
2489 if (!NILP (exclude_proportional))
2490 cf.Flags |= CF_FIXEDPITCHONLY;
2491
2492 cf.lpLogFont = &lf;
2493
2494 /* Initialize as much of the font details as we can from the current
2495 default font. */
2496 hdc = GetDC (FRAME_W32_WINDOW (f));
2497 oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
2498 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2499 if (GetTextMetrics (hdc, &tm))
2500 {
2501 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2502 lf.lfWeight = tm.tmWeight;
2503 lf.lfItalic = tm.tmItalic;
2504 lf.lfUnderline = tm.tmUnderlined;
2505 lf.lfStrikeOut = tm.tmStruckOut;
2506 lf.lfCharSet = tm.tmCharSet;
2507 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2508 }
2509 SelectObject (hdc, oldobj);
2510 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2511
2512 if (!ChooseFont (&cf)
2513 || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
2514 return Qnil;
2515
2516 return DECODE_SYSTEM (build_string (buf));
2517 }
2518
2519 static const char *const w32font_booleans [] = {
2520 NULL,
2521 };
2522
2523 static const char *const w32font_non_booleans [] = {
2524 ":script",
2525 ":antialias",
2526 ":style",
2527 NULL,
2528 };
2529
2530 static void
2531 w32font_filter_properties (Lisp_Object font, Lisp_Object alist)
2532 {
2533 font_filter_properties (font, alist, w32font_booleans, w32font_non_booleans);
2534 }
2535
2536 struct font_driver w32font_driver =
2537 {
2538 LISP_INITIALLY_ZERO, /* Qgdi */
2539 false, /* case insensitive */
2540 w32font_get_cache,
2541 w32font_list,
2542 w32font_match,
2543 w32font_list_family,
2544 NULL, /* free_entity */
2545 w32font_open,
2546 w32font_close,
2547 NULL, /* prepare_face */
2548 NULL, /* done_face */
2549 w32font_has_char,
2550 w32font_encode_char,
2551 w32font_text_extents,
2552 w32font_draw,
2553 NULL, /* get_bitmap */
2554 NULL, /* free_bitmap */
2555 NULL, /* anchor_point */
2556 NULL, /* otf_capability */
2557 NULL, /* otf_drive */
2558 NULL, /* start_for_frame */
2559 NULL, /* end_for_frame */
2560 NULL, /* shape */
2561 NULL, /* check */
2562 NULL, /* get_variation_glyphs */
2563 w32font_filter_properties,
2564 NULL, /* cached_font_ok */
2565 };
2566
2567
2568 /* Initialize state that does not change between invocations. This is only
2569 called when Emacs is dumped. */
2570 void
2571 syms_of_w32font (void)
2572 {
2573 DEFSYM (Qgdi, "gdi");
2574 DEFSYM (Quniscribe, "uniscribe");
2575 DEFSYM (QCformat, ":format");
2576
2577 /* Generic font families. */
2578 DEFSYM (Qmonospace, "monospace");
2579 DEFSYM (Qserif, "serif");
2580 DEFSYM (Qsansserif, "sansserif");
2581 DEFSYM (Qscript, "script");
2582 DEFSYM (Qdecorative, "decorative");
2583 /* Aliases. */
2584 DEFSYM (Qsans_serif, "sans_serif");
2585 DEFSYM (Qsans, "sans");
2586 DEFSYM (Qmono, "mono");
2587
2588 /* Fake foundries. */
2589 DEFSYM (Qraster, "raster");
2590 DEFSYM (Qoutline, "outline");
2591 DEFSYM (Qunknown, "unknown");
2592
2593 /* Antialiasing. */
2594 DEFSYM (Qstandard, "standard");
2595 DEFSYM (Qsubpixel, "subpixel");
2596 DEFSYM (Qnatural, "natural");
2597
2598 /* Languages */
2599 DEFSYM (Qzh, "zh");
2600
2601 /* Scripts */
2602 DEFSYM (Qlatin, "latin");
2603 DEFSYM (Qgreek, "greek");
2604 DEFSYM (Qcoptic, "coptic");
2605 DEFSYM (Qcyrillic, "cyrillic");
2606 DEFSYM (Qarmenian, "armenian");
2607 DEFSYM (Qhebrew, "hebrew");
2608 DEFSYM (Qvai, "vai");
2609 DEFSYM (Qarabic, "arabic");
2610 DEFSYM (Qsyriac, "syriac");
2611 DEFSYM (Qnko, "nko");
2612 DEFSYM (Qthaana, "thaana");
2613 DEFSYM (Qdevanagari, "devanagari");
2614 DEFSYM (Qbengali, "bengali");
2615 DEFSYM (Qgurmukhi, "gurmukhi");
2616 DEFSYM (Qgujarati, "gujarati");
2617 DEFSYM (Qoriya, "oriya");
2618 DEFSYM (Qtamil, "tamil");
2619 DEFSYM (Qtelugu, "telugu");
2620 DEFSYM (Qkannada, "kannada");
2621 DEFSYM (Qmalayalam, "malayalam");
2622 DEFSYM (Qsinhala, "sinhala");
2623 DEFSYM (Qthai, "thai");
2624 DEFSYM (Qlao, "lao");
2625 DEFSYM (Qtibetan, "tibetan");
2626 DEFSYM (Qmyanmar, "myanmar");
2627 DEFSYM (Qgeorgian, "georgian");
2628 DEFSYM (Qhangul, "hangul");
2629 DEFSYM (Qethiopic, "ethiopic");
2630 DEFSYM (Qcherokee, "cherokee");
2631 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2632 DEFSYM (Qogham, "ogham");
2633 DEFSYM (Qrunic, "runic");
2634 DEFSYM (Qkhmer, "khmer");
2635 DEFSYM (Qmongolian, "mongolian");
2636 DEFSYM (Qbraille, "braille");
2637 DEFSYM (Qhan, "han");
2638 DEFSYM (Qideographic_description, "ideographic-description");
2639 DEFSYM (Qcjk_misc, "cjk-misc");
2640 DEFSYM (Qkana, "kana");
2641 DEFSYM (Qbopomofo, "bopomofo");
2642 DEFSYM (Qkanbun, "kanbun");
2643 DEFSYM (Qyi, "yi");
2644 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2645 DEFSYM (Qmusical_symbol, "musical-symbol");
2646 DEFSYM (Qmathematical_bold, "mathematical-bold");
2647 DEFSYM (Qmathematical_italic, "mathematical-italic");
2648 DEFSYM (Qmathematical_bold_italic, "mathematical-bold-italic");
2649 DEFSYM (Qmathematical_script, "mathematical-script");
2650 DEFSYM (Qmathematical_bold_script, "mathematical-bold-script");
2651 DEFSYM (Qmathematical_fraktur, "mathematical-fraktur");
2652 DEFSYM (Qmathematical_double_struck, "mathematical-double-struck");
2653 DEFSYM (Qmathematical_bold_fraktur, "mathematical-bold-fraktur");
2654 DEFSYM (Qmathematical_sans_serif, "mathematical-sans-serif");
2655 DEFSYM (Qmathematical_sans_serif_bold, "mathematical-sans-serif-bold");
2656 DEFSYM (Qmathematical_sans_serif_italic, "mathematical-sans-serif-italic");
2657 DEFSYM (Qmathematical_sans_serif_bold_italic, "mathematical-sans-serif-bold-italic");
2658 DEFSYM (Qmathematical_monospace, "mathematical-monospace");
2659 DEFSYM (Qcham, "cham");
2660 DEFSYM (Qphonetic, "phonetic");
2661 DEFSYM (Qbalinese, "balinese");
2662 DEFSYM (Qbuginese, "buginese");
2663 DEFSYM (Qbuhid, "buhid");
2664 DEFSYM (Qcuneiform, "cuneiform");
2665 DEFSYM (Qcypriot, "cypriot");
2666 DEFSYM (Qdeseret, "deseret");
2667 DEFSYM (Qglagolitic, "glagolitic");
2668 DEFSYM (Qgothic, "gothic");
2669 DEFSYM (Qhanunoo, "hanunoo");
2670 DEFSYM (Qkharoshthi, "kharoshthi");
2671 DEFSYM (Qlimbu, "limbu");
2672 DEFSYM (Qlinear_b, "linear_b");
2673 DEFSYM (Qold_italic, "old_italic");
2674 DEFSYM (Qold_persian, "old_persian");
2675 DEFSYM (Qosmanya, "osmanya");
2676 DEFSYM (Qphags_pa, "phags-pa");
2677 DEFSYM (Qphoenician, "phoenician");
2678 DEFSYM (Qshavian, "shavian");
2679 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2680 DEFSYM (Qtagalog, "tagalog");
2681 DEFSYM (Qtagbanwa, "tagbanwa");
2682 DEFSYM (Qtai_le, "tai_le");
2683 DEFSYM (Qtifinagh, "tifinagh");
2684 DEFSYM (Qugaritic, "ugaritic");
2685 DEFSYM (Qlycian, "lycian");
2686 DEFSYM (Qcarian, "carian");
2687 DEFSYM (Qlydian, "lydian");
2688 DEFSYM (Qdomino_tile, "domino-tile");
2689 DEFSYM (Qmahjong_tile, "mahjong-tile");
2690 DEFSYM (Qtai_xuan_jing_symbol, "tai-xuan-jing-symbol");
2691 DEFSYM (Qcounting_rod_numeral, "counting-rod-numeral");
2692 DEFSYM (Qancient_symbol, "ancient-symbol");
2693 DEFSYM (Qphaistos_disc, "phaistos-disc");
2694 DEFSYM (Qancient_greek_number, "ancient-greek-number");
2695 DEFSYM (Qsundanese, "sundanese");
2696 DEFSYM (Qlepcha, "lepcha");
2697 DEFSYM (Qol_chiki, "ol-chiki");
2698 DEFSYM (Qsaurashtra, "saurashtra");
2699 DEFSYM (Qkayah_li, "kayah-li");
2700 DEFSYM (Qrejang, "rejang");
2701
2702 /* W32 font encodings. */
2703 DEFVAR_LISP ("w32-charset-info-alist",
2704 Vw32_charset_info_alist,
2705 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2706 Each entry should be of the form:
2707
2708 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2709
2710 where CHARSET_NAME is a string used in font names to identify the charset,
2711 WINDOWS_CHARSET is a symbol that can be one of:
2712
2713 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2714 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2715 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2716 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2717 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2718 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2719 or w32-charset-oem.
2720
2721 CODEPAGE should be an integer specifying the codepage that should be used
2722 to display the character set, t to do no translation and output as Unicode,
2723 or nil to do no translation and output as 8 bit (or multibyte on far-east
2724 versions of Windows) characters. */);
2725 Vw32_charset_info_alist = Qnil;
2726
2727 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2728 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2729 DEFSYM (Qw32_charset_default, "w32-charset-default");
2730 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2731 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2732 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2733 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2734 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2735 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2736 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2737 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2738 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2739 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2740 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2741 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2742 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2743 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2744 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2745 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2746
2747 defsubr (&Sx_select_font);
2748
2749 w32font_driver.type = Qgdi;
2750 register_font_driver (&w32font_driver, NULL);
2751 }
2752
2753 void
2754 globals_of_w32font (void)
2755 {
2756 #ifdef WINDOWSNT
2757 g_b_init_get_outline_metrics_w = 0;
2758 g_b_init_get_text_metrics_w = 0;
2759 g_b_init_get_glyph_outline_w = 0;
2760 g_b_init_get_char_width_32_w = 0;
2761 #endif
2762 }