* lisp/url/url-handlers.el: No need for subr-x at run-time.
[emacs.git] / src / w32font.c
blob9cbc3ee14bb3db2721a8c926ebeff30a01bbb607
1 /* Font backend for the Microsoft Windows API.
2 Copyright (C) 2007-2018 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 <https://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 UNINIT;
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 eassume (0 <= nglyphs); /* pacify GCC warning on next line */
548 wcode = alloca (nglyphs * sizeof (WORD) * 2);
549 for (i = 0; i < nglyphs; i++)
551 if (code[i] < 0x10000)
552 wcode[i] = code[i];
553 else
555 DWORD surrogate = code[i] - 0x10000;
557 /* High surrogate: U+D800 - U+DBFF. */
558 wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
559 /* Low surrogate: U+DC00 - U+DFFF. */
560 wcode[i] = 0xDC00 + (surrogate & 0x03FF);
561 /* An extra glyph. wcode is already double the size of code to
562 cope with this. */
563 nglyphs++;
567 if (dc == NULL)
569 /* TODO: Frames can come and go, and their fonts outlive
570 them. So we can't cache the frame in the font structure. Use
571 selected_frame until the API is updated to pass in a
572 frame. */
573 f = XFRAME (selected_frame);
575 /* Prevent quitting while EnumFontFamiliesEx runs and conses the
576 list it will return. That's because get_frame_dc acquires
577 the critical section, so we cannot quit before we release it
578 in release_frame_dc. */
579 prev_quit = Vinhibit_quit;
580 Vinhibit_quit = Qt;
581 dc = get_frame_dc (f);
582 old_font = SelectObject (dc, w32_font->hfont);
585 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
587 total_width = size.cx;
590 /* On 95/98/ME, only some Unicode functions are available, so fallback
591 on doing a dummy draw to find the total width. */
592 if (!total_width)
594 RECT rect;
595 rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
596 DrawTextW (dc, wcode, nglyphs, &rect,
597 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
598 total_width = rect.right;
601 /* Give our best estimate of the metrics, based on what we know. */
602 metrics->width = total_width - w32_font->metrics.tmOverhang;
603 metrics->lbearing = 0;
604 metrics->rbearing = total_width;
605 metrics->ascent = font->ascent;
606 metrics->descent = font->descent;
608 /* Restore state and release DC. */
609 SelectObject (dc, old_font);
610 release_frame_dc (f, dc);
611 Vinhibit_quit = prev_quit;
614 /* w32 implementation of draw for font backend.
615 Optional.
616 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
617 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
618 fill the background in advance. It is assured that WITH_BACKGROUND
619 is false when (FROM > 0 || TO < S->nchars).
621 TODO: Currently this assumes that the colors and fonts are already
622 set in the DC. This seems to be true now, but maybe only due to
623 the old font code setting it up. It may be safer to resolve faces
624 and fonts in here and set them explicitly
628 w32font_draw (struct glyph_string *s, int from, int to,
629 int x, int y, bool with_background)
631 UINT options;
632 HRGN orig_clip = NULL;
633 int len = to - from;
634 struct w32font_info *w32font = (struct w32font_info *) s->font;
636 options = w32font->glyph_idx;
638 if (s->num_clips > 0)
640 HRGN new_clip = CreateRectRgnIndirect (s->clip);
642 /* Save clip region for later restoration. */
643 orig_clip = CreateRectRgn (0, 0, 0, 0);
644 if (!GetClipRgn (s->hdc, orig_clip))
646 DeleteObject (orig_clip);
647 orig_clip = NULL;
650 if (s->num_clips > 1)
652 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
654 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
655 DeleteObject (clip2);
658 SelectClipRgn (s->hdc, new_clip);
659 DeleteObject (new_clip);
662 /* Using OPAQUE background mode can clear more background than expected
663 when Cleartype is used. Draw the background manually to avoid this. */
664 SetBkMode (s->hdc, TRANSPARENT);
665 if (with_background)
667 HBRUSH brush;
668 RECT rect;
669 struct font *font = s->font;
670 int ascent = font->ascent, descent = font->descent;
672 /* Font's global ascent and descent values might be
673 preposterously large for some fonts. We fix here the case
674 when those fonts are used for display of glyphless
675 characters, because drawing background with font dimensions
676 in those cases makes the display illegible. There's only one
677 more call to the draw method with with_background set to
678 true, and that's in x_draw_glyph_string_foreground, when
679 drawing the cursor, where we have no such heuristics
680 available. FIXME. */
681 if (s->first_glyph->type == GLYPHLESS_GLYPH
682 && (s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE
683 || s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM))
685 ascent =
686 s->first_glyph->slice.glyphless.lower_yoff
687 - s->first_glyph->slice.glyphless.upper_yoff;
688 descent = 0;
690 brush = CreateSolidBrush (s->gc->background);
691 rect.left = x;
692 rect.top = y - ascent;
693 rect.right = x + s->width;
694 rect.bottom = y + descent;
695 FillRect (s->hdc, &rect, brush);
696 DeleteObject (brush);
699 if (s->padding_p)
701 int i;
703 for (i = 0; i < len; i++)
704 ExtTextOutW (s->hdc, x + i, y, options, NULL,
705 s->char2b + from + i, 1, NULL);
707 else
708 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, len, NULL);
710 /* Restore clip region. */
711 if (s->num_clips > 0)
712 SelectClipRgn (s->hdc, orig_clip);
714 if (orig_clip)
715 DeleteObject (orig_clip);
717 return len;
720 /* w32 implementation of free_entity for font backend.
721 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
722 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
723 static void
724 w32font_free_entity (Lisp_Object entity);
727 /* w32 implementation of prepare_face for font backend.
728 Optional (if FACE->extra is not used).
729 Prepare FACE for displaying characters by FONT on frame F by
730 storing some data in FACE->extra. If successful, return 0.
731 Otherwise, return -1.
732 static int
733 w32font_prepare_face (struct frame *f, struct face *face);
735 /* w32 implementation of done_face for font backend.
736 Optional.
737 Done FACE for displaying characters by FACE->font on frame F.
738 static void
739 w32font_done_face (struct frame *f, struct face *face); */
741 /* w32 implementation of get_bitmap for font backend.
742 Optional.
743 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
744 intended that this method is called from the other font-driver
745 for actual drawing.
746 static int
747 w32font_get_bitmap (struct font *font, unsigned code,
748 struct font_bitmap *bitmap, int bits_per_pixel);
750 /* w32 implementation of free_bitmap for font backend.
751 Optional.
752 Free bitmap data in BITMAP.
753 static void
754 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
756 /* w32 implementation of anchor_point for font backend.
757 Optional.
758 Get coordinates of the INDEXth anchor point of the glyph whose
759 code is CODE. Store the coordinates in *X and *Y. Return 0 if
760 the operations was successful. Otherwise return -1.
761 static int
762 w32font_anchor_point (struct font *font, unsigned code,
763 int index, int *x, int *y);
765 /* w32 implementation of otf_capability for font backend.
766 Optional.
767 Return a list describing which scripts/languages FONT
768 supports by which GSUB/GPOS features of OpenType tables.
769 static Lisp_Object
770 w32font_otf_capability (struct font *font);
772 /* w32 implementation of otf_drive for font backend.
773 Optional.
774 Apply FONT's OTF-FEATURES to the glyph string.
776 FEATURES specifies which OTF features to apply in this format:
777 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
778 See the documentation of `font-drive-otf' for the detail.
780 This method applies the specified features to the codes in the
781 elements of GSTRING-IN (between FROMth and TOth). The output
782 codes are stored in GSTRING-OUT at the IDXth element and the
783 following elements.
785 Return the number of output codes. If none of the features are
786 applicable to the input data, return 0. If GSTRING-OUT is too
787 short, return -1.
788 static int
789 w32font_otf_drive (struct font *font, Lisp_Object features,
790 Lisp_Object gstring_in, int from, int to,
791 Lisp_Object gstring_out, int idx,
792 bool alternate_subst);
795 /* Internal implementation of w32font_list.
796 Additional parameter opentype_only restricts the returned fonts to
797 opentype fonts, which can be used with the Uniscribe backend. */
798 Lisp_Object
799 w32font_list_internal (struct frame *f, Lisp_Object font_spec,
800 bool opentype_only)
802 struct font_callback_data match_data;
803 HDC dc;
805 match_data.orig_font_spec = font_spec;
806 match_data.list = Qnil;
807 XSETFRAME (match_data.frame, f);
809 memset (&match_data.pattern, 0, sizeof (LOGFONT));
810 fill_in_logfont (f, &match_data.pattern, font_spec);
812 /* If the charset is unrecognized, then we won't find a font, so don't
813 waste time looking for one. */
814 if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
816 Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
817 if (!NILP (spec_charset)
818 && !EQ (spec_charset, Qiso10646_1)
819 && !EQ (spec_charset, Qunicode_bmp)
820 && !EQ (spec_charset, Qunicode_sip)
821 && !EQ (spec_charset, Qunknown)
822 && !EQ (spec_charset, Qascii_0))
823 return Qnil;
826 match_data.opentype_only = opentype_only;
827 if (opentype_only)
828 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
830 if (match_data.pattern.lfFaceName[0] == '\0')
832 /* EnumFontFamiliesEx does not take other fields into account if
833 font name is blank, so need to use two passes. */
834 list_all_matching_fonts (&match_data);
836 else
838 Lisp_Object prev_quit = Vinhibit_quit;
840 /* Prevent quitting while EnumFontFamiliesEx runs and conses the
841 list it will return. That's because get_frame_dc acquires
842 the critical section, so we cannot quit before we release it
843 in release_frame_dc. */
844 Vinhibit_quit = Qt;
845 dc = get_frame_dc (f);
847 EnumFontFamiliesEx (dc, &match_data.pattern,
848 (FONTENUMPROC) add_font_entity_to_list,
849 (LPARAM) &match_data, 0);
850 release_frame_dc (f, dc);
851 Vinhibit_quit = prev_quit;
854 return match_data.list;
857 /* Internal implementation of w32font_match.
858 Additional parameter opentype_only restricts the returned fonts to
859 opentype fonts, which can be used with the Uniscribe backend. */
860 Lisp_Object
861 w32font_match_internal (struct frame *f, Lisp_Object font_spec,
862 bool opentype_only)
864 struct font_callback_data match_data;
865 HDC dc;
867 match_data.orig_font_spec = font_spec;
868 XSETFRAME (match_data.frame, f);
869 match_data.list = Qnil;
871 memset (&match_data.pattern, 0, sizeof (LOGFONT));
872 fill_in_logfont (f, &match_data.pattern, font_spec);
874 match_data.opentype_only = opentype_only;
875 if (opentype_only)
876 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
878 /* Prevent quitting while EnumFontFamiliesEx runs and conses the
879 list it will return. That's because get_frame_dc acquires the
880 critical section, so we cannot quit before we release it in
881 release_frame_dc. */
882 Lisp_Object prev_quit = Vinhibit_quit;
883 Vinhibit_quit = Qt;
884 dc = get_frame_dc (f);
886 EnumFontFamiliesEx (dc, &match_data.pattern,
887 (FONTENUMPROC) add_one_font_entity_to_list,
888 (LPARAM) &match_data, 0);
889 release_frame_dc (f, dc);
890 Vinhibit_quit = prev_quit;
892 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
896 w32font_open_internal (struct frame *f, Lisp_Object font_entity,
897 int pixel_size, Lisp_Object font_object)
899 int len, size;
900 LOGFONT logfont;
901 HDC dc;
902 HFONT hfont, old_font;
903 Lisp_Object val;
904 struct w32font_info *w32_font;
905 struct font * font;
906 OUTLINETEXTMETRICW* metrics = NULL;
908 w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
909 font = (struct font *) w32_font;
911 if (!font)
912 return 0;
914 memset (&logfont, 0, sizeof (logfont));
915 fill_in_logfont (f, &logfont, font_entity);
917 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
918 limitations in bitmap fonts. */
919 val = AREF (font_entity, FONT_FOUNDRY_INDEX);
920 if (!EQ (val, Qraster))
921 logfont.lfOutPrecision = OUT_TT_PRECIS;
923 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
924 if (!size)
925 size = pixel_size;
927 logfont.lfHeight = -size;
928 hfont = CreateFontIndirect (&logfont);
930 if (hfont == NULL)
931 return 0;
933 /* Get the metrics for this font. */
934 dc = get_frame_dc (f);
935 old_font = SelectObject (dc, hfont);
937 /* Try getting the outline metrics (only works for truetype fonts). */
938 len = get_outline_metrics_w (dc, 0, NULL);
939 if (len)
941 metrics = (OUTLINETEXTMETRICW *) alloca (len);
942 if (get_outline_metrics_w (dc, len, metrics))
943 memcpy (&w32_font->metrics, &metrics->otmTextMetrics,
944 sizeof (TEXTMETRICW));
945 else
946 metrics = NULL;
949 if (!metrics)
950 get_text_metrics_w (dc, &w32_font->metrics);
952 w32_font->cached_metrics = NULL;
953 w32_font->n_cache_blocks = 0;
955 SelectObject (dc, old_font);
956 release_frame_dc (f, dc);
958 w32_font->hfont = hfont;
961 char *name;
963 /* We don't know how much space we need for the full name, so start with
964 96 bytes and go up in steps of 32. */
965 len = 96;
966 name = alloca (len);
967 while (name && w32font_full_name (&logfont, font_entity, pixel_size,
968 name, len) < 0)
970 len += 32;
971 name = alloca (len);
973 if (name)
974 font->props[FONT_FULLNAME_INDEX]
975 = DECODE_SYSTEM (build_string (name));
976 else
977 font->props[FONT_FULLNAME_INDEX]
978 = DECODE_SYSTEM (build_string (logfont.lfFaceName));
981 font->max_width = w32_font->metrics.tmMaxCharWidth;
982 /* Parts of Emacs display assume that height = ascent + descent...
983 so height is defined later, after ascent and descent.
984 font->height = w32_font->metrics.tmHeight
985 + w32_font->metrics.tmExternalLeading;
988 font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
990 font->vertical_centering = 0;
991 font->baseline_offset = 0;
992 font->relative_compose = 0;
993 font->default_ascent = w32_font->metrics.tmAscent;
994 font->pixel_size = size;
995 font->driver = &w32font_driver;
996 font->encoding_charset = -1;
997 font->repertory_charset = -1;
998 /* TODO: do we really want the minimum width here, which could be negative? */
999 font->min_width = font->space_width;
1000 font->ascent = w32_font->metrics.tmAscent;
1001 font->descent = w32_font->metrics.tmDescent;
1002 font->height = font->ascent + font->descent;
1004 if (metrics)
1006 font->underline_thickness = metrics->otmsUnderscoreSize;
1007 font->underline_position = -metrics->otmsUnderscorePosition;
1009 else
1011 font->underline_thickness = 0;
1012 font->underline_position = -1;
1015 /* For temporary compatibility with legacy code that expects the
1016 name to be usable in x-list-fonts. Eventually we expect to change
1017 x-list-fonts and other places that use fonts so that this can be
1018 an fcname or similar. */
1019 font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
1021 return 1;
1024 /* Callback function for EnumFontFamiliesEx.
1025 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
1026 static int CALLBACK ALIGN_STACK
1027 add_font_name_to_list (ENUMLOGFONTEX *logical_font,
1028 NEWTEXTMETRICEX *physical_font,
1029 DWORD font_type, LPARAM list_object)
1031 Lisp_Object* list = (Lisp_Object *) list_object;
1032 Lisp_Object family;
1034 /* Skip vertical fonts (intended only for printing) */
1035 if (logical_font->elfLogFont.lfFaceName[0] == '@')
1036 return 1;
1038 family = intern_font_name (logical_font->elfLogFont.lfFaceName);
1039 if (! memq_no_quit (family, *list))
1040 *list = Fcons (family, *list);
1042 return 1;
1045 static int w32_decode_weight (int);
1046 static int w32_encode_weight (int);
1048 /* Convert an enumerated Windows font to an Emacs font entity. */
1049 static Lisp_Object
1050 w32_enumfont_pattern_entity (Lisp_Object frame,
1051 ENUMLOGFONTEX *logical_font,
1052 NEWTEXTMETRICEX *physical_font,
1053 DWORD font_type,
1054 LOGFONT *requested_font,
1055 Lisp_Object backend)
1057 Lisp_Object entity, tem;
1058 LOGFONT *lf = (LOGFONT*) logical_font;
1059 BYTE generic_type;
1060 DWORD full_type = physical_font->ntmTm.ntmFlags;
1062 entity = font_make_entity ();
1064 ASET (entity, FONT_TYPE_INDEX, backend);
1065 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
1066 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
1068 /* Foundry is difficult to get in readable form on Windows.
1069 But Emacs crashes if it is not set, so set it to something more
1070 generic. These values make xlfds compatible with Emacs 22. */
1071 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
1072 tem = Qraster;
1073 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
1074 tem = Qoutline;
1075 else
1076 tem = Qunknown;
1078 ASET (entity, FONT_FOUNDRY_INDEX, tem);
1080 /* Save the generic family in the extra info, as it is likely to be
1081 useful to users looking for a close match. */
1082 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
1083 if (generic_type == FF_DECORATIVE)
1084 tem = Qdecorative;
1085 else if (generic_type == FF_MODERN)
1086 tem = Qmono;
1087 else if (generic_type == FF_ROMAN)
1088 tem = Qserif;
1089 else if (generic_type == FF_SCRIPT)
1090 tem = Qscript;
1091 else if (generic_type == FF_SWISS)
1092 tem = Qsans;
1093 else
1094 tem = Qnil;
1096 ASET (entity, FONT_ADSTYLE_INDEX, tem);
1098 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
1099 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL));
1100 else
1101 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL));
1103 if (requested_font->lfQuality != DEFAULT_QUALITY)
1105 font_put_extra (entity, QCantialias,
1106 lispy_antialias_type (requested_font->lfQuality));
1108 ASET (entity, FONT_FAMILY_INDEX,
1109 intern_font_name (lf->lfFaceName));
1111 FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
1112 make_number (w32_decode_weight (lf->lfWeight)));
1113 FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
1114 make_number (lf->lfItalic ? 200 : 100));
1115 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1116 to get it. */
1117 FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100));
1119 if (font_type & RASTER_FONTTYPE)
1120 ASET (entity, FONT_SIZE_INDEX,
1121 make_number (physical_font->ntmTm.tmHeight
1122 + physical_font->ntmTm.tmExternalLeading));
1123 else
1124 ASET (entity, FONT_SIZE_INDEX, make_number (0));
1126 /* Cache Unicode codepoints covered by this font, as there is no other way
1127 of getting this information easily. */
1128 if (font_type & TRUETYPE_FONTTYPE)
1130 tem = font_supported_scripts (&physical_font->ntmFontSig);
1131 if (!NILP (tem))
1132 font_put_extra (entity, QCscript, tem);
1135 /* This information is not fully available when opening fonts, so
1136 save it here. Only Windows 2000 and later return information
1137 about opentype and type1 fonts, so need a fallback for detecting
1138 truetype so that this information is not any worse than we could
1139 have obtained later. */
1140 if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
1141 tem = Qopentype;
1142 else if (font_type & TRUETYPE_FONTTYPE)
1143 tem = intern ("truetype");
1144 else if (full_type & NTM_PS_OPENTYPE)
1145 tem = Qpostscript;
1146 else if (full_type & NTM_TYPE1)
1147 tem = intern ("type1");
1148 else if (font_type & RASTER_FONTTYPE)
1149 tem = intern ("w32bitmap");
1150 else
1151 tem = intern ("w32vector");
1153 font_put_extra (entity, QCformat, tem);
1155 return entity;
1159 /* Convert generic families to the family portion of lfPitchAndFamily. */
1160 static BYTE
1161 w32_generic_family (Lisp_Object name)
1163 /* Generic families. */
1164 if (EQ (name, Qmonospace) || EQ (name, Qmono))
1165 return FF_MODERN;
1166 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
1167 return FF_SWISS;
1168 else if (EQ (name, Qserif))
1169 return FF_ROMAN;
1170 else if (EQ (name, Qdecorative))
1171 return FF_DECORATIVE;
1172 else if (EQ (name, Qscript))
1173 return FF_SCRIPT;
1174 else
1175 return FF_DONTCARE;
1178 static int
1179 logfonts_match (LOGFONT *font, LOGFONT *pattern)
1181 /* Only check height for raster fonts. */
1182 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
1183 && font->lfHeight != pattern->lfHeight)
1184 return 0;
1186 /* Have some flexibility with weights. */
1187 if (pattern->lfWeight
1188 && ((font->lfWeight < (pattern->lfWeight - 150))
1189 || font->lfWeight > (pattern->lfWeight + 150)))
1190 return 0;
1192 /* Charset and face should be OK. Italic has to be checked
1193 against the original spec, in case we don't have any preference. */
1194 return 1;
1197 /* Codepage Bitfields in FONTSIGNATURE struct. */
1198 #define CSB_JAPANESE (1 << 17)
1199 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1200 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1202 static int
1203 font_matches_spec (DWORD type, NEWTEXTMETRICEX *font,
1204 Lisp_Object spec, Lisp_Object backend,
1205 LOGFONT *logfont)
1207 Lisp_Object extra, val;
1209 /* Check italic. Can't check logfonts, since it is a boolean field,
1210 so there is no difference between "non-italic" and "don't care". */
1212 int slant = FONT_SLANT_NUMERIC (spec);
1214 if (slant >= 0
1215 && ((slant > 150 && !font->ntmTm.tmItalic)
1216 || (slant <= 150 && font->ntmTm.tmItalic)))
1217 return 0;
1220 /* Check adstyle against generic family. */
1221 val = AREF (spec, FONT_ADSTYLE_INDEX);
1222 if (!NILP (val))
1224 BYTE family = w32_generic_family (val);
1225 if (family != FF_DONTCARE
1226 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
1227 return 0;
1230 /* Check spacing */
1231 val = AREF (spec, FONT_SPACING_INDEX);
1232 if (INTEGERP (val))
1234 int spacing = XINT (val);
1235 int proportional = (spacing < FONT_SPACING_MONO);
1237 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
1238 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
1239 return 0;
1242 /* Check extra parameters. */
1243 for (extra = AREF (spec, FONT_EXTRA_INDEX);
1244 CONSP (extra); extra = XCDR (extra))
1246 Lisp_Object extra_entry;
1247 extra_entry = XCAR (extra);
1248 if (CONSP (extra_entry))
1250 Lisp_Object key = XCAR (extra_entry);
1252 val = XCDR (extra_entry);
1253 if (EQ (key, QCscript) && SYMBOLP (val))
1255 /* Only truetype fonts will have information about what
1256 scripts they support. This probably means the user
1257 will have to force Emacs to use raster, PostScript
1258 or ATM fonts for non-ASCII text. */
1259 if (type & TRUETYPE_FONTTYPE)
1261 Lisp_Object support
1262 = font_supported_scripts (&font->ntmFontSig);
1263 if (! memq_no_quit (val, support))
1264 return 0;
1266 /* Avoid using non-Japanese fonts for Japanese, even
1267 if they claim they are capable, due to known
1268 breakage in Vista and Windows 7 fonts
1269 (bug#6029). */
1270 if (EQ (val, Qkana)
1271 && (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET
1272 || !(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE)))
1273 return 0;
1275 else
1277 /* Return specific matches, but play it safe. Fonts
1278 that cover more than their charset would suggest
1279 are likely to be truetype or opentype fonts,
1280 covered above. */
1281 if (EQ (val, Qlatin))
1283 /* Although every charset but symbol, thai and
1284 arabic contains the basic ASCII set of latin
1285 characters, Emacs expects much more. */
1286 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
1287 return 0;
1289 else if (EQ (val, Qsymbol))
1291 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
1292 return 0;
1294 else if (EQ (val, Qcyrillic))
1296 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
1297 return 0;
1299 else if (EQ (val, Qgreek))
1301 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
1302 return 0;
1304 else if (EQ (val, Qarabic))
1306 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
1307 return 0;
1309 else if (EQ (val, Qhebrew))
1311 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
1312 return 0;
1314 else if (EQ (val, Qthai))
1316 if (font->ntmTm.tmCharSet != THAI_CHARSET)
1317 return 0;
1319 else if (EQ (val, Qkana))
1321 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1322 return 0;
1324 else if (EQ (val, Qbopomofo))
1326 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1327 return 0;
1329 else if (EQ (val, Qhangul))
1331 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1332 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1333 return 0;
1335 else if (EQ (val, Qhan))
1337 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1338 && font->ntmTm.tmCharSet != GB2312_CHARSET
1339 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1340 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1341 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1342 return 0;
1344 else
1345 /* Other scripts unlikely to be handled by non-truetype
1346 fonts. */
1347 return 0;
1350 else if (EQ (key, QClang) && SYMBOLP (val))
1352 /* Just handle the CJK languages here, as the lang
1353 parameter is used to select a font with appropriate
1354 glyphs in the cjk unified ideographs block. Other fonts
1355 support for a language can be solely determined by
1356 its character coverage. */
1357 if (EQ (val, Qja))
1359 if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1360 return 0;
1362 else if (EQ (val, Qko))
1364 if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
1365 return 0;
1367 else if (EQ (val, Qzh))
1369 if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
1370 return 0;
1372 else
1373 /* Any other language, we don't recognize it. Only the above
1374 currently appear in fontset.el, so it isn't worth
1375 creating a mapping table of codepages/scripts to languages
1376 or opening the font to see if there are any language tags
1377 in it that the Windows API does not expose. Fontset
1378 spec should have a fallback, as some backends do
1379 not recognize language at all. */
1380 return 0;
1382 else if (EQ (key, QCotf) && CONSP (val))
1384 /* OTF features only supported by the uniscribe backend. */
1385 if (EQ (backend, Quniscribe))
1387 if (!uniscribe_check_otf (logfont, val))
1388 return 0;
1390 else
1391 return 0;
1395 return 1;
1398 static int
1399 w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset)
1401 DWORD subrange1 = coverage->fsUsb[1];
1403 #define SUBRANGE1_HAN_MASK 0x08000000
1404 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1405 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1407 if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET)
1409 return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK;
1411 else if (charset == SHIFTJIS_CHARSET)
1413 return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK;
1415 else if (charset == HANGEUL_CHARSET)
1417 return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK;
1420 return 1;
1423 #ifndef WINDOWSNT
1424 #define _strlwr strlwr
1425 #endif /* !WINDOWSNT */
1427 static int
1428 check_face_name (LOGFONT *font, char *full_name)
1430 char full_iname[LF_FULLFACESIZE+1];
1432 /* Just check for names known to cause problems, since the full name
1433 can contain expanded abbreviations, prefixed foundry, postfixed
1434 style, the latter of which sometimes differs from the style indicated
1435 in the shorter name (eg Lt becomes Light or even Extra Light) */
1437 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1438 installed, we run into problems with the Uniscribe backend which tries
1439 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1440 with Arial's characteristics, since that attempt to use TrueType works
1441 some places, but not others. */
1442 if (!xstrcasecmp (font->lfFaceName, "helvetica"))
1444 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1445 full_iname[LF_FULLFACESIZE] = 0;
1446 _strlwr (full_iname);
1447 return strstr ("helvetica", full_iname) != NULL;
1449 /* Same for Helv. */
1450 if (!xstrcasecmp (font->lfFaceName, "helv"))
1452 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1453 full_iname[LF_FULLFACESIZE] = 0;
1454 _strlwr (full_iname);
1455 return strstr ("helv", full_iname) != NULL;
1458 /* Since Times is mapped to Times New Roman, a substring
1459 match is not sufficient to filter out the bogus match. */
1460 else if (!xstrcasecmp (font->lfFaceName, "times"))
1461 return xstrcasecmp (full_name, "times") == 0;
1463 return 1;
1467 /* Callback function for EnumFontFamiliesEx.
1468 * Checks if a font matches everything we are trying to check against,
1469 * and if so, adds it to a list. Both the data we are checking against
1470 * and the list to which the fonts are added are passed in via the
1471 * lparam argument, in the form of a font_callback_data struct. */
1472 static int CALLBACK ALIGN_STACK
1473 add_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 Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
1480 Lisp_Object entity;
1482 int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1483 || physical_font->ntmFontSig.fsUsb[2]
1484 || physical_font->ntmFontSig.fsUsb[1]
1485 || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1487 /* Skip non matching fonts. */
1489 /* For uniscribe backend, consider only truetype or opentype fonts
1490 that have some Unicode coverage. */
1491 if (match_data->opentype_only
1492 && ((!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
1493 && !(font_type & TRUETYPE_FONTTYPE))
1494 || !is_unicode))
1495 return 1;
1497 /* Ensure a match. */
1498 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1499 || !font_matches_spec (font_type, physical_font,
1500 match_data->orig_font_spec, backend,
1501 &logical_font->elfLogFont)
1502 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1503 match_data->pattern.lfCharSet))
1504 return 1;
1506 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1507 We limit this to raster fonts, because the test can catch some
1508 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1509 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1510 therefore get through this test. Since full names can be prefixed
1511 by a foundry, we accept raster fonts if the font name is found
1512 anywhere within the full name. */
1513 if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
1514 && !strstr ((char *)logical_font->elfFullName,
1515 logical_font->elfLogFont.lfFaceName))
1516 /* Check for well known substitutions that mess things up in the
1517 presence of Type-1 fonts of the same name. */
1518 || (!check_face_name (&logical_font->elfLogFont,
1519 (char *)logical_font->elfFullName)))
1520 return 1;
1522 /* Make a font entity for the font. */
1523 entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1524 physical_font, font_type,
1525 &match_data->pattern,
1526 backend);
1528 if (!NILP (entity))
1530 Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1531 FONT_REGISTRY_INDEX);
1533 /* iso10646-1 fonts must contain Unicode mapping tables. */
1534 if (EQ (spec_charset, Qiso10646_1))
1536 if (!is_unicode)
1537 return 1;
1539 /* unicode-bmp fonts must contain characters from the BMP. */
1540 else if (EQ (spec_charset, Qunicode_bmp))
1542 if (!physical_font->ntmFontSig.fsUsb[3]
1543 && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1544 && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1545 && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1546 return 1;
1548 /* unicode-sip fonts must contain characters in Unicode plane 2.
1549 so look for bit 57 (surrogates) in the Unicode subranges, plus
1550 the bits for CJK ranges that include those characters. */
1551 else if (EQ (spec_charset, Qunicode_sip))
1553 if (!(physical_font->ntmFontSig.fsUsb[1] & 0x02000000)
1554 || !(physical_font->ntmFontSig.fsUsb[1] & 0x28000000))
1555 return 1;
1558 /* This font matches. */
1560 /* If registry was specified, ensure it is reported as the same. */
1561 if (!NILP (spec_charset))
1563 /* Avoid using non-Japanese fonts for Japanese, even if they
1564 claim they are capable, due to known breakage in Vista
1565 and Windows 7 fonts (bug#6029). */
1566 if (logical_font->elfLogFont.lfCharSet == SHIFTJIS_CHARSET
1567 && !(physical_font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1568 return 1;
1569 else
1570 ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1572 /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1573 fonts as Unicode and skip other charsets. */
1574 else if (match_data->opentype_only)
1576 if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1577 || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1578 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1579 else
1580 return 1;
1583 /* Add this font to the list. */
1584 match_data->list = Fcons (entity, match_data->list);
1586 return 1;
1589 /* Callback function for EnumFontFamiliesEx.
1590 * Terminates the search once we have a match. */
1591 static int CALLBACK ALIGN_STACK
1592 add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1593 NEWTEXTMETRICEX *physical_font,
1594 DWORD font_type, LPARAM lParam)
1596 struct font_callback_data *match_data
1597 = (struct font_callback_data *) lParam;
1598 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1600 /* If we have a font in the list, terminate the search. */
1601 return NILP (match_data->list);
1604 /* Old function to convert from x to w32 charset, from w32fns.c. */
1605 static LONG
1606 x_to_w32_charset (char * lpcs)
1608 Lisp_Object this_entry, w32_charset;
1609 char *charset;
1610 int len = strlen (lpcs);
1612 /* Support "*-#nnn" format for unknown charsets. */
1613 if (strncmp (lpcs, "*-#", 3) == 0)
1614 return atoi (lpcs + 3);
1616 /* All Windows fonts qualify as Unicode. */
1617 if (!strncmp (lpcs, "iso10646", 8))
1618 return DEFAULT_CHARSET;
1620 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1621 charset = alloca (len + 1);
1622 strcpy (charset, lpcs);
1623 lpcs = strchr (charset, '*');
1624 if (lpcs)
1625 *lpcs = '\0';
1627 /* Look through w32-charset-info-alist for the character set.
1628 Format of each entry is
1629 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1631 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist, Qnil);
1633 if (NILP (this_entry))
1635 /* At startup, we want iso8859-1 fonts to come up properly. */
1636 if (xstrcasecmp (charset, "iso8859-1") == 0)
1637 return ANSI_CHARSET;
1638 else
1639 return DEFAULT_CHARSET;
1642 w32_charset = Fcar (Fcdr (this_entry));
1644 /* Translate Lisp symbol to number. */
1645 if (EQ (w32_charset, Qw32_charset_ansi))
1646 return ANSI_CHARSET;
1647 if (EQ (w32_charset, Qw32_charset_symbol))
1648 return SYMBOL_CHARSET;
1649 if (EQ (w32_charset, Qw32_charset_shiftjis))
1650 return SHIFTJIS_CHARSET;
1651 if (EQ (w32_charset, Qw32_charset_hangeul))
1652 return HANGEUL_CHARSET;
1653 if (EQ (w32_charset, Qw32_charset_chinesebig5))
1654 return CHINESEBIG5_CHARSET;
1655 if (EQ (w32_charset, Qw32_charset_gb2312))
1656 return GB2312_CHARSET;
1657 if (EQ (w32_charset, Qw32_charset_oem))
1658 return OEM_CHARSET;
1659 if (EQ (w32_charset, Qw32_charset_johab))
1660 return JOHAB_CHARSET;
1661 if (EQ (w32_charset, Qw32_charset_easteurope))
1662 return EASTEUROPE_CHARSET;
1663 if (EQ (w32_charset, Qw32_charset_turkish))
1664 return TURKISH_CHARSET;
1665 if (EQ (w32_charset, Qw32_charset_baltic))
1666 return BALTIC_CHARSET;
1667 if (EQ (w32_charset, Qw32_charset_russian))
1668 return RUSSIAN_CHARSET;
1669 if (EQ (w32_charset, Qw32_charset_arabic))
1670 return ARABIC_CHARSET;
1671 if (EQ (w32_charset, Qw32_charset_greek))
1672 return GREEK_CHARSET;
1673 if (EQ (w32_charset, Qw32_charset_hebrew))
1674 return HEBREW_CHARSET;
1675 if (EQ (w32_charset, Qw32_charset_vietnamese))
1676 return VIETNAMESE_CHARSET;
1677 if (EQ (w32_charset, Qw32_charset_thai))
1678 return THAI_CHARSET;
1679 if (EQ (w32_charset, Qw32_charset_mac))
1680 return MAC_CHARSET;
1682 return DEFAULT_CHARSET;
1686 /* Convert a Lisp font registry (symbol) to a windows charset. */
1687 static LONG
1688 registry_to_w32_charset (Lisp_Object charset)
1690 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1691 || EQ (charset, Qunicode_sip))
1692 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1693 else if (EQ (charset, Qiso8859_1))
1694 return ANSI_CHARSET;
1695 else if (SYMBOLP (charset))
1696 return x_to_w32_charset (SSDATA (SYMBOL_NAME (charset)));
1697 else
1698 return DEFAULT_CHARSET;
1701 /* Old function to convert from w32 to x charset, from w32fns.c. */
1702 static char *
1703 w32_to_x_charset (int fncharset, char *matching)
1705 static char buf[32];
1706 Lisp_Object charset_type;
1707 int match_len = 0;
1709 if (matching)
1711 /* If fully specified, accept it as it is. Otherwise use a
1712 substring match. */
1713 char *wildcard = strchr (matching, '*');
1714 if (wildcard)
1715 *wildcard = '\0';
1716 else if (strchr (matching, '-'))
1717 return matching;
1719 match_len = strlen (matching);
1722 switch (fncharset)
1724 case ANSI_CHARSET:
1725 /* Handle startup case of w32-charset-info-alist not
1726 being set up yet. */
1727 if (NILP (Vw32_charset_info_alist))
1728 return (char *)"iso8859-1";
1729 charset_type = Qw32_charset_ansi;
1730 break;
1731 case DEFAULT_CHARSET:
1732 charset_type = Qw32_charset_default;
1733 break;
1734 case SYMBOL_CHARSET:
1735 charset_type = Qw32_charset_symbol;
1736 break;
1737 case SHIFTJIS_CHARSET:
1738 charset_type = Qw32_charset_shiftjis;
1739 break;
1740 case HANGEUL_CHARSET:
1741 charset_type = Qw32_charset_hangeul;
1742 break;
1743 case GB2312_CHARSET:
1744 charset_type = Qw32_charset_gb2312;
1745 break;
1746 case CHINESEBIG5_CHARSET:
1747 charset_type = Qw32_charset_chinesebig5;
1748 break;
1749 case OEM_CHARSET:
1750 charset_type = Qw32_charset_oem;
1751 break;
1752 case EASTEUROPE_CHARSET:
1753 charset_type = Qw32_charset_easteurope;
1754 break;
1755 case TURKISH_CHARSET:
1756 charset_type = Qw32_charset_turkish;
1757 break;
1758 case BALTIC_CHARSET:
1759 charset_type = Qw32_charset_baltic;
1760 break;
1761 case RUSSIAN_CHARSET:
1762 charset_type = Qw32_charset_russian;
1763 break;
1764 case ARABIC_CHARSET:
1765 charset_type = Qw32_charset_arabic;
1766 break;
1767 case GREEK_CHARSET:
1768 charset_type = Qw32_charset_greek;
1769 break;
1770 case HEBREW_CHARSET:
1771 charset_type = Qw32_charset_hebrew;
1772 break;
1773 case VIETNAMESE_CHARSET:
1774 charset_type = Qw32_charset_vietnamese;
1775 break;
1776 case THAI_CHARSET:
1777 charset_type = Qw32_charset_thai;
1778 break;
1779 case MAC_CHARSET:
1780 charset_type = Qw32_charset_mac;
1781 break;
1782 case JOHAB_CHARSET:
1783 charset_type = Qw32_charset_johab;
1784 break;
1786 default:
1787 /* Encode numerical value of unknown charset. */
1788 sprintf (buf, "*-#%d", fncharset);
1789 return buf;
1793 Lisp_Object rest;
1794 char * best_match = NULL;
1795 int matching_found = 0;
1797 /* Look through w32-charset-info-alist for the character set.
1798 Prefer ISO codepages, and prefer lower numbers in the ISO
1799 range. Only return charsets for codepages which are installed.
1801 Format of each entry is
1802 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1804 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1806 char * x_charset;
1807 Lisp_Object w32_charset;
1808 Lisp_Object codepage;
1810 Lisp_Object this_entry = XCAR (rest);
1812 /* Skip invalid entries in alist. */
1813 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1814 || !CONSP (XCDR (this_entry))
1815 || !SYMBOLP (XCAR (XCDR (this_entry))))
1816 continue;
1818 x_charset = SSDATA (XCAR (this_entry));
1819 w32_charset = XCAR (XCDR (this_entry));
1820 codepage = XCDR (XCDR (this_entry));
1822 /* Look for Same charset and a valid codepage (or non-int
1823 which means ignore). */
1824 if (EQ (w32_charset, charset_type)
1825 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
1826 || IsValidCodePage (XINT (codepage))))
1828 /* If we don't have a match already, then this is the
1829 best. */
1830 if (!best_match)
1832 best_match = x_charset;
1833 if (matching && !strnicmp (x_charset, matching, match_len))
1834 matching_found = 1;
1836 /* If we already found a match for MATCHING, then
1837 only consider other matches. */
1838 else if (matching_found
1839 && strnicmp (x_charset, matching, match_len))
1840 continue;
1841 /* If this matches what we want, and the best so far doesn't,
1842 then this is better. */
1843 else if (!matching_found && matching
1844 && !strnicmp (x_charset, matching, match_len))
1846 best_match = x_charset;
1847 matching_found = 1;
1849 /* If this is fully specified, and the best so far isn't,
1850 then this is better. */
1851 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1852 /* If this is an ISO codepage, and the best so far isn't,
1853 then this is better, but only if it fully specifies the
1854 encoding. */
1855 || (strnicmp (best_match, "iso", 3) != 0
1856 && strnicmp (x_charset, "iso", 3) == 0
1857 && strchr (x_charset, '-')))
1858 best_match = x_charset;
1859 /* If both are ISO8859 codepages, choose the one with the
1860 lowest number in the encoding field. */
1861 else if (strnicmp (best_match, "iso8859-", 8) == 0
1862 && strnicmp (x_charset, "iso8859-", 8) == 0)
1864 int best_enc = atoi (best_match + 8);
1865 int this_enc = atoi (x_charset + 8);
1866 if (this_enc > 0 && this_enc < best_enc)
1867 best_match = x_charset;
1872 /* If no match, encode the numeric value. */
1873 if (!best_match)
1875 sprintf (buf, "*-#%d", fncharset);
1876 return buf;
1879 strncpy (buf, best_match, 31);
1880 /* If the charset is not fully specified, put -0 on the end. */
1881 if (!strchr (best_match, '-'))
1883 int pos = strlen (best_match);
1884 /* Charset specifiers shouldn't be very long. If it is a made
1885 up one, truncating it should not do any harm since it isn't
1886 recognized anyway. */
1887 if (pos > 29)
1888 pos = 29;
1889 strcpy (buf + pos, "-0");
1891 buf[31] = '\0';
1892 return buf;
1896 static Lisp_Object
1897 w32_registry (LONG w32_charset, DWORD font_type)
1899 char *charset;
1901 /* If charset is defaulted, charset is Unicode or unknown, depending on
1902 font type. */
1903 if (w32_charset == DEFAULT_CHARSET)
1904 return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
1906 charset = w32_to_x_charset (w32_charset, NULL);
1907 return font_intern_prop (charset, strlen (charset), 1);
1910 static int
1911 w32_decode_weight (int fnweight)
1913 if (fnweight >= FW_HEAVY) return 210;
1914 if (fnweight >= FW_EXTRABOLD) return 205;
1915 if (fnweight >= FW_BOLD) return 200;
1916 if (fnweight >= FW_SEMIBOLD) return 180;
1917 if (fnweight >= FW_NORMAL) return 100;
1918 if (fnweight >= FW_LIGHT) return 50;
1919 if (fnweight >= FW_EXTRALIGHT) return 40;
1920 if (fnweight > FW_THIN) return 20;
1921 return 0;
1924 static int
1925 w32_encode_weight (int n)
1927 if (n >= 210) return FW_HEAVY;
1928 if (n >= 205) return FW_EXTRABOLD;
1929 if (n >= 200) return FW_BOLD;
1930 if (n >= 180) return FW_SEMIBOLD;
1931 if (n >= 100) return FW_NORMAL;
1932 if (n >= 50) return FW_LIGHT;
1933 if (n >= 40) return FW_EXTRALIGHT;
1934 if (n >= 20) return FW_THIN;
1935 return 0;
1938 /* Convert a Windows font weight into one of the weights supported
1939 by fontconfig (see font.c:font_parse_fcname). */
1940 static Lisp_Object
1941 w32_to_fc_weight (int n)
1943 if (n >= FW_EXTRABOLD) return intern ("black");
1944 if (n >= FW_BOLD) return Qbold;
1945 if (n >= FW_SEMIBOLD) return intern ("demibold");
1946 if (n >= FW_NORMAL) return intern ("medium");
1947 return Qlight;
1950 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1951 static void
1952 fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec)
1954 Lisp_Object tmp, extra;
1955 int dpi = FRAME_RES_Y (f);
1957 tmp = AREF (font_spec, FONT_DPI_INDEX);
1958 if (INTEGERP (tmp))
1960 dpi = XINT (tmp);
1962 else if (FLOATP (tmp))
1964 dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
1967 /* Height */
1968 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1969 if (INTEGERP (tmp))
1970 logfont->lfHeight = -1 * XINT (tmp);
1971 else if (FLOATP (tmp))
1972 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
1974 /* Escapement */
1976 /* Orientation */
1978 /* Weight */
1979 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1980 if (INTEGERP (tmp))
1981 logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
1983 /* Italic */
1984 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1985 if (INTEGERP (tmp))
1987 int slant = FONT_SLANT_NUMERIC (font_spec);
1988 logfont->lfItalic = slant > 150 ? 1 : 0;
1991 /* Underline */
1993 /* Strikeout */
1995 /* Charset */
1996 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
1997 if (! NILP (tmp))
1998 logfont->lfCharSet = registry_to_w32_charset (tmp);
1999 else
2000 logfont->lfCharSet = DEFAULT_CHARSET;
2002 /* Out Precision */
2004 /* Clip Precision */
2006 /* Quality */
2007 logfont->lfQuality = DEFAULT_QUALITY;
2009 /* Generic Family and Face Name */
2010 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
2012 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
2013 if (! NILP (tmp))
2015 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
2016 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
2017 ; /* Font name was generic, don't fill in font name. */
2018 /* Font families are interned, but allow for strings also in case of
2019 user input. */
2020 else if (SYMBOLP (tmp))
2022 strncpy (logfont->lfFaceName,
2023 SSDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
2024 logfont->lfFaceName[LF_FACESIZE-1] = '\0';
2028 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
2029 if (!NILP (tmp))
2031 /* Override generic family. */
2032 BYTE family = w32_generic_family (tmp);
2033 if (family != FF_DONTCARE)
2034 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
2037 /* Set pitch based on the spacing property. */
2038 tmp = AREF (font_spec, FONT_SPACING_INDEX);
2039 if (INTEGERP (tmp))
2041 int spacing = XINT (tmp);
2042 if (spacing < FONT_SPACING_MONO)
2043 logfont->lfPitchAndFamily
2044 = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
2045 else
2046 logfont->lfPitchAndFamily
2047 = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
2050 /* Process EXTRA info. */
2051 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
2052 CONSP (extra); extra = XCDR (extra))
2054 tmp = XCAR (extra);
2055 if (CONSP (tmp))
2057 Lisp_Object key, val;
2058 key = XCAR (tmp), val = XCDR (tmp);
2059 /* Only use QCscript if charset is not provided, or is Unicode
2060 and a single script is specified. This is rather crude,
2061 and is only used to narrow down the fonts returned where
2062 there is a definite match. Some scripts, such as latin, han,
2063 cjk-misc match multiple lfCharSet values, so we can't pre-filter
2064 them. */
2065 if (EQ (key, QCscript)
2066 && logfont->lfCharSet == DEFAULT_CHARSET
2067 && SYMBOLP (val))
2069 if (EQ (val, Qgreek))
2070 logfont->lfCharSet = GREEK_CHARSET;
2071 else if (EQ (val, Qhangul))
2072 logfont->lfCharSet = HANGUL_CHARSET;
2073 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
2074 logfont->lfCharSet = SHIFTJIS_CHARSET;
2075 else if (EQ (val, Qbopomofo))
2076 logfont->lfCharSet = CHINESEBIG5_CHARSET;
2077 /* GB 18030 supports tibetan, yi, mongolian,
2078 fonts that support it should show up if we ask for
2079 GB2312 fonts. */
2080 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
2081 || EQ (val, Qmongolian))
2082 logfont->lfCharSet = GB2312_CHARSET;
2083 else if (EQ (val, Qhebrew))
2084 logfont->lfCharSet = HEBREW_CHARSET;
2085 else if (EQ (val, Qarabic))
2086 logfont->lfCharSet = ARABIC_CHARSET;
2087 else if (EQ (val, Qthai))
2088 logfont->lfCharSet = THAI_CHARSET;
2090 else if (EQ (key, QCantialias) && SYMBOLP (val))
2092 logfont->lfQuality = w32_antialias_type (val);
2098 static void
2099 list_all_matching_fonts (struct font_callback_data *match_data)
2101 HDC dc;
2102 Lisp_Object families = w32font_list_family (XFRAME (match_data->frame));
2103 struct frame *f = XFRAME (match_data->frame);
2105 /* Prevent quitting while EnumFontFamiliesEx runs and conses the
2106 list it will return. That's because get_frame_dc acquires the
2107 critical section, so we cannot quit before we release it in
2108 release_frame_dc. */
2109 Lisp_Object prev_quit = Vinhibit_quit;
2110 Vinhibit_quit = Qt;
2111 dc = get_frame_dc (f);
2113 while (!NILP (families))
2115 /* Only fonts from the current locale are given localized names
2116 on Windows, so we can keep backwards compatibility with
2117 Windows 9x/ME by using non-Unicode font enumeration without
2118 sacrificing internationalization here. */
2119 char *name;
2120 Lisp_Object family = CAR (families);
2121 families = CDR (families);
2122 if (NILP (family))
2123 continue;
2124 else if (SYMBOLP (family))
2125 name = SSDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
2126 else
2127 continue;
2129 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2130 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2132 EnumFontFamiliesEx (dc, &match_data->pattern,
2133 (FONTENUMPROC) add_font_entity_to_list,
2134 (LPARAM) match_data, 0);
2137 release_frame_dc (f, dc);
2138 Vinhibit_quit = prev_quit;
2141 static Lisp_Object
2142 lispy_antialias_type (BYTE type)
2144 Lisp_Object lispy;
2146 switch (type)
2148 case NONANTIALIASED_QUALITY:
2149 lispy = Qnone;
2150 break;
2151 case ANTIALIASED_QUALITY:
2152 lispy = Qstandard;
2153 break;
2154 case CLEARTYPE_QUALITY:
2155 lispy = Qsubpixel;
2156 break;
2157 case CLEARTYPE_NATURAL_QUALITY:
2158 lispy = Qnatural;
2159 break;
2160 default:
2161 lispy = Qnil;
2162 break;
2164 return lispy;
2167 /* Convert antialiasing symbols to lfQuality */
2168 static BYTE
2169 w32_antialias_type (Lisp_Object type)
2171 if (EQ (type, Qnone))
2172 return NONANTIALIASED_QUALITY;
2173 else if (EQ (type, Qstandard))
2174 return ANTIALIASED_QUALITY;
2175 else if (EQ (type, Qsubpixel))
2176 return CLEARTYPE_QUALITY;
2177 else if (EQ (type, Qnatural))
2178 return CLEARTYPE_NATURAL_QUALITY;
2179 else
2180 return DEFAULT_QUALITY;
2183 /* Return a list of all the scripts that the font supports. */
2184 static Lisp_Object
2185 font_supported_scripts (FONTSIGNATURE * sig)
2187 DWORD * subranges = sig->fsUsb;
2188 Lisp_Object supported = Qnil;
2190 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2191 #define SUBRANGE(n,sym) \
2192 if (subranges[(n) / 32] & (1U << ((n) % 32))) \
2193 supported = Fcons ((sym), supported)
2195 /* Match multiple subranges. SYM is set if any MASK bit is set in
2196 subranges[0 - 3]. */
2197 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2198 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2199 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2200 supported = Fcons ((sym), supported)
2202 SUBRANGE (0, Qlatin);
2203 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2204 /* Most fonts that support Latin will have good coverage of the
2205 Extended blocks, so in practice marking them below is not really
2206 needed, or useful: if a font claims support for, say, Latin
2207 Extended-B, but does not contain glyphs for some of the
2208 characters in the range, the user will have to augment her
2209 fontset to display those few characters. But we mark these
2210 subranges here anyway, for the marginal use cases where they
2211 might make a difference. */
2212 SUBRANGE (1, Qlatin);
2213 SUBRANGE (2, Qlatin);
2214 SUBRANGE (3, Qlatin);
2215 SUBRANGE (4, Qphonetic);
2216 /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */
2217 SUBRANGE (7, Qgreek);
2218 SUBRANGE (8, Qcoptic);
2219 SUBRANGE (9, Qcyrillic);
2220 SUBRANGE (10, Qarmenian);
2221 SUBRANGE (11, Qhebrew);
2222 /* Bit 12 is rather useless if the user has Hebrew fonts installed,
2223 because apparently at some point in the past bit 12 was "Hebrew
2224 Extended", and many Hebrew fonts still have this bit set. The
2225 only workaround is to customize fontsets to use fonts like Ebrima
2226 or Quivira. */
2227 SUBRANGE (12, Qvai);
2228 SUBRANGE (13, Qarabic);
2229 SUBRANGE (14, Qnko);
2230 SUBRANGE (15, Qdevanagari);
2231 SUBRANGE (16, Qbengali);
2232 SUBRANGE (17, Qgurmukhi);
2233 SUBRANGE (18, Qgujarati);
2234 SUBRANGE (19, Qoriya);
2235 SUBRANGE (20, Qtamil);
2236 SUBRANGE (21, Qtelugu);
2237 SUBRANGE (22, Qkannada);
2238 SUBRANGE (23, Qmalayalam);
2239 SUBRANGE (24, Qthai);
2240 SUBRANGE (25, Qlao);
2241 SUBRANGE (26, Qgeorgian);
2242 SUBRANGE (27, Qbalinese);
2243 /* 28: Hangul Jamo -- covered by the default fontset. */
2244 /* 29: Latin Extended, 30: Greek Extended -- covered above. */
2245 /* 31: Supplemental Punctuation -- most probably be masked by
2246 Courier New, so fontset customization is needed. */
2247 SUBRANGE (31, Qsymbol);
2248 /* 32-47: Symbols (defined below). */
2249 SUBRANGE (48, Qcjk_misc);
2250 /* Match either 49: katakana or 50: hiragana for kana. */
2251 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
2252 SUBRANGE (51, Qbopomofo);
2253 /* 52: Compatibility Jamo */
2254 SUBRANGE (53, Qphags_pa);
2255 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2256 SUBRANGE (56, Qhangul);
2257 /* 57: Surrogates. */
2258 SUBRANGE (58, Qphoenician);
2259 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
2260 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2261 SUBRANGE (59, Qkanbun); /* And this. */
2262 /* These are covered well either by the default Courier New or by
2263 CJK fonts that are set up specially in the default fontset. So
2264 marking them here wouldn't be useful. */
2265 /* 60: Private use, 61: CJK strokes and compatibility. */
2266 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2267 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2268 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2269 /* 69: Specials. */
2270 SUBRANGE (70, Qtibetan);
2271 SUBRANGE (71, Qsyriac);
2272 SUBRANGE (72, Qthaana);
2273 SUBRANGE (73, Qsinhala);
2274 SUBRANGE (74, Qmyanmar);
2275 SUBRANGE (75, Qethiopic);
2276 SUBRANGE (76, Qcherokee);
2277 SUBRANGE (77, Qcanadian_aboriginal);
2278 SUBRANGE (78, Qogham);
2279 SUBRANGE (79, Qrunic);
2280 SUBRANGE (80, Qkhmer);
2281 SUBRANGE (81, Qmongolian);
2282 SUBRANGE (82, Qbraille);
2283 SUBRANGE (83, Qyi);
2284 SUBRANGE (84, Qbuhid);
2285 SUBRANGE (84, Qhanunoo);
2286 SUBRANGE (84, Qtagalog);
2287 SUBRANGE (84, Qtagbanwa);
2288 SUBRANGE (85, Qold_italic);
2289 SUBRANGE (86, Qgothic);
2290 SUBRANGE (87, Qdeseret);
2291 SUBRANGE (88, Qbyzantine_musical_symbol);
2292 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
2293 SUBRANGE (89, Qmathematical_bold); /* See fontset.el:setup-default-fontset. */
2294 SUBRANGE (89, Qmathematical_italic);
2295 SUBRANGE (89, Qmathematical_bold_italic);
2296 SUBRANGE (89, Qmathematical_script);
2297 SUBRANGE (89, Qmathematical_bold_script);
2298 SUBRANGE (89, Qmathematical_fraktur);
2299 SUBRANGE (89, Qmathematical_double_struck);
2300 SUBRANGE (89, Qmathematical_bold_fraktur);
2301 SUBRANGE (89, Qmathematical_sans_serif);
2302 SUBRANGE (89, Qmathematical_sans_serif_bold);
2303 SUBRANGE (89, Qmathematical_sans_serif_italic);
2304 SUBRANGE (89, Qmathematical_sans_serif_bold_italic);
2305 SUBRANGE (89, Qmathematical_monospace);
2306 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2307 SUBRANGE (93, Qlimbu);
2308 SUBRANGE (94, Qtai_le);
2309 SUBRANGE (95, Qtai_le);
2310 SUBRANGE (96, Qbuginese);
2311 SUBRANGE (97, Qglagolitic);
2312 SUBRANGE (98, Qtifinagh);
2313 /* 99: Yijing Hexagrams. */
2314 SUBRANGE (99, Qhan);
2315 SUBRANGE (100, Qsyloti_nagri);
2316 SUBRANGE (101, Qlinear_b);
2317 SUBRANGE (102, Qancient_greek_number);
2318 SUBRANGE (103, Qugaritic);
2319 SUBRANGE (104, Qold_persian);
2320 SUBRANGE (105, Qshavian);
2321 SUBRANGE (106, Qosmanya);
2322 SUBRANGE (107, Qcypriot);
2323 SUBRANGE (108, Qkharoshthi);
2324 SUBRANGE (109, Qtai_xuan_jing_symbol);
2325 SUBRANGE (110, Qcuneiform);
2326 SUBRANGE (111, Qcounting_rod_numeral);
2327 SUBRANGE (112, Qsundanese);
2328 SUBRANGE (113, Qlepcha);
2329 SUBRANGE (114, Qol_chiki);
2330 SUBRANGE (115, Qsaurashtra);
2331 SUBRANGE (116, Qkayah_li);
2332 SUBRANGE (117, Qrejang);
2333 SUBRANGE (118, Qcham);
2334 SUBRANGE (119, Qancient_symbol);
2335 SUBRANGE (120, Qphaistos_disc);
2336 SUBRANGE (121, Qlycian);
2337 SUBRANGE (121, Qcarian);
2338 SUBRANGE (121, Qlydian);
2339 SUBRANGE (122, Qdomino_tile);
2340 SUBRANGE (122, Qmahjong_tile);
2341 /* 123-127: Reserved. */
2343 /* There isn't really a main symbol range, so include symbol if any
2344 relevant range is set. */
2345 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2347 /* Missing: Tai Viet (U+AA80-U+AADF). */
2348 #undef SUBRANGE
2349 #undef MASK_ANY
2351 return supported;
2354 /* Generate a full name for a Windows font.
2355 The full name is in fcname format, with weight, slant and antialiasing
2356 specified if they are not "normal". */
2357 static int
2358 w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
2359 int pixel_size, char *name, int nbytes)
2361 int len, height, outline;
2362 char *p;
2363 Lisp_Object antialiasing, weight = Qnil;
2365 len = strlen (font->lfFaceName);
2367 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2369 /* Represent size of scalable fonts by point size. But use pixelsize for
2370 raster fonts to indicate that they are exactly that size. */
2371 if (outline)
2372 len += 11; /* -SIZE */
2373 else
2374 len += 21;
2376 if (font->lfItalic)
2377 len += 7; /* :italic */
2379 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2381 weight = w32_to_fc_weight (font->lfWeight);
2382 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
2385 antialiasing = lispy_antialias_type (font->lfQuality);
2386 if (! NILP (antialiasing))
2387 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2389 /* Check that the buffer is big enough */
2390 if (len > nbytes)
2391 return -1;
2393 p = name;
2394 p += sprintf (p, "%s", font->lfFaceName);
2396 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2398 if (height > 0)
2400 if (outline)
2402 double pointsize = height * 72.0 / one_w32_display_info.resy;
2403 /* Round to nearest half point. floor is used, since round is not
2404 supported in MS library. */
2405 pointsize = floor (pointsize * 2 + 0.5) / 2;
2406 p += sprintf (p, "-%1.1f", pointsize);
2408 else
2409 p += sprintf (p, ":pixelsize=%d", height);
2412 if (SYMBOLP (weight) && ! NILP (weight))
2413 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2415 if (font->lfItalic)
2416 p += sprintf (p, ":italic");
2418 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2419 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2421 return (p - name);
2424 /* Convert a logfont and point size into a fontconfig style font name.
2425 POINTSIZE is in tenths of points.
2426 If SIZE indicates the size of buffer FCNAME, into which the font name
2427 is written. If the buffer is not large enough to contain the name,
2428 the function returns -1, otherwise it returns the number of bytes
2429 written to FCNAME. */
2430 static int
2431 logfont_to_fcname (LOGFONT* font, int pointsize, char *fcname, int size)
2433 int len, height;
2434 char *p = fcname;
2435 Lisp_Object weight = Qnil;
2437 len = strlen (font->lfFaceName) + 2;
2438 height = pointsize / 10;
2439 while (height /= 10)
2440 len++;
2442 if (pointsize % 10)
2443 len += 2;
2445 if (font->lfItalic)
2446 len += 7; /* :italic */
2447 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2449 weight = w32_to_fc_weight (font->lfWeight);
2450 len += SBYTES (SYMBOL_NAME (weight)) + 1;
2453 if (len > size)
2454 return -1;
2456 p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2457 if (pointsize % 10)
2458 p += sprintf (p, ".%d", pointsize % 10);
2460 if (SYMBOLP (weight) && !NILP (weight))
2461 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2463 if (font->lfItalic)
2464 p += sprintf (p, ":italic");
2466 return (p - fcname);
2469 static void
2470 compute_metrics (HDC dc, struct w32font_info *w32_font, unsigned int code,
2471 struct w32_metric_cache *metrics)
2473 GLYPHMETRICS gm;
2474 MAT2 transform;
2475 unsigned int options = GGO_METRICS;
2476 INT width;
2478 if (w32_font->glyph_idx)
2479 options |= GGO_GLYPH_INDEX;
2481 memset (&transform, 0, sizeof (transform));
2482 transform.eM11.value = 1;
2483 transform.eM22.value = 1;
2485 if (get_glyph_outline_w (dc, code, options, &gm, 0, NULL, &transform)
2486 != GDI_ERROR)
2488 metrics->lbearing = gm.gmptGlyphOrigin.x;
2489 metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2490 metrics->width = gm.gmCellIncX;
2491 metrics->ascent = gm.gmptGlyphOrigin.y;
2492 metrics->descent = gm.gmBlackBoxY - gm.gmptGlyphOrigin.y;
2493 metrics->status = W32METRIC_SUCCESS;
2495 else if (get_char_width_32_w (dc, code, code, &width) != 0)
2497 metrics->lbearing = 0;
2498 metrics->rbearing = width;
2499 metrics->width = width;
2500 metrics->ascent = w32_font->font.ascent;
2501 metrics->descent = w32_font->font.descent;
2502 metrics->status = W32METRIC_SUCCESS;
2504 else
2505 metrics->status = W32METRIC_FAIL;
2508 DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2509 doc: /* Read a font name using a W32 font selection dialog.
2510 Return fontconfig style font string corresponding to the selection.
2512 If FRAME is omitted or nil, it defaults to the selected frame.
2513 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2514 in the font selection dialog. */)
2515 (Lisp_Object frame, Lisp_Object exclude_proportional)
2517 struct frame *f = decode_window_system_frame (frame);
2518 CHOOSEFONT cf;
2519 LOGFONT lf;
2520 TEXTMETRIC tm;
2521 HDC hdc;
2522 HANDLE oldobj;
2523 char buf[100];
2525 memset (&cf, 0, sizeof (cf));
2526 memset (&lf, 0, sizeof (lf));
2528 cf.lStructSize = sizeof (cf);
2529 cf.hwndOwner = FRAME_W32_WINDOW (f);
2530 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2532 /* If exclude_proportional is non-nil, limit the selection to
2533 monospaced fonts. */
2534 if (!NILP (exclude_proportional))
2535 cf.Flags |= CF_FIXEDPITCHONLY;
2537 cf.lpLogFont = &lf;
2539 /* Initialize as much of the font details as we can from the current
2540 default font. */
2541 hdc = GetDC (FRAME_W32_WINDOW (f));
2542 oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
2543 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2544 if (GetTextMetrics (hdc, &tm))
2546 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2547 lf.lfWeight = tm.tmWeight;
2548 lf.lfItalic = tm.tmItalic;
2549 lf.lfUnderline = tm.tmUnderlined;
2550 lf.lfStrikeOut = tm.tmStruckOut;
2551 lf.lfCharSet = tm.tmCharSet;
2552 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2554 SelectObject (hdc, oldobj);
2555 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2558 int count = SPECPDL_INDEX ();
2559 Lisp_Object value = Qnil;
2561 w32_dialog_in_progress (Qt);
2562 specbind (Qinhibit_redisplay, Qt);
2563 record_unwind_protect (w32_dialog_in_progress, Qnil);
2565 if (ChooseFont (&cf)
2566 && logfont_to_fcname (&lf, cf.iPointSize, buf, 100) >= 0)
2567 value = DECODE_SYSTEM (build_string (buf));
2569 unbind_to (count, Qnil);
2571 return value;
2575 static const char *const w32font_booleans [] = {
2576 NULL,
2579 static const char *const w32font_non_booleans [] = {
2580 ":script",
2581 ":antialias",
2582 ":style",
2583 NULL,
2586 static void
2587 w32font_filter_properties (Lisp_Object font, Lisp_Object alist)
2589 font_filter_properties (font, alist, w32font_booleans, w32font_non_booleans);
2592 struct font_driver w32font_driver =
2594 LISPSYM_INITIALLY (Qgdi),
2595 false, /* case insensitive */
2596 w32font_get_cache,
2597 w32font_list,
2598 w32font_match,
2599 w32font_list_family,
2600 NULL, /* free_entity */
2601 w32font_open,
2602 w32font_close,
2603 NULL, /* prepare_face */
2604 NULL, /* done_face */
2605 w32font_has_char,
2606 w32font_encode_char,
2607 w32font_text_extents,
2608 w32font_draw,
2609 NULL, /* get_bitmap */
2610 NULL, /* free_bitmap */
2611 NULL, /* anchor_point */
2612 NULL, /* otf_capability */
2613 NULL, /* otf_drive */
2614 NULL, /* start_for_frame */
2615 NULL, /* end_for_frame */
2616 NULL, /* shape */
2617 NULL, /* check */
2618 NULL, /* get_variation_glyphs */
2619 w32font_filter_properties,
2620 NULL, /* cached_font_ok */
2624 /* Initialize state that does not change between invocations. This is only
2625 called when Emacs is dumped. */
2626 void
2627 syms_of_w32font (void)
2629 DEFSYM (Qgdi, "gdi");
2630 DEFSYM (Quniscribe, "uniscribe");
2631 DEFSYM (QCformat, ":format");
2633 /* Generic font families. */
2634 DEFSYM (Qmonospace, "monospace");
2635 DEFSYM (Qserif, "serif");
2636 DEFSYM (Qsansserif, "sansserif");
2637 DEFSYM (Qscript, "script");
2638 DEFSYM (Qdecorative, "decorative");
2639 /* Aliases. */
2640 DEFSYM (Qsans_serif, "sans_serif");
2641 DEFSYM (Qsans, "sans");
2642 DEFSYM (Qmono, "mono");
2644 /* Fake foundries. */
2645 DEFSYM (Qraster, "raster");
2646 DEFSYM (Qoutline, "outline");
2647 DEFSYM (Qunknown, "unknown");
2649 /* Antialiasing. */
2650 DEFSYM (Qstandard, "standard");
2651 DEFSYM (Qsubpixel, "subpixel");
2652 DEFSYM (Qnatural, "natural");
2654 /* Languages */
2655 DEFSYM (Qzh, "zh");
2657 /* Scripts */
2658 DEFSYM (Qlatin, "latin");
2659 DEFSYM (Qgreek, "greek");
2660 DEFSYM (Qcoptic, "coptic");
2661 DEFSYM (Qcyrillic, "cyrillic");
2662 DEFSYM (Qarmenian, "armenian");
2663 DEFSYM (Qhebrew, "hebrew");
2664 DEFSYM (Qvai, "vai");
2665 DEFSYM (Qarabic, "arabic");
2666 DEFSYM (Qsyriac, "syriac");
2667 DEFSYM (Qnko, "nko");
2668 DEFSYM (Qthaana, "thaana");
2669 DEFSYM (Qdevanagari, "devanagari");
2670 DEFSYM (Qbengali, "bengali");
2671 DEFSYM (Qgurmukhi, "gurmukhi");
2672 DEFSYM (Qgujarati, "gujarati");
2673 DEFSYM (Qoriya, "oriya");
2674 DEFSYM (Qtamil, "tamil");
2675 DEFSYM (Qtelugu, "telugu");
2676 DEFSYM (Qkannada, "kannada");
2677 DEFSYM (Qmalayalam, "malayalam");
2678 DEFSYM (Qsinhala, "sinhala");
2679 DEFSYM (Qthai, "thai");
2680 DEFSYM (Qlao, "lao");
2681 DEFSYM (Qtibetan, "tibetan");
2682 DEFSYM (Qmyanmar, "myanmar");
2683 DEFSYM (Qgeorgian, "georgian");
2684 DEFSYM (Qhangul, "hangul");
2685 DEFSYM (Qethiopic, "ethiopic");
2686 DEFSYM (Qcherokee, "cherokee");
2687 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2688 DEFSYM (Qogham, "ogham");
2689 DEFSYM (Qrunic, "runic");
2690 DEFSYM (Qkhmer, "khmer");
2691 DEFSYM (Qmongolian, "mongolian");
2692 DEFSYM (Qbraille, "braille");
2693 DEFSYM (Qhan, "han");
2694 DEFSYM (Qideographic_description, "ideographic-description");
2695 DEFSYM (Qcjk_misc, "cjk-misc");
2696 DEFSYM (Qkana, "kana");
2697 DEFSYM (Qbopomofo, "bopomofo");
2698 DEFSYM (Qkanbun, "kanbun");
2699 DEFSYM (Qyi, "yi");
2700 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2701 DEFSYM (Qmusical_symbol, "musical-symbol");
2702 DEFSYM (Qmathematical_bold, "mathematical-bold");
2703 DEFSYM (Qmathematical_italic, "mathematical-italic");
2704 DEFSYM (Qmathematical_bold_italic, "mathematical-bold-italic");
2705 DEFSYM (Qmathematical_script, "mathematical-script");
2706 DEFSYM (Qmathematical_bold_script, "mathematical-bold-script");
2707 DEFSYM (Qmathematical_fraktur, "mathematical-fraktur");
2708 DEFSYM (Qmathematical_double_struck, "mathematical-double-struck");
2709 DEFSYM (Qmathematical_bold_fraktur, "mathematical-bold-fraktur");
2710 DEFSYM (Qmathematical_sans_serif, "mathematical-sans-serif");
2711 DEFSYM (Qmathematical_sans_serif_bold, "mathematical-sans-serif-bold");
2712 DEFSYM (Qmathematical_sans_serif_italic, "mathematical-sans-serif-italic");
2713 DEFSYM (Qmathematical_sans_serif_bold_italic, "mathematical-sans-serif-bold-italic");
2714 DEFSYM (Qmathematical_monospace, "mathematical-monospace");
2715 DEFSYM (Qcham, "cham");
2716 DEFSYM (Qphonetic, "phonetic");
2717 DEFSYM (Qbalinese, "balinese");
2718 DEFSYM (Qbuginese, "buginese");
2719 DEFSYM (Qbuhid, "buhid");
2720 DEFSYM (Qcuneiform, "cuneiform");
2721 DEFSYM (Qcypriot, "cypriot");
2722 DEFSYM (Qdeseret, "deseret");
2723 DEFSYM (Qglagolitic, "glagolitic");
2724 DEFSYM (Qgothic, "gothic");
2725 DEFSYM (Qhanunoo, "hanunoo");
2726 DEFSYM (Qkharoshthi, "kharoshthi");
2727 DEFSYM (Qlimbu, "limbu");
2728 DEFSYM (Qlinear_b, "linear_b");
2729 DEFSYM (Qold_italic, "old_italic");
2730 DEFSYM (Qold_persian, "old_persian");
2731 DEFSYM (Qosmanya, "osmanya");
2732 DEFSYM (Qphags_pa, "phags-pa");
2733 DEFSYM (Qphoenician, "phoenician");
2734 DEFSYM (Qshavian, "shavian");
2735 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2736 DEFSYM (Qtagalog, "tagalog");
2737 DEFSYM (Qtagbanwa, "tagbanwa");
2738 DEFSYM (Qtai_le, "tai_le");
2739 DEFSYM (Qtifinagh, "tifinagh");
2740 DEFSYM (Qugaritic, "ugaritic");
2741 DEFSYM (Qlycian, "lycian");
2742 DEFSYM (Qcarian, "carian");
2743 DEFSYM (Qlydian, "lydian");
2744 DEFSYM (Qdomino_tile, "domino-tile");
2745 DEFSYM (Qmahjong_tile, "mahjong-tile");
2746 DEFSYM (Qtai_xuan_jing_symbol, "tai-xuan-jing-symbol");
2747 DEFSYM (Qcounting_rod_numeral, "counting-rod-numeral");
2748 DEFSYM (Qancient_symbol, "ancient-symbol");
2749 DEFSYM (Qphaistos_disc, "phaistos-disc");
2750 DEFSYM (Qancient_greek_number, "ancient-greek-number");
2751 DEFSYM (Qsundanese, "sundanese");
2752 DEFSYM (Qlepcha, "lepcha");
2753 DEFSYM (Qol_chiki, "ol-chiki");
2754 DEFSYM (Qsaurashtra, "saurashtra");
2755 DEFSYM (Qkayah_li, "kayah-li");
2756 DEFSYM (Qrejang, "rejang");
2758 /* W32 font encodings. */
2759 DEFVAR_LISP ("w32-charset-info-alist",
2760 Vw32_charset_info_alist,
2761 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2762 Each entry should be of the form:
2764 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2766 where CHARSET_NAME is a string used in font names to identify the charset,
2767 WINDOWS_CHARSET is a symbol that can be one of:
2769 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2770 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2771 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2772 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2773 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2774 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2775 or w32-charset-oem.
2777 CODEPAGE should be an integer specifying the codepage that should be used
2778 to display the character set, t to do no translation and output as Unicode,
2779 or nil to do no translation and output as 8 bit (or multibyte on far-east
2780 versions of Windows) characters. */);
2781 Vw32_charset_info_alist = Qnil;
2783 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2784 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2785 DEFSYM (Qw32_charset_default, "w32-charset-default");
2786 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2787 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2788 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2789 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2790 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2791 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2792 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2793 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2794 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2795 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2796 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2797 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2798 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2799 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2800 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2801 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2803 defsubr (&Sx_select_font);
2805 register_font_driver (&w32font_driver, NULL);
2808 void
2809 globals_of_w32font (void)
2811 #ifdef WINDOWSNT
2812 g_b_init_get_outline_metrics_w = 0;
2813 g_b_init_get_text_metrics_w = 0;
2814 g_b_init_get_glyph_outline_w = 0;
2815 g_b_init_get_char_width_32_w = 0;
2816 #endif