root/src/font.c

DEFINITIONS

1. valid_font_driver
2. font_make_spec
3. font_make_entity
4. font_make_object
5. font_build_object
6. font_intern_prop
7. font_pixel_size
8. font_style_to_value
9. font_style_symbolic
10. find_font_encoding
11. font_registry_charsets
12. font_prop_validate_symbol
13. font_prop_validate_style
14. font_prop_validate_non_neg
15. font_prop_validate_spacing
16. font_prop_validate_otf
17. get_font_prop_index
18. font_prop_validate
19. font_put_extra
20. parse_matrix
21. font_expand_wildcards
22. font_parse_xlfd_1
23. font_parse_xlfd
24. font_unparse_xlfd
25. font_parse_fcname
26. font_unparse_fcname
27. font_parse_name
28. font_parse_family_registry
29. font_rescale_ratio
30. font_score
31. font_vconcat_entity_vectors
32. font_compare
33. font_sort_entities
34. font_update_sort_order
35. font_check_otf_features
36. font_check_otf
37. font_match_p
38. font_prepare_cache
39. font_finish_cache
40. font_get_cache
41. font_clear_cache
42. font_is_ignored
43. font_delete_unmatched
44. font_list_entities
45. font_matching_entity
46. font_open_entity
47. font_close_object
48. font_has_char
49. font_encode_char
50. font_get_name
51. font_spec_from_name
52. font_clear_prop
53. font_select_entity
54. font_find_for_lface
55. font_open_for_lface
56. font_load_for_lface
57. font_prepare_for_face
58. font_done_for_face
59. font_open_by_spec
60. font_open_by_name
61. register_font_driver
62. free_font_driver_list
63. font_update_drivers
64. fset_font_data
65. font_put_frame_data
66. font_get_frame_data
67. font_filter_properties
68. font_at
69. codepoint_is_emoji_eligible
70. font_range
71. copy_font_spec
72. merge_font_spec
73. DEFUN
74. clear_font_cache
75. DEFUN
76. font_fill_lglyph_metrics
77. check_gstring
78. check_otf_features
79. otf_tag_symbol
80. otf_open
81. font_otf_capability
82. generate_otf_features
83. font_otf_DeviceTable
84. font_otf_ValueRecord
85. font_otf_Anchor
86. DEFUN
87. DEFUN
88. build_style_table
89. font_add_log
90. font_deferred_log
91. font_drop_xrender_surfaces
92. syms_of_font
93. init_font

     1 /* font.c -- "Font" primitives.
     2 
     3 Copyright (C) 2006-2023 Free Software Foundation, Inc.
     4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
     5   National Institute of Advanced Industrial Science and Technology (AIST)
     6   Registration Number H13PRO009
     7 
     8 This file is part of GNU Emacs.
     9 
    10 GNU Emacs is free software: you can redistribute it and/or modify
    11 it under the terms of the GNU General Public License as published by
    12 the Free Software Foundation, either version 3 of the License, or (at
    13 your option) any later version.
    14 
    15 GNU Emacs is distributed in the hope that it will be useful,
    16 but WITHOUT ANY WARRANTY; without even the implied warranty of
    17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    18 GNU General Public License for more details.
    19 
    20 You should have received a copy of the GNU General Public License
    21 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    22 
    23 #include <config.h>
    24 #include <float.h>
    25 #include <stdio.h>
    26 #include <stdlib.h>
    27 
    28 #include <c-ctype.h>
    29 
    30 #include "lisp.h"
    31 #include "character.h"
    32 #include "buffer.h"
    33 #include "frame.h"
    34 #include "window.h"
    35 #include "dispextern.h"
    36 #include "charset.h"
    37 #include "composite.h"
    38 #include "fontset.h"
    39 #include "font.h"
    40 #include "termhooks.h"
    41 #include "pdumper.h"
    42 
    43 #ifdef HAVE_WINDOW_SYSTEM
    44 #include TERM_HEADER
    45 #endif /* HAVE_WINDOW_SYSTEM */
    46 
    47 #define DEFAULT_ENCODING Qiso8859_1
    48 
    49 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
    50 static Lisp_Object font_style_table;
    51 
    52 /* Structure used for tables mapping weight, slant, and width numeric
    53    values and their names.  */
    54 
    55 struct table_entry
    56 {
    57   int numeric;
    58   /* The first one is a valid name as a face attribute.
    59      The second one (if any) is a typical name in XLFD field.  */
    60   const char *names[6];
    61 };
    62 
    63 /* The following tables should be in sync with 'custom-face-attributes'.  */
    64 
    65 /* Table of weight numeric values and their names.  This table must be
    66    sorted by numeric values in ascending order and the numeric values
    67    must approximately match the weights in the font files.  */
    68 
    69 static const struct table_entry weight_table[] =
    70 {
    71   { 0, { "thin" }},
    72   { 40, { "ultra-light", "ultralight", "extra-light", "extralight" }},
    73   { 50, { "light" }},
    74   { 55, { "semi-light", "semilight", "demilight" }},
    75   { 80, { "regular", "normal", "unspecified", "book" }},
    76   { 100, { "medium" }},
    77   { 180, { "semi-bold", "semibold", "demibold", "demi-bold", "demi" }},
    78   { 200, { "bold" }},
    79   { 205, { "extra-bold", "extrabold", "ultra-bold", "ultrabold" }},
    80   { 210, { "black", "heavy" }},
    81   { 250, { "ultra-heavy", "ultraheavy" }}
    82 };
    83 
    84 /* Table of slant numeric values and their names.  This table must be
    85    sorted by numeric values in ascending order.  */
    86 
    87 static const struct table_entry slant_table[] =
    88 {
    89   { 0, { "reverse-oblique", "ro" }},
    90   { 10, { "reverse-italic", "ri" }},
    91   { 100, { "normal", "r", "unspecified" }},
    92   { 200, { "italic" ,"i", "ot" }},
    93   { 210, { "oblique", "o" }}
    94 };
    95 
    96 /* Table of width numeric values and their names.  This table must be
    97    sorted by numeric values in ascending order.  */
    98 
    99 static const struct table_entry width_table[] =
   100 {
   101   { 50, { "ultra-condensed", "ultracondensed" }},
   102   { 63, { "extra-condensed", "extracondensed" }},
   103   { 75, { "condensed", "compressed", "narrow" }},
   104   { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
   105   { 100, { "normal", "medium", "regular", "unspecified" }},
   106   { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
   107   { 125, { "expanded" }},
   108   { 150, { "extra-expanded", "extraexpanded" }},
   109   { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
   110 };
   111 
   112 /* Alist of font registry symbols and the corresponding charset
   113    information.  The information is retrieved from
   114    Vfont_encoding_alist on demand.
   115 
   116    Eash element has the form:
   117         (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
   118    or
   119         (REGISTRY . nil)
   120 
   121    In the former form, ENCODING-CHARSET-ID is an ID of a charset that
   122    encodes a character code to a glyph code of a font, and
   123    REPERTORY-CHARSET-ID is an ID of a charset that tells if a
   124    character is supported by a font.
   125 
   126    The latter form means that the information for REGISTRY couldn't be
   127    retrieved.  */
   128 static Lisp_Object font_charset_alist;
   129 
   130 /* List of all font drivers.  Each font-backend (XXXfont.c) calls
   131    register_font_driver in syms_of_XXXfont to register its font-driver
   132    here.  */
   133 static struct font_driver_list *font_driver_list;
   134 
   135 #ifdef ENABLE_CHECKING
   136 
   137 /* Used to catch bogus pointers in font objects.  */
   138 
   139 bool
   140 valid_font_driver (struct font_driver const *drv)
   141 {
   142   Lisp_Object tail, frame;
   143   struct font_driver_list *fdl;
   144 
   145   for (fdl = font_driver_list; fdl; fdl = fdl->next)
   146     if (fdl->driver == drv)
   147       return true;
   148   FOR_EACH_FRAME (tail, frame)
   149     for (fdl = XFRAME (frame)->font_driver_list; fdl; fdl = fdl->next)
   150       if (fdl->driver == drv)
   151         return true;
   152   return false;
   153 }
   154 
   155 #endif /* ENABLE_CHECKING */
   156 
   157 /* Creators of font-related Lisp object.  */
   158 
   159 static Lisp_Object
   160 font_make_spec (void)
   161 {
   162   Lisp_Object font_spec;
   163   struct font_spec *spec
   164     = ((struct font_spec *)
   165        allocate_pseudovector (VECSIZE (struct font_spec),
   166                               FONT_SPEC_MAX, FONT_SPEC_MAX, PVEC_FONT));
   167   XSETFONT (font_spec, spec);
   168   return font_spec;
   169 }
   170 
   171 Lisp_Object
   172 font_make_entity (void)
   173 {
   174   Lisp_Object font_entity;
   175   struct font_entity *entity
   176     = ((struct font_entity *)
   177        allocate_pseudovector (VECSIZE (struct font_entity),
   178                               FONT_ENTITY_MAX, FONT_ENTITY_MAX, PVEC_FONT));
   179   XSETFONT (font_entity, entity);
   180   return font_entity;
   181 }
   182 
   183 /* Create a font-object whose structure size is SIZE.  If ENTITY is
   184    not nil, copy properties from ENTITY to the font-object.  If
   185    PIXELSIZE is positive, set the `size' property to PIXELSIZE.  */
   186 Lisp_Object
   187 font_make_object (int size, Lisp_Object entity, int pixelsize)
   188 {
   189   Lisp_Object font_object;
   190   struct font *font
   191     = (struct font *) allocate_pseudovector (size, FONT_OBJECT_MAX,
   192                                              FONT_OBJECT_MAX, PVEC_FONT);
   193   int i;
   194 
   195   /* Poison the max_width, so we can detect when it hasn't been set.  */
   196   eassert (font->max_width = 1024 * 1024 * 1024);
   197 
   198   /* GC can happen before the driver is set up,
   199      so avoid dangling pointer here (Bug#17771).  */
   200   font->driver = NULL;
   201   XSETFONT (font_object, font);
   202 
   203   if (! NILP (entity))
   204     {
   205       for (i = 1; i < FONT_SPEC_MAX; i++)
   206         font->props[i] = AREF (entity, i);
   207       if (! NILP (AREF (entity, FONT_EXTRA_INDEX)))
   208         font->props[FONT_EXTRA_INDEX]
   209           = Fcopy_alist (AREF (entity, FONT_EXTRA_INDEX));
   210     }
   211   if (size > 0)
   212     font->props[FONT_SIZE_INDEX] = make_fixnum (pixelsize);
   213   return font_object;
   214 }
   215 
   216 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
   217 
   218 static int font_unparse_fcname (Lisp_Object, int, char *, int);
   219 
   220 /* Like above, but also set `type', `name' and `fullname' properties
   221    of font-object.  */
   222 
   223 Lisp_Object
   224 font_build_object (int vectorsize, Lisp_Object type,
   225                    Lisp_Object entity, double pixelsize)
   226 {
   227   int len;
   228   char name[256];
   229   Lisp_Object font_object = font_make_object (vectorsize, entity, pixelsize);
   230 
   231   ASET (font_object, FONT_TYPE_INDEX, type);
   232   len = font_unparse_xlfd (entity, pixelsize, name, sizeof name);
   233   if (len > 0)
   234     ASET (font_object, FONT_NAME_INDEX, make_string (name, len));
   235   len = font_unparse_fcname (entity, pixelsize, name, sizeof name);
   236   if (len > 0)
   237     ASET (font_object, FONT_FULLNAME_INDEX, make_string (name, len));
   238   else
   239     ASET (font_object, FONT_FULLNAME_INDEX,
   240           AREF (font_object, FONT_NAME_INDEX));
   241   return font_object;
   242 }
   243 
   244 #endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
   245 
   246 static int font_pixel_size (struct frame *f, Lisp_Object);
   247 static Lisp_Object font_open_entity (struct frame *, Lisp_Object, int);
   248 static Lisp_Object font_matching_entity (struct frame *, Lisp_Object *,
   249                                          Lisp_Object);
   250 static unsigned font_encode_char (Lisp_Object, int);
   251 
   252 /* Number of registered font drivers.  */
   253 static int num_font_drivers;
   254 
   255 
   256 /* Return a Lispy value of a font property value at STR and LEN bytes.
   257    If STR is "*", return nil.  If FORCE_SYMBOL, or if STR does not
   258    consist entirely of one or more digits, return a symbol interned
   259    from STR.  Otherwise, return an integer.  */
   260 
   261 Lisp_Object
   262 font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
   263 {
   264   ptrdiff_t i, nbytes, nchars;
   265   Lisp_Object tem, name, obarray;
   266 
   267   if (len == 1 && *str == '*')
   268     return Qnil;
   269   if (!force_symbol && 0 < len && '0' <= *str && *str <= '9')
   270     {
   271       for (i = 1; i < len; i++)
   272         if (! ('0' <= str[i] && str[i] <= '9'))
   273           break;
   274       if (i == len)
   275         {
   276           i = 0;
   277           for (EMACS_INT n = 0;
   278                (n += str[i++] - '0') <= MOST_POSITIVE_FIXNUM; )
   279             {
   280               if (i == len)
   281                 return make_fixnum (n);
   282               if (INT_MULTIPLY_WRAPV (n, 10, &n))
   283                 break;
   284             }
   285 
   286           xsignal1 (Qoverflow_error, make_string (str, len));
   287         }
   288     }
   289 
   290   /* This code is similar to intern function from lread.c.  */
   291   obarray = check_obarray (Vobarray);
   292   parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
   293   tem = oblookup (obarray, str,
   294                   (len == nchars || len != nbytes) ? len : nchars, len);
   295   if (SYMBOLP (tem))
   296     return tem;
   297   name = make_specified_string (str, nchars, len,
   298                                 len != nchars && len == nbytes);
   299   return intern_driver (name, obarray, tem);
   300 }
   301 
   302 /* Return a pixel size of font-spec SPEC on frame F.  */
   303 
   304 static int
   305 font_pixel_size (struct frame *f, Lisp_Object spec)
   306 {
   307 #ifdef HAVE_WINDOW_SYSTEM
   308   Lisp_Object size = AREF (spec, FONT_SIZE_INDEX);
   309   double point_size;
   310   int dpi, pixel_size;
   311   Lisp_Object val;
   312 
   313   if (FIXNUMP (size))
   314     return XFIXNUM (size);
   315   if (NILP (size))
   316     return 0;
   317   if (FRAME_WINDOW_P (f))
   318     {
   319       eassert (FLOATP (size));
   320       point_size = XFLOAT_DATA (size);
   321       val = AREF (spec, FONT_DPI_INDEX);
   322       if (FIXNUMP (val))
   323         dpi = XFIXNUM (val);
   324       else
   325         dpi = FRAME_RES_Y (f);
   326       pixel_size = POINT_TO_PIXEL (point_size, dpi);
   327       return pixel_size;
   328     }
   329 #endif
   330   return 1;
   331 }
   332 
   333 
   334 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
   335    font vector.  If VAL is not valid (i.e. not registered in
   336    font_style_table), return -1 if NOERROR is zero, and return a
   337    proper index if NOERROR is nonzero.  In that case, register VAL in
   338    font_style_table if VAL is a symbol, and return the closest index if
   339    VAL is an integer.  */
   340 
   341 int
   342 font_style_to_value (enum font_property_index prop, Lisp_Object val,
   343                      bool noerror)
   344 {
   345   Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
   346   int len;
   347 
   348   CHECK_VECTOR (table);
   349   len = ASIZE (table);
   350 
   351   if (SYMBOLP (val))
   352     {
   353       int i, j;
   354       char *s;
   355       Lisp_Object elt;
   356 
   357       /* At first try exact match.  */
   358       for (i = 0; i < len; i++)
   359         {
   360           CHECK_VECTOR (AREF (table, i));
   361           for (j = 1; j < ASIZE (AREF (table, i)); j++)
   362             if (EQ (val, AREF (AREF (table, i), j)))
   363               {
   364                 CHECK_FIXNUM (AREF (AREF (table, i), 0));
   365                 return ((XFIXNUM (AREF (AREF (table, i), 0)) << 8)
   366                         | (i << 4) | (j - 1));
   367               }
   368         }
   369       /* Try also with case-folding match.  */
   370       s = SSDATA (SYMBOL_NAME (val));
   371       for (i = 0; i < len; i++)
   372         for (j = 1; j < ASIZE (AREF (table, i)); j++)
   373           {
   374             elt = AREF (AREF (table, i), j);
   375             if (xstrcasecmp (s, SSDATA (SYMBOL_NAME (elt))) == 0)
   376               {
   377                 CHECK_FIXNUM (AREF (AREF (table, i), 0));
   378                 return ((XFIXNUM (AREF (AREF (table, i), 0)) << 8)
   379                         | (i << 4) | (j - 1));
   380               }
   381           }
   382       if (! noerror)
   383         return -1;
   384       eassert (len < 255);
   385       elt = make_vector (2, make_fixnum (100));
   386       ASET (elt, 1, val);
   387       ASET (font_style_table, prop - FONT_WEIGHT_INDEX,
   388             CALLN (Fvconcat, table, make_vector (1, elt)));
   389       return (100 << 8) | (i << 4);
   390     }
   391   else
   392     {
   393       int i, last_n;
   394       EMACS_INT numeric = XFIXNUM (val);
   395 
   396       for (i = 0, last_n = -1; i < len; i++)
   397         {
   398           int n;
   399 
   400           CHECK_VECTOR (AREF (table, i));
   401           CHECK_FIXNUM (AREF (AREF (table, i), 0));
   402           n = XFIXNUM (AREF (AREF (table, i), 0));
   403           if (numeric == n)
   404             return (n << 8) | (i << 4);
   405           if (numeric < n)
   406             {
   407               if (! noerror)
   408                 return -1;
   409               return ((i == 0 || n - numeric < numeric - last_n)
   410                       ? (n << 8) | (i << 4): (last_n << 8 | ((i - 1) << 4)));
   411             }
   412           last_n = n;
   413         }
   414       if (! noerror)
   415         return -1;
   416       return ((last_n << 8) | ((i - 1) << 4));
   417     }
   418 }
   419 
   420 Lisp_Object
   421 font_style_symbolic (Lisp_Object font, enum font_property_index prop,
   422                      bool for_face)
   423 {
   424   Lisp_Object val = AREF (font, prop);
   425   Lisp_Object table, elt;
   426   int i;
   427 
   428   if (NILP (val))
   429     return Qnil;
   430   table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
   431   CHECK_VECTOR (table);
   432   i = XFIXNUM (val) & 0xFF;
   433   eassert (((i >> 4) & 0xF) < ASIZE (table));
   434   elt = AREF (table, ((i >> 4) & 0xF));
   435   CHECK_VECTOR (elt);
   436   eassert ((i & 0xF) + 1 < ASIZE (elt));
   437   elt = (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
   438   CHECK_SYMBOL (elt);
   439   return elt;
   440 }
   441 
   442 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
   443    FONTNAME.  ENCODING is a charset symbol that specifies the encoding
   444    of the font.  REPERTORY is a charset symbol or nil.  */
   445 
   446 Lisp_Object
   447 find_font_encoding (Lisp_Object fontname)
   448 {
   449   Lisp_Object tail, elt;
   450 
   451   for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
   452     {
   453       elt = XCAR (tail);
   454       if (CONSP (elt)
   455           && STRINGP (XCAR (elt))
   456           && fast_string_match_ignore_case (XCAR (elt), fontname) >= 0
   457           && (SYMBOLP (XCDR (elt))
   458               ? CHARSETP (XCDR (elt))
   459               : CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
   460         return (XCDR (elt));
   461     }
   462   return Qnil;
   463 }
   464 
   465 /* Return encoding charset and repertory charset for REGISTRY in
   466    ENCODING and REPERTORY correspondingly.  If correct information for
   467    REGISTRY is available, return 0.  Otherwise return -1.  */
   468 
   469 int
   470 font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct charset **repertory)
   471 {
   472   Lisp_Object val;
   473   int encoding_id, repertory_id;
   474 
   475   val = Fassoc_string (registry, font_charset_alist, Qt);
   476   if (! NILP (val))
   477     {
   478       val = XCDR (val);
   479       if (NILP (val))
   480         return -1;
   481       encoding_id = XFIXNUM (XCAR (val));
   482       repertory_id = XFIXNUM (XCDR (val));
   483     }
   484   else
   485     {
   486       val = find_font_encoding (SYMBOL_NAME (registry));
   487       if (SYMBOLP (val) && CHARSETP (val))
   488         {
   489           encoding_id = repertory_id = XFIXNUM (CHARSET_SYMBOL_ID (val));
   490         }
   491       else if (CONSP (val))
   492         {
   493           if (! CHARSETP (XCAR (val)))
   494             goto invalid_entry;
   495           encoding_id = XFIXNUM (CHARSET_SYMBOL_ID (XCAR (val)));
   496           if (NILP (XCDR (val)))
   497             repertory_id = -1;
   498           else
   499             {
   500               if (! CHARSETP (XCDR (val)))
   501                 goto invalid_entry;
   502               repertory_id = XFIXNUM (CHARSET_SYMBOL_ID (XCDR (val)));
   503             }
   504         }
   505       else
   506         goto invalid_entry;
   507       val = Fcons (make_fixnum (encoding_id), make_fixnum (repertory_id));
   508       font_charset_alist
   509         = nconc2 (font_charset_alist, list1 (Fcons (registry, val)));
   510     }
   511 
   512   if (encoding)
   513     *encoding = CHARSET_FROM_ID (encoding_id);
   514   if (repertory)
   515     *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL;
   516   return 0;
   517 
   518  invalid_entry:
   519   font_charset_alist
   520     = nconc2 (font_charset_alist, list1 (Fcons (registry, Qnil)));
   521   return -1;
   522 }
   523 
   524 
   525 /* Font property value validators.  See the comment of
   526    font_property_table for the meaning of the arguments.  */
   527 
   528 static Lisp_Object font_prop_validate (int, Lisp_Object, Lisp_Object);
   529 static Lisp_Object font_prop_validate_symbol (Lisp_Object, Lisp_Object);
   530 static Lisp_Object font_prop_validate_style (Lisp_Object, Lisp_Object);
   531 static Lisp_Object font_prop_validate_non_neg (Lisp_Object, Lisp_Object);
   532 static Lisp_Object font_prop_validate_spacing (Lisp_Object, Lisp_Object);
   533 static int get_font_prop_index (Lisp_Object);
   534 
   535 static Lisp_Object
   536 font_prop_validate_symbol (Lisp_Object prop, Lisp_Object val)
   537 {
   538   if (STRINGP (val))
   539     val = Fintern (val, Qnil);
   540   if (! SYMBOLP (val))
   541     val = Qerror;
   542   else if (EQ (prop, QCregistry))
   543     val = Fintern (Fdowncase (SYMBOL_NAME (val)), Qnil);
   544   return val;
   545 }
   546 
   547 
   548 static Lisp_Object
   549 font_prop_validate_style (Lisp_Object style, Lisp_Object val)
   550 {
   551   enum font_property_index prop = (EQ (style, QCweight) ? FONT_WEIGHT_INDEX
   552                                    : EQ (style, QCslant) ? FONT_SLANT_INDEX
   553                                    : FONT_WIDTH_INDEX);
   554   if (FIXNUMP (val))
   555     {
   556       EMACS_INT n = XFIXNUM (val);
   557       CHECK_VECTOR (AREF (font_style_table, prop - FONT_WEIGHT_INDEX));
   558       if (((n >> 4) & 0xF)
   559           >= ASIZE (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)))
   560         val = Qerror;
   561       else
   562         {
   563           Lisp_Object elt = AREF (AREF (font_style_table, prop - FONT_WEIGHT_INDEX), (n >> 4) & 0xF);
   564 
   565           CHECK_VECTOR (elt);
   566           if ((n & 0xF) + 1 >= ASIZE (elt))
   567             val = Qerror;
   568           else
   569             {
   570               CHECK_FIXNUM (AREF (elt, 0));
   571               if (XFIXNUM (AREF (elt, 0)) != (n >> 8))
   572                 val = Qerror;
   573             }
   574         }
   575     }
   576   else if (SYMBOLP (val))
   577     {
   578       int n = font_style_to_value (prop, val, 0);
   579 
   580       val = n >= 0 ? make_fixnum (n) : Qerror;
   581     }
   582   else
   583     val = Qerror;
   584   return val;
   585 }
   586 
   587 static Lisp_Object
   588 font_prop_validate_non_neg (Lisp_Object prop, Lisp_Object val)
   589 {
   590   return (FIXNATP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0)
   591           ? val : Qerror);
   592 }
   593 
   594 static Lisp_Object
   595 font_prop_validate_spacing (Lisp_Object prop, Lisp_Object val)
   596 {
   597   if (NILP (val) || (FIXNATP (val) && XFIXNUM (val) <= FONT_SPACING_CHARCELL))
   598     return val;
   599   if (SYMBOLP (val) && SBYTES (SYMBOL_NAME (val)) == 1)
   600     {
   601       char spacing = SDATA (SYMBOL_NAME (val))[0];
   602 
   603       if (spacing == 'c' || spacing == 'C')
   604         return make_fixnum (FONT_SPACING_CHARCELL);
   605       if (spacing == 'm' || spacing == 'M')
   606         return make_fixnum (FONT_SPACING_MONO);
   607       if (spacing == 'p' || spacing == 'P')
   608         return make_fixnum (FONT_SPACING_PROPORTIONAL);
   609       if (spacing == 'd' || spacing == 'D')
   610         return make_fixnum (FONT_SPACING_DUAL);
   611     }
   612   return Qerror;
   613 }
   614 
   615 static Lisp_Object
   616 font_prop_validate_otf (Lisp_Object prop, Lisp_Object val)
   617 {
   618   Lisp_Object tail, tmp;
   619   int i;
   620 
   621   /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
   622      GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
   623      GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil  */
   624   if (! CONSP (val))
   625     return Qerror;
   626   if (! SYMBOLP (XCAR (val)))
   627     return Qerror;
   628   tail = XCDR (val);
   629   if (NILP (tail))
   630     return val;
   631   if (! CONSP (tail) || ! SYMBOLP (XCAR (val)))
   632     return Qerror;
   633   for (i = 0; i < 2; i++)
   634     {
   635       tail = XCDR (tail);
   636       if (NILP (tail))
   637         return val;
   638       if (! CONSP (tail))
   639         return Qerror;
   640       for (tmp = XCAR (tail); CONSP (tmp); tmp = XCDR (tmp))
   641         if (! SYMBOLP (XCAR (tmp)))
   642           return Qerror;
   643       if (! NILP (tmp))
   644         return Qerror;
   645     }
   646   return val;
   647 }
   648 
   649 /* Structure of known font property keys and validator of the
   650    values.  */
   651 static const struct
   652 {
   653   /* Index of the key symbol.  */
   654   int key;
   655   /* Function to validate PROP's value VAL, or NULL if any value is
   656      ok.  The value is VAL or its regularized value if VAL is valid,
   657      and Qerror if not.  */
   658   Lisp_Object (*validator) (Lisp_Object prop, Lisp_Object val);
   659 } font_property_table[] =
   660   { { SYMBOL_INDEX (QCtype), font_prop_validate_symbol },
   661     { SYMBOL_INDEX (QCfoundry), font_prop_validate_symbol },
   662     { SYMBOL_INDEX (QCfamily), font_prop_validate_symbol },
   663     { SYMBOL_INDEX (QCadstyle), font_prop_validate_symbol },
   664     { SYMBOL_INDEX (QCregistry), font_prop_validate_symbol },
   665     { SYMBOL_INDEX (QCweight), font_prop_validate_style },
   666     { SYMBOL_INDEX (QCslant), font_prop_validate_style },
   667     { SYMBOL_INDEX (QCwidth), font_prop_validate_style },
   668     { SYMBOL_INDEX (QCsize), font_prop_validate_non_neg },
   669     { SYMBOL_INDEX (QCdpi), font_prop_validate_non_neg },
   670     { SYMBOL_INDEX (QCspacing), font_prop_validate_spacing },
   671     { SYMBOL_INDEX (QCavgwidth), font_prop_validate_non_neg },
   672     /* The order of the above entries must match with enum
   673        font_property_index.  */
   674     { SYMBOL_INDEX (QClang), font_prop_validate_symbol },
   675     { SYMBOL_INDEX (QCscript), font_prop_validate_symbol },
   676     { SYMBOL_INDEX (QCotf), font_prop_validate_otf }
   677   };
   678 
   679 /* Return an index number of font property KEY or -1 if KEY is not an
   680    already known property.  */
   681 
   682 static int
   683 get_font_prop_index (Lisp_Object key)
   684 {
   685   int i;
   686 
   687   for (i = 0; i < ARRAYELTS (font_property_table); i++)
   688     if (EQ (key, builtin_lisp_symbol (font_property_table[i].key)))
   689       return i;
   690   return -1;
   691 }
   692 
   693 /* Validate the font property.  The property key is specified by the
   694    symbol PROP, or the index IDX (if PROP is nil).  If VAL is invalid,
   695    signal an error.  The value is VAL or the regularized one.  */
   696 
   697 static Lisp_Object
   698 font_prop_validate (int idx, Lisp_Object prop, Lisp_Object val)
   699 {
   700   Lisp_Object validated;
   701 
   702   if (NILP (val))
   703     return val;
   704   if (NILP (prop))
   705     prop = builtin_lisp_symbol (font_property_table[idx].key);
   706   else
   707     {
   708       idx = get_font_prop_index (prop);
   709       if (idx < 0)
   710         return val;
   711     }
   712   validated = (font_property_table[idx].validator) (prop, val);
   713   if (EQ (validated, Qerror))
   714     signal_error ("invalid font property", Fcons (prop, val));
   715   return validated;
   716 }
   717 
   718 
   719 /* Store VAL as a value of extra font property PROP in FONT while
   720    keeping the sorting order.  Don't check the validity of VAL.  If
   721    VAL is Qunbound, delete the slot for PROP from the list of extra
   722    properties.  */
   723 
   724 Lisp_Object
   725 font_put_extra (Lisp_Object font, Lisp_Object prop, Lisp_Object val)
   726 {
   727   Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX);
   728   Lisp_Object slot = (NILP (extra) ? Qnil : assq_no_quit (prop, extra));
   729 
   730   if (NILP (slot))
   731     {
   732       Lisp_Object prev = Qnil;
   733 
   734       if (BASE_EQ (val, Qunbound))
   735         return val;
   736       while (CONSP (extra)
   737              && NILP (Fstring_lessp (prop, XCAR (XCAR (extra)))))
   738         prev = extra, extra = XCDR (extra);
   739 
   740       if (NILP (prev))
   741         ASET (font, FONT_EXTRA_INDEX, Fcons (Fcons (prop, val), extra));
   742       else
   743         XSETCDR (prev, Fcons (Fcons (prop, val), extra));
   744 
   745       return val;
   746     }
   747   XSETCDR (slot, val);
   748   if (BASE_EQ (val, Qunbound))
   749     ASET (font, FONT_EXTRA_INDEX, Fdelq (slot, extra));
   750   return val;
   751 }
   752 
   753 
   754 /* Font name parser and unparser.  */
   755 
   756 static int parse_matrix (const char *);
   757 static int font_expand_wildcards (Lisp_Object *, int);
   758 static int font_parse_name (char *, ptrdiff_t, Lisp_Object);
   759 
   760 /* An enumerator for each field of an XLFD font name.  */
   761 enum xlfd_field_index
   762 {
   763   XLFD_FOUNDRY_INDEX,
   764   XLFD_FAMILY_INDEX,
   765   XLFD_WEIGHT_INDEX,
   766   XLFD_SLANT_INDEX,
   767   XLFD_SWIDTH_INDEX,
   768   XLFD_ADSTYLE_INDEX,
   769   XLFD_PIXEL_INDEX,
   770   XLFD_POINT_INDEX,
   771   XLFD_RESX_INDEX,
   772   XLFD_RESY_INDEX,
   773   XLFD_SPACING_INDEX,
   774   XLFD_AVGWIDTH_INDEX,
   775   XLFD_REGISTRY_INDEX,
   776   XLFD_ENCODING_INDEX,
   777   XLFD_LAST_INDEX
   778 };
   779 
   780 /* An enumerator for mask bit corresponding to each XLFD field.  */
   781 enum xlfd_field_mask
   782 {
   783   XLFD_FOUNDRY_MASK = 0x0001,
   784   XLFD_FAMILY_MASK = 0x0002,
   785   XLFD_WEIGHT_MASK = 0x0004,
   786   XLFD_SLANT_MASK = 0x0008,
   787   XLFD_SWIDTH_MASK = 0x0010,
   788   XLFD_ADSTYLE_MASK = 0x0020,
   789   XLFD_PIXEL_MASK = 0x0040,
   790   XLFD_POINT_MASK = 0x0080,
   791   XLFD_RESX_MASK = 0x0100,
   792   XLFD_RESY_MASK = 0x0200,
   793   XLFD_SPACING_MASK = 0x0400,
   794   XLFD_AVGWIDTH_MASK = 0x0800,
   795   XLFD_REGISTRY_MASK = 0x1000,
   796   XLFD_ENCODING_MASK = 0x2000
   797 };
   798 
   799 
   800 /* Parse P pointing to the pixel/point size field of the form
   801    `[A B C D]' which specifies a transformation matrix:
   802 
   803         A  B  0
   804         C  D  0
   805         0  0  1
   806 
   807    by which all glyphs of the font are transformed.  The spec says
   808    that scalar value N for the pixel/point size is equivalent to:
   809    A = N * resx/resy, B = C = 0, D = N.
   810 
   811    Return the scalar value N if the form is valid.  Otherwise return
   812    -1.  */
   813 
   814 static int
   815 parse_matrix (const char *p)
   816 {
   817   double matrix[4];
   818   char *end;
   819   int i;
   820 
   821   for (i = 0, p++; i < 4 && *p && *p != ']'; i++)
   822     {
   823       if (*p == '~')
   824         matrix[i] = - strtod (p + 1, &end);
   825       else
   826         matrix[i] = strtod (p, &end);
   827       p = end;
   828     }
   829   return (i == 4 ? (int) matrix[3] : -1);
   830 }
   831 
   832 /* Expand a wildcard field in FIELD (the first N fields are filled) to
   833    multiple fields to fill in all 14 XLFD fields while restricting a
   834    field position by its contents.  */
   835 
   836 static int
   837 font_expand_wildcards (Lisp_Object *field, int n)
   838 {
   839   /* Copy of FIELD.  */
   840   Lisp_Object tmp[XLFD_LAST_INDEX];
   841   /* Array of information about where this element can go.  Nth
   842      element is for Nth element of FIELD. */
   843   struct {
   844     /* Minimum possible field.  */
   845     int from;
   846     /* Maximum possible field.  */
   847     int to;
   848     /* Bit mask of possible field.  Nth bit corresponds to Nth field.  */
   849     int mask;
   850   } range[XLFD_LAST_INDEX];
   851   int i, j;
   852   int range_from, range_to;
   853   unsigned range_mask;
   854 
   855 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
   856                           | XLFD_ADSTYLE_MASK  | XLFD_REGISTRY_MASK)
   857 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
   858 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
   859                             | XLFD_AVGWIDTH_MASK)
   860 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
   861 
   862   /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
   863      field.  The value is shifted to left one bit by one in the
   864      following loop.  */
   865   for (i = 0, range_mask = 0; i <= 14 - n; i++)
   866     range_mask = (range_mask << 1) | 1;
   867 
   868   /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
   869      position-based restriction for FIELD[I].  */
   870   for (i = 0, range_from = 0, range_to = 14 - n; i < n;
   871        i++, range_from++, range_to++, range_mask <<= 1)
   872     {
   873       Lisp_Object val = field[i];
   874 
   875       tmp[i] = val;
   876       if (NILP (val))
   877         {
   878           /* Wildcard.  */
   879           range[i].from = range_from;
   880           range[i].to = range_to;
   881           range[i].mask = range_mask;
   882         }
   883       else
   884         {
   885           /* The triplet FROM, TO, and MASK is a value-based
   886              restriction for FIELD[I].  */
   887           int from, to;
   888           unsigned mask;
   889 
   890           if (FIXNUMP (val))
   891             {
   892               EMACS_INT numeric = XFIXNUM (val);
   893 
   894               if (i + 1 == n)
   895                 from = to = XLFD_ENCODING_INDEX,
   896                   mask = XLFD_ENCODING_MASK;
   897               else if (numeric == 0)
   898                 from = XLFD_PIXEL_INDEX, to = XLFD_AVGWIDTH_INDEX,
   899                   mask = XLFD_PIXEL_MASK | XLFD_LARGENUM_MASK;
   900               else if (numeric <= 48)
   901                 from = to = XLFD_PIXEL_INDEX,
   902                   mask = XLFD_PIXEL_MASK;
   903               else
   904                 from = XLFD_POINT_INDEX, to = XLFD_AVGWIDTH_INDEX,
   905                   mask = XLFD_LARGENUM_MASK;
   906             }
   907           else if (SBYTES (SYMBOL_NAME (val)) == 0)
   908             from = XLFD_FOUNDRY_INDEX, to = XLFD_ADSTYLE_INDEX,
   909               mask = XLFD_NULL_MASK;
   910           else if (i == 0)
   911             from = to = XLFD_FOUNDRY_INDEX, mask = XLFD_FOUNDRY_MASK;
   912           else if (i + 1 == n)
   913             {
   914               Lisp_Object name = SYMBOL_NAME (val);
   915 
   916               if (SDATA (name)[SBYTES (name) - 1] == '*')
   917                 from = XLFD_REGISTRY_INDEX, to = XLFD_ENCODING_INDEX,
   918                   mask = XLFD_REGENC_MASK;
   919               else
   920                 from = to = XLFD_ENCODING_INDEX,
   921                   mask = XLFD_ENCODING_MASK;
   922             }
   923           else if (range_from <= XLFD_WEIGHT_INDEX
   924                    && range_to >= XLFD_WEIGHT_INDEX
   925                    && FONT_WEIGHT_NAME_NUMERIC (val) >= 0)
   926             from = to = XLFD_WEIGHT_INDEX, mask = XLFD_WEIGHT_MASK;
   927           else if (range_from <= XLFD_SLANT_INDEX
   928                    && range_to >= XLFD_SLANT_INDEX
   929                    && FONT_SLANT_NAME_NUMERIC (val) >= 0)
   930             from = to = XLFD_SLANT_INDEX, mask = XLFD_SLANT_MASK;
   931           else if (range_from <= XLFD_SWIDTH_INDEX
   932                    && range_to >= XLFD_SWIDTH_INDEX
   933                    && FONT_WIDTH_NAME_NUMERIC (val) >= 0)
   934             from = to = XLFD_SWIDTH_INDEX, mask = XLFD_SWIDTH_MASK;
   935           else
   936             {
   937               if (EQ (val, Qc) || EQ (val, Qm) || EQ (val, Qp) || EQ (val, Qd))
   938                 from = to = XLFD_SPACING_INDEX, mask = XLFD_SPACING_MASK;
   939               else
   940                 from = XLFD_FOUNDRY_INDEX, to = XLFD_ENCODING_INDEX,
   941                   mask = XLFD_SYMBOL_MASK;
   942             }
   943 
   944           /* Merge position-based and value-based restrictions.  */
   945           mask &= range_mask;
   946           while (from < range_from)
   947             mask &= ~(1 << from++);
   948           while (from < 14 && ! (mask & (1 << from)))
   949             from++;
   950           while (to > range_to)
   951             mask &= ~(1 << to--);
   952           while (to >= 0 && ! (mask & (1 << to)))
   953             to--;
   954           if (from > to)
   955             return -1;
   956           range[i].from = from;
   957           range[i].to = to;
   958           range[i].mask = mask;
   959 
   960           if (from > range_from || to < range_to)
   961             {
   962               /* The range is narrowed by value-based restrictions.
   963                  Reflect it to the other fields.  */
   964 
   965               /* Following fields should be after FROM.  */
   966               range_from = from;
   967               /* Preceding fields should be before TO.  */
   968               for (j = i - 1, from--, to--; j >= 0; j--, from--, to--)
   969                 {
   970                   /* Check FROM for non-wildcard field.  */
   971                   if (! NILP (tmp[j]) && range[j].from < from)
   972                     {
   973                       while (range[j].from < from)
   974                         range[j].mask &= ~(1 << range[j].from++);
   975                       while (from < 14 && ! (range[j].mask & (1 << from)))
   976                         from++;
   977                       range[j].from = from;
   978                     }
   979                   else
   980                     from = range[j].from;
   981                   if (range[j].to > to)
   982                     {
   983                       while (range[j].to > to)
   984                         range[j].mask &= ~(1 << range[j].to--);
   985                       while (to >= 0 && ! (range[j].mask & (1 << to)))
   986                         to--;
   987                       range[j].to = to;
   988                     }
   989                   else
   990                     to = range[j].to;
   991                   if (from > to)
   992                     return -1;
   993                 }
   994             }
   995         }
   996     }
   997 
   998   /* Decide all fields from restrictions in RANGE.  */
   999   for (i = j = 0; i < n ; i++)
  1000     {
  1001       if (j < range[i].from)
  1002         {
  1003           if (i == 0 || ! NILP (tmp[i - 1]))
  1004             /* None of TMP[X] corresponds to Jth field.  */
  1005             return -1;
  1006           memclear (field + j, (range[i].from - j) * word_size);
  1007           j = range[i].from;
  1008         }
  1009       field[j++] = tmp[i];
  1010     }
  1011   if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX)
  1012     return -1;
  1013   memclear (field + j, (XLFD_LAST_INDEX - j) * word_size);
  1014   if (FIXNUMP (field[XLFD_ENCODING_INDEX]))
  1015     field[XLFD_ENCODING_INDEX]
  1016       = Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil);
  1017   return 0;
  1018 }
  1019 
  1020 
  1021 /* Parse NAME (null terminated) as XLFD and store information in FONT
  1022    (font-spec or font-entity).  Size property of FONT is set as
  1023    follows:
  1024         specified XLFD fields           FONT property
  1025         ---------------------           -------------
  1026         PIXEL_SIZE                      PIXEL_SIZE (Lisp integer)
  1027         POINT_SIZE and RESY             calculated pixel size (Lisp integer)
  1028         POINT_SIZE                      POINT_SIZE/10 (Lisp float)
  1029 
  1030    If NAME is successfully parsed, return 0.  Otherwise return -1.
  1031 
  1032    FONT is usually a font-spec, but when this function is called from
  1033    X font backend driver, it is a font-entity.  In that case, NAME is
  1034    a fully specified XLFD.  */
  1035 
  1036 static int
  1037 font_parse_xlfd_1 (char *name, ptrdiff_t len, Lisp_Object font, int segments)
  1038 {
  1039   int i, j, n;
  1040   char *f[XLFD_LAST_INDEX + 1];
  1041   Lisp_Object val;
  1042   char *p;
  1043 
  1044   if (len > 255 || !len)
  1045     /* Maximum XLFD name length is 255. */
  1046     return -1;
  1047 
  1048   /* Accept "*-.." as a fully specified XLFD. */
  1049   if (name[0] == '*' && (len == 1 || name[1] == '-'))
  1050     i = 1, f[XLFD_FOUNDRY_INDEX] = name;
  1051   else
  1052     i = 0;
  1053 
  1054   /* Split into segments. */
  1055   for (p = name + i; *p; p++)
  1056     if (*p == '-')
  1057       {
  1058         /* If we have too many segments, then gather them up into the
  1059            FAMILY part of the name.  This allows using fonts with
  1060            dashes in the FAMILY bit. */
  1061         if (segments > XLFD_LAST_INDEX && i == XLFD_WEIGHT_INDEX)
  1062           segments--;
  1063         else {
  1064           f[i++] = p + 1;
  1065           if (i == XLFD_LAST_INDEX)
  1066             break;
  1067         }
  1068       }
  1069   f[i] = name + len;
  1070 
  1071 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
  1072 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
  1073 
  1074   if (i == XLFD_LAST_INDEX)
  1075     {
  1076       /* Fully specified XLFD.  */
  1077       int pixel_size;
  1078 
  1079       ASET (font, FONT_FOUNDRY_INDEX, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX));
  1080       ASET (font, FONT_FAMILY_INDEX, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX));
  1081       for (i = XLFD_WEIGHT_INDEX, j = FONT_WEIGHT_INDEX;
  1082            i <= XLFD_SWIDTH_INDEX; i++, j++)
  1083         {
  1084           val = INTERN_FIELD_SYM (i);
  1085           if (! NILP (val))
  1086             {
  1087               if ((n = font_style_to_value (j, INTERN_FIELD_SYM (i), 0)) < 0)
  1088                 return -1;
  1089               ASET (font, j, make_fixnum (n));
  1090             }
  1091         }
  1092       ASET (font, FONT_ADSTYLE_INDEX, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX));
  1093       if (strcmp (f[XLFD_REGISTRY_INDEX], "*-*") == 0)
  1094         ASET (font, FONT_REGISTRY_INDEX, Qnil);
  1095       else
  1096         ASET (font, FONT_REGISTRY_INDEX,
  1097               font_intern_prop (f[XLFD_REGISTRY_INDEX],
  1098                                 f[XLFD_LAST_INDEX] - f[XLFD_REGISTRY_INDEX],
  1099                                 1));
  1100       p = f[XLFD_PIXEL_INDEX];
  1101       if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0)
  1102         ASET (font, FONT_SIZE_INDEX, make_fixnum (pixel_size));
  1103       else
  1104         {
  1105           val = INTERN_FIELD (XLFD_PIXEL_INDEX);
  1106           if (FIXNUMP (val))
  1107             ASET (font, FONT_SIZE_INDEX, val);
  1108           else if (FONT_ENTITY_P (font))
  1109             return -1;
  1110           else
  1111             {
  1112               double point_size = -1;
  1113 
  1114               eassert (FONT_SPEC_P (font));
  1115               p = f[XLFD_POINT_INDEX];
  1116               if (*p == '[')
  1117                 point_size = parse_matrix (p);
  1118               else if (c_isdigit (*p))
  1119                 point_size = atoi (p), point_size /= 10;
  1120               if (point_size >= 0)
  1121                 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
  1122             }
  1123         }
  1124 
  1125       val = INTERN_FIELD (XLFD_RESY_INDEX);
  1126       if (! NILP (val) && ! FIXNUMP (val))
  1127         return -1;
  1128       ASET (font, FONT_DPI_INDEX, val);
  1129       val = INTERN_FIELD (XLFD_SPACING_INDEX);
  1130       if (! NILP (val))
  1131         {
  1132           val = font_prop_validate_spacing (QCspacing, val);
  1133           if (! FIXNUMP (val))
  1134             return -1;
  1135           ASET (font, FONT_SPACING_INDEX, val);
  1136         }
  1137       p = f[XLFD_AVGWIDTH_INDEX];
  1138       if (*p == '~')
  1139         p++;
  1140       val = font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0);
  1141       if (! NILP (val) && ! FIXNUMP (val))
  1142         return -1;
  1143       ASET (font, FONT_AVGWIDTH_INDEX, val);
  1144     }
  1145   else
  1146     {
  1147       bool wild_card_found = 0;
  1148       Lisp_Object prop[XLFD_LAST_INDEX];
  1149 
  1150       if (FONT_ENTITY_P (font))
  1151         return -1;
  1152       for (j = 0; j < i; j++)
  1153         {
  1154           if (*f[j] == '*')
  1155             {
  1156               if (f[j][1] && f[j][1] != '-')
  1157                 return -1;
  1158               prop[j] = Qnil;
  1159               wild_card_found = 1;
  1160             }
  1161           else if (j + 1 < i)
  1162             prop[j] = INTERN_FIELD (j);
  1163           else
  1164             prop[j] = font_intern_prop (f[j], f[i] - f[j], 0);
  1165         }
  1166       if (! wild_card_found)
  1167         return -1;
  1168       if (font_expand_wildcards (prop, i) < 0)
  1169         return -1;
  1170 
  1171       ASET (font, FONT_FOUNDRY_INDEX, prop[XLFD_FOUNDRY_INDEX]);
  1172       ASET (font, FONT_FAMILY_INDEX, prop[XLFD_FAMILY_INDEX]);
  1173       for (i = XLFD_WEIGHT_INDEX, j = FONT_WEIGHT_INDEX;
  1174            i <= XLFD_SWIDTH_INDEX; i++, j++)
  1175         if (! NILP (prop[i]))
  1176           {
  1177             if ((n = font_style_to_value (j, prop[i], 1)) < 0)
  1178               return -1;
  1179             ASET (font, j, make_fixnum (n));
  1180           }
  1181       ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]);
  1182       val = prop[XLFD_REGISTRY_INDEX];
  1183       if (NILP (val))
  1184         {
  1185           val = prop[XLFD_ENCODING_INDEX];
  1186           if (! NILP (val))
  1187             {
  1188               AUTO_STRING (star_dash, "*-");
  1189               val = concat2 (star_dash, SYMBOL_NAME (val));
  1190             }
  1191         }
  1192       else if (NILP (prop[XLFD_ENCODING_INDEX]))
  1193         {
  1194           AUTO_STRING (dash_star, "-*");
  1195           val = concat2 (SYMBOL_NAME (val), dash_star);
  1196         }
  1197       else
  1198         {
  1199           AUTO_STRING (dash, "-");
  1200           val = concat3 (SYMBOL_NAME (val), dash,
  1201                          SYMBOL_NAME (prop[XLFD_ENCODING_INDEX]));
  1202         }
  1203       if (! NILP (val))
  1204         ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil));
  1205 
  1206       if (FIXNUMP (prop[XLFD_PIXEL_INDEX]))
  1207         ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]);
  1208       else if (FIXNUMP (prop[XLFD_POINT_INDEX]))
  1209         {
  1210           double point_size = XFIXNUM (prop[XLFD_POINT_INDEX]);
  1211 
  1212           ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
  1213         }
  1214 
  1215       if (FIXNUMP (prop[XLFD_RESX_INDEX]))
  1216         ASET (font, FONT_DPI_INDEX, prop[XLFD_RESY_INDEX]);
  1217       if (! NILP (prop[XLFD_SPACING_INDEX]))
  1218         {
  1219           val = font_prop_validate_spacing (QCspacing,
  1220                                             prop[XLFD_SPACING_INDEX]);
  1221           if (! FIXNUMP (val))
  1222             return -1;
  1223           ASET (font, FONT_SPACING_INDEX, val);
  1224         }
  1225       if (FIXNUMP (prop[XLFD_AVGWIDTH_INDEX]))
  1226         ASET (font, FONT_AVGWIDTH_INDEX, prop[XLFD_AVGWIDTH_INDEX]);
  1227     }
  1228 
  1229   return 0;
  1230 }
  1231 
  1232 int
  1233 font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
  1234 {
  1235   int found = font_parse_xlfd_1 (name, len, font, -1);
  1236   if (found > -1)
  1237     return found;
  1238 
  1239   int segments = 0;
  1240   /* Count how many segments we have. */
  1241   for (char *p = name; *p; p++)
  1242     if (*p == '-')
  1243       segments++;
  1244 
  1245   /* If we have a surplus of segments, then we try to parse again, in
  1246      case there's a font with dashes in the family name. */
  1247   if (segments > XLFD_LAST_INDEX)
  1248     return font_parse_xlfd_1 (name, len, font, segments);
  1249   else
  1250     return -1;
  1251 }
  1252 
  1253 
  1254 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
  1255    length), and return the name length.  If FONT_SIZE_INDEX of FONT is
  1256    0, use PIXEL_SIZE instead.  */
  1257 
  1258 ptrdiff_t
  1259 font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
  1260 {
  1261   char *p;
  1262   const char *f[XLFD_REGISTRY_INDEX + 1];
  1263   Lisp_Object val;
  1264   int i, j, len;
  1265 
  1266   eassert (FONTP (font));
  1267 
  1268   for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
  1269        i++, j++)
  1270     {
  1271       if (i == FONT_ADSTYLE_INDEX)
  1272         j = XLFD_ADSTYLE_INDEX;
  1273       else if (i == FONT_REGISTRY_INDEX)
  1274         j = XLFD_REGISTRY_INDEX;
  1275       val = AREF (font, i);
  1276       if (NILP (val))
  1277         {
  1278           if (j == XLFD_REGISTRY_INDEX)
  1279             f[j] = "*-*";
  1280           else
  1281             f[j] = "*";
  1282         }
  1283       else
  1284         {
  1285           if (SYMBOLP (val))
  1286             val = SYMBOL_NAME (val);
  1287           if (j == XLFD_REGISTRY_INDEX
  1288               && ! strchr (SSDATA (val), '-'))
  1289             {
  1290               /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*".  */
  1291               ptrdiff_t alloc = SBYTES (val) + 4;
  1292               if (nbytes <= alloc)
  1293                 return -1;
  1294               f[j] = p = alloca (alloc);
  1295               sprintf (p, "%s%s-*", SDATA (val),
  1296                        &"*"[SDATA (val)[SBYTES (val) - 1] == '*']);
  1297             }
  1298           else
  1299             f[j] = SSDATA (val);
  1300         }
  1301     }
  1302 
  1303   for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX;
  1304        i++, j++)
  1305     {
  1306       val = font_style_symbolic (font, i, 0);
  1307       if (NILP (val))
  1308         f[j] = "*";
  1309       else
  1310         {
  1311           int c, k, l;
  1312           ptrdiff_t alloc;
  1313 
  1314           val = SYMBOL_NAME (val);
  1315           alloc = SBYTES (val) + 1;
  1316           if (nbytes <= alloc)
  1317             return -1;
  1318           f[j] = p = alloca (alloc);
  1319           /* Copy the name while excluding '-', '?', ',', and '"'.  */
  1320           for (k = l = 0; k < alloc; k++)
  1321             {
  1322               c = SREF (val, k);
  1323               if (c != '-' && c != '?' && c != ',' && c != '"')
  1324                 p[l++] = c;
  1325             }
  1326         }
  1327     }
  1328 
  1329   val = AREF (font, FONT_SIZE_INDEX);
  1330   eassert (NUMBERP (val) || NILP (val));
  1331   char font_size_index_buf[sizeof "-*"
  1332                            + max (INT_STRLEN_BOUND (EMACS_INT),
  1333                                   1 + DBL_MAX_10_EXP + 1)];
  1334   if (INTEGERP (val))
  1335     {
  1336       intmax_t v;
  1337       if (! (integer_to_intmax (val, &v) && 0 < v))
  1338         v = pixel_size;
  1339       if (v > 0)
  1340         {
  1341           f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
  1342           sprintf (p, "%"PRIdMAX"-*", v);
  1343         }
  1344       else
  1345         f[XLFD_PIXEL_INDEX] = "*-*";
  1346     }
  1347   else if (FLOATP (val))
  1348     {
  1349       double v = XFLOAT_DATA (val) * 10;
  1350       f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
  1351       sprintf (p, "*-%.0f", v);
  1352     }
  1353   else
  1354     f[XLFD_PIXEL_INDEX] = "*-*";
  1355 
  1356   char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)];
  1357   if (FIXNUMP (AREF (font, FONT_DPI_INDEX)))
  1358     {
  1359       EMACS_INT v = XFIXNUM (AREF (font, FONT_DPI_INDEX));
  1360       f[XLFD_RESX_INDEX] = p = dpi_index_buf;
  1361       sprintf (p, "%"pI"d-%"pI"d", v, v);
  1362     }
  1363   else
  1364     f[XLFD_RESX_INDEX] = "*-*";
  1365 
  1366   if (FIXNUMP (AREF (font, FONT_SPACING_INDEX)))
  1367     {
  1368       EMACS_INT spacing = XFIXNUM (AREF (font, FONT_SPACING_INDEX));
  1369 
  1370       f[XLFD_SPACING_INDEX] = (spacing <= FONT_SPACING_PROPORTIONAL ? "p"
  1371                                : spacing <= FONT_SPACING_DUAL ? "d"
  1372                                : spacing <= FONT_SPACING_MONO ? "m"
  1373                                : "c");
  1374     }
  1375   else
  1376     f[XLFD_SPACING_INDEX] = "*";
  1377 
  1378   char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)];
  1379   if (FIXNUMP (AREF (font,  FONT_AVGWIDTH_INDEX)))
  1380     {
  1381       f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf;
  1382       sprintf (p, "%"pI"d", XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX)));
  1383     }
  1384   else
  1385     f[XLFD_AVGWIDTH_INDEX] = "*";
  1386 
  1387   len = snprintf (name, nbytes, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
  1388                   f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
  1389                   f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
  1390                   f[XLFD_SWIDTH_INDEX], f[XLFD_ADSTYLE_INDEX],
  1391                   f[XLFD_PIXEL_INDEX], f[XLFD_RESX_INDEX],
  1392                   f[XLFD_SPACING_INDEX], f[XLFD_AVGWIDTH_INDEX],
  1393                   f[XLFD_REGISTRY_INDEX]);
  1394   return len < nbytes ? len : -1;
  1395 }
  1396 
  1397 /* Parse NAME (null terminated) and store information in FONT
  1398    (font-spec or font-entity).  NAME is supplied in either the
  1399    Fontconfig or GTK font name format.  If NAME is successfully
  1400    parsed, return 0.  Otherwise return -1.
  1401 
  1402    The fontconfig format is
  1403 
  1404     FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
  1405 
  1406    The GTK format is
  1407 
  1408     FAMILY [PROPS...] [SIZE]
  1409 
  1410    This function tries to guess which format it is.  */
  1411 
  1412 static int
  1413 font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font)
  1414 {
  1415   char *p, *q;
  1416   char *size_beg = NULL, *size_end = NULL;
  1417   char *props_beg = NULL, *family_end = NULL;
  1418 
  1419   if (len == 0)
  1420     return -1;
  1421 
  1422   for (p = name; *p; p++)
  1423     {
  1424       if (*p == '\\' && p[1])
  1425         p++;
  1426       else if (*p == ':')
  1427         {
  1428           props_beg = family_end = p;
  1429           break;
  1430         }
  1431       else if (*p == '-')
  1432         {
  1433           bool decimal = 0, size_found = 1;
  1434           for (q = p + 1; *q && *q != ':'; q++)
  1435             if (! c_isdigit (*q))
  1436               {
  1437                 if (*q != '.' || decimal)
  1438                   {
  1439                     size_found = 0;
  1440                     break;
  1441                   }
  1442                 decimal = 1;
  1443               }
  1444           if (size_found)
  1445             {
  1446               family_end = p;
  1447               size_beg = p + 1;
  1448               size_end = q;
  1449               break;
  1450             }
  1451         }
  1452     }
  1453 
  1454   if (family_end)
  1455     {
  1456       Lisp_Object extra_props = Qnil;
  1457 
  1458       /* A fontconfig name with size and/or property data.  */
  1459       if (family_end > name)
  1460         {
  1461           Lisp_Object family;
  1462           family = font_intern_prop (name, family_end - name, 1);
  1463           ASET (font, FONT_FAMILY_INDEX, family);
  1464         }
  1465       if (size_beg)
  1466         {
  1467           double point_size = strtod (size_beg, &size_end);
  1468           ASET (font, FONT_SIZE_INDEX, make_float (point_size));
  1469           if (*size_end == ':' && size_end[1])
  1470             props_beg = size_end;
  1471         }
  1472       if (props_beg)
  1473         {
  1474           /* Now parse ":KEY=VAL" patterns.  */
  1475           Lisp_Object val;
  1476 
  1477           for (p = props_beg; *p; p = q)
  1478             {
  1479               for (q = p + 1; *q && *q != '=' && *q != ':'; q++);
  1480               if (*q != '=')
  1481                 {
  1482                   /* Must be an enumerated value.  */
  1483                   ptrdiff_t word_len;
  1484                   p = p + 1;
  1485                   word_len = q - p;
  1486                   val = font_intern_prop (p, q - p, 1);
  1487 
  1488 #define PROP_MATCH(STR) (word_len == strlen (STR)               \
  1489                          && memcmp (p, STR, strlen (STR)) == 0)
  1490 
  1491                   if (PROP_MATCH ("thin")
  1492                       || PROP_MATCH ("ultra-light")
  1493                       || PROP_MATCH ("light")
  1494                       || PROP_MATCH ("semi-light")
  1495                       || PROP_MATCH ("book")
  1496                       || PROP_MATCH ("medium")
  1497                       || PROP_MATCH ("normal")
  1498                       || PROP_MATCH ("semibold")
  1499                       || PROP_MATCH ("demibold")
  1500                       || PROP_MATCH ("bold")
  1501                       || PROP_MATCH ("ultra-bold")
  1502                       || PROP_MATCH ("black")
  1503                       || PROP_MATCH ("heavy")
  1504                       || PROP_MATCH ("ultra-heavy"))
  1505                     FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val);
  1506                   else if (PROP_MATCH ("roman")
  1507                            || PROP_MATCH ("italic")
  1508                            || PROP_MATCH ("oblique"))
  1509                     FONT_SET_STYLE (font, FONT_SLANT_INDEX, val);
  1510                   else if (PROP_MATCH ("charcell"))
  1511                     ASET (font, FONT_SPACING_INDEX,
  1512                           make_fixnum (FONT_SPACING_CHARCELL));
  1513                   else if (PROP_MATCH ("mono"))
  1514                     ASET (font, FONT_SPACING_INDEX,
  1515                           make_fixnum (FONT_SPACING_MONO));
  1516                   else if (PROP_MATCH ("proportional"))
  1517                     ASET (font, FONT_SPACING_INDEX,
  1518                           make_fixnum (FONT_SPACING_PROPORTIONAL));
  1519 #undef PROP_MATCH
  1520                 }
  1521               else
  1522                 {
  1523                   /* KEY=VAL pairs  */
  1524                   Lisp_Object key UNINIT;
  1525                   int prop;
  1526 
  1527                   if (q - p == 10 && memcmp (p + 1, "pixelsize", 9) == 0)
  1528                     prop = FONT_SIZE_INDEX;
  1529                   else
  1530                     {
  1531                       key = font_intern_prop (p, q - p, 1);
  1532                       prop = get_font_prop_index (key);
  1533                     }
  1534 
  1535                   p = q + 1;
  1536                   for (q = p; *q && *q != ':'; q++);
  1537                   val = font_intern_prop (p, q - p, 0);
  1538 
  1539                   if (prop >= FONT_FOUNDRY_INDEX
  1540                       && prop < FONT_EXTRA_INDEX)
  1541                     ASET (font, prop, font_prop_validate (prop, Qnil, val));
  1542                   else
  1543                     {
  1544                       extra_props = nconc2 (extra_props,
  1545                                             list1 (Fcons (key, val)));
  1546                     }
  1547                 }
  1548               p = q;
  1549             }
  1550         }
  1551 
  1552       if (! NILP (extra_props))
  1553         {
  1554           struct font_driver_list *driver_list = font_driver_list;
  1555           for ( ; driver_list; driver_list = driver_list->next)
  1556             if (driver_list->driver->filter_properties)
  1557               (*driver_list->driver->filter_properties) (font, extra_props);
  1558         }
  1559 
  1560     }
  1561   else
  1562     {
  1563       /* Either a fontconfig-style name with no size and property
  1564          data, or a GTK-style name.  */
  1565       Lisp_Object weight = Qnil, slant = Qnil;
  1566       Lisp_Object width  = Qnil, size  = Qnil;
  1567       char *word_start;
  1568       ptrdiff_t word_len;
  1569 
  1570       /* Scan backwards from the end, looking for a size.  */
  1571       for (p = name + len - 1; p >= name; p--)
  1572         if (!c_isdigit (*p))
  1573           break;
  1574 
  1575       if ((p < name + len - 1) && ((p + 1 == name) || *p == ' '))
  1576         /* Found a font size.  */
  1577         size = make_float (strtod (p + 1, NULL));
  1578       else
  1579         p = name + len;
  1580 
  1581       /* Now P points to the termination of the string, sans size.
  1582          Scan backwards, looking for font properties.  */
  1583       for (; p > name; p = q)
  1584         {
  1585           for (q = p - 1; q >= name; q--)
  1586             {
  1587               if (q > name && *(q-1) == '\\')
  1588                 --q;   /* Skip quoting backslashes.  */
  1589               else if (*q == ' ')
  1590                 break;
  1591             }
  1592 
  1593           word_start = q + 1;
  1594           word_len = p - word_start;
  1595 
  1596 #define PROP_MATCH(STR)                                         \
  1597           (word_len == strlen (STR)                             \
  1598            && memcmp (word_start, STR, strlen (STR)) == 0)
  1599 #define PROP_SAVE(VAR, STR)                                     \
  1600           (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
  1601 
  1602           if (PROP_MATCH ("Ultra-Light"))
  1603             PROP_SAVE (weight, "ultra-light");
  1604           else if (PROP_MATCH ("Light"))
  1605             PROP_SAVE (weight, "light");
  1606           else if (PROP_MATCH ("Book"))
  1607             PROP_SAVE (weight, "book");
  1608           else if (PROP_MATCH ("Medium"))
  1609             PROP_SAVE (weight, "medium");
  1610           else if (PROP_MATCH ("Semi-Bold"))
  1611             PROP_SAVE (weight, "semi-bold");
  1612           else if (PROP_MATCH ("Bold"))
  1613             PROP_SAVE (weight, "bold");
  1614           else if (PROP_MATCH ("Italic"))
  1615             PROP_SAVE (slant, "italic");
  1616           else if (PROP_MATCH ("Oblique"))
  1617             PROP_SAVE (slant, "oblique");
  1618           else if (PROP_MATCH ("Semi-Condensed"))
  1619             PROP_SAVE (width, "semi-condensed");
  1620           else if (PROP_MATCH ("Condensed"))
  1621             PROP_SAVE (width, "condensed");
  1622           /* An unknown word must be part of the font name.  */
  1623           else
  1624             {
  1625               family_end = p;
  1626               break;
  1627             }
  1628         }
  1629 #undef PROP_MATCH
  1630 #undef PROP_SAVE
  1631 
  1632       if (family_end)
  1633         ASET (font, FONT_FAMILY_INDEX,
  1634               font_intern_prop (name, family_end - name, 1));
  1635       if (!NILP (size))
  1636         ASET (font, FONT_SIZE_INDEX, size);
  1637       if (!NILP (weight))
  1638         FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, weight);
  1639       if (!NILP (slant))
  1640         FONT_SET_STYLE (font, FONT_SLANT_INDEX, slant);
  1641       if (!NILP (width))
  1642         FONT_SET_STYLE (font, FONT_WIDTH_INDEX, width);
  1643     }
  1644 
  1645   return 0;
  1646 }
  1647 
  1648 #if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
  1649 
  1650 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
  1651    NAME (NBYTES length), and return the name length.  If
  1652    FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
  1653    Return a negative value on error.  */
  1654 
  1655 static int
  1656 font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
  1657 {
  1658   Lisp_Object family, foundry;
  1659   Lisp_Object val;
  1660   int point_size;
  1661   int i;
  1662   char *p;
  1663   char *lim;
  1664   Lisp_Object styles[3];
  1665   const char *style_names[3] = { "weight", "slant", "width" };
  1666 
  1667   family = AREF (font, FONT_FAMILY_INDEX);
  1668   if (! NILP (family))
  1669     {
  1670       if (SYMBOLP (family))
  1671         family = SYMBOL_NAME (family);
  1672       else
  1673         family = Qnil;
  1674     }
  1675 
  1676   val = AREF (font, FONT_SIZE_INDEX);
  1677   if (FIXNUMP (val))
  1678     {
  1679       if (XFIXNUM (val) != 0)
  1680         pixel_size = XFIXNUM (val);
  1681       point_size = -1;
  1682     }
  1683   else
  1684     {
  1685       eassert (FLOATP (val));
  1686       pixel_size = -1;
  1687       point_size = (int) XFLOAT_DATA (val);
  1688     }
  1689 
  1690   foundry = AREF (font, FONT_FOUNDRY_INDEX);
  1691   if (! NILP (foundry))
  1692     {
  1693       if (SYMBOLP (foundry))
  1694         foundry = SYMBOL_NAME (foundry);
  1695       else
  1696         foundry = Qnil;
  1697     }
  1698 
  1699   for (i = 0; i < 3; i++)
  1700     styles[i] = font_style_symbolic (font, FONT_WEIGHT_INDEX + i, 0);
  1701 
  1702   p = name;
  1703   lim = name + nbytes;
  1704   if (! NILP (family))
  1705     {
  1706       int len = snprintf (p, lim - p, "%s", SSDATA (family));
  1707       if (! (0 <= len && len < lim - p))
  1708         return -1;
  1709       p += len;
  1710     }
  1711   if (point_size > 0)
  1712     {
  1713       int len = snprintf (p, lim - p, &"-%d"[p == name], point_size);
  1714       if (! (0 <= len && len < lim - p))
  1715         return -1;
  1716       p += len;
  1717     }
  1718   else if (pixel_size > 0)
  1719     {
  1720       int len = snprintf (p, lim - p, ":pixelsize=%d", pixel_size);
  1721       if (! (0 <= len && len < lim - p))
  1722         return -1;
  1723       p += len;
  1724     }
  1725   if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
  1726     {
  1727       int len = snprintf (p, lim - p, ":foundry=%s",
  1728                           SSDATA (SYMBOL_NAME (AREF (font,
  1729                                                      FONT_FOUNDRY_INDEX))));
  1730       if (! (0 <= len && len < lim - p))
  1731         return -1;
  1732       p += len;
  1733     }
  1734   for (i = 0; i < 3; i++)
  1735     if (! NILP (styles[i]))
  1736       {
  1737         int len = snprintf (p, lim - p, ":%s=%s", style_names[i],
  1738                             SSDATA (SYMBOL_NAME (styles[i])));
  1739         if (! (0 <= len && len < lim - p))
  1740           return -1;
  1741         p += len;
  1742       }
  1743 
  1744   if (FIXNUMP (AREF (font, FONT_DPI_INDEX)))
  1745     {
  1746       int len = snprintf (p, lim - p, ":dpi=%"pI"d",
  1747                           XFIXNUM (AREF (font, FONT_DPI_INDEX)));
  1748       if (! (0 <= len && len < lim - p))
  1749         return -1;
  1750       p += len;
  1751     }
  1752 
  1753   if (FIXNUMP (AREF (font, FONT_SPACING_INDEX)))
  1754     {
  1755       int len = snprintf (p, lim - p, ":spacing=%"pI"d",
  1756                           XFIXNUM (AREF (font, FONT_SPACING_INDEX)));
  1757       if (! (0 <= len && len < lim - p))
  1758         return -1;
  1759       p += len;
  1760     }
  1761 
  1762   if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX)))
  1763     {
  1764       int len = snprintf (p, lim - p,
  1765                           (XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX)) == 0
  1766                            ? ":scalable=true"
  1767                            : ":scalable=false"));
  1768       if (! (0 <= len && len < lim - p))
  1769         return -1;
  1770       p += len;
  1771     }
  1772 
  1773   return (p - name);
  1774 }
  1775 
  1776 #endif
  1777 
  1778 /* Parse NAME (null terminated) and store information in FONT
  1779    (font-spec or font-entity).  If NAME is successfully parsed, return
  1780    0.  Otherwise return -1.  */
  1781 
  1782 static int
  1783 font_parse_name (char *name, ptrdiff_t namelen, Lisp_Object font)
  1784 {
  1785   if (name[0] == '-' || strchr (name, '*') || strchr (name, '?'))
  1786     return font_parse_xlfd (name, namelen, font);
  1787   return font_parse_fcname (name, namelen, font);
  1788 }
  1789 
  1790 
  1791 /* Merge FAMILY and REGISTRY into FONT_SPEC.  FAMILY may have the form
  1792    "FAMILY-FOUNDRY".  REGISTRY may not contain charset-encoding
  1793    part.  */
  1794 
  1795 void
  1796 font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Object font_spec)
  1797 {
  1798   ptrdiff_t len;
  1799   char *p0, *p1;
  1800 
  1801   if (! NILP (family)
  1802       && NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
  1803     {
  1804       CHECK_STRING (family);
  1805       len = SBYTES (family);
  1806       p0 = SSDATA (family);
  1807       p1 = strchr (p0, '-');
  1808       if (p1)
  1809         {
  1810           if ((*p0 != '*' && p1 - p0 > 0)
  1811               && NILP (AREF (font_spec, FONT_FOUNDRY_INDEX)))
  1812             Ffont_put (font_spec, QCfoundry, font_intern_prop (p0, p1 - p0, 1));
  1813           p1++;
  1814           len -= p1 - p0;
  1815           Ffont_put (font_spec, QCfamily, font_intern_prop (p1, len, 1));
  1816         }
  1817       else
  1818         ASET (font_spec, FONT_FAMILY_INDEX, Fintern (family, Qnil));
  1819     }
  1820   if (! NILP (registry))
  1821     {
  1822       /* Convert "XXX" and "XXX*" to "XXX*-*".  */
  1823       CHECK_STRING (registry);
  1824       len = SBYTES (registry);
  1825       p0 = SSDATA (registry);
  1826       p1 = strchr (p0, '-');
  1827       if (! p1)
  1828         {
  1829           bool asterisk = len && p0[len - 1] == '*';
  1830           AUTO_STRING_WITH_LEN (extra, &"*-*"[asterisk], 3 - asterisk);
  1831           registry = concat2 (registry, extra);
  1832         }
  1833       registry = Fdowncase (registry);
  1834       ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
  1835     }
  1836 }
  1837 
  1838 
  1839 /* Font sorting.  */
  1840 
  1841 static double
  1842 font_rescale_ratio (Lisp_Object font_entity)
  1843 {
  1844   Lisp_Object tail, elt;
  1845   Lisp_Object name = Qnil;
  1846 
  1847   for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail))
  1848     {
  1849       elt = XCAR (tail);
  1850       if (FLOATP (XCDR (elt)))
  1851         {
  1852           if (STRINGP (XCAR (elt)))
  1853             {
  1854               if (NILP (name))
  1855                 name = Ffont_xlfd_name (font_entity, Qnil);
  1856               if (fast_string_match_ignore_case (XCAR (elt), name) >= 0)
  1857                 return XFLOAT_DATA (XCDR (elt));
  1858             }
  1859           else if (FONT_SPEC_P (XCAR (elt)))
  1860             {
  1861               if (font_match_p (XCAR (elt), font_entity))
  1862                 return XFLOAT_DATA (XCDR (elt));
  1863             }
  1864         }
  1865     }
  1866   return 1.0;
  1867 }
  1868 
  1869 /* We sort fonts by scoring each of them against a specified
  1870    font-spec.  The score value is 32 bit (`unsigned'), and the smaller
  1871    the value is, the closer the font is to the font-spec.
  1872 
  1873    The lowest 2 bits of the score are used for driver type.  The font
  1874    available by the most preferred font driver is 0.
  1875 
  1876    The 4 7-bit fields in the higher 28 bits are used for numeric properties
  1877    WEIGHT, SLANT, WIDTH, and SIZE.  */
  1878 
  1879 /* How many bits to shift to store the difference value of each font
  1880    property in a score.  Note that floats for FONT_TYPE_INDEX and
  1881    FONT_REGISTRY_INDEX are not used.  */
  1882 static int sort_shift_bits[FONT_SIZE_INDEX + 1];
  1883 
  1884 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
  1885    The return value indicates how different ENTITY is compared with
  1886    SPEC_PROP.  */
  1887 
  1888 static unsigned
  1889 font_score (Lisp_Object entity, Lisp_Object *spec_prop)
  1890 {
  1891   unsigned score = 0;
  1892   int i;
  1893 
  1894   /* Score three style numeric fields.  Maximum difference is 127. */
  1895   for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
  1896     if (! NILP (spec_prop[i])
  1897         && ! EQ (AREF (entity, i), spec_prop[i])
  1898         && FIXNUMP (AREF (entity, i)))
  1899       {
  1900         EMACS_INT diff = ((XFIXNUM (AREF (entity, i)) >> 8)
  1901                           - (XFIXNUM (spec_prop[i]) >> 8));
  1902         score |= min (eabs (diff), 127) << sort_shift_bits[i];
  1903       }
  1904 
  1905   /* Score the size.  Maximum difference is 127.  */
  1906   if (! NILP (spec_prop[FONT_SIZE_INDEX])
  1907       && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
  1908     {
  1909       /* We use the higher 6-bit for the actual size difference.  The
  1910          lowest bit is set if the DPI is different.  */
  1911       EMACS_INT diff;
  1912       EMACS_INT pixel_size = XFIXNUM (spec_prop[FONT_SIZE_INDEX]);
  1913       EMACS_INT entity_size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX));
  1914 
  1915       if (CONSP (Vface_font_rescale_alist))
  1916         pixel_size *= font_rescale_ratio (entity);
  1917       if (pixel_size * 2 < entity_size || entity_size * 2 < pixel_size)
  1918         /* This size is wrong by more than a factor 2: reject it!  */
  1919         return 0xFFFFFFFF;
  1920       diff = eabs (pixel_size - entity_size) << 1;
  1921       if (! NILP (spec_prop[FONT_DPI_INDEX])
  1922           && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
  1923         diff |= 1;
  1924       if (! NILP (spec_prop[FONT_AVGWIDTH_INDEX])
  1925           && ! EQ (spec_prop[FONT_AVGWIDTH_INDEX], AREF (entity, FONT_AVGWIDTH_INDEX)))
  1926         diff |= 1;
  1927       score |= min (diff, 127) << sort_shift_bits[FONT_SIZE_INDEX];
  1928     }
  1929 
  1930   return score;
  1931 }
  1932 
  1933 
  1934 /* Concatenate all elements of LIST into one vector.  LIST is a list
  1935    of font-entity vectors.  */
  1936 
  1937 static Lisp_Object
  1938 font_vconcat_entity_vectors (Lisp_Object list)
  1939 {
  1940   ptrdiff_t nargs = list_length (list);
  1941   Lisp_Object *args;
  1942   USE_SAFE_ALLOCA;
  1943   SAFE_ALLOCA_LISP (args, nargs);
  1944 
  1945   for (ptrdiff_t i = 0; i < nargs; i++, list = XCDR (list))
  1946     args[i] = XCAR (list);
  1947   Lisp_Object result = Fvconcat (nargs, args);
  1948   SAFE_FREE ();
  1949   return result;
  1950 }
  1951 
  1952 
  1953 /* The structure for elements being sorted by qsort.  */
  1954 struct font_sort_data
  1955 {
  1956   unsigned score;
  1957   int font_driver_preference;
  1958   Lisp_Object entity;
  1959 };
  1960 
  1961 
  1962 /* The comparison function for qsort.  */
  1963 
  1964 static int
  1965 font_compare (const void *d1, const void *d2)
  1966 {
  1967   const struct font_sort_data *data1 = d1;
  1968   const struct font_sort_data *data2 = d2;
  1969 
  1970   if (data1->score < data2->score)
  1971     return -1;
  1972   else if (data1->score > data2->score)
  1973     return 1;
  1974   return (data1->font_driver_preference - data2->font_driver_preference);
  1975 }
  1976 
  1977 
  1978 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
  1979    If PREFER specifies a point-size, calculate the corresponding
  1980    pixel-size from QCdpi property of PREFER or from the Y-resolution
  1981    of FRAME before sorting.
  1982 
  1983    If BEST-ONLY is nonzero, return the best matching entity (that
  1984    supports the character BEST-ONLY if BEST-ONLY is positive, or any
  1985    if BEST-ONLY is negative).  Otherwise, return the sorted result as
  1986    a single vector of font-entities.
  1987 
  1988    This function does no optimization for the case that the total
  1989    number of elements is 1.  The caller should avoid calling this in
  1990    such a case.  */
  1991 
  1992 static Lisp_Object
  1993 font_sort_entities (Lisp_Object list, Lisp_Object prefer,
  1994                     struct frame *f, int best_only)
  1995 {
  1996   Lisp_Object prefer_prop[FONT_SPEC_MAX];
  1997   int len, maxlen, i;
  1998   struct font_sort_data *data;
  1999   unsigned best_score;
  2000   Lisp_Object best_entity;
  2001   Lisp_Object tail;
  2002   Lisp_Object vec UNINIT;
  2003   USE_SAFE_ALLOCA;
  2004 
  2005   for (i = FONT_WEIGHT_INDEX; i <= FONT_AVGWIDTH_INDEX; i++)
  2006     prefer_prop[i] = AREF (prefer, i);
  2007   if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
  2008     prefer_prop[FONT_SIZE_INDEX]
  2009       = make_fixnum (font_pixel_size (f, prefer));
  2010 
  2011   if (NILP (XCDR (list)))
  2012     {
  2013       /* What we have to take care of is this single vector.  */
  2014       vec = XCAR (list);
  2015       maxlen = ASIZE (vec);
  2016     }
  2017   else if (best_only)
  2018     {
  2019       /* We don't have to perform sort, so there's no need of creating
  2020          a single vector.  But, we must find the length of the longest
  2021          vector.  */
  2022       maxlen = 0;
  2023       for (tail = list; CONSP (tail); tail = XCDR (tail))
  2024         if (maxlen < ASIZE (XCAR (tail)))
  2025           maxlen = ASIZE (XCAR (tail));
  2026     }
  2027   else
  2028     {
  2029       /* We have to create a single vector to sort it.  */
  2030       vec = font_vconcat_entity_vectors (list);
  2031       maxlen = ASIZE (vec);
  2032     }
  2033 
  2034   data = SAFE_ALLOCA (maxlen * sizeof *data);
  2035   best_score = 0xFFFFFFFF;
  2036   best_entity = Qnil;
  2037 
  2038   for (tail = list; CONSP (tail); tail = XCDR (tail))
  2039     {
  2040       int font_driver_preference = 0;
  2041       Lisp_Object current_font_driver;
  2042 
  2043       if (best_only)
  2044         vec = XCAR (tail);
  2045       len = ASIZE (vec);
  2046 
  2047       /* We are sure that the length of VEC > 0.  */
  2048       current_font_driver = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
  2049       /* Score the elements.  */
  2050       for (i = 0; i < len; i++)
  2051         {
  2052           data[i].entity = AREF (vec, i);
  2053           data[i].score
  2054             = ((best_only <= 0 || font_has_char (f, data[i].entity, best_only)
  2055                 > 0)
  2056                ? font_score (data[i].entity, prefer_prop)
  2057                : 0xFFFFFFFF);
  2058           if (best_only && best_score > data[i].score)
  2059             {
  2060               best_score = data[i].score;
  2061               best_entity = data[i].entity;
  2062               if (best_score == 0)
  2063                 break;
  2064             }
  2065           if (! EQ (current_font_driver, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
  2066             {
  2067               current_font_driver = AREF (AREF (vec, i), FONT_TYPE_INDEX);
  2068               font_driver_preference++;
  2069             }
  2070           data[i].font_driver_preference = font_driver_preference;
  2071         }
  2072 
  2073       /* Sort if necessary.  */
  2074       if (! best_only)
  2075         {
  2076           qsort (data, len, sizeof *data, font_compare);
  2077           for (i = 0; i < len; i++)
  2078             ASET (vec, i, data[i].entity);
  2079           break;
  2080         }
  2081       else
  2082         vec = best_entity;
  2083     }
  2084 
  2085   SAFE_FREE ();
  2086 
  2087   FONT_ADD_LOG ("sort-by", prefer, vec);
  2088   return vec;
  2089 }
  2090 
  2091 
  2092 /* API of Font Service Layer.  */
  2093 
  2094 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
  2095    sort_shift_bits.  Finternal_set_font_selection_order calls this
  2096    function with font_sort_order after setting up it.  */
  2097 
  2098 void
  2099 font_update_sort_order (int *order)
  2100 {
  2101   int i, shift_bits;
  2102 
  2103   for (i = 0, shift_bits = 23; i < 4; i++, shift_bits -= 7)
  2104     {
  2105       int xlfd_idx = order[i];
  2106 
  2107       if (xlfd_idx == XLFD_WEIGHT_INDEX)
  2108         sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
  2109       else if (xlfd_idx == XLFD_SLANT_INDEX)
  2110         sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
  2111       else if (xlfd_idx == XLFD_SWIDTH_INDEX)
  2112         sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
  2113       else
  2114         sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
  2115     }
  2116 }
  2117 
  2118 static bool
  2119 font_check_otf_features (Lisp_Object script, Lisp_Object langsys,
  2120                          Lisp_Object features, Lisp_Object table)
  2121 {
  2122   Lisp_Object val;
  2123   bool negative;
  2124 
  2125   table = assq_no_quit (script, table);
  2126   if (NILP (table))
  2127     return 0;
  2128   table = XCDR (table);
  2129   if (! NILP (langsys))
  2130     {
  2131       table = assq_no_quit (langsys, table);
  2132       if (NILP (table))
  2133         return 0;
  2134     }
  2135   else
  2136     {
  2137       val = assq_no_quit (Qnil, table);
  2138       if (NILP (val))
  2139         table = XCAR (table);
  2140       else
  2141         table = val;
  2142     }
  2143   table = XCDR (table);
  2144   for (negative = 0; CONSP (features); features = XCDR (features))
  2145     {
  2146       if (NILP (XCAR (features)))
  2147         {
  2148           negative = 1;
  2149           continue;
  2150         }
  2151       if (NILP (Fmemq (XCAR (features), table)) != negative)
  2152         return 0;
  2153     }
  2154   return 1;
  2155 }
  2156 
  2157 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec).  */
  2158 
  2159 static bool
  2160 font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
  2161 {
  2162   Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
  2163 
  2164   script = XCAR (spec);
  2165   spec = XCDR (spec);
  2166   if (! NILP (spec))
  2167     {
  2168       langsys = XCAR (spec);
  2169       spec = XCDR (spec);
  2170       if (! NILP (spec))
  2171         {
  2172           gsub = XCAR (spec);
  2173           spec = XCDR (spec);
  2174           if (! NILP (spec))
  2175             gpos = XCAR (spec);
  2176         }
  2177     }
  2178 
  2179   if (! NILP (gsub) && ! font_check_otf_features (script, langsys, gsub,
  2180                                                   XCAR (otf_capability)))
  2181     return 0;
  2182   if (! NILP (gpos) && ! font_check_otf_features (script, langsys, gpos,
  2183                                                   XCDR (otf_capability)))
  2184     return 0;
  2185   return 1;
  2186 }
  2187 
  2188 
  2189 
  2190 /* Check if FONT (font-entity or font-object) matches with the font
  2191    specification SPEC.  */
  2192 
  2193 bool
  2194 font_match_p (Lisp_Object spec, Lisp_Object font)
  2195 {
  2196   Lisp_Object prop[FONT_SPEC_MAX], *props;
  2197   Lisp_Object extra, font_extra;
  2198   int i;
  2199 
  2200   for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
  2201     if (! NILP (AREF (spec, i))
  2202         && ! NILP (AREF (font, i))
  2203         && ! EQ (AREF (spec, i), AREF (font, i)))
  2204       return 0;
  2205   props = XFONT_SPEC (spec)->props;
  2206   if (FLOATP (props[FONT_SIZE_INDEX]))
  2207     {
  2208       for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
  2209         prop[i] = AREF (spec, i);
  2210       prop[FONT_SIZE_INDEX]
  2211         = make_fixnum (font_pixel_size (XFRAME (selected_frame), spec));
  2212       props = prop;
  2213     }
  2214 
  2215   if (font_score (font, props) > 0)
  2216     return 0;
  2217   extra = AREF (spec, FONT_EXTRA_INDEX);
  2218   font_extra = AREF (font, FONT_EXTRA_INDEX);
  2219   for (; CONSP (extra); extra = XCDR (extra))
  2220     {
  2221       Lisp_Object key = XCAR (XCAR (extra));
  2222       Lisp_Object val = XCDR (XCAR (extra)), val2;
  2223 
  2224       if (EQ (key, QClang))
  2225         {
  2226           val2 = assq_no_quit (key, font_extra);
  2227           if (NILP (val2))
  2228             return 0;
  2229           val2 = XCDR (val2);
  2230           if (CONSP (val))
  2231             {
  2232               if (! CONSP (val2))
  2233                 return 0;
  2234               while (CONSP (val))
  2235                 if (NILP (Fmemq (val, val2)))
  2236                   return 0;
  2237             }
  2238           else
  2239             if (CONSP (val2)
  2240                 ? NILP (Fmemq (val, XCDR (val2)))
  2241                 : ! EQ (val, val2))
  2242               return 0;
  2243         }
  2244       else if (EQ (key, QCscript))
  2245         {
  2246           val2 = assq_no_quit (val, Vscript_representative_chars);
  2247           if (CONSP (val2))
  2248             {
  2249               val2 = XCDR (val2);
  2250               if (CONSP (val2))
  2251                 {
  2252                   /* All characters in the list must be supported.  */
  2253                   for (; CONSP (val2); val2 = XCDR (val2))
  2254                     {
  2255                       if (! CHARACTERP (XCAR (val2)))
  2256                         continue;
  2257                       if (font_encode_char (font, XFIXNAT (XCAR (val2)))
  2258                           == FONT_INVALID_CODE)
  2259                         return 0;
  2260                     }
  2261                 }
  2262               else if (VECTORP (val2))
  2263                 {
  2264                   /* At most one character in the vector must be supported.  */
  2265                   for (i = 0; i < ASIZE (val2); i++)
  2266                     {
  2267                       if (! CHARACTERP (AREF (val2, i)))
  2268                         continue;
  2269                       if (font_encode_char (font, XFIXNAT (AREF (val2, i)))
  2270                           != FONT_INVALID_CODE)
  2271                         break;
  2272                     }
  2273                   if (i == ASIZE (val2))
  2274                     return 0;
  2275                 }
  2276             }
  2277         }
  2278       else if (EQ (key, QCotf))
  2279         {
  2280           struct font *fontp;
  2281 
  2282           if (! FONT_OBJECT_P (font))
  2283             return 0;
  2284           fontp = XFONT_OBJECT (font);
  2285           if (! fontp->driver->otf_capability)
  2286             return 0;
  2287           val2 = fontp->driver->otf_capability (fontp);
  2288           if (NILP (val2) || ! font_check_otf (val, val2))
  2289             return 0;
  2290         }
  2291     }
  2292 
  2293   return 1;
  2294 }
  2295 
  2296 
  2297 /* Font cache
  2298 
  2299    Each font backend has the callback function get_cache, and it
  2300    returns a cons cell of which cdr part can be freely used for
  2301    caching fonts.  The cons cell may be shared by multiple frames
  2302    and/or multiple font drivers.  So, we arrange the cdr part as this:
  2303 
  2304         ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
  2305 
  2306    where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
  2307    is a number frames sharing this cache, and FONT-CACHE-DATA is a
  2308    cons (FONT-SPEC . [FONT-ENTITY ...]).  */
  2309 
  2310 static void font_clear_cache (struct frame *, Lisp_Object,
  2311                               struct font_driver const *);
  2312 
  2313 static void
  2314 font_prepare_cache (struct frame *f, struct font_driver const *driver)
  2315 {
  2316   Lisp_Object cache, val;
  2317 
  2318   cache = driver->get_cache (f);
  2319   val = XCDR (cache);
  2320   while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
  2321     val = XCDR (val);
  2322   if (NILP (val))
  2323     {
  2324       val = list2 (driver->type, make_fixnum (1));
  2325       XSETCDR (cache, Fcons (val, XCDR (cache)));
  2326     }
  2327   else
  2328     {
  2329       val = XCDR (XCAR (val));
  2330       XSETCAR (val, make_fixnum (XFIXNUM (XCAR (val)) + 1));
  2331     }
  2332 }
  2333 
  2334 
  2335 static void
  2336 font_finish_cache (struct frame *f, struct font_driver const *driver)
  2337 {
  2338   Lisp_Object cache, val, tmp;
  2339 
  2340 
  2341   cache = driver->get_cache (f);
  2342   val = XCDR (cache);
  2343   while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
  2344     cache = val, val = XCDR (val);
  2345   eassert (! NILP (val));
  2346   tmp = XCDR (XCAR (val));
  2347   XSETCAR (tmp, make_fixnum (XFIXNUM (XCAR (tmp)) - 1));
  2348   if (XFIXNUM (XCAR (tmp)) == 0)
  2349     {
  2350       font_clear_cache (f, XCAR (val), driver);
  2351       XSETCDR (cache, XCDR (val));
  2352     }
  2353 }
  2354 
  2355 
  2356 static Lisp_Object
  2357 font_get_cache (struct frame *f, struct font_driver const *driver)
  2358 {
  2359   Lisp_Object val = driver->get_cache (f);
  2360   Lisp_Object type = driver->type;
  2361 
  2362   eassert (CONSP (val));
  2363   for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
  2364   eassert (CONSP (val));
  2365   /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
  2366   val = XCDR (XCAR (val));
  2367   return val;
  2368 }
  2369 
  2370 
  2371 static void
  2372 font_clear_cache (struct frame *f, Lisp_Object cache,
  2373                   struct font_driver const *driver)
  2374 {
  2375   Lisp_Object tail, elt;
  2376   Lisp_Object entity;
  2377   ptrdiff_t i;
  2378 
  2379   /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
  2380   for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
  2381     {
  2382       elt = XCAR (tail);
  2383       /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
  2384       if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
  2385         {
  2386           elt = XCDR (elt);
  2387           eassert (VECTORP (elt));
  2388           for (i = 0; i < ASIZE (elt); i++)
  2389             {
  2390               entity = AREF (elt, i);
  2391 
  2392               if (FONT_ENTITY_P (entity)
  2393                   && EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
  2394                 {
  2395                   Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
  2396 
  2397                   for (; CONSP (objlist); objlist = XCDR (objlist))
  2398                     {
  2399                       Lisp_Object val = XCAR (objlist);
  2400                       struct font *font = XFONT_OBJECT (val);
  2401 
  2402                       if (! NILP (AREF (val, FONT_TYPE_INDEX)))
  2403                         {
  2404                           eassert (font && driver == font->driver);
  2405                           /* We are going to close the font, so make
  2406                              sure we don't have any lgstrings lying
  2407                              around in lgstring cache that reference
  2408                              the font.  */
  2409                           composition_gstring_cache_clear_font (val);
  2410                           driver->close_font (font);
  2411                         }
  2412                     }
  2413                   if (driver->free_entity)
  2414                     driver->free_entity (entity);
  2415                 }
  2416             }
  2417         }
  2418     }
  2419   XSETCDR (cache, Qnil);
  2420 }
  2421 
  2422 
  2423 /* Check whether NAME should be ignored based on Vface_ignored_fonts.
  2424    This is reused by xg_font_filter to apply the same checks to the
  2425    GTK font chooser.  */
  2426 
  2427 bool
  2428 font_is_ignored (const char *name, ptrdiff_t namelen)
  2429 {
  2430   Lisp_Object tail = Vface_ignored_fonts;
  2431   Lisp_Object regexp;
  2432 
  2433   FOR_EACH_TAIL_SAFE (tail)
  2434     {
  2435       regexp = XCAR (tail);
  2436       if (STRINGP (regexp)
  2437           && fast_c_string_match_ignore_case (regexp, name,
  2438                                               namelen) >= 0)
  2439         return true;
  2440     }
  2441   return false;
  2442 }
  2443 static Lisp_Object scratch_font_spec, scratch_font_prefer;
  2444 
  2445 /* Check each font-entity in VEC, and return a list of font-entities
  2446    that satisfy these conditions:
  2447      (1) matches with SPEC and SIZE if SPEC is not nil, and
  2448      (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
  2449 */
  2450 
  2451 static Lisp_Object
  2452 font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size)
  2453 {
  2454   Lisp_Object entity, val;
  2455   enum font_property_index prop;
  2456   ptrdiff_t i;
  2457 
  2458   for (val = Qnil, i = ASIZE (vec) - 1; i >= 0; i--)
  2459     {
  2460       entity = AREF (vec, i);
  2461       if (! NILP (Vface_ignored_fonts))
  2462         {
  2463           char name[256];
  2464           ptrdiff_t namelen;
  2465           namelen = font_unparse_xlfd (entity, 0, name, 256);
  2466           if (namelen >= 0)
  2467             if (font_is_ignored (name, namelen))
  2468                 continue;
  2469         }
  2470       if (NILP (spec))
  2471         {
  2472           val = Fcons (entity, val);
  2473           continue;
  2474         }
  2475       for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
  2476         {
  2477           if (FIXNUMP (AREF (spec, prop)))
  2478             {
  2479               if (!FIXNUMP (AREF (entity, prop)))
  2480                 prop = FONT_SPEC_MAX;
  2481               else
  2482                 {
  2483                   int required = XFIXNUM (AREF (spec, prop)) >> 8;
  2484                   int candidate = XFIXNUM (AREF (entity, prop)) >> 8;
  2485 
  2486                   if (candidate != required
  2487 #ifdef HAVE_NTGUI
  2488                       /* A kludge for w32 font search, where listing a
  2489                          family returns only 4 standard weights: regular,
  2490                          italic, bold, bold-italic.  For other values one
  2491                          must specify the font, not just the family in the
  2492                          :family attribute of the face.  But specifying
  2493                          :family in the face attributes looks for regular
  2494                          weight, so if we require exact match, the
  2495                          non-regular font will be rejected.  So we relax
  2496                          the accuracy of the match here, and let
  2497                          font_sort_entities find the best match.  */
  2498                       && (prop != FONT_WEIGHT_INDEX
  2499                           || eabs (candidate - required) > 100)
  2500 #endif
  2501                       )
  2502                     prop = FONT_SPEC_MAX;
  2503                 }
  2504             }
  2505         }
  2506       if (prop < FONT_SPEC_MAX
  2507           && size
  2508           && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
  2509         {
  2510           int diff = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) - size;
  2511 
  2512           if (eabs (diff) > FONT_PIXEL_SIZE_QUANTUM)
  2513             prop = FONT_SPEC_MAX;
  2514         }
  2515       if (prop < FONT_SPEC_MAX
  2516           && FIXNUMP (AREF (spec, FONT_DPI_INDEX))
  2517           && FIXNUMP (AREF (entity, FONT_DPI_INDEX))
  2518           && XFIXNUM (AREF (entity, FONT_DPI_INDEX)) != 0
  2519           && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
  2520         prop = FONT_SPEC_MAX;
  2521       if (prop < FONT_SPEC_MAX
  2522           && FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX))
  2523           && FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX))
  2524           && XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0
  2525           && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
  2526                    AREF (entity, FONT_AVGWIDTH_INDEX)))
  2527         prop = FONT_SPEC_MAX;
  2528       if (prop < FONT_SPEC_MAX)
  2529         val = Fcons (entity, val);
  2530     }
  2531   return (Fvconcat (1, &val));
  2532 }
  2533 
  2534 
  2535 /* Return a list of vectors of font-entities matching with SPEC on
  2536    FRAME.  Each elements in the list is a vector of entities from the
  2537    same font-driver.  */
  2538 
  2539 Lisp_Object
  2540 font_list_entities (struct frame *f, Lisp_Object spec)
  2541 {
  2542   struct font_driver_list *driver_list = f->font_driver_list;
  2543   Lisp_Object ftype, val;
  2544   Lisp_Object list = Qnil;
  2545   int size;
  2546   bool need_filtering = 0;
  2547   int i;
  2548 
  2549   eassert (FONT_SPEC_P (spec));
  2550 
  2551   if (FIXNUMP (AREF (spec, FONT_SIZE_INDEX)))
  2552     size = XFIXNUM (AREF (spec, FONT_SIZE_INDEX));
  2553   else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
  2554     size = font_pixel_size (f, spec);
  2555   else
  2556     size = 0;
  2557 
  2558   ftype = AREF (spec, FONT_TYPE_INDEX);
  2559   for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
  2560     ASET (scratch_font_spec, i, AREF (spec, i));
  2561   for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
  2562     if (i != FONT_SPACING_INDEX)
  2563       {
  2564         ASET (scratch_font_spec, i, Qnil);
  2565         if (! NILP (AREF (spec, i)))
  2566           need_filtering = 1;
  2567       }
  2568   ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
  2569   ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
  2570 
  2571   for (; driver_list; driver_list = driver_list->next)
  2572     if (driver_list->on
  2573         && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
  2574       {
  2575         Lisp_Object cache = font_get_cache (f, driver_list->driver);
  2576 
  2577         ASET (scratch_font_spec, FONT_TYPE_INDEX, driver_list->driver->type);
  2578         val = assoc_no_quit (scratch_font_spec, XCDR (cache));
  2579         if (CONSP (val))
  2580           val = XCDR (val);
  2581         else
  2582           {
  2583             Lisp_Object copy;
  2584 
  2585             val = (driver_list->driver->list) (f, scratch_font_spec);
  2586             /* We put zero_vector in the font-cache to indicate that
  2587                no fonts matching SPEC were found on the system.
  2588                Failure to have this indication in the font cache can
  2589                cause severe performance degradation in some rare
  2590                cases, see bug#21028.  */
  2591             if (NILP (val))
  2592               val = zero_vector;
  2593             else
  2594               val = Fvconcat (1, &val);
  2595             copy = copy_font_spec (scratch_font_spec);
  2596             ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
  2597             XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
  2598           }
  2599         if (ASIZE (val) > 0
  2600             && (need_filtering
  2601                 || ! NILP (Vface_ignored_fonts)))
  2602           val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size);
  2603         if (ASIZE (val) > 0)
  2604           {
  2605             list = Fcons (val, list);
  2606             /* Querying further backends can be very slow, so we only do
  2607                it if the user has explicitly requested it (Bug#43177).  */
  2608             if (query_all_font_backends == false)
  2609               break;
  2610           }
  2611       }
  2612 
  2613   list = Fnreverse (list);
  2614   FONT_ADD_LOG ("list", spec, list);
  2615   return list;
  2616 }
  2617 
  2618 
  2619 /* Return a font entity matching with SPEC on FRAME.  ATTRS, if non
  2620    nil, is an array of face's attributes, which specifies preferred
  2621    font-related attributes.  */
  2622 
  2623 static Lisp_Object
  2624 font_matching_entity (struct frame *f, Lisp_Object *attrs, Lisp_Object spec)
  2625 {
  2626   struct font_driver_list *driver_list = f->font_driver_list;
  2627   Lisp_Object ftype, size, entity;
  2628   Lisp_Object work = copy_font_spec (spec);
  2629 
  2630   ftype = AREF (spec, FONT_TYPE_INDEX);
  2631   size = AREF (spec, FONT_SIZE_INDEX);
  2632 
  2633   if (FLOATP (size))
  2634     ASET (work, FONT_SIZE_INDEX, make_fixnum (font_pixel_size (f, spec)));
  2635   FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
  2636   FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
  2637   FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
  2638 
  2639   entity = Qnil;
  2640   for (; driver_list; driver_list = driver_list->next)
  2641     if (driver_list->on
  2642         && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
  2643       {
  2644         Lisp_Object cache = font_get_cache (f, driver_list->driver);
  2645 
  2646         ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
  2647         entity = assoc_no_quit (work, XCDR (cache));
  2648         if (CONSP (entity))
  2649           entity = AREF (XCDR (entity), 0);
  2650         else
  2651           {
  2652             entity = driver_list->driver->match (f, work);
  2653             if (!NILP (entity))
  2654               {
  2655                 Lisp_Object copy = copy_font_spec (work);
  2656                 Lisp_Object match = Fvector (1, &entity);
  2657 
  2658                 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
  2659                 XSETCDR (cache, Fcons (Fcons (copy, match), XCDR (cache)));
  2660               }
  2661           }
  2662         if (! NILP (entity))
  2663           break;
  2664       }
  2665   FONT_ADD_LOG ("match", work, entity);
  2666   return entity;
  2667 }
  2668 
  2669 
  2670 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
  2671    opened font object.  */
  2672 
  2673 static Lisp_Object
  2674 font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size)
  2675 {
  2676   struct font_driver_list *driver_list;
  2677   Lisp_Object objlist, size, val, font_object;
  2678   struct font *font;
  2679   int height, psize;
  2680 
  2681   eassert (FONT_ENTITY_P (entity));
  2682   size = AREF (entity, FONT_SIZE_INDEX);
  2683   if (XFIXNUM (size) != 0)
  2684     pixel_size = XFIXNUM (size);
  2685 
  2686   val = AREF (entity, FONT_TYPE_INDEX);
  2687   for (driver_list = f->font_driver_list;
  2688        driver_list && ! EQ (driver_list->driver->type, val);
  2689        driver_list = driver_list->next);
  2690   if (! driver_list)
  2691     return Qnil;
  2692 
  2693   for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
  2694        objlist = XCDR (objlist))
  2695     {
  2696       Lisp_Object fn = XCAR (objlist);
  2697       if (! NILP (AREF (fn, FONT_TYPE_INDEX))
  2698           && XFONT_OBJECT (fn)->pixel_size == pixel_size)
  2699         {
  2700           if (driver_list->driver->cached_font_ok == NULL
  2701               || driver_list->driver->cached_font_ok (f, fn, entity))
  2702             return fn;
  2703         }
  2704     }
  2705 
  2706   /* We always open a font of manageable size; i.e non-zero average
  2707      width and height.  */
  2708   for (psize = pixel_size; ; psize++)
  2709     {
  2710       font_object = driver_list->driver->open_font (f, entity, psize);
  2711       if (NILP (font_object))
  2712         return Qnil;
  2713       font = XFONT_OBJECT (font_object);
  2714       if (font->average_width > 0 && font->height > 0)
  2715         break;
  2716       /* Avoid an infinite loop.  */
  2717       if (psize > pixel_size + 15)
  2718         return Qnil;
  2719     }
  2720   ASET (font_object, FONT_SIZE_INDEX, make_fixnum (pixel_size));
  2721   FONT_ADD_LOG ("open", entity, font_object);
  2722   ASET (entity, FONT_OBJLIST_INDEX,
  2723         Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
  2724 
  2725   font = XFONT_OBJECT (font_object);
  2726 #ifdef HAVE_WINDOW_SYSTEM
  2727   int min_width = (font->min_width ? font->min_width
  2728                    : font->average_width ? font->average_width
  2729                    : font->space_width ? font->space_width
  2730                    : 1);
  2731 #endif
  2732 
  2733   int font_ascent, font_descent;
  2734   get_font_ascent_descent (font, &font_ascent, &font_descent);
  2735   height = font_ascent + font_descent;
  2736   if (height <= 0)
  2737     height = 1;
  2738 #ifdef HAVE_WINDOW_SYSTEM
  2739   FRAME_DISPLAY_INFO (f)->n_fonts++;
  2740   if (FRAME_DISPLAY_INFO (f)->n_fonts == 1)
  2741     {
  2742       FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
  2743       FRAME_SMALLEST_FONT_HEIGHT (f) = height;
  2744       f->fonts_changed = 1;
  2745     }
  2746   else
  2747     {
  2748       if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
  2749         FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, f->fonts_changed = 1;
  2750       if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
  2751         FRAME_SMALLEST_FONT_HEIGHT (f) = height, f->fonts_changed = 1;
  2752     }
  2753 #endif
  2754 
  2755   return font_object;
  2756 }
  2757 
  2758 
  2759 /* Close FONT_OBJECT that is opened on frame F.  */
  2760 
  2761 static void
  2762 font_close_object (struct frame *f, Lisp_Object font_object)
  2763 {
  2764   struct font *font = XFONT_OBJECT (font_object);
  2765 
  2766   if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
  2767     /* Already closed.  */
  2768     return;
  2769   FONT_ADD_LOG ("close", font_object, Qnil);
  2770   font->driver->close_font (font);
  2771 #ifdef HAVE_WINDOW_SYSTEM
  2772   eassert (FRAME_DISPLAY_INFO (f)->n_fonts);
  2773   FRAME_DISPLAY_INFO (f)->n_fonts--;
  2774 #endif
  2775 }
  2776 
  2777 
  2778 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
  2779    FONT is a font-entity and it must be opened to check.  */
  2780 
  2781 int
  2782 font_has_char (struct frame *f, Lisp_Object font, int c)
  2783 {
  2784   struct font *fontp;
  2785 
  2786   if (FONT_ENTITY_P (font))
  2787     {
  2788       Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
  2789       struct font_driver_list *driver_list;
  2790 
  2791       for (driver_list = f->font_driver_list;
  2792            driver_list && ! EQ (driver_list->driver->type, type);
  2793            driver_list = driver_list->next);
  2794       if (! driver_list)
  2795         return 0;
  2796       if (! driver_list->driver->has_char)
  2797         return -1;
  2798       return driver_list->driver->has_char (font, c);
  2799     }
  2800 
  2801   eassert (FONT_OBJECT_P (font));
  2802   fontp = XFONT_OBJECT (font);
  2803   if (fontp->driver->has_char)
  2804     {
  2805       int result = fontp->driver->has_char (font, c);
  2806 
  2807       if (result >= 0)
  2808         return result;
  2809     }
  2810   return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
  2811 }
  2812 
  2813 
  2814 /* Return the glyph ID of FONT_OBJECT for character C.  */
  2815 
  2816 static unsigned
  2817 font_encode_char (Lisp_Object font_object, int c)
  2818 {
  2819   struct font *font;
  2820 
  2821   eassert (FONT_OBJECT_P (font_object));
  2822   font = XFONT_OBJECT (font_object);
  2823   return font->driver->encode_char (font, c);
  2824 }
  2825 
  2826 
  2827 /* Return the name of FONT_OBJECT.  */
  2828 
  2829 Lisp_Object
  2830 font_get_name (Lisp_Object font_object)
  2831 {
  2832   eassert (FONT_OBJECT_P (font_object));
  2833   return AREF (font_object, FONT_NAME_INDEX);
  2834 }
  2835 
  2836 
  2837 /* Create a new font spec from FONT_NAME, and return it.  If FONT_NAME
  2838    could not be parsed by font_parse_name, return Qnil.  */
  2839 
  2840 Lisp_Object
  2841 font_spec_from_name (Lisp_Object font_name)
  2842 {
  2843   Lisp_Object spec = Ffont_spec (0, NULL);
  2844 
  2845   CHECK_STRING (font_name);
  2846   if (font_parse_name (SSDATA (font_name), SBYTES (font_name), spec) == -1)
  2847     return Qnil;
  2848   font_put_extra (spec, QCname, font_name);
  2849   font_put_extra (spec, QCuser_spec, font_name);
  2850   return spec;
  2851 }
  2852 
  2853 
  2854 void
  2855 font_clear_prop (Lisp_Object *attrs, enum font_property_index prop)
  2856 {
  2857   Lisp_Object font = attrs[LFACE_FONT_INDEX];
  2858 
  2859   if (! FONTP (font))
  2860     return;
  2861 
  2862   if (! NILP (Ffont_get (font, QCname)))
  2863     {
  2864       font = copy_font_spec (font);
  2865       font_put_extra (font, QCname, Qunbound);
  2866     }
  2867 
  2868   if (NILP (AREF (font, prop))
  2869       && prop != FONT_FAMILY_INDEX
  2870       && prop != FONT_FOUNDRY_INDEX
  2871       && prop != FONT_WIDTH_INDEX
  2872       && prop != FONT_SIZE_INDEX)
  2873     return;
  2874   if (EQ (font, attrs[LFACE_FONT_INDEX]))
  2875     font = copy_font_spec (font);
  2876   ASET (font, prop, Qnil);
  2877   if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
  2878     {
  2879       if (prop == FONT_FAMILY_INDEX)
  2880         {
  2881           ASET (font, FONT_FOUNDRY_INDEX, Qnil);
  2882           /* If we are setting the font family, we must also clear
  2883              FONT_WIDTH_INDEX to avoid rejecting families that lack
  2884              support for some widths.  */
  2885           ASET (font, FONT_WIDTH_INDEX, Qnil);
  2886         }
  2887       ASET (font, FONT_ADSTYLE_INDEX, Qnil);
  2888       ASET (font, FONT_REGISTRY_INDEX, Qnil);
  2889       ASET (font, FONT_SIZE_INDEX, Qnil);
  2890       ASET (font, FONT_DPI_INDEX, Qnil);
  2891       ASET (font, FONT_SPACING_INDEX, Qnil);
  2892       ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
  2893     }
  2894   else if (prop == FONT_SIZE_INDEX)
  2895     {
  2896       ASET (font, FONT_DPI_INDEX, Qnil);
  2897       ASET (font, FONT_SPACING_INDEX, Qnil);
  2898       ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
  2899     }
  2900   else if (prop == FONT_WIDTH_INDEX)
  2901     ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
  2902   attrs[LFACE_FONT_INDEX] = font;
  2903 }
  2904 
  2905 /* Select a font from ENTITIES (list of one or more font-entity
  2906    vectors) that supports the character C (if non-negative) and is the
  2907    best match for ATTRS and PIXEL_SIZE.  */
  2908 
  2909 static Lisp_Object
  2910 font_select_entity (struct frame *f, Lisp_Object entities,
  2911                     Lisp_Object *attrs, int pixel_size, int c)
  2912 {
  2913   Lisp_Object font_entity;
  2914   Lisp_Object prefer;
  2915   int i;
  2916 
  2917   /* If we have a single candidate, return it if it supports C.  */
  2918   if (NILP (XCDR (entities))
  2919       && ASIZE (XCAR (entities)) == 1)
  2920     {
  2921       font_entity = AREF (XCAR (entities), 0);
  2922       if (c < 0 || font_has_char (f, font_entity, c) > 0)
  2923         return font_entity;
  2924       return Qnil;
  2925     }
  2926 
  2927   /* If we have several candidates, find the best match by sorting
  2928      them by properties specified in ATTRS.  Style attributes (weight,
  2929      slant, width, and size) are taken from the font spec in ATTRS (if
  2930      that is non-nil), or from ATTRS, or left as nil.  */
  2931   prefer = scratch_font_prefer;
  2932 
  2933   for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
  2934     ASET (prefer, i, Qnil);
  2935   if (FONTP (attrs[LFACE_FONT_INDEX]))
  2936     {
  2937       Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
  2938 
  2939       for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
  2940         ASET (prefer, i, AREF (face_font, i));
  2941     }
  2942   if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
  2943     FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
  2944   if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
  2945     FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
  2946   if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
  2947     FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
  2948   ASET (prefer, FONT_SIZE_INDEX, make_fixnum (pixel_size));
  2949 
  2950   return font_sort_entities (entities, prefer, f, c);
  2951 }
  2952 
  2953 /* Return a font-entity that satisfies SPEC and is the best match for
  2954    face's font related attributes in ATTRS.  C, if not negative, is a
  2955    character that the entity must support.  */
  2956 
  2957 Lisp_Object
  2958 font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int c)
  2959 {
  2960   Lisp_Object work;
  2961   Lisp_Object entities, val;
  2962   Lisp_Object foundry[3], *family, registry[3], adstyle[3];
  2963   int pixel_size;
  2964   int i, j, k, l;
  2965   USE_SAFE_ALLOCA;
  2966 
  2967   /* Registry specification alternatives: from the most specific to
  2968      the least specific and finally an unspecified one.  */
  2969   registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
  2970   if (NILP (registry[0]))
  2971     {
  2972       registry[0] = DEFAULT_ENCODING;
  2973       registry[1] = Qascii_0;
  2974       registry[2] = zero_vector;
  2975     }
  2976   else
  2977     registry[1] = zero_vector;
  2978 
  2979   if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
  2980     {
  2981       struct charset *encoding, *repertory;
  2982 
  2983       if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
  2984                                   &encoding, &repertory) < 0)
  2985         return Qnil;
  2986       if (repertory
  2987           && ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
  2988         return Qnil;
  2989       else if (c > encoding->max_char)
  2990         return Qnil;
  2991     }
  2992 
  2993   work = copy_font_spec (spec);
  2994   ASET (work, FONT_TYPE_INDEX, AREF (spec, FONT_TYPE_INDEX));
  2995   pixel_size = font_pixel_size (f, spec);
  2996   if (pixel_size == 0 && FIXNUMP (attrs[LFACE_HEIGHT_INDEX]))
  2997     {
  2998       double pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]);
  2999 
  3000       pixel_size = POINT_TO_PIXEL (pt / 10, FRAME_RES_Y (f));
  3001       if (pixel_size < 1)
  3002         pixel_size = 1;
  3003     }
  3004   ASET (work, FONT_SIZE_INDEX, Qnil);
  3005 
  3006   /* Foundry specification alternatives: from the most specific to the
  3007      least specific and finally an unspecified one.  */
  3008   foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
  3009   if (! NILP (foundry[0]))
  3010     foundry[1] = zero_vector;
  3011   else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
  3012     {
  3013       val = attrs[LFACE_FOUNDRY_INDEX];
  3014       foundry[0] = font_intern_prop (SSDATA (val), SBYTES (val), 1);
  3015       foundry[1] = Qnil;
  3016       foundry[2] = zero_vector;
  3017     }
  3018   else
  3019     foundry[0] = Qnil, foundry[1] = zero_vector;
  3020 
  3021   /* Additional style specification alternatives: from the most
  3022      specific to the least specific and finally an unspecified one.  */
  3023   adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
  3024   if (! NILP (adstyle[0]))
  3025     adstyle[1] = zero_vector;
  3026   else if (FONTP (attrs[LFACE_FONT_INDEX]))
  3027     {
  3028       Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
  3029 
  3030       if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
  3031         {
  3032           adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
  3033           adstyle[1] = Qnil;
  3034           adstyle[2] = zero_vector;
  3035         }
  3036       else
  3037         adstyle[0] = Qnil, adstyle[1] = zero_vector;
  3038     }
  3039   else
  3040     adstyle[0] = Qnil, adstyle[1] = zero_vector;
  3041 
  3042 
  3043   /* Family specification alternatives: from the most specific to
  3044      the least specific and finally an unspecified one.  */
  3045   val = AREF (work, FONT_FAMILY_INDEX);
  3046   if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
  3047     {
  3048       val = attrs[LFACE_FAMILY_INDEX];
  3049       val = font_intern_prop (SSDATA (val), SBYTES (val), 1);
  3050     }
  3051   Lisp_Object familybuf[3];
  3052   if (NILP (val))
  3053     {
  3054       family = familybuf;
  3055       family[0] = Qnil;
  3056       family[1] = zero_vector;  /* terminator.  */
  3057     }
  3058   else
  3059     {
  3060       Lisp_Object alters
  3061         = Fassoc_string (val, Vface_alternative_font_family_alist, Qt);
  3062 
  3063       if (! NILP (alters))
  3064         {
  3065           EMACS_INT alterslen = list_length (alters);
  3066           SAFE_ALLOCA_LISP (family, alterslen + 2);
  3067           for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
  3068             family[i] = XCAR (alters);
  3069           if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
  3070             family[i++] = Qnil;
  3071           family[i] = zero_vector;
  3072         }
  3073       else
  3074         {
  3075           family = familybuf;
  3076           i = 0;
  3077           family[i++] = val;
  3078           if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
  3079             family[i++] = Qnil;
  3080           family[i] = zero_vector;
  3081         }
  3082     }
  3083 
  3084   /* Now look up suitable fonts, from the most specific spec to the
  3085      least specific spec.  Accept the first one that matches.  */
  3086   for (i = 0; SYMBOLP (family[i]); i++)
  3087     {
  3088       ASET (work, FONT_FAMILY_INDEX, family[i]);
  3089       for (j = 0; SYMBOLP (foundry[j]); j++)
  3090         {
  3091           ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
  3092           for (k = 0; SYMBOLP (registry[k]); k++)
  3093             {
  3094               ASET (work, FONT_REGISTRY_INDEX, registry[k]);
  3095               for (l = 0; SYMBOLP (adstyle[l]); l++)
  3096                 {
  3097                   ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
  3098                   /* Produce the list of candidates for the spec in WORK.  */
  3099                   entities = font_list_entities (f, work);
  3100                   if (! NILP (entities))
  3101                     {
  3102                       /* If there are several candidates, select the
  3103                          best match for PIXEL_SIZE and attributes in ATTRS.  */
  3104                       val = font_select_entity (f, entities,
  3105                                                 attrs, pixel_size, c);
  3106                       if (! NILP (val))
  3107                         {
  3108                           SAFE_FREE ();
  3109                           return val;
  3110                         }
  3111                     }
  3112                 }
  3113             }
  3114         }
  3115     }
  3116 
  3117   SAFE_FREE ();
  3118   return Qnil;
  3119 }
  3120 
  3121 
  3122 Lisp_Object
  3123 font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Lisp_Object spec)
  3124 {
  3125   int size;
  3126 
  3127   if (FIXNUMP (AREF (entity, FONT_SIZE_INDEX))
  3128       && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
  3129     size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX));
  3130   else
  3131     {
  3132       if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
  3133         size = font_pixel_size (f, spec);
  3134       else
  3135         {
  3136           double pt;
  3137           if (FIXNUMP (attrs[LFACE_HEIGHT_INDEX]))
  3138             pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]);
  3139           else
  3140             {
  3141               /* We need the default face to be valid below.  */
  3142               if (FRAME_FACE_CACHE (f)->used == 0)
  3143                 recompute_basic_faces (f);
  3144 
  3145               struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  3146               Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX];
  3147               eassert (FIXNUMP (height));
  3148               pt = XFIXNUM (height);
  3149             }
  3150 
  3151           pt /= 10;
  3152           size = POINT_TO_PIXEL (pt, FRAME_RES_Y (f));
  3153 #ifdef HAVE_NS
  3154           if (size == 0)
  3155             {
  3156               Lisp_Object ffsize = get_frame_param (f, Qfontsize);
  3157               size = (NUMBERP (ffsize)
  3158                       ? POINT_TO_PIXEL (XFLOATINT (ffsize), FRAME_RES_Y (f))
  3159                       : 0);
  3160             }
  3161 #endif
  3162         }
  3163       size *= font_rescale_ratio (entity);
  3164     }
  3165 
  3166   return font_open_entity (f, entity, size);
  3167 }
  3168 
  3169 
  3170 /* Find a font that satisfies SPEC and is the best match for
  3171    face's attributes in ATTRS on FRAME, and return the opened
  3172    font-object.  */
  3173 
  3174 Lisp_Object
  3175 font_load_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec)
  3176 {
  3177   Lisp_Object entity, name;
  3178 
  3179   entity = font_find_for_lface (f, attrs, spec, -1);
  3180   if (NILP (entity))
  3181     {
  3182       /* No font is listed for SPEC, but each font-backend may have
  3183          different criteria about "font matching".  So, try it.  */
  3184       entity = font_matching_entity (f, attrs, spec);
  3185       /* Perhaps the user asked for a font "Foobar-123", and we
  3186          interpreted "-123" as the size, whereas it really is part of
  3187          the name.  So we reset the size to nil and the family name to
  3188          the entire "Foobar-123" thing, and try again with that.  */
  3189       if (NILP (entity))
  3190         {
  3191           name = Ffont_get (spec, QCuser_spec);
  3192           if (STRINGP (name))
  3193             {
  3194               char *p = SSDATA (name), *q = strrchr (p, '-');
  3195 
  3196               if (q != NULL && c_isdigit (q[1]))
  3197                 {
  3198                   char *tail;
  3199                   double font_size = strtod (q + 1, &tail);
  3200 
  3201                   if (font_size > 0 && tail != q + 1)
  3202                     {
  3203                       Lisp_Object lsize = Ffont_get (spec, QCsize);
  3204 
  3205                       if ((FLOATP (lsize) && XFLOAT_DATA (lsize) == font_size)
  3206                           || (FIXNUMP (lsize) && XFIXNUM (lsize) == font_size))
  3207                         {
  3208                           ASET (spec, FONT_FAMILY_INDEX,
  3209                                 font_intern_prop (p, tail - p, 1));
  3210                           ASET (spec, FONT_SIZE_INDEX, Qnil);
  3211                           entity = font_matching_entity (f, attrs, spec);
  3212                         }
  3213                     }
  3214                 }
  3215             }
  3216         }
  3217       if (NILP (entity))
  3218         return Qnil;
  3219     }
  3220   /* Don't lose the original name that was put in initially.  We need
  3221      it to re-apply the font when font parameters (like hinting or dpi) have
  3222      changed.  */
  3223   entity = font_open_for_lface (f, entity, attrs, spec);
  3224   if (!NILP (entity))
  3225     {
  3226       name = Ffont_get (spec, QCuser_spec);
  3227       if (STRINGP (name)) font_put_extra (entity, QCuser_spec, name);
  3228     }
  3229   return entity;
  3230 }
  3231 
  3232 
  3233 /* Make FACE on frame F ready to use the font opened for FACE.  */
  3234 
  3235 void
  3236 font_prepare_for_face (struct frame *f, struct face *face)
  3237 {
  3238   if (face->font->driver->prepare_face)
  3239     face->font->driver->prepare_face (f, face);
  3240 }
  3241 
  3242 
  3243 /* Make FACE on frame F stop using the font opened for FACE.  */
  3244 
  3245 void
  3246 font_done_for_face (struct frame *f, struct face *face)
  3247 {
  3248   if (face->font->driver->done_face)
  3249     face->font->driver->done_face (f, face);
  3250 }
  3251 
  3252 
  3253 /* Open a font that is a match for font-spec SPEC on frame F.  If no proper
  3254    font is found, return Qnil.  */
  3255 
  3256 Lisp_Object
  3257 font_open_by_spec (struct frame *f, Lisp_Object spec)
  3258 {
  3259   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  3260 
  3261   /* We set up the default font-related attributes of a face to prefer
  3262      a moderate font.  */
  3263   attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
  3264   attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
  3265     = attrs[LFACE_SLANT_INDEX] = Qnormal;
  3266 #ifndef HAVE_NS
  3267   attrs[LFACE_HEIGHT_INDEX] = make_fixnum (120);
  3268 #else
  3269   attrs[LFACE_HEIGHT_INDEX] = make_fixnum (0);
  3270 #endif
  3271   attrs[LFACE_FONT_INDEX] = Qnil;
  3272 
  3273   return font_load_for_lface (f, attrs, spec);
  3274 }
  3275 
  3276 
  3277 /* Open a font that matches NAME on frame F.  If no proper font is
  3278    found, return Qnil.  */
  3279 
  3280 Lisp_Object
  3281 font_open_by_name (struct frame *f, Lisp_Object name)
  3282 {
  3283   Lisp_Object spec = CALLN (Ffont_spec, QCname, name);
  3284   Lisp_Object ret = font_open_by_spec (f, spec);
  3285   /* Do not lose name originally put in.  */
  3286   if (!NILP (ret))
  3287     font_put_extra (ret, QCuser_spec, name);
  3288 
  3289   return ret;
  3290 }
  3291 
  3292 
  3293 /* Register font-driver DRIVER.  This function is used in two ways.
  3294 
  3295    The first is with frame F non-NULL.  In this case, make DRIVER
  3296    available (but not yet activated) on F.  All frame creators
  3297    (e.g. Fx_create_frame) must call this function at least once with
  3298    an available font-driver.
  3299 
  3300    The second is with frame F NULL.  In this case, DRIVER is globally
  3301    registered in the variable `font_driver_list'.  All font-driver
  3302    implementations must call this function in its
  3303    syms_of_XXXX_for_pdumper (e.g. syms_of_xfont_for_pdumper).  */
  3304 
  3305 void
  3306 register_font_driver (struct font_driver const *driver, struct frame *f)
  3307 {
  3308   struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
  3309   struct font_driver_list *prev, *list;
  3310 
  3311 #ifdef HAVE_WINDOW_SYSTEM
  3312   if (f && ! driver->draw)
  3313     error ("Unusable font driver for a frame: %s",
  3314            SDATA (SYMBOL_NAME (driver->type)));
  3315 #endif /* HAVE_WINDOW_SYSTEM */
  3316 
  3317   for (prev = NULL, list = root; list; prev = list, list = list->next)
  3318     if (EQ (list->driver->type, driver->type))
  3319       error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
  3320 
  3321   list = xmalloc (sizeof *list);
  3322   list->on = 0;
  3323   list->driver = driver;
  3324   list->next = NULL;
  3325   if (prev)
  3326     prev->next = list;
  3327   else if (f)
  3328     f->font_driver_list = list;
  3329   else
  3330     font_driver_list = list;
  3331   if (! f)
  3332     num_font_drivers++;
  3333 }
  3334 
  3335 void
  3336 free_font_driver_list (struct frame *f)
  3337 {
  3338   struct font_driver_list *list, *next;
  3339 
  3340   for (list = f->font_driver_list; list; list = next)
  3341     {
  3342       next = list->next;
  3343       xfree (list);
  3344     }
  3345   f->font_driver_list = NULL;
  3346 }
  3347 
  3348 
  3349 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
  3350    symbols, e.g. xft, x).  If NEW_DRIVERS is t, make F use all
  3351    available font drivers that are not superseded by another driver.
  3352    (A font driver SYMBOL is superseded by the driver specified by
  3353    SYMBOL's 'font-driver-superseded-by property if it is a non-nil
  3354    symbol.)  If NEW_DRIVERS is nil, finalize all drivers.
  3355 
  3356    A caller must free all realized faces if any in advance.  The
  3357    return value is a list of font backends actually made used on
  3358    F.  */
  3359 
  3360 Lisp_Object
  3361 font_update_drivers (struct frame *f, Lisp_Object new_drivers)
  3362 {
  3363   Lisp_Object active_drivers = Qnil, default_drivers = Qnil;
  3364   struct font_driver_list *list;
  3365 
  3366   /* Collect all unsuperseded driver symbols into
  3367      `default_drivers'.  */
  3368   Lisp_Object all_drivers = Qnil;
  3369   for (list = f->font_driver_list; list; list = list->next)
  3370     all_drivers = Fcons (list->driver->type, all_drivers);
  3371   for (Lisp_Object rest = all_drivers; CONSP (rest); rest = XCDR (rest))
  3372     {
  3373       Lisp_Object superseded_by
  3374         = Fget (XCAR (rest), Qfont_driver_superseded_by);
  3375 
  3376       if (NILP (superseded_by)
  3377           || NILP (Fmemq (superseded_by, all_drivers)))
  3378         default_drivers = Fcons (XCAR (rest), default_drivers);
  3379     }
  3380 
  3381   if (EQ (new_drivers, Qt))
  3382     new_drivers = default_drivers;
  3383 
  3384   /* At first, turn off non-requested drivers, and turn on requested
  3385      drivers.  */
  3386   for (list = f->font_driver_list; list; list = list->next)
  3387     {
  3388       struct font_driver const *driver = list->driver;
  3389       if ((! NILP (Fmemq (driver->type, new_drivers))) != list->on)
  3390         {
  3391           if (list->on)
  3392             {
  3393               if (driver->end_for_frame)
  3394                 driver->end_for_frame (f);
  3395               font_finish_cache (f, driver);
  3396               list->on = 0;
  3397             }
  3398           else
  3399             {
  3400               if (! driver->start_for_frame
  3401                   || driver->start_for_frame (f) == 0)
  3402                 {
  3403                   font_prepare_cache (f, driver);
  3404                   list->on = 1;
  3405                 }
  3406             }
  3407         }
  3408     }
  3409 
  3410   if (NILP (new_drivers))
  3411     return Qnil;
  3412   else
  3413     {
  3414       /* Re-order the driver list according to new_drivers.  */
  3415       struct font_driver_list **list_table, **next;
  3416       Lisp_Object tail;
  3417       int i;
  3418       USE_SAFE_ALLOCA;
  3419 
  3420       SAFE_NALLOCA (list_table, 1, num_font_drivers + 1);
  3421       for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
  3422         {
  3423           for (list = f->font_driver_list; list; list = list->next)
  3424             if (list->on && EQ (list->driver->type, XCAR (tail)))
  3425               break;
  3426           if (list)
  3427             list_table[i++] = list;
  3428         }
  3429       for (list = f->font_driver_list; list; list = list->next)
  3430         if (! list->on)
  3431           list_table[i++] = list;
  3432       list_table[i] = NULL;
  3433 
  3434       next = &f->font_driver_list;
  3435       for (i = 0; list_table[i]; i++)
  3436         {
  3437           *next = list_table[i];
  3438           next = &(*next)->next;
  3439         }
  3440       *next = NULL;
  3441       SAFE_FREE ();
  3442 
  3443       if (! f->font_driver_list->on)
  3444         { /* None of the drivers is enabled: enable them all.
  3445              Happens if you set the list of drivers to (xft x) in your .emacs
  3446              and then use it under w32 or ns.  */
  3447           for (list = f->font_driver_list; list; list = list->next)
  3448             {
  3449               struct font_driver const *driver = list->driver;
  3450               eassert (! list->on);
  3451               if (NILP (Fmemq (driver->type, default_drivers)))
  3452                 continue;
  3453               if (! driver->start_for_frame
  3454                   || driver->start_for_frame (f) == 0)
  3455                 {
  3456                   font_prepare_cache (f, driver);
  3457                   list->on = 1;
  3458                 }
  3459             }
  3460         }
  3461     }
  3462 
  3463   for (list = f->font_driver_list; list; list = list->next)
  3464     if (list->on)
  3465       active_drivers = nconc2 (active_drivers, list1 (list->driver->type));
  3466   return active_drivers;
  3467 }
  3468 
  3469 #if (defined HAVE_XFT || defined HAVE_FREETYPE) && !defined USE_CAIRO
  3470 
  3471 static void
  3472 fset_font_data (struct frame *f, Lisp_Object val)
  3473 {
  3474   f->font_data = val;
  3475 }
  3476 
  3477 void
  3478 font_put_frame_data (struct frame *f, Lisp_Object driver, void *data)
  3479 {
  3480   Lisp_Object val = assq_no_quit (driver, f->font_data);
  3481 
  3482   if (!data)
  3483     fset_font_data (f, Fdelq (val, f->font_data));
  3484   else
  3485     {
  3486       if (NILP (val))
  3487         fset_font_data (f, Fcons (Fcons (driver, make_mint_ptr (data)),
  3488                                   f->font_data));
  3489       else
  3490         XSETCDR (val, make_mint_ptr (data));
  3491     }
  3492 }
  3493 
  3494 void *
  3495 font_get_frame_data (struct frame *f, Lisp_Object driver)
  3496 {
  3497   Lisp_Object val = assq_no_quit (driver, f->font_data);
  3498 
  3499   return NILP (val) ? NULL : xmint_pointer (XCDR (val));
  3500 }
  3501 
  3502 #endif /* (HAVE_XFT || HAVE_FREETYPE) && !USE_CAIRO */
  3503 
  3504 /* Sets attributes on a font.  Any properties that appear in ALIST and
  3505    BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
  3506    BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
  3507    arrays of strings.  This function is intended for use by the font
  3508    drivers to implement their specific font_filter_properties.  */
  3509 void
  3510 font_filter_properties (Lisp_Object font,
  3511                         Lisp_Object alist,
  3512                         const char *const boolean_properties[],
  3513                         const char *const non_boolean_properties[])
  3514 {
  3515   Lisp_Object it;
  3516   int i;
  3517 
  3518   /* Set boolean values to Qt or Qnil.  */
  3519   for (i = 0; boolean_properties[i] != NULL; ++i)
  3520     for (it = alist; ! NILP (it); it = XCDR (it))
  3521       {
  3522         Lisp_Object key = XCAR (XCAR (it));
  3523         Lisp_Object val = XCDR (XCAR (it));
  3524         char *keystr = SSDATA (SYMBOL_NAME (key));
  3525 
  3526         if (strcmp (boolean_properties[i], keystr) == 0)
  3527           {
  3528             const char *str = FIXNUMP (val) ? (XFIXNUM (val) ? "true" : "false")
  3529               : SYMBOLP (val) ? SSDATA (SYMBOL_NAME (val))
  3530               : "true";
  3531 
  3532             if (strcmp ("false", str) == 0 || strcmp ("False", str) == 0
  3533                 || strcmp ("FALSE", str) == 0 || strcmp ("FcFalse", str) == 0
  3534                 || strcmp ("off", str) == 0 || strcmp ("OFF", str) == 0
  3535                 || strcmp ("Off", str) == 0)
  3536               val = Qnil;
  3537             else
  3538               val = Qt;
  3539 
  3540             Ffont_put (font, key, val);
  3541           }
  3542       }
  3543 
  3544   for (i = 0; non_boolean_properties[i] != NULL; ++i)
  3545     for (it = alist; ! NILP (it); it = XCDR (it))
  3546       {
  3547         Lisp_Object key = XCAR (XCAR (it));
  3548         Lisp_Object val = XCDR (XCAR (it));
  3549         char *keystr = SSDATA (SYMBOL_NAME (key));
  3550         if (strcmp (non_boolean_properties[i], keystr) == 0)
  3551           Ffont_put (font, key, val);
  3552       }
  3553 }
  3554 
  3555 
  3556 /* Return the font used to draw character C by FACE at buffer position
  3557    POS in window W.  If STRING is non-nil, it is a string containing C
  3558    at index POS.  If C is negative, get C from the current buffer or
  3559    STRING.  */
  3560 
  3561 static Lisp_Object
  3562 font_at (int c, ptrdiff_t pos, struct face *face, struct window *w,
  3563          Lisp_Object string)
  3564 {
  3565   struct frame *f;
  3566   bool multibyte;
  3567   Lisp_Object font_object;
  3568 
  3569   multibyte = (NILP (string)
  3570                ? ! NILP (BVAR (current_buffer, enable_multibyte_characters))
  3571                : STRING_MULTIBYTE (string));
  3572   if (c < 0)
  3573     {
  3574       if (NILP (string))
  3575         {
  3576           if (multibyte)
  3577             {
  3578               ptrdiff_t pos_byte = CHAR_TO_BYTE (pos);
  3579 
  3580               c = FETCH_CHAR (pos_byte);
  3581             }
  3582           else
  3583             c = FETCH_BYTE (pos);
  3584         }
  3585       else
  3586         {
  3587           unsigned char *str;
  3588 
  3589           multibyte = STRING_MULTIBYTE (string);
  3590           if (multibyte)
  3591             {
  3592               ptrdiff_t pos_byte = string_char_to_byte (string, pos);
  3593 
  3594               str = SDATA (string) + pos_byte;
  3595               c = STRING_CHAR (str);
  3596             }
  3597           else
  3598             c = SDATA (string)[pos];
  3599         }
  3600     }
  3601 
  3602   f = XFRAME (w->frame);
  3603   if (! FRAME_WINDOW_P (f))
  3604     return Qnil;
  3605   if (! face)
  3606     {
  3607       int face_id;
  3608       ptrdiff_t endptr;
  3609 
  3610       if (STRINGP (string))
  3611         face_id = face_at_string_position (w, string, pos, 0, &endptr,
  3612                                            DEFAULT_FACE_ID, false, 0);
  3613       else
  3614         face_id = face_at_buffer_position (w, pos, &endptr,
  3615                                            pos + 100, false, -1, 0);
  3616       face = FACE_FROM_ID (f, face_id);
  3617     }
  3618   if (multibyte)
  3619     {
  3620       int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
  3621       face = FACE_FROM_ID (f, face_id);
  3622     }
  3623   if (! face->font)
  3624     return Qnil;
  3625 
  3626   XSETFONT (font_object, face->font);
  3627   return font_object;
  3628 }
  3629 
  3630 
  3631 #ifdef HAVE_WINDOW_SYSTEM
  3632 
  3633 /* Check if CH is a codepoint for which we should attempt to use the
  3634    emoji font, even if the codepoint itself has Emoji_Presentation =
  3635    No.  Vauto_composition_emoji_eligible_codepoints is filled in for
  3636    us by admin/unidata/emoji-zwj.awk.  */
  3637 static bool
  3638 codepoint_is_emoji_eligible (int ch)
  3639 {
  3640   if (EQ (CHAR_TABLE_REF (Vchar_script_table, ch), Qemoji))
  3641     return true;
  3642 
  3643   if (! NILP (Fmemq (make_fixnum (ch),
  3644                      Vauto_composition_emoji_eligible_codepoints)))
  3645     return true;
  3646 
  3647   return false;
  3648 }
  3649 
  3650 /* Check how many characters after character/byte position POS/POS_BYTE
  3651    (at most to *LIMIT) can be displayed by the same font in the window W.
  3652    FACE, if non-NULL, is the face selected for the character at POS.
  3653    If STRING is not nil, it is the string to check instead of the current
  3654    buffer.  In that case, FACE must be not NULL.
  3655 
  3656    CH is the character that actually caused the composition
  3657    process to start, it may be different from the character at POS.
  3658 
  3659    The return value is the font-object for the character at POS.
  3660    *LIMIT is set to the position where that font can't be used.
  3661 
  3662    It is assured that the current buffer (or STRING) is multibyte.  */
  3663 
  3664 Lisp_Object
  3665 font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit,
  3666             struct window *w, struct face *face, Lisp_Object string,
  3667             int ch)
  3668 {
  3669   ptrdiff_t ignore;
  3670   int c;
  3671   Lisp_Object font_object = Qnil;
  3672   struct frame *f = XFRAME (w->frame);
  3673 
  3674   if (!face)
  3675     {
  3676       int face_id;
  3677 
  3678       if (NILP (string))
  3679           face_id = face_at_buffer_position (w, pos, &ignore, *limit,
  3680                                              false, -1, 0);
  3681       else
  3682         {
  3683           face_id =
  3684             NILP (Vface_remapping_alist)
  3685             ? DEFAULT_FACE_ID
  3686             : lookup_basic_face (w, f, DEFAULT_FACE_ID);
  3687 
  3688           face_id = face_at_string_position (w, string, pos, 0, &ignore,
  3689                                              face_id, false, 0);
  3690         }
  3691       face = FACE_FROM_ID (f, face_id);
  3692     }
  3693 
  3694   /* If the composition was triggered by an emoji, use a character
  3695      from 'script-representative-chars', rather than the first
  3696      character in the string, to determine the font to use.  */
  3697   if (codepoint_is_emoji_eligible (ch))
  3698     {
  3699       Lisp_Object val = assq_no_quit (Qemoji, Vscript_representative_chars);
  3700       if (CONSP (val))
  3701         {
  3702           val = XCDR (val);
  3703           if (CONSP (val))
  3704             val = XCAR (val);
  3705           else if (VECTORP (val))
  3706             val = AREF (val, 0);
  3707           font_object = font_for_char (face, XFIXNAT (val), pos, string);
  3708         }
  3709     }
  3710 
  3711   while (pos < *limit)
  3712     {
  3713       c = (NILP (string)
  3714            ? fetch_char_advance_no_check (&pos, &pos_byte)
  3715            : fetch_string_char_advance_no_check (string, &pos, &pos_byte));
  3716       Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
  3717       if (FIXNUMP (category)
  3718           && (XFIXNUM (category) == UNICODE_CATEGORY_Cf
  3719               || CHAR_VARIATION_SELECTOR_P (c)))
  3720         continue;
  3721       if (NILP (font_object))
  3722         {
  3723           font_object = font_for_char (face, c, pos - 1, string);
  3724           if (NILP (font_object))
  3725             return Qnil;
  3726           continue;
  3727         }
  3728       if (font_encode_char (font_object, c) == FONT_INVALID_CODE)
  3729         *limit = pos - 1;
  3730     }
  3731   return font_object;
  3732 }
  3733 #endif
  3734 
  3735 
  3736 /* Lisp API.  */
  3737 
  3738 DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
  3739        doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
  3740 Return nil otherwise.
  3741 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
  3742 which kind of font it is.  It must be one of `font-spec', `font-entity',
  3743 `font-object'.  */)
  3744   (Lisp_Object object, Lisp_Object extra_type)
  3745 {
  3746   if (NILP (extra_type))
  3747     return (FONTP (object) ? Qt : Qnil);
  3748   if (EQ (extra_type, Qfont_spec))
  3749     return (FONT_SPEC_P (object) ? Qt : Qnil);
  3750   if (EQ (extra_type, Qfont_entity))
  3751     return (FONT_ENTITY_P (object) ? Qt : Qnil);
  3752   if (EQ (extra_type, Qfont_object))
  3753     return (FONT_OBJECT_P (object) ? Qt : Qnil);
  3754   wrong_type_argument (Qfont_extra_type, extra_type); ;
  3755 }
  3756 
  3757 DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
  3758        doc: /* Return a newly created font-spec with arguments as properties.
  3759 
  3760 ARGS must come in pairs KEY VALUE of font properties.  KEY must be a
  3761 valid font property name listed below:
  3762 
  3763 `:family', `:weight', `:slant', `:width'
  3764 
  3765 They are the same as face attributes of the same name.  See
  3766 `set-face-attribute'.
  3767 
  3768 `:foundry'
  3769 
  3770 VALUE must be a string or a symbol specifying the font foundry, e.g. `misc'.
  3771 
  3772 `:adstyle'
  3773 
  3774 VALUE must be a string or a symbol specifying the additional
  3775 typographic style information of a font, e.g. `sans'.
  3776 
  3777 `:registry'
  3778 
  3779 VALUE must be a string or a symbol specifying the charset registry and
  3780 encoding of a font, e.g. `iso8859-1'.
  3781 
  3782 `:size'
  3783 
  3784 VALUE must be a non-negative integer or a floating point number
  3785 specifying the font size.  It specifies the font size in pixels (if
  3786 VALUE is an integer), or in points (if VALUE is a float).
  3787 
  3788 `:dpi'
  3789 
  3790 VALUE must be a non-negative number that specifies the resolution
  3791 (dot per inch) for which the font is designed.
  3792 
  3793 `:spacing'
  3794 
  3795 VALUE specifies the spacing of the font: mono, proportional, charcell,
  3796 or dual.  It can be either a number (0 for proportional, 90 for dual,
  3797 100 for mono, 110 for charcell) or a 1-letter symbol: `P', `D', `M',
  3798 or `C' (lower-case variants are also accepted).
  3799 
  3800 `:avgwidth'
  3801 
  3802 VALUE must be a non-negative integer specifying the average width of
  3803 the font in 1/10 pixel units.
  3804 
  3805 `:name'
  3806 
  3807 VALUE must be a string of XLFD-style or fontconfig-style font name.
  3808 
  3809 `:script'
  3810 
  3811 VALUE must be a symbol representing a script that the font must
  3812 support.  It may be a symbol representing a subgroup of a script
  3813 listed in the variable `script-representative-chars'.
  3814 
  3815 `:lang'
  3816 
  3817 VALUE must be a symbol whose name is a two-letter ISO-639 language
  3818 name, e.g. `ja'.  The value is matched against the "Additional Style"
  3819 field of the XLFD spec of a font, if it's non-empty, on X, and
  3820 against the codepages supported by the font on w32.
  3821 
  3822 `:otf'
  3823 
  3824 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
  3825 required OpenType features.
  3826 
  3827   SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
  3828   LANGSYS-TAG: OpenType language system tag symbol,
  3829      or nil for the default language system.
  3830   GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
  3831   GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
  3832 
  3833 GSUB and GPOS may contain nil elements.  In such a case, the font
  3834 must not have any of the remaining elements.
  3835 
  3836 For instance, if the VALUE is `(thai nil nil (mark))', the font must
  3837 be an OpenType font whose GPOS table of `thai' script's default
  3838 language system must contain `mark' feature.
  3839 
  3840 usage: (font-spec ARGS...)  */)
  3841   (ptrdiff_t nargs, Lisp_Object *args)
  3842 {
  3843   Lisp_Object spec = font_make_spec ();
  3844   ptrdiff_t i;
  3845 
  3846   for (i = 0; i < nargs; i += 2)
  3847     {
  3848       Lisp_Object key = args[i], val;
  3849 
  3850       CHECK_SYMBOL (key);
  3851       if (i + 1 >= nargs)
  3852         error ("No value for key `%s'", SDATA (SYMBOL_NAME (key)));
  3853       val = args[i + 1];
  3854 
  3855       if (EQ (key, QCname))
  3856         {
  3857           CHECK_STRING (val);
  3858           if (font_parse_name (SSDATA (val), SBYTES (val), spec) < 0)
  3859             error ("Invalid font name: %s", SSDATA (val));
  3860           font_put_extra (spec, key, val);
  3861         }
  3862       else
  3863         {
  3864           int idx = get_font_prop_index (key);
  3865 
  3866           if (idx >= 0)
  3867             {
  3868               val = font_prop_validate (idx, Qnil, val);
  3869               if (idx < FONT_EXTRA_INDEX)
  3870                 ASET (spec, idx, val);
  3871               else
  3872                 font_put_extra (spec, key, val);
  3873             }
  3874           else
  3875             font_put_extra (spec, key, font_prop_validate (0, key, val));
  3876         }
  3877     }
  3878   return spec;
  3879 }
  3880 
  3881 /* Return a copy of FONT as a font-spec.  For the sake of speed, this code
  3882    relies on an internal stuff exposed from alloc.c and should be handled
  3883    with care. */
  3884 
  3885 Lisp_Object
  3886 copy_font_spec (Lisp_Object font)
  3887 {
  3888   enum { font_spec_size = VECSIZE (struct font_spec) };
  3889   Lisp_Object new_spec, tail, *pcdr;
  3890   struct font_spec *spec;
  3891 
  3892   CHECK_FONT (font);
  3893 
  3894   /* Make an uninitialized font-spec object.  */
  3895   spec = (struct font_spec *) allocate_vector (font_spec_size);
  3896   XSETPVECTYPESIZE (spec, PVEC_FONT, FONT_SPEC_MAX,
  3897                     font_spec_size - FONT_SPEC_MAX);
  3898 
  3899   spec->props[FONT_TYPE_INDEX] = spec->props[FONT_EXTRA_INDEX] = Qnil;
  3900 
  3901   /* Copy basic properties FONT_FOUNDRY_INDEX..FONT_AVGWIDTH_INDEX.  */
  3902   memcpy (spec->props + 1, XVECTOR (font)->contents + 1,
  3903           (FONT_EXTRA_INDEX - 1) * word_size);
  3904 
  3905   /* Copy an alist of extra information but discard :font-entity property.  */
  3906   pcdr = spec->props + FONT_EXTRA_INDEX;
  3907   for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
  3908     if (!EQ (XCAR (XCAR (tail)), QCfont_entity))
  3909       {
  3910         *pcdr = Fcons (Fcons (XCAR (XCAR (tail)), CDR (XCAR (tail))), Qnil);
  3911         pcdr = xcdr_addr (*pcdr);
  3912       }
  3913 
  3914   XSETFONT (new_spec, spec);
  3915   return new_spec;
  3916 }
  3917 
  3918 /* Merge font-specs FROM and TO, and return a new font-spec.
  3919    Every specified property in FROM overrides the corresponding
  3920    property in TO.  */
  3921 Lisp_Object
  3922 merge_font_spec (Lisp_Object from, Lisp_Object to)
  3923 {
  3924   Lisp_Object extra, tail;
  3925   int i;
  3926 
  3927   CHECK_FONT (from);
  3928   CHECK_FONT (to);
  3929   to = copy_font_spec (to);
  3930   for (i = 0; i < FONT_EXTRA_INDEX; i++)
  3931     ASET (to, i, AREF (from, i));
  3932   extra = AREF (to, FONT_EXTRA_INDEX);
  3933   for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
  3934     if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
  3935       {
  3936         Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
  3937 
  3938         if (! NILP (slot))
  3939           XSETCDR (slot, XCDR (XCAR (tail)));
  3940         else
  3941           extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
  3942       }
  3943   ASET (to, FONT_EXTRA_INDEX, extra);
  3944   return to;
  3945 }
  3946 
  3947 DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
  3948        doc: /* Return the value of FONT's property KEY.
  3949 FONT is a font-spec, a font-entity, or a font-object.
  3950 KEY can be any symbol, but these are reserved for specific meanings:
  3951   :foundry, :family, :adstyle, :registry, :weight, :slant, :width,
  3952   :size, :dpi, :spacing, :avgwidth, :script, :lang, :otf
  3953 See the documentation of `font-spec' for their meanings.
  3954 
  3955 If FONT is a font-entity or a font-object, then values of
  3956 :script and :otf properties are different from those of a font-spec
  3957 as below:
  3958 
  3959   The value of :script may be a list of scripts that are supported by
  3960   the font.
  3961 
  3962   The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are
  3963   lists representing the OpenType features supported by the font, of
  3964   this form: ((SCRIPT (LANGSYS FEATURE ...) ...) ...), where
  3965   SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
  3966   Layout tags.  See `otf-script-alist' for the OpenType script tags.
  3967 
  3968 In addition to the keys listed above, the following keys are reserved
  3969 for the specific meanings as below:
  3970 
  3971   The value of :type is a symbol that identifies the font backend to be
  3972   used, such as `ftcrhb' or `xfthb' on X , `harfbuzz' or `uniscribe' on
  3973   MS-Windows, `ns' on Cocoa/GNUstep, etc.
  3974 
  3975   The value of :combining-capability is non-nil if the font-backend of
  3976   FONT supports rendering of combining characters for non-OTF fonts.  */)
  3977   (Lisp_Object font, Lisp_Object key)
  3978 {
  3979   int idx;
  3980   Lisp_Object val;
  3981 
  3982   CHECK_FONT (font);
  3983   CHECK_SYMBOL (key);
  3984 
  3985   idx = get_font_prop_index (key);
  3986   if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
  3987     return font_style_symbolic (font, idx, 0);
  3988   if (idx >= 0 && idx < FONT_EXTRA_INDEX)
  3989     return AREF (font, idx);
  3990   val = Fassq (key, AREF (font, FONT_EXTRA_INDEX));
  3991   if (NILP (val) && FONT_OBJECT_P (font))
  3992     {
  3993       struct font *fontp = XFONT_OBJECT (font);
  3994 
  3995       if (EQ (key, QCotf))
  3996         {
  3997           if (fontp->driver->otf_capability)
  3998             val = fontp->driver->otf_capability (fontp);
  3999           else
  4000             val = Fcons (Qnil, Qnil);
  4001         }
  4002       else if (EQ (key, QCcombining_capability))
  4003         {
  4004           if (fontp->driver->combining_capability)
  4005             val = fontp->driver->combining_capability (fontp);
  4006         }
  4007     }
  4008   else
  4009     val = Fcdr (val);
  4010   return val;
  4011 }
  4012 
  4013 #ifdef HAVE_WINDOW_SYSTEM
  4014 
  4015 DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
  4016        doc: /* Return a plist of face attributes generated by FONT.
  4017 FONT is a font name, a font-spec, a font-entity, or a font-object.
  4018 The return value is a list of the form
  4019 
  4020 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
  4021 
  4022 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
  4023 compatible with `set-face-attribute'.  Some of these key-attribute pairs
  4024 may be omitted from the list if they are not specified by FONT.
  4025 
  4026 The optional argument FRAME specifies the frame that the face attributes
  4027 are to be displayed on.  If omitted, the selected frame is used.  */)
  4028   (Lisp_Object font, Lisp_Object frame)
  4029 {
  4030   struct frame *f = decode_live_frame (frame);
  4031   Lisp_Object plist[10];
  4032   Lisp_Object val;
  4033   int n = 0;
  4034 
  4035   if (STRINGP (font))
  4036     {
  4037       int fontset = fs_query_fontset (font, 0);
  4038       Lisp_Object name = font;
  4039       if (fontset >= 0)
  4040         font = fontset_ascii (fontset);
  4041       font = font_spec_from_name (name);
  4042       if (! FONTP (font))
  4043         signal_error ("Invalid font name", name);
  4044     }
  4045   else if (! FONTP (font))
  4046     signal_error ("Invalid font object", font);
  4047 
  4048   val = AREF (font, FONT_FAMILY_INDEX);
  4049   if (! NILP (val))
  4050     {
  4051       plist[n++] = QCfamily;
  4052       plist[n++] = SYMBOL_NAME (val);
  4053     }
  4054 
  4055   val = AREF (font, FONT_SIZE_INDEX);
  4056   if (FIXNUMP (val))
  4057     {
  4058       Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
  4059       int dpi = FIXNUMP (font_dpi) ? XFIXNUM (font_dpi) : FRAME_RES_Y (f);
  4060       plist[n++] = QCheight;
  4061       plist[n++] = make_fixnum (PIXEL_TO_POINT (XFIXNUM (val) * 10, dpi));
  4062     }
  4063   else if (FLOATP (val))
  4064     {
  4065       plist[n++] = QCheight;
  4066       plist[n++] = make_fixnum (10 * (int) XFLOAT_DATA (val));
  4067     }
  4068 
  4069   val = FONT_WEIGHT_FOR_FACE (font);
  4070   if (! NILP (val))
  4071     {
  4072       plist[n++] = QCweight;
  4073       plist[n++] = val;
  4074     }
  4075 
  4076   val = FONT_SLANT_FOR_FACE (font);
  4077   if (! NILP (val))
  4078     {
  4079       plist[n++] = QCslant;
  4080       plist[n++] = val;
  4081     }
  4082 
  4083   val = FONT_WIDTH_FOR_FACE (font);
  4084   if (! NILP (val))
  4085     {
  4086       plist[n++] = QCwidth;
  4087       plist[n++] = val;
  4088     }
  4089 
  4090   return Flist (n, plist);
  4091 }
  4092 
  4093 #endif
  4094 
  4095 DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
  4096        doc: /* Set one property of FONT: give property KEY value VAL.
  4097 FONT is a font-spec, a font-entity, or a font-object.
  4098 
  4099 If FONT is a font-spec, KEY can be any symbol.  But if KEY is the one
  4100 accepted by the function `font-spec' (which see), VAL must be what
  4101 allowed in `font-spec'.
  4102 
  4103 If FONT is a font-entity or a font-object, KEY must not be the one
  4104 accepted by `font-spec'.
  4105 
  4106 See also `font-get' for KEYs that have special meanings.  */)
  4107   (Lisp_Object font, Lisp_Object prop, Lisp_Object val)
  4108 {
  4109   int idx;
  4110 
  4111   idx = get_font_prop_index (prop);
  4112   if (idx >= 0 && idx < FONT_EXTRA_INDEX)
  4113     {
  4114       CHECK_FONT_SPEC (font);
  4115       ASET (font, idx, font_prop_validate (idx, Qnil, val));
  4116     }
  4117   else
  4118     {
  4119       if (EQ (prop, QCname)
  4120           || EQ (prop, QCscript)
  4121           || EQ (prop, QClang)
  4122           || EQ (prop, QCotf))
  4123         CHECK_FONT_SPEC (font);
  4124       else
  4125         CHECK_FONT (font);
  4126       font_put_extra (font, prop, font_prop_validate (0, prop, val));
  4127     }
  4128   return val;
  4129 }
  4130 
  4131 DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
  4132        doc: /* List available fonts matching FONT-SPEC on the current frame.
  4133 Optional 2nd argument FRAME specifies the target frame.
  4134 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
  4135 Optional 4th argument PREFER, if non-nil, is a font-spec to
  4136 control the order of the returned list.  Fonts are sorted by
  4137 how close they are to PREFER.  */)
  4138   (Lisp_Object font_spec, Lisp_Object frame, Lisp_Object num, Lisp_Object prefer)
  4139 {
  4140   struct frame *f = decode_live_frame (frame);
  4141   Lisp_Object vec, list;
  4142   EMACS_INT n = 0;
  4143 
  4144   CHECK_FONT_SPEC (font_spec);
  4145   if (! NILP (num))
  4146     {
  4147       CHECK_FIXNUM (num);
  4148       n = XFIXNUM (num);
  4149       if (n <= 0)
  4150         return Qnil;
  4151     }
  4152   if (! NILP (prefer))
  4153     CHECK_FONT_SPEC (prefer);
  4154 
  4155   list = font_list_entities (f, font_spec);
  4156   if (NILP (list))
  4157     return Qnil;
  4158   if (NILP (XCDR (list))
  4159       && ASIZE (XCAR (list)) == 1)
  4160     return list1 (AREF (XCAR (list), 0));
  4161 
  4162   if (! NILP (prefer))
  4163     vec = font_sort_entities (list, prefer, f, 0);
  4164   else
  4165     vec = font_vconcat_entity_vectors (list);
  4166   if (n == 0 || n >= ASIZE (vec))
  4167     list = CALLN (Fappend, vec, Qnil);
  4168   else
  4169     {
  4170       for (list = Qnil, n--; n >= 0; n--)
  4171         list = Fcons (AREF (vec, n), list);
  4172     }
  4173   return list;
  4174 }
  4175 
  4176 DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
  4177        doc: /* List available font families on the current frame.
  4178 If FRAME is omitted or nil, the selected frame is used.  */)
  4179   (Lisp_Object frame)
  4180 {
  4181   struct frame *f = decode_live_frame (frame);
  4182   struct font_driver_list *driver_list;
  4183   Lisp_Object list = Qnil;
  4184 
  4185   for (driver_list = f->font_driver_list; driver_list;
  4186        driver_list = driver_list->next)
  4187     if (driver_list->driver->list_family)
  4188       {
  4189         Lisp_Object val = driver_list->driver->list_family (f);
  4190         Lisp_Object tail = list;
  4191 
  4192         for (; CONSP (val); val = XCDR (val))
  4193           if (NILP (Fmemq (XCAR (val), tail))
  4194               && SYMBOLP (XCAR (val)))
  4195             list = Fcons (SYMBOL_NAME (XCAR (val)), list);
  4196       }
  4197   return list;
  4198 }
  4199 
  4200 DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
  4201        doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
  4202 Optional 2nd argument FRAME, if non-nil, specifies the target frame.  */)
  4203   (Lisp_Object font_spec, Lisp_Object frame)
  4204 {
  4205   Lisp_Object val = Flist_fonts (font_spec, frame, make_fixnum (1), Qnil);
  4206 
  4207   if (CONSP (val))
  4208     val = XCAR (val);
  4209   return val;
  4210 }
  4211 
  4212 DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
  4213        doc: /*  Return XLFD name of FONT.
  4214 FONT is a font-spec, font-entity, or font-object.
  4215 If the name is too long for XLFD (maximum 255 chars), return nil.
  4216 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
  4217 the consecutive wildcards are folded into one.  */)
  4218   (Lisp_Object font, Lisp_Object fold_wildcards)
  4219 {
  4220   char name[256];
  4221   int namelen, pixel_size = 0;
  4222 
  4223   CHECK_FONT (font);
  4224 
  4225   if (FONT_OBJECT_P (font))
  4226     {
  4227       Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
  4228 
  4229       if (STRINGP (font_name)
  4230           && SDATA (font_name)[0] == '-')
  4231         {
  4232           if (NILP (fold_wildcards))
  4233             return font_name;
  4234           lispstpcpy (name, font_name);
  4235           namelen = SBYTES (font_name);
  4236           goto done;
  4237         }
  4238       pixel_size = XFONT_OBJECT (font)->pixel_size;
  4239     }
  4240   namelen = font_unparse_xlfd (font, pixel_size, name, 256);
  4241   if (namelen < 0)
  4242     return Qnil;
  4243  done:
  4244   if (! NILP (fold_wildcards))
  4245     {
  4246       char *p0 = name, *p1;
  4247 
  4248       while ((p1 = strstr (p0, "-*-*")))
  4249         {
  4250           memmove (p1, p1 + 2, (name + namelen + 1) - (p1 + 2));
  4251           namelen -= 2;
  4252           p0 = p1;
  4253         }
  4254     }
  4255 
  4256   return make_string (name, namelen);
  4257 }
  4258 
  4259 void
  4260 clear_font_cache (struct frame *f)
  4261 {
  4262   struct font_driver_list *driver_list = f->font_driver_list;
  4263 
  4264   for (; driver_list; driver_list = driver_list->next)
  4265     if (driver_list->on)
  4266       {
  4267         Lisp_Object val, tmp, cache = driver_list->driver->get_cache (f);
  4268 
  4269         val = XCDR (cache);
  4270         while (eassert (CONSP (val)),
  4271                ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
  4272           val = XCDR (val);
  4273         tmp = XCDR (XCAR (val));
  4274         if (XFIXNUM (XCAR (tmp)) == 0)
  4275           {
  4276             font_clear_cache (f, XCAR (val), driver_list->driver);
  4277             XSETCDR (cache, XCDR (val));
  4278           }
  4279       }
  4280 }
  4281 
  4282 DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
  4283        doc: /* Clear font cache of each frame.  */)
  4284   (void)
  4285 {
  4286   Lisp_Object list, frame;
  4287 
  4288   FOR_EACH_FRAME (list, frame)
  4289     clear_font_cache (XFRAME (frame));
  4290 
  4291   return Qnil;
  4292 }
  4293 
  4294 
  4295 void
  4296 font_fill_lglyph_metrics (Lisp_Object glyph, struct font *font, unsigned int code)
  4297 {
  4298   struct font_metrics metrics;
  4299 
  4300   LGLYPH_SET_CODE (glyph, code);
  4301   font->driver->text_extents (font, &code, 1, &metrics);
  4302   LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
  4303   LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
  4304   LGLYPH_SET_WIDTH (glyph, metrics.width);
  4305   LGLYPH_SET_ASCENT (glyph, metrics.ascent);
  4306   LGLYPH_SET_DESCENT (glyph, metrics.descent);
  4307 }
  4308 
  4309 
  4310 DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 2, 2, 0,
  4311        doc: /* Shape the glyph-string GSTRING subject to bidi DIRECTION.
  4312 Shaping means substituting glyphs and/or adjusting positions of glyphs
  4313 to get the correct visual image of character sequences set in the
  4314 header of the glyph-string.
  4315 
  4316 DIRECTION should be produced by the UBA, the Unicode Bidirectional
  4317 Algorithm, and should be a symbol, either L2R or R2L.  It can also
  4318 be nil if the bidi context is unknown.
  4319 
  4320 If the shaping was successful, the value is GSTRING itself or a newly
  4321 created glyph-string.  Otherwise, the value is nil.
  4322 
  4323 See the documentation of `composition-get-gstring' for the format of
  4324 GSTRING.  */)
  4325   (Lisp_Object gstring, Lisp_Object direction)
  4326 {
  4327   struct font *font;
  4328   Lisp_Object font_object, n, glyph;
  4329   ptrdiff_t i, from, to;
  4330 
  4331   if (! composition_gstring_p (gstring))
  4332     signal_error ("Invalid glyph-string: ", gstring);
  4333   if (! NILP (LGSTRING_ID (gstring)))
  4334     return gstring;
  4335   Lisp_Object cached_gstring =
  4336     composition_gstring_lookup_cache (LGSTRING_HEADER (gstring));
  4337   if (! NILP (cached_gstring))
  4338     return cached_gstring;
  4339   font_object = LGSTRING_FONT (gstring);
  4340   CHECK_FONT_OBJECT (font_object);
  4341   font = XFONT_OBJECT (font_object);
  4342   if (! font->driver->shape)
  4343     return Qnil;
  4344 
  4345   /* Try at most three times with larger gstring each time.  */
  4346   for (i = 0; i < 3; i++)
  4347     {
  4348       n = font->driver->shape (gstring, direction);
  4349       if (FIXNUMP (n))
  4350         break;
  4351       gstring = larger_vector (gstring,
  4352                                LGSTRING_GLYPH_LEN (gstring), -1);
  4353     }
  4354   if (i == 3 || XFIXNUM (n) == 0)
  4355     return Qnil;
  4356   if (XFIXNUM (n) < LGSTRING_GLYPH_LEN (gstring))
  4357     LGSTRING_SET_GLYPH (gstring, XFIXNUM (n), Qnil);
  4358 
  4359   /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
  4360      GLYPHS covers all characters (except for the last few ones) in
  4361      GSTRING.  More formally, provided that NCHARS is the number of
  4362      characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
  4363      and TO_IDX of each glyph must satisfy these conditions:
  4364 
  4365        GLYPHS[0].FROM_IDX == 0
  4366        GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
  4367        if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
  4368          ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
  4369          GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
  4370        else
  4371          ;; Be sure to cover all characters.
  4372          GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
  4373   glyph = LGSTRING_GLYPH (gstring, 0);
  4374   from = LGLYPH_FROM (glyph);
  4375   to = LGLYPH_TO (glyph);
  4376   if (from != 0 || to < from)
  4377     goto shaper_error;
  4378   for (i = 1; i < LGSTRING_GLYPH_LEN (gstring); i++)
  4379     {
  4380       glyph = LGSTRING_GLYPH (gstring, i);
  4381       if (NILP (glyph))
  4382         break;
  4383       if (! (LGLYPH_FROM (glyph) <= LGLYPH_TO (glyph)
  4384              && (LGLYPH_FROM (glyph) == from
  4385                  ? LGLYPH_TO (glyph) == to
  4386                  : LGLYPH_FROM (glyph) == to + 1)))
  4387         goto shaper_error;
  4388       from = LGLYPH_FROM (glyph);
  4389       to = LGLYPH_TO (glyph);
  4390     }
  4391   composition_gstring_adjust_zero_width (gstring);
  4392   return composition_gstring_put_cache (gstring, XFIXNUM (n));
  4393 
  4394  shaper_error:
  4395   return Qnil;
  4396 }
  4397 
  4398 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
  4399        2, 2, 0,
  4400        doc: /* Return a list of variation glyphs for CHARACTER in FONT-OBJECT.
  4401 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
  4402 where
  4403   VARIATION-SELECTOR is a character code of variation selector
  4404     (#xFE00..#xFE0F or #xE0100..#xE01EF).
  4405   GLYPH-ID is a glyph code of the corresponding variation glyph, an integer.  */)
  4406   (Lisp_Object font_object, Lisp_Object character)
  4407 {
  4408   unsigned variations[256];
  4409   struct font *font;
  4410   int i, n;
  4411   Lisp_Object val;
  4412 
  4413   CHECK_FONT_OBJECT (font_object);
  4414   CHECK_CHARACTER (character);
  4415   font = XFONT_OBJECT (font_object);
  4416   if (! font->driver->get_variation_glyphs)
  4417     return Qnil;
  4418   n = font->driver->get_variation_glyphs (font, XFIXNUM (character), variations);
  4419   if (! n)
  4420     return Qnil;
  4421   val = Qnil;
  4422   for (i = 0; i < 255; i++)
  4423     if (variations[i])
  4424       {
  4425         int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
  4426         Lisp_Object code = INT_TO_INTEGER (variations[i]);
  4427         val = Fcons (Fcons (make_fixnum (vs), code), val);
  4428       }
  4429   return val;
  4430 }
  4431 
  4432 /* Return a description of the font at POSITION in the current buffer.
  4433    If the 2nd optional arg CH is non-nil, it is a character to check
  4434    the font instead of the character at POSITION.
  4435 
  4436    For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
  4437    FONT-OBJECT is the font for the character at POSITION in the current
  4438    buffer.  This is computed from all the text properties and overlays
  4439    that apply to POSITION.  POSITION may be nil, in which case,
  4440    FONT-SPEC is the font for displaying the character CH with the
  4441    default face.  GLYPH-CODE is the glyph code in the font to use for
  4442    the character, it is a fixnum, if it is small enough, otherwise a
  4443    bignum.
  4444 
  4445    For a text terminal, return a nonnegative integer glyph code for
  4446    the character, or a negative integer if the character is not
  4447    displayable.  Terminal glyph codes are system-dependent integers
  4448    that represent displayable characters: for example, on a Linux x86
  4449    console they represent VGA code points.
  4450 
  4451    It returns nil in the following cases:
  4452 
  4453    (1) The window system doesn't have a font for the character (thus
  4454    it is displayed by an empty box).
  4455 
  4456    (2) The character code is invalid.
  4457 
  4458    (3) If POSITION is not nil, and the current buffer is not displayed
  4459    in any window.
  4460 
  4461    (4) For a text terminal, the terminal does not report glyph codes.
  4462 
  4463    In addition, the returned font name may not take into account of
  4464    such redisplay engine hooks as what used in jit-lock-mode if
  4465    POSITION is currently not visible.  */
  4466 
  4467 
  4468 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
  4469        doc: /* For internal use only.  */)
  4470   (Lisp_Object position, Lisp_Object ch)
  4471 {
  4472   ptrdiff_t pos, pos_byte, dummy;
  4473   int face_id;
  4474   int c;
  4475   struct frame *f;
  4476 
  4477   if (NILP (position))
  4478     {
  4479       CHECK_CHARACTER (ch);
  4480       c = XFIXNUM (ch);
  4481       f = XFRAME (selected_frame);
  4482       face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
  4483       pos = -1;
  4484     }
  4485   else
  4486     {
  4487       Lisp_Object window;
  4488       struct window *w;
  4489 
  4490       EMACS_INT fixed_pos = fix_position (position);
  4491       if (! (BEGV <= fixed_pos && fixed_pos < ZV))
  4492         args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
  4493       pos = fixed_pos;
  4494       pos_byte = CHAR_TO_BYTE (pos);
  4495       if (NILP (ch))
  4496         c = FETCH_CHAR (pos_byte);
  4497       else
  4498         {
  4499           CHECK_FIXNAT (ch);
  4500           c = XFIXNUM (ch);
  4501         }
  4502       window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
  4503       if (NILP (window))
  4504         return Qnil;
  4505       w = XWINDOW (window);
  4506       f = XFRAME (w->frame);
  4507       face_id = face_at_buffer_position (w, pos, &dummy,
  4508                                          pos + 100, false, -1, 0);
  4509     }
  4510   if (! CHAR_VALID_P (c))
  4511     return Qnil;
  4512 
  4513   if (! FRAME_WINDOW_P (f))
  4514     return terminal_glyph_code (FRAME_TERMINAL (f), c);
  4515 
  4516   /* We need the basic faces to be valid below, so recompute them if
  4517      some code just happened to clear the face cache.  */
  4518   if (FRAME_FACE_CACHE (f)->used == 0)
  4519     recompute_basic_faces (f);
  4520 
  4521   face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
  4522   struct face *face = FACE_FROM_ID (f, face_id);
  4523   if (! face->font)
  4524     return Qnil;
  4525   unsigned code = face->font->driver->encode_char (face->font, c);
  4526   if (code == FONT_INVALID_CODE)
  4527     return Qnil;
  4528   Lisp_Object font_object;
  4529   XSETFONT (font_object, face->font);
  4530   return Fcons (font_object, INT_TO_INTEGER (code));
  4531 }
  4532 
  4533 
  4534 /* This part (through the next ^L) is still experimental and not
  4535    tested much.  We may drastically change codes.  */
  4536 
  4537 /* This code implements support for extracting OTF features of a font
  4538    and exposing them to Lisp, including application of those features
  4539    to arbitrary stretches of text.  FIXME: it would be good to finish
  4540    this work and have this in Emacs.  */
  4541 
  4542 /* OTF handler.  */
  4543 
  4544 #if 0
  4545 
  4546 #define LGSTRING_HEADER_SIZE 6
  4547 #define LGSTRING_GLYPH_SIZE 8
  4548 
  4549 static int
  4550 check_gstring (Lisp_Object gstring)
  4551 {
  4552   Lisp_Object val;
  4553   ptrdiff_t i;
  4554   int j;
  4555 
  4556   CHECK_VECTOR (gstring);
  4557   val = AREF (gstring, 0);
  4558   CHECK_VECTOR (val);
  4559   if (ASIZE (val) < LGSTRING_HEADER_SIZE)
  4560     goto err;
  4561   CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
  4562   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
  4563     CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
  4564   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
  4565     CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
  4566   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
  4567     CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
  4568   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
  4569     CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
  4570   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
  4571     CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
  4572 
  4573   for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
  4574     {
  4575       val = LGSTRING_GLYPH (gstring, i);
  4576       CHECK_VECTOR (val);
  4577       if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
  4578         goto err;
  4579       if (NILP (AREF (val, LGLYPH_IX_CHAR)))
  4580         break;
  4581       CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
  4582       CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
  4583       CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
  4584       if (!NILP (AREF (val, LGLYPH_IX_CODE)))
  4585         CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
  4586       if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
  4587         CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
  4588       if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
  4589         {
  4590           val = AREF (val, LGLYPH_IX_ADJUSTMENT);
  4591           CHECK_VECTOR (val);
  4592           if (ASIZE (val) < 3)
  4593             goto err;
  4594           for (j = 0; j < 3; j++)
  4595             CHECK_FIXNUM (AREF (val, j));
  4596         }
  4597     }
  4598   return i;
  4599  err:
  4600   error ("Invalid glyph-string format");
  4601   return -1;
  4602 }
  4603 
  4604 static void
  4605 check_otf_features (Lisp_Object otf_features)
  4606 {
  4607   Lisp_Object val;
  4608 
  4609   CHECK_CONS (otf_features);
  4610   CHECK_SYMBOL (XCAR (otf_features));
  4611   otf_features = XCDR (otf_features);
  4612   CHECK_CONS (otf_features);
  4613   CHECK_SYMBOL (XCAR (otf_features));
  4614   otf_features = XCDR (otf_features);
  4615   for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
  4616     {
  4617       CHECK_SYMBOL (XCAR (val));
  4618       if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
  4619         error ("Invalid OTF GSUB feature: %s",
  4620                SDATA (SYMBOL_NAME (XCAR (val))));
  4621     }
  4622   otf_features = XCDR (otf_features);
  4623   for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
  4624     {
  4625       CHECK_SYMBOL (XCAR (val));
  4626       if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
  4627         error ("Invalid OTF GPOS feature: %s",
  4628                SDATA (SYMBOL_NAME (XCAR (val))));
  4629     }
  4630 }
  4631 
  4632 #ifdef HAVE_LIBOTF
  4633 #include <otf.h>
  4634 
  4635 Lisp_Object otf_list;
  4636 
  4637 static Lisp_Object
  4638 otf_tag_symbol (OTF_Tag tag)
  4639 {
  4640   char name[5];
  4641 
  4642   OTF_tag_name (tag, name);
  4643   return Fintern (make_unibyte_string (name, 4), Qnil);
  4644 }
  4645 
  4646 static OTF *
  4647 otf_open (Lisp_Object file)
  4648 {
  4649   Lisp_Object val = Fassoc (file, otf_list, Qnil);
  4650   OTF *otf;
  4651 
  4652   if (! NILP (val))
  4653     otf = xmint_pointer (XCDR (val));
  4654   else
  4655     {
  4656       otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
  4657       val = make_mint_ptr (otf);
  4658       otf_list = Fcons (Fcons (file, val), otf_list);
  4659     }
  4660   return otf;
  4661 }
  4662 
  4663 
  4664 /* Return a list describing which scripts/languages FONT supports by
  4665    which GSUB/GPOS features of OpenType tables.  See the comment of
  4666    (struct font_driver).otf_capability.  */
  4667 
  4668 Lisp_Object
  4669 font_otf_capability (struct font *font)
  4670 {
  4671   OTF *otf;
  4672   Lisp_Object capability = Fcons (Qnil, Qnil);
  4673   int i;
  4674 
  4675   otf = otf_open (font->props[FONT_FILE_INDEX]);
  4676   if (! otf)
  4677     return Qnil;
  4678   for (i = 0; i < 2; i++)
  4679     {
  4680       OTF_GSUB_GPOS *gsub_gpos;
  4681       Lisp_Object script_list = Qnil;
  4682       int j;
  4683 
  4684       if (OTF_get_features (otf, i == 0) < 0)
  4685         continue;
  4686       gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
  4687       for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
  4688         {
  4689           OTF_Script *script = gsub_gpos->ScriptList.Script + j;
  4690           Lisp_Object langsys_list = Qnil;
  4691           Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
  4692           int k;
  4693 
  4694           for (k = script->LangSysCount; k >= 0; k--)
  4695             {
  4696               OTF_LangSys *langsys;
  4697               Lisp_Object feature_list = Qnil;
  4698               Lisp_Object langsys_tag;
  4699               int l;
  4700 
  4701               if (k == script->LangSysCount)
  4702                 {
  4703                   langsys = &script->DefaultLangSys;
  4704                   langsys_tag = Qnil;
  4705                 }
  4706               else
  4707                 {
  4708                   langsys = script->LangSys + k;
  4709                   langsys_tag
  4710                     = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
  4711                 }
  4712               for (l = langsys->FeatureCount - 1; l >= 0; l--)
  4713                 {
  4714                   OTF_Feature *feature
  4715                     = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
  4716                   Lisp_Object feature_tag
  4717                     = otf_tag_symbol (feature->FeatureTag);
  4718 
  4719                   feature_list = Fcons (feature_tag, feature_list);
  4720                 }
  4721               langsys_list = Fcons (Fcons (langsys_tag, feature_list),
  4722                                     langsys_list);
  4723             }
  4724           script_list = Fcons (Fcons (script_tag, langsys_list),
  4725                                script_list);
  4726         }
  4727 
  4728       if (i == 0)
  4729         XSETCAR (capability, script_list);
  4730       else
  4731         XSETCDR (capability, script_list);
  4732     }
  4733 
  4734   return capability;
  4735 }
  4736 
  4737 /* Parse OTF features in SPEC and write a proper features spec string
  4738    in FEATURES for the call of OTF_drive_gsub/gpos (of libotf).  It is
  4739    assured that the sufficient memory has already allocated for
  4740    FEATURES.  */
  4741 
  4742 static void
  4743 generate_otf_features (Lisp_Object spec, char *features)
  4744 {
  4745   Lisp_Object val;
  4746   char *p;
  4747   bool asterisk;
  4748 
  4749   p = features;
  4750   *p = '\0';
  4751   for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
  4752     {
  4753       val = XCAR (spec);
  4754       CHECK_SYMBOL (val);
  4755       if (p > features)
  4756         *p++ = ',';
  4757       if (SREF (SYMBOL_NAME (val), 0) == '*')
  4758         {
  4759           asterisk = 1;
  4760           *p++ = '*';
  4761         }
  4762       else if (! asterisk)
  4763         {
  4764           val = SYMBOL_NAME (val);
  4765           p += esprintf (p, "%s", SDATA (val));
  4766         }
  4767       else
  4768         {
  4769           val = SYMBOL_NAME (val);
  4770           p += esprintf (p, "~%s", SDATA (val));
  4771         }
  4772     }
  4773   if (CONSP (spec))
  4774     error ("OTF spec too long");
  4775 }
  4776 
  4777 Lisp_Object
  4778 font_otf_DeviceTable (OTF_DeviceTable *device_table)
  4779 {
  4780   int len = device_table->StartSize - device_table->EndSize + 1;
  4781 
  4782   return Fcons (make_fixnum (len),
  4783                 make_unibyte_string (device_table->DeltaValue, len));
  4784 }
  4785 
  4786 Lisp_Object
  4787 font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
  4788 {
  4789   Lisp_Object val = make_nil_vector (8);
  4790 
  4791   if (value_format & OTF_XPlacement)
  4792     ASET (val, 0, make_fixnum (value_record->XPlacement));
  4793   if (value_format & OTF_YPlacement)
  4794     ASET (val, 1, make_fixnum (value_record->YPlacement));
  4795   if (value_format & OTF_XAdvance)
  4796     ASET (val, 2, make_fixnum (value_record->XAdvance));
  4797   if (value_format & OTF_YAdvance)
  4798     ASET (val, 3, make_fixnum (value_record->YAdvance));
  4799   if (value_format & OTF_XPlaDevice)
  4800     ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
  4801   if (value_format & OTF_YPlaDevice)
  4802     ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
  4803   if (value_format & OTF_XAdvDevice)
  4804     ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
  4805   if (value_format & OTF_YAdvDevice)
  4806     ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
  4807   return val;
  4808 }
  4809 
  4810 Lisp_Object
  4811 font_otf_Anchor (OTF_Anchor *anchor)
  4812 {
  4813   Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
  4814   ASET (val, 0, make_fixnum (anchor->XCoordinate));
  4815   ASET (val, 1, make_fixnum (anchor->YCoordinate));
  4816   if (anchor->AnchorFormat == 2)
  4817     ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
  4818   else
  4819     {
  4820       ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
  4821       ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
  4822     }
  4823   return val;
  4824 }
  4825 #endif  /* HAVE_LIBOTF */
  4826 
  4827 DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
  4828        doc: /* Apply OpenType features on glyph-string GSTRING-IN.
  4829 OTF-FEATURES specifies which features to apply in this format:
  4830   (SCRIPT LANGSYS GSUB GPOS)
  4831 where
  4832   SCRIPT is a symbol specifying a script tag of OpenType,
  4833   LANGSYS is a symbol specifying a langsys tag of OpenType,
  4834   GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
  4835 
  4836 If LANGSYS is nil, the default langsys is selected.
  4837 
  4838 The features are applied in the order they appear in the list.  The
  4839 symbol `*' means to apply all available features not present in this
  4840 list, and the remaining features are ignored.  For instance, (vatu
  4841 pstf * haln) is to apply vatu and pstf in this order, then to apply
  4842 all available features other than vatu, pstf, and haln.
  4843 
  4844 The features are applied to the glyphs in the range FROM and TO of
  4845 the glyph-string GSTRING-IN.
  4846 
  4847 If some feature is actually applicable, the resulting glyphs are
  4848 produced in the glyph-string GSTRING-OUT from the index INDEX.  In
  4849 this case, the value is the number of produced glyphs.
  4850 
  4851 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
  4852 the value is 0.
  4853 
  4854 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
  4855 produced in GSTRING-OUT, and the value is nil.
  4856 
  4857 See the documentation of `composition-get-gstring' for the format of
  4858 glyph-string.  */)
  4859   (Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object index)
  4860 {
  4861   Lisp_Object font_object = LGSTRING_FONT (gstring_in);
  4862   Lisp_Object val;
  4863   struct font *font;
  4864   int len, num;
  4865 
  4866   check_otf_features (otf_features);
  4867   CHECK_FONT_OBJECT (font_object);
  4868   font = XFONT_OBJECT (font_object);
  4869   if (! font->driver->otf_drive)
  4870     error ("Font backend %s can't drive OpenType GSUB table",
  4871            SDATA (SYMBOL_NAME (font->driver->type)));
  4872   CHECK_CONS (otf_features);
  4873   CHECK_SYMBOL (XCAR (otf_features));
  4874   val = XCDR (otf_features);
  4875   CHECK_SYMBOL (XCAR (val));
  4876   val = XCDR (otf_features);
  4877   if (! NILP (val))
  4878     CHECK_CONS (val);
  4879   len = check_gstring (gstring_in);
  4880   CHECK_VECTOR (gstring_out);
  4881   CHECK_FIXNAT (from);
  4882   CHECK_FIXNAT (to);
  4883   CHECK_FIXNAT (index);
  4884 
  4885   if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len)
  4886     args_out_of_range_3 (from, to, make_fixnum (len));
  4887   if (XFIXNUM (index) >= ASIZE (gstring_out))
  4888     args_out_of_range (index, make_fixnum (ASIZE (gstring_out)));
  4889   num = font->driver->otf_drive (font, otf_features,
  4890                                  gstring_in, XFIXNUM (from), XFIXNUM (to),
  4891                                  gstring_out, XFIXNUM (index), 0);
  4892   if (num < 0)
  4893     return Qnil;
  4894   return make_fixnum (num);
  4895 }
  4896 
  4897 DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
  4898        3, 3, 0,
  4899        doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
  4900 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
  4901 in this format:
  4902   (SCRIPT LANGSYS FEATURE ...)
  4903 See the documentation of `font-drive-otf' for more detail.
  4904 
  4905 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
  4906 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
  4907 character code corresponding to the glyph or nil if there's no
  4908 corresponding character.  */)
  4909   (Lisp_Object font_object, Lisp_Object character, Lisp_Object otf_features)
  4910 {
  4911   struct font *font = CHECK_FONT_GET_OBJECT (font_object);
  4912   Lisp_Object gstring_in, gstring_out, g;
  4913   Lisp_Object alternates;
  4914   int i, num;
  4915 
  4916   if (! font->driver->otf_drive)
  4917     error ("Font backend %s can't drive OpenType GSUB table",
  4918            SDATA (SYMBOL_NAME (font->driver->type)));
  4919   CHECK_CHARACTER (character);
  4920   CHECK_CONS (otf_features);
  4921 
  4922   gstring_in = Ffont_make_gstring (font_object, make_fixnum (1));
  4923   g = LGSTRING_GLYPH (gstring_in, 0);
  4924   LGLYPH_SET_CHAR (g, XFIXNUM (character));
  4925   gstring_out = Ffont_make_gstring (font_object, make_fixnum (10));
  4926   while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
  4927                                          gstring_out, 0, 1)) < 0)
  4928     gstring_out = Ffont_make_gstring (font_object,
  4929                                       make_fixnum (ASIZE (gstring_out) * 2));
  4930   alternates = Qnil;
  4931   for (i = 0; i < num; i++)
  4932     {
  4933       Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
  4934       int c = LGLYPH_CHAR (g);
  4935       unsigned code = LGLYPH_CODE (g);
  4936 
  4937       alternates = Fcons (Fcons (make_fixnum (code),
  4938                                  c > 0 ? make_fixnum (c) : Qnil),
  4939                           alternates);
  4940     }
  4941   return Fnreverse (alternates);
  4942 }
  4943 #endif  /* 0 */
  4944 
  4945 
  4946 #ifdef FONT_DEBUG
  4947 
  4948 DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
  4949        doc: /* Open FONT-ENTITY.  */)
  4950   (Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame)
  4951 {
  4952   intmax_t isize;
  4953   struct frame *f = decode_live_frame (frame);
  4954 
  4955   CHECK_FONT_ENTITY (font_entity);
  4956 
  4957   if (NILP (size))
  4958     isize = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX));
  4959   else
  4960     {
  4961       CHECK_NUMBER (size);
  4962       if (FLOATP (size))
  4963         isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f));
  4964       else if (! integer_to_intmax (size, &isize))
  4965         args_out_of_range (font_entity, size);
  4966       if (! (INT_MIN <= isize && isize <= INT_MAX))
  4967         args_out_of_range (font_entity, size);
  4968       if (isize == 0)
  4969         isize = 120;
  4970     }
  4971   return font_open_entity (f, font_entity, isize);
  4972 }
  4973 
  4974 DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
  4975        doc: /* Close FONT-OBJECT.  */)
  4976   (Lisp_Object font_object, Lisp_Object frame)
  4977 {
  4978   CHECK_FONT_OBJECT (font_object);
  4979   font_close_object (decode_live_frame (frame), font_object);
  4980   return Qnil;
  4981 }
  4982 
  4983 DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
  4984        doc: /* Return information about FONT-OBJECT.
  4985 The value is a vector:
  4986   [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
  4987     CAPABILITY ]
  4988 
  4989 NAME is the font name, a string (or nil if the font backend doesn't
  4990 provide a name).
  4991 
  4992 FILENAME is the font file name, a string (or nil if the font backend
  4993 doesn't provide a file name).
  4994 
  4995 PIXEL-SIZE is a pixel size by which the font is opened.
  4996 
  4997 SIZE is a maximum advance width of the font in pixels.
  4998 
  4999 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
  5000 pixels.
  5001 
  5002 CAPABILITY is a list whose first element is a symbol representing the
  5003 font format (x, opentype, truetype, type1, pcf, or bdf) and the
  5004 remaining elements describe the details of the font capability.
  5005 
  5006 If the font is OpenType font, the form of the list is
  5007   (opentype GSUB GPOS)
  5008 where GSUB shows which "GSUB" features the font supports, and GPOS
  5009 shows which "GPOS" features the font supports.  Both GSUB and GPOS are
  5010 lists of the format:
  5011   ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
  5012 
  5013 If the font is not OpenType font, currently the length of the form is
  5014 one.
  5015 
  5016 SCRIPT is a symbol representing OpenType script tag.
  5017 
  5018 LANGSYS is a symbol representing OpenType langsys tag, or nil
  5019 representing the default langsys.
  5020 
  5021 FEATURE is a symbol representing OpenType feature tag.
  5022 
  5023 If the font is not OpenType font, CAPABILITY is nil.  */)
  5024   (Lisp_Object font_object)
  5025 {
  5026   struct font *font = CHECK_FONT_GET_OBJECT (font_object);
  5027   return CALLN (Fvector,
  5028                 AREF (font_object, FONT_NAME_INDEX),
  5029                 AREF (font_object, FONT_FILE_INDEX),
  5030                 make_fixnum (font->pixel_size),
  5031                 make_fixnum (font->max_width),
  5032                 make_fixnum (font->ascent),
  5033                 make_fixnum (font->descent),
  5034                 make_fixnum (font->space_width),
  5035                 make_fixnum (font->average_width),
  5036                 (font->driver->otf_capability
  5037                  ? Fcons (Qopentype, font->driver->otf_capability (font))
  5038                  : Qnil));
  5039 }
  5040 
  5041 DEFUN ("font-has-char-p", Ffont_has_char_p, Sfont_has_char_p, 2, 3, 0,
  5042        doc:
  5043        /* Return non-nil if FONT on FRAME has a glyph for character CH.
  5044 FONT can be either a font-entity or a font-object.  If it is
  5045 a font-entity and the result is nil, it means the font needs to be
  5046 opened (with `open-font') to check.
  5047 FRAME defaults to the selected frame if it is nil or omitted.  */)
  5048   (Lisp_Object font, Lisp_Object ch, Lisp_Object frame)
  5049 {
  5050   struct frame *f;
  5051   CHECK_FONT (font);
  5052   CHECK_CHARACTER (ch);
  5053 
  5054   if (NILP (frame))
  5055     f = XFRAME (selected_frame);
  5056   else
  5057     {
  5058       CHECK_FRAME (frame);
  5059       f = XFRAME (frame);
  5060     }
  5061 
  5062   if (font_has_char (f, font, XFIXNAT (ch)) <= 0)
  5063     return Qnil;
  5064   else
  5065     return Qt;
  5066 }
  5067 
  5068 DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
  5069        doc:
  5070        /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
  5071 FROM and TO are positions (integers or markers) specifying a region
  5072 of the current buffer, and can be in either order.  If the optional
  5073 fourth arg OBJECT is not nil, it is a string or a vector containing
  5074 the target characters between indices FROM and TO, which are treated
  5075 as in `substring'.
  5076 
  5077 Each element is a vector containing information of a glyph in this format:
  5078   [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
  5079 where
  5080   FROM is an index numbers of a character the glyph corresponds to.
  5081   TO is the same as FROM.
  5082   C is the character of the glyph.
  5083   CODE is the glyph-code of C in FONT-OBJECT.
  5084   WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
  5085   ADJUSTMENT is always nil.
  5086 
  5087 If FONT-OBJECT doesn't have a glyph for a character, the corresponding
  5088 element is nil.
  5089 
  5090 Also see `font-has-char-p', which is more efficient than this function
  5091 if you just want to check whether FONT-OBJECT has a glyph for a
  5092 character.  */)
  5093   (Lisp_Object font_object, Lisp_Object from, Lisp_Object to,
  5094    Lisp_Object object)
  5095 {
  5096   struct font *font = CHECK_FONT_GET_OBJECT (font_object);
  5097   ptrdiff_t len;
  5098   Lisp_Object *chars;
  5099   USE_SAFE_ALLOCA;
  5100 
  5101   if (NILP (object))
  5102     {
  5103       ptrdiff_t charpos, bytepos;
  5104 
  5105       validate_region (&from, &to);
  5106       if (EQ (from, to))
  5107         return Qnil;
  5108       len = XFIXNAT (to) - XFIXNAT (from);
  5109       SAFE_ALLOCA_LISP (chars, len);
  5110       charpos = XFIXNAT (from);
  5111       bytepos = CHAR_TO_BYTE (charpos);
  5112       for (ptrdiff_t i = 0; charpos < XFIXNAT (to); i++)
  5113         {
  5114           int c = fetch_char_advance (&charpos, &bytepos);
  5115           chars[i] = make_fixnum (c);
  5116         }
  5117     }
  5118   else if (STRINGP (object))
  5119     {
  5120       const unsigned char *p;
  5121       ptrdiff_t ifrom, ito;
  5122 
  5123       validate_subarray (object, from, to, SCHARS (object), &ifrom, &ito);
  5124       if (ifrom == ito)
  5125         return Qnil;
  5126       len = ito - ifrom;
  5127       SAFE_ALLOCA_LISP (chars, len);
  5128       p = SDATA (object);
  5129       if (STRING_MULTIBYTE (object))
  5130         {
  5131           int c;
  5132 
  5133           /* Skip IFROM characters from the beginning.  */
  5134           for (ptrdiff_t i = 0; i < ifrom; i++)
  5135             p += BYTES_BY_CHAR_HEAD (*p);
  5136 
  5137           /* Now fetch an interesting characters.  */
  5138           for (ptrdiff_t i = 0; i < len; i++)
  5139             {
  5140               c = string_char_advance (&p);
  5141               chars[i] = make_fixnum (c);
  5142             }
  5143         }
  5144       else
  5145         for (ptrdiff_t i = 0; i < len; i++)
  5146           chars[i] = make_fixnum (p[ifrom + i]);
  5147     }
  5148   else if (VECTORP (object))
  5149     {
  5150       ptrdiff_t ifrom, ito;
  5151 
  5152       validate_subarray (object, from, to, ASIZE (object), &ifrom, &ito);
  5153       if (ifrom == ito)
  5154         return Qnil;
  5155       len = ito - ifrom;
  5156       for (ptrdiff_t i = 0; i < len; i++)
  5157         {
  5158           Lisp_Object elt = AREF (object, ifrom + i);
  5159           CHECK_CHARACTER (elt);
  5160         }
  5161       chars = aref_addr (object, ifrom);
  5162     }
  5163   else
  5164     wrong_type_argument (Qarrayp, object);
  5165 
  5166   Lisp_Object vec = make_nil_vector (len);
  5167   for (ptrdiff_t i = 0; i < len; i++)
  5168     {
  5169       Lisp_Object g;
  5170       int c = XFIXNAT (chars[i]);
  5171       unsigned code;
  5172       struct font_metrics metrics;
  5173 
  5174       code = font->driver->encode_char (font, c);
  5175       if (code == FONT_INVALID_CODE)
  5176         {
  5177           ASET (vec, i, Qnil);
  5178           continue;
  5179         }
  5180       g = LGLYPH_NEW ();
  5181       LGLYPH_SET_FROM (g, i);
  5182       LGLYPH_SET_TO (g, i);
  5183       LGLYPH_SET_CHAR (g, c);
  5184       LGLYPH_SET_CODE (g, code);
  5185       font->driver->text_extents (font, &code, 1, &metrics);
  5186       LGLYPH_SET_WIDTH (g, metrics.width);
  5187       LGLYPH_SET_LBEARING (g, metrics.lbearing);
  5188       LGLYPH_SET_RBEARING (g, metrics.rbearing);
  5189       LGLYPH_SET_ASCENT (g, metrics.ascent);
  5190       LGLYPH_SET_DESCENT (g, metrics.descent);
  5191       ASET (vec, i, g);
  5192     }
  5193   if (! VECTORP (object))
  5194     SAFE_FREE ();
  5195   return vec;
  5196 }
  5197 
  5198 DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
  5199        doc: /* Return t if and only if font-spec SPEC matches with FONT.
  5200 FONT is a font-spec, font-entity, or font-object. */)
  5201   (Lisp_Object spec, Lisp_Object font)
  5202 {
  5203   CHECK_FONT_SPEC (spec);
  5204   CHECK_FONT (font);
  5205 
  5206   return (font_match_p (spec, font) ? Qt : Qnil);
  5207 }
  5208 
  5209 DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
  5210        doc: /* Return a font-object for displaying a character at POSITION.
  5211 Optional second arg WINDOW, if non-nil, is a window displaying
  5212 the current buffer.  It defaults to the currently selected window.
  5213 Optional third arg STRING, if non-nil, is a string containing the target
  5214 character at index specified by POSITION.  */)
  5215   (Lisp_Object position, Lisp_Object window, Lisp_Object string)
  5216 {
  5217   struct window *w = decode_live_window (window);
  5218   EMACS_INT pos;
  5219 
  5220   if (NILP (string))
  5221     {
  5222       if (XBUFFER (w->contents) != current_buffer)
  5223         error ("Specified window is not displaying the current buffer");
  5224       pos = fix_position (position);
  5225       if (! (BEGV <= pos && pos < ZV))
  5226         args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
  5227     }
  5228   else
  5229     {
  5230       CHECK_FIXNUM (position);
  5231       CHECK_STRING (string);
  5232       pos = XFIXNUM (position);
  5233       if (! (0 <= pos && pos < SCHARS (string)))
  5234         args_out_of_range (string, position);
  5235     }
  5236 
  5237   return font_at (-1, pos, NULL, w, string);
  5238 }
  5239 
  5240 #if 0
  5241 DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
  5242        doc: /*  Draw STRING by FONT-OBJECT on the top left corner of the current frame.
  5243 The value is a number of glyphs drawn.
  5244 Type C-l to recover what previously shown.  */)
  5245   (Lisp_Object font_object, Lisp_Object string)
  5246 {
  5247   Lisp_Object frame = selected_frame;
  5248   struct frame *f = XFRAME (frame);
  5249   struct font *font;
  5250   struct face *face;
  5251   int i, len, width;
  5252   unsigned *code;
  5253 
  5254   CHECK_FONT_GET_OBJECT (font_object, font);
  5255   CHECK_STRING (string);
  5256   len = SCHARS (string);
  5257   code = alloca (sizeof (unsigned) * len);
  5258   for (i = 0; i < len; i++)
  5259     {
  5260       Lisp_Object ch = Faref (string, make_fixnum (i));
  5261       Lisp_Object val;
  5262       int c = XFIXNUM (ch);
  5263 
  5264       code[i] = font->driver->encode_char (font, c);
  5265       if (code[i] == FONT_INVALID_CODE)
  5266         break;
  5267     }
  5268   face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  5269   face->fontp = font;
  5270   if (font->driver->prepare_face)
  5271     font->driver->prepare_face (f, face);
  5272   width = font->driver->text_extents (font, code, i, NULL);
  5273   len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
  5274   if (font->driver->done_face)
  5275     font->driver->done_face (f, face);
  5276   face->fontp = NULL;
  5277   return make_fixnum (len);
  5278 }
  5279 #endif
  5280 
  5281 DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0,
  5282        doc: /* Return FRAME's font cache.  Mainly used for debugging.
  5283 If FRAME is omitted or nil, use the selected frame.  */)
  5284   (Lisp_Object frame)
  5285 {
  5286 #ifdef HAVE_WINDOW_SYSTEM
  5287   struct frame *f = decode_live_frame (frame);
  5288 
  5289   if (FRAME_WINDOW_P (f))
  5290     return FRAME_DISPLAY_INFO (f)->name_list_element;
  5291   else
  5292 #endif
  5293     return Qnil;
  5294 }
  5295 
  5296 #endif  /* FONT_DEBUG */
  5297 
  5298 #ifdef HAVE_WINDOW_SYSTEM
  5299 
  5300 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
  5301        doc: /* Return information about a font named NAME on frame FRAME.
  5302 If FRAME is omitted or nil, use the selected frame.
  5303 
  5304 The returned value is a vector of 14 elements:
  5305   [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
  5306     DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
  5307     FILENAME CAPABILITY ]
  5308 where
  5309   OPENED-NAME is the name used for opening the font,
  5310   FULL-NAME is the full name of the font,
  5311   SIZE is the pixelsize of the font,
  5312   HEIGHT is the pixel-height of the font (i.e., ascent + descent),
  5313   BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
  5314   RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
  5315     how to compose characters,
  5316   MAX-WIDTH is the maximum advance width of the font,
  5317   ASCENT, DESCENT, SPACE-WIDTH, and AVERAGE-WIDTH are metrics of
  5318     the font in pixels,
  5319   FILENAME is the font file name, a string (or nil if the font backend
  5320     doesn't provide a file name).
  5321   CAPABILITY is a list whose first element is a symbol representing the
  5322     font format, one of `x', `opentype', `truetype', `type1', `pcf', or `bdf'.
  5323     The remaining elements describe the details of the font capabilities,
  5324     as follows:
  5325 
  5326       If the font is OpenType font, the form of the list is
  5327         (opentype GSUB GPOS)
  5328       where GSUB shows which "GSUB" features the font supports, and GPOS
  5329       shows which "GPOS" features the font supports.  Both GSUB and GPOS are
  5330       lists of the form:
  5331         ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
  5332 
  5333       where
  5334         SCRIPT is a symbol representing OpenType script tag.
  5335         LANGSYS is a symbol representing OpenType langsys tag, or nil
  5336          representing the default langsys.
  5337         FEATURE is a symbol representing OpenType feature tag.
  5338 
  5339       If the font is not an OpenType font, there are no elements
  5340       in CAPABILITY except the font format symbol.
  5341 
  5342 If the named font cannot be opened and loaded, return nil.  */)
  5343   (Lisp_Object name, Lisp_Object frame)
  5344 {
  5345   struct frame *f;
  5346   struct font *font;
  5347   Lisp_Object info;
  5348   Lisp_Object font_object;
  5349 
  5350   if (! FONTP (name))
  5351     CHECK_STRING (name);
  5352   f = decode_window_system_frame (frame);
  5353 
  5354   if (STRINGP (name))
  5355     {
  5356       int fontset = fs_query_fontset (name, 0);
  5357 
  5358       if (fontset >= 0)
  5359         name = fontset_ascii (fontset);
  5360       font_object = font_open_by_name (f, name);
  5361     }
  5362   else if (FONT_OBJECT_P (name))
  5363     font_object = name;
  5364   else if (FONT_ENTITY_P (name))
  5365     font_object = font_open_entity (f, name, 0);
  5366   else
  5367     {
  5368       struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  5369       Lisp_Object entity = font_matching_entity (f, face->lface, name);
  5370 
  5371       font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
  5372     }
  5373   if (NILP (font_object))
  5374     return Qnil;
  5375   font = XFONT_OBJECT (font_object);
  5376 
  5377   /* Sanity check to make sure we have initialized max_width.  */
  5378   eassert (XFONT_OBJECT (font_object)->max_width < 1024 * 1024 * 1024);
  5379 
  5380   info = CALLN (Fvector,
  5381                 AREF (font_object, FONT_NAME_INDEX),
  5382                 AREF (font_object, FONT_FULLNAME_INDEX),
  5383                 make_fixnum (font->pixel_size),
  5384                 make_fixnum (font->height),
  5385                 make_fixnum (font->baseline_offset),
  5386                 make_fixnum (font->relative_compose),
  5387                 make_fixnum (font->default_ascent),
  5388                 make_fixnum (font->max_width),
  5389                 make_fixnum (font->ascent),
  5390                 make_fixnum (font->descent),
  5391                 make_fixnum (font->space_width),
  5392                 make_fixnum (font->average_width),
  5393                 AREF (font_object, FONT_FILE_INDEX),
  5394                 (font->driver->otf_capability
  5395                  ? Fcons (Qopentype, font->driver->otf_capability (font))
  5396                  : Qnil));
  5397 
  5398 #if 0
  5399   /* As font_object is still in FONT_OBJLIST of the entity, we can't
  5400      close it now.  Perhaps, we should manage font-objects
  5401      by `reference-count'.  */
  5402   font_close_object (f, font_object);
  5403 #endif
  5404   return info;
  5405 }
  5406 #endif
  5407 
  5408 
  5409 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
  5410 
  5411 static Lisp_Object
  5412 build_style_table (const struct table_entry *entry, int nelement)
  5413 {
  5414   Lisp_Object table = make_nil_vector (nelement);
  5415   for (int i = 0; i < nelement; i++)
  5416     {
  5417       int j;
  5418       for (j = 0; entry[i].names[j]; j++)
  5419         continue;
  5420       Lisp_Object elt = make_nil_vector (j + 1);
  5421       ASET (elt, 0, make_fixnum (entry[i].numeric));
  5422       for (j = 0; entry[i].names[j]; j++)
  5423         ASET (elt, j + 1, intern_c_string (entry[i].names[j]));
  5424       ASET (table, i, elt);
  5425     }
  5426   return table;
  5427 }
  5428 
  5429 /* The deferred font-log data of the form [ACTION ARG RESULT].
  5430    If ACTION is not nil, that is added to the log when font_add_log is
  5431    called next time.  At that time, ACTION is set back to nil.  */
  5432 static Lisp_Object Vfont_log_deferred;
  5433 
  5434 /* Prepend the font-related logging data in Vfont_log if it is not
  5435    t.  ACTION describes a kind of font-related action (e.g. listing,
  5436    opening), ARG is the argument for the action, and RESULT is the
  5437    result of the action.  */
  5438 void
  5439 font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
  5440 {
  5441   Lisp_Object val;
  5442   int i;
  5443 
  5444   if (EQ (Vfont_log, Qt))
  5445     return;
  5446   if (STRINGP (AREF (Vfont_log_deferred, 0)))
  5447     {
  5448       char *str = SSDATA (AREF (Vfont_log_deferred, 0));
  5449 
  5450       ASET (Vfont_log_deferred, 0, Qnil);
  5451       font_add_log (str, AREF (Vfont_log_deferred, 1),
  5452                     AREF (Vfont_log_deferred, 2));
  5453     }
  5454 
  5455   if (FONTP (arg))
  5456     {
  5457       Lisp_Object tail, elt;
  5458       AUTO_STRING (equal, "=");
  5459 
  5460       val = Ffont_xlfd_name (arg, Qt);
  5461       for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
  5462            tail = XCDR (tail))
  5463         {
  5464           elt = XCAR (tail);
  5465           if (EQ (XCAR (elt), QCscript)
  5466               && SYMBOLP (XCDR (elt)))
  5467             val = concat3 (val, SYMBOL_NAME (QCscript),
  5468                            concat2 (equal, SYMBOL_NAME (XCDR (elt))));
  5469           else if (EQ (XCAR (elt), QClang)
  5470                    && SYMBOLP (XCDR (elt)))
  5471             val = concat3 (val, SYMBOL_NAME (QClang),
  5472                            concat2 (equal, SYMBOL_NAME (XCDR (elt))));
  5473           else if (EQ (XCAR (elt), QCotf)
  5474                    && CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
  5475             val = concat3 (val, SYMBOL_NAME (QCotf),
  5476                            concat2 (equal, SYMBOL_NAME (XCAR (XCDR (elt)))));
  5477         }
  5478       arg = val;
  5479     }
  5480 
  5481   if (CONSP (result)
  5482       && VECTORP (XCAR (result))
  5483       && ASIZE (XCAR (result)) > 0
  5484       && FONTP (AREF (XCAR (result), 0)))
  5485     result = font_vconcat_entity_vectors (result);
  5486   if (FONTP (result))
  5487     {
  5488       val = Ffont_xlfd_name (result, Qt);
  5489       if (! FONT_SPEC_P (result))
  5490         {
  5491           AUTO_STRING (colon, ":");
  5492           val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
  5493                          colon, val);
  5494         }
  5495       result = val;
  5496     }
  5497   else if (CONSP (result))
  5498     {
  5499       Lisp_Object tail;
  5500       result = Fcopy_sequence (result);
  5501       for (tail = result; CONSP (tail); tail = XCDR (tail))
  5502         {
  5503           val = XCAR (tail);
  5504           if (FONTP (val))
  5505             val = Ffont_xlfd_name (val, Qt);
  5506           XSETCAR (tail, val);
  5507         }
  5508     }
  5509   else if (VECTORP (result))
  5510     {
  5511       result = Fcopy_sequence (result);
  5512       for (i = 0; i < ASIZE (result); i++)
  5513         {
  5514           val = AREF (result, i);
  5515           if (FONTP (val))
  5516             val = Ffont_xlfd_name (val, Qt);
  5517           ASET (result, i, val);
  5518         }
  5519     }
  5520   Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
  5521 }
  5522 
  5523 /* Record a font-related logging data to be added to Vfont_log when
  5524    font_add_log is called next time.  ACTION, ARG, RESULT are the same
  5525    as font_add_log.  */
  5526 
  5527 void
  5528 font_deferred_log (const char *action, Lisp_Object arg, Lisp_Object result)
  5529 {
  5530   if (EQ (Vfont_log, Qt))
  5531     return;
  5532   ASET (Vfont_log_deferred, 0, build_string (action));
  5533   ASET (Vfont_log_deferred, 1, arg);
  5534   ASET (Vfont_log_deferred, 2, result);
  5535 }
  5536 
  5537 void
  5538 font_drop_xrender_surfaces (struct frame *f)
  5539 {
  5540   struct font_driver_list *list;
  5541 
  5542   for (list = f->font_driver_list; list; list = list->next)
  5543     if (list->on && list->driver->drop_xrender_surfaces)
  5544       list->driver->drop_xrender_surfaces (f);
  5545 }
  5546 
  5547 void
  5548 syms_of_font (void)
  5549 {
  5550   sort_shift_bits[FONT_TYPE_INDEX] = 0;
  5551   sort_shift_bits[FONT_SLANT_INDEX] = 2;
  5552   sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
  5553   sort_shift_bits[FONT_SIZE_INDEX] = 16;
  5554   sort_shift_bits[FONT_WIDTH_INDEX] = 23;
  5555   /* Note that the other elements in sort_shift_bits are not used.  */
  5556   PDUMPER_REMEMBER_SCALAR (sort_shift_bits);
  5557 
  5558   font_charset_alist = Qnil;
  5559   staticpro (&font_charset_alist);
  5560 
  5561   DEFSYM (Qopentype, "opentype");
  5562 
  5563   /* Currently used by hbfont.c, which has no syms_of_hbfont function
  5564      of its own.  */
  5565   DEFSYM (Qcanonical_combining_class, "canonical-combining-class");
  5566 
  5567   /* Important character set symbols.  */
  5568   DEFSYM (Qascii_0, "ascii-0");
  5569   DEFSYM (Qiso8859_1, "iso8859-1");
  5570   DEFSYM (Qiso10646_1, "iso10646-1");
  5571   DEFSYM (Qunicode_bmp, "unicode-bmp");
  5572   DEFSYM (Qemoji, "emoji");
  5573 
  5574   /* Symbols representing keys of font extra info.  */
  5575   DEFSYM (QCotf, ":otf");
  5576   DEFSYM (QClang, ":lang");
  5577   DEFSYM (QCscript, ":script");
  5578   DEFSYM (QCantialias, ":antialias");
  5579   DEFSYM (QCfoundry, ":foundry");
  5580   DEFSYM (QCadstyle, ":adstyle");
  5581   DEFSYM (QCregistry, ":registry");
  5582   DEFSYM (QCspacing, ":spacing");
  5583   DEFSYM (QCdpi, ":dpi");
  5584   DEFSYM (QCscalable, ":scalable");
  5585   DEFSYM (QCavgwidth, ":avgwidth");
  5586   DEFSYM (QCfont_entity, ":font-entity");
  5587   DEFSYM (QCcombining_capability, ":combining-capability");
  5588 
  5589   /* Symbols representing values of font spacing property.  */
  5590   DEFSYM (Qc, "c");
  5591   DEFSYM (Qm, "m");
  5592   DEFSYM (Qp, "p");
  5593   DEFSYM (Qd, "d");
  5594 
  5595   /* Special ADSTYLE properties to avoid fonts used for Latin
  5596      characters; used in xfont.c and ftfont.c.  */
  5597   DEFSYM (Qja, "ja");
  5598   DEFSYM (Qko, "ko");
  5599 
  5600   DEFSYM (QCuser_spec, ":user-spec");
  5601 
  5602   /* For shapers that need to know text directionality.  */
  5603   DEFSYM (QL2R, "L2R");
  5604   DEFSYM (QR2L, "R2L");
  5605 
  5606   DEFSYM (Qfont_extra_type, "font-extra-type");
  5607   DEFSYM (Qfont_driver_superseded_by, "font-driver-superseded-by");
  5608 
  5609   scratch_font_spec = Ffont_spec (0, NULL);
  5610   staticpro (&scratch_font_spec);
  5611   scratch_font_prefer = Ffont_spec (0, NULL);
  5612   staticpro (&scratch_font_prefer);
  5613 
  5614   Vfont_log_deferred = make_nil_vector (3);
  5615   staticpro (&Vfont_log_deferred);
  5616 
  5617 #if 0
  5618 #ifdef HAVE_LIBOTF
  5619   staticpro (&otf_list);
  5620   otf_list = Qnil;
  5621 #endif  /* HAVE_LIBOTF */
  5622 #endif  /* 0 */
  5623 
  5624   defsubr (&Sfontp);
  5625   defsubr (&Sfont_spec);
  5626   defsubr (&Sfont_get);
  5627 #ifdef HAVE_WINDOW_SYSTEM
  5628   defsubr (&Sfont_face_attributes);
  5629 #endif
  5630   defsubr (&Sfont_put);
  5631   defsubr (&Slist_fonts);
  5632   defsubr (&Sfont_family_list);
  5633   defsubr (&Sfind_font);
  5634   defsubr (&Sfont_xlfd_name);
  5635   defsubr (&Sclear_font_cache);
  5636   defsubr (&Sfont_shape_gstring);
  5637   defsubr (&Sfont_variation_glyphs);
  5638   defsubr (&Sinternal_char_font);
  5639 #if 0
  5640   defsubr (&Sfont_drive_otf);
  5641   defsubr (&Sfont_otf_alternates);
  5642 #endif  /* 0 */
  5643 
  5644 #ifdef FONT_DEBUG
  5645   defsubr (&Sopen_font);
  5646   defsubr (&Sclose_font);
  5647   defsubr (&Squery_font);
  5648   defsubr (&Sfont_get_glyphs);
  5649   defsubr (&Sfont_has_char_p);
  5650   defsubr (&Sfont_match_p);
  5651   defsubr (&Sfont_at);
  5652 #if 0
  5653   defsubr (&Sdraw_string);
  5654 #endif
  5655   defsubr (&Sframe_font_cache);
  5656 #endif  /* FONT_DEBUG */
  5657 #ifdef HAVE_WINDOW_SYSTEM
  5658   defsubr (&Sfont_info);
  5659 #endif
  5660 
  5661   DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist,
  5662                doc: /*
  5663 Alist of fontname patterns vs the corresponding encoding and repertory info.
  5664 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
  5665 where ENCODING is a charset or a char-table,
  5666 and REPERTORY is a charset, a char-table, or nil.
  5667 
  5668 If ENCODING and REPERTORY are the same, the element can have the form
  5669 \(REGEXP . ENCODING).
  5670 
  5671 ENCODING is for converting a character to a glyph code of the font.
  5672 If ENCODING is a charset, encoding a character by the charset gives
  5673 the corresponding glyph code.  If ENCODING is a char-table, looking up
  5674 the table by a character gives the corresponding glyph code.
  5675 
  5676 REPERTORY specifies a repertory of characters supported by the font.
  5677 If REPERTORY is a charset, all characters belonging to the charset are
  5678 supported.  If REPERTORY is a char-table, all characters who have a
  5679 non-nil value in the table are supported.  If REPERTORY is nil, Emacs
  5680 gets the repertory information by an opened font and ENCODING.  */);
  5681   Vfont_encoding_alist = Qnil;
  5682 
  5683   /* FIXME: These 3 vars are not quite what they appear: setq on them
  5684      won't have any effect other than disconnect them from the style
  5685      table used by the font display code.  So we make them read-only,
  5686      to avoid this confusing situation.  */
  5687 
  5688   DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table,
  5689                doc: /*  Vector of valid font weight values.
  5690 Each element has the form:
  5691     [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
  5692 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols.
  5693 This variable cannot be set; trying to do so will signal an error.  */);
  5694   Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
  5695   make_symbol_constant (intern_c_string ("font-weight-table"));
  5696 
  5697   DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table,
  5698                doc: /*  Vector of font slant symbols vs the corresponding numeric values.
  5699 See `font-weight-table' for the format of the vector.
  5700 This variable cannot be set; trying to do so will signal an error.  */);
  5701   Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
  5702   make_symbol_constant (intern_c_string ("font-slant-table"));
  5703 
  5704   DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table,
  5705                doc: /*  Alist of font width symbols vs the corresponding numeric values.
  5706 See `font-weight-table' for the format of the vector.
  5707 This variable cannot be set; trying to do so will signal an error.  */);
  5708   Vfont_width_table = BUILD_STYLE_TABLE (width_table);
  5709   make_symbol_constant (intern_c_string ("font-width-table"));
  5710 
  5711   staticpro (&font_style_table);
  5712   font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table,
  5713                             Vfont_width_table);
  5714 
  5715   DEFVAR_LISP ("font-log", Vfont_log, doc: /*
  5716 A list that logs font-related actions and results, for debugging.
  5717 The default value is t, which means to suppress logging.
  5718 Set it to nil to enable logging.  If the environment variable
  5719 EMACS_FONT_LOG is set at startup, it defaults to nil.  */);
  5720   Vfont_log = Qnil;
  5721 
  5722   DEFVAR_BOOL ("inhibit-compacting-font-caches", inhibit_compacting_font_caches,
  5723                doc: /*
  5724 If non-nil, don't compact font caches during GC.
  5725 Some large fonts cause lots of consing and trigger GC.  If they
  5726 are removed from the font caches, they will need to be opened
  5727 again during redisplay, which slows down redisplay.  If you
  5728 see font-related delays in displaying some special characters,
  5729 and cannot switch to a smaller font for those characters, set
  5730 this variable non-nil.
  5731 Disabling compaction of font caches might enlarge the Emacs memory
  5732 footprint in sessions that use lots of different fonts.  */);
  5733 
  5734 #ifdef WINDOWSNT
  5735   /* Compacting font caches causes slow redisplay on Windows with many
  5736      large fonts, so we disable it by default.  */
  5737   inhibit_compacting_font_caches = 1;
  5738 #else
  5739   inhibit_compacting_font_caches = 0;
  5740 #endif
  5741 
  5742   DEFVAR_BOOL ("xft-ignore-color-fonts",
  5743                xft_ignore_color_fonts,
  5744                doc: /*
  5745 Non-nil means don't query fontconfig for color fonts, since they often
  5746 cause Xft crashes.  Only has an effect in Xft builds.  */);
  5747   xft_ignore_color_fonts = true;
  5748 
  5749   DEFVAR_BOOL ("query-all-font-backends", query_all_font_backends,
  5750                doc: /*
  5751 If non-nil, attempt to query all available font backends.
  5752 By default Emacs will stop searching for a matching font at the first
  5753 match.  */);
  5754   query_all_font_backends = false;
  5755 
  5756 #ifdef HAVE_WINDOW_SYSTEM
  5757 #ifdef HAVE_FREETYPE
  5758   syms_of_ftfont ();
  5759 #ifdef HAVE_X_WINDOWS
  5760   syms_of_xfont ();
  5761 #ifdef USE_CAIRO
  5762   syms_of_ftcrfont ();
  5763 #else
  5764 #ifdef HAVE_XFT
  5765   syms_of_xftfont ();
  5766 #endif  /* HAVE_XFT */
  5767 #endif  /* not USE_CAIRO */
  5768 #else   /* not HAVE_X_WINDOWS */
  5769 #ifdef USE_CAIRO
  5770   syms_of_ftcrfont ();
  5771 #endif
  5772 #endif  /* not HAVE_X_WINDOWS */
  5773 #else   /* not HAVE_FREETYPE */
  5774 #ifdef HAVE_X_WINDOWS
  5775   syms_of_xfont ();
  5776 #endif  /* HAVE_X_WINDOWS */
  5777 #endif  /* not HAVE_FREETYPE */
  5778 #ifdef HAVE_BDFFONT
  5779   syms_of_bdffont ();
  5780 #endif  /* HAVE_BDFFONT */
  5781 #ifdef HAVE_NTGUI
  5782   syms_of_w32font ();
  5783 #endif  /* HAVE_NTGUI */
  5784 #ifdef USE_BE_CAIRO
  5785   syms_of_ftcrfont ();
  5786 #endif
  5787 #endif  /* HAVE_WINDOW_SYSTEM */
  5788 }
  5789 
  5790 void
  5791 init_font (void)
  5792 {
  5793   Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
  5794 }