Improve font lookup on MS-Windows

* src/w32font.c (struct font_callback_data): New member
'known_fonts'.
(w32font_list_internal, w32font_match_internal): Set up
match_data.known_fonts if the font spec includes :script that
names one of the non-USB scripts.
(add_font_entity_to_list): If font_matches_spec returns zero
for a font, and we have some fonts in match_data->known_fonts,
consider the font to be a match if it is named in known_fonts.
(font_supported_scripts): Update the Unicode Subranges.  In
particular, map bit 74 to 'burmese', as this is the name Emacs
uses, not 'myanmar'.  Add a list of scripts that have no USBs
defined for them.
(syms_of_w32font) <Qburmese, Qcuneiform_numbers_and_punctuation>
<Qaegean_number, Qw32_non_USB_fonts>: New symbols.

* lisp/term/w32-win.el (w32-no-usb-subranges): New defconst.
(w32--filter-USB-scripts, w32-find-non-USB-fonts): New functions.
(w32-non-USB-fonts): New defvar.

* lisp/international/fontset.el (setup-default-fontset): Add
more scripts to automatic setup by representative characters.

* doc/emacs/msdos.texi (Windows Fonts): Document
'w32-find-non-USB-fonts' and 'w32-non-USB-fonts'.

* etc/NEWS: Mention 'w32-find-non-USB-fonts' and
'w32-non-USB-fonts'.

1 files changed, 110 insertions, 17 deletions

diff --git a/src/w32font.c b/src/w32font.c
index 14d49b24d9b..9a334717c12 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -90,6 +90,8 @@ struct font_callback_data
   Lisp_Object orig_font_spec;
   /* The frame the font is being loaded on.  */
   Lisp_Object frame;
+  /* Fonts known to support the font spec, or nil if none.  */
+  Lisp_Object known_fonts;
   /* The list to add matches to.  */
   Lisp_Object list;
   /* Whether to match only opentype fonts.  */
@@ -841,6 +843,25 @@ w32font_list_internal (struct frame *f, Lisp_Object font_spec,
   match_data.opentype_only = opentype_only;
   if (opentype_only)
     match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
+  match_data.known_fonts = Qnil;
+  Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val;
+  if (CONSP (vw32_non_USB_fonts))
+    {
+      Lisp_Object extra;
+      for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
+	   CONSP (extra); extra = XCDR (extra))
+	{
+	  Lisp_Object tem = XCAR (extra);
+	  if (CONSP (tem)
+	      && EQ (XCAR (tem), QCscript)
+	      && SYMBOLP (XCDR (tem))
+	      && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts)))
+	    {
+	      match_data.known_fonts = XCDR (val);
+	      break;
+	    }
+	}
+    }
 
   if (match_data.pattern.lfFaceName[0] == '\0')
     {
@@ -890,6 +911,26 @@ w32font_match_internal (struct frame *f, Lisp_Object font_spec,
   if (opentype_only)
     match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
 
+  match_data.known_fonts = Qnil;
+  Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val;
+  if (CONSP (vw32_non_USB_fonts))
+    {
+      Lisp_Object extra;
+      for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
+	   CONSP (extra); extra = XCDR (extra))
+	{
+	  Lisp_Object tem = XCAR (extra);
+	  if (CONSP (tem)
+	      && EQ (XCAR (tem), QCscript)
+	      && SYMBOLP (XCDR (tem))
+	      && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts)))
+	    {
+	      match_data.known_fonts = XCDR (val);
+	      break;
+	    }
+	}
+    }
+
   /* Prevent quitting while EnumFontFamiliesEx runs and conses the
      list it will return.  That's because get_frame_dc acquires the
      critical section, so we cannot quit before we release it in
@@ -1511,9 +1552,13 @@ add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
 
   /* Ensure a match.  */
   if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
-      || !font_matches_spec (font_type, physical_font,
-			     match_data->orig_font_spec, backend,
-			     &logical_font->elfLogFont)
+      || !(font_matches_spec (font_type, physical_font,
+			      match_data->orig_font_spec, backend,
+			      &logical_font->elfLogFont)
+	   || (!NILP (match_data->known_fonts)
+	       && memq_no_quit
+	            (intern_font_name (logical_font->elfLogFont.lfFaceName),
+		     match_data->known_fonts)))
       || !w32font_coverage_ok (&physical_font->ntmFontSig,
 			       match_data->pattern.lfCharSet))
     return 1;
@@ -2214,8 +2259,9 @@ font_supported_scripts (FONTSIGNATURE * sig)
       || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
     supported = Fcons ((sym), supported)
 
-  SUBRANGE (0, Qlatin);
-  /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B.  */
+  /* 0: ASCII (a.k.a. "Basic Latin"),
+     1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B,
+     29: Latin Extended Additional.  */
   /* Most fonts that support Latin will have good coverage of the
      Extended blocks, so in practice marking them below is not really
      needed, or useful: if a font claims support for, say, Latin
@@ -2224,12 +2270,11 @@ font_supported_scripts (FONTSIGNATURE * sig)
      fontset to display those few characters.  But we mark these
      subranges here anyway, for the marginal use cases where they
      might make a difference.  */
-  SUBRANGE (1, Qlatin);
-  SUBRANGE (2, Qlatin);
-  SUBRANGE (3, Qlatin);
+  MASK_ANY (0x2000000F, 0, 0, 0, Qlatin);
   SUBRANGE (4, Qphonetic);
   /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks.  */
-  SUBRANGE (7, Qgreek);
+  /* 7: Greek and Coptic, 30: Greek Extended.  */
+  MASK_ANY (0x40000080, 0, 0, 0, Qgreek);
   SUBRANGE (8, Qcoptic);
   SUBRANGE (9, Qcyrillic);
   SUBRANGE (10, Qarmenian);
