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