]> code.delx.au - gnu-emacs/blob - src/w32font.c
Ibuffer change marks
[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_char_width_32_w;
106
107 typedef UINT (WINAPI * GetOutlineTextMetricsW_Proc) (
108 HDC hdc,
109 UINT cbData,
110 LPOUTLINETEXTMETRICW lpotmw);
111 typedef BOOL (WINAPI * GetTextMetricsW_Proc) (
112 HDC hdc,
113 LPTEXTMETRICW lptmw);
114 typedef DWORD (WINAPI * GetGlyphOutlineW_Proc) (
115 HDC hdc,
116 UINT uChar,
117 UINT uFormat,
118 LPGLYPHMETRICS lpgm,
119 DWORD cbBuffer,
120 LPVOID lpvBuffer,
121 const MAT2 *lpmat2);
122 typedef BOOL (WINAPI * GetCharWidth32W_Proc) (
123 HDC hdc,
124 UINT uFirstChar,
125 UINT uLastChar,
126 LPINT lpBuffer);
127
128 /* Several "wide" functions we use to support the font backends are
129 unavailable on Windows 9X, unless UNICOWS.DLL is installed (their
130 versions in the default libraries are non-functional stubs). On NT
131 and later systems, these functions are in GDI32.DLL. The following
132 helper function attempts to load UNICOWS.DLL on Windows 9X, and
133 refuses to let Emacs start up if that library is not found. On NT
134 and later versions, it simply loads GDI32.DLL, which should always
135 be available. */
136 static HMODULE
137 w32_load_unicows_or_gdi32 (void)
138 {
139 return maybe_load_unicows_dll ();
140 }
141
142 /* The following 3 functions call the problematic "wide" APIs via
143 function pointers, to avoid linking against the non-standard
144 libunicows on W9X. */
145 static UINT WINAPI
146 get_outline_metrics_w(HDC hdc, UINT cbData, LPOUTLINETEXTMETRICW lpotmw)
147 {
148 static GetOutlineTextMetricsW_Proc s_pfn_Get_Outline_Text_MetricsW = NULL;
149 HMODULE hm_unicows = NULL;
150 if (g_b_init_get_outline_metrics_w == 0)
151 {
152 g_b_init_get_outline_metrics_w = 1;
153 hm_unicows = w32_load_unicows_or_gdi32 ();
154 if (hm_unicows)
155 s_pfn_Get_Outline_Text_MetricsW = (GetOutlineTextMetricsW_Proc)
156 GetProcAddress (hm_unicows, "GetOutlineTextMetricsW");
157 }
158 eassert (s_pfn_Get_Outline_Text_MetricsW != NULL);
159 return s_pfn_Get_Outline_Text_MetricsW (hdc, cbData, lpotmw);
160 }
161
162 static BOOL WINAPI
163 get_text_metrics_w(HDC hdc, LPTEXTMETRICW lptmw)
164 {
165 static GetTextMetricsW_Proc s_pfn_Get_Text_MetricsW = NULL;
166 HMODULE hm_unicows = NULL;
167 if (g_b_init_get_text_metrics_w == 0)
168 {
169 g_b_init_get_text_metrics_w = 1;
170 hm_unicows = w32_load_unicows_or_gdi32 ();
171 if (hm_unicows)
172 s_pfn_Get_Text_MetricsW = (GetTextMetricsW_Proc)
173 GetProcAddress (hm_unicows, "GetTextMetricsW");
174 }
175 eassert (s_pfn_Get_Text_MetricsW != NULL);
176 return s_pfn_Get_Text_MetricsW (hdc, lptmw);
177 }
178
179 static DWORD WINAPI
180 get_glyph_outline_w (HDC hdc, UINT uChar, UINT uFormat, LPGLYPHMETRICS lpgm,
181 DWORD cbBuffer, LPVOID lpvBuffer, const MAT2 *lpmat2)
182 {
183 static GetGlyphOutlineW_Proc s_pfn_Get_Glyph_OutlineW = NULL;
184 HMODULE hm_unicows = NULL;
185 if (g_b_init_get_glyph_outline_w == 0)
186 {
187 g_b_init_get_glyph_outline_w = 1;
188 hm_unicows = w32_load_unicows_or_gdi32 ();
189 if (hm_unicows)
190 s_pfn_Get_Glyph_OutlineW = (GetGlyphOutlineW_Proc)
191 GetProcAddress (hm_unicows, "GetGlyphOutlineW");
192 }
193 eassert (s_pfn_Get_Glyph_OutlineW != NULL);
194 return s_pfn_Get_Glyph_OutlineW (hdc, uChar, uFormat, lpgm, cbBuffer,
195 lpvBuffer, lpmat2);
196 }
197
198 static DWORD WINAPI
199 get_char_width_32_w (HDC hdc, UINT uFirstChar, UINT uLastChar, LPINT lpBuffer)
200 {
201 static GetCharWidth32W_Proc s_pfn_Get_Char_Width_32W = NULL;
202 HMODULE hm_unicows = NULL;
203 if (g_b_init_get_char_width_32_w == 0)
204 {
205 g_b_init_get_char_width_32_w = 1;
206 hm_unicows = w32_load_unicows_or_gdi32 ();
207 if (hm_unicows)
208 s_pfn_Get_Char_Width_32W = (GetCharWidth32W_Proc)
209 GetProcAddress (hm_unicows, "GetCharWidth32W");
210 }
211 eassert (s_pfn_Get_Char_Width_32W != NULL);
212 return s_pfn_Get_Char_Width_32W (hdc, uFirstChar, uLastChar, lpBuffer);
213 }
214
215 #else /* Cygwin */
216
217 /* Cygwin doesn't support Windows 9X, and links against GDI32.DLL, so
218 it can just call these functions directly. */
219 #define get_outline_metrics_w(h,d,o) GetOutlineTextMetricsW(h,d,o)
220 #define get_text_metrics_w(h,t) GetTextMetricsW(h,t)
221 #define get_glyph_outline_w(h,uc,f,gm,b,v,m) \
222 GetGlyphOutlineW(h,uc,f,gm,b,v,m)
223 #define get_char_width_32_w(h,fc,lc,b) GetCharWidth32W(h,fc,lc,b)
224
225 #endif /* Cygwin */
226
227 static int
228 memq_no_quit (Lisp_Object elt, Lisp_Object list)
229 {
230 while (CONSP (list) && ! EQ (XCAR (list), elt))
231 list = XCDR (list);
232 return (CONSP (list));
233 }
234
235 Lisp_Object
236 intern_font_name (char * string)
237 {
238 Lisp_Object str = DECODE_SYSTEM (build_string (string));
239 ptrdiff_t len = SCHARS (str);
240 Lisp_Object obarray = check_obarray (Vobarray);
241 Lisp_Object tem = oblookup (obarray, SSDATA (str), len, len);
242 /* This code is similar to intern function from lread.c. */
243 return SYMBOLP (tem) ? tem : intern_driver (str, obarray, tem);
244 }
245
246 /* w32 implementation of get_cache for font backend.
247 Return a cache of font-entities on FRAME. The cache must be a
248 cons whose cdr part is the actual cache area. */
249 Lisp_Object
250 w32font_get_cache (struct frame *f)
251 {
252 struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
253
254 return (dpyinfo->name_list_element);
255 }
256
257 /* w32 implementation of list for font backend.
258 List fonts exactly matching with FONT_SPEC on FRAME. The value
259 is a vector of font-entities. This is the sole API that
260 allocates font-entities. */
261 static Lisp_Object
262 w32font_list (struct frame *f, Lisp_Object font_spec)
263 {
264 Lisp_Object fonts = w32font_list_internal (f, font_spec, 0);
265 FONT_ADD_LOG ("w32font-list", font_spec, fonts);
266 return fonts;
267 }
268
269 /* w32 implementation of match for font backend.
270 Return a font entity most closely matching with FONT_SPEC on
271 FRAME. The closeness is determined by the font backend, thus
272 `face-font-selection-order' is ignored here. */
273 static Lisp_Object
274 w32font_match (struct frame *f, Lisp_Object font_spec)
275 {
276 Lisp_Object entity = w32font_match_internal (f, font_spec, 0);
277 FONT_ADD_LOG ("w32font-match", font_spec, entity);
278 return entity;
279 }
280
281 /* w32 implementation of list_family for font backend.
282 List available families. The value is a list of family names
283 (symbols). */
284 static Lisp_Object
285 w32font_list_family (struct frame *f)
286 {
287 Lisp_Object list = Qnil;
288 LOGFONT font_match_pattern;
289 HDC dc;
290
291 memset (&font_match_pattern, 0, sizeof (font_match_pattern));
292 font_match_pattern.lfCharSet = DEFAULT_CHARSET;
293
294 dc = get_frame_dc (f);
295
296 EnumFontFamiliesEx (dc, &font_match_pattern,
297 (FONTENUMPROC) add_font_name_to_list,
298 (LPARAM) &list, 0);
299 release_frame_dc (f, dc);
300
301 return list;
302 }
303
304 /* w32 implementation of open for font backend.
305 Open a font specified by FONT_ENTITY on frame F.
306 If the font is scalable, open it with PIXEL_SIZE. */
307 static Lisp_Object
308 w32font_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
309 {
310 Lisp_Object font_object
311 = font_make_object (VECSIZE (struct w32font_info),
312 font_entity, pixel_size);
313 struct w32font_info *w32_font
314 = (struct w32font_info *) XFONT_OBJECT (font_object);
315
316 ASET (font_object, FONT_TYPE_INDEX, Qgdi);
317
318 if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
319 {
320 return Qnil;
321 }
322
323 /* GDI backend does not use glyph indices. */
324 w32_font->glyph_idx = 0;
325
326 return font_object;
327 }
328
329 /* w32 implementation of close for font_backend. */
330 void
331 w32font_close (struct font *font)
332 {
333 struct w32font_info *w32_font = (struct w32font_info *) font;
334
335 if (w32_font->hfont)
336 {
337 /* Delete the GDI font object. */
338 DeleteObject (w32_font->hfont);
339 w32_font->hfont = NULL;
340
341 /* Free all the cached metrics. */
342 if (w32_font->cached_metrics)
343 {
344 int i;
345
346 for (i = 0; i < w32_font->n_cache_blocks; i++)
347 xfree (w32_font->cached_metrics[i]);
348 xfree (w32_font->cached_metrics);
349 w32_font->cached_metrics = NULL;
350 }
351 }
352 }
353
354 /* w32 implementation of has_char for font backend.
355 Optional.
356 If FONT_ENTITY has a glyph for character C (Unicode code point),
357 return 1. If not, return 0. If a font must be opened to check
358 it, return -1. */
359 int
360 w32font_has_char (Lisp_Object entity, int c)
361 {
362 /* We can't be certain about which characters a font will support until
363 we open it. Checking the scripts that the font supports turns out
364 to not be reliable. */
365 return -1;
366
367 #if 0
368 Lisp_Object supported_scripts, extra, script;
369 DWORD mask;
370
371 extra = AREF (entity, FONT_EXTRA_INDEX);
372 if (!CONSP (extra))
373 return -1;
374
375 supported_scripts = assq_no_quit (QCscript, extra);
376 /* If font doesn't claim to support any scripts, then we can't be certain
377 until we open it. */
378 if (!CONSP (supported_scripts))
379 return -1;
380
381 supported_scripts = XCDR (supported_scripts);
382
383 script = CHAR_TABLE_REF (Vchar_script_table, c);
384
385 /* If we don't know what script the character is from, then we can't be
386 certain until we open it. Also if the font claims support for the script
387 the character is from, it may only have partial coverage, so we still
388 can't be certain until we open the font. */
389 if (NILP (script) || memq_no_quit (script, supported_scripts))
390 return -1;
391
392 /* Font reports what scripts it supports, and none of them are the script
393 the character is from. But we still can't be certain, as some fonts
394 will contain some/most/all of the characters in that script without
395 claiming support for it. */
396 return -1;
397 #endif
398 }
399
400 /* w32 implementation of encode_char for font backend.
401 Return a glyph code of FONT for character C (Unicode code point).
402 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
403
404 For speed, the gdi backend uses Unicode (Emacs calls encode_char
405 far too often for it to be efficient). But we still need to detect
406 which characters are not supported by the font.
407 */
408 static unsigned
409 w32font_encode_char (struct font *font, int c)
410 {
411 struct w32font_info * w32_font = (struct w32font_info *)font;
412
413 if (c < w32_font->metrics.tmFirstChar
414 || c > w32_font->metrics.tmLastChar)
415 return FONT_INVALID_CODE;
416 else
417 return c;
418 }
419
420 /* w32 implementation of text_extents for font backend.
421 Perform the size computation of glyphs of FONT and fillin members
422 of METRICS. The glyphs are specified by their glyph codes in
423 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
424 case just return the overall width. */
425 void
426 w32font_text_extents (struct font *font, unsigned *code,
427 int nglyphs, struct font_metrics *metrics)
428 {
429 int i;
430 HFONT old_font = NULL;
431 HDC dc = NULL;
432 struct frame * f;
433 int total_width = 0;
434 WORD *wcode;
435 SIZE size;
436 bool first;
437
438 struct w32font_info *w32_font = (struct w32font_info *) font;
439
440 memset (metrics, 0, sizeof (struct font_metrics));
441
442 for (i = 0, first = true; i < nglyphs; i++)
443 {
444 struct w32_metric_cache *char_metric;
445 int block = *(code + i) / CACHE_BLOCKSIZE;
446 int pos_in_block = *(code + i) % CACHE_BLOCKSIZE;
447
448 if (block >= w32_font->n_cache_blocks)
449 {
450 if (!w32_font->cached_metrics)
451 w32_font->cached_metrics
452 = xmalloc ((block + 1)
453 * sizeof (struct w32_metric_cache *));
454 else
455 w32_font->cached_metrics
456 = xrealloc (w32_font->cached_metrics,
457 (block + 1)
458 * sizeof (struct w32_metric_cache *));
459 memset (w32_font->cached_metrics + w32_font->n_cache_blocks, 0,
460 ((block + 1 - w32_font->n_cache_blocks)
461 * sizeof (struct w32_metric_cache *)));
462 w32_font->n_cache_blocks = block + 1;
463 }
464
465 if (!w32_font->cached_metrics[block])
466 {
467 w32_font->cached_metrics[block]
468 = xzalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
469 }
470
471 char_metric = w32_font->cached_metrics[block] + pos_in_block;
472
473 if (char_metric->status == W32METRIC_NO_ATTEMPT)
474 {
475 if (dc == NULL)
476 {
477 /* TODO: Frames can come and go, and their fonts
478 outlive them. So we can't cache the frame in the
479 font structure. Use selected_frame until the API
480 is updated to pass in a frame. */
481 f = XFRAME (selected_frame);
482
483 dc = get_frame_dc (f);
484 old_font = SelectObject (dc, w32_font->hfont);
485 }
486 compute_metrics (dc, w32_font, *(code + i), char_metric);
487 }
488
489 if (char_metric->status == W32METRIC_SUCCESS)
490 {
491 if (first)
492 {
493 metrics->lbearing = char_metric->lbearing;
494 metrics->rbearing = char_metric->rbearing;
495 metrics->width = 0;
496 metrics->ascent = char_metric->ascent;
497 metrics->descent = char_metric->descent;
498 first = false;
499 }
500 if (metrics->lbearing > char_metric->lbearing)
501 metrics->lbearing = char_metric->lbearing;
502 if (metrics->rbearing < char_metric->rbearing)
503 metrics->rbearing = char_metric->rbearing;
504 metrics->width += char_metric->width;
505 if (metrics->ascent < char_metric->ascent)
506 metrics->ascent = char_metric->ascent;
507 if (metrics->descent < char_metric->descent)
508 metrics->descent = char_metric->descent;
509 }
510 else
511 /* If we couldn't get metrics for a char,
512 use alternative method. */
513 break;
514 }
515 /* If we got through everything, return. */
516 if (i == nglyphs)
517 {
518 if (dc != NULL)
519 {
520 /* Restore state and release DC. */
521 SelectObject (dc, old_font);
522 release_frame_dc (f, dc);
523 }
524 return;
525 }
526
527 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
528 fallback on other methods that will at least give some of the metric
529 information. */
530
531 /* Make array big enough to hold surrogates. */
532 wcode = alloca (nglyphs * sizeof (WORD) * 2);
533 for (i = 0; i < nglyphs; i++)
534 {
535 if (code[i] < 0x10000)
536 wcode[i] = code[i];
537 else
538 {
539 DWORD surrogate = code[i] - 0x10000;
540
541 /* High surrogate: U+D800 - U+DBFF. */
542 wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
543 /* Low surrogate: U+DC00 - U+DFFF. */
544 wcode[i] = 0xDC00 + (surrogate & 0x03FF);
545 /* An extra glyph. wcode is already double the size of code to
546 cope with this. */
547 nglyphs++;
548 }
549 }
550
551 if (dc == NULL)
552 {
553 /* TODO: Frames can come and go, and their fonts outlive
554 them. So we can't cache the frame in the font structure. Use
555 selected_frame until the API is updated to pass in a
556 frame. */
557 f = XFRAME (selected_frame);
558
559 dc = get_frame_dc (f);
560 old_font = SelectObject (dc, w32_font->hfont);
561 }
562
563 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
564 {
565 total_width = size.cx;
566 }
567
568 /* On 95/98/ME, only some Unicode functions are available, so fallback
569 on doing a dummy draw to find the total width. */
570 if (!total_width)
571 {
572 RECT rect;
573 rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
574 DrawTextW (dc, wcode, nglyphs, &rect,
575 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
576 total_width = rect.right;
577 }
578
579 /* Give our best estimate of the metrics, based on what we know. */
580 metrics->width = total_width - w32_font->metrics.tmOverhang;
581 metrics->lbearing = 0;
582 metrics->rbearing = total_width;
583 metrics->ascent = font->ascent;
584 metrics->descent = font->descent;
585
586 /* Restore state and release DC. */
587 SelectObject (dc, old_font);
588 release_frame_dc (f, dc);
589 }
590
591 /* w32 implementation of draw for font backend.
592 Optional.
593 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
594 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
595 fill the background in advance. It is assured that WITH_BACKGROUND
596 is false when (FROM > 0 || TO < S->nchars).
597
598 TODO: Currently this assumes that the colors and fonts are already
599 set in the DC. This seems to be true now, but maybe only due to
600 the old font code setting it up. It may be safer to resolve faces
601 and fonts in here and set them explicitly
602 */
603
604 int
605 w32font_draw (struct glyph_string *s, int from, int to,
606 int x, int y, bool with_background)
607 {
608 UINT options;
609 HRGN orig_clip = NULL;
610 int len = to - from;
611 struct w32font_info *w32font = (struct w32font_info *) s->font;
612
613 options = w32font->glyph_idx;
614
615 if (s->num_clips > 0)
616 {
617 HRGN new_clip = CreateRectRgnIndirect (s->clip);
618
619 /* Save clip region for later restoration. */
620 orig_clip = CreateRectRgn (0, 0, 0, 0);
621 if (!GetClipRgn (s->hdc, orig_clip))
622 {
623 DeleteObject (orig_clip);
624 orig_clip = NULL;
625 }
626
627 if (s->num_clips > 1)
628 {
629 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
630
631 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
632 DeleteObject (clip2);
633 }
634
635 SelectClipRgn (s->hdc, new_clip);
636 DeleteObject (new_clip);
637 }
638
639 /* Using OPAQUE background mode can clear more background than expected
640 when Cleartype is used. Draw the background manually to avoid this. */
641 SetBkMode (s->hdc, TRANSPARENT);
642 if (with_background)
643 {
644 HBRUSH brush;
645 RECT rect;
646 struct font *font = s->font;
647 int ascent = font->ascent, descent = font->descent;
648
649 /* Font's global ascent and descent values might be
650 preposterously large for some fonts. We fix here the case
651 when those fonts are used for display of glyphless
652 characters, because drawing background with font dimensions
653 in those cases makes the display illegible. There's only one
654 more call to the draw method with with_background set to
655 true, and that's in x_draw_glyph_string_foreground, when
656 drawing the cursor, where we have no such heuristics
657 available. FIXME. */
658 if (s->first_glyph->type == GLYPHLESS_GLYPH
659 && (s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE
660 || s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM))
661 {
662 ascent =
663 s->first_glyph->slice.glyphless.lower_yoff
664 - s->first_glyph->slice.glyphless.upper_yoff;
665 descent = 0;
666 }
667 brush = CreateSolidBrush (s->gc->background);
668 rect.left = x;
669 rect.top = y - ascent;
670 rect.right = x + s->width;
671 rect.bottom = y + descent;
672 FillRect (s->hdc, &rect, brush);
673 DeleteObject (brush);
674 }
675
676 if (s->padding_p)
677 {
678 int i;
679
680 for (i = 0; i < len; i++)
681 ExtTextOutW (s->hdc, x + i, y, options, NULL,
682 s->char2b + from + i, 1, NULL);
683 }
684 else
685 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, len, NULL);
686
687 /* Restore clip region. */
688 if (s->num_clips > 0)
689 SelectClipRgn (s->hdc, orig_clip);
690
691 if (orig_clip)
692 DeleteObject (orig_clip);
693
694 return len;
695 }
696
697 /* w32 implementation of free_entity for font backend.
698 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
699 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
700 static void
701 w32font_free_entity (Lisp_Object entity);
702 */
703
704 /* w32 implementation of prepare_face for font backend.
705 Optional (if FACE->extra is not used).
706 Prepare FACE for displaying characters by FONT on frame F by
707 storing some data in FACE->extra. If successful, return 0.
708 Otherwise, return -1.
709 static int
710 w32font_prepare_face (struct frame *f, struct face *face);
711 */
712 /* w32 implementation of done_face for font backend.
713 Optional.
714 Done FACE for displaying characters by FACE->font on frame F.
715 static void
716 w32font_done_face (struct frame *f, struct face *face); */
717
718 /* w32 implementation of get_bitmap for font backend.
719 Optional.
720 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
721 intended that this method is called from the other font-driver
722 for actual drawing.
723 static int
724 w32font_get_bitmap (struct font *font, unsigned code,
725 struct font_bitmap *bitmap, int bits_per_pixel);
726 */
727 /* w32 implementation of free_bitmap for font backend.
728 Optional.
729 Free bitmap data in BITMAP.
730 static void
731 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
732 */
733 /* w32 implementation of anchor_point for font backend.
734 Optional.
735 Get coordinates of the INDEXth anchor point of the glyph whose
736 code is CODE. Store the coordinates in *X and *Y. Return 0 if
737 the operations was successful. Otherwise return -1.
738 static int
739 w32font_anchor_point (struct font *font, unsigned code,
740 int index, int *x, int *y);
741 */
742 /* w32 implementation of otf_capability for font backend.
743 Optional.
744 Return a list describing which scripts/languages FONT
745 supports by which GSUB/GPOS features of OpenType tables.
746 static Lisp_Object
747 w32font_otf_capability (struct font *font);
748 */
749 /* w32 implementation of otf_drive for font backend.
750 Optional.
751 Apply FONT's OTF-FEATURES to the glyph string.
752
753 FEATURES specifies which OTF features to apply in this format:
754 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
755 See the documentation of `font-drive-otf' for the detail.
756
757 This method applies the specified features to the codes in the
758 elements of GSTRING-IN (between FROMth and TOth). The output
759 codes are stored in GSTRING-OUT at the IDXth element and the
760 following elements.
761
762 Return the number of output codes. If none of the features are
763 applicable to the input data, return 0. If GSTRING-OUT is too
764 short, return -1.
765 static int
766 w32font_otf_drive (struct font *font, Lisp_Object features,
767 Lisp_Object gstring_in, int from, int to,
768 Lisp_Object gstring_out, int idx,
769 bool alternate_subst);
770 */
771
772 /* Internal implementation of w32font_list.
773 Additional parameter opentype_only restricts the returned fonts to
774 opentype fonts, which can be used with the Uniscribe backend. */
775 Lisp_Object
776 w32font_list_internal (struct frame *f, Lisp_Object font_spec,
777 bool opentype_only)
778 {
779 struct font_callback_data match_data;
780 HDC dc;
781
782 match_data.orig_font_spec = font_spec;
783 match_data.list = Qnil;
784 XSETFRAME (match_data.frame, f);
785
786 memset (&match_data.pattern, 0, sizeof (LOGFONT));
787 fill_in_logfont (f, &match_data.pattern, font_spec);
788
789 /* If the charset is unrecognized, then we won't find a font, so don't
790 waste time looking for one. */
791 if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
792 {
793 Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
794 if (!NILP (spec_charset)
795 && !EQ (spec_charset, Qiso10646_1)
796 && !EQ (spec_charset, Qunicode_bmp)
797 && !EQ (spec_charset, Qunicode_sip)
798 && !EQ (spec_charset, Qunknown)
799 && !EQ (spec_charset, Qascii_0))
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 (char *)"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, "*-#%d", 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, "*-#%d", 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 double 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 }