@@ -2246,7 +2291,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
   SUBRANGE (16, Qbengali);
   SUBRANGE (17, Qgurmukhi);
   SUBRANGE (18, Qgujarati);
-  SUBRANGE (19, Qoriya);
+  SUBRANGE (19, Qoriya);	/* a.k.a. "Odia" */
   SUBRANGE (20, Qtamil);
   SUBRANGE (21, Qtelugu);
   SUBRANGE (22, Qkannada);
@@ -2259,8 +2304,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
   /* 29: Latin Extended, 30: Greek Extended -- covered above.  */
   /* 31: Supplemental Punctuation -- most probably be masked by
      Courier New, so fontset customization is needed.  */
-  SUBRANGE (31, Qsymbol);
-  /* 32-47: Symbols (defined below).  */
+  /* 31-47: Symbols (defined below).  */
   SUBRANGE (48, Qcjk_misc);
   /* Match either 49: katakana or 50: hiragana for kana.  */
   MASK_ANY (0, 0x00060000, 0, 0, Qkana);
@@ -2286,7 +2330,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
   SUBRANGE (71, Qsyriac);
   SUBRANGE (72, Qthaana);
   SUBRANGE (73, Qsinhala);
-  SUBRANGE (74, Qmyanmar);
+  SUBRANGE (74, Qburmese);	/* a.k.a. "Myanmar" */
   SUBRANGE (75, Qethiopic);
   SUBRANGE (76, Qcherokee);
   SUBRANGE (77, Qcanadian_aboriginal);
@@ -2329,6 +2373,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
   SUBRANGE (99, Qhan);
   SUBRANGE (100, Qsyloti_nagri);
   SUBRANGE (101, Qlinear_b);
+  SUBRANGE (101, Qaegean_number);
   SUBRANGE (102, Qancient_greek_number);
   SUBRANGE (103, Qugaritic);
   SUBRANGE (104, Qold_persian);
@@ -2338,6 +2383,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
   SUBRANGE (108, Qkharoshthi);
   SUBRANGE (109, Qtai_xuan_jing_symbol);
   SUBRANGE (110, Qcuneiform);
+  SUBRANGE (111, Qcuneiform_numbers_and_punctuation);
   SUBRANGE (111, Qcounting_rod_numeral);
   SUBRANGE (112, Qsundanese);
   SUBRANGE (113, Qlepcha);
@@ -2357,9 +2403,52 @@ font_supported_scripts (FONTSIGNATURE * sig)
 
   /* There isn't really a main symbol range, so include symbol if any
      relevant range is set.  */
-  MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
-
-  /* Missing: Tai Viet (U+AA80-U+AADF).  */
+  MASK_ANY (0x80000000, 0x0000FFFF, 0, 0, Qsymbol);
+
+  /* Missing:
+       Tai Viet
+       Old Permic
+       Palmyrene
+       Nabatean
+       Manichean
+       Hanifi Rohingya
+       Sogdian
+       Elymaic
+       Mahajani
+       Khojki
+       Khudawadi
+       Grantha
+       Newa
+       Tirhuta
+       Siddham
+       Modi
+       Takri
+       Dogra
+       Warang Citi
+       Nandinagari
+       Zanabazar Square
+       Soyombo
+       Pau Cin Hau
+       Bhaiksuki
+       Marchen
+       Masaram Gondi
+       Makasar
+       Egyptian
+       Mro
+       Bassa-Vah
+       Pahawh Hmong
+       Medefaidrin
+       Tangut
+       Tangut Components
+       Nushu
+       Duployan Shorthand
+       Ancient Greek Musical Notation
+       Nyiakeng Puachue Hmong
+       Wancho
+       Mende Kikakui
+       Adlam
+       Indic Siyaq Number
+       Ottoman Siyaq Number.  */
 #undef SUBRANGE
 #undef MASK_ANY
 
@@ -2698,7 +2787,7 @@ syms_of_w32font (void)
   DEFSYM (Qthai, "thai");
   DEFSYM (Qlao, "lao");
   DEFSYM (Qtibetan, "tibetan");
-  DEFSYM (Qmyanmar, "myanmar");
+  DEFSYM (Qburmese, "burmese");
   DEFSYM (Qgeorgian, "georgian");
   DEFSYM (Qhangul, "hangul");
   DEFSYM (Qethiopic, "ethiopic");
@@ -2737,6 +2826,8 @@ syms_of_w32font (void)
   DEFSYM (Qbuginese, "buginese");
   DEFSYM (Qbuhid, "buhid");
   DEFSYM (Qcuneiform, "cuneiform");
+  DEFSYM (Qcuneiform_numbers_and_punctuation,
+	  "cuneiform-numbers-and-punctuation");
   DEFSYM (Qcypriot, "cypriot");
   DEFSYM (Qdeseret, "deseret");
   DEFSYM (Qglagolitic, "glagolitic");
@@ -2745,6 +2836,7 @@ syms_of_w32font (void)
   DEFSYM (Qkharoshthi, "kharoshthi");
   DEFSYM (Qlimbu, "limbu");
   DEFSYM (Qlinear_b, "linear_b");
+  DEFSYM (Qaegean_number, "aegean-number");
   DEFSYM (Qold_italic, "old_italic");
   DEFSYM (Qold_persian, "old_persian");
   DEFSYM (Qosmanya, "osmanya");
@@ -2818,6 +2910,7 @@ versions of Windows) characters.  */);
   DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
   DEFSYM (Qw32_charset_thai, "w32-charset-thai");
   DEFSYM (Qw32_charset_mac, "w32-charset-mac");
+  DEFSYM (Qw32_non_USB_fonts, "w32-non-USB-fonts");
 
   defsubr (&Sx_select_font);