1 /* Font backend for the Microsoft Windows API.
2    Copyright (C) 2007-2021 Free Software Foundation, Inc.
3 
4 This file is part of GNU Emacs.
5 
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or (at
9 your option) any later version.
10 
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 GNU General Public License for more details.
15 
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
18 
19 #include <config.h>
20 #include <windows.h>
21 #include <stdio.h>
22 #include <math.h>
23 #include <ctype.h>
24 #include <commdlg.h>
25 
26 #include "lisp.h"
27 #include "w32term.h"
28 #include "frame.h"
29 #include "coding.h"	/* for ENCODE_SYSTEM, DECODE_SYSTEM */
30 #include "w32font.h"
31 #ifdef WINDOWSNT
32 #include "w32common.h"
33 #include "w32.h"
34 #endif
35 
36 #include "pdumper.h"
37 
38 /* Cleartype available on Windows XP, cleartype_natural from XP SP1.
39    The latter does not try to fit cleartype smoothed fonts into the
40    same bounding box as the non-antialiased version of the font.
41  */
42 #ifndef CLEARTYPE_QUALITY
43 #define CLEARTYPE_QUALITY 5
44 #endif
45 #ifndef CLEARTYPE_NATURAL_QUALITY
46 #define CLEARTYPE_NATURAL_QUALITY 6
47 #endif
48 
49 /* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
50    of MSVC headers.  */
51 #ifndef VIETNAMESE_CHARSET
52 #define VIETNAMESE_CHARSET 163
53 #endif
54 #ifndef JOHAB_CHARSET
55 #define JOHAB_CHARSET 130
56 #endif
57 
58 static void fill_in_logfont (struct frame *, LOGFONT *, Lisp_Object);
59 
60 static BYTE w32_antialias_type (Lisp_Object);
61 static Lisp_Object lispy_antialias_type (BYTE);
62 
63 static Lisp_Object font_supported_scripts (FONTSIGNATURE *);
64 static int w32font_full_name (LOGFONT *, Lisp_Object, int, char *, int);
65 static void compute_metrics (HDC, struct w32font_info *, unsigned int,
66                              struct w32_metric_cache *);
67 
68 static Lisp_Object w32_registry (LONG, DWORD);
69 
70 /* EnumFontFamiliesEx callbacks.  */
71 static int CALLBACK ALIGN_STACK add_font_entity_to_list (ENUMLOGFONTEX *,
72 							 NEWTEXTMETRICEX *,
73 							 DWORD, LPARAM);
74 static int CALLBACK ALIGN_STACK add_one_font_entity_to_list (ENUMLOGFONTEX *,
75 							     NEWTEXTMETRICEX *,
76 							     DWORD, LPARAM);
77 static int CALLBACK ALIGN_STACK add_font_name_to_list (ENUMLOGFONTEX *,
78 						       NEWTEXTMETRICEX *,
79 						       DWORD, LPARAM);
80 
81 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
82    of what we really want.  */
83 struct font_callback_data
84 {
85   /* The logfont we are matching against. EnumFontFamiliesEx only matches
86      face name and charset, so we need to manually match everything else
87      in the callback function.  */
88   LOGFONT pattern;
89   /* The original font spec or entity.  */
90   Lisp_Object orig_font_spec;
91   /* The frame the font is being loaded on.  */
92   Lisp_Object frame;
93   /* Fonts known to support the font spec, or nil if none.  */
94   Lisp_Object known_fonts;
95   /* The list to add matches to.  */
96   Lisp_Object list;
97   /* Whether to match only opentype fonts.  */
98   bool opentype_only;
99 };
100 
101 /* Handles the problem that EnumFontFamiliesEx will not return all
102    style variations if the font name is not specified.  */
103 static void list_all_matching_fonts (struct font_callback_data *);
104 
105 #ifdef WINDOWSNT
106 
107 static BOOL g_b_init_get_outline_metrics_w;
108 static BOOL g_b_init_get_text_metrics_w;
109 static BOOL g_b_init_get_glyph_outline_w;
110 static BOOL g_b_init_get_char_width_32_w;
111 
112 typedef UINT (WINAPI * GetOutlineTextMetricsW_Proc) (
113    HDC hdc,
114    UINT cbData,
115    LPOUTLINETEXTMETRICW lpotmw);
116 typedef BOOL (WINAPI * GetTextMetricsW_Proc) (
117    HDC hdc,
118    LPTEXTMETRICW lptmw);
119 typedef DWORD (WINAPI * GetGlyphOutlineW_Proc) (
120    HDC hdc,
121    UINT uChar,
122    UINT uFormat,
123    LPGLYPHMETRICS lpgm,
124    DWORD cbBuffer,
125    LPVOID lpvBuffer,
126    const MAT2 *lpmat2);
127 typedef BOOL (WINAPI * GetCharWidth32W_Proc) (
128    HDC hdc,
129    UINT uFirstChar,
130    UINT uLastChar,
131    LPINT lpBuffer);
132 
133 /* Several "wide" functions we use to support the font backends are
134    unavailable on Windows 9X, unless UNICOWS.DLL is installed (their
135    versions in the default libraries are non-functional stubs).  On NT
136    and later systems, these functions are in GDI32.DLL.  The following
137    helper function attempts to load UNICOWS.DLL on Windows 9X, and
138    refuses to let Emacs start up if that library is not found.  On NT
139    and later versions, it simply loads GDI32.DLL, which should always
140    be available.  */
141 static HMODULE
w32_load_unicows_or_gdi32(void)142 w32_load_unicows_or_gdi32 (void)
143 {
144   return maybe_load_unicows_dll ();
145 }
146 
147 /* The following 3 functions call the problematic "wide" APIs via
148    function pointers, to avoid linking against the non-standard
149    libunicows on W9X.  */
150 static UINT WINAPI
get_outline_metrics_w(HDC hdc,UINT cbData,LPOUTLINETEXTMETRICW lpotmw)151 get_outline_metrics_w(HDC hdc, UINT cbData, LPOUTLINETEXTMETRICW lpotmw)
152 {
153   static GetOutlineTextMetricsW_Proc s_pfn_Get_Outline_Text_MetricsW = NULL;
154   HMODULE hm_unicows = NULL;
155   if (g_b_init_get_outline_metrics_w == 0)
156     {
157       g_b_init_get_outline_metrics_w = 1;
158       hm_unicows = w32_load_unicows_or_gdi32 ();
159       if (hm_unicows)
160 	s_pfn_Get_Outline_Text_MetricsW = (GetOutlineTextMetricsW_Proc)
161 	  get_proc_addr (hm_unicows, "GetOutlineTextMetricsW");
162     }
163   eassert (s_pfn_Get_Outline_Text_MetricsW != NULL);
164   return s_pfn_Get_Outline_Text_MetricsW (hdc, cbData, lpotmw);
165 }
166 
167 static BOOL WINAPI
get_text_metrics_w(HDC hdc,LPTEXTMETRICW lptmw)168 get_text_metrics_w(HDC hdc, LPTEXTMETRICW lptmw)
169 {
170   static GetTextMetricsW_Proc s_pfn_Get_Text_MetricsW = NULL;
171   HMODULE hm_unicows = NULL;
172   if (g_b_init_get_text_metrics_w == 0)
173     {
174       g_b_init_get_text_metrics_w = 1;
175       hm_unicows = w32_load_unicows_or_gdi32 ();
176       if (hm_unicows)
177 	s_pfn_Get_Text_MetricsW = (GetTextMetricsW_Proc)
178 	  get_proc_addr (hm_unicows, "GetTextMetricsW");
179     }
180   eassert (s_pfn_Get_Text_MetricsW != NULL);
181   return s_pfn_Get_Text_MetricsW (hdc, lptmw);
182 }
183 
184 static DWORD WINAPI
get_glyph_outline_w(HDC hdc,UINT uChar,UINT uFormat,LPGLYPHMETRICS lpgm,DWORD cbBuffer,LPVOID lpvBuffer,const MAT2 * lpmat2)185 get_glyph_outline_w (HDC hdc, UINT uChar, UINT uFormat, LPGLYPHMETRICS lpgm,
186 		     DWORD cbBuffer, LPVOID lpvBuffer, const MAT2 *lpmat2)
187 {
188   static GetGlyphOutlineW_Proc s_pfn_Get_Glyph_OutlineW = NULL;
189   HMODULE hm_unicows = NULL;
190   if (g_b_init_get_glyph_outline_w == 0)
191     {
192       g_b_init_get_glyph_outline_w = 1;
193       hm_unicows = w32_load_unicows_or_gdi32 ();
194       if (hm_unicows)
195 	s_pfn_Get_Glyph_OutlineW = (GetGlyphOutlineW_Proc)
196 	  get_proc_addr (hm_unicows, "GetGlyphOutlineW");
197     }
198   eassert (s_pfn_Get_Glyph_OutlineW != NULL);
199   return s_pfn_Get_Glyph_OutlineW (hdc, uChar, uFormat, lpgm, cbBuffer,
200 				   lpvBuffer, lpmat2);
201 }
202 
203 static DWORD WINAPI
get_char_width_32_w(HDC hdc,UINT uFirstChar,UINT uLastChar,LPINT lpBuffer)204 get_char_width_32_w (HDC hdc, UINT uFirstChar, UINT uLastChar, LPINT lpBuffer)
205 {
206   static GetCharWidth32W_Proc s_pfn_Get_Char_Width_32W = NULL;
207   HMODULE hm_unicows = NULL;
208   if (g_b_init_get_char_width_32_w == 0)
209     {
210       g_b_init_get_char_width_32_w = 1;
211       hm_unicows = w32_load_unicows_or_gdi32 ();
212       if (hm_unicows)
213 	s_pfn_Get_Char_Width_32W = (GetCharWidth32W_Proc)
214 	  get_proc_addr (hm_unicows, "GetCharWidth32W");
215     }
216   eassert (s_pfn_Get_Char_Width_32W != NULL);
217   return s_pfn_Get_Char_Width_32W (hdc, uFirstChar, uLastChar, lpBuffer);
218 }
219 
220 #else  /* Cygwin */
221 
222 /* Cygwin doesn't support Windows 9X, and links against GDI32.DLL, so
223    it can just call these functions directly.  */
224 #define get_outline_metrics_w(h,d,o)   GetOutlineTextMetricsW(h,d,o)
225 #define get_text_metrics_w(h,t)        GetTextMetricsW(h,t)
226 #define get_glyph_outline_w(h,uc,f,gm,b,v,m) \
227                                        GetGlyphOutlineW(h,uc,f,gm,b,v,m)
228 #define get_char_width_32_w(h,fc,lc,b) GetCharWidth32W(h,fc,lc,b)
229 
230 #endif	/* Cygwin */
231 
232 static int
memq_no_quit(Lisp_Object elt,Lisp_Object list)233 memq_no_quit (Lisp_Object elt, Lisp_Object list)
234 {
235   while (CONSP (list) && ! EQ (XCAR (list), elt))
236     list = XCDR (list);
237   return (CONSP (list));
238 }
239 
240 Lisp_Object
intern_font_name(char * string)241 intern_font_name (char * string)
242 {
243   Lisp_Object str = DECODE_SYSTEM (build_string (string));
244   ptrdiff_t len = SCHARS (str);
245   Lisp_Object obarray = check_obarray (Vobarray);
246   Lisp_Object tem = oblookup (obarray, SSDATA (str), len, len);
247   /* This code is similar to intern function from lread.c.  */
248   return SYMBOLP (tem) ? tem : intern_driver (str, obarray, tem);
249 }
250 
251 /* w32 implementation of get_cache for font backend.
252    Return a cache of font-entities on FRAME.  The cache must be a
253    cons whose cdr part is the actual cache area.  */
254 Lisp_Object
w32font_get_cache(struct frame * f)255 w32font_get_cache (struct frame *f)
256 {
257   struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
258 
259   return (dpyinfo->name_list_element);
260 }
261 
262 /* w32 implementation of list for font backend.
263    List fonts exactly matching with FONT_SPEC on FRAME.  The value
264    is a vector of font-entities.  This is the sole API that
265    allocates font-entities.  */
266 static Lisp_Object
w32font_list(struct frame * f,Lisp_Object font_spec)267 w32font_list (struct frame *f, Lisp_Object font_spec)
268 {
269   Lisp_Object fonts = w32font_list_internal (f, font_spec, 0);
270   FONT_ADD_LOG ("w32font-list", font_spec, fonts);
271   return fonts;
272 }
273 
274 /* w32 implementation of match for font backend.
275    Return a font entity most closely matching with FONT_SPEC on
276    FRAME.  The closeness is determined by the font backend, thus
277    `face-font-selection-order' is ignored here.  */
278 static Lisp_Object
w32font_match(struct frame * f,Lisp_Object font_spec)279 w32font_match (struct frame *f, Lisp_Object font_spec)
280 {
281   Lisp_Object entity = w32font_match_internal (f, font_spec, 0);
282   FONT_ADD_LOG ("w32font-match", font_spec, entity);
283   return entity;
284 }
285 
286 /* w32 implementation of list_family for font backend.
287    List available families.  The value is a list of family names
288    (symbols).  */
289 static Lisp_Object
w32font_list_family(struct frame * f)290 w32font_list_family (struct frame *f)
291 {
292   Lisp_Object list = Qnil;
293   Lisp_Object prev_quit = Vinhibit_quit;
294   LOGFONT font_match_pattern;
295   HDC dc;
296 
297   memset (&font_match_pattern, 0, sizeof (font_match_pattern));
298   font_match_pattern.lfCharSet = DEFAULT_CHARSET;
299 
300   /* Prevent quitting while EnumFontFamiliesEx runs and conses the
301      list it will return.  That's because get_frame_dc acquires the
302      critical section, so we cannot quit before we release it in
303      release_frame_dc.  */
304   Vinhibit_quit = Qt;
305   dc = get_frame_dc (f);
306 
307   EnumFontFamiliesEx (dc, &font_match_pattern,
308                       (FONTENUMPROC) add_font_name_to_list,
309                       (LPARAM) &list, 0);
310   release_frame_dc (f, dc);
311   Vinhibit_quit = prev_quit;
312 
313   return list;
314 }
315 
316 /* w32 implementation of open for font backend.
317    Open a font specified by FONT_ENTITY on frame F.
318    If the font is scalable, open it with PIXEL_SIZE.  */
319 static Lisp_Object
w32font_open(struct frame * f,Lisp_Object font_entity,int pixel_size)320 w32font_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
321 {
322   Lisp_Object font_object
323     = font_make_object (VECSIZE (struct w32font_info),
324                         font_entity, pixel_size);
325   struct w32font_info *w32_font
326     = (struct w32font_info *) XFONT_OBJECT (font_object);
327 
328   ASET (font_object, FONT_TYPE_INDEX, Qgdi);
329 
330   if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
331     {
332       return Qnil;
333     }
334 
335   /* GDI backend does not use glyph indices.  */
336   w32_font->glyph_idx = 0;
337 
338   return font_object;
339 }
340 
341 /* w32 implementation of close for font_backend.  */
342 void
w32font_close(struct font * font)343 w32font_close (struct font *font)
344 {
345   struct w32font_info *w32_font = (struct w32font_info *) font;
346 
347   if (w32_font->hfont)
348     {
349       /* Delete the GDI font object.  */
350       DeleteObject (w32_font->hfont);
351       w32_font->hfont = NULL;
352 
353       /* Free all the cached metrics.  */
354       if (w32_font->cached_metrics)
355 	{
356 	  int i;
357 
358 	  for (i = 0; i < w32_font->n_cache_blocks; i++)
359 	      xfree (w32_font->cached_metrics[i]);
360 	  xfree (w32_font->cached_metrics);
361 	  w32_font->cached_metrics = NULL;
362 	}
363     }
364 }
365 
366 /* w32 implementation of has_char for font backend.
367    Optional.
368    If FONT_ENTITY has a glyph for character C (Unicode code point),
369    return 1.  If not, return 0.  If a font must be opened to check
370    it, return -1.  */
371 int
w32font_has_char(Lisp_Object entity,int c)372 w32font_has_char (Lisp_Object entity, int c)
373 {
374   /* We can't be certain about which characters a font will support until
375      we open it.  Checking the scripts that the font supports turns out
376      to not be reliable.  */
377   return -1;
378 
379 #if 0
380   Lisp_Object supported_scripts, extra, script;
381   DWORD mask;
382 
383   extra = AREF (entity, FONT_EXTRA_INDEX);
384   if (!CONSP (extra))
385     return -1;
386 
387   supported_scripts = assq_no_quit (QCscript, extra);
388   /* If font doesn't claim to support any scripts, then we can't be certain
389      until we open it.  */
390   if (!CONSP (supported_scripts))
391     return -1;
392 
393   supported_scripts = XCDR (supported_scripts);
394 
395   script = CHAR_TABLE_REF (Vchar_script_table, c);
396 
397   /* If we don't know what script the character is from, then we can't be
398      certain until we open it.  Also if the font claims support for the script
399      the character is from, it may only have partial coverage, so we still
400      can't be certain until we open the font.  */
401   if (NILP (script) || memq_no_quit (script, supported_scripts))
402     return -1;
403 
404   /* Font reports what scripts it supports, and none of them are the script
405      the character is from. But we still can't be certain, as some fonts
406      will contain some/most/all of the characters in that script without
407      claiming support for it.  */
408   return -1;
409 #endif
410 }
411 
412 /* w32 implementation of encode_char for font backend.
413    Return a glyph code of FONT for character C (Unicode code point).
414    If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
415 
416    For speed, the gdi backend uses Unicode (Emacs calls encode_char
417    far too often for it to be efficient). But we still need to detect
418    which characters are not supported by the font.
419   */
420 static unsigned
w32font_encode_char(struct font * font,int c)421 w32font_encode_char (struct font *font, int c)
422 {
423   struct w32font_info * w32_font = (struct w32font_info *)font;
424 
425   if (c < w32_font->metrics.tmFirstChar
426       || c > w32_font->metrics.tmLastChar)
427     return FONT_INVALID_CODE;
428   else
429     return c;
430 }
431 
432 /* w32 implementation of text_extents for font backend.
433    Perform the size computation of glyphs of FONT and fillin members
434    of METRICS.  The glyphs are specified by their glyph codes in
435    CODE (length NGLYPHS).  Apparently metrics can be NULL, in this
436    case just return the overall width.  */
437 void
w32font_text_extents(struct font * font,const unsigned * code,int nglyphs,struct font_metrics * metrics)438 w32font_text_extents (struct font *font, const unsigned *code,
439 		      int nglyphs, struct font_metrics *metrics)
440 {
441   int i;
442   HFONT old_font = NULL;
443   HDC dc = NULL;
444   struct frame * f UNINIT;
445   int total_width = 0;
446   WORD *wcode;
447   SIZE size;
448   bool first;
449   Lisp_Object prev_quit = Vinhibit_quit;
450 
451   struct w32font_info *w32_font = (struct w32font_info *) font;
452 
453   memset (metrics, 0, sizeof (struct font_metrics));
454 
455   for (i = 0, first = true; i < nglyphs; i++)
456     {
457       struct w32_metric_cache *char_metric;
458       int block = *(code + i) / CACHE_BLOCKSIZE;
459       int pos_in_block = *(code + i) % CACHE_BLOCKSIZE;
460 
461       if (block >= w32_font->n_cache_blocks)
462 	{
463 	  if (!w32_font->cached_metrics)
464 	    w32_font->cached_metrics
465 	      = xmalloc ((block + 1)
466 			 * sizeof (struct w32_metric_cache *));
467 	  else
468 	    w32_font->cached_metrics
469 	      = xrealloc (w32_font->cached_metrics,
470 			  (block + 1)
471 			  * sizeof (struct w32_metric_cache *));
472 	  memset (w32_font->cached_metrics + w32_font->n_cache_blocks, 0,
473 		  ((block + 1 - w32_font->n_cache_blocks)
474 		   * sizeof (struct w32_metric_cache *)));
475 	  w32_font->n_cache_blocks = block + 1;
476 	}
477 
478       if (!w32_font->cached_metrics[block])
479 	{
480 	  w32_font->cached_metrics[block]
481 	    = xzalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
482 	}
483 
484       char_metric = w32_font->cached_metrics[block] + pos_in_block;
485 
486       if (char_metric->status == W32METRIC_NO_ATTEMPT)
487 	{
488 	  if (dc == NULL)
489 	    {
490 	      /* TODO: Frames can come and go, and their fonts
491 		 outlive them. So we can't cache the frame in the
492 		 font structure.  Use selected_frame until the API
493 		 is updated to pass in a frame.  */
494 	      f = XFRAME (selected_frame);
495 
496 	      /* Prevent quitting while EnumFontFamiliesEx runs and
497 		 conses the list it will return.  That's because
498 		 get_frame_dc acquires the critical section, so we
499 		 cannot quit before we release it in release_frame_dc.  */
500 	      prev_quit = Vinhibit_quit;
501 	      Vinhibit_quit = Qt;
502 	      dc = get_frame_dc (f);
503 	      old_font = SelectObject (dc, w32_font->hfont);
504 	    }
505 	  compute_metrics (dc, w32_font, *(code + i), char_metric);
506 	}
507 
508       if (char_metric->status == W32METRIC_SUCCESS)
509 	{
510 	  if (first)
511 	    {
512 	      metrics->lbearing = char_metric->lbearing;
513 	      metrics->rbearing = char_metric->rbearing;
514 	      metrics->width    = 0;
515 	      metrics->ascent   = char_metric->ascent;
516 	      metrics->descent  = char_metric->descent;
517 	      first = false;
518 	    }
519 	  if (metrics->lbearing > char_metric->lbearing)
520 	    metrics->lbearing = char_metric->lbearing;
521 	  if (metrics->rbearing < char_metric->rbearing)
522 	    metrics->rbearing = char_metric->rbearing;
523 	  metrics->width += char_metric->width;
524 	  if (metrics->ascent < char_metric->ascent)
525 	    metrics->ascent = char_metric->ascent;
526 	  if (metrics->descent < char_metric->descent)
527 	    metrics->descent = char_metric->descent;
528 	}
529       else
530 	/* If we couldn't get metrics for a char,
531 	   use alternative method.  */
532 	break;
533     }
534   /* If we got through everything, return.  */
535   if (i == nglyphs)
536     {
537       if (dc != NULL)
538 	{
539 	  /* Restore state and release DC.  */
540 	  SelectObject (dc, old_font);
541 	  release_frame_dc (f, dc);
542 	  Vinhibit_quit = prev_quit;
543 	}
544       return;
545     }
546 
547   /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
548      fallback on other methods that will at least give some of the metric
549      information.  */
550 
551   /* Make array big enough to hold surrogates.  */
552   eassume (0 <= nglyphs);	/* pacify GCC warning on next line */
553   wcode = alloca (nglyphs * sizeof (WORD) * 2);
554   for (i = 0; i < nglyphs; i++)
555     {
556       if (code[i] < 0x10000)
557         wcode[i] = code[i];
558       else
559         {
560           DWORD surrogate = code[i] - 0x10000;
561 
562           /* High surrogate: U+D800 - U+DBFF.  */
563           wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
564           /* Low surrogate: U+DC00 - U+DFFF.  */
565           wcode[i] = 0xDC00 + (surrogate & 0x03FF);
566           /* An extra glyph. wcode is already double the size of code to
567              cope with this.  */
568           nglyphs++;
569         }
570     }
571 
572   if (dc == NULL)
573     {
574       /* TODO: Frames can come and go, and their fonts outlive
575 	 them. So we can't cache the frame in the font structure.  Use
576 	 selected_frame until the API is updated to pass in a
577 	 frame.  */
578       f = XFRAME (selected_frame);
579 
580       /* Prevent quitting while EnumFontFamiliesEx runs and conses the
581 	 list it will return.  That's because get_frame_dc acquires
582 	 the critical section, so we cannot quit before we release it
583 	 in release_frame_dc.  */
584       prev_quit = Vinhibit_quit;
585       Vinhibit_quit = Qt;
586       dc = get_frame_dc (f);
587       old_font = SelectObject (dc, w32_font->hfont);
588     }
589 
590   if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
591     {
592       total_width = size.cx;
593     }
594 
595   /* On 95/98/ME, only some Unicode functions are available, so fallback
596      on doing a dummy draw to find the total width.  */
597   if (!total_width)
598     {
599       RECT rect;
600       rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
601       DrawTextW (dc, wcode, nglyphs, &rect,
602                  DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
603       total_width = rect.right;
604     }
605 
606   /* Give our best estimate of the metrics, based on what we know.  */
607   metrics->width = total_width - w32_font->metrics.tmOverhang;
608   metrics->lbearing = 0;
609   metrics->rbearing = total_width;
610   metrics->ascent = font->ascent;
611   metrics->descent = font->descent;
612 
613   /* Restore state and release DC.  */
614   SelectObject (dc, old_font);
615   release_frame_dc (f, dc);
616   Vinhibit_quit = prev_quit;
617 }
618 
619 /* w32 implementation of draw for font backend.
620    Optional.
621    Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
622    position of frame F with S->FACE and S->GC.  If WITH_BACKGROUND,
623    fill the background in advance.  It is assured that WITH_BACKGROUND
624    is false when (FROM > 0 || TO < S->nchars).
625 
626    TODO: Currently this assumes that the colors and fonts are already
627    set in the DC. This seems to be true now, but maybe only due to
628    the old font code setting it up. It may be safer to resolve faces
629    and fonts in here and set them explicitly
630 */
631 
632 int
w32font_draw(struct glyph_string * s,int from,int to,int x,int y,bool with_background)633 w32font_draw (struct glyph_string *s, int from, int to,
634 	      int x, int y, bool with_background)
635 {
636   UINT options;
637   HRGN orig_clip = NULL;
638   int len = to - from;
639   struct w32font_info *w32font = (struct w32font_info *) s->font;
640 
641   options = w32font->glyph_idx;
642 
643   if (s->num_clips > 0)
644     {
645       HRGN new_clip = CreateRectRgnIndirect (s->clip);
646 
647       /* Save clip region for later restoration.  */
648       orig_clip = CreateRectRgn (0, 0, 0, 0);
649       if (!GetClipRgn (s->hdc, orig_clip))
650 	{
651 	  DeleteObject (orig_clip);
652 	  orig_clip = NULL;
653 	}
654 
655       if (s->num_clips > 1)
656         {
657           HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
658 
659           CombineRgn (new_clip, new_clip, clip2, RGN_OR);
660           DeleteObject (clip2);
661         }
662 
663       SelectClipRgn (s->hdc, new_clip);
664       DeleteObject (new_clip);
665     }
666 
667   /* Using OPAQUE background mode can clear more background than expected
668      when Cleartype is used.  Draw the background manually to avoid this.  */
669   SetBkMode (s->hdc, TRANSPARENT);
670   if (with_background)
671     {
672       HBRUSH brush;
673       RECT rect;
674       struct font *font = s->font;
675       int ascent = font->ascent, descent = font->descent;
676 
677       /* Font's global ascent and descent values might be
678 	 preposterously large for some fonts.  We fix here the case
679 	 when those fonts are used for display of glyphless
680 	 characters, because drawing background with font dimensions
681 	 in those cases makes the display illegible.  There's only one
682 	 more call to the draw method with with_background set to
683 	 true, and that's in w32_draw_glyph_string_foreground, when
684 	 drawing the cursor, where we have no such heuristics
685 	 available.  FIXME.  */
686       if (s->first_glyph->type == GLYPHLESS_GLYPH
687 	  && (s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE
688 	      || s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM))
689 	{
690 	  ascent =
691 	    s->first_glyph->slice.glyphless.lower_yoff
692 	    - s->first_glyph->slice.glyphless.upper_yoff;
693 	  descent = 0;
694 	}
695       brush = CreateSolidBrush (s->gc->background);
696       rect.left = x;
697       rect.top = y - ascent;
698       rect.right = x + s->width;
699       rect.bottom = y + descent;
700       FillRect (s->hdc, &rect, brush);
701       DeleteObject (brush);
702     }
703 
704   if (s->padding_p)
705     {
706       int i;
707 
708       for (i = 0; i < len; i++)
709 	{
710 	  WCHAR c = s->char2b[from + i] & 0xFFFF;
711 	  ExtTextOutW (s->hdc, x + i, y, options, NULL, &c, 1, NULL);
712 	}
713     }
714   else
715     {
716       /* The number of glyphs in a glyph_string cannot be larger than
717 	 the maximum value of the 'used' member of a glyph_row, so we
718 	 are OK using alloca here.  */
719       eassert (len <= SHRT_MAX);
720       WCHAR *chars = alloca (len * sizeof (WCHAR));
721       int j;
722       for (j = 0; j < len; j++)
723 	chars[j] = s->char2b[from + j] & 0xFFFF;
724       ExtTextOutW (s->hdc, x, y, options, NULL, chars, len, NULL);
725     }
726 
727   /* Restore clip region.  */
728   if (s->num_clips > 0)
729     SelectClipRgn (s->hdc, orig_clip);
730 
731   if (orig_clip)
732     DeleteObject (orig_clip);
733 
734   return len;
735 }
736 
737 /* w32 implementation of free_entity for font backend.
738    Optional.
739    Free FONT_EXTRA_INDEX field of FONT_ENTITY.
740 static void
741 w32font_free_entity (Lisp_Object entity);
742   */
743 
744 /* w32 implementation of prepare_face for font backend.
745    Optional (if FACE->extra is not used).
746    Prepare FACE for displaying characters by FONT on frame F by
747    storing some data in FACE->extra.  If successful, return 0.
748    Otherwise, return -1.
749 static int
750 w32font_prepare_face (struct frame *f, struct face *face);
751   */
752 /* w32 implementation of done_face for font backend.
753    Optional.
754    Done FACE for displaying characters by FACE->font on frame F.
755 static void
756 w32font_done_face (struct frame *f, struct face *face);  */
757 
758 /* w32 implementation of get_bitmap for font backend.
759    Optional.
760    Store bitmap data for glyph-code CODE of FONT in BITMAP.  It is
761    intended that this method is called from the other font-driver
762    for actual drawing.
763 static int
764 w32font_get_bitmap (struct font *font, unsigned code,
765                     struct font_bitmap *bitmap, int bits_per_pixel);
766   */
767 /* w32 implementation of free_bitmap for font backend.
768    Optional.
769    Free bitmap data in BITMAP.
770 static void
771 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
772   */
773 /* w32 implementation of anchor_point for font backend.
774    Optional.
775    Get coordinates of the INDEXth anchor point of the glyph whose
776    code is CODE.  Store the coordinates in *X and *Y.  Return 0 if
777    the operations was successful.  Otherwise return -1.
778 static int
779 w32font_anchor_point (struct font *font, unsigned code,
780                                  int index, int *x, int *y);
781   */
782 /* w32 implementation of otf_capability for font backend.
783    Optional.
784    Return a list describing which scripts/languages FONT
785    supports by which GSUB/GPOS features of OpenType tables.
786 static Lisp_Object
787 w32font_otf_capability (struct font *font);
788   */
789 /* w32 implementation of otf_drive for font backend.
790    Optional.
791    Apply FONT's OTF-FEATURES to the glyph string.
792 
793    FEATURES specifies which OTF features to apply in this format:
794       (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
795    See the documentation of `font-drive-otf' for the detail.
796 
797    This method applies the specified features to the codes in the
798    elements of GSTRING-IN (between FROMth and TOth).  The output
799    codes are stored in GSTRING-OUT at the IDXth element and the
800    following elements.
801 
802    Return the number of output codes.  If none of the features are
803    applicable to the input data, return 0.  If GSTRING-OUT is too
804    short, return -1.
805 static int
806 w32font_otf_drive (struct font *font, Lisp_Object features,
807                    Lisp_Object gstring_in, int from, int to,
808                    Lisp_Object gstring_out, int idx,
809                    bool alternate_subst);
810   */
811 
812 /* Internal implementation of w32font_list.
813    Additional parameter opentype_only restricts the returned fonts to
814    opentype fonts, which can be used with the Uniscribe backend.  */
815 Lisp_Object
w32font_list_internal(struct frame * f,Lisp_Object font_spec,bool opentype_only)816 w32font_list_internal (struct frame *f, Lisp_Object font_spec,
817 		       bool opentype_only)
818 {
819   struct font_callback_data match_data;
820   HDC dc;
821 
822   match_data.orig_font_spec = font_spec;
823   match_data.list = Qnil;
824   XSETFRAME (match_data.frame, f);
825 
826   memset (&match_data.pattern, 0, sizeof (LOGFONT));
827   fill_in_logfont (f, &match_data.pattern, font_spec);
828 
829   /* If the charset is unrecognized, then we won't find a font, so don't
830      waste time looking for one.  */
831   if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
832     {
833       Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
834       if (!NILP (spec_charset)
835 	  && !EQ (spec_charset, Qiso10646_1)
836 	  && !EQ (spec_charset, Qunicode_bmp)
837 	  && !EQ (spec_charset, Qunicode_sip)
838 	  && !EQ (spec_charset, Qunknown)
839 	  && !EQ (spec_charset, Qascii_0))
840 	return Qnil;
841     }
842 
843   match_data.opentype_only = opentype_only;
844   if (opentype_only)
845     match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
846   match_data.known_fonts = Qnil;
847   Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val;
848   if (CONSP (vw32_non_USB_fonts))
849     {
850       Lisp_Object extra;
851       for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
852 	   CONSP (extra); extra = XCDR (extra))
853 	{
854 	  Lisp_Object tem = XCAR (extra);
855 	  if (CONSP (tem)
856 	      && EQ (XCAR (tem), QCscript)
857 	      && SYMBOLP (XCDR (tem))
858 	      && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts)))
859 	    {
860 	      match_data.known_fonts = XCDR (val);
861 	      break;
862 	    }
863 	}
864     }
865 
866   if (match_data.pattern.lfFaceName[0] == '\0')
867     {
868       /* EnumFontFamiliesEx does not take other fields into account if
869          font name is blank, so need to use two passes.  */
870       list_all_matching_fonts (&match_data);
871     }
872   else
873     {
874       Lisp_Object prev_quit = Vinhibit_quit;
875 
876       /* Prevent quitting while EnumFontFamiliesEx runs and conses the
877 	 list it will return.  That's because get_frame_dc acquires
878 	 the critical section, so we cannot quit before we release it
879 	 in release_frame_dc.  */
880       Vinhibit_quit = Qt;
881       dc = get_frame_dc (f);
882 
883       EnumFontFamiliesEx (dc, &match_data.pattern,
884                           (FONTENUMPROC) add_font_entity_to_list,
885                           (LPARAM) &match_data, 0);
886       release_frame_dc (f, dc);
887       Vinhibit_quit = prev_quit;
888     }
889 
890   return match_data.list;
891 }
892 
893 /* Internal implementation of w32font_match.
894    Additional parameter opentype_only restricts the returned fonts to
895    opentype fonts, which can be used with the Uniscribe backend.  */
896 Lisp_Object
w32font_match_internal(struct frame * f,Lisp_Object font_spec,bool opentype_only)897 w32font_match_internal (struct frame *f, Lisp_Object font_spec,
898 			bool opentype_only)
899 {
900   struct font_callback_data match_data;
901   HDC dc;
902 
903   match_data.orig_font_spec = font_spec;
904   XSETFRAME (match_data.frame, f);
905   match_data.list = Qnil;
906 
907   memset (&match_data.pattern, 0, sizeof (LOGFONT));
908   fill_in_logfont (f, &match_data.pattern, font_spec);
909 
910   match_data.opentype_only = opentype_only;
911   if (opentype_only)
912     match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
913 
914   match_data.known_fonts = Qnil;
915   Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val;
916   if (CONSP (vw32_non_USB_fonts))
917     {
918       Lisp_Object extra;
919       for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
920 	   CONSP (extra); extra = XCDR (extra))
921 	{
922 	  Lisp_Object tem = XCAR (extra);
923 	  if (CONSP (tem)
924 	      && EQ (XCAR (tem), QCscript)
925 	      && SYMBOLP (XCDR (tem))
926 	      && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts)))
927 	    {
928 	      match_data.known_fonts = XCDR (val);
929 	      break;
930 	    }
931 	}
932     }
933 
934   /* Prevent quitting while EnumFontFamiliesEx runs and conses the
935      list it will return.  That's because get_frame_dc acquires the
936      critical section, so we cannot quit before we release it in
937      release_frame_dc.  */
938   Lisp_Object prev_quit = Vinhibit_quit;
939   Vinhibit_quit = Qt;
940   dc = get_frame_dc (f);
941 
942   EnumFontFamiliesEx (dc, &match_data.pattern,
943                       (FONTENUMPROC) add_one_font_entity_to_list,
944                       (LPARAM) &match_data, 0);
945   release_frame_dc (f, dc);
946   Vinhibit_quit = prev_quit;
947 
948   return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
949 }
950 
951 int
w32font_open_internal(struct frame * f,Lisp_Object font_entity,int pixel_size,Lisp_Object font_object)952 w32font_open_internal (struct frame *f, Lisp_Object font_entity,
953 		       int pixel_size, Lisp_Object font_object)
954 {
955   int len, size;
956   LOGFONT logfont;
957   HDC dc;
958   HFONT hfont, old_font;
959   Lisp_Object val;
960   struct w32font_info *w32_font;
961   struct font * font;
962   OUTLINETEXTMETRICW* metrics = NULL;
963 
964   w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
965   font = (struct font *) w32_font;
966 
967   if (!font)
968     return 0;
969 
970   memset (&logfont, 0, sizeof (logfont));
971   fill_in_logfont (f, &logfont, font_entity);
972 
973   /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
974      limitations in bitmap fonts.  */
975   val = AREF (font_entity, FONT_FOUNDRY_INDEX);
976   if (!EQ (val, Qraster))
977     logfont.lfOutPrecision = OUT_TT_PRECIS;
978 
979   size = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX));
980   if (!size)
981     size = pixel_size;
982 
983   logfont.lfHeight = -size;
984   hfont = CreateFontIndirect (&logfont);
985 
986   if (hfont == NULL)
987     return 0;
988 
989   /* Get the metrics for this font.  */
990   dc = get_frame_dc (f);
991   old_font = SelectObject (dc, hfont);
992 
993   /* Try getting the outline metrics (only works for truetype fonts).  */
994   len = get_outline_metrics_w (dc, 0, NULL);
995   if (len)
996     {
997       metrics = (OUTLINETEXTMETRICW *) alloca (len);
998       if (get_outline_metrics_w (dc, len, metrics))
999         memcpy (&w32_font->metrics, &metrics->otmTextMetrics,
1000 		sizeof (TEXTMETRICW));
1001       else
1002         metrics = NULL;
1003     }
1004 
1005   if (!metrics)
1006     get_text_metrics_w (dc, &w32_font->metrics);
1007 
1008   w32_font->cached_metrics = NULL;
1009   w32_font->n_cache_blocks = 0;
1010 
1011   SelectObject (dc, old_font);
1012   release_frame_dc (f, dc);
1013 
1014   w32_font->hfont = hfont;
1015 
1016   {
1017     char *name;
1018 
1019     /* We don't know how much space we need for the full name, so start with
1020        96 bytes and go up in steps of 32.  */
1021     len = 96;
1022     name = alloca (len);
1023     while (name && w32font_full_name (&logfont, font_entity, pixel_size,
1024                                       name, len) < 0)
1025       {
1026         len += 32;
1027         name = alloca (len);
1028       }
1029     if (name)
1030       font->props[FONT_FULLNAME_INDEX]
1031         = DECODE_SYSTEM (build_string (name));
1032     else
1033       font->props[FONT_FULLNAME_INDEX]
1034 	= DECODE_SYSTEM (build_string (logfont.lfFaceName));
1035   }
1036 
1037   font->max_width = w32_font->metrics.tmMaxCharWidth;
1038   /* Parts of Emacs display assume that height = ascent + descent...
1039      so height is defined later, after ascent and descent.
1040   font->height = w32_font->metrics.tmHeight
1041     + w32_font->metrics.tmExternalLeading;
1042   */
1043 
1044   font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
1045 
1046   font->vertical_centering = 0;
1047   font->baseline_offset = 0;
1048   font->relative_compose = 0;
1049   font->default_ascent = w32_font->metrics.tmAscent;
1050   font->pixel_size = size;
1051   font->driver = &w32font_driver;
1052   font->encoding_charset = -1;
1053   font->repertory_charset = -1;
1054   /* TODO: do we really want the minimum width here, which could be negative? */
1055   font->min_width = font->space_width;
1056   font->ascent = w32_font->metrics.tmAscent;
1057   font->descent = w32_font->metrics.tmDescent;
1058   font->height = font->ascent + font->descent;
1059 
1060   if (metrics)
1061     {
1062       font->underline_thickness = metrics->otmsUnderscoreSize;
1063       font->underline_position = -metrics->otmsUnderscorePosition;
1064     }
1065   else
1066     {
1067       font->underline_thickness = 0;
1068       font->underline_position = -1;
1069     }
1070 
1071   /* For temporary compatibility with legacy code that expects the
1072      name to be usable in x-list-fonts. Eventually we expect to change
1073      x-list-fonts and other places that use fonts so that this can be
1074      an fcname or similar.  */
1075   font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
1076 
1077   return 1;
1078 }
1079 
1080 /* Callback function for EnumFontFamiliesEx.
1081  * Adds the name of a font to a Lisp list (passed in as the lParam arg).  */
1082 static int CALLBACK ALIGN_STACK
add_font_name_to_list(ENUMLOGFONTEX * logical_font,NEWTEXTMETRICEX * physical_font,DWORD font_type,LPARAM list_object)1083 add_font_name_to_list (ENUMLOGFONTEX *logical_font,
1084 		       NEWTEXTMETRICEX *physical_font,
1085 		       DWORD font_type, LPARAM list_object)
1086 {
1087   Lisp_Object* list = (Lisp_Object *) list_object;
1088   Lisp_Object family;
1089 
1090   /* Skip vertical fonts (intended only for printing)  */
1091   if (logical_font->elfLogFont.lfFaceName[0] == '@')
1092     return 1;
1093 
1094   family = intern_font_name (logical_font->elfLogFont.lfFaceName);
1095   if (! memq_no_quit (family, *list))
1096     *list = Fcons (family, *list);
1097 
1098   return 1;
1099 }
1100 
1101 static int w32_decode_weight (int);
1102 static int w32_encode_weight (int);
1103 
1104 /* Convert an enumerated Windows font to an Emacs font entity.  */
1105 static Lisp_Object
w32_enumfont_pattern_entity(Lisp_Object frame,ENUMLOGFONTEX * logical_font,NEWTEXTMETRICEX * physical_font,DWORD font_type,LOGFONT * requested_font,Lisp_Object backend)1106 w32_enumfont_pattern_entity (Lisp_Object frame,
1107 			     ENUMLOGFONTEX *logical_font,
1108 			     NEWTEXTMETRICEX *physical_font,
1109 			     DWORD font_type,
1110 			     LOGFONT *requested_font,
1111 			     Lisp_Object backend)
1112 {
1113   Lisp_Object entity, tem;
1114   LOGFONT *lf = (LOGFONT*) logical_font;
1115   BYTE generic_type;
1116   DWORD full_type = physical_font->ntmTm.ntmFlags;
1117 
1118   entity = font_make_entity ();
1119 
1120   ASET (entity, FONT_TYPE_INDEX, backend);
1121   ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
1122   ASET (entity, FONT_OBJLIST_INDEX, Qnil);
1123 
1124   /* Foundry is difficult to get in readable form on Windows.
1125      But Emacs crashes if it is not set, so set it to something more
1126      generic.  These values make xlfds compatible with Emacs 22. */
1127   if (lf->lfOutPrecision == OUT_STRING_PRECIS)
1128     tem = Qraster;
1129   else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
1130     tem = Qoutline;
1131   else
1132     tem = Qunknown;
1133 
1134   ASET (entity, FONT_FOUNDRY_INDEX, tem);
1135 
1136   /* Save the generic family in the extra info, as it is likely to be
1137      useful to users looking for a close match.  */
1138   generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
1139   if (generic_type == FF_DECORATIVE)
1140     tem = Qdecorative;
1141   else if (generic_type == FF_MODERN)
1142     tem = Qmono;
1143   else if (generic_type == FF_ROMAN)
1144     tem = Qserif;
1145   else if (generic_type == FF_SCRIPT)
1146     tem = Qscript;
1147   else if (generic_type == FF_SWISS)
1148     tem = Qsans;
1149   else
1150     tem = Qnil;
1151 
1152   ASET (entity, FONT_ADSTYLE_INDEX, tem);
1153 
1154   if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
1155     ASET (entity, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_PROPORTIONAL));
1156   else
1157     ASET (entity, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_CHARCELL));
1158 
1159   if (requested_font->lfQuality != DEFAULT_QUALITY)
1160     {
1161       font_put_extra (entity, QCantialias,
1162                       lispy_antialias_type (requested_font->lfQuality));
1163     }
1164   ASET (entity, FONT_FAMILY_INDEX,
1165 	intern_font_name (lf->lfFaceName));
1166 
1167   FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
1168 		  make_fixnum (w32_decode_weight (lf->lfWeight)));
1169   FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
1170 		  make_fixnum (lf->lfItalic ? 200 : 100));
1171   /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1172      to get it.  */
1173   FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_fixnum (100));
1174 
1175   if (font_type & RASTER_FONTTYPE)
1176     ASET (entity, FONT_SIZE_INDEX,
1177           make_fixnum (physical_font->ntmTm.tmHeight
1178                        + physical_font->ntmTm.tmExternalLeading));
1179   else
1180     ASET (entity, FONT_SIZE_INDEX, make_fixnum (0));
1181 
1182   /* Cache Unicode codepoints covered by this font, as there is no other way
1183      of getting this information easily.  */
1184   if (font_type & TRUETYPE_FONTTYPE)
1185     {
1186       tem = font_supported_scripts (&physical_font->ntmFontSig);
1187       if (!NILP (tem))
1188         font_put_extra (entity, QCscript, tem);
1189     }
1190 
1191   /* This information is not fully available when opening fonts, so
1192      save it here.  Only Windows 2000 and later return information
1193      about opentype and type1 fonts, so need a fallback for detecting
1194      truetype so that this information is not any worse than we could
1195      have obtained later.  */
1196   if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
1197     tem = Qopentype;
1198   else if (font_type & TRUETYPE_FONTTYPE)
1199     tem = intern ("truetype");
1200   else if (full_type & NTM_PS_OPENTYPE)
1201     tem = Qpostscript;
1202   else if (full_type & NTM_TYPE1)
1203     tem = intern ("type1");
1204   else if (font_type & RASTER_FONTTYPE)
1205     tem = intern ("w32bitmap");
1206   else
1207     tem = intern ("w32vector");
1208 
1209   font_put_extra (entity, QCformat, tem);
1210 
1211   return entity;
1212 }
1213 
1214 
1215 /* Convert generic families to the family portion of lfPitchAndFamily.  */
1216 static BYTE
w32_generic_family(Lisp_Object name)1217 w32_generic_family (Lisp_Object name)
1218 {
1219   /* Generic families.  */
1220   if (EQ (name, Qmonospace) || EQ (name, Qmono))
1221     return FF_MODERN;
1222   else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
1223     return FF_SWISS;
1224   else if (EQ (name, Qserif))
1225     return FF_ROMAN;
1226   else if (EQ (name, Qdecorative))
1227     return FF_DECORATIVE;
1228   else if (EQ (name, Qscript))
1229     return FF_SCRIPT;
1230   else
1231     return FF_DONTCARE;
1232 }
1233 
1234 static int
logfonts_match(LOGFONT * font,LOGFONT * pattern)1235 logfonts_match (LOGFONT *font, LOGFONT *pattern)
1236 {
1237   /* Only check height for raster fonts.  */
1238   if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
1239       && font->lfHeight != pattern->lfHeight)
1240     return 0;
1241 
1242   /* Have some flexibility with weights.  */
1243   if (pattern->lfWeight
1244       && ((font->lfWeight < (pattern->lfWeight - 150))
1245           || font->lfWeight > (pattern->lfWeight + 150)))
1246       return 0;
1247 
1248   /* Charset and face should be OK.  Italic has to be checked
1249      against the original spec, in case we don't have any preference.  */
1250   return 1;
1251 }
1252 
1253 /* Codepage Bitfields in FONTSIGNATURE struct.  */
1254 #define CSB_JAPANESE (1 << 17)
1255 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1256 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1257 
1258 static int
font_matches_spec(DWORD type,NEWTEXTMETRICEX * font,Lisp_Object spec,Lisp_Object backend,LOGFONT * logfont)1259 font_matches_spec (DWORD type, NEWTEXTMETRICEX *font,
1260 		   Lisp_Object spec, Lisp_Object backend,
1261 		   LOGFONT *logfont)
1262 {
1263   Lisp_Object extra, val;
1264 
1265   /* Check italic. Can't check logfonts, since it is a boolean field,
1266      so there is no difference between "non-italic" and "don't care".  */
1267   {
1268     int slant = FONT_SLANT_NUMERIC (spec);
1269 
1270     if (slant >= 0
1271 	&& ((slant > 150 && !font->ntmTm.tmItalic)
1272 	    || (slant <= 150 && font->ntmTm.tmItalic)))
1273 	  return 0;
1274   }
1275 
1276   /* Check adstyle against generic family.  */
1277   val = AREF (spec, FONT_ADSTYLE_INDEX);
1278   if (!NILP (val))
1279     {
1280       BYTE family = w32_generic_family (val);
1281       if (family != FF_DONTCARE
1282           && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
1283         return 0;
1284     }
1285 
1286   /* Check spacing */
1287   val = AREF (spec, FONT_SPACING_INDEX);
1288   if (FIXNUMP (val))
1289     {
1290       int spacing = XFIXNUM (val);
1291       int proportional = (spacing < FONT_SPACING_MONO);
1292 
1293       if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
1294 	  || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
1295 	return 0;
1296     }
1297 
1298   /* Check extra parameters.  */
1299   for (extra = AREF (spec, FONT_EXTRA_INDEX);
1300        CONSP (extra); extra = XCDR (extra))
1301     {
1302       Lisp_Object extra_entry;
1303       extra_entry = XCAR (extra);
1304       if (CONSP (extra_entry))
1305         {
1306           Lisp_Object key = XCAR (extra_entry);
1307 
1308           val = XCDR (extra_entry);
1309           if (EQ (key, QCscript) && SYMBOLP (val))
1310             {
1311               /* Only truetype fonts will have information about what
1312                  scripts they support.  This probably means the user
1313                  will have to force Emacs to use raster, PostScript
1314                  or ATM fonts for non-ASCII text.  */
1315               if (type & TRUETYPE_FONTTYPE)
1316                 {
1317                   Lisp_Object support
1318                     = font_supported_scripts (&font->ntmFontSig);
1319                   if (! memq_no_quit (val, support))
1320                     return 0;
1321 
1322 		  /* Avoid using non-Japanese fonts for Japanese, even
1323 		     if they claim they are capable, due to known
1324 		     breakage in Vista and Windows 7 fonts
1325 		     (bug#6029).  */
1326 		  if (EQ (val, Qkana)
1327 		      && (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET
1328 			  || !(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE)))
1329 		    return 0;
1330                 }
1331               else
1332                 {
1333                   /* Return specific matches, but play it safe. Fonts
1334                      that cover more than their charset would suggest
1335                      are likely to be truetype or opentype fonts,
1336                      covered above.  */
1337                   if (EQ (val, Qlatin))
1338                     {
1339                       /* Although every charset but symbol, thai and
1340                          arabic contains the basic ASCII set of latin
1341                          characters, Emacs expects much more.  */
1342                       if (font->ntmTm.tmCharSet != ANSI_CHARSET)
1343                         return 0;
1344                     }
1345                   else if (EQ (val, Qsymbol))
1346                     {
1347                       if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
1348                         return 0;
1349                     }
1350                   else if (EQ (val, Qcyrillic))
1351                     {
1352                       if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
1353                         return 0;
1354                     }
1355                   else if (EQ (val, Qgreek))
1356                     {
1357                       if (font->ntmTm.tmCharSet != GREEK_CHARSET)
1358                         return 0;
1359                     }
1360                   else if (EQ (val, Qarabic))
1361                     {
1362                       if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
1363                         return 0;
1364                     }
1365                   else if (EQ (val, Qhebrew))
1366                     {
1367                       if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
1368                         return 0;
1369                     }
1370                   else if (EQ (val, Qthai))
1371                     {
1372                       if (font->ntmTm.tmCharSet != THAI_CHARSET)
1373                         return 0;
1374                     }
1375                   else if (EQ (val, Qkana))
1376                     {
1377                       if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1378                         return 0;
1379                     }
1380                   else if (EQ (val, Qbopomofo))
1381                     {
1382                       if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1383                         return 0;
1384                     }
1385                   else if (EQ (val, Qhangul))
1386                     {
1387                       if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1388                           && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1389                         return 0;
1390                     }
1391                   else if (EQ (val, Qhan))
1392                     {
1393                       if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1394                           && font->ntmTm.tmCharSet != GB2312_CHARSET
1395                           && font->ntmTm.tmCharSet != HANGUL_CHARSET
1396                           && font->ntmTm.tmCharSet != JOHAB_CHARSET
1397                           && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1398                         return 0;
1399                     }
1400                   else
1401                     /* Other scripts unlikely to be handled by non-truetype
1402 		       fonts.  */
1403                     return 0;
1404                 }
1405             }
1406 	  else if (EQ (key, QClang) && SYMBOLP (val))
1407 	    {
1408 	      /* Just handle the CJK languages here, as the lang
1409 		 parameter is used to select a font with appropriate
1410 		 glyphs in the cjk unified ideographs block. Other fonts
1411 	         support for a language can be solely determined by
1412 	         its character coverage.  */
1413 	      if (EQ (val, Qja))
1414 		{
1415 		  if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1416 		    return 0;
1417 		}
1418 	      else if (EQ (val, Qko))
1419 		{
1420 		  if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
1421 		    return 0;
1422 		}
1423 	      else if (EQ (val, Qzh))
1424 		{
1425 		  if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
1426                     return 0;
1427 		}
1428 	      else
1429 		/* Any other language, we don't recognize it. Only the above
1430                    currently appear in fontset.el, so it isn't worth
1431                    creating a mapping table of codepages/scripts to languages
1432                    or opening the font to see if there are any language tags
1433                    in it that the Windows API does not expose. Fontset
1434 		   spec should have a fallback, as some backends do
1435 		   not recognize language at all.  */
1436 		return 0;
1437 	    }
1438           else if (EQ (key, QCotf) && CONSP (val))
1439 	    {
1440 	      /* OTF features only supported by the uniscribe backend.  */
1441 	      if (EQ (backend, Quniscribe))
1442 		{
1443 		  if (!uniscribe_check_otf (logfont, val))
1444 		    return 0;
1445 		}
1446 	      else
1447 		return 0;
1448 	    }
1449         }
1450     }
1451   return 1;
1452 }
1453 
1454 static int
w32font_coverage_ok(FONTSIGNATURE * coverage,BYTE charset)1455 w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset)
1456 {
1457   DWORD subrange1 = coverage->fsUsb[1];
1458 
1459 #define SUBRANGE1_HAN_MASK 0x08000000
1460 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1461 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1462 
1463   if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET)
1464     {
1465       return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK;
1466     }
1467   else if (charset == SHIFTJIS_CHARSET)
1468     {
1469       return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK;
1470     }
1471   else if (charset == HANGEUL_CHARSET)
1472     {
1473       return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK;
1474     }
1475 
1476   return 1;
1477 }
1478 
1479 #ifndef WINDOWSNT
1480 #define _strlwr strlwr
1481 #endif /* !WINDOWSNT */
1482 
1483 static int
check_face_name(LOGFONT * font,char * full_name)1484 check_face_name (LOGFONT *font, char *full_name)
1485 {
1486   char full_iname[LF_FULLFACESIZE+1];
1487 
1488   /* Just check for names known to cause problems, since the full name
1489      can contain expanded abbreviations, prefixed foundry, postfixed
1490      style, the latter of which sometimes differs from the style indicated
1491      in the shorter name (eg Lt becomes Light or even Extra Light)  */
1492 
1493   /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1494      installed, we run into problems with the Uniscribe backend which tries
1495      to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1496      with Arial's characteristics, since that attempt to use TrueType works
1497      some places, but not others.  */
1498   if (!xstrcasecmp (font->lfFaceName, "helvetica"))
1499     {
1500       strncpy (full_iname, full_name, LF_FULLFACESIZE);
1501       full_iname[LF_FULLFACESIZE] = 0;
1502       _strlwr (full_iname);
1503       return strstr ("helvetica", full_iname) != NULL;
1504     }
1505   /* Same for Helv.  */
1506   if (!xstrcasecmp (font->lfFaceName, "helv"))
1507     {
1508       strncpy (full_iname, full_name, LF_FULLFACESIZE);
1509       full_iname[LF_FULLFACESIZE] = 0;
1510       _strlwr (full_iname);
1511       return strstr ("helv", full_iname) != NULL;
1512     }
1513 
1514   /* Since Times is mapped to Times New Roman, a substring
1515      match is not sufficient to filter out the bogus match.  */
1516   else if (!xstrcasecmp (font->lfFaceName, "times"))
1517     return xstrcasecmp (full_name, "times") == 0;
1518 
1519   return 1;
1520 }
1521 
1522 
1523 /* Callback function for EnumFontFamiliesEx.
1524  * Checks if a font matches everything we are trying to check against,
1525  * and if so, adds it to a list. Both the data we are checking against
1526  * and the list to which the fonts are added are passed in via the
1527  * lparam argument, in the form of a font_callback_data struct. */
1528 static int CALLBACK ALIGN_STACK
add_font_entity_to_list(ENUMLOGFONTEX * logical_font,NEWTEXTMETRICEX * physical_font,DWORD font_type,LPARAM lParam)1529 add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1530 			 NEWTEXTMETRICEX *physical_font,
1531 			 DWORD font_type, LPARAM lParam)
1532 {
1533   struct font_callback_data *match_data
1534     = (struct font_callback_data *) lParam;
1535   Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
1536   Lisp_Object entity;
1537 
1538   int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1539     || physical_font->ntmFontSig.fsUsb[2]
1540     || physical_font->ntmFontSig.fsUsb[1]
1541     || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1542 
1543   /* Skip non matching fonts.  */
1544 
1545   /* For uniscribe backend, consider only truetype or opentype fonts
1546      that have some Unicode coverage.  */
1547   if (match_data->opentype_only
1548       && ((!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
1549 	   && !(font_type & TRUETYPE_FONTTYPE))
1550 	  || !is_unicode))
1551     return 1;
1552 
1553   /* Ensure a match.  */
1554   if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1555       || !(font_matches_spec (font_type, physical_font,
1556 			      match_data->orig_font_spec, backend,
1557 			      &logical_font->elfLogFont)
1558 	   || (!NILP (match_data->known_fonts)
1559 	       && memq_no_quit
1560 	            (intern_font_name (logical_font->elfLogFont.lfFaceName),
1561 		     match_data->known_fonts)))
1562       || !w32font_coverage_ok (&physical_font->ntmFontSig,
1563 			       match_data->pattern.lfCharSet))
1564     return 1;
1565 
1566   /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1567      We limit this to raster fonts, because the test can catch some
1568      genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1569      DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1570      therefore get through this test.  Since full names can be prefixed
1571      by a foundry, we accept raster fonts if the font name is found
1572      anywhere within the full name.  */
1573   if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
1574        && !strstr ((char *)logical_font->elfFullName,
1575 		   logical_font->elfLogFont.lfFaceName))
1576       /* Check for well known substitutions that mess things up in the
1577 	 presence of Type-1 fonts of the same name.  */
1578       || (!check_face_name (&logical_font->elfLogFont,
1579 			    (char *)logical_font->elfFullName)))
1580     return 1;
1581 
1582   /* Make a font entity for the font.  */
1583   entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1584 					physical_font, font_type,
1585 					&match_data->pattern,
1586 					backend);
1587 
1588   if (!NILP (entity))
1589     {
1590       Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1591 				       FONT_REGISTRY_INDEX);
1592 
1593       /* iso10646-1 fonts must contain Unicode mapping tables.  */
1594       if (EQ (spec_charset, Qiso10646_1))
1595 	{
1596 	  if (!is_unicode)
1597 	    return 1;
1598 	}
1599       /* unicode-bmp fonts must contain characters from the BMP.  */
1600       else if (EQ (spec_charset, Qunicode_bmp))
1601 	{
1602 	  if (!physical_font->ntmFontSig.fsUsb[3]
1603 	      && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1604 	      && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1605 	      && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1606 	    return 1;
1607 	}
1608       /* unicode-sip fonts must contain characters in Unicode plane 2.
1609 	 so look for bit 57 (surrogates) in the Unicode subranges, plus
1610 	 the bits for CJK ranges that include those characters.  */
1611       else if (EQ (spec_charset, Qunicode_sip))
1612 	{
1613 	  if (!(physical_font->ntmFontSig.fsUsb[1] & 0x02000000)
1614 	      || !(physical_font->ntmFontSig.fsUsb[1] & 0x28000000))
1615 	    return 1;
1616 	}
1617 
1618       /* This font matches.  */
1619 
1620       /* If registry was specified, ensure it is reported as the same.  */
1621       if (!NILP (spec_charset))
1622 	{
1623 	  /* Avoid using non-Japanese fonts for Japanese, even if they
1624 	     claim they are capable, due to known breakage in Vista
1625 	     and Windows 7 fonts (bug#6029).  */
1626 	  if (logical_font->elfLogFont.lfCharSet == SHIFTJIS_CHARSET
1627 	      && !(physical_font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1628 	    return 1;
1629 	  else
1630 	    ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1631 	}
1632       /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1633 	 fonts as Unicode and skip other charsets.  */
1634       else if (match_data->opentype_only)
1635 	{
1636 	  if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1637 	      || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1638 	    ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1639 	  else
1640 	    return 1;
1641 	}
1642 
1643       /* Add this font to the list.  */
1644       match_data->list = Fcons (entity, match_data->list);
1645     }
1646   return 1;
1647 }
1648 
1649 /* Callback function for EnumFontFamiliesEx.
1650  * Terminates the search once we have a match. */
1651 static int CALLBACK ALIGN_STACK
add_one_font_entity_to_list(ENUMLOGFONTEX * logical_font,NEWTEXTMETRICEX * physical_font,DWORD font_type,LPARAM lParam)1652 add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1653 			     NEWTEXTMETRICEX *physical_font,
1654 			     DWORD font_type, LPARAM lParam)
1655 {
1656   struct font_callback_data *match_data
1657     = (struct font_callback_data *) lParam;
1658   add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1659 
1660   /* If we have a font in the list, terminate the search.  */
1661   return NILP (match_data->list);
1662 }
1663 
1664 /* Old function to convert from x to w32 charset, from w32fns.c.  */
1665 static LONG
x_to_w32_charset(char * lpcs)1666 x_to_w32_charset (char * lpcs)
1667 {
1668   Lisp_Object this_entry, w32_charset;
1669   char *charset;
1670   int len = strlen (lpcs);
1671 
1672   /* Support "*-#nnn" format for unknown charsets.  */
1673   if (strncmp (lpcs, "*-#", 3) == 0)
1674     return atoi (lpcs + 3);
1675 
1676   /* All Windows fonts qualify as Unicode.  */
1677   if (!strncmp (lpcs, "iso10646", 8))
1678     return DEFAULT_CHARSET;
1679 
1680   /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5".  */
1681   charset = alloca (len + 1);
1682   strcpy (charset, lpcs);
1683   lpcs = strchr (charset, '*');
1684   if (lpcs)
1685     *lpcs = '\0';
1686 
1687   /* Look through w32-charset-info-alist for the character set.
1688      Format of each entry is
1689        (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1690   */
1691   this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist, Qnil);
1692 
1693   if (NILP (this_entry))
1694     {
1695       /* At startup, we want iso8859-1 fonts to come up properly. */
1696       if (xstrcasecmp (charset, "iso8859-1") == 0)
1697         return ANSI_CHARSET;
1698       else
1699         return DEFAULT_CHARSET;
1700     }
1701 
1702   w32_charset = Fcar (Fcdr (this_entry));
1703 
1704   /* Translate Lisp symbol to number.  */
1705   if (EQ (w32_charset, Qw32_charset_ansi))
1706     return ANSI_CHARSET;
1707   if (EQ (w32_charset, Qw32_charset_symbol))
1708     return SYMBOL_CHARSET;
1709   if (EQ (w32_charset, Qw32_charset_shiftjis))
1710     return SHIFTJIS_CHARSET;
1711   if (EQ (w32_charset, Qw32_charset_hangeul))
1712     return HANGEUL_CHARSET;
1713   if (EQ (w32_charset, Qw32_charset_chinesebig5))
1714     return CHINESEBIG5_CHARSET;
1715   if (EQ (w32_charset, Qw32_charset_gb2312))
1716     return GB2312_CHARSET;
1717   if (EQ (w32_charset, Qw32_charset_oem))
1718     return OEM_CHARSET;
1719   if (EQ (w32_charset, Qw32_charset_johab))
1720     return JOHAB_CHARSET;
1721   if (EQ (w32_charset, Qw32_charset_easteurope))
1722     return EASTEUROPE_CHARSET;
1723   if (EQ (w32_charset, Qw32_charset_turkish))
1724     return TURKISH_CHARSET;
1725   if (EQ (w32_charset, Qw32_charset_baltic))
1726     return BALTIC_CHARSET;
1727   if (EQ (w32_charset, Qw32_charset_russian))
1728     return RUSSIAN_CHARSET;
1729   if (EQ (w32_charset, Qw32_charset_arabic))
1730     return ARABIC_CHARSET;
1731   if (EQ (w32_charset, Qw32_charset_greek))
1732     return GREEK_CHARSET;
1733   if (EQ (w32_charset, Qw32_charset_hebrew))
1734     return HEBREW_CHARSET;
1735   if (EQ (w32_charset, Qw32_charset_vietnamese))
1736     return VIETNAMESE_CHARSET;
1737   if (EQ (w32_charset, Qw32_charset_thai))
1738     return THAI_CHARSET;
1739   if (EQ (w32_charset, Qw32_charset_mac))
1740     return MAC_CHARSET;
1741 
1742   return DEFAULT_CHARSET;
1743 }
1744 
1745 
1746 /* Convert a Lisp font registry (symbol) to a windows charset.  */
1747 static LONG
registry_to_w32_charset(Lisp_Object charset)1748 registry_to_w32_charset (Lisp_Object charset)
1749 {
1750   if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1751       || EQ (charset, Qunicode_sip))
1752     return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1753   else if (EQ (charset, Qiso8859_1))
1754     return ANSI_CHARSET;
1755   else if (SYMBOLP (charset))
1756     return x_to_w32_charset (SSDATA (SYMBOL_NAME (charset)));
1757   else
1758     return DEFAULT_CHARSET;
1759 }
1760 
1761 /* Old function to convert from w32 to x charset, from w32fns.c.  */
1762 static char *
w32_to_x_charset(int fncharset,char * matching)1763 w32_to_x_charset (int fncharset, char *matching)
1764 {
1765   static char buf[32];
1766   Lisp_Object charset_type;
1767   int match_len = 0;
1768 
1769   if (matching)
1770     {
1771       /* If fully specified, accept it as it is.  Otherwise use a
1772 	 substring match. */
1773       char *wildcard = strchr (matching, '*');
1774       if (wildcard)
1775 	*wildcard = '\0';
1776       else if (strchr (matching, '-'))
1777 	return matching;
1778 
1779       match_len = strlen (matching);
1780     }
1781 
1782   switch (fncharset)
1783     {
1784     case ANSI_CHARSET:
1785       /* Handle startup case of w32-charset-info-alist not
1786          being set up yet. */
1787       if (NILP (Vw32_charset_info_alist))
1788         return (char *)"iso8859-1";
1789       charset_type = Qw32_charset_ansi;
1790       break;
1791     case DEFAULT_CHARSET:
1792       charset_type = Qw32_charset_default;
1793       break;
1794     case SYMBOL_CHARSET:
1795       charset_type = Qw32_charset_symbol;
1796       break;
1797     case SHIFTJIS_CHARSET:
1798       charset_type = Qw32_charset_shiftjis;
1799       break;
1800     case HANGEUL_CHARSET:
1801       charset_type = Qw32_charset_hangeul;
1802       break;
1803     case GB2312_CHARSET:
1804       charset_type = Qw32_charset_gb2312;
1805       break;
1806     case CHINESEBIG5_CHARSET:
1807       charset_type = Qw32_charset_chinesebig5;
1808       break;
1809     case OEM_CHARSET:
1810       charset_type = Qw32_charset_oem;
1811       break;
1812     case EASTEUROPE_CHARSET:
1813       charset_type = Qw32_charset_easteurope;
1814       break;
1815     case TURKISH_CHARSET:
1816       charset_type = Qw32_charset_turkish;
1817       break;
1818     case BALTIC_CHARSET:
1819       charset_type = Qw32_charset_baltic;
1820       break;
1821     case RUSSIAN_CHARSET:
1822       charset_type = Qw32_charset_russian;
1823       break;
1824     case ARABIC_CHARSET:
1825       charset_type = Qw32_charset_arabic;
1826       break;
1827     case GREEK_CHARSET:
1828       charset_type = Qw32_charset_greek;
1829       break;
1830     case HEBREW_CHARSET:
1831       charset_type = Qw32_charset_hebrew;
1832       break;
1833     case VIETNAMESE_CHARSET:
1834       charset_type = Qw32_charset_vietnamese;
1835       break;
1836     case THAI_CHARSET:
1837       charset_type = Qw32_charset_thai;
1838       break;
1839     case MAC_CHARSET:
1840       charset_type = Qw32_charset_mac;
1841       break;
1842     case JOHAB_CHARSET:
1843       charset_type = Qw32_charset_johab;
1844       break;
1845 
1846     default:
1847       /* Encode numerical value of unknown charset.  */
1848       sprintf (buf, "*-#%d", fncharset);
1849       return buf;
1850     }
1851 
1852   {
1853     Lisp_Object rest;
1854     char * best_match = NULL;
1855     int matching_found = 0;
1856 
1857     /* Look through w32-charset-info-alist for the character set.
1858        Prefer ISO codepages, and prefer lower numbers in the ISO
1859        range. Only return charsets for codepages which are installed.
1860 
1861        Format of each entry is
1862          (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1863     */
1864     for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1865       {
1866         char * x_charset;
1867         Lisp_Object w32_charset;
1868         Lisp_Object codepage;
1869 
1870         Lisp_Object this_entry = XCAR (rest);
1871 
1872         /* Skip invalid entries in alist. */
1873         if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1874             || !CONSP (XCDR (this_entry))
1875             || !SYMBOLP (XCAR (XCDR (this_entry))))
1876           continue;
1877 
1878         x_charset = SSDATA (XCAR (this_entry));
1879         w32_charset = XCAR (XCDR (this_entry));
1880         codepage = XCDR (XCDR (this_entry));
1881 
1882         /* Look for Same charset and a valid codepage (or non-int
1883            which means ignore).  */
1884         if (EQ (w32_charset, charset_type)
1885             && (!FIXNUMP (codepage) || XFIXNUM (codepage) == CP_DEFAULT
1886                 || IsValidCodePage (XFIXNUM (codepage))))
1887           {
1888             /* If we don't have a match already, then this is the
1889                best.  */
1890             if (!best_match)
1891 	      {
1892 		best_match = x_charset;
1893 		if (matching && !strnicmp (x_charset, matching, match_len))
1894 		  matching_found = 1;
1895 	      }
1896 	    /* If we already found a match for MATCHING, then
1897 	       only consider other matches.  */
1898 	    else if (matching_found
1899 		     && strnicmp (x_charset, matching, match_len))
1900 	      continue;
1901 	    /* If this matches what we want, and the best so far doesn't,
1902 	       then this is better.  */
1903 	    else if (!matching_found && matching
1904 		     && !strnicmp (x_charset, matching, match_len))
1905 	      {
1906 		best_match = x_charset;
1907 		matching_found = 1;
1908 	      }
1909 	    /* If this is fully specified, and the best so far isn't,
1910 	       then this is better.  */
1911 	    else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1912 	    /* If this is an ISO codepage, and the best so far isn't,
1913 	       then this is better, but only if it fully specifies the
1914 	       encoding.  */
1915 		|| (strnicmp (best_match, "iso", 3) != 0
1916 		    && strnicmp (x_charset, "iso", 3) == 0
1917 		    && strchr (x_charset, '-')))
1918 		best_match = x_charset;
1919             /* If both are ISO8859 codepages, choose the one with the
1920                lowest number in the encoding field.  */
1921             else if (strnicmp (best_match, "iso8859-", 8) == 0
1922                      && strnicmp (x_charset, "iso8859-", 8) == 0)
1923               {
1924                 int best_enc = atoi (best_match + 8);
1925                 int this_enc = atoi (x_charset + 8);
1926                 if (this_enc > 0 && this_enc < best_enc)
1927                   best_match = x_charset;
1928               }
1929           }
1930       }
1931 
1932     /* If no match, encode the numeric value. */
1933     if (!best_match)
1934       {
1935         sprintf (buf, "*-#%d", fncharset);
1936         return buf;
1937       }
1938 
1939     strncpy (buf, best_match, 31);
1940     /* If the charset is not fully specified, put -0 on the end.  */
1941     if (!strchr (best_match, '-'))
1942       {
1943 	int pos = strlen (best_match);
1944 	/* Charset specifiers shouldn't be very long.  If it is a made
1945 	   up one, truncating it should not do any harm since it isn't
1946 	   recognized anyway.  */
1947 	if (pos > 29)
1948 	  pos = 29;
1949 	strcpy (buf + pos, "-0");
1950       }
1951     buf[31] = '\0';
1952     return buf;
1953   }
1954 }
1955 
1956 static Lisp_Object
w32_registry(LONG w32_charset,DWORD font_type)1957 w32_registry (LONG w32_charset, DWORD font_type)
1958 {
1959   char *charset;
1960 
1961   /* If charset is defaulted, charset is Unicode or unknown, depending on
1962      font type.  */
1963   if (w32_charset == DEFAULT_CHARSET)
1964     return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
1965 
1966   charset = w32_to_x_charset (w32_charset, NULL);
1967   return font_intern_prop (charset, strlen (charset), 1);
1968 }
1969 
1970 static int
w32_decode_weight(int fnweight)1971 w32_decode_weight (int fnweight)
1972 {
1973   if (fnweight >= FW_HEAVY)      return 210;
1974   if (fnweight >= FW_EXTRABOLD)  return 205;
1975   if (fnweight >= FW_BOLD)       return 200;
1976   if (fnweight >= FW_SEMIBOLD)   return 180;
1977   if (fnweight >= FW_NORMAL)     return 100;
1978   if (fnweight >= FW_LIGHT)      return 50;
1979   if (fnweight >= FW_EXTRALIGHT) return 40;
1980   if (fnweight >  FW_THIN)       return 20;
1981   return 0;
1982 }
1983 
1984 static int
w32_encode_weight(int n)1985 w32_encode_weight (int n)
1986 {
1987   if (n >= 210) return FW_HEAVY;
1988   if (n >= 205) return FW_EXTRABOLD;
1989   if (n >= 200) return FW_BOLD;
1990   if (n >= 180) return FW_SEMIBOLD;
1991   if (n >= 100) return FW_NORMAL;
1992   if (n >= 50)  return FW_LIGHT;
1993   if (n >= 40)  return FW_EXTRALIGHT;
1994   if (n >= 20)  return FW_THIN;
1995   return 0;
1996 }
1997 
1998 /* Convert a Windows font weight into one of the weights supported
1999    by fontconfig (see font.c:font_parse_fcname).  */
2000 static Lisp_Object
w32_to_fc_weight(int n)2001 w32_to_fc_weight (int n)
2002 {
2003   if (n >= FW_HEAVY)     return intern ("black");
2004   if (n >= FW_EXTRABOLD) return Qextra_bold;
2005   if (n >= FW_BOLD)      return Qbold;
2006   if (n >= FW_SEMIBOLD)  return intern ("demibold");
2007   if (n >= FW_NORMAL)    return intern ("medium");
2008   if (n >= FW_LIGHT)     return Qlight;
2009   if (n >= FW_EXTRALIGHT) return Qextra_light;
2010   return intern ("thin");
2011 }
2012 
2013 /* Fill in all the available details of LOGFONT from FONT_SPEC.  */
2014 static void
fill_in_logfont(struct frame * f,LOGFONT * logfont,Lisp_Object font_spec)2015 fill_in_logfont (struct frame *f, LOGFONT *logfont, Lisp_Object font_spec)
2016 {
2017   Lisp_Object tmp, extra;
2018   int dpi = FRAME_RES_Y (f);
2019 
2020   tmp = AREF (font_spec, FONT_DPI_INDEX);
2021   if (FIXNUMP (tmp))
2022     {
2023       dpi = XFIXNUM (tmp);
2024     }
2025   else if (FLOATP (tmp))
2026     {
2027       dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
2028     }
2029 
2030   /* Height  */
2031   tmp = AREF (font_spec, FONT_SIZE_INDEX);
2032   if (FIXNUMP (tmp))
2033     logfont->lfHeight = -1 * XFIXNUM (tmp);
2034   else if (FLOATP (tmp))
2035     logfont->lfHeight = (int) (-1.0 *  dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
2036 
2037   /* Escapement  */
2038 
2039   /* Orientation  */
2040 
2041   /* Weight  */
2042   tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
2043   if (FIXNUMP (tmp))
2044     logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
2045 
2046   /* Italic  */
2047   tmp = AREF (font_spec, FONT_SLANT_INDEX);
2048   if (FIXNUMP (tmp))
2049     {
2050       int slant = FONT_SLANT_NUMERIC (font_spec);
2051       logfont->lfItalic = slant > 150 ? 1 : 0;
2052     }
2053 
2054   /* Underline  */
2055 
2056   /* Strikeout  */
2057 
2058   /* Charset  */
2059   tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
2060   if (! NILP (tmp))
2061     logfont->lfCharSet = registry_to_w32_charset (tmp);
2062   else
2063     logfont->lfCharSet = DEFAULT_CHARSET;
2064 
2065   /* Out Precision  */
2066 
2067   /* Clip Precision  */
2068 
2069   /* Quality */
2070   logfont->lfQuality = DEFAULT_QUALITY;
2071 
2072   /* Generic Family and Face Name  */
2073   logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
2074 
2075   tmp = AREF (font_spec, FONT_FAMILY_INDEX);
2076   if (! NILP (tmp))
2077     {
2078       logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
2079       if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
2080         ; /* Font name was generic, don't fill in font name.  */
2081         /* Font families are interned, but allow for strings also in case of
2082            user input.  */
2083       else if (SYMBOLP (tmp))
2084 	{
2085 	  strncpy (logfont->lfFaceName,
2086 		   SSDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
2087 	  logfont->lfFaceName[LF_FACESIZE-1] = '\0';
2088 	}
2089     }
2090 
2091   tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
2092   if (!NILP (tmp))
2093     {
2094       /* Override generic family.  */
2095       BYTE family = w32_generic_family (tmp);
2096       if (family != FF_DONTCARE)
2097         logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
2098     }
2099 
2100   /* Set pitch based on the spacing property.  */
2101   tmp = AREF (font_spec, FONT_SPACING_INDEX);
2102   if (FIXNUMP (tmp))
2103     {
2104       int spacing = XFIXNUM (tmp);
2105       if (spacing < FONT_SPACING_MONO)
2106 	logfont->lfPitchAndFamily
2107 	  = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
2108       else
2109 	logfont->lfPitchAndFamily
2110 	  = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
2111     }
2112 
2113   /* Process EXTRA info.  */
2114   for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
2115        CONSP (extra); extra = XCDR (extra))
2116     {
2117       tmp = XCAR (extra);
2118       if (CONSP (tmp))
2119         {
2120           Lisp_Object key, val;
2121           key = XCAR (tmp), val = XCDR (tmp);
2122           /* Only use QCscript if charset is not provided, or is Unicode
2123              and a single script is specified.  This is rather crude,
2124              and is only used to narrow down the fonts returned where
2125              there is a definite match.  Some scripts, such as latin, han,
2126              cjk-misc match multiple lfCharSet values, so we can't pre-filter
2127              them.  */
2128 	  if (EQ (key, QCscript)
2129                    && logfont->lfCharSet == DEFAULT_CHARSET
2130                    && SYMBOLP (val))
2131             {
2132               if (EQ (val, Qgreek))
2133                 logfont->lfCharSet = GREEK_CHARSET;
2134               else if (EQ (val, Qhangul))
2135                 logfont->lfCharSet = HANGUL_CHARSET;
2136               else if (EQ (val, Qkana) || EQ (val, Qkanbun))
2137                 logfont->lfCharSet = SHIFTJIS_CHARSET;
2138               else if (EQ (val, Qbopomofo))
2139                 logfont->lfCharSet = CHINESEBIG5_CHARSET;
2140               /* GB 18030 supports tibetan, yi, mongolian,
2141                  fonts that support it should show up if we ask for
2142                  GB2312 fonts. */
2143               else if (EQ (val, Qtibetan) || EQ (val, Qyi)
2144                        || EQ (val, Qmongolian))
2145                 logfont->lfCharSet = GB2312_CHARSET;
2146               else if (EQ (val, Qhebrew))
2147                 logfont->lfCharSet = HEBREW_CHARSET;
2148               else if (EQ (val, Qarabic))
2149                 logfont->lfCharSet = ARABIC_CHARSET;
2150               else if (EQ (val, Qthai))
2151                 logfont->lfCharSet = THAI_CHARSET;
2152             }
2153           else if (EQ (key, QCantialias) && SYMBOLP (val))
2154             {
2155               logfont->lfQuality = w32_antialias_type (val);
2156             }
2157         }
2158     }
2159 }
2160 
2161 static void
list_all_matching_fonts(struct font_callback_data * match_data)2162 list_all_matching_fonts (struct font_callback_data *match_data)
2163 {
2164   HDC dc;
2165   Lisp_Object families = w32font_list_family (XFRAME (match_data->frame));
2166   struct frame *f = XFRAME (match_data->frame);
2167 
2168   /* Prevent quitting while EnumFontFamiliesEx runs and conses the
2169      list it will return.  That's because get_frame_dc acquires the
2170      critical section, so we cannot quit before we release it in
2171      release_frame_dc.  */
2172   Lisp_Object prev_quit = Vinhibit_quit;
2173   Vinhibit_quit = Qt;
2174   dc = get_frame_dc (f);
2175 
2176   while (!NILP (families))
2177     {
2178       /* Only fonts from the current locale are given localized names
2179 	 on Windows, so we can keep backwards compatibility with
2180 	 Windows 9x/ME by using non-Unicode font enumeration without
2181 	 sacrificing internationalization here.  */
2182       char *name;
2183       Lisp_Object family = CAR (families);
2184       families = CDR (families);
2185       if (NILP (family))
2186         continue;
2187       else if (SYMBOLP (family))
2188         name = SSDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
2189       else
2190 	continue;
2191 
2192       strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2193       match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2194 
2195       EnumFontFamiliesEx (dc, &match_data->pattern,
2196                           (FONTENUMPROC) add_font_entity_to_list,
2197                           (LPARAM) match_data, 0);
2198     }
2199 
2200   release_frame_dc (f, dc);
2201   Vinhibit_quit = prev_quit;
2202 }
2203 
2204 static Lisp_Object
lispy_antialias_type(BYTE type)2205 lispy_antialias_type (BYTE type)
2206 {
2207   Lisp_Object lispy;
2208 
2209   switch (type)
2210     {
2211     case NONANTIALIASED_QUALITY:
2212       lispy = Qnone;
2213       break;
2214     case ANTIALIASED_QUALITY:
2215       lispy = Qstandard;
2216       break;
2217     case CLEARTYPE_QUALITY:
2218       lispy = Qsubpixel;
2219       break;
2220     case CLEARTYPE_NATURAL_QUALITY:
2221       lispy = Qnatural;
2222       break;
2223     default:
2224       lispy = Qnil;
2225       break;
2226     }
2227   return lispy;
2228 }
2229 
2230 /* Convert antialiasing symbols to lfQuality  */
2231 static BYTE
w32_antialias_type(Lisp_Object type)2232 w32_antialias_type (Lisp_Object type)
2233 {
2234   if (EQ (type, Qnone))
2235     return NONANTIALIASED_QUALITY;
2236   else if (EQ (type, Qstandard))
2237     return ANTIALIASED_QUALITY;
2238   else if (EQ (type, Qsubpixel))
2239     return CLEARTYPE_QUALITY;
2240   else if (EQ (type, Qnatural))
2241     return CLEARTYPE_NATURAL_QUALITY;
2242   else
2243     return DEFAULT_QUALITY;
2244 }
2245 
2246 /* Return a list of all the scripts that the font supports.  */
2247 static Lisp_Object
font_supported_scripts(FONTSIGNATURE * sig)2248 font_supported_scripts (FONTSIGNATURE * sig)
2249 {
2250   DWORD * subranges = sig->fsUsb;
2251   Lisp_Object supported = Qnil;
2252 
2253   /* Match a single subrange. SYM is set if bit N is set in subranges.  */
2254 #define SUBRANGE(n,sym) \
2255   if (subranges[(n) / 32] & (1U << ((n) % 32))) \
2256     supported = Fcons ((sym), supported)
2257 
2258   /* Match multiple subranges. SYM is set if any MASK bit is set in
2259      subranges[0 - 3].  */
2260 #define MASK_ANY(mask0,mask1,mask2,mask3,sym)      \
2261   if ((subranges[0] & (mask0)) || (subranges[1] & (mask1))     \
2262       || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2263     supported = Fcons ((sym), supported)
2264 
2265   /* 0: ASCII (a.k.a. "Basic Latin"),
2266      1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B,
2267      29: Latin Extended Additional.  */
2268   /* Most fonts that support Latin will have good coverage of the
2269      Extended blocks, so in practice marking them below is not really
2270      needed, or useful: if a font claims support for, say, Latin
2271      Extended-B, but does not contain glyphs for some of the
2272      characters in the range, the user will have to augment her
2273      fontset to display those few characters.  But we mark these
2274      subranges here anyway, for the marginal use cases where they
2275      might make a difference.  */
2276   MASK_ANY (0x2000000F, 0, 0, 0, Qlatin);
2277   SUBRANGE (4, Qphonetic);
2278   /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks.  */
2279   /* 7: Greek and Coptic, 30: Greek Extended.  */
2280   MASK_ANY (0x40000080, 0, 0, 0, Qgreek);
2281   SUBRANGE (8, Qcoptic);
2282   SUBRANGE (9, Qcyrillic);
2283   SUBRANGE (10, Qarmenian);
2284   SUBRANGE (11, Qhebrew);
2285   /* Bit 12 is rather useless if the user has Hebrew fonts installed,
2286      because apparently at some point in the past bit 12 was "Hebrew
2287      Extended", and many Hebrew fonts still have this bit set.  The
2288      only workaround is to customize fontsets to use fonts like Ebrima
2289      or Quivira.  */
2290   SUBRANGE (12, Qvai);
2291   SUBRANGE (13, Qarabic);
2292   SUBRANGE (14, Qnko);
2293   SUBRANGE (15, Qdevanagari);
2294   SUBRANGE (16, Qbengali);
2295   SUBRANGE (17, Qgurmukhi);
2296   SUBRANGE (18, Qgujarati);
2297   SUBRANGE (19, Qoriya);	/* a.k.a. "Odia" */
2298   SUBRANGE (20, Qtamil);
2299   SUBRANGE (21, Qtelugu);
2300   SUBRANGE (22, Qkannada);
2301   SUBRANGE (23, Qmalayalam);
2302   SUBRANGE (24, Qthai);
2303   SUBRANGE (25, Qlao);
2304   SUBRANGE (26, Qgeorgian);
2305   SUBRANGE (27, Qbalinese);
2306   /* 28: Hangul Jamo -- covered by the default fontset.  */
2307   /* 29: Latin Extended, 30: Greek Extended -- covered above.  */
2308   /* 31: Supplemental Punctuation -- most probably be masked by
2309      Courier New, so fontset customization is needed.  */
2310   /* 31-47: Symbols (defined below).  */
2311   SUBRANGE (48, Qcjk_misc);
2312   /* Match either 49: katakana or 50: hiragana for kana.  */
2313   MASK_ANY (0, 0x00060000, 0, 0, Qkana);
2314   SUBRANGE (51, Qbopomofo);
2315   /* 52: Compatibility Jamo */
2316   SUBRANGE (53, Qphags_pa);
2317   /* 54: Enclosed CJK letters and months, 55: CJK Compatibility.  */
2318   SUBRANGE (56, Qhangul);
2319   /* 57: Surrogates.  */
2320   SUBRANGE (58, Qphoenician);
2321   SUBRANGE (59, Qhan); /* There are others, but this is the main one.  */
2322   SUBRANGE (59, Qideographic_description); /* Windows lumps this in.  */
2323   SUBRANGE (59, Qkanbun); /* And this.  */
2324   /* These are covered well either by the default Courier New or by
2325      CJK fonts that are set up specially in the default fontset.  So
2326      marking them here wouldn't be useful.  */
2327   /* 60: Private use, 61: CJK strokes and compatibility.  */
2328   /* 62: Alphabetic Presentation, 63: Arabic Presentation A.  */
2329   /* 64: Combining half marks, 65: Vertical and CJK compatibility.  */
2330   /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width.  */
2331   /* 69: Specials.  */
2332   SUBRANGE (70, Qtibetan);
2333   SUBRANGE (71, Qsyriac);
2334   SUBRANGE (72, Qthaana);
2335   SUBRANGE (73, Qsinhala);
2336   SUBRANGE (74, Qburmese);	/* a.k.a. "Myanmar" */
2337   SUBRANGE (75, Qethiopic);
2338   SUBRANGE (76, Qcherokee);
2339   SUBRANGE (77, Qcanadian_aboriginal);
2340   SUBRANGE (78, Qogham);
2341   SUBRANGE (79, Qrunic);
2342   SUBRANGE (80, Qkhmer);
2343   SUBRANGE (81, Qmongolian);
2344   SUBRANGE (82, Qbraille);
2345   SUBRANGE (83, Qyi);
2346   SUBRANGE (84, Qbuhid);
2347   SUBRANGE (84, Qhanunoo);
2348   SUBRANGE (84, Qtagalog);
2349   SUBRANGE (84, Qtagbanwa);
2350   SUBRANGE (85, Qold_italic);
2351   SUBRANGE (86, Qgothic);
2352   SUBRANGE (87, Qdeseret);
2353   SUBRANGE (88, Qbyzantine_musical_symbol);
2354   SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these.  */
2355   SUBRANGE (89, Qmathematical_bold); /* See fontset.el:setup-default-fontset.  */
2356   SUBRANGE (89, Qmathematical_italic);
2357   SUBRANGE (89, Qmathematical_bold_italic);
2358   SUBRANGE (89, Qmathematical_script);
2359   SUBRANGE (89, Qmathematical_bold_script);
2360   SUBRANGE (89, Qmathematical_fraktur);
2361   SUBRANGE (89, Qmathematical_double_struck);
2362   SUBRANGE (89, Qmathematical_bold_fraktur);
2363   SUBRANGE (89, Qmathematical_sans_serif);
2364   SUBRANGE (89, Qmathematical_sans_serif_bold);
2365   SUBRANGE (89, Qmathematical_sans_serif_italic);
2366   SUBRANGE (89, Qmathematical_sans_serif_bold_italic);
2367   SUBRANGE (89, Qmathematical_monospace);
2368   /* 90: Private use, 91: Variation selectors, 92: Tags.  */
2369   SUBRANGE (93, Qlimbu);
2370   SUBRANGE (94, Qtai_le);
2371   SUBRANGE (95, Qtai_le);
2372   SUBRANGE (96, Qbuginese);
2373   SUBRANGE (97, Qglagolitic);
2374   SUBRANGE (98, Qtifinagh);
2375   /* 99: Yijing Hexagrams.  */
2376   SUBRANGE (99, Qhan);
2377   SUBRANGE (100, Qsyloti_nagri);
2378   SUBRANGE (101, Qlinear_b);
2379   SUBRANGE (101, Qaegean_number);
2380   SUBRANGE (102, Qancient_greek_number);
2381   SUBRANGE (103, Qugaritic);
2382   SUBRANGE (104, Qold_persian);
2383   SUBRANGE (105, Qshavian);
2384   SUBRANGE (106, Qosmanya);
2385   SUBRANGE (107, Qcypriot);
2386   SUBRANGE (108, Qkharoshthi);
2387   SUBRANGE (109, Qtai_xuan_jing_symbol);
2388   SUBRANGE (110, Qcuneiform);
2389   SUBRANGE (111, Qcuneiform_numbers_and_punctuation);
2390   SUBRANGE (111, Qcounting_rod_numeral);
2391   SUBRANGE (112, Qsundanese);
2392   SUBRANGE (113, Qlepcha);
2393   SUBRANGE (114, Qol_chiki);
2394   SUBRANGE (115, Qsaurashtra);
2395   SUBRANGE (116, Qkayah_li);
2396   SUBRANGE (117, Qrejang);
2397   SUBRANGE (118, Qcham);
2398   SUBRANGE (119, Qancient_symbol);
2399   SUBRANGE (120, Qphaistos_disc);
2400   SUBRANGE (121, Qlycian);
2401   SUBRANGE (121, Qcarian);
2402   SUBRANGE (121, Qlydian);
2403   SUBRANGE (122, Qdomino_tile);
2404   SUBRANGE (122, Qmahjong_tile);
2405   /* 123-127: Reserved.  */
2406 
2407   /* There isn't really a main symbol range, so include symbol if any
2408      relevant range is set.  */
2409   MASK_ANY (0x80000000, 0x0000FFFF, 0, 0, Qsymbol);
2410 
2411   /* Missing:
2412        Tai Viet
2413        Old Permic
2414        Palmyrene
2415        Nabatean
2416        Manichean
2417        Hanifi Rohingya
2418        Sogdian
2419        Elymaic
2420        Mahajani
2421        Khojki
2422        Khudawadi
2423        Grantha
2424        Newa
2425        Tirhuta
2426        Siddham
2427        Modi
2428        Takri
2429        Dogra
2430        Warang Citi
2431        Nandinagari
2432        Zanabazar Square
2433        Soyombo
2434        Pau Cin Hau
2435        Bhaiksuki
2436        Marchen
2437        Masaram Gondi
2438        Makasar
2439        Egyptian
2440        Mro
2441        Bassa-Vah
2442        Pahawh Hmong
2443        Medefaidrin
2444        Tangut
2445        Tangut Components
2446        Nushu
2447        Duployan Shorthand
2448        Ancient Greek Musical Notation
2449        Nyiakeng Puachue Hmong
2450        Wancho
2451        Mende Kikakui
2452        Adlam
2453        Indic Siyaq Number
2454        Ottoman Siyaq Number.  */
2455 #undef SUBRANGE
2456 #undef MASK_ANY
2457 
2458   return supported;
2459 }
2460 
2461 /* Generate a full name for a Windows font.
2462    The full name is in fcname format, with weight, slant and antialiasing
2463    specified if they are not "normal".  */
2464 static int
w32font_full_name(LOGFONT * font,Lisp_Object font_obj,int pixel_size,char * name,int nbytes)2465 w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
2466 		   int pixel_size, char *name, int nbytes)
2467 {
2468   int len, height, outline;
2469   char *p;
2470   Lisp_Object antialiasing, weight = Qnil;
2471 
2472   len = strlen (font->lfFaceName);
2473 
2474   outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2475 
2476   /* Represent size of scalable fonts by point size. But use pixelsize for
2477      raster fonts to indicate that they are exactly that size.  */
2478   if (outline)
2479     len += 11; /* -SIZE */
2480   else
2481     len += 21;
2482 
2483   if (font->lfItalic)
2484     len += 7; /* :italic */
2485 
2486   if (font->lfWeight && font->lfWeight != FW_NORMAL)
2487     {
2488       weight = w32_to_fc_weight (font->lfWeight);
2489       len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
2490     }
2491 
2492   antialiasing = lispy_antialias_type (font->lfQuality);
2493   if (! NILP (antialiasing))
2494     len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2495 
2496   /* Check that the buffer is big enough  */
2497   if (len > nbytes)
2498     return -1;
2499 
2500   p = name;
2501   p += sprintf (p, "%s", font->lfFaceName);
2502 
2503   height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2504 
2505   if (height > 0)
2506     {
2507       if (outline)
2508         {
2509           double pointsize = height * 72.0 / one_w32_display_info.resy;
2510           /* Round to nearest half point.  floor is used, since round is not
2511 	     supported in MS library.  */
2512           pointsize = floor (pointsize * 2 + 0.5) / 2;
2513           p += sprintf (p, "-%1.1f", pointsize);
2514         }
2515       else
2516         p += sprintf (p, ":pixelsize=%d", height);
2517     }
2518 
2519   if (SYMBOLP (weight) && ! NILP (weight))
2520     p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2521 
2522   if (font->lfItalic)
2523     p += sprintf (p, ":italic");
2524 
2525   if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2526     p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2527 
2528   return (p - name);
2529 }
2530 
2531 /* Convert a logfont and point size into a fontconfig style font name.
2532    POINTSIZE is in tenths of points.
2533    If SIZE indicates the size of buffer FCNAME, into which the font name
2534    is written.  If the buffer is not large enough to contain the name,
2535    the function returns -1, otherwise it returns the number of bytes
2536    written to FCNAME.  */
2537 static int
logfont_to_fcname(LOGFONT * font,int pointsize,char * fcname,int size)2538 logfont_to_fcname (LOGFONT* font, int pointsize, char *fcname, int size)
2539 {
2540   int len, height;
2541   char *p = fcname;
2542   Lisp_Object weight = Qnil;
2543 
2544   len = strlen (font->lfFaceName) + 2;
2545   height = pointsize / 10;
2546   while (height /= 10)
2547     len++;
2548 
2549   if (pointsize % 10)
2550     len += 2;
2551 
2552   if (font->lfItalic)
2553     len += 7; /* :italic */
2554   if (font->lfWeight && font->lfWeight != FW_NORMAL)
2555     {
2556       weight = w32_to_fc_weight (font->lfWeight);
2557       len += SBYTES (SYMBOL_NAME (weight)) + 1;
2558     }
2559 
2560   if (len > size)
2561     return -1;
2562 
2563   p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2564   if (pointsize % 10)
2565     p += sprintf (p, ".%d", pointsize % 10);
2566 
2567   if (SYMBOLP (weight) && !NILP (weight))
2568     p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2569 
2570   if (font->lfItalic)
2571     p += sprintf (p, ":italic");
2572 
2573   return (p - fcname);
2574 }
2575 
2576 static void
compute_metrics(HDC dc,struct w32font_info * w32_font,unsigned int code,struct w32_metric_cache * metrics)2577 compute_metrics (HDC dc, struct w32font_info *w32_font, unsigned int code,
2578 		 struct w32_metric_cache *metrics)
2579 {
2580   GLYPHMETRICS gm;
2581   MAT2 transform;
2582   unsigned int options = GGO_METRICS;
2583   INT width;
2584 
2585   if (w32_font->glyph_idx)
2586     options |= GGO_GLYPH_INDEX;
2587 
2588   memset (&transform, 0, sizeof (transform));
2589   transform.eM11.value = 1;
2590   transform.eM22.value = 1;
2591 
2592   if (get_glyph_outline_w (dc, code, options, &gm, 0, NULL, &transform)
2593       != GDI_ERROR)
2594     {
2595       metrics->lbearing = gm.gmptGlyphOrigin.x;
2596       metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2597       metrics->width = gm.gmCellIncX;
2598       metrics->ascent = gm.gmptGlyphOrigin.y;
2599       metrics->descent = gm.gmBlackBoxY - gm.gmptGlyphOrigin.y;
2600       metrics->status = W32METRIC_SUCCESS;
2601     }
2602   else if (get_char_width_32_w (dc, code, code, &width) != 0)
2603     {
2604       metrics->lbearing = 0;
2605       metrics->rbearing = width;
2606       metrics->width = width;
2607       metrics->ascent = w32_font->font.ascent;
2608       metrics->descent = w32_font->font.descent;
2609       metrics->status = W32METRIC_SUCCESS;
2610     }
2611   else
2612     metrics->status = W32METRIC_FAIL;
2613 }
2614 
2615 DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2616        doc: /* Read a font name using a W32 font selection dialog.
2617 Return fontconfig style font string corresponding to the selection.
2618 
2619 If FRAME is omitted or nil, it defaults to the selected frame.
2620 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2621 in the font selection dialog. */)
2622   (Lisp_Object frame, Lisp_Object exclude_proportional)
2623 {
2624   struct frame *f = decode_window_system_frame (frame);
2625   CHOOSEFONT cf;
2626   LOGFONT lf;
2627   TEXTMETRIC tm;
2628   HDC hdc;
2629   HANDLE oldobj;
2630   char buf[100];
2631 
2632   memset (&cf, 0, sizeof (cf));
2633   memset (&lf, 0, sizeof (lf));
2634 
2635   cf.lStructSize = sizeof (cf);
2636   cf.hwndOwner = FRAME_W32_WINDOW (f);
2637   cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2638 
2639   /* If exclude_proportional is non-nil, limit the selection to
2640      monospaced fonts.  */
2641   if (!NILP (exclude_proportional))
2642     cf.Flags |= CF_FIXEDPITCHONLY;
2643 
2644   cf.lpLogFont = &lf;
2645 
2646   /* Initialize as much of the font details as we can from the current
2647      default font.  */
2648   hdc = GetDC (FRAME_W32_WINDOW (f));
2649   oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
2650   GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2651   if (GetTextMetrics (hdc, &tm))
2652     {
2653       lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2654       lf.lfWeight = tm.tmWeight;
2655       lf.lfItalic = tm.tmItalic;
2656       lf.lfUnderline = tm.tmUnderlined;
2657       lf.lfStrikeOut = tm.tmStruckOut;
2658       lf.lfCharSet = tm.tmCharSet;
2659       cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2660     }
2661   SelectObject (hdc, oldobj);
2662   ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2663 
2664   {
2665     int count = SPECPDL_INDEX ();
2666     Lisp_Object value = Qnil;
2667 
2668     w32_dialog_in_progress (Qt);
2669     specbind (Qinhibit_redisplay, Qt);
2670     record_unwind_protect (w32_dialog_in_progress, Qnil);
2671 
2672     if (ChooseFont (&cf)
2673 	&& logfont_to_fcname (&lf, cf.iPointSize, buf, 100) >= 0)
2674       value = DECODE_SYSTEM (build_string (buf));
2675 
2676     unbind_to (count, Qnil);
2677 
2678     return value;
2679   }
2680 }
2681 
2682 static const char *const w32font_booleans [] = {
2683   NULL,
2684 };
2685 
2686 static const char *const w32font_non_booleans [] = {
2687   ":script",
2688   ":antialias",
2689   ":style",
2690   NULL,
2691 };
2692 
2693 static void
w32font_filter_properties(Lisp_Object font,Lisp_Object alist)2694 w32font_filter_properties (Lisp_Object font, Lisp_Object alist)
2695 {
2696   font_filter_properties (font, alist, w32font_booleans, w32font_non_booleans);
2697 }
2698 
2699 struct font_driver w32font_driver =
2700   {
2701     LISPSYM_INITIALLY (Qgdi),
2702     false, /* case insensitive */
2703     w32font_get_cache,
2704     w32font_list,
2705     w32font_match,
2706     w32font_list_family,
2707     NULL, /* free_entity */
2708     w32font_open,
2709     w32font_close,
2710     NULL, /* prepare_face */
2711     NULL, /* done_face */
2712     w32font_has_char,
2713     w32font_encode_char,
2714     w32font_text_extents,
2715     w32font_draw,
2716     NULL, /* get_bitmap */
2717     NULL, /* free_bitmap */
2718     NULL, /* anchor_point */
2719     NULL, /* otf_capability */
2720     NULL, /* otf_drive */
2721     NULL, /* start_for_frame */
2722     NULL, /* end_for_frame */
2723     NULL, /* shape */
2724     NULL, /* check */
2725     NULL, /* get_variation_glyphs */
2726     w32font_filter_properties,
2727     NULL, /* cached_font_ok */
2728   };
2729 
2730 
2731 /* Initialize state that does not change between invocations. This is only
2732    called when Emacs is dumped.  */
2733 
2734 static void syms_of_w32font_for_pdumper (void);
2735 
2736 void
syms_of_w32font(void)2737 syms_of_w32font (void)
2738 {
2739   DEFSYM (Qgdi, "gdi");
2740   DEFSYM (Quniscribe, "uniscribe");
2741   DEFSYM (Qharfbuzz, "harfbuzz");
2742   DEFSYM (QCformat, ":format");
2743 
2744   /* Generic font families.  */
2745   DEFSYM (Qmonospace, "monospace");
2746   DEFSYM (Qserif, "serif");
2747   DEFSYM (Qsansserif, "sansserif");
2748   DEFSYM (Qscript, "script");
2749   DEFSYM (Qdecorative, "decorative");
2750   /* Aliases.  */
2751   DEFSYM (Qsans_serif, "sans_serif");
2752   DEFSYM (Qsans, "sans");
2753   DEFSYM (Qmono, "mono");
2754 
2755   /* Fake foundries.  */
2756   DEFSYM (Qraster, "raster");
2757   DEFSYM (Qoutline, "outline");
2758   DEFSYM (Qunknown, "unknown");
2759 
2760   /* Antialiasing.  */
2761   DEFSYM (Qstandard, "standard");
2762   DEFSYM (Qsubpixel, "subpixel");
2763   DEFSYM (Qnatural, "natural");
2764 
2765   /* Languages  */
2766   DEFSYM (Qzh, "zh");
2767 
2768   /* Scripts  */
2769   DEFSYM (Qlatin, "latin");
2770   DEFSYM (Qgreek, "greek");
2771   DEFSYM (Qcoptic, "coptic");
2772   DEFSYM (Qcyrillic, "cyrillic");
2773   DEFSYM (Qarmenian, "armenian");
2774   DEFSYM (Qhebrew, "hebrew");
2775   DEFSYM (Qvai, "vai");
2776   DEFSYM (Qarabic, "arabic");
2777   DEFSYM (Qsyriac, "syriac");
2778   DEFSYM (Qnko, "nko");
2779   DEFSYM (Qthaana, "thaana");
2780   DEFSYM (Qdevanagari, "devanagari");
2781   DEFSYM (Qbengali, "bengali");
2782   DEFSYM (Qgurmukhi, "gurmukhi");
2783   DEFSYM (Qgujarati, "gujarati");
2784   DEFSYM (Qoriya, "oriya");
2785   DEFSYM (Qtamil, "tamil");
2786   DEFSYM (Qtelugu, "telugu");
2787   DEFSYM (Qkannada, "kannada");
2788   DEFSYM (Qmalayalam, "malayalam");
2789   DEFSYM (Qsinhala, "sinhala");
2790   DEFSYM (Qthai, "thai");
2791   DEFSYM (Qlao, "lao");
2792   DEFSYM (Qtibetan, "tibetan");
2793   DEFSYM (Qburmese, "burmese");
2794   DEFSYM (Qgeorgian, "georgian");
2795   DEFSYM (Qhangul, "hangul");
2796   DEFSYM (Qethiopic, "ethiopic");
2797   DEFSYM (Qcherokee, "cherokee");
2798   DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2799   DEFSYM (Qogham, "ogham");
2800   DEFSYM (Qrunic, "runic");
2801   DEFSYM (Qkhmer, "khmer");
2802   DEFSYM (Qmongolian, "mongolian");
2803   DEFSYM (Qbraille, "braille");
2804   DEFSYM (Qhan, "han");
2805   DEFSYM (Qideographic_description, "ideographic-description");
2806   DEFSYM (Qcjk_misc, "cjk-misc");
2807   DEFSYM (Qkana, "kana");
2808   DEFSYM (Qbopomofo, "bopomofo");
2809   DEFSYM (Qkanbun, "kanbun");
2810   DEFSYM (Qyi, "yi");
2811   DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2812   DEFSYM (Qmusical_symbol, "musical-symbol");
2813   DEFSYM (Qmathematical_bold, "mathematical-bold");
2814   DEFSYM (Qmathematical_italic, "mathematical-italic");
2815   DEFSYM (Qmathematical_bold_italic, "mathematical-bold-italic");
2816   DEFSYM (Qmathematical_script, "mathematical-script");
2817   DEFSYM (Qmathematical_bold_script, "mathematical-bold-script");
2818   DEFSYM (Qmathematical_fraktur, "mathematical-fraktur");
2819   DEFSYM (Qmathematical_double_struck, "mathematical-double-struck");
2820   DEFSYM (Qmathematical_bold_fraktur, "mathematical-bold-fraktur");
2821   DEFSYM (Qmathematical_sans_serif, "mathematical-sans-serif");
2822   DEFSYM (Qmathematical_sans_serif_bold, "mathematical-sans-serif-bold");
2823   DEFSYM (Qmathematical_sans_serif_italic, "mathematical-sans-serif-italic");
2824   DEFSYM (Qmathematical_sans_serif_bold_italic, "mathematical-sans-serif-bold-italic");
2825   DEFSYM (Qmathematical_monospace, "mathematical-monospace");
2826   DEFSYM (Qcham, "cham");
2827   DEFSYM (Qphonetic, "phonetic");
2828   DEFSYM (Qbalinese, "balinese");
2829   DEFSYM (Qbuginese, "buginese");
2830   DEFSYM (Qbuhid, "buhid");
2831   DEFSYM (Qcuneiform, "cuneiform");
2832   DEFSYM (Qcuneiform_numbers_and_punctuation,
2833 	  "cuneiform-numbers-and-punctuation");
2834   DEFSYM (Qcypriot, "cypriot");
2835   DEFSYM (Qdeseret, "deseret");
2836   DEFSYM (Qglagolitic, "glagolitic");
2837   DEFSYM (Qgothic, "gothic");
2838   DEFSYM (Qhanunoo, "hanunoo");
2839   DEFSYM (Qkharoshthi, "kharoshthi");
2840   DEFSYM (Qlimbu, "limbu");
2841   DEFSYM (Qlinear_b, "linear_b");
2842   DEFSYM (Qaegean_number, "aegean-number");
2843   DEFSYM (Qold_italic, "old_italic");
2844   DEFSYM (Qold_persian, "old_persian");
2845   DEFSYM (Qosmanya, "osmanya");
2846   DEFSYM (Qphags_pa, "phags-pa");
2847   DEFSYM (Qphoenician, "phoenician");
2848   DEFSYM (Qshavian, "shavian");
2849   DEFSYM (Qsyloti_nagri, "syloti_nagri");
2850   DEFSYM (Qtagalog, "tagalog");
2851   DEFSYM (Qtagbanwa, "tagbanwa");
2852   DEFSYM (Qtai_le, "tai_le");
2853   DEFSYM (Qtifinagh, "tifinagh");
2854   DEFSYM (Qugaritic, "ugaritic");
2855   DEFSYM (Qlycian, "lycian");
2856   DEFSYM (Qcarian, "carian");
2857   DEFSYM (Qlydian, "lydian");
2858   DEFSYM (Qdomino_tile, "domino-tile");
2859   DEFSYM (Qmahjong_tile, "mahjong-tile");
2860   DEFSYM (Qtai_xuan_jing_symbol, "tai-xuan-jing-symbol");
2861   DEFSYM (Qcounting_rod_numeral, "counting-rod-numeral");
2862   DEFSYM (Qancient_symbol, "ancient-symbol");
2863   DEFSYM (Qphaistos_disc, "phaistos-disc");
2864   DEFSYM (Qancient_greek_number, "ancient-greek-number");
2865   DEFSYM (Qsundanese, "sundanese");
2866   DEFSYM (Qlepcha, "lepcha");
2867   DEFSYM (Qol_chiki, "ol-chiki");
2868   DEFSYM (Qsaurashtra, "saurashtra");
2869   DEFSYM (Qkayah_li, "kayah-li");
2870   DEFSYM (Qrejang, "rejang");
2871 
2872   /* W32 font encodings.  */
2873   DEFVAR_LISP ("w32-charset-info-alist",
2874                Vw32_charset_info_alist,
2875                doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2876 Each entry should be of the form:
2877 
2878    (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2879 
2880 where CHARSET_NAME is a string used in font names to identify the charset,
2881 WINDOWS_CHARSET is a symbol that can be one of:
2882 
2883   w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2884   w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2885   w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2886   w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2887   w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2888   w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2889   or w32-charset-oem.
2890 
2891 CODEPAGE should be an integer specifying the codepage that should be used
2892 to display the character set, t to do no translation and output as Unicode,
2893 or nil to do no translation and output as 8 bit (or multibyte on far-east
2894 versions of Windows) characters.  */);
2895   Vw32_charset_info_alist = Qnil;
2896 
2897   DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2898   DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2899   DEFSYM (Qw32_charset_default, "w32-charset-default");
2900   DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2901   DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2902   DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2903   DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2904   DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2905   DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2906   DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2907   DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2908   DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2909   DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2910   DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2911   DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2912   DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2913   DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2914   DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2915   DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2916   DEFSYM (Qw32_non_USB_fonts, "w32-non-USB-fonts");
2917 
2918   defsubr (&Sx_select_font);
2919 
2920   pdumper_do_now_and_after_load (syms_of_w32font_for_pdumper);
2921 }
2922 
2923 static void
syms_of_w32font_for_pdumper(void)2924 syms_of_w32font_for_pdumper (void)
2925 {
2926   register_font_driver (&w32font_driver, NULL);
2927 }
2928 
2929 void
globals_of_w32font(void)2930 globals_of_w32font (void)
2931 {
2932 #ifdef WINDOWSNT
2933   g_b_init_get_outline_metrics_w = 0;
2934   g_b_init_get_text_metrics_w = 0;
2935   g_b_init_get_glyph_outline_w = 0;
2936   g_b_init_get_char_width_32_w = 0;
2937 #endif
2938 }
2939