Fix the MSDOS build broken by 2010-09-26T15:18:47Z!larsi@gnus.org.
[emacs.git] / src / w32font.c
blob46fca5d78d5ad4ad3cd4e7966162cc89b9f8407e
1 /* Font backend for the Microsoft W32 API.
2 Copyright (C) 2007, 2008, 2009, 2010 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
9 (at 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 <math.h>
22 #include <ctype.h>
23 #include <commdlg.h>
24 #include <setjmp.h>
26 #include "lisp.h"
27 #include "w32term.h"
28 #include "frame.h"
29 #include "dispextern.h"
30 #include "character.h"
31 #include "charset.h"
32 #include "coding.h"
33 #include "fontset.h"
34 #include "font.h"
35 #include "w32font.h"
37 /* Cleartype available on Windows XP, cleartype_natural from XP SP1.
38 The latter does not try to fit cleartype smoothed fonts into the
39 same bounding box as the non-antialiased version of the font.
41 #ifndef CLEARTYPE_QUALITY
42 #define CLEARTYPE_QUALITY 5
43 #endif
44 #ifndef CLEARTYPE_NATURAL_QUALITY
45 #define CLEARTYPE_NATURAL_QUALITY 6
46 #endif
48 /* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
49 of MSVC headers. */
50 #ifndef VIETNAMESE_CHARSET
51 #define VIETNAMESE_CHARSET 163
52 #endif
53 #ifndef JOHAB_CHARSET
54 #define JOHAB_CHARSET 130
55 #endif
57 extern struct font_driver w32font_driver;
59 Lisp_Object Qgdi;
60 Lisp_Object Quniscribe;
61 static Lisp_Object QCformat;
62 static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif;
63 static Lisp_Object Qserif, Qscript, Qdecorative;
64 static Lisp_Object Qraster, Qoutline, Qunknown;
66 /* antialiasing */
67 extern Lisp_Object QCantialias, QCotf, QClang; /* defined in font.c */
68 extern Lisp_Object Qnone; /* reuse from w32fns.c */
69 static Lisp_Object Qstandard, Qsubpixel, Qnatural;
71 /* languages */
72 static Lisp_Object Qzh;
74 /* scripts */
75 static Lisp_Object Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
76 static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
77 static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
78 static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
79 static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
80 static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
81 static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
82 static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
83 static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
84 static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
85 /* Not defined in characters.el, but referenced in fontset.el. */
86 static Lisp_Object Qbalinese, Qbuginese, Qbuhid, Qcuneiform, Qcypriot;
87 static Lisp_Object Qdeseret, Qglagolitic, Qgothic, Qhanunoo, Qkharoshthi;
88 static Lisp_Object Qlimbu, Qlinear_b, Qold_italic, Qold_persian, Qosmanya;
89 static Lisp_Object Qphags_pa, Qphoenician, Qshavian, Qsyloti_nagri;
90 static Lisp_Object Qtagalog, Qtagbanwa, Qtai_le, Qtifinagh, Qugaritic;
92 /* W32 charsets: for use in Vw32_charset_info_alist. */
93 static Lisp_Object Qw32_charset_ansi, Qw32_charset_default;
94 static Lisp_Object Qw32_charset_symbol, Qw32_charset_shiftjis;
95 static Lisp_Object Qw32_charset_hangeul, Qw32_charset_gb2312;
96 static Lisp_Object Qw32_charset_chinesebig5, Qw32_charset_oem;
97 static Lisp_Object Qw32_charset_easteurope, Qw32_charset_turkish;
98 static Lisp_Object Qw32_charset_baltic, Qw32_charset_russian;
99 static Lisp_Object Qw32_charset_arabic, Qw32_charset_greek;
100 static Lisp_Object Qw32_charset_hebrew, Qw32_charset_vietnamese;
101 static Lisp_Object Qw32_charset_thai, Qw32_charset_johab, Qw32_charset_mac;
103 /* Associative list linking character set strings to Windows codepages. */
104 static Lisp_Object Vw32_charset_info_alist;
106 /* Font spacing symbols - defined in font.c. */
107 extern Lisp_Object Qc, Qp, Qm;
109 static void fill_in_logfont (FRAME_PTR, LOGFONT *, Lisp_Object);
111 static BYTE w32_antialias_type (Lisp_Object);
112 static Lisp_Object lispy_antialias_type (BYTE);
114 static Lisp_Object font_supported_scripts (FONTSIGNATURE *);
115 static int w32font_full_name (LOGFONT *, Lisp_Object, int, char *, int);
116 static void compute_metrics (HDC, struct w32font_info *, unsigned int,
117 struct w32_metric_cache *);
119 static Lisp_Object w32_registry (LONG, DWORD);
121 /* EnumFontFamiliesEx callbacks. */
122 static int CALLBACK add_font_entity_to_list (ENUMLOGFONTEX *,
123 NEWTEXTMETRICEX *,
124 DWORD, LPARAM);
125 static int CALLBACK add_one_font_entity_to_list (ENUMLOGFONTEX *,
126 NEWTEXTMETRICEX *,
127 DWORD, LPARAM);
128 static int CALLBACK add_font_name_to_list (ENUMLOGFONTEX *,
129 NEWTEXTMETRICEX *,
130 DWORD, LPARAM);
132 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
133 of what we really want. */
134 struct font_callback_data
136 /* The logfont we are matching against. EnumFontFamiliesEx only matches
137 face name and charset, so we need to manually match everything else
138 in the callback function. */
139 LOGFONT pattern;
140 /* The original font spec or entity. */
141 Lisp_Object orig_font_spec;
142 /* The frame the font is being loaded on. */
143 Lisp_Object frame;
144 /* The list to add matches to. */
145 Lisp_Object list;
146 /* Whether to match only opentype fonts. */
147 int opentype_only;
150 /* Handles the problem that EnumFontFamiliesEx will not return all
151 style variations if the font name is not specified. */
152 static void list_all_matching_fonts (struct font_callback_data *);
155 static int
156 memq_no_quit (Lisp_Object elt, Lisp_Object list)
158 while (CONSP (list) && ! EQ (XCAR (list), elt))
159 list = XCDR (list);
160 return (CONSP (list));
163 Lisp_Object
164 intern_font_name (char * string)
166 Lisp_Object obarray, tem, str;
167 int len;
169 str = DECODE_SYSTEM (build_string (string));
170 len = SCHARS (str);
172 /* The following code is copied from the function intern (in lread.c). */
173 obarray = Vobarray;
174 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
175 obarray = check_obarray (obarray);
176 tem = oblookup (obarray, SDATA (str), len, len);
177 if (SYMBOLP (tem))
178 return tem;
179 return Fintern (str, obarray);
182 /* w32 implementation of get_cache for font backend.
183 Return a cache of font-entities on FRAME. The cache must be a
184 cons whose cdr part is the actual cache area. */
185 Lisp_Object
186 w32font_get_cache (FRAME_PTR f)
188 struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
190 return (dpyinfo->name_list_element);
193 /* w32 implementation of list for font backend.
194 List fonts exactly matching with FONT_SPEC on FRAME. The value
195 is a vector of font-entities. This is the sole API that
196 allocates font-entities. */
197 static Lisp_Object
198 w32font_list (Lisp_Object frame, Lisp_Object font_spec)
200 Lisp_Object fonts = w32font_list_internal (frame, font_spec, 0);
201 FONT_ADD_LOG ("w32font-list", font_spec, fonts);
202 return fonts;
205 /* w32 implementation of match for font backend.
206 Return a font entity most closely matching with FONT_SPEC on
207 FRAME. The closeness is detemined by the font backend, thus
208 `face-font-selection-order' is ignored here. */
209 static Lisp_Object
210 w32font_match (Lisp_Object frame, Lisp_Object font_spec)
212 Lisp_Object entity = w32font_match_internal (frame, font_spec, 0);
213 FONT_ADD_LOG ("w32font-match", font_spec, entity);
214 return entity;
217 /* w32 implementation of list_family for font backend.
218 List available families. The value is a list of family names
219 (symbols). */
220 static Lisp_Object
221 w32font_list_family (Lisp_Object frame)
223 Lisp_Object list = Qnil;
224 LOGFONT font_match_pattern;
225 HDC dc;
226 FRAME_PTR f = XFRAME (frame);
228 memset (&font_match_pattern, 0, sizeof (font_match_pattern));
229 font_match_pattern.lfCharSet = DEFAULT_CHARSET;
231 dc = get_frame_dc (f);
233 EnumFontFamiliesEx (dc, &font_match_pattern,
234 (FONTENUMPROC) add_font_name_to_list,
235 (LPARAM) &list, 0);
236 release_frame_dc (f, dc);
238 return list;
241 /* w32 implementation of open for font backend.
242 Open a font specified by FONT_ENTITY on frame F.
243 If the font is scalable, open it with PIXEL_SIZE. */
244 static Lisp_Object
245 w32font_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
247 Lisp_Object font_object
248 = font_make_object (VECSIZE (struct w32font_info),
249 font_entity, pixel_size);
250 struct w32font_info *w32_font
251 = (struct w32font_info *) XFONT_OBJECT (font_object);
253 ASET (font_object, FONT_TYPE_INDEX, Qgdi);
255 if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
257 return Qnil;
260 /* GDI backend does not use glyph indices. */
261 w32_font->glyph_idx = 0;
263 return font_object;
266 /* w32 implementation of close for font_backend.
267 Close FONT on frame F. */
268 void
269 w32font_close (FRAME_PTR f, struct font *font)
271 int i;
272 struct w32font_info *w32_font = (struct w32font_info *) font;
274 /* Delete the GDI font object. */
275 DeleteObject (w32_font->hfont);
277 /* Free all the cached metrics. */
278 if (w32_font->cached_metrics)
280 for (i = 0; i < w32_font->n_cache_blocks; i++)
282 xfree (w32_font->cached_metrics[i]);
284 xfree (w32_font->cached_metrics);
285 w32_font->cached_metrics = NULL;
289 /* w32 implementation of has_char for font backend.
290 Optional.
291 If FONT_ENTITY has a glyph for character C (Unicode code point),
292 return 1. If not, return 0. If a font must be opened to check
293 it, return -1. */
295 w32font_has_char (Lisp_Object entity, int c)
297 /* We can't be certain about which characters a font will support until
298 we open it. Checking the scripts that the font supports turns out
299 to not be reliable. */
300 return -1;
302 #if 0
303 Lisp_Object supported_scripts, extra, script;
304 DWORD mask;
306 extra = AREF (entity, FONT_EXTRA_INDEX);
307 if (!CONSP (extra))
308 return -1;
310 supported_scripts = assq_no_quit (QCscript, extra);
311 /* If font doesn't claim to support any scripts, then we can't be certain
312 until we open it. */
313 if (!CONSP (supported_scripts))
314 return -1;
316 supported_scripts = XCDR (supported_scripts);
318 script = CHAR_TABLE_REF (Vchar_script_table, c);
320 /* If we don't know what script the character is from, then we can't be
321 certain until we open it. Also if the font claims support for the script
322 the character is from, it may only have partial coverage, so we still
323 can't be certain until we open the font. */
324 if (NILP (script) || memq_no_quit (script, supported_scripts))
325 return -1;
327 /* Font reports what scripts it supports, and none of them are the script
328 the character is from. But we still can't be certain, as some fonts
329 will contain some/most/all of the characters in that script without
330 claiming support for it. */
331 return -1;
332 #endif
335 /* w32 implementation of encode_char for font backend.
336 Return a glyph code of FONT for characer C (Unicode code point).
337 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
339 For speed, the gdi backend uses unicode (Emacs calls encode_char
340 far too often for it to be efficient). But we still need to detect
341 which characters are not supported by the font.
343 static unsigned
344 w32font_encode_char (struct font *font, int c)
346 struct w32font_info * w32_font = (struct w32font_info *)font;
348 if (c < w32_font->metrics.tmFirstChar
349 || c > w32_font->metrics.tmLastChar)
350 return FONT_INVALID_CODE;
351 else
352 return c;
355 /* w32 implementation of text_extents for font backend.
356 Perform the size computation of glyphs of FONT and fillin members
357 of METRICS. The glyphs are specified by their glyph codes in
358 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
359 case just return the overall width. */
361 w32font_text_extents (struct font *font, unsigned *code,
362 int nglyphs, struct font_metrics *metrics)
364 int i;
365 HFONT old_font = NULL;
366 HDC dc = NULL;
367 struct frame * f;
368 int total_width = 0;
369 WORD *wcode;
370 SIZE size;
372 struct w32font_info *w32_font = (struct w32font_info *) font;
374 if (metrics)
376 memset (metrics, 0, sizeof (struct font_metrics));
377 metrics->ascent = font->ascent;
378 metrics->descent = font->descent;
380 for (i = 0; i < nglyphs; i++)
382 struct w32_metric_cache *char_metric;
383 int block = *(code + i) / CACHE_BLOCKSIZE;
384 int pos_in_block = *(code + i) % CACHE_BLOCKSIZE;
386 if (block >= w32_font->n_cache_blocks)
388 if (!w32_font->cached_metrics)
389 w32_font->cached_metrics
390 = xmalloc ((block + 1)
391 * sizeof (struct w32_metric_cache *));
392 else
393 w32_font->cached_metrics
394 = xrealloc (w32_font->cached_metrics,
395 (block + 1)
396 * sizeof (struct w32_metric_cache *));
397 memset (w32_font->cached_metrics + w32_font->n_cache_blocks, 0,
398 ((block + 1 - w32_font->n_cache_blocks)
399 * sizeof (struct w32_metric_cache *)));
400 w32_font->n_cache_blocks = block + 1;
403 if (!w32_font->cached_metrics[block])
405 w32_font->cached_metrics[block]
406 = xmalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
407 memset (w32_font->cached_metrics[block], 0,
408 CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
411 char_metric = w32_font->cached_metrics[block] + pos_in_block;
413 if (char_metric->status == W32METRIC_NO_ATTEMPT)
415 if (dc == NULL)
417 /* TODO: Frames can come and go, and their fonts
418 outlive them. So we can't cache the frame in the
419 font structure. Use selected_frame until the API
420 is updated to pass in a frame. */
421 f = XFRAME (selected_frame);
423 dc = get_frame_dc (f);
424 old_font = SelectObject (dc, w32_font->hfont);
426 compute_metrics (dc, w32_font, *(code + i), char_metric);
429 if (char_metric->status == W32METRIC_SUCCESS)
431 metrics->lbearing = min (metrics->lbearing,
432 metrics->width + char_metric->lbearing);
433 metrics->rbearing = max (metrics->rbearing,
434 metrics->width + char_metric->rbearing);
435 metrics->width += char_metric->width;
437 else
438 /* If we couldn't get metrics for a char,
439 use alternative method. */
440 break;
442 /* If we got through everything, return. */
443 if (i == nglyphs)
445 if (dc != NULL)
447 /* Restore state and release DC. */
448 SelectObject (dc, old_font);
449 release_frame_dc (f, dc);
452 return metrics->width;
456 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
457 fallback on other methods that will at least give some of the metric
458 information. */
460 /* Make array big enough to hold surrogates. */
461 wcode = alloca (nglyphs * sizeof (WORD) * 2);
462 for (i = 0; i < nglyphs; i++)
464 if (code[i] < 0x10000)
465 wcode[i] = code[i];
466 else
468 DWORD surrogate = code[i] - 0x10000;
470 /* High surrogate: U+D800 - U+DBFF. */
471 wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
472 /* Low surrogate: U+DC00 - U+DFFF. */
473 wcode[i] = 0xDC00 + (surrogate & 0x03FF);
474 /* An extra glyph. wcode is already double the size of code to
475 cope with this. */
476 nglyphs++;
480 if (dc == NULL)
482 /* TODO: Frames can come and go, and their fonts outlive
483 them. So we can't cache the frame in the font structure. Use
484 selected_frame until the API is updated to pass in a
485 frame. */
486 f = XFRAME (selected_frame);
488 dc = get_frame_dc (f);
489 old_font = SelectObject (dc, w32_font->hfont);
492 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
494 total_width = size.cx;
497 /* On 95/98/ME, only some unicode functions are available, so fallback
498 on doing a dummy draw to find the total width. */
499 if (!total_width)
501 RECT rect;
502 rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
503 DrawTextW (dc, wcode, nglyphs, &rect,
504 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
505 total_width = rect.right;
508 /* Give our best estimate of the metrics, based on what we know. */
509 if (metrics)
511 metrics->width = total_width - w32_font->metrics.tmOverhang;
512 metrics->lbearing = 0;
513 metrics->rbearing = total_width;
516 /* Restore state and release DC. */
517 SelectObject (dc, old_font);
518 release_frame_dc (f, dc);
520 return total_width;
523 /* w32 implementation of draw for font backend.
524 Optional.
525 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
526 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
527 is nonzero, fill the background in advance. It is assured that
528 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
530 TODO: Currently this assumes that the colors and fonts are already
531 set in the DC. This seems to be true now, but maybe only due to
532 the old font code setting it up. It may be safer to resolve faces
533 and fonts in here and set them explicitly
537 w32font_draw (struct glyph_string *s, int from, int to,
538 int x, int y, int with_background)
540 UINT options;
541 HRGN orig_clip = NULL;
542 struct w32font_info *w32font = (struct w32font_info *) s->font;
544 options = w32font->glyph_idx;
546 if (s->num_clips > 0)
548 HRGN new_clip = CreateRectRgnIndirect (s->clip);
550 /* Save clip region for later restoration. */
551 orig_clip = CreateRectRgn (0, 0, 0, 0);
552 if (!GetClipRgn (s->hdc, orig_clip))
554 DeleteObject (orig_clip);
555 orig_clip = NULL;
558 if (s->num_clips > 1)
560 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
562 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
563 DeleteObject (clip2);
566 SelectClipRgn (s->hdc, new_clip);
567 DeleteObject (new_clip);
570 /* Using OPAQUE background mode can clear more background than expected
571 when Cleartype is used. Draw the background manually to avoid this. */
572 SetBkMode (s->hdc, TRANSPARENT);
573 if (with_background)
575 HBRUSH brush;
576 RECT rect;
577 struct font *font = s->font;
579 brush = CreateSolidBrush (s->gc->background);
580 rect.left = x;
581 rect.top = y - font->ascent;
582 rect.right = x + s->width;
583 rect.bottom = y + font->descent;
584 FillRect (s->hdc, &rect, brush);
585 DeleteObject (brush);
588 if (s->padding_p)
590 int len = to - from, i;
592 for (i = 0; i < len; i++)
593 ExtTextOutW (s->hdc, x + i, y, options, NULL,
594 s->char2b + from + i, 1, NULL);
596 else
597 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, to - from, NULL);
599 /* Restore clip region. */
600 if (s->num_clips > 0)
601 SelectClipRgn (s->hdc, orig_clip);
603 if (orig_clip)
604 DeleteObject (orig_clip);
607 /* w32 implementation of free_entity for font backend.
608 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
609 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
610 static void
611 w32font_free_entity (Lisp_Object entity);
614 /* w32 implementation of prepare_face for font backend.
615 Optional (if FACE->extra is not used).
616 Prepare FACE for displaying characters by FONT on frame F by
617 storing some data in FACE->extra. If successful, return 0.
618 Otherwise, return -1.
619 static int
620 w32font_prepare_face (FRAME_PTR f, struct face *face);
622 /* w32 implementation of done_face for font backend.
623 Optional.
624 Done FACE for displaying characters by FACE->font on frame F.
625 static void
626 w32font_done_face (FRAME_PTR f, struct face *face); */
628 /* w32 implementation of get_bitmap for font backend.
629 Optional.
630 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
631 intended that this method is called from the other font-driver
632 for actual drawing.
633 static int
634 w32font_get_bitmap (struct font *font, unsigned code,
635 struct font_bitmap *bitmap, int bits_per_pixel);
637 /* w32 implementation of free_bitmap for font backend.
638 Optional.
639 Free bitmap data in BITMAP.
640 static void
641 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
643 /* w32 implementation of get_outline for font backend.
644 Optional.
645 Return an outline data for glyph-code CODE of FONT. The format
646 of the outline data depends on the font-driver.
647 static void *
648 w32font_get_outline (struct font *font, unsigned code);
650 /* w32 implementation of free_outline for font backend.
651 Optional.
652 Free OUTLINE (that is obtained by the above method).
653 static void
654 w32font_free_outline (struct font *font, void *outline);
656 /* w32 implementation of anchor_point for font backend.
657 Optional.
658 Get coordinates of the INDEXth anchor point of the glyph whose
659 code is CODE. Store the coordinates in *X and *Y. Return 0 if
660 the operations was successfull. Otherwise return -1.
661 static int
662 w32font_anchor_point (struct font *font, unsigned code,
663 int index, int *x, int *y);
665 /* w32 implementation of otf_capability for font backend.
666 Optional.
667 Return a list describing which scripts/languages FONT
668 supports by which GSUB/GPOS features of OpenType tables.
669 static Lisp_Object
670 w32font_otf_capability (struct font *font);
672 /* w32 implementation of otf_drive for font backend.
673 Optional.
674 Apply FONT's OTF-FEATURES to the glyph string.
676 FEATURES specifies which OTF features to apply in this format:
677 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
678 See the documentation of `font-drive-otf' for the detail.
680 This method applies the specified features to the codes in the
681 elements of GSTRING-IN (between FROMth and TOth). The output
682 codes are stored in GSTRING-OUT at the IDXth element and the
683 following elements.
685 Return the number of output codes. If none of the features are
686 applicable to the input data, return 0. If GSTRING-OUT is too
687 short, return -1.
688 static int
689 w32font_otf_drive (struct font *font, Lisp_Object features,
690 Lisp_Object gstring_in, int from, int to,
691 Lisp_Object gstring_out, int idx,
692 int alternate_subst);
695 /* Internal implementation of w32font_list.
696 Additional parameter opentype_only restricts the returned fonts to
697 opentype fonts, which can be used with the Uniscribe backend. */
698 Lisp_Object
699 w32font_list_internal (Lisp_Object frame, Lisp_Object font_spec, int opentype_only)
701 struct font_callback_data match_data;
702 HDC dc;
703 FRAME_PTR f = XFRAME (frame);
705 match_data.orig_font_spec = font_spec;
706 match_data.list = Qnil;
707 match_data.frame = frame;
709 memset (&match_data.pattern, 0, sizeof (LOGFONT));
710 fill_in_logfont (f, &match_data.pattern, font_spec);
712 /* If the charset is unrecognized, then we won't find a font, so don't
713 waste time looking for one. */
714 if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
716 Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
717 if (!NILP (spec_charset)
718 && !EQ (spec_charset, Qiso10646_1)
719 && !EQ (spec_charset, Qunicode_bmp)
720 && !EQ (spec_charset, Qunicode_sip)
721 && !EQ (spec_charset, Qunknown))
722 return Qnil;
725 match_data.opentype_only = opentype_only;
726 if (opentype_only)
727 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
729 if (match_data.pattern.lfFaceName[0] == '\0')
731 /* EnumFontFamiliesEx does not take other fields into account if
732 font name is blank, so need to use two passes. */
733 list_all_matching_fonts (&match_data);
735 else
737 dc = get_frame_dc (f);
739 EnumFontFamiliesEx (dc, &match_data.pattern,
740 (FONTENUMPROC) add_font_entity_to_list,
741 (LPARAM) &match_data, 0);
742 release_frame_dc (f, dc);
745 return match_data.list;
748 /* Internal implementation of w32font_match.
749 Additional parameter opentype_only restricts the returned fonts to
750 opentype fonts, which can be used with the Uniscribe backend. */
751 Lisp_Object
752 w32font_match_internal (Lisp_Object frame, Lisp_Object font_spec, int opentype_only)
754 struct font_callback_data match_data;
755 HDC dc;
756 FRAME_PTR f = XFRAME (frame);
758 match_data.orig_font_spec = font_spec;
759 match_data.frame = frame;
760 match_data.list = Qnil;
762 memset (&match_data.pattern, 0, sizeof (LOGFONT));
763 fill_in_logfont (f, &match_data.pattern, font_spec);
765 match_data.opentype_only = opentype_only;
766 if (opentype_only)
767 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
769 dc = get_frame_dc (f);
771 EnumFontFamiliesEx (dc, &match_data.pattern,
772 (FONTENUMPROC) add_one_font_entity_to_list,
773 (LPARAM) &match_data, 0);
774 release_frame_dc (f, dc);
776 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
780 w32font_open_internal (FRAME_PTR f, Lisp_Object font_entity,
781 int pixel_size, Lisp_Object font_object)
783 int len, size, i;
784 LOGFONT logfont;
785 HDC dc;
786 HFONT hfont, old_font;
787 Lisp_Object val, extra;
788 struct w32font_info *w32_font;
789 struct font * font;
790 OUTLINETEXTMETRICW* metrics = NULL;
792 w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
793 font = (struct font *) w32_font;
795 if (!font)
796 return 0;
798 memset (&logfont, 0, sizeof (logfont));
799 fill_in_logfont (f, &logfont, font_entity);
801 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
802 limitations in bitmap fonts. */
803 val = AREF (font_entity, FONT_FOUNDRY_INDEX);
804 if (!EQ (val, Qraster))
805 logfont.lfOutPrecision = OUT_TT_PRECIS;
807 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
808 if (!size)
809 size = pixel_size;
811 logfont.lfHeight = -size;
812 hfont = CreateFontIndirect (&logfont);
814 if (hfont == NULL)
815 return 0;
817 /* Get the metrics for this font. */
818 dc = get_frame_dc (f);
819 old_font = SelectObject (dc, hfont);
821 /* Try getting the outline metrics (only works for truetype fonts). */
822 len = GetOutlineTextMetricsW (dc, 0, NULL);
823 if (len)
825 metrics = (OUTLINETEXTMETRICW *) alloca (len);
826 if (GetOutlineTextMetricsW (dc, len, metrics))
827 memcpy (&w32_font->metrics, &metrics->otmTextMetrics,
828 sizeof (TEXTMETRICW));
829 else
830 metrics = NULL;
833 if (!metrics)
834 GetTextMetricsW (dc, &w32_font->metrics);
836 w32_font->cached_metrics = NULL;
837 w32_font->n_cache_blocks = 0;
839 SelectObject (dc, old_font);
840 release_frame_dc (f, dc);
842 w32_font->hfont = hfont;
845 char *name;
847 /* We don't know how much space we need for the full name, so start with
848 96 bytes and go up in steps of 32. */
849 len = 96;
850 name = alloca (len);
851 while (name && w32font_full_name (&logfont, font_entity, pixel_size,
852 name, len) < 0)
854 len += 32;
855 name = alloca (len);
857 if (name)
858 font->props[FONT_FULLNAME_INDEX]
859 = DECODE_SYSTEM (build_string (name));
860 else
861 font->props[FONT_FULLNAME_INDEX]
862 = DECODE_SYSTEM (build_string (logfont.lfFaceName));
865 font->max_width = w32_font->metrics.tmMaxCharWidth;
866 /* Parts of Emacs display assume that height = ascent + descent...
867 so height is defined later, after ascent and descent.
868 font->height = w32_font->metrics.tmHeight
869 + w32_font->metrics.tmExternalLeading;
872 font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
874 font->vertical_centering = 0;
875 font->encoding_type = 0;
876 font->baseline_offset = 0;
877 font->relative_compose = 0;
878 font->default_ascent = w32_font->metrics.tmAscent;
879 font->font_encoder = NULL;
880 font->pixel_size = size;
881 font->driver = &w32font_driver;
882 /* Use format cached during list, as the information we have access to
883 here is incomplete. */
884 extra = AREF (font_entity, FONT_EXTRA_INDEX);
885 if (CONSP (extra))
887 val = assq_no_quit (QCformat, extra);
888 if (CONSP (val))
889 font->props[FONT_FORMAT_INDEX] = XCDR (val);
890 else
891 font->props[FONT_FORMAT_INDEX] = Qunknown;
893 else
894 font->props[FONT_FORMAT_INDEX] = Qunknown;
896 font->props[FONT_FILE_INDEX] = Qnil;
897 font->encoding_charset = -1;
898 font->repertory_charset = -1;
899 /* TODO: do we really want the minimum width here, which could be negative? */
900 font->min_width = font->space_width;
901 font->ascent = w32_font->metrics.tmAscent;
902 font->descent = w32_font->metrics.tmDescent;
903 font->height = font->ascent + font->descent;
905 if (metrics)
907 font->underline_thickness = metrics->otmsUnderscoreSize;
908 font->underline_position = -metrics->otmsUnderscorePosition;
910 else
912 font->underline_thickness = 0;
913 font->underline_position = -1;
916 /* For temporary compatibility with legacy code that expects the
917 name to be usable in x-list-fonts. Eventually we expect to change
918 x-list-fonts and other places that use fonts so that this can be
919 an fcname or similar. */
920 font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
922 return 1;
925 /* Callback function for EnumFontFamiliesEx.
926 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
927 static int CALLBACK
928 add_font_name_to_list (ENUMLOGFONTEX *logical_font,
929 NEWTEXTMETRICEX *physical_font,
930 DWORD font_type, LPARAM list_object)
932 Lisp_Object* list = (Lisp_Object *) list_object;
933 Lisp_Object family;
935 /* Skip vertical fonts (intended only for printing) */
936 if (logical_font->elfLogFont.lfFaceName[0] == '@')
937 return 1;
939 family = intern_font_name (logical_font->elfLogFont.lfFaceName);
940 if (! memq_no_quit (family, *list))
941 *list = Fcons (family, *list);
943 return 1;
946 static int w32_decode_weight (int);
947 static int w32_encode_weight (int);
949 /* Convert an enumerated Windows font to an Emacs font entity. */
950 static Lisp_Object
951 w32_enumfont_pattern_entity (Lisp_Object frame,
952 ENUMLOGFONTEX *logical_font,
953 NEWTEXTMETRICEX *physical_font,
954 DWORD font_type,
955 LOGFONT *requested_font,
956 Lisp_Object backend)
958 Lisp_Object entity, tem;
959 LOGFONT *lf = (LOGFONT*) logical_font;
960 BYTE generic_type;
961 DWORD full_type = physical_font->ntmTm.ntmFlags;
963 entity = font_make_entity ();
965 ASET (entity, FONT_TYPE_INDEX, backend);
966 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
967 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
969 /* Foundry is difficult to get in readable form on Windows.
970 But Emacs crashes if it is not set, so set it to something more
971 generic. These values make xlfds compatible with Emacs 22. */
972 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
973 tem = Qraster;
974 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
975 tem = Qoutline;
976 else
977 tem = Qunknown;
979 ASET (entity, FONT_FOUNDRY_INDEX, tem);
981 /* Save the generic family in the extra info, as it is likely to be
982 useful to users looking for a close match. */
983 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
984 if (generic_type == FF_DECORATIVE)
985 tem = Qdecorative;
986 else if (generic_type == FF_MODERN)
987 tem = Qmono;
988 else if (generic_type == FF_ROMAN)
989 tem = Qserif;
990 else if (generic_type == FF_SCRIPT)
991 tem = Qscript;
992 else if (generic_type == FF_SWISS)
993 tem = Qsans;
994 else
995 tem = Qnil;
997 ASET (entity, FONT_ADSTYLE_INDEX, tem);
999 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
1000 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL));
1001 else
1002 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL));
1004 if (requested_font->lfQuality != DEFAULT_QUALITY)
1006 font_put_extra (entity, QCantialias,
1007 lispy_antialias_type (requested_font->lfQuality));
1009 ASET (entity, FONT_FAMILY_INDEX,
1010 intern_font_name (lf->lfFaceName));
1012 FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
1013 make_number (w32_decode_weight (lf->lfWeight)));
1014 FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
1015 make_number (lf->lfItalic ? 200 : 100));
1016 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1017 to get it. */
1018 FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100));
1020 if (font_type & RASTER_FONTTYPE)
1021 ASET (entity, FONT_SIZE_INDEX,
1022 make_number (physical_font->ntmTm.tmHeight
1023 + physical_font->ntmTm.tmExternalLeading));
1024 else
1025 ASET (entity, FONT_SIZE_INDEX, make_number (0));
1027 /* Cache unicode codepoints covered by this font, as there is no other way
1028 of getting this information easily. */
1029 if (font_type & TRUETYPE_FONTTYPE)
1031 tem = font_supported_scripts (&physical_font->ntmFontSig);
1032 if (!NILP (tem))
1033 font_put_extra (entity, QCscript, tem);
1036 /* This information is not fully available when opening fonts, so
1037 save it here. Only Windows 2000 and later return information
1038 about opentype and type1 fonts, so need a fallback for detecting
1039 truetype so that this information is not any worse than we could
1040 have obtained later. */
1041 if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
1042 tem = intern ("opentype");
1043 else if (font_type & TRUETYPE_FONTTYPE)
1044 tem = intern ("truetype");
1045 else if (full_type & NTM_PS_OPENTYPE)
1046 tem = intern ("postscript");
1047 else if (full_type & NTM_TYPE1)
1048 tem = intern ("type1");
1049 else if (font_type & RASTER_FONTTYPE)
1050 tem = intern ("w32bitmap");
1051 else
1052 tem = intern ("w32vector");
1054 font_put_extra (entity, QCformat, tem);
1056 return entity;
1060 /* Convert generic families to the family portion of lfPitchAndFamily. */
1061 BYTE
1062 w32_generic_family (Lisp_Object name)
1064 /* Generic families. */
1065 if (EQ (name, Qmonospace) || EQ (name, Qmono))
1066 return FF_MODERN;
1067 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
1068 return FF_SWISS;
1069 else if (EQ (name, Qserif))
1070 return FF_ROMAN;
1071 else if (EQ (name, Qdecorative))
1072 return FF_DECORATIVE;
1073 else if (EQ (name, Qscript))
1074 return FF_SCRIPT;
1075 else
1076 return FF_DONTCARE;
1079 static int
1080 logfonts_match (LOGFONT *font, LOGFONT *pattern)
1082 /* Only check height for raster fonts. */
1083 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
1084 && font->lfHeight != pattern->lfHeight)
1085 return 0;
1087 /* Have some flexibility with weights. */
1088 if (pattern->lfWeight
1089 && ((font->lfWeight < (pattern->lfWeight - 150))
1090 || font->lfWeight > (pattern->lfWeight + 150)))
1091 return 0;
1093 /* Charset and face should be OK. Italic has to be checked
1094 against the original spec, in case we don't have any preference. */
1095 return 1;
1098 /* Codepage Bitfields in FONTSIGNATURE struct. */
1099 #define CSB_JAPANESE (1 << 17)
1100 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1101 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1103 static int
1104 font_matches_spec (DWORD type, NEWTEXTMETRICEX *font,
1105 Lisp_Object spec, Lisp_Object backend,
1106 LOGFONT *logfont)
1108 Lisp_Object extra, val;
1110 /* Check italic. Can't check logfonts, since it is a boolean field,
1111 so there is no difference between "non-italic" and "don't care". */
1113 int slant = FONT_SLANT_NUMERIC (spec);
1115 if (slant >= 0
1116 && ((slant > 150 && !font->ntmTm.tmItalic)
1117 || (slant <= 150 && font->ntmTm.tmItalic)))
1118 return 0;
1121 /* Check adstyle against generic family. */
1122 val = AREF (spec, FONT_ADSTYLE_INDEX);
1123 if (!NILP (val))
1125 BYTE family = w32_generic_family (val);
1126 if (family != FF_DONTCARE
1127 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
1128 return 0;
1131 /* Check spacing */
1132 val = AREF (spec, FONT_SPACING_INDEX);
1133 if (INTEGERP (val))
1135 int spacing = XINT (val);
1136 int proportional = (spacing < FONT_SPACING_MONO);
1138 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
1139 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
1140 return 0;
1143 /* Check extra parameters. */
1144 for (extra = AREF (spec, FONT_EXTRA_INDEX);
1145 CONSP (extra); extra = XCDR (extra))
1147 Lisp_Object extra_entry;
1148 extra_entry = XCAR (extra);
1149 if (CONSP (extra_entry))
1151 Lisp_Object key = XCAR (extra_entry);
1153 val = XCDR (extra_entry);
1154 if (EQ (key, QCscript) && SYMBOLP (val))
1156 /* Only truetype fonts will have information about what
1157 scripts they support. This probably means the user
1158 will have to force Emacs to use raster, postscript
1159 or atm fonts for non-ASCII text. */
1160 if (type & TRUETYPE_FONTTYPE)
1162 Lisp_Object support
1163 = font_supported_scripts (&font->ntmFontSig);
1164 if (! memq_no_quit (val, support))
1165 return 0;
1167 else
1169 /* Return specific matches, but play it safe. Fonts
1170 that cover more than their charset would suggest
1171 are likely to be truetype or opentype fonts,
1172 covered above. */
1173 if (EQ (val, Qlatin))
1175 /* Although every charset but symbol, thai and
1176 arabic contains the basic ASCII set of latin
1177 characters, Emacs expects much more. */
1178 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
1179 return 0;
1181 else if (EQ (val, Qsymbol))
1183 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
1184 return 0;
1186 else if (EQ (val, Qcyrillic))
1188 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
1189 return 0;
1191 else if (EQ (val, Qgreek))
1193 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
1194 return 0;
1196 else if (EQ (val, Qarabic))
1198 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
1199 return 0;
1201 else if (EQ (val, Qhebrew))
1203 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
1204 return 0;
1206 else if (EQ (val, Qthai))
1208 if (font->ntmTm.tmCharSet != THAI_CHARSET)
1209 return 0;
1211 else if (EQ (val, Qkana))
1213 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1214 return 0;
1216 else if (EQ (val, Qbopomofo))
1218 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1219 return 0;
1221 else if (EQ (val, Qhangul))
1223 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1224 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1225 return 0;
1227 else if (EQ (val, Qhan))
1229 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1230 && font->ntmTm.tmCharSet != GB2312_CHARSET
1231 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1232 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1233 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1234 return 0;
1236 else
1237 /* Other scripts unlikely to be handled by non-truetype
1238 fonts. */
1239 return 0;
1242 else if (EQ (key, QClang) && SYMBOLP (val))
1244 /* Just handle the CJK languages here, as the lang
1245 parameter is used to select a font with appropriate
1246 glyphs in the cjk unified ideographs block. Other fonts
1247 support for a language can be solely determined by
1248 its character coverage. */
1249 if (EQ (val, Qja))
1251 if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1252 return 0;
1254 else if (EQ (val, Qko))
1256 if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
1257 return 0;
1259 else if (EQ (val, Qzh))
1261 if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
1262 return 0;
1264 else
1265 /* Any other language, we don't recognize it. Only the above
1266 currently appear in fontset.el, so it isn't worth
1267 creating a mapping table of codepages/scripts to languages
1268 or opening the font to see if there are any language tags
1269 in it that the W32 API does not expose. Fontset
1270 spec should have a fallback, as some backends do
1271 not recognize language at all. */
1272 return 0;
1274 else if (EQ (key, QCotf) && CONSP (val))
1276 /* OTF features only supported by the uniscribe backend. */
1277 if (EQ (backend, Quniscribe))
1279 if (!uniscribe_check_otf (logfont, val))
1280 return 0;
1282 else
1283 return 0;
1287 return 1;
1290 static int
1291 w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset)
1293 DWORD subrange1 = coverage->fsUsb[1];
1295 #define SUBRANGE1_HAN_MASK 0x08000000
1296 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1297 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1299 if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET)
1301 return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK;
1303 else if (charset == SHIFTJIS_CHARSET)
1305 return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK;
1307 else if (charset == HANGEUL_CHARSET)
1309 return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK;
1312 return 1;
1316 static int
1317 check_face_name (LOGFONT *font, char *full_name)
1319 char full_iname[LF_FULLFACESIZE+1];
1321 /* Just check for names known to cause problems, since the full name
1322 can contain expanded abbreviations, prefixed foundry, postfixed
1323 style, the latter of which sometimes differs from the style indicated
1324 in the shorter name (eg Lt becomes Light or even Extra Light) */
1326 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1327 installed, we run into problems with the Uniscribe backend which tries
1328 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1329 with Arial's characteristics, since that attempt to use Truetype works
1330 some places, but not others. */
1331 if (!xstrcasecmp (font->lfFaceName, "helvetica"))
1333 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1334 full_iname[LF_FULLFACESIZE] = 0;
1335 _strlwr (full_iname);
1336 return strstr ("helvetica", full_iname) != NULL;
1338 /* Same for Helv. */
1339 if (!xstrcasecmp (font->lfFaceName, "helv"))
1341 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1342 full_iname[LF_FULLFACESIZE] = 0;
1343 _strlwr (full_iname);
1344 return strstr ("helv", full_iname) != NULL;
1347 /* Since Times is mapped to Times New Roman, a substring
1348 match is not sufficient to filter out the bogus match. */
1349 else if (!xstrcasecmp (font->lfFaceName, "times"))
1350 return xstrcasecmp (full_name, "times") == 0;
1352 return 1;
1356 /* Callback function for EnumFontFamiliesEx.
1357 * Checks if a font matches everything we are trying to check agaist,
1358 * and if so, adds it to a list. Both the data we are checking against
1359 * and the list to which the fonts are added are passed in via the
1360 * lparam argument, in the form of a font_callback_data struct. */
1361 static int CALLBACK
1362 add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1363 NEWTEXTMETRICEX *physical_font,
1364 DWORD font_type, LPARAM lParam)
1366 struct font_callback_data *match_data
1367 = (struct font_callback_data *) lParam;
1368 Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
1369 Lisp_Object entity;
1371 int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1372 || physical_font->ntmFontSig.fsUsb[2]
1373 || physical_font->ntmFontSig.fsUsb[1]
1374 || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1376 /* Skip non matching fonts. */
1378 /* For uniscribe backend, consider only truetype or opentype fonts
1379 that have some unicode coverage. */
1380 if (match_data->opentype_only
1381 && ((!physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE
1382 && !(font_type & TRUETYPE_FONTTYPE))
1383 || !is_unicode))
1384 return 1;
1386 /* Ensure a match. */
1387 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1388 || !font_matches_spec (font_type, physical_font,
1389 match_data->orig_font_spec, backend,
1390 &logical_font->elfLogFont)
1391 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1392 match_data->pattern.lfCharSet))
1393 return 1;
1395 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1396 We limit this to raster fonts, because the test can catch some
1397 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1398 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1399 therefore get through this test. Since full names can be prefixed
1400 by a foundry, we accept raster fonts if the font name is found
1401 anywhere within the full name. */
1402 if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
1403 && !strstr (logical_font->elfFullName,
1404 logical_font->elfLogFont.lfFaceName))
1405 /* Check for well known substitutions that mess things up in the
1406 presence of Type-1 fonts of the same name. */
1407 || (!check_face_name (&logical_font->elfLogFont,
1408 logical_font->elfFullName)))
1409 return 1;
1411 /* Make a font entity for the font. */
1412 entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1413 physical_font, font_type,
1414 &match_data->pattern,
1415 backend);
1417 if (!NILP (entity))
1419 Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1420 FONT_REGISTRY_INDEX);
1422 /* iso10646-1 fonts must contain unicode mapping tables. */
1423 if (EQ (spec_charset, Qiso10646_1))
1425 if (!is_unicode)
1426 return 1;
1428 /* unicode-bmp fonts must contain characters from the BMP. */
1429 else if (EQ (spec_charset, Qunicode_bmp))
1431 if (!physical_font->ntmFontSig.fsUsb[3]
1432 && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1433 && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1434 && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1435 return 1;
1437 /* unicode-sip fonts must contain characters in unicode plane 2.
1438 so look for bit 57 (surrogates) in the Unicode subranges, plus
1439 the bits for CJK ranges that include those characters. */
1440 else if (EQ (spec_charset, Qunicode_sip))
1442 if (!physical_font->ntmFontSig.fsUsb[1] & 0x02000000
1443 || !physical_font->ntmFontSig.fsUsb[1] & 0x28000000)
1444 return 1;
1447 /* This font matches. */
1449 /* If registry was specified, ensure it is reported as the same. */
1450 if (!NILP (spec_charset))
1451 ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1453 /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1454 fonts as unicode and skip other charsets. */
1455 else if (match_data->opentype_only)
1457 if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1458 || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1459 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1460 else
1461 return 1;
1464 /* Add this font to the list. */
1465 match_data->list = Fcons (entity, match_data->list);
1467 return 1;
1470 /* Callback function for EnumFontFamiliesEx.
1471 * Terminates the search once we have a match. */
1472 static int CALLBACK
1473 add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1474 NEWTEXTMETRICEX *physical_font,
1475 DWORD font_type, LPARAM lParam)
1477 struct font_callback_data *match_data
1478 = (struct font_callback_data *) lParam;
1479 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1481 /* If we have a font in the list, terminate the search. */
1482 return NILP (match_data->list);
1485 /* Old function to convert from x to w32 charset, from w32fns.c. */
1486 static LONG
1487 x_to_w32_charset (char * lpcs)
1489 Lisp_Object this_entry, w32_charset;
1490 char *charset;
1491 int len = strlen (lpcs);
1493 /* Support "*-#nnn" format for unknown charsets. */
1494 if (strncmp (lpcs, "*-#", 3) == 0)
1495 return atoi (lpcs + 3);
1497 /* All Windows fonts qualify as unicode. */
1498 if (!strncmp (lpcs, "iso10646", 8))
1499 return DEFAULT_CHARSET;
1501 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1502 charset = alloca (len + 1);
1503 strcpy (charset, lpcs);
1504 lpcs = strchr (charset, '*');
1505 if (lpcs)
1506 *lpcs = '\0';
1508 /* Look through w32-charset-info-alist for the character set.
1509 Format of each entry is
1510 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1512 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
1514 if (NILP (this_entry))
1516 /* At startup, we want iso8859-1 fonts to come up properly. */
1517 if (xstrcasecmp (charset, "iso8859-1") == 0)
1518 return ANSI_CHARSET;
1519 else
1520 return DEFAULT_CHARSET;
1523 w32_charset = Fcar (Fcdr (this_entry));
1525 /* Translate Lisp symbol to number. */
1526 if (EQ (w32_charset, Qw32_charset_ansi))
1527 return ANSI_CHARSET;
1528 if (EQ (w32_charset, Qw32_charset_symbol))
1529 return SYMBOL_CHARSET;
1530 if (EQ (w32_charset, Qw32_charset_shiftjis))
1531 return SHIFTJIS_CHARSET;
1532 if (EQ (w32_charset, Qw32_charset_hangeul))
1533 return HANGEUL_CHARSET;
1534 if (EQ (w32_charset, Qw32_charset_chinesebig5))
1535 return CHINESEBIG5_CHARSET;
1536 if (EQ (w32_charset, Qw32_charset_gb2312))
1537 return GB2312_CHARSET;
1538 if (EQ (w32_charset, Qw32_charset_oem))
1539 return OEM_CHARSET;
1540 if (EQ (w32_charset, Qw32_charset_johab))
1541 return JOHAB_CHARSET;
1542 if (EQ (w32_charset, Qw32_charset_easteurope))
1543 return EASTEUROPE_CHARSET;
1544 if (EQ (w32_charset, Qw32_charset_turkish))
1545 return TURKISH_CHARSET;
1546 if (EQ (w32_charset, Qw32_charset_baltic))
1547 return BALTIC_CHARSET;
1548 if (EQ (w32_charset, Qw32_charset_russian))
1549 return RUSSIAN_CHARSET;
1550 if (EQ (w32_charset, Qw32_charset_arabic))
1551 return ARABIC_CHARSET;
1552 if (EQ (w32_charset, Qw32_charset_greek))
1553 return GREEK_CHARSET;
1554 if (EQ (w32_charset, Qw32_charset_hebrew))
1555 return HEBREW_CHARSET;
1556 if (EQ (w32_charset, Qw32_charset_vietnamese))
1557 return VIETNAMESE_CHARSET;
1558 if (EQ (w32_charset, Qw32_charset_thai))
1559 return THAI_CHARSET;
1560 if (EQ (w32_charset, Qw32_charset_mac))
1561 return MAC_CHARSET;
1563 return DEFAULT_CHARSET;
1567 /* Convert a Lisp font registry (symbol) to a windows charset. */
1568 static LONG
1569 registry_to_w32_charset (Lisp_Object charset)
1571 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1572 || EQ (charset, Qunicode_sip))
1573 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1574 else if (EQ (charset, Qiso8859_1))
1575 return ANSI_CHARSET;
1576 else if (SYMBOLP (charset))
1577 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
1578 else
1579 return DEFAULT_CHARSET;
1582 /* Old function to convert from w32 to x charset, from w32fns.c. */
1583 static char *
1584 w32_to_x_charset (int fncharset, char *matching)
1586 static char buf[32];
1587 Lisp_Object charset_type;
1588 int match_len = 0;
1590 if (matching)
1592 /* If fully specified, accept it as it is. Otherwise use a
1593 substring match. */
1594 char *wildcard = strchr (matching, '*');
1595 if (wildcard)
1596 *wildcard = '\0';
1597 else if (strchr (matching, '-'))
1598 return matching;
1600 match_len = strlen (matching);
1603 switch (fncharset)
1605 case ANSI_CHARSET:
1606 /* Handle startup case of w32-charset-info-alist not
1607 being set up yet. */
1608 if (NILP (Vw32_charset_info_alist))
1609 return "iso8859-1";
1610 charset_type = Qw32_charset_ansi;
1611 break;
1612 case DEFAULT_CHARSET:
1613 charset_type = Qw32_charset_default;
1614 break;
1615 case SYMBOL_CHARSET:
1616 charset_type = Qw32_charset_symbol;
1617 break;
1618 case SHIFTJIS_CHARSET:
1619 charset_type = Qw32_charset_shiftjis;
1620 break;
1621 case HANGEUL_CHARSET:
1622 charset_type = Qw32_charset_hangeul;
1623 break;
1624 case GB2312_CHARSET:
1625 charset_type = Qw32_charset_gb2312;
1626 break;
1627 case CHINESEBIG5_CHARSET:
1628 charset_type = Qw32_charset_chinesebig5;
1629 break;
1630 case OEM_CHARSET:
1631 charset_type = Qw32_charset_oem;
1632 break;
1633 case EASTEUROPE_CHARSET:
1634 charset_type = Qw32_charset_easteurope;
1635 break;
1636 case TURKISH_CHARSET:
1637 charset_type = Qw32_charset_turkish;
1638 break;
1639 case BALTIC_CHARSET:
1640 charset_type = Qw32_charset_baltic;
1641 break;
1642 case RUSSIAN_CHARSET:
1643 charset_type = Qw32_charset_russian;
1644 break;
1645 case ARABIC_CHARSET:
1646 charset_type = Qw32_charset_arabic;
1647 break;
1648 case GREEK_CHARSET:
1649 charset_type = Qw32_charset_greek;
1650 break;
1651 case HEBREW_CHARSET:
1652 charset_type = Qw32_charset_hebrew;
1653 break;
1654 case VIETNAMESE_CHARSET:
1655 charset_type = Qw32_charset_vietnamese;
1656 break;
1657 case THAI_CHARSET:
1658 charset_type = Qw32_charset_thai;
1659 break;
1660 case MAC_CHARSET:
1661 charset_type = Qw32_charset_mac;
1662 break;
1663 case JOHAB_CHARSET:
1664 charset_type = Qw32_charset_johab;
1665 break;
1667 default:
1668 /* Encode numerical value of unknown charset. */
1669 sprintf (buf, "*-#%u", fncharset);
1670 return buf;
1674 Lisp_Object rest;
1675 char * best_match = NULL;
1676 int matching_found = 0;
1678 /* Look through w32-charset-info-alist for the character set.
1679 Prefer ISO codepages, and prefer lower numbers in the ISO
1680 range. Only return charsets for codepages which are installed.
1682 Format of each entry is
1683 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1685 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1687 char * x_charset;
1688 Lisp_Object w32_charset;
1689 Lisp_Object codepage;
1691 Lisp_Object this_entry = XCAR (rest);
1693 /* Skip invalid entries in alist. */
1694 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1695 || !CONSP (XCDR (this_entry))
1696 || !SYMBOLP (XCAR (XCDR (this_entry))))
1697 continue;
1699 x_charset = SDATA (XCAR (this_entry));
1700 w32_charset = XCAR (XCDR (this_entry));
1701 codepage = XCDR (XCDR (this_entry));
1703 /* Look for Same charset and a valid codepage (or non-int
1704 which means ignore). */
1705 if (EQ (w32_charset, charset_type)
1706 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
1707 || IsValidCodePage (XINT (codepage))))
1709 /* If we don't have a match already, then this is the
1710 best. */
1711 if (!best_match)
1713 best_match = x_charset;
1714 if (matching && !strnicmp (x_charset, matching, match_len))
1715 matching_found = 1;
1717 /* If we already found a match for MATCHING, then
1718 only consider other matches. */
1719 else if (matching_found
1720 && strnicmp (x_charset, matching, match_len))
1721 continue;
1722 /* If this matches what we want, and the best so far doesn't,
1723 then this is better. */
1724 else if (!matching_found && matching
1725 && !strnicmp (x_charset, matching, match_len))
1727 best_match = x_charset;
1728 matching_found = 1;
1730 /* If this is fully specified, and the best so far isn't,
1731 then this is better. */
1732 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1733 /* If this is an ISO codepage, and the best so far isn't,
1734 then this is better, but only if it fully specifies the
1735 encoding. */
1736 || (strnicmp (best_match, "iso", 3) != 0
1737 && strnicmp (x_charset, "iso", 3) == 0
1738 && strchr (x_charset, '-')))
1739 best_match = x_charset;
1740 /* If both are ISO8859 codepages, choose the one with the
1741 lowest number in the encoding field. */
1742 else if (strnicmp (best_match, "iso8859-", 8) == 0
1743 && strnicmp (x_charset, "iso8859-", 8) == 0)
1745 int best_enc = atoi (best_match + 8);
1746 int this_enc = atoi (x_charset + 8);
1747 if (this_enc > 0 && this_enc < best_enc)
1748 best_match = x_charset;
1753 /* If no match, encode the numeric value. */
1754 if (!best_match)
1756 sprintf (buf, "*-#%u", fncharset);
1757 return buf;
1760 strncpy (buf, best_match, 31);
1761 /* If the charset is not fully specified, put -0 on the end. */
1762 if (!strchr (best_match, '-'))
1764 int pos = strlen (best_match);
1765 /* Charset specifiers shouldn't be very long. If it is a made
1766 up one, truncating it should not do any harm since it isn't
1767 recognized anyway. */
1768 if (pos > 29)
1769 pos = 29;
1770 strcpy (buf + pos, "-0");
1772 buf[31] = '\0';
1773 return buf;
1777 static Lisp_Object
1778 w32_registry (LONG w32_charset, DWORD font_type)
1780 char *charset;
1782 /* If charset is defaulted, charset is unicode or unknown, depending on
1783 font type. */
1784 if (w32_charset == DEFAULT_CHARSET)
1785 return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
1787 charset = w32_to_x_charset (w32_charset, NULL);
1788 return font_intern_prop (charset, strlen (charset), 1);
1791 static int
1792 w32_decode_weight (int fnweight)
1794 if (fnweight >= FW_HEAVY) return 210;
1795 if (fnweight >= FW_EXTRABOLD) return 205;
1796 if (fnweight >= FW_BOLD) return 200;
1797 if (fnweight >= FW_SEMIBOLD) return 180;
1798 if (fnweight >= FW_NORMAL) return 100;
1799 if (fnweight >= FW_LIGHT) return 50;
1800 if (fnweight >= FW_EXTRALIGHT) return 40;
1801 if (fnweight > FW_THIN) return 20;
1802 return 0;
1805 static int
1806 w32_encode_weight (int n)
1808 if (n >= 210) return FW_HEAVY;
1809 if (n >= 205) return FW_EXTRABOLD;
1810 if (n >= 200) return FW_BOLD;
1811 if (n >= 180) return FW_SEMIBOLD;
1812 if (n >= 100) return FW_NORMAL;
1813 if (n >= 50) return FW_LIGHT;
1814 if (n >= 40) return FW_EXTRALIGHT;
1815 if (n >= 20) return FW_THIN;
1816 return 0;
1819 /* Convert a Windows font weight into one of the weights supported
1820 by fontconfig (see font.c:font_parse_fcname). */
1821 static Lisp_Object
1822 w32_to_fc_weight (int n)
1824 if (n >= FW_EXTRABOLD) return intern ("black");
1825 if (n >= FW_BOLD) return intern ("bold");
1826 if (n >= FW_SEMIBOLD) return intern ("demibold");
1827 if (n >= FW_NORMAL) return intern ("medium");
1828 return intern ("light");
1831 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1832 static void
1833 fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
1835 Lisp_Object tmp, extra;
1836 int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
1838 tmp = AREF (font_spec, FONT_DPI_INDEX);
1839 if (INTEGERP (tmp))
1841 dpi = XINT (tmp);
1843 else if (FLOATP (tmp))
1845 dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
1848 /* Height */
1849 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1850 if (INTEGERP (tmp))
1851 logfont->lfHeight = -1 * XINT (tmp);
1852 else if (FLOATP (tmp))
1853 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
1855 /* Escapement */
1857 /* Orientation */
1859 /* Weight */
1860 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1861 if (INTEGERP (tmp))
1862 logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
1864 /* Italic */
1865 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1866 if (INTEGERP (tmp))
1868 int slant = FONT_SLANT_NUMERIC (font_spec);
1869 logfont->lfItalic = slant > 150 ? 1 : 0;
1872 /* Underline */
1874 /* Strikeout */
1876 /* Charset */
1877 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
1878 if (! NILP (tmp))
1879 logfont->lfCharSet = registry_to_w32_charset (tmp);
1880 else
1881 logfont->lfCharSet = DEFAULT_CHARSET;
1883 /* Out Precision */
1885 /* Clip Precision */
1887 /* Quality */
1888 logfont->lfQuality = DEFAULT_QUALITY;
1890 /* Generic Family and Face Name */
1891 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
1893 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
1894 if (! NILP (tmp))
1896 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
1897 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
1898 ; /* Font name was generic, don't fill in font name. */
1899 /* Font families are interned, but allow for strings also in case of
1900 user input. */
1901 else if (SYMBOLP (tmp))
1902 strncpy (logfont->lfFaceName,
1903 SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
1906 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
1907 if (!NILP (tmp))
1909 /* Override generic family. */
1910 BYTE family = w32_generic_family (tmp);
1911 if (family != FF_DONTCARE)
1912 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
1916 /* Set pitch based on the spacing property. */
1917 tmp = AREF (font_spec, FONT_SPACING_INDEX);
1918 if (INTEGERP (tmp))
1920 int spacing = XINT (tmp);
1921 if (spacing < FONT_SPACING_MONO)
1922 logfont->lfPitchAndFamily
1923 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
1924 else
1925 logfont->lfPitchAndFamily
1926 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
1929 /* Process EXTRA info. */
1930 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
1931 CONSP (extra); extra = XCDR (extra))
1933 tmp = XCAR (extra);
1934 if (CONSP (tmp))
1936 Lisp_Object key, val;
1937 key = XCAR (tmp), val = XCDR (tmp);
1938 /* Only use QCscript if charset is not provided, or is unicode
1939 and a single script is specified. This is rather crude,
1940 and is only used to narrow down the fonts returned where
1941 there is a definite match. Some scripts, such as latin, han,
1942 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1943 them. */
1944 if (EQ (key, QCscript)
1945 && logfont->lfCharSet == DEFAULT_CHARSET
1946 && SYMBOLP (val))
1948 if (EQ (val, Qgreek))
1949 logfont->lfCharSet = GREEK_CHARSET;
1950 else if (EQ (val, Qhangul))
1951 logfont->lfCharSet = HANGUL_CHARSET;
1952 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
1953 logfont->lfCharSet = SHIFTJIS_CHARSET;
1954 else if (EQ (val, Qbopomofo))
1955 logfont->lfCharSet = CHINESEBIG5_CHARSET;
1956 /* GB 18030 supports tibetan, yi, mongolian,
1957 fonts that support it should show up if we ask for
1958 GB2312 fonts. */
1959 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
1960 || EQ (val, Qmongolian))
1961 logfont->lfCharSet = GB2312_CHARSET;
1962 else if (EQ (val, Qhebrew))
1963 logfont->lfCharSet = HEBREW_CHARSET;
1964 else if (EQ (val, Qarabic))
1965 logfont->lfCharSet = ARABIC_CHARSET;
1966 else if (EQ (val, Qthai))
1967 logfont->lfCharSet = THAI_CHARSET;
1969 else if (EQ (key, QCantialias) && SYMBOLP (val))
1971 logfont->lfQuality = w32_antialias_type (val);
1977 static void
1978 list_all_matching_fonts (struct font_callback_data *match_data)
1980 HDC dc;
1981 Lisp_Object families = w32font_list_family (match_data->frame);
1982 struct frame *f = XFRAME (match_data->frame);
1984 dc = get_frame_dc (f);
1986 while (!NILP (families))
1988 /* Only fonts from the current locale are given localized names
1989 on Windows, so we can keep backwards compatibility with
1990 Windows 9x/ME by using non-Unicode font enumeration without
1991 sacrificing internationalization here. */
1992 char *name;
1993 Lisp_Object family = CAR (families);
1994 families = CDR (families);
1995 if (NILP (family))
1996 continue;
1997 else if (SYMBOLP (family))
1998 name = SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
1999 else
2000 continue;
2002 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2003 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2005 EnumFontFamiliesEx (dc, &match_data->pattern,
2006 (FONTENUMPROC) add_font_entity_to_list,
2007 (LPARAM) match_data, 0);
2010 release_frame_dc (f, dc);
2013 static Lisp_Object
2014 lispy_antialias_type (BYTE type)
2016 Lisp_Object lispy;
2018 switch (type)
2020 case NONANTIALIASED_QUALITY:
2021 lispy = Qnone;
2022 break;
2023 case ANTIALIASED_QUALITY:
2024 lispy = Qstandard;
2025 break;
2026 case CLEARTYPE_QUALITY:
2027 lispy = Qsubpixel;
2028 break;
2029 case CLEARTYPE_NATURAL_QUALITY:
2030 lispy = Qnatural;
2031 break;
2032 default:
2033 lispy = Qnil;
2034 break;
2036 return lispy;
2039 /* Convert antialiasing symbols to lfQuality */
2040 static BYTE
2041 w32_antialias_type (Lisp_Object type)
2043 if (EQ (type, Qnone))
2044 return NONANTIALIASED_QUALITY;
2045 else if (EQ (type, Qstandard))
2046 return ANTIALIASED_QUALITY;
2047 else if (EQ (type, Qsubpixel))
2048 return CLEARTYPE_QUALITY;
2049 else if (EQ (type, Qnatural))
2050 return CLEARTYPE_NATURAL_QUALITY;
2051 else
2052 return DEFAULT_QUALITY;
2055 /* Return a list of all the scripts that the font supports. */
2056 static Lisp_Object
2057 font_supported_scripts (FONTSIGNATURE * sig)
2059 DWORD * subranges = sig->fsUsb;
2060 Lisp_Object supported = Qnil;
2062 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2063 #define SUBRANGE(n,sym) \
2064 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2065 supported = Fcons ((sym), supported)
2067 /* Match multiple subranges. SYM is set if any MASK bit is set in
2068 subranges[0 - 3]. */
2069 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2070 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2071 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2072 supported = Fcons ((sym), supported)
2074 SUBRANGE (0, Qlatin);
2075 /* The following count as latin too, ASCII should be present in these fonts,
2076 so don't need to mark them separately. */
2077 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2078 SUBRANGE (4, Qphonetic);
2079 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
2080 SUBRANGE (7, Qgreek);
2081 SUBRANGE (8, Qcoptic);
2082 SUBRANGE (9, Qcyrillic);
2083 SUBRANGE (10, Qarmenian);
2084 SUBRANGE (11, Qhebrew);
2085 /* 12: Vai. */
2086 SUBRANGE (13, Qarabic);
2087 SUBRANGE (14, Qnko);
2088 SUBRANGE (15, Qdevanagari);
2089 SUBRANGE (16, Qbengali);
2090 SUBRANGE (17, Qgurmukhi);
2091 SUBRANGE (18, Qgujarati);
2092 SUBRANGE (19, Qoriya);
2093 SUBRANGE (20, Qtamil);
2094 SUBRANGE (21, Qtelugu);
2095 SUBRANGE (22, Qkannada);
2096 SUBRANGE (23, Qmalayalam);
2097 SUBRANGE (24, Qthai);
2098 SUBRANGE (25, Qlao);
2099 SUBRANGE (26, Qgeorgian);
2100 SUBRANGE (27, Qbalinese);
2101 /* 28: Hangul Jamo. */
2102 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2103 /* 32-47: Symbols (defined below). */
2104 SUBRANGE (48, Qcjk_misc);
2105 /* Match either 49: katakana or 50: hiragana for kana. */
2106 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
2107 SUBRANGE (51, Qbopomofo);
2108 /* 52: Compatibility Jamo */
2109 SUBRANGE (53, Qphags_pa);
2110 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2111 SUBRANGE (56, Qhangul);
2112 /* 57: Surrogates. */
2113 SUBRANGE (58, Qphoenician);
2114 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
2115 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2116 SUBRANGE (59, Qkanbun); /* And this. */
2117 /* 60: Private use, 61: CJK strokes and compatibility. */
2118 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2119 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2120 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2121 /* 69: Specials. */
2122 SUBRANGE (70, Qtibetan);
2123 SUBRANGE (71, Qsyriac);
2124 SUBRANGE (72, Qthaana);
2125 SUBRANGE (73, Qsinhala);
2126 SUBRANGE (74, Qmyanmar);
2127 SUBRANGE (75, Qethiopic);
2128 SUBRANGE (76, Qcherokee);
2129 SUBRANGE (77, Qcanadian_aboriginal);
2130 SUBRANGE (78, Qogham);
2131 SUBRANGE (79, Qrunic);
2132 SUBRANGE (80, Qkhmer);
2133 SUBRANGE (81, Qmongolian);
2134 SUBRANGE (82, Qbraille);
2135 SUBRANGE (83, Qyi);
2136 SUBRANGE (84, Qbuhid);
2137 SUBRANGE (84, Qhanunoo);
2138 SUBRANGE (84, Qtagalog);
2139 SUBRANGE (84, Qtagbanwa);
2140 SUBRANGE (85, Qold_italic);
2141 SUBRANGE (86, Qgothic);
2142 SUBRANGE (87, Qdeseret);
2143 SUBRANGE (88, Qbyzantine_musical_symbol);
2144 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
2145 SUBRANGE (89, Qmathematical);
2146 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2147 SUBRANGE (93, Qlimbu);
2148 SUBRANGE (94, Qtai_le);
2149 /* 95: New Tai Le */
2150 SUBRANGE (90, Qbuginese);
2151 SUBRANGE (97, Qglagolitic);
2152 SUBRANGE (98, Qtifinagh);
2153 /* 99: Yijing Hexagrams. */
2154 SUBRANGE (100, Qsyloti_nagri);
2155 SUBRANGE (101, Qlinear_b);
2156 /* 102: Ancient Greek Numbers. */
2157 SUBRANGE (103, Qugaritic);
2158 SUBRANGE (104, Qold_persian);
2159 SUBRANGE (105, Qshavian);
2160 SUBRANGE (106, Qosmanya);
2161 SUBRANGE (107, Qcypriot);
2162 SUBRANGE (108, Qkharoshthi);
2163 /* 109: Tai Xuan Jing. */
2164 SUBRANGE (110, Qcuneiform);
2165 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2166 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2167 SUBRANGE (118, Qcham);
2168 /* 119: Ancient symbols, 120: Phaistos Disc. */
2169 /* 121: Carian, Lycian, Lydian, 122: Dominos, Mah Jong tiles. */
2170 /* 123-127: Reserved. */
2172 /* There isn't really a main symbol range, so include symbol if any
2173 relevant range is set. */
2174 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2176 /* Missing: Tai Viet (U+AA80-U+AADF). */
2177 #undef SUBRANGE
2178 #undef MASK_ANY
2180 return supported;
2183 /* Generate a full name for a Windows font.
2184 The full name is in fcname format, with weight, slant and antialiasing
2185 specified if they are not "normal". */
2186 static int
2187 w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
2188 int pixel_size, char *name, int nbytes)
2190 int len, height, outline;
2191 char *p;
2192 Lisp_Object antialiasing, weight = Qnil;
2194 len = strlen (font->lfFaceName);
2196 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2198 /* Represent size of scalable fonts by point size. But use pixelsize for
2199 raster fonts to indicate that they are exactly that size. */
2200 if (outline)
2201 len += 11; /* -SIZE */
2202 else
2203 len += 21;
2205 if (font->lfItalic)
2206 len += 7; /* :italic */
2208 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2210 weight = w32_to_fc_weight (font->lfWeight);
2211 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
2214 antialiasing = lispy_antialias_type (font->lfQuality);
2215 if (! NILP (antialiasing))
2216 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2218 /* Check that the buffer is big enough */
2219 if (len > nbytes)
2220 return -1;
2222 p = name;
2223 p += sprintf (p, "%s", font->lfFaceName);
2225 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2227 if (height > 0)
2229 if (outline)
2231 float pointsize = height * 72.0 / one_w32_display_info.resy;
2232 /* Round to nearest half point. floor is used, since round is not
2233 supported in MS library. */
2234 pointsize = floor (pointsize * 2 + 0.5) / 2;
2235 p += sprintf (p, "-%1.1f", pointsize);
2237 else
2238 p += sprintf (p, ":pixelsize=%d", height);
2241 if (SYMBOLP (weight) && ! NILP (weight))
2242 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2244 if (font->lfItalic)
2245 p += sprintf (p, ":italic");
2247 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2248 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2250 return (p - name);
2253 /* Convert a logfont and point size into a fontconfig style font name.
2254 POINTSIZE is in tenths of points.
2255 If SIZE indicates the size of buffer FCNAME, into which the font name
2256 is written. If the buffer is not large enough to contain the name,
2257 the function returns -1, otherwise it returns the number of bytes
2258 written to FCNAME. */
2259 static int
2260 logfont_to_fcname (LOGFONT* font, int pointsize, char *fcname, int size)
2262 int len, height;
2263 char *p = fcname;
2264 Lisp_Object weight = Qnil;
2266 len = strlen (font->lfFaceName) + 2;
2267 height = pointsize / 10;
2268 while (height /= 10)
2269 len++;
2271 if (pointsize % 10)
2272 len += 2;
2274 if (font->lfItalic)
2275 len += 7; /* :italic */
2276 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2278 weight = w32_to_fc_weight (font->lfWeight);
2279 len += SBYTES (SYMBOL_NAME (weight)) + 1;
2282 if (len > size)
2283 return -1;
2285 p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2286 if (pointsize % 10)
2287 p += sprintf (p, ".%d", pointsize % 10);
2289 if (SYMBOLP (weight) && !NILP (weight))
2290 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2292 if (font->lfItalic)
2293 p += sprintf (p, ":italic");
2295 return (p - fcname);
2298 static void
2299 compute_metrics (HDC dc, struct w32font_info *w32_font, unsigned int code,
2300 struct w32_metric_cache *metrics)
2302 GLYPHMETRICS gm;
2303 MAT2 transform;
2304 unsigned int options = GGO_METRICS;
2306 if (w32_font->glyph_idx)
2307 options |= GGO_GLYPH_INDEX;
2309 memset (&transform, 0, sizeof (transform));
2310 transform.eM11.value = 1;
2311 transform.eM22.value = 1;
2313 if (GetGlyphOutlineW (dc, code, options, &gm, 0, NULL, &transform)
2314 != GDI_ERROR)
2316 metrics->lbearing = gm.gmptGlyphOrigin.x;
2317 metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2318 metrics->width = gm.gmCellIncX;
2319 metrics->status = W32METRIC_SUCCESS;
2321 else
2322 metrics->status = W32METRIC_FAIL;
2325 DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2326 doc: /* Read a font name using a W32 font selection dialog.
2327 Return fontconfig style font string corresponding to the selection.
2329 If FRAME is omitted or nil, it defaults to the selected frame.
2330 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2331 in the font selection dialog. */)
2332 (Lisp_Object frame, Lisp_Object exclude_proportional)
2334 FRAME_PTR f = check_x_frame (frame);
2335 CHOOSEFONT cf;
2336 LOGFONT lf;
2337 TEXTMETRIC tm;
2338 HDC hdc;
2339 HANDLE oldobj;
2340 char buf[100];
2342 memset (&cf, 0, sizeof (cf));
2343 memset (&lf, 0, sizeof (lf));
2345 cf.lStructSize = sizeof (cf);
2346 cf.hwndOwner = FRAME_W32_WINDOW (f);
2347 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2349 /* If exclude_proportional is non-nil, limit the selection to
2350 monospaced fonts. */
2351 if (!NILP (exclude_proportional))
2352 cf.Flags |= CF_FIXEDPITCHONLY;
2354 cf.lpLogFont = &lf;
2356 /* Initialize as much of the font details as we can from the current
2357 default font. */
2358 hdc = GetDC (FRAME_W32_WINDOW (f));
2359 oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
2360 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2361 if (GetTextMetrics (hdc, &tm))
2363 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2364 lf.lfWeight = tm.tmWeight;
2365 lf.lfItalic = tm.tmItalic;
2366 lf.lfUnderline = tm.tmUnderlined;
2367 lf.lfStrikeOut = tm.tmStruckOut;
2368 lf.lfCharSet = tm.tmCharSet;
2369 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2371 SelectObject (hdc, oldobj);
2372 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2374 if (!ChooseFont (&cf)
2375 || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
2376 return Qnil;
2378 return DECODE_SYSTEM (build_string (buf));
2381 struct font_driver w32font_driver =
2383 0, /* Qgdi */
2384 0, /* case insensitive */
2385 w32font_get_cache,
2386 w32font_list,
2387 w32font_match,
2388 w32font_list_family,
2389 NULL, /* free_entity */
2390 w32font_open,
2391 w32font_close,
2392 NULL, /* prepare_face */
2393 NULL, /* done_face */
2394 w32font_has_char,
2395 w32font_encode_char,
2396 w32font_text_extents,
2397 w32font_draw,
2398 NULL, /* get_bitmap */
2399 NULL, /* free_bitmap */
2400 NULL, /* get_outline */
2401 NULL, /* free_outline */
2402 NULL, /* anchor_point */
2403 NULL, /* otf_capability */
2404 NULL, /* otf_drive */
2405 NULL, /* start_for_frame */
2406 NULL, /* end_for_frame */
2407 NULL, /* shape */
2408 NULL, /* check */
2409 NULL, /* get_variation_glyphs */
2410 NULL, /* filter_properties */
2414 /* Initialize state that does not change between invocations. This is only
2415 called when Emacs is dumped. */
2416 void
2417 syms_of_w32font (void)
2419 DEFSYM (Qgdi, "gdi");
2420 DEFSYM (Quniscribe, "uniscribe");
2421 DEFSYM (QCformat, ":format");
2423 /* Generic font families. */
2424 DEFSYM (Qmonospace, "monospace");
2425 DEFSYM (Qserif, "serif");
2426 DEFSYM (Qsansserif, "sansserif");
2427 DEFSYM (Qscript, "script");
2428 DEFSYM (Qdecorative, "decorative");
2429 /* Aliases. */
2430 DEFSYM (Qsans_serif, "sans_serif");
2431 DEFSYM (Qsans, "sans");
2432 DEFSYM (Qmono, "mono");
2434 /* Fake foundries. */
2435 DEFSYM (Qraster, "raster");
2436 DEFSYM (Qoutline, "outline");
2437 DEFSYM (Qunknown, "unknown");
2439 /* Antialiasing. */
2440 DEFSYM (Qstandard, "standard");
2441 DEFSYM (Qsubpixel, "subpixel");
2442 DEFSYM (Qnatural, "natural");
2444 /* Languages */
2445 DEFSYM (Qzh, "zh");
2447 /* Scripts */
2448 DEFSYM (Qlatin, "latin");
2449 DEFSYM (Qgreek, "greek");
2450 DEFSYM (Qcoptic, "coptic");
2451 DEFSYM (Qcyrillic, "cyrillic");
2452 DEFSYM (Qarmenian, "armenian");
2453 DEFSYM (Qhebrew, "hebrew");
2454 DEFSYM (Qarabic, "arabic");
2455 DEFSYM (Qsyriac, "syriac");
2456 DEFSYM (Qnko, "nko");
2457 DEFSYM (Qthaana, "thaana");
2458 DEFSYM (Qdevanagari, "devanagari");
2459 DEFSYM (Qbengali, "bengali");
2460 DEFSYM (Qgurmukhi, "gurmukhi");
2461 DEFSYM (Qgujarati, "gujarati");
2462 DEFSYM (Qoriya, "oriya");
2463 DEFSYM (Qtamil, "tamil");
2464 DEFSYM (Qtelugu, "telugu");
2465 DEFSYM (Qkannada, "kannada");
2466 DEFSYM (Qmalayalam, "malayalam");
2467 DEFSYM (Qsinhala, "sinhala");
2468 DEFSYM (Qthai, "thai");
2469 DEFSYM (Qlao, "lao");
2470 DEFSYM (Qtibetan, "tibetan");
2471 DEFSYM (Qmyanmar, "myanmar");
2472 DEFSYM (Qgeorgian, "georgian");
2473 DEFSYM (Qhangul, "hangul");
2474 DEFSYM (Qethiopic, "ethiopic");
2475 DEFSYM (Qcherokee, "cherokee");
2476 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2477 DEFSYM (Qogham, "ogham");
2478 DEFSYM (Qrunic, "runic");
2479 DEFSYM (Qkhmer, "khmer");
2480 DEFSYM (Qmongolian, "mongolian");
2481 DEFSYM (Qsymbol, "symbol");
2482 DEFSYM (Qbraille, "braille");
2483 DEFSYM (Qhan, "han");
2484 DEFSYM (Qideographic_description, "ideographic-description");
2485 DEFSYM (Qcjk_misc, "cjk-misc");
2486 DEFSYM (Qkana, "kana");
2487 DEFSYM (Qbopomofo, "bopomofo");
2488 DEFSYM (Qkanbun, "kanbun");
2489 DEFSYM (Qyi, "yi");
2490 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2491 DEFSYM (Qmusical_symbol, "musical-symbol");
2492 DEFSYM (Qmathematical, "mathematical");
2493 DEFSYM (Qcham, "cham");
2494 DEFSYM (Qphonetic, "phonetic");
2495 DEFSYM (Qbalinese, "balinese");
2496 DEFSYM (Qbuginese, "buginese");
2497 DEFSYM (Qbuhid, "buhid");
2498 DEFSYM (Qcuneiform, "cuneiform");
2499 DEFSYM (Qcypriot, "cypriot");
2500 DEFSYM (Qdeseret, "deseret");
2501 DEFSYM (Qglagolitic, "glagolitic");
2502 DEFSYM (Qgothic, "gothic");
2503 DEFSYM (Qhanunoo, "hanunoo");
2504 DEFSYM (Qkharoshthi, "kharoshthi");
2505 DEFSYM (Qlimbu, "limbu");
2506 DEFSYM (Qlinear_b, "linear_b");
2507 DEFSYM (Qold_italic, "old_italic");
2508 DEFSYM (Qold_persian, "old_persian");
2509 DEFSYM (Qosmanya, "osmanya");
2510 DEFSYM (Qphags_pa, "phags-pa");
2511 DEFSYM (Qphoenician, "phoenician");
2512 DEFSYM (Qshavian, "shavian");
2513 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2514 DEFSYM (Qtagalog, "tagalog");
2515 DEFSYM (Qtagbanwa, "tagbanwa");
2516 DEFSYM (Qtai_le, "tai_le");
2517 DEFSYM (Qtifinagh, "tifinagh");
2518 DEFSYM (Qugaritic, "ugaritic");
2520 /* W32 font encodings. */
2521 DEFVAR_LISP ("w32-charset-info-alist",
2522 &Vw32_charset_info_alist,
2523 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2524 Each entry should be of the form:
2526 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2528 where CHARSET_NAME is a string used in font names to identify the charset,
2529 WINDOWS_CHARSET is a symbol that can be one of:
2531 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2532 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2533 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2534 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2535 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2536 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2537 or w32-charset-oem.
2539 CODEPAGE should be an integer specifying the codepage that should be used
2540 to display the character set, t to do no translation and output as Unicode,
2541 or nil to do no translation and output as 8 bit (or multibyte on far-east
2542 versions of Windows) characters. */);
2543 Vw32_charset_info_alist = Qnil;
2545 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2546 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2547 DEFSYM (Qw32_charset_default, "w32-charset-default");
2548 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2549 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2550 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2551 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2552 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2553 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2554 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2555 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2556 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2557 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2558 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2559 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2560 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2561 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2562 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2563 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2565 defsubr (&Sx_select_font);
2567 w32font_driver.type = Qgdi;
2568 register_font_driver (&w32font_driver, NULL);
2571 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2572 (do not change this comment) */