src/font.c

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

DEFINITIONS
