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               if (fast_string_match_ignore_case (XCAR (elt), name) >= 0)
  1883                 return XFLOAT_DATA (XCDR (elt));
  1884             }
  1885           else if (FONT_SPEC_P (XCAR (elt)))
  1886             {
  1887               if (font_match_p (XCAR (elt), font_entity))
  1888                 return XFLOAT_DATA (XCDR (elt));
  1889             }
  1890         }
  1891     }
  1892   return 1.0;
  1893 }
  1894 
  1895 /* We sort fonts by scoring each of them against a specified
  1896    font-spec.  The score value is 32 bit (`unsigned'), and the smaller
  1897    the value is, the closer the font is to the font-spec.
  1898 
  1899    The lowest 2 bits of the score are used for driver type.  The font
  1900    available by the most preferred font driver is 0.
  1901 
  1902    The 4 7-bit fields in the higher 28 bits are used for numeric properties
  1903    WEIGHT, SLANT, WIDTH, and SIZE.  */
  1904 
  1905 /* How many bits to shift to store the difference value of each font
  1906    property in a score.  Note that floats for FONT_TYPE_INDEX and
  1907    FONT_REGISTRY_INDEX are not used.  */
  1908 static int sort_shift_bits[FONT_SIZE_INDEX + 1];
  1909 
  1910 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
  1911    The return value indicates how different ENTITY is compared with
  1912    SPEC_PROP.  */
  1913 
  1914 static unsigned
  1915 font_score (Lisp_Object entity, Lisp_Object *spec_prop)
  1916 {
  1917   unsigned score = 0;
  1918   int i;
  1919 
  1920   /* Score three style numeric fields.  Maximum difference is 127. */
  1921   for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
  1922     if (! NILP (spec_prop[i])
  1923         && ! EQ (AREF (entity, i), spec_prop[i])
  1924         && FIXNUMP (AREF (entity, i)))
  1925       {
  1926         EMACS_INT diff = ((XFIXNUM (AREF (entity, i)) >> 8)
  1927                           - (XFIXNUM (spec_prop[i]) >> 8));
  1928         score |= min (eabs (diff), 127) << sort_shift_bits[i];
  1929       }
  1930 
  1931   /* Score the size.  Maximum difference is 127.  */
  1932   if (! NILP (spec_prop[FONT_SIZE_INDEX])
  1933       && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
  1934     {
  1935       /* We use the higher 6-bit for the actual size difference.  The
  1936          lowest bit is set if the DPI is different.  */
  1937       EMACS_INT diff;
  1938       EMACS_INT pixel_size = XFIXNUM (spec_prop[FONT_SIZE_INDEX]);
  1939       EMACS_INT entity_size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX));
  1940 
  1941       if (CONSP (Vface_font_rescale_alist))
  1942         pixel_size *= font_rescale_ratio (entity);
  1943       if (pixel_size * 2 < entity_size || entity_size * 2 < pixel_size)
  1944         /* This size is wrong by more than a factor 2: reject it!  */
  1945         return 0xFFFFFFFF;
  1946       diff = eabs (pixel_size - entity_size) << 1;
  1947       if (! NILP (spec_prop[FONT_DPI_INDEX])
  1948           && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
  1949         diff |= 1;
  1950       if (! NILP (spec_prop[FONT_AVGWIDTH_INDEX])
  1951           && ! EQ (spec_prop[FONT_AVGWIDTH_INDEX], AREF (entity, FONT_AVGWIDTH_INDEX)))
  1952         diff |= 1;
  1953       score |= min (diff, 127) << sort_shift_bits[FONT_SIZE_INDEX];
  1954     }
  1955 
  1956   return score;
  1957 }
  1958 
  1959 
  1960 /* Concatenate all elements of LIST into one vector.  LIST is a list
  1961    of font-entity vectors.  */
  1962 
  1963 static Lisp_Object
  1964 font_vconcat_entity_vectors (Lisp_Object list)
  1965 {
  1966   ptrdiff_t nargs = list_length (list);
  1967   Lisp_Object *args;
  1968   USE_SAFE_ALLOCA;
  1969   SAFE_ALLOCA_LISP (args, nargs);
  1970 
  1971   for (ptrdiff_t i = 0; i < nargs; i++, list = XCDR (list))
  1972     args[i] = XCAR (list);
  1973   Lisp_Object result = Fvconcat (nargs, args);
  1974   SAFE_FREE ();
  1975   return result;
  1976 }
  1977 
  1978 
  1979 /* The structure for elements being sorted by qsort.  */
  1980 struct font_sort_data
  1981 {
  1982   unsigned score;
  1983   int font_driver_preference;
  1984   Lisp_Object entity;
  1985 };
  1986 
  1987 
  1988 /* The comparison function for qsort.  */
  1989 
  1990 static int
  1991 font_compare (const void *d1, const void *d2)
  1992 {
  1993   const struct font_sort_data *data1 = d1;
  1994   const struct font_sort_data *data2 = d2;
  1995 
  1996   if (data1->score < data2->score)
  1997     return -1;
  1998   else if (data1->score > data2->score)
  1999     return 1;
  2000   return (data1->font_driver_preference - data2->font_driver_preference);
  2001 }
  2002 
  2003 
  2004 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
  2005    If PREFER specifies a point-size, calculate the corresponding
  2006    pixel-size from QCdpi property of PREFER or from the Y-resolution
  2007    of FRAME before sorting.
  2008 
  2009    If BEST-ONLY is nonzero, return the best matching entity (that
  2010    supports the character BEST-ONLY if BEST-ONLY is positive, or any
  2011    if BEST-ONLY is negative).  Otherwise, return the sorted result as
  2012    a single vector of font-entities.
  2013 
  2014    This function does no optimization for the case that the total
  2015    number of elements is 1.  The caller should avoid calling this in
  2016    such a case.  */
  2017 
  2018 static Lisp_Object
  2019 font_sort_entities (Lisp_Object list, Lisp_Object prefer,
  2020                     struct frame *f, int best_only)
  2021 {
  2022   Lisp_Object prefer_prop[FONT_SPEC_MAX];
  2023   int len, maxlen, i;
  2024   struct font_sort_data *data;
  2025   unsigned best_score;
  2026   Lisp_Object best_entity;
  2027   Lisp_Object tail;
  2028   Lisp_Object vec UNINIT;
  2029   USE_SAFE_ALLOCA;
  2030 
  2031   for (i = FONT_WEIGHT_INDEX; i <= FONT_AVGWIDTH_INDEX; i++)
  2032     prefer_prop[i] = AREF (prefer, i);
  2033   if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
  2034     prefer_prop[FONT_SIZE_INDEX]
  2035       = make_fixnum (font_pixel_size (f, prefer));
  2036 
  2037   if (NILP (XCDR (list)))
  2038     {
  2039       /* What we have to take care of is this single vector.  */
  2040       vec = XCAR (list);
  2041       maxlen = ASIZE (vec);
  2042     }
  2043   else if (best_only)
  2044     {
  2045       /* We don't have to perform sort, so there's no need of creating
  2046          a single vector.  But, we must find the length of the longest
  2047          vector.  */
  2048       maxlen = 0;
  2049       for (tail = list; CONSP (tail); tail = XCDR (tail))
  2050         if (maxlen < ASIZE (XCAR (tail)))
  2051           maxlen = ASIZE (XCAR (tail));
  2052     }
  2053   else
  2054     {
  2055       /* We have to create a single vector to sort it.  */
  2056       vec = font_vconcat_entity_vectors (list);
  2057       maxlen = ASIZE (vec);
  2058     }
  2059 
  2060   data = SAFE_ALLOCA (maxlen * sizeof *data);
  2061   best_score = 0xFFFFFFFF;
  2062   best_entity = Qnil;
  2063 
  2064   for (tail = list; CONSP (tail); tail = XCDR (tail))
  2065     {
  2066       int font_driver_preference = 0;
  2067       Lisp_Object current_font_driver;
  2068 
  2069       if (best_only)
  2070         vec = XCAR (tail);
  2071       len = ASIZE (vec);
  2072 
  2073       /* We are sure that the length of VEC > 0.  */
  2074       current_font_driver = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
  2075       /* Score the elements.  */
  2076       for (i = 0; i < len; i++)
  2077         {
  2078           data[i].entity = AREF (vec, i);
  2079           data[i].score
  2080             = ((best_only <= 0 || font_has_char (f, data[i].entity, best_only)
  2081                 > 0)
  2082                ? font_score (data[i].entity, prefer_prop)
  2083                : 0xFFFFFFFF);
  2084           if (best_only && best_score > data[i].score)
  2085             {
  2086               best_score = data[i].score;
  2087               best_entity = data[i].entity;
  2088               if (best_score == 0)
  2089                 break;
  2090             }
  2091           if (! EQ (current_font_driver, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
  2092             {
  2093               current_font_driver = AREF (AREF (vec, i), FONT_TYPE_INDEX);
  2094               font_driver_preference++;
  2095             }
  2096           data[i].font_driver_preference = font_driver_preference;
  2097         }
  2098 
  2099       /* Sort if necessary.  */
  2100       if (! best_only)
  2101         {
  2102           qsort (data, len, sizeof *data, font_compare);
  2103           for (i = 0; i < len; i++)
  2104             ASET (vec, i, data[i].entity);
  2105           break;
  2106         }
  2107       else
  2108         vec = best_entity;
  2109     }
  2110 
  2111   SAFE_FREE ();
  2112 
  2113   FONT_ADD_LOG ("sort-by", prefer, vec);
  2114   return vec;
  2115 }
  2116 
  2117 
  2118 /* API of Font Service Layer.  */
  2119 
  2120 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
  2121    sort_shift_bits.  Finternal_set_font_selection_order calls this
  2122    function with font_sort_order after setting up it.  */
  2123 
  2124 void
  2125 font_update_sort_order (int *order)
  2126 {
  2127   int i, shift_bits;
  2128 
  2129   for (i = 0, shift_bits = 23; i < 4; i++, shift_bits -= 7)
  2130     {
  2131       int xlfd_idx = order[i];
  2132 
  2133       if (xlfd_idx == XLFD_WEIGHT_INDEX)
  2134         sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
  2135       else if (xlfd_idx == XLFD_SLANT_INDEX)
  2136         sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
  2137       else if (xlfd_idx == XLFD_SWIDTH_INDEX)
  2138         sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
  2139       else
  2140         sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
  2141     }
  2142 }
  2143 
  2144 static bool
  2145 font_check_otf_features (Lisp_Object script, Lisp_Object langsys,
  2146                          Lisp_Object features, Lisp_Object table)
  2147 {
  2148   Lisp_Object val;
  2149   bool negative;
  2150 
  2151   table = assq_no_quit (script, table);
  2152   if (NILP (table))
  2153     return 0;
  2154   table = XCDR (table);
  2155   if (! NILP (langsys))
  2156     {
  2157       table = assq_no_quit (langsys, table);
  2158       if (NILP (table))
  2159         return 0;
  2160     }
  2161   else
  2162     {
  2163       val = assq_no_quit (Qnil, table);
  2164       if (NILP (val))
  2165         table = XCAR (table);
  2166       else
  2167         table = val;
  2168     }
  2169   table = XCDR (table);
  2170   for (negative = 0; CONSP (features); features = XCDR (features))
  2171     {
  2172       if (NILP (XCAR (features)))
  2173         {
  2174           negative = 1;
  2175           continue;
  2176         }
  2177       if (NILP (Fmemq (XCAR (features), table)) != negative)
  2178         return 0;
  2179     }
  2180   return 1;
  2181 }
  2182 
  2183 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec).  */
  2184 
  2185 static bool
  2186 font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
  2187 {
  2188   Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
  2189 
  2190   script = XCAR (spec);
  2191   spec = XCDR (spec);
  2192   if (! NILP (spec))
  2193     {
  2194       langsys = XCAR (spec);
  2195       spec = XCDR (spec);
  2196       if (! NILP (spec))
  2197         {
  2198           gsub = XCAR (spec);
  2199           spec = XCDR (spec);
  2200           if (! NILP (spec))
  2201             gpos = XCAR (spec);
  2202         }
  2203     }
  2204 
  2205   if (! NILP (gsub) && ! font_check_otf_features (script, langsys, gsub,
  2206                                                   XCAR (otf_capability)))
  2207     return 0;
  2208   if (! NILP (gpos) && ! font_check_otf_features (script, langsys, gpos,
  2209                                                   XCDR (otf_capability)))
  2210     return 0;
  2211   return 1;
  2212 }
  2213 
  2214 
  2215 
  2216 /* Check if FONT (font-entity or font-object) matches with the font
  2217    specification SPEC.  */
  2218 
  2219 bool
  2220 font_match_p (Lisp_Object spec, Lisp_Object font)
  2221 {
  2222   Lisp_Object prop[FONT_SPEC_MAX], *props;
  2223   Lisp_Object extra, font_extra;
  2224   int i;
  2225 
  2226   for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
  2227     if (! NILP (AREF (spec, i))
  2228         && ! NILP (AREF (font, i))
  2229         && ! EQ (AREF (spec, i), AREF (font, i)))
  2230       return 0;
  2231   props = XFONT_SPEC (spec)->props;
  2232   if (FLOATP (props[FONT_SIZE_INDEX]))
  2233     {
  2234       for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
  2235         prop[i] = AREF (spec, i);
  2236       prop[FONT_SIZE_INDEX]
  2237         = make_fixnum (font_pixel_size (XFRAME (selected_frame), spec));
  2238       props = prop;
  2239     }
  2240 
  2241   if (font_score (font, props) > 0)
  2242     return 0;
  2243   extra = AREF (spec, FONT_EXTRA_INDEX);
  2244   font_extra = AREF (font, FONT_EXTRA_INDEX);
  2245   for (; CONSP (extra); extra = XCDR (extra))
  2246     {
  2247       Lisp_Object key = XCAR (XCAR (extra));
  2248       Lisp_Object val = XCDR (XCAR (extra)), val2;
  2249 
  2250       if (EQ (key, QClang))
  2251         {
  2252           val2 = assq_no_quit (key, font_extra);
  2253           if (NILP (val2))
  2254             return 0;
  2255           val2 = XCDR (val2);
  2256           if (CONSP (val))
  2257             {
  2258               if (! CONSP (val2))
  2259                 return 0;
  2260               while (CONSP (val))
  2261                 if (NILP (Fmemq (val, val2)))
  2262                   return 0;
  2263             }
  2264           else
  2265             if (CONSP (val2)
  2266                 ? NILP (Fmemq (val, XCDR (val2)))
  2267                 : ! EQ (val, val2))
  2268               return 0;
  2269         }
  2270       else if (EQ (key, QCscript))
  2271         {
  2272           val2 = assq_no_quit (val, Vscript_representative_chars);
  2273           if (CONSP (val2))
  2274             {
  2275               val2 = XCDR (val2);
  2276               if (CONSP (val2))
  2277                 {
  2278                   /* All characters in the list must be supported.  */
  2279                   for (; CONSP (val2); val2 = XCDR (val2))
  2280                     {
  2281                       if (! CHARACTERP (XCAR (val2)))
  2282                         continue;
  2283                       if (font_encode_char (font, XFIXNAT (XCAR (val2)))
  2284                           == FONT_INVALID_CODE)
  2285                         return 0;
  2286                     }
  2287                 }
  2288               else if (VECTORP (val2))
  2289                 {
  2290                   /* At most one character in the vector must be supported.  */
  2291                   for (i = 0; i < ASIZE (val2); i++)
  2292                     {
  2293                       if (! CHARACTERP (AREF (val2, i)))
  2294                         continue;
  2295                       if (font_encode_char (font, XFIXNAT (AREF (val2, i)))
  2296                           != FONT_INVALID_CODE)
  2297                         break;
  2298                     }
  2299                   if (i == ASIZE (val2))
  2300                     return 0;
  2301                 }
  2302             }
  2303         }
  2304       else if (EQ (key, QCotf))
  2305         {
  2306           struct font *fontp;
  2307 
  2308           if (! FONT_OBJECT_P (font))
  2309             return 0;
  2310           fontp = XFONT_OBJECT (font);
  2311           if (! fontp->driver->otf_capability)
  2312             return 0;
  2313           val2 = fontp->driver->otf_capability (fontp);
  2314           if (NILP (val2) || ! font_check_otf (val, val2))
  2315             return 0;
  2316         }
  2317     }
  2318 
  2319   return 1;
  2320 }
  2321 
  2322 
  2323 /* Font cache
  2324 
  2325    Each font backend has the callback function get_cache, and it
  2326    returns a cons cell of which cdr part can be freely used for
  2327    caching fonts.  The cons cell may be shared by multiple frames
  2328    and/or multiple font drivers.  So, we arrange the cdr part as this:
  2329 
  2330         ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
  2331 
  2332    where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
  2333    is a number frames sharing this cache, and FONT-CACHE-DATA is a
  2334    cons (FONT-SPEC . [FONT-ENTITY ...]).  */
  2335 
  2336 static void font_clear_cache (struct frame *, Lisp_Object,
  2337                               struct font_driver const *);
  2338 
  2339 static void
  2340 font_prepare_cache (struct frame *f, struct font_driver const *driver)
  2341 {
  2342   Lisp_Object cache, val;
  2343 
  2344   cache = driver->get_cache (f);
  2345   val = XCDR (cache);
  2346   while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
  2347     val = XCDR (val);
  2348   if (NILP (val))
  2349     {
  2350       val = list2 (driver->type, make_fixnum (1));
  2351       XSETCDR (cache, Fcons (val, XCDR (cache)));
  2352     }
  2353   else
  2354     {
  2355       val = XCDR (XCAR (val));
  2356       XSETCAR (val, make_fixnum (XFIXNUM (XCAR (val)) + 1));
  2357     }
  2358 }
  2359 
  2360 
  2361 static void
  2362 font_finish_cache (struct frame *f, struct font_driver const *driver)
  2363 {
  2364   Lisp_Object cache, val, tmp;
  2365 
  2366 
  2367   cache = driver->get_cache (f);
  2368   val = XCDR (cache);
  2369   while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
  2370     cache = val, val = XCDR (val);
  2371   eassert (! NILP (val));
  2372   tmp = XCDR (XCAR (val));
  2373   XSETCAR (tmp, make_fixnum (XFIXNUM (XCAR (tmp)) - 1));
  2374   if (XFIXNUM (XCAR (tmp)) == 0)
  2375     {
  2376       font_clear_cache (f, XCAR (val), driver);
  2377       XSETCDR (cache, XCDR (val));
  2378     }
  2379 }
  2380 
  2381 
  2382 static Lisp_Object
  2383 font_get_cache (struct frame *f, struct font_driver const *driver)
  2384 {
  2385   Lisp_Object val = driver->get_cache (f);
  2386   Lisp_Object type = driver->type;
  2387 
  2388   eassert (CONSP (val));
  2389   for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
  2390   eassert (CONSP (val));
  2391   /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
  2392   val = XCDR (XCAR (val));
  2393   return val;
  2394 }
  2395 
  2396 
  2397 static void
  2398 font_clear_cache (struct frame *f, Lisp_Object cache,
  2399                   struct font_driver const *driver)
  2400 {
  2401   Lisp_Object tail, elt;
  2402   Lisp_Object entity;
  2403   ptrdiff_t i;
  2404 
  2405   /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
  2406   for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
  2407     {
  2408       elt = XCAR (tail);
  2409       /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
  2410       if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
  2411         {
  2412           elt = XCDR (elt);
  2413           eassert (VECTORP (elt));
  2414           for (i = 0; i < ASIZE (elt); i++)
  2415             {
  2416               entity = AREF (elt, i);
  2417 
  2418               if (FONT_ENTITY_P (entity)
  2419                   && EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
  2420                 {
  2421                   Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
  2422 
  2423                   for (; CONSP (objlist); objlist = XCDR (objlist))
  2424                     {
  2425                       Lisp_Object val = XCAR (objlist);
  2426                       struct font *font = XFONT_OBJECT (val);
  2427 
  2428                       if (! NILP (AREF (val, FONT_TYPE_INDEX)))
  2429                         {
  2430                           eassert (font && driver == font->driver);
  2431                           /* We are going to close the font, so make
  2432                              sure we don't have any lgstrings lying
  2433                              around in lgstring cache that reference
  2434                              the font.  */
  2435                           composition_gstring_cache_clear_font (val);
  2436                           driver->close_font (font);
  2437                         }
  2438                     }
  2439                   if (driver->free_entity)
  2440                     driver->free_entity (entity);
  2441                 }
  2442             }
  2443         }
  2444     }
  2445   XSETCDR (cache, Qnil);
  2446 }
  2447 
  2448 
  2449 /* Check whether NAME should be ignored based on Vface_ignored_fonts.
  2450    This is reused by xg_font_filter to apply the same checks to the
  2451    GTK font chooser.  */
  2452 
  2453 bool
  2454 font_is_ignored (const char *name, ptrdiff_t namelen)
  2455 {
  2456   Lisp_Object tail = Vface_ignored_fonts;
  2457   Lisp_Object regexp;
  2458 
  2459   FOR_EACH_TAIL_SAFE (tail)
  2460     {
  2461       regexp = XCAR (tail);
  2462       if (STRINGP (regexp)
  2463           && fast_c_string_match_ignore_case (regexp, name,
  2464                                               namelen) >= 0)
  2465         return true;
  2466     }
  2467   return false;
  2468 }
  2469 static Lisp_Object scratch_font_spec, scratch_font_prefer;
  2470 
  2471 /* Check each font-entity in VEC, and return a list of font-entities
  2472    that satisfy these conditions:
  2473      (1) matches with SPEC and SIZE if SPEC is not nil, and
  2474      (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
  2475 */
  2476 
  2477 static Lisp_Object
  2478 font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size)
  2479 {
  2480   Lisp_Object entity, val;
  2481   enum font_property_index prop;
  2482   ptrdiff_t i;
  2483 
  2484   for (val = Qnil, i = ASIZE (vec) - 1; i >= 0; i--)
  2485     {
  2486       entity = AREF (vec, i);
  2487       if (! NILP (Vface_ignored_fonts))
  2488         {
  2489           char name[256];
  2490           ptrdiff_t namelen;
  2491           namelen = font_unparse_xlfd (entity, 0, name, 256);
  2492           if (namelen >= 0)
  2493             if (font_is_ignored (name, namelen))
  2494                 continue;
  2495         }
  2496       if (NILP (spec))
  2497         {
  2498           val = Fcons (entity, val);
  2499           continue;
  2500         }
  2501       for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
  2502         {
  2503           if (FIXNUMP (AREF (spec, prop)))
  2504             {
  2505               if (!FIXNUMP (AREF (entity, prop)))
  2506                 prop = FONT_SPEC_MAX;
  2507               else
  2508                 {
  2509                   int required = XFIXNUM (AREF (spec, prop)) >> 8;
  2510                   int candidate = XFIXNUM (AREF (entity, prop)) >> 8;
  2511 
  2512                   if (candidate != required
  2513 #ifdef HAVE_NTGUI
  2514                       /* A kludge for w32 font search, where listing a
  2515                          family returns only 4 standard weights: regular,
  2516                          italic, bold, bold-italic.  For other values one
  2517                          must specify the font, not just the family in the
  2518                          :family attribute of the face.  But specifying
  2519                          :family in the face attributes looks for regular
  2520                          weight, so if we require exact match, the
  2521                          non-regular font will be rejected.  So we relax
  2522                          the accuracy of the match here, and let
  2523                          font_sort_entities find the best match.  */
  2524                       && (prop != FONT_WEIGHT_INDEX
  2525                           || eabs (candidate - required) > 100)
  2526 #endif
  2527                       )
  2528                     prop = FONT_SPEC_MAX;
  2529                 }
  2530             }
  2531         }
  2532       if (prop < FONT_SPEC_MAX
  2533           && size
  2534           && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
  2535         {
  2536           int diff = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) - size;
  2537 
  2538           if (eabs (diff) > FONT_PIXEL_SIZE_QUANTUM)
  2539             prop = FONT_SPEC_MAX;
  2540         }
  2541       if (prop < FONT_SPEC_MAX
  2542           && FIXNUMP (AREF (spec, FONT_DPI_INDEX))
  2543           && FIXNUMP (AREF (entity, FONT_DPI_INDEX))
  2544           && XFIXNUM (AREF (entity, FONT_DPI_INDEX)) != 0
  2545           && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
  2546         prop = FONT_SPEC_MAX;
  2547       if (prop < FONT_SPEC_MAX
  2548           && FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX))
  2549           && FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX))
  2550           && XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0
  2551           && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
  2552                    AREF (entity, FONT_AVGWIDTH_INDEX)))
  2553         prop = FONT_SPEC_MAX;
  2554       if (prop < FONT_SPEC_MAX)
  2555         val = Fcons (entity, val);
  2556     }
  2557   return (Fvconcat (1, &val));
  2558 }
  2559 
  2560 
  2561 /* Return a list of vectors of font-entities matching with SPEC on
  2562    FRAME.  Each elements in the list is a vector of entities from the
  2563    same font-driver.  */
  2564 
  2565 Lisp_Object
  2566 font_list_entities (struct frame *f, Lisp_Object spec)
  2567 {
  2568   struct font_driver_list *driver_list = f->font_driver_list;
  2569   Lisp_Object ftype, val;
  2570   Lisp_Object list = Qnil;
  2571   int size;
  2572   bool need_filtering = 0;
  2573   int i;
  2574 
  2575   eassert (FONT_SPEC_P (spec));
  2576 
  2577   if (FIXNUMP (AREF (spec, FONT_SIZE_INDEX)))
  2578     size = XFIXNUM (AREF (spec, FONT_SIZE_INDEX));
  2579   else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
  2580     size = font_pixel_size (f, spec);
  2581   else
  2582     size = 0;
  2583 
  2584   ftype = AREF (spec, FONT_TYPE_INDEX);
  2585   for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
  2586     ASET (scratch_font_spec, i, AREF (spec, i));
  2587   for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
  2588     if (i != FONT_SPACING_INDEX)
  2589       {
  2590         ASET (scratch_font_spec, i, Qnil);
  2591         if (! NILP (AREF (spec, i)))
  2592           need_filtering = 1;
  2593       }
  2594   ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
  2595   ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
  2596 
  2597   for (; driver_list; driver_list = driver_list->next)
  2598     if (driver_list->on
  2599         && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
  2600       {
  2601         Lisp_Object cache = font_get_cache (f, driver_list->driver);
  2602 
  2603         ASET (scratch_font_spec, FONT_TYPE_INDEX, driver_list->driver->type);
  2604         val = assoc_no_quit (scratch_font_spec, XCDR (cache));
  2605         if (CONSP (val))
  2606           val = XCDR (val);
  2607         else
  2608           {
  2609             Lisp_Object copy;
  2610 
  2611             val = (driver_list->driver->list) (f, scratch_font_spec);
  2612             /* We put zero_vector in the font-cache to indicate that
  2613                no fonts matching SPEC were found on the system.
  2614                Failure to have this indication in the font cache can
  2615                cause severe performance degradation in some rare
  2616                cases, see bug#21028.  */
  2617             if (NILP (val))
  2618               val = zero_vector;
  2619             else
  2620               val = Fvconcat (1, &val);
  2621             copy = copy_font_spec (scratch_font_spec);
  2622             ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
  2623             XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
  2624           }
  2625         if (ASIZE (val) > 0
  2626             && (need_filtering
  2627                 || ! NILP (Vface_ignored_fonts)))
  2628           val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size);
  2629         if (ASIZE (val) > 0)
  2630           {
  2631             list = Fcons (val, list);
  2632             /* Querying further backends can be very slow, so we only do
  2633                it if the user has explicitly requested it (Bug#43177).  */
  2634             if (query_all_font_backends == false)
  2635               break;
  2636           }
  2637       }
  2638 
  2639   list = Fnreverse (list);
  2640   FONT_ADD_LOG ("list", spec, list);
  2641   return list;
  2642 }
  2643 
  2644 
  2645 /* Return a font entity matching with SPEC on FRAME.  ATTRS, if non
  2646    nil, is an array of face's attributes, which specifies preferred
  2647    font-related attributes.  */
  2648 
  2649 static Lisp_Object
  2650 font_matching_entity (struct frame *f, Lisp_Object *attrs, Lisp_Object spec)
  2651 {
  2652   struct font_driver_list *driver_list = f->font_driver_list;
  2653   Lisp_Object ftype, size, entity;
  2654   Lisp_Object work = copy_font_spec (spec);
  2655 
  2656   ftype = AREF (spec, FONT_TYPE_INDEX);
  2657   size = AREF (spec, FONT_SIZE_INDEX);
  2658 
  2659   if (FLOATP (size))
  2660     ASET (work, FONT_SIZE_INDEX, make_fixnum (font_pixel_size (f, spec)));
  2661   FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
  2662   FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
  2663   FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
  2664 
  2665   entity = Qnil;
  2666   for (; driver_list; driver_list = driver_list->next)
  2667     if (driver_list->on
  2668         && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
  2669       {
  2670         Lisp_Object cache = font_get_cache (f, driver_list->driver);
  2671 
  2672         ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
  2673         entity = assoc_no_quit (work, XCDR (cache));
  2674         if (CONSP (entity))
  2675           entity = AREF (XCDR (entity), 0);
  2676         else
  2677           {
  2678             entity = driver_list->driver->match (f, work);
  2679             if (!NILP (entity))
  2680               {
  2681                 Lisp_Object copy = copy_font_spec (work);
  2682                 Lisp_Object match = Fvector (1, &entity);
  2683 
  2684                 ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
  2685                 XSETCDR (cache, Fcons (Fcons (copy, match), XCDR (cache)));
  2686               }
  2687           }
  2688         if (! NILP (entity))
  2689           break;
  2690       }
  2691   FONT_ADD_LOG ("match", work, entity);
  2692   return entity;
  2693 }
  2694 
  2695 
  2696 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
  2697    opened font object.  */
  2698 
  2699 static Lisp_Object
  2700 font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size)
  2701 {
  2702   struct font_driver_list *driver_list;
  2703   Lisp_Object objlist, size, val, font_object;
  2704   struct font *font;
  2705   int height, psize;
  2706 
  2707   eassert (FONT_ENTITY_P (entity));
  2708   size = AREF (entity, FONT_SIZE_INDEX);
  2709   if (XFIXNUM (size) != 0)
  2710     pixel_size = XFIXNUM (size);
  2711 
  2712   val = AREF (entity, FONT_TYPE_INDEX);
  2713   for (driver_list = f->font_driver_list;
  2714        driver_list && ! EQ (driver_list->driver->type, val);
  2715        driver_list = driver_list->next);
  2716   if (! driver_list)
  2717     return Qnil;
  2718 
  2719   for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
  2720        objlist = XCDR (objlist))
  2721     {
  2722       Lisp_Object fn = XCAR (objlist);
  2723       if (! NILP (AREF (fn, FONT_TYPE_INDEX))
  2724           && XFONT_OBJECT (fn)->pixel_size == pixel_size)
  2725         {
  2726           if (driver_list->driver->cached_font_ok == NULL
  2727               || driver_list->driver->cached_font_ok (f, fn, entity))
  2728             return fn;
  2729         }
  2730     }
  2731 
  2732   /* We always open a font of manageable size; i.e non-zero average
  2733      width and height.  */
  2734   for (psize = pixel_size; ; psize++)
  2735     {
  2736       font_object = driver_list->driver->open_font (f, entity, psize);
  2737       if (NILP (font_object))
  2738         return Qnil;
  2739       font = XFONT_OBJECT (font_object);
  2740       if (font->average_width > 0 && font->height > 0)
  2741         break;
  2742       /* Avoid an infinite loop.  */
  2743       if (psize > pixel_size + 15)
  2744         return Qnil;
  2745     }
  2746   ASET (font_object, FONT_SIZE_INDEX, make_fixnum (pixel_size));
  2747   FONT_ADD_LOG ("open", entity, font_object);
  2748   ASET (entity, FONT_OBJLIST_INDEX,
  2749         Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
  2750 
  2751   font = XFONT_OBJECT (font_object);
  2752 #ifdef HAVE_WINDOW_SYSTEM
  2753   int min_width = (font->min_width ? font->min_width
  2754                    : font->average_width ? font->average_width
  2755                    : font->space_width ? font->space_width
  2756                    : 1);
  2757 #endif
  2758 
  2759   int font_ascent, font_descent;
  2760   get_font_ascent_descent (font, &font_ascent, &font_descent);
  2761   height = font_ascent + font_descent;
  2762   if (height <= 0)
  2763     height = 1;
  2764 #ifdef HAVE_WINDOW_SYSTEM
  2765   FRAME_DISPLAY_INFO (f)->n_fonts++;
  2766   if (FRAME_DISPLAY_INFO (f)->n_fonts == 1)
  2767     {
  2768       FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
  2769       FRAME_SMALLEST_FONT_HEIGHT (f) = height;
  2770       f->fonts_changed = 1;
  2771     }
  2772   else
  2773     {
  2774       if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
  2775         FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, f->fonts_changed = 1;
  2776       if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
  2777         FRAME_SMALLEST_FONT_HEIGHT (f) = height, f->fonts_changed = 1;
  2778     }
  2779 #endif
  2780 
  2781   return font_object;
  2782 }
  2783 
  2784 
  2785 /* Close FONT_OBJECT that is opened on frame F.  */
  2786 
  2787 static void
  2788 font_close_object (struct frame *f, Lisp_Object font_object)
  2789 {
  2790   struct font *font = XFONT_OBJECT (font_object);
  2791 
  2792   if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
  2793     /* Already closed.  */
  2794     return;
  2795   FONT_ADD_LOG ("close", font_object, Qnil);
  2796   font->driver->close_font (font);
  2797 #ifdef HAVE_WINDOW_SYSTEM
  2798   eassert (FRAME_DISPLAY_INFO (f)->n_fonts);
  2799   FRAME_DISPLAY_INFO (f)->n_fonts--;
  2800 #endif
  2801 }
  2802 
  2803 
  2804 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
  2805    FONT is a font-entity and it must be opened to check.  */
  2806 
  2807 int
  2808 font_has_char (struct frame *f, Lisp_Object font, int c)
  2809 {
  2810   struct font *fontp;
  2811 
  2812   if (FONT_ENTITY_P (font))
  2813     {
  2814       Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
  2815       struct font_driver_list *driver_list;
  2816 
  2817       for (driver_list = f->font_driver_list;
  2818            driver_list && ! EQ (driver_list->driver->type, type);
  2819            driver_list = driver_list->next);
  2820       if (! driver_list)
  2821         return 0;
  2822       if (! driver_list->driver->has_char)
  2823         return -1;
  2824       return driver_list->driver->has_char (font, c);
  2825     }
  2826 
  2827   eassert (FONT_OBJECT_P (font));
  2828   fontp = XFONT_OBJECT (font);
  2829   if (fontp->driver->has_char)
  2830     {
  2831       int result = fontp->driver->has_char (font, c);
  2832 
  2833       if (result >= 0)
  2834         return result;
  2835     }
  2836   return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
  2837 }
  2838 
  2839 
  2840 /* Return the glyph ID of FONT_OBJECT for character C.  */
  2841 
  2842 static unsigned
  2843 font_encode_char (Lisp_Object font_object, int c)
  2844 {
  2845   struct font *font;
  2846 
  2847   eassert (FONT_OBJECT_P (font_object));
  2848   font = XFONT_OBJECT (font_object);
  2849   return font->driver->encode_char (font, c);
  2850 }
  2851 
  2852 
  2853 /* Return the name of FONT_OBJECT.  */
  2854 
  2855 Lisp_Object
  2856 font_get_name (Lisp_Object font_object)
  2857 {
  2858   eassert (FONT_OBJECT_P (font_object));
  2859   return AREF (font_object, FONT_NAME_INDEX);
  2860 }
  2861 
  2862 
  2863 /* Create a new font spec from FONT_NAME, and return it.  If FONT_NAME
  2864    could not be parsed by font_parse_name, return Qnil.  */
  2865 
  2866 Lisp_Object
  2867 font_spec_from_name (Lisp_Object font_name)
  2868 {
  2869   Lisp_Object spec = Ffont_spec (0, NULL);
  2870 
  2871   CHECK_STRING (font_name);
  2872   if (font_parse_name (SSDATA (font_name), SBYTES (font_name), spec) == -1)
  2873     return Qnil;
  2874   font_put_extra (spec, QCname, font_name);
  2875   font_put_extra (spec, QCuser_spec, font_name);
  2876   return spec;
  2877 }
  2878 
  2879 
  2880 void
  2881 font_clear_prop (Lisp_Object *attrs, enum font_property_index prop)
  2882 {
  2883   Lisp_Object font = attrs[LFACE_FONT_INDEX];
  2884 
  2885   if (! FONTP (font))
  2886     return;
  2887 
  2888   if (! NILP (Ffont_get (font, QCname)))
  2889     {
  2890       font = copy_font_spec (font);
  2891       font_put_extra (font, QCname, Qunbound);
  2892     }
  2893 
  2894   if (NILP (AREF (font, prop))
  2895       && prop != FONT_FAMILY_INDEX
  2896       && prop != FONT_FOUNDRY_INDEX
  2897       && prop != FONT_WIDTH_INDEX
  2898       && prop != FONT_SIZE_INDEX)
  2899     return;
  2900   if (EQ (font, attrs[LFACE_FONT_INDEX]))
  2901     font = copy_font_spec (font);
  2902   ASET (font, prop, Qnil);
  2903   if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
  2904     {
  2905       if (prop == FONT_FAMILY_INDEX)
  2906         {
  2907           ASET (font, FONT_FOUNDRY_INDEX, Qnil);
  2908           /* If we are setting the font family, we must also clear
  2909              FONT_WIDTH_INDEX to avoid rejecting families that lack
  2910              support for some widths.  */
  2911           ASET (font, FONT_WIDTH_INDEX, Qnil);
  2912         }
  2913       ASET (font, FONT_ADSTYLE_INDEX, Qnil);
  2914       ASET (font, FONT_REGISTRY_INDEX, Qnil);
  2915       ASET (font, FONT_SIZE_INDEX, Qnil);
  2916       ASET (font, FONT_DPI_INDEX, Qnil);
  2917       ASET (font, FONT_SPACING_INDEX, Qnil);
  2918       ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
  2919     }
  2920   else if (prop == FONT_SIZE_INDEX)
  2921     {
  2922       ASET (font, FONT_DPI_INDEX, Qnil);
  2923       ASET (font, FONT_SPACING_INDEX, Qnil);
  2924       ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
  2925     }
  2926   else if (prop == FONT_WIDTH_INDEX)
  2927     ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
  2928   attrs[LFACE_FONT_INDEX] = font;
  2929 }
  2930 
  2931 /* Select a font from ENTITIES (list of one or more font-entity
  2932    vectors) that supports the character C (if non-negative) and is the
  2933    best match for ATTRS and PIXEL_SIZE.  */
  2934 
  2935 static Lisp_Object
  2936 font_select_entity (struct frame *f, Lisp_Object entities,
  2937                     Lisp_Object *attrs, int pixel_size, int c)
  2938 {
  2939   Lisp_Object font_entity;
  2940   Lisp_Object prefer;
  2941   int i;
  2942 
  2943   /* If we have a single candidate, return it if it supports C.  */
  2944   if (NILP (XCDR (entities))
  2945       && ASIZE (XCAR (entities)) == 1)
  2946     {
  2947       font_entity = AREF (XCAR (entities), 0);
  2948       if (c < 0 || font_has_char (f, font_entity, c) > 0)
  2949         return font_entity;
  2950       return Qnil;
  2951     }
  2952 
  2953   /* If we have several candidates, find the best match by sorting
  2954      them by properties specified in ATTRS.  Style attributes (weight,
  2955      slant, width, and size) are taken from the font spec in ATTRS (if
  2956      that is non-nil), or from ATTRS, or left as nil.  */
  2957   prefer = scratch_font_prefer;
  2958 
  2959   for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
  2960     ASET (prefer, i, Qnil);
  2961   if (FONTP (attrs[LFACE_FONT_INDEX]))
  2962     {
  2963       Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
  2964 
  2965       for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
  2966         ASET (prefer, i, AREF (face_font, i));
  2967     }
  2968   if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
  2969     FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
  2970   if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
  2971     FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
  2972   if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
  2973     FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
  2974   ASET (prefer, FONT_SIZE_INDEX, make_fixnum (pixel_size));
  2975 
  2976   return font_sort_entities (entities, prefer, f, c);
  2977 }
  2978 
  2979 /* Return a font-entity that satisfies SPEC and is the best match for
  2980    face's font related attributes in ATTRS.  C, if not negative, is a
  2981    character that the entity must support.  */
  2982 
  2983 Lisp_Object
  2984 font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int c)
  2985 {
  2986   Lisp_Object work;
  2987   Lisp_Object entities, val;
  2988   Lisp_Object foundry[3], *family, registry[3], adstyle[3];
  2989   int pixel_size;
  2990   int i, j, k, l;
  2991   USE_SAFE_ALLOCA;
  2992 
  2993   /* Registry specification alternatives: from the most specific to
  2994      the least specific and finally an unspecified one.  */
  2995   registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
  2996   if (NILP (registry[0]))
  2997     {
  2998       registry[0] = DEFAULT_ENCODING;
  2999       registry[1] = Qascii_0;
  3000       registry[2] = zero_vector;
  3001     }
  3002   else
  3003     registry[1] = zero_vector;
  3004 
  3005   if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
  3006     {
  3007       struct charset *encoding, *repertory;
  3008 
  3009       if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
  3010                                   &encoding, &repertory) < 0)
  3011         return Qnil;
  3012       if (repertory
  3013           && ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
  3014         return Qnil;
  3015       else if (c > encoding->max_char)
  3016         return Qnil;
  3017     }
  3018 
  3019   work = copy_font_spec (spec);
  3020   ASET (work, FONT_TYPE_INDEX, AREF (spec, FONT_TYPE_INDEX));
  3021   pixel_size = font_pixel_size (f, spec);
  3022   if (pixel_size == 0 && FIXNUMP (attrs[LFACE_HEIGHT_INDEX]))
  3023     {
  3024       double pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]);
  3025 
  3026       pixel_size = POINT_TO_PIXEL (pt / 10, FRAME_RES (f));
  3027       if (pixel_size < 1)
  3028         pixel_size = 1;
  3029     }
  3030   ASET (work, FONT_SIZE_INDEX, Qnil);
  3031 
  3032   /* Foundry specification alternatives: from the most specific to the
  3033      least specific and finally an unspecified one.  */
  3034   foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
  3035   if (! NILP (foundry[0]))
  3036     foundry[1] = zero_vector;
  3037   else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
  3038     {
  3039       val = attrs[LFACE_FOUNDRY_INDEX];
  3040       foundry[0] = font_intern_prop (SSDATA (val), SBYTES (val), 1);
  3041       foundry[1] = Qnil;
  3042       foundry[2] = zero_vector;
  3043     }
  3044   else
  3045     foundry[0] = Qnil, foundry[1] = zero_vector;
  3046 
  3047   /* Additional style specification alternatives: from the most
  3048      specific to the least specific and finally an unspecified one.  */
  3049   adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
  3050   if (! NILP (adstyle[0]))
  3051     adstyle[1] = zero_vector;
  3052   else if (FONTP (attrs[LFACE_FONT_INDEX]))
  3053     {
  3054       Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
  3055 
  3056       if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
  3057         {
  3058           adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
  3059           adstyle[1] = Qnil;
  3060           adstyle[2] = zero_vector;
  3061         }
  3062       else
  3063         adstyle[0] = Qnil, adstyle[1] = zero_vector;
  3064     }
  3065   else
  3066     adstyle[0] = Qnil, adstyle[1] = zero_vector;
  3067 
  3068 
  3069   /* Family specification alternatives: from the most specific to
  3070      the least specific and finally an unspecified one.  */
  3071   val = AREF (work, FONT_FAMILY_INDEX);
  3072   if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
  3073     {
  3074       val = attrs[LFACE_FAMILY_INDEX];
  3075       val = font_intern_prop (SSDATA (val), SBYTES (val), 1);
  3076     }
  3077   Lisp_Object familybuf[3];
  3078   if (NILP (val))
  3079     {
  3080       family = familybuf;
  3081       family[0] = Qnil;
  3082       family[1] = zero_vector;  /* terminator.  */
  3083     }
  3084   else
  3085     {
  3086       Lisp_Object alters
  3087         = Fassoc_string (val, Vface_alternative_font_family_alist, Qt);
  3088 
  3089       if (! NILP (alters))
  3090         {
  3091           EMACS_INT alterslen = list_length (alters);
  3092           SAFE_ALLOCA_LISP (family, alterslen + 2);
  3093           for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
  3094             family[i] = XCAR (alters);
  3095           if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
  3096             family[i++] = Qnil;
  3097           family[i] = zero_vector;
  3098         }
  3099       else
  3100         {
  3101           family = familybuf;
  3102           i = 0;
  3103           family[i++] = val;
  3104           if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
  3105             family[i++] = Qnil;
  3106           family[i] = zero_vector;
  3107         }
  3108     }
  3109 
  3110   /* Now look up suitable fonts, from the most specific spec to the
  3111      least specific spec.  Accept the first one that matches.  */
  3112   for (i = 0; SYMBOLP (family[i]); i++)
  3113     {
  3114       ASET (work, FONT_FAMILY_INDEX, family[i]);
  3115       for (j = 0; SYMBOLP (foundry[j]); j++)
  3116         {
  3117           ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
  3118           for (k = 0; SYMBOLP (registry[k]); k++)
  3119             {
  3120               ASET (work, FONT_REGISTRY_INDEX, registry[k]);
  3121               for (l = 0; SYMBOLP (adstyle[l]); l++)
  3122                 {
  3123                   ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
  3124                   /* Produce the list of candidates for the spec in WORK.  */
  3125                   entities = font_list_entities (f, work);
  3126                   if (! NILP (entities))
  3127                     {
  3128                       /* If there are several candidates, select the
  3129                          best match for PIXEL_SIZE and attributes in ATTRS.  */
  3130                       val = font_select_entity (f, entities,
  3131                                                 attrs, pixel_size, c);
  3132                       if (! NILP (val))
  3133                         {
  3134                           SAFE_FREE ();
  3135                           return val;
  3136                         }
  3137                     }
  3138                 }
  3139             }
  3140         }
  3141     }
  3142 
  3143   SAFE_FREE ();
  3144   return Qnil;
  3145 }
  3146 
  3147 
  3148 Lisp_Object
  3149 font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Lisp_Object spec)
  3150 {
  3151   int size;
  3152 
  3153   if (FIXNUMP (AREF (entity, FONT_SIZE_INDEX))
  3154       && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
  3155     size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX));
  3156   else
  3157     {
  3158       if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
  3159         size = font_pixel_size (f, spec);
  3160       else
  3161         {
  3162           double pt;
  3163           if (FIXNUMP (attrs[LFACE_HEIGHT_INDEX]))
  3164             pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]);
  3165           else
  3166             {
  3167               /* We need the default face to be valid below.  */
  3168               if (FRAME_FACE_CACHE (f)->used == 0)
  3169                 recompute_basic_faces (f);
  3170 
  3171               struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  3172               Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX];
  3173               eassert (FIXNUMP (height));
  3174               pt = XFIXNUM (height);
  3175             }
  3176 
  3177           pt /= 10;
  3178           size = POINT_TO_PIXEL (pt, FRAME_RES (f));
  3179 #ifdef HAVE_NS
  3180           if (size == 0)
  3181             {
  3182               Lisp_Object ffsize = get_frame_param (f, Qfontsize);
  3183               size = (NUMBERP (ffsize)
  3184                       ? POINT_TO_PIXEL (XFLOATINT (ffsize), FRAME_RES (f))
  3185                       : 0);
  3186             }
  3187 #endif
  3188         }
  3189       size *= font_rescale_ratio (entity);
  3190     }
  3191 
  3192   return font_open_entity (f, entity, size);
  3193 }
  3194 
  3195 
  3196 /* Find a font that satisfies SPEC and is the best match for
  3197    face's attributes in ATTRS on FRAME, and return the opened
  3198    font-object.  */
  3199 
  3200 Lisp_Object
  3201 font_load_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec)
  3202 {
  3203   Lisp_Object entity, name;
  3204 
  3205   entity = font_find_for_lface (f, attrs, spec, -1);
  3206   if (NILP (entity))
  3207     {
  3208       /* No font is listed for SPEC, but each font-backend may have
  3209          different criteria about "font matching".  So, try it.  */
  3210       entity = font_matching_entity (f, attrs, spec);
  3211       /* Perhaps the user asked for a font "Foobar-123", and we
  3212          interpreted "-123" as the size, whereas it really is part of
  3213          the name.  So we reset the size to nil and the family name to
  3214          the entire "Foobar-123" thing, and try again with that.  */
  3215       if (NILP (entity))
  3216         {
  3217           name = Ffont_get (spec, QCuser_spec);
  3218           if (STRINGP (name))
  3219             {
  3220               char *p = SSDATA (name), *q = strrchr (p, '-');
  3221 
  3222               if (q != NULL && c_isdigit (q[1]))
  3223                 {
  3224                   char *tail;
  3225                   double font_size = strtod (q + 1, &tail);
  3226 
  3227                   if (font_size > 0 && tail != q + 1)
  3228                     {
  3229                       Lisp_Object lsize = Ffont_get (spec, QCsize);
  3230 
  3231                       if ((FLOATP (lsize) && XFLOAT_DATA (lsize) == font_size)
  3232                           || (FIXNUMP (lsize) && XFIXNUM (lsize) == font_size))
  3233                         {
  3234                           ASET (spec, FONT_FAMILY_INDEX,
  3235                                 font_intern_prop (p, tail - p, 1));
  3236                           ASET (spec, FONT_SIZE_INDEX, Qnil);
  3237                           entity = font_matching_entity (f, attrs, spec);
  3238                         }
  3239                     }
  3240                 }
  3241             }
  3242         }
  3243       if (NILP (entity))
  3244         return Qnil;
  3245     }
  3246   /* Don't lose the original name that was put in initially.  We need
  3247      it to re-apply the font when font parameters (like hinting or dpi) have
  3248      changed.  */
  3249   entity = font_open_for_lface (f, entity, attrs, spec);
  3250   if (!NILP (entity))
  3251     {
  3252       name = Ffont_get (spec, QCuser_spec);
  3253       if (STRINGP (name)) font_put_extra (entity, QCuser_spec, name);
  3254     }
  3255   return entity;
  3256 }
  3257 
  3258 
  3259 /* Make FACE on frame F ready to use the font opened for FACE.  */
  3260 
  3261 void
  3262 font_prepare_for_face (struct frame *f, struct face *face)
  3263 {
  3264   if (face->font->driver->prepare_face)
  3265     face->font->driver->prepare_face (f, face);
  3266 }
  3267 
  3268 
  3269 /* Make FACE on frame F stop using the font opened for FACE.  */
  3270 
  3271 void
  3272 font_done_for_face (struct frame *f, struct face *face)
  3273 {
  3274   if (face->font->driver->done_face)
  3275     face->font->driver->done_face (f, face);
  3276 }
  3277 
  3278 
  3279 /* Open a font that is a match for font-spec SPEC on frame F.  If no proper
  3280    font is found, return Qnil.  */
  3281 
  3282 Lisp_Object
  3283 font_open_by_spec (struct frame *f, Lisp_Object spec)
  3284 {
  3285   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  3286 
  3287   /* We set up the default font-related attributes of a face to prefer
  3288      a moderate font.  */
  3289   attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
  3290   attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
  3291     = attrs[LFACE_SLANT_INDEX] = Qnormal;
  3292 #ifndef HAVE_NS
  3293   attrs[LFACE_HEIGHT_INDEX] = make_fixnum (120);
  3294 #else
  3295   attrs[LFACE_HEIGHT_INDEX] = make_fixnum (0);
  3296 #endif
  3297   attrs[LFACE_FONT_INDEX] = Qnil;
  3298 
  3299   return font_load_for_lface (f, attrs, spec);
  3300 }
  3301 
  3302 
  3303 /* Open a font that matches NAME on frame F.  If no proper font is
  3304    found, return Qnil.  */
  3305 
  3306 Lisp_Object
  3307 font_open_by_name (struct frame *f, Lisp_Object name)
  3308 {
  3309   Lisp_Object spec = CALLN (Ffont_spec, QCname, name);
  3310   Lisp_Object ret = font_open_by_spec (f, spec);
  3311   /* Do not lose name originally put in.  */
  3312   if (!NILP (ret))
  3313     font_put_extra (ret, QCuser_spec, name);
  3314 
  3315   return ret;
  3316 }
  3317 
  3318 
  3319 /* Register font-driver DRIVER.  This function is used in two ways.
  3320 
  3321    The first is with frame F non-NULL.  In this case, make DRIVER
  3322    available (but not yet activated) on F.  All frame creators
  3323    (e.g. Fx_create_frame) must call this function at least once with
  3324    an available font-driver.
  3325 
  3326    The second is with frame F NULL.  In this case, DRIVER is globally
  3327    registered in the variable `font_driver_list'.  All font-driver
  3328    implementations must call this function in its
  3329    syms_of_XXXX_for_pdumper (e.g. syms_of_xfont_for_pdumper).  */
  3330 
  3331 void
  3332 register_font_driver (struct font_driver const *driver, struct frame *f)
  3333 {
  3334   struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
  3335   struct font_driver_list *prev, *list;
  3336 
  3337 #ifdef HAVE_WINDOW_SYSTEM
  3338   if (f && ! driver->draw)
  3339     error ("Unusable font driver for a frame: %s",
  3340            SDATA (SYMBOL_NAME (driver->type)));
  3341 #endif /* HAVE_WINDOW_SYSTEM */
  3342 
  3343   for (prev = NULL, list = root; list; prev = list, list = list->next)
  3344     if (EQ (list->driver->type, driver->type))
  3345       error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
  3346 
  3347   list = xmalloc (sizeof *list);
  3348   list->on = 0;
  3349   list->driver = driver;
  3350   list->next = NULL;
  3351   if (prev)
  3352     prev->next = list;
  3353   else if (f)
  3354     f->font_driver_list = list;
  3355   else
  3356     font_driver_list = list;
  3357   if (! f)
  3358     num_font_drivers++;
  3359 }
  3360 
  3361 void
  3362 free_font_driver_list (struct frame *f)
  3363 {
  3364   struct font_driver_list *list, *next;
  3365 
  3366   for (list = f->font_driver_list; list; list = next)
  3367     {
  3368       next = list->next;
  3369       xfree (list);
  3370     }
  3371   f->font_driver_list = NULL;
  3372 }
  3373 
  3374 
  3375 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
  3376    symbols, e.g. xft, x).  If NEW_DRIVERS is t, make F use all
  3377    available font drivers that are not superseded by another driver.
  3378    (A font driver SYMBOL is superseded by the driver specified by
  3379    SYMBOL's 'font-driver-superseded-by property if it is a non-nil
  3380    symbol.)  If NEW_DRIVERS is nil, finalize all drivers.
  3381 
  3382    A caller must free all realized faces if any in advance.  The
  3383    return value is a list of font backends actually made used on
  3384    F.  */
  3385 
  3386 Lisp_Object
  3387 font_update_drivers (struct frame *f, Lisp_Object new_drivers)
  3388 {
  3389   Lisp_Object active_drivers = Qnil, default_drivers = Qnil;
  3390   struct font_driver_list *list;
  3391 
  3392   /* Collect all unsuperseded driver symbols into
  3393      `default_drivers'.  */
  3394   Lisp_Object all_drivers = Qnil;
  3395   for (list = f->font_driver_list; list; list = list->next)
  3396     all_drivers = Fcons (list->driver->type, all_drivers);
  3397   for (Lisp_Object rest = all_drivers; CONSP (rest); rest = XCDR (rest))
  3398     {
  3399       Lisp_Object superseded_by
  3400         = Fget (XCAR (rest), Qfont_driver_superseded_by);
  3401 
  3402       if (NILP (superseded_by)
  3403           || NILP (Fmemq (superseded_by, all_drivers)))
  3404         default_drivers = Fcons (XCAR (rest), default_drivers);
  3405     }
  3406 
  3407   if (EQ (new_drivers, Qt))
  3408     new_drivers = default_drivers;
  3409 
  3410   /* At first, turn off non-requested drivers, and turn on requested
  3411      drivers.  */
  3412   for (list = f->font_driver_list; list; list = list->next)
  3413     {
  3414       struct font_driver const *driver = list->driver;
  3415       if ((! NILP (Fmemq (driver->type, new_drivers))) != list->on)
  3416         {
  3417           if (list->on)
  3418             {
  3419               if (driver->end_for_frame)
  3420                 driver->end_for_frame (f);
  3421               font_finish_cache (f, driver);
  3422               list->on = 0;
  3423             }
  3424           else
  3425             {
  3426               if (! driver->start_for_frame
  3427                   || driver->start_for_frame (f) == 0)
  3428                 {
  3429                   font_prepare_cache (f, driver);
  3430                   list->on = 1;
  3431                 }
  3432             }
  3433         }
  3434     }
  3435 
  3436   if (NILP (new_drivers))
  3437     return Qnil;
  3438   else
  3439     {
  3440       /* Re-order the driver list according to new_drivers.  */
  3441       struct font_driver_list **list_table, **next;
  3442       Lisp_Object tail;
  3443       int i;
  3444       USE_SAFE_ALLOCA;
  3445 
  3446       SAFE_NALLOCA (list_table, 1, num_font_drivers + 1);
  3447       for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
  3448         {
  3449           for (list = f->font_driver_list; list; list = list->next)
  3450             if (list->on && EQ (list->driver->type, XCAR (tail)))
  3451               break;
  3452           if (list)
  3453             list_table[i++] = list;
  3454         }
  3455       for (list = f->font_driver_list; list; list = list->next)
  3456         if (! list->on)
  3457           list_table[i++] = list;
  3458       list_table[i] = NULL;
  3459 
  3460       next = &f->font_driver_list;
  3461       for (i = 0; list_table[i]; i++)
  3462         {
  3463           *next = list_table[i];
  3464           next = &(*next)->next;
  3465         }
  3466       *next = NULL;
  3467       SAFE_FREE ();
  3468 
  3469       if (! f->font_driver_list->on)
  3470         { /* None of the drivers is enabled: enable them all.
  3471              Happens if you set the list of drivers to (xft x) in your .emacs
  3472              and then use it under w32 or ns.  */
  3473           for (list = f->font_driver_list; list; list = list->next)
  3474             {
  3475               struct font_driver const *driver = list->driver;
  3476               eassert (! list->on);
  3477               if (NILP (Fmemq (driver->type, default_drivers)))
  3478                 continue;
  3479               if (! driver->start_for_frame
  3480                   || driver->start_for_frame (f) == 0)
  3481                 {
  3482                   font_prepare_cache (f, driver);
  3483                   list->on = 1;
  3484                 }
  3485             }
  3486         }
  3487     }
  3488 
  3489   for (list = f->font_driver_list; list; list = list->next)
  3490     if (list->on)
  3491       active_drivers = nconc2 (active_drivers, list1 (list->driver->type));
  3492   return active_drivers;
  3493 }
  3494 
  3495 #if (defined HAVE_XFT || defined HAVE_FREETYPE) && !defined USE_CAIRO
  3496 
  3497 static void
  3498 fset_font_data (struct frame *f, Lisp_Object val)
  3499 {
  3500   f->font_data = val;
  3501 }
  3502 
  3503 void
  3504 font_put_frame_data (struct frame *f, Lisp_Object driver, void *data)
  3505 {
  3506   Lisp_Object val = assq_no_quit (driver, f->font_data);
  3507 
  3508   if (!data)
  3509     fset_font_data (f, Fdelq (val, f->font_data));
  3510   else
  3511     {
  3512       if (NILP (val))
  3513         fset_font_data (f, Fcons (Fcons (driver, make_mint_ptr (data)),
  3514                                   f->font_data));
  3515       else
  3516         XSETCDR (val, make_mint_ptr (data));
  3517     }
  3518 }
  3519 
  3520 void *
  3521 font_get_frame_data (struct frame *f, Lisp_Object driver)
  3522 {
  3523   Lisp_Object val = assq_no_quit (driver, f->font_data);
  3524 
  3525   return NILP (val) ? NULL : xmint_pointer (XCDR (val));
  3526 }
  3527 
  3528 #endif /* (HAVE_XFT || HAVE_FREETYPE) && !USE_CAIRO */
  3529 
  3530 /* Sets attributes on a font.  Any properties that appear in ALIST and
  3531    BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
  3532    BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
  3533    arrays of strings.  This function is intended for use by the font
  3534    drivers to implement their specific font_filter_properties.  */
  3535 void
  3536 font_filter_properties (Lisp_Object font,
  3537                         Lisp_Object alist,
  3538                         const char *const boolean_properties[],
  3539                         const char *const non_boolean_properties[])
  3540 {
  3541   Lisp_Object it;
  3542   int i;
  3543 
  3544   /* Set boolean values to Qt or Qnil.  */
  3545   for (i = 0; boolean_properties[i] != NULL; ++i)
  3546     for (it = alist; ! NILP (it); it = XCDR (it))
  3547       {
  3548         Lisp_Object key = XCAR (XCAR (it));
  3549         Lisp_Object val = XCDR (XCAR (it));
  3550         char *keystr = SSDATA (SYMBOL_NAME (key));
  3551 
  3552         if (strcmp (boolean_properties[i], keystr) == 0)
  3553           {
  3554             const char *str = FIXNUMP (val) ? (XFIXNUM (val) ? "true" : "false")
  3555               : SYMBOLP (val) ? SSDATA (SYMBOL_NAME (val))
  3556               : "true";
  3557 
  3558             if (strcmp ("false", str) == 0 || strcmp ("False", str) == 0
  3559                 || strcmp ("FALSE", str) == 0 || strcmp ("FcFalse", str) == 0
  3560                 || strcmp ("off", str) == 0 || strcmp ("OFF", str) == 0
  3561                 || strcmp ("Off", str) == 0)
  3562               val = Qnil;
  3563             else
  3564               val = Qt;
  3565 
  3566             Ffont_put (font, key, val);
  3567           }
  3568       }
  3569 
  3570   for (i = 0; non_boolean_properties[i] != NULL; ++i)
  3571     for (it = alist; ! NILP (it); it = XCDR (it))
  3572       {
  3573         Lisp_Object key = XCAR (XCAR (it));
  3574         Lisp_Object val = XCDR (XCAR (it));
  3575         char *keystr = SSDATA (SYMBOL_NAME (key));
  3576         if (strcmp (non_boolean_properties[i], keystr) == 0)
  3577           Ffont_put (font, key, val);
  3578       }
  3579 }
  3580 
  3581 
  3582 /* Return the font used to draw character C by FACE at buffer position
  3583    POS in window W.  If STRING is non-nil, it is a string containing C
  3584    at index POS.  If C is negative, get C from the current buffer or
  3585    STRING.  */
  3586 
  3587 static Lisp_Object
  3588 font_at (int c, ptrdiff_t pos, struct face *face, struct window *w,
  3589          Lisp_Object string)
  3590 {
  3591   struct frame *f;
  3592   bool multibyte;
  3593   Lisp_Object font_object;
  3594 
  3595   multibyte = (NILP (string)
  3596                ? ! NILP (BVAR (current_buffer, enable_multibyte_characters))
  3597                : STRING_MULTIBYTE (string));
  3598   if (c < 0)
  3599     {
  3600       if (NILP (string))
  3601         {
  3602           if (multibyte)
  3603             {
  3604               ptrdiff_t pos_byte = CHAR_TO_BYTE (pos);
  3605 
  3606               c = FETCH_CHAR (pos_byte);
  3607             }
  3608           else
  3609             c = FETCH_BYTE (pos);
  3610         }
  3611       else
  3612         {
  3613           unsigned char *str;
  3614 
  3615           multibyte = STRING_MULTIBYTE (string);
  3616           if (multibyte)
  3617             {
  3618               ptrdiff_t pos_byte = string_char_to_byte (string, pos);
  3619 
  3620               str = SDATA (string) + pos_byte;
  3621               c = STRING_CHAR (str);
  3622             }
  3623           else
  3624             c = SDATA (string)[pos];
  3625         }
  3626     }
  3627 
  3628   f = XFRAME (w->frame);
  3629   if (! FRAME_WINDOW_P (f))
  3630     return Qnil;
  3631   if (! face)
  3632     {
  3633       int face_id;
  3634       ptrdiff_t endptr;
  3635 
  3636       if (STRINGP (string))
  3637         face_id = face_at_string_position (w, string, pos, 0, &endptr,
  3638                                            DEFAULT_FACE_ID, false, 0);
  3639       else
  3640         face_id = face_at_buffer_position (w, pos, &endptr,
  3641                                            pos + 100, false, -1, 0);
  3642       face = FACE_FROM_ID (f, face_id);
  3643     }
  3644   if (multibyte)
  3645     {
  3646       int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
  3647       face = FACE_FROM_ID (f, face_id);
  3648     }
  3649   if (! face->font)
  3650     return Qnil;
  3651 
  3652   XSETFONT (font_object, face->font);
  3653   return font_object;
  3654 }
  3655 
  3656 
  3657 #ifdef HAVE_WINDOW_SYSTEM
  3658 
  3659 /* Check if CH is a codepoint for which we should attempt to use the
  3660    emoji font, even if the codepoint itself has Emoji_Presentation =
  3661    No.  Vauto_composition_emoji_eligible_codepoints is filled in for
  3662    us by admin/unidata/emoji-zwj.awk.  */
  3663 static bool
  3664 codepoint_is_emoji_eligible (int ch)
  3665 {
  3666   if (EQ (CHAR_TABLE_REF (Vchar_script_table, ch), Qemoji))
  3667     return true;
  3668 
  3669   if (! NILP (Fmemq (make_fixnum (ch),
  3670                      Vauto_composition_emoji_eligible_codepoints)))
  3671     return true;
  3672 
  3673   return false;
  3674 }
  3675 
  3676 /* Check how many characters after character/byte position POS/POS_BYTE
  3677    (at most to *LIMIT) can be displayed by the same font in the window W.
  3678    FACE, if non-NULL, is the face selected for the character at POS.
  3679    If STRING is not nil, it is the string to check instead of the current
  3680    buffer.  In that case, FACE must be not NULL.
  3681 
  3682    CH is the character that actually caused the composition
  3683    process to start, it may be different from the character at POS.
  3684 
  3685    The return value is the font-object for the character at POS.
  3686    *LIMIT is set to the position where that font can't be used.
  3687 
  3688    It is assured that the current buffer (or STRING) is multibyte.  */
  3689 
  3690 Lisp_Object
  3691 font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit,
  3692             struct window *w, struct face *face, Lisp_Object string,
  3693             int ch)
  3694 {
  3695   ptrdiff_t ignore;
  3696   int c;
  3697   Lisp_Object font_object = Qnil;
  3698   struct frame *f = XFRAME (w->frame);
  3699 
  3700   if (!face)
  3701     {
  3702       int face_id;
  3703 
  3704       if (NILP (string))
  3705           face_id = face_at_buffer_position (w, pos, &ignore, *limit,
  3706                                              false, -1, 0);
  3707       else
  3708         {
  3709           face_id =
  3710             NILP (Vface_remapping_alist)
  3711             ? DEFAULT_FACE_ID
  3712             : lookup_basic_face (w, f, DEFAULT_FACE_ID);
  3713 
  3714           face_id = face_at_string_position (w, string, pos, 0, &ignore,
  3715                                              face_id, false, 0);
  3716         }
  3717       face = FACE_FROM_ID (f, face_id);
  3718     }
  3719 
  3720   /* If the composition was triggered by an emoji, use a character
  3721      from 'script-representative-chars', rather than the first
  3722      character in the string, to determine the font to use.  */
  3723   if (codepoint_is_emoji_eligible (ch))
  3724     {
  3725       Lisp_Object val = assq_no_quit (Qemoji, Vscript_representative_chars);
  3726       if (CONSP (val))
  3727         {
  3728           val = XCDR (val);
  3729           if (CONSP (val))
  3730             val = XCAR (val);
  3731           else if (VECTORP (val))
  3732             val = AREF (val, 0);
  3733           font_object = font_for_char (face, XFIXNAT (val), pos, string);
  3734         }
  3735     }
  3736 
  3737   while (pos < *limit)
  3738     {
  3739       c = (NILP (string)
  3740            ? fetch_char_advance_no_check (&pos, &pos_byte)
  3741            : fetch_string_char_advance_no_check (string, &pos, &pos_byte));
  3742       Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
  3743       if (FIXNUMP (category)
  3744           && (XFIXNUM (category) == UNICODE_CATEGORY_Cf
  3745               || CHAR_VARIATION_SELECTOR_P (c)))
  3746         continue;
  3747       if (NILP (font_object))
  3748         {
  3749           font_object = font_for_char (face, c, pos - 1, string);
  3750           if (NILP (font_object))
  3751             return Qnil;
  3752           continue;
  3753         }
  3754       if (font_encode_char (font_object, c) == FONT_INVALID_CODE)
  3755         *limit = pos - 1;
  3756     }
  3757   return font_object;
  3758 }
  3759 #endif
  3760 
  3761 
  3762 /* Lisp API.  */
  3763 
  3764 DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
  3765        doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
  3766 Return nil otherwise.
  3767 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
  3768 which kind of font it is.  It must be one of `font-spec', `font-entity',
  3769 `font-object'.  */)
  3770   (Lisp_Object object, Lisp_Object extra_type)
  3771 {
  3772   if (NILP (extra_type))
  3773     return (FONTP (object) ? Qt : Qnil);
  3774   if (EQ (extra_type, Qfont_spec))
  3775     return (FONT_SPEC_P (object) ? Qt : Qnil);
  3776   if (EQ (extra_type, Qfont_entity))
  3777     return (FONT_ENTITY_P (object) ? Qt : Qnil);
  3778   if (EQ (extra_type, Qfont_object))
  3779     return (FONT_OBJECT_P (object) ? Qt : Qnil);
  3780   wrong_type_argument (Qfont_extra_type, extra_type); ;
  3781 }
  3782 
  3783 DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
  3784        doc: /* Return a newly created font-spec with arguments as properties.
  3785 
  3786 ARGS must come in pairs KEY VALUE of font properties.  KEY must be a
  3787 valid font property name listed below:
  3788 
  3789 `:family', `:weight', `:slant', `:width'
  3790 
  3791 They are the same as face attributes of the same name.  See
  3792 `set-face-attribute'.
  3793 
  3794 `:foundry'
  3795 
  3796 VALUE must be a string or a symbol specifying the font foundry, e.g. `misc'.
  3797 
  3798 `:adstyle'
  3799 
  3800 VALUE must be a string or a symbol specifying the additional
  3801 typographic style information of a font, e.g. `sans'.
  3802 
  3803 `:registry'
  3804 
  3805 VALUE must be a string or a symbol specifying the charset registry and
  3806 encoding of a font, e.g. `iso8859-1'.
  3807 
  3808 `:size'
  3809 
  3810 VALUE must be a non-negative integer or a floating point number
  3811 specifying the font size.  It specifies the font size in pixels (if
  3812 VALUE is an integer), or in points (if VALUE is a float).
  3813 
  3814 `:dpi'
  3815 
  3816 VALUE must be a non-negative number that specifies the resolution
  3817 (dot per inch) for which the font is designed.
  3818 
  3819 `:spacing'
  3820 
  3821 VALUE specifies the spacing of the font: mono, proportional, charcell,
  3822 or dual.  It can be either a number (0 for proportional, 90 for dual,
  3823 100 for mono, 110 for charcell) or a 1-letter symbol: `P', `D', `M',
  3824 or `C' (lower-case variants are also accepted).
  3825 
  3826 `:avgwidth'
  3827 
  3828 VALUE must be a non-negative integer specifying the average width of
  3829 the font in 1/10 pixel units.
  3830 
  3831 `:name'
  3832 
  3833 VALUE must be a string of XLFD-style or fontconfig-style font name.
  3834 
  3835 `:script'
  3836 
  3837 VALUE must be a symbol representing a script that the font must
  3838 support.  It may be a symbol representing a subgroup of a script
  3839 listed in the variable `script-representative-chars'.
  3840 
  3841 `:lang'
  3842 
  3843 VALUE must be a symbol whose name is a two-letter ISO-639 language
  3844 name, e.g. `ja'.  The value is matched against the "Additional Style"
  3845 field of the XLFD spec of a font, if it's non-empty, on X, and
  3846 against the codepages supported by the font on w32.
  3847 
  3848 `:otf'
  3849 
  3850 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
  3851 required OpenType features.
  3852 
  3853   SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
  3854   LANGSYS-TAG: OpenType language system tag symbol,
  3855      or nil for the default language system.
  3856   GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
  3857   GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
  3858 
  3859 GSUB and GPOS may contain nil elements.  In such a case, the font
  3860 must not have any of the remaining elements.
  3861 
  3862 For instance, if the VALUE is `(thai nil nil (mark))', the font must
  3863 be an OpenType font whose GPOS table of `thai' script's default
  3864 language system must contain `mark' feature.
  3865 
  3866 usage: (font-spec ARGS...)  */)
  3867   (ptrdiff_t nargs, Lisp_Object *args)
  3868 {
  3869   Lisp_Object spec = font_make_spec ();
  3870   ptrdiff_t i;
  3871 
  3872   for (i = 0; i < nargs; i += 2)
  3873     {
  3874       Lisp_Object key = args[i], val;
  3875 
  3876       CHECK_SYMBOL (key);
  3877       if (i + 1 >= nargs)
  3878         error ("No value for key `%s'", SDATA (SYMBOL_NAME (key)));
  3879       val = args[i + 1];
  3880 
  3881       if (EQ (key, QCname))
  3882         {
  3883           CHECK_STRING (val);
  3884           if (font_parse_name (SSDATA (val), SBYTES (val), spec) < 0)
  3885             error ("Invalid font name: %s", SSDATA (val));
  3886           font_put_extra (spec, key, val);
  3887         }
  3888       else
  3889         {
  3890           int idx = get_font_prop_index (key);
  3891 
  3892           if (idx >= 0)
  3893             {
  3894               val = font_prop_validate (idx, Qnil, val);
  3895               if (idx < FONT_EXTRA_INDEX)
  3896                 ASET (spec, idx, val);
  3897               else
  3898                 font_put_extra (spec, key, val);
  3899             }
  3900           else
  3901             font_put_extra (spec, key, font_prop_validate (0, key, val));
  3902         }
  3903     }
  3904   return spec;
  3905 }
  3906 
  3907 /* Return a copy of FONT as a font-spec.  For the sake of speed, this code
  3908    relies on an internal stuff exposed from alloc.c and should be handled
  3909    with care. */
  3910 
  3911 Lisp_Object
  3912 copy_font_spec (Lisp_Object font)
  3913 {
  3914   enum { font_spec_size = VECSIZE (struct font_spec) };
  3915   Lisp_Object new_spec, tail, *pcdr;
  3916   struct font_spec *spec;
  3917 
  3918   CHECK_FONT (font);
  3919 
  3920   /* Make an uninitialized font-spec object.  */
  3921   spec = (struct font_spec *) allocate_vector (font_spec_size);
  3922   XSETPVECTYPESIZE (spec, PVEC_FONT, FONT_SPEC_MAX,
  3923                     font_spec_size - FONT_SPEC_MAX);
  3924 
  3925   spec->props[FONT_TYPE_INDEX] = spec->props[FONT_EXTRA_INDEX] = Qnil;
  3926 
  3927   /* Copy basic properties FONT_FOUNDRY_INDEX..FONT_AVGWIDTH_INDEX.  */
  3928   memcpy (spec->props + 1, XVECTOR (font)->contents + 1,
  3929           (FONT_EXTRA_INDEX - 1) * word_size);
  3930 
  3931   /* Copy an alist of extra information but discard :font-entity property.  */
  3932   pcdr = spec->props + FONT_EXTRA_INDEX;
  3933   for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
  3934     if (!EQ (XCAR (XCAR (tail)), QCfont_entity))
  3935       {
  3936         *pcdr = Fcons (Fcons (XCAR (XCAR (tail)), CDR (XCAR (tail))), Qnil);
  3937         pcdr = xcdr_addr (*pcdr);
  3938       }
  3939 
  3940   XSETFONT (new_spec, spec);
  3941   return new_spec;
  3942 }
  3943 
  3944 /* Merge font-specs FROM and TO, and return a new font-spec.
  3945    Every specified property in FROM overrides the corresponding
  3946    property in TO.  */
  3947 Lisp_Object
  3948 merge_font_spec (Lisp_Object from, Lisp_Object to)
  3949 {
  3950   Lisp_Object extra, tail;
  3951   int i;
  3952 
  3953   CHECK_FONT (from);
  3954   CHECK_FONT (to);
  3955   to = copy_font_spec (to);
  3956   for (i = 0; i < FONT_EXTRA_INDEX; i++)
  3957     ASET (to, i, AREF (from, i));
  3958   extra = AREF (to, FONT_EXTRA_INDEX);
  3959   for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
  3960     if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
  3961       {
  3962         Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
  3963 
  3964         if (! NILP (slot))
  3965           XSETCDR (slot, XCDR (XCAR (tail)));
  3966         else
  3967           extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
  3968       }
  3969   ASET (to, FONT_EXTRA_INDEX, extra);
  3970   return to;
  3971 }
  3972 
  3973 DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
  3974        doc: /* Return the value of FONT's property KEY.
  3975 FONT is a font-spec, a font-entity, or a font-object.
  3976 KEY can be any symbol, but these are reserved for specific meanings:
  3977   :foundry, :family, :adstyle, :registry, :weight, :slant, :width,
  3978   :size, :dpi, :spacing, :avgwidth, :script, :lang, :otf
  3979 See the documentation of `font-spec' for their meanings.
  3980 
  3981 If FONT is a font-entity or a font-object, then values of
  3982 :script and :otf properties are different from those of a font-spec
  3983 as below:
  3984 
  3985   The value of :script may be a list of scripts that are supported by
  3986   the font.
  3987 
  3988   The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are
  3989   lists representing the OpenType features supported by the font, of
  3990   this form: ((SCRIPT (LANGSYS FEATURE ...) ...) ...), where
  3991   SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
  3992   Layout tags.  See `otf-script-alist' for the OpenType script tags.
  3993 
  3994 In addition to the keys listed above, the following keys are reserved
  3995 for the specific meanings as below:
  3996 
  3997   The value of :type is a symbol that identifies the font backend to be
  3998   used, such as `ftcrhb' or `xfthb' on X , `harfbuzz' or `uniscribe' on
  3999   MS-Windows, `ns' on Cocoa/GNUstep, etc.
  4000 
  4001   The value of :combining-capability is non-nil if the font-backend of
  4002   FONT supports rendering of combining characters for non-OTF fonts.  */)
  4003   (Lisp_Object font, Lisp_Object key)
  4004 {
  4005   int idx;
  4006   Lisp_Object val;
  4007 
  4008   CHECK_FONT (font);
  4009   CHECK_SYMBOL (key);
  4010 
  4011   idx = get_font_prop_index (key);
  4012   if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
  4013     return font_style_symbolic (font, idx, 0);
  4014   if (idx >= 0 && idx < FONT_EXTRA_INDEX)
  4015     return AREF (font, idx);
  4016   val = Fassq (key, AREF (font, FONT_EXTRA_INDEX));
  4017   if (NILP (val) && FONT_OBJECT_P (font))
  4018     {
  4019       struct font *fontp = XFONT_OBJECT (font);
  4020 
  4021       if (EQ (key, QCotf))
  4022         {
  4023           if (fontp->driver->otf_capability)
  4024             val = fontp->driver->otf_capability (fontp);
  4025           else
  4026             val = Fcons (Qnil, Qnil);
  4027         }
  4028       else if (EQ (key, QCcombining_capability))
  4029         {
  4030           if (fontp->driver->combining_capability)
  4031             val = fontp->driver->combining_capability (fontp);
  4032         }
  4033     }
  4034   else
  4035     val = Fcdr (val);
  4036   return val;
  4037 }
  4038 
  4039 #ifdef HAVE_WINDOW_SYSTEM
  4040 
  4041 DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
  4042        doc: /* Return a plist of face attributes generated by FONT.
  4043 FONT is a font name, a font-spec, a font-entity, or a font-object.
  4044 The return value is a list of the form
  4045 
  4046 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
  4047 
  4048 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
  4049 compatible with `set-face-attribute'.  Some of these key-attribute pairs
  4050 may be omitted from the list if they are not specified by FONT.
  4051 
  4052 The optional argument FRAME specifies the frame that the face attributes
  4053 are to be displayed on.  If omitted, the selected frame is used.  */)
  4054   (Lisp_Object font, Lisp_Object frame)
  4055 {
  4056   struct frame *f = decode_live_frame (frame);
  4057   Lisp_Object plist[10];
  4058   Lisp_Object val;
  4059   int n = 0;
  4060 
  4061   if (STRINGP (font))
  4062     {
  4063       int fontset = fs_query_fontset (font, 0);
  4064       Lisp_Object name = font;
  4065       if (fontset >= 0)
  4066         font = fontset_ascii (fontset);
  4067       font = font_spec_from_name (name);
  4068       if (! FONTP (font))
  4069         signal_error ("Invalid font name", name);
  4070     }
  4071   else if (! FONTP (font))
  4072     signal_error ("Invalid font object", font);
  4073 
  4074   val = AREF (font, FONT_FAMILY_INDEX);
  4075   if (! NILP (val))
  4076     {
  4077       plist[n++] = QCfamily;
  4078       plist[n++] = SYMBOL_NAME (val);
  4079     }
  4080 
  4081   val = AREF (font, FONT_SIZE_INDEX);
  4082   if (FIXNUMP (val))
  4083     {
  4084       Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
  4085       int dpi = FIXNUMP (font_dpi) ? XFIXNUM (font_dpi) : FRAME_RES (f);
  4086       plist[n++] = QCheight;
  4087       plist[n++] = make_fixnum (PIXEL_TO_POINT (XFIXNUM (val) * 10, dpi));
  4088     }
  4089   else if (FLOATP (val))
  4090     {
  4091       plist[n++] = QCheight;
  4092       plist[n++] = make_fixnum (10 * (int) XFLOAT_DATA (val));
  4093     }
  4094 
  4095   val = FONT_WEIGHT_FOR_FACE (font);
  4096   if (! NILP (val))
  4097     {
  4098       plist[n++] = QCweight;
  4099       plist[n++] = val;
  4100     }
  4101 
  4102   val = FONT_SLANT_FOR_FACE (font);
  4103   if (! NILP (val))
  4104     {
  4105       plist[n++] = QCslant;
  4106       plist[n++] = val;
  4107     }
  4108 
  4109   val = FONT_WIDTH_FOR_FACE (font);
  4110   if (! NILP (val))
  4111     {
  4112       plist[n++] = QCwidth;
  4113       plist[n++] = val;
  4114     }
  4115 
  4116   return Flist (n, plist);
  4117 }
  4118 
  4119 #endif
  4120 
  4121 DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
  4122        doc: /* Set one property of FONT: give property KEY value VAL.
  4123 FONT is a font-spec, a font-entity, or a font-object.
  4124 
  4125 If FONT is a font-spec, KEY can be any symbol.  But if KEY is the one
  4126 accepted by the function `font-spec' (which see), VAL must be what
  4127 allowed in `font-spec'.
  4128 
  4129 If FONT is a font-entity or a font-object, KEY must not be the one
  4130 accepted by `font-spec'.
  4131 
  4132 See also `font-get' for KEYs that have special meanings.  */)
  4133   (Lisp_Object font, Lisp_Object prop, Lisp_Object val)
  4134 {
  4135   int idx;
  4136 
  4137   idx = get_font_prop_index (prop);
  4138   if (idx >= 0 && idx < FONT_EXTRA_INDEX)
  4139     {
  4140       CHECK_FONT_SPEC (font);
  4141       ASET (font, idx, font_prop_validate (idx, Qnil, val));
  4142     }
  4143   else
  4144     {
  4145       if (EQ (prop, QCname)
  4146           || EQ (prop, QCscript)
  4147           || EQ (prop, QClang)
  4148           || EQ (prop, QCotf))
  4149         CHECK_FONT_SPEC (font);
  4150       else
  4151         CHECK_FONT (font);
  4152       font_put_extra (font, prop, font_prop_validate (0, prop, val));
  4153     }
  4154   return val;
  4155 }
  4156 
  4157 DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
  4158        doc: /* List available fonts matching FONT-SPEC on the current frame.
  4159 Optional 2nd argument FRAME specifies the target frame.
  4160 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
  4161 Optional 4th argument PREFER, if non-nil, is a font-spec to
  4162 control the order of the returned list.  Fonts are sorted by
  4163 how close they are to PREFER.  */)
  4164   (Lisp_Object font_spec, Lisp_Object frame, Lisp_Object num, Lisp_Object prefer)
  4165 {
  4166   struct frame *f = decode_live_frame (frame);
  4167   Lisp_Object vec, list;
  4168   EMACS_INT n = 0;
  4169 
  4170   CHECK_FONT_SPEC (font_spec);
  4171   if (! NILP (num))
  4172     {
  4173       CHECK_FIXNUM (num);
  4174       n = XFIXNUM (num);
  4175       if (n <= 0)
  4176         return Qnil;
  4177     }
  4178   if (! NILP (prefer))
  4179     CHECK_FONT_SPEC (prefer);
  4180 
  4181   list = font_list_entities (f, font_spec);
  4182   if (NILP (list))
  4183     return Qnil;
  4184   if (NILP (XCDR (list))
  4185       && ASIZE (XCAR (list)) == 1)
  4186     return list1 (AREF (XCAR (list), 0));
  4187 
  4188   if (! NILP (prefer))
  4189     vec = font_sort_entities (list, prefer, f, 0);
  4190   else
  4191     vec = font_vconcat_entity_vectors (list);
  4192   if (n == 0 || n >= ASIZE (vec))
  4193     list = CALLN (Fappend, vec, Qnil);
  4194   else
  4195     {
  4196       for (list = Qnil, n--; n >= 0; n--)
  4197         list = Fcons (AREF (vec, n), list);
  4198     }
  4199   return list;
  4200 }
  4201 
  4202 DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
  4203        doc: /* List available font families on the current frame.
  4204 If FRAME is omitted or nil, the selected frame is used.  */)
  4205   (Lisp_Object frame)
  4206 {
  4207   struct frame *f = decode_live_frame (frame);
  4208   struct font_driver_list *driver_list;
  4209   Lisp_Object list = Qnil;
  4210 
  4211   for (driver_list = f->font_driver_list; driver_list;
  4212        driver_list = driver_list->next)
  4213     if (driver_list->driver->list_family)
  4214       {
  4215         Lisp_Object val = driver_list->driver->list_family (f);
  4216         Lisp_Object tail = list;
  4217 
  4218         for (; CONSP (val); val = XCDR (val))
  4219           if (NILP (Fmemq (XCAR (val), tail))
  4220               && SYMBOLP (XCAR (val)))
  4221             list = Fcons (SYMBOL_NAME (XCAR (val)), list);
  4222       }
  4223   return list;
  4224 }
  4225 
  4226 DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
  4227        doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
  4228 Optional 2nd argument FRAME, if non-nil, specifies the target frame.  */)
  4229   (Lisp_Object font_spec, Lisp_Object frame)
  4230 {
  4231   Lisp_Object val = Flist_fonts (font_spec, frame, make_fixnum (1), Qnil);
  4232 
  4233   if (CONSP (val))
  4234     val = XCAR (val);
  4235   return val;
  4236 }
  4237 
  4238 DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
  4239        doc: /*  Return XLFD name of FONT.
  4240 FONT is a font-spec, font-entity, or font-object.
  4241 If the name is too long for XLFD (maximum 255 chars), return nil.
  4242 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
  4243 the consecutive wildcards are folded into one.  */)
  4244   (Lisp_Object font, Lisp_Object fold_wildcards)
  4245 {
  4246   char name[256];
  4247   int namelen, pixel_size = 0;
  4248 
  4249   CHECK_FONT (font);
  4250 
  4251   if (FONT_OBJECT_P (font))
  4252     {
  4253       Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
  4254 
  4255       if (STRINGP (font_name)
  4256           && SDATA (font_name)[0] == '-')
  4257         {
  4258           if (NILP (fold_wildcards))
  4259             return font_name;
  4260           lispstpcpy (name, font_name);
  4261           namelen = SBYTES (font_name);
  4262           goto done;
  4263         }
  4264       pixel_size = XFONT_OBJECT (font)->pixel_size;
  4265     }
  4266   namelen = font_unparse_xlfd (font, pixel_size, name, 256);
  4267   if (namelen < 0)
  4268     return Qnil;
  4269  done:
  4270   if (! NILP (fold_wildcards))
  4271     {
  4272       char *p0 = name, *p1;
  4273 
  4274       while ((p1 = strstr (p0, "-*-*")))
  4275         {
  4276           memmove (p1, p1 + 2, (name + namelen + 1) - (p1 + 2));
  4277           namelen -= 2;
  4278           p0 = p1;
  4279         }
  4280     }
  4281 
  4282   return make_string (name, namelen);
  4283 }
  4284 
  4285 void
  4286 clear_font_cache (struct frame *f)
  4287 {
  4288   struct font_driver_list *driver_list = f->font_driver_list;
  4289 
  4290   for (; driver_list; driver_list = driver_list->next)
  4291     if (driver_list->on)
  4292       {
  4293         Lisp_Object val, tmp, cache = driver_list->driver->get_cache (f);
  4294 
  4295         val = XCDR (cache);
  4296         while (eassert (CONSP (val)),
  4297                ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
  4298           val = XCDR (val);
  4299         tmp = XCDR (XCAR (val));
  4300         if (XFIXNUM (XCAR (tmp)) == 0)
  4301           {
  4302             font_clear_cache (f, XCAR (val), driver_list->driver);
  4303             XSETCDR (cache, XCDR (val));
  4304           }
  4305       }
  4306 }
  4307 
  4308 DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
  4309        doc: /* Clear font cache of each frame.  */)
  4310   (void)
  4311 {
  4312   Lisp_Object list, frame;
  4313 
  4314   FOR_EACH_FRAME (list, frame)
  4315     clear_font_cache (XFRAME (frame));
  4316 
  4317   return Qnil;
  4318 }
  4319 
  4320 
  4321 void
  4322 font_fill_lglyph_metrics (Lisp_Object glyph, struct font *font, unsigned int code)
  4323 {
  4324   struct font_metrics metrics;
  4325 
  4326   LGLYPH_SET_CODE (glyph, code);
  4327   font->driver->text_extents (font, &code, 1, &metrics);
  4328   LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
  4329   LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
  4330   LGLYPH_SET_WIDTH (glyph, metrics.width);
  4331   LGLYPH_SET_ASCENT (glyph, metrics.ascent);
  4332   LGLYPH_SET_DESCENT (glyph, metrics.descent);
  4333 }
  4334 
  4335 
  4336 DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 2, 2, 0,
  4337        doc: /* Shape the glyph-string GSTRING subject to bidi DIRECTION.
  4338 Shaping means substituting glyphs and/or adjusting positions of glyphs
  4339 to get the correct visual image of character sequences set in the
  4340 header of the glyph-string.
  4341 
  4342 DIRECTION should be produced by the UBA, the Unicode Bidirectional
  4343 Algorithm, and should be a symbol, either L2R or R2L.  It can also
  4344 be nil if the bidi context is unknown.
  4345 
  4346 If the shaping was successful, the value is GSTRING itself or a newly
  4347 created glyph-string.  Otherwise, the value is nil.
  4348 
  4349 See the documentation of `composition-get-gstring' for the format of
  4350 GSTRING.  */)
  4351   (Lisp_Object gstring, Lisp_Object direction)
  4352 {
  4353   struct font *font;
  4354   Lisp_Object font_object, n, glyph;
  4355   ptrdiff_t i, from, to;
  4356 
  4357   if (! composition_gstring_p (gstring))
  4358     signal_error ("Invalid glyph-string: ", gstring);
  4359   if (! NILP (LGSTRING_ID (gstring)))
  4360     return gstring;
  4361   Lisp_Object cached_gstring =
  4362     composition_gstring_lookup_cache (LGSTRING_HEADER (gstring));
  4363   if (! NILP (cached_gstring))
  4364     return cached_gstring;
  4365   font_object = LGSTRING_FONT (gstring);
  4366   CHECK_FONT_OBJECT (font_object);
  4367   font = XFONT_OBJECT (font_object);
  4368   if (! font->driver->shape)
  4369     return Qnil;
  4370 
  4371   /* Try at most three times with larger gstring each time.  */
  4372   for (i = 0; i < 3; i++)
  4373     {
  4374       n = font->driver->shape (gstring, direction);
  4375       if (FIXNUMP (n))
  4376         break;
  4377       gstring = larger_vector (gstring,
  4378                                LGSTRING_GLYPH_LEN (gstring), -1);
  4379     }
  4380   if (i == 3 || XFIXNUM (n) == 0)
  4381     return Qnil;
  4382   if (XFIXNUM (n) < LGSTRING_GLYPH_LEN (gstring))
  4383     LGSTRING_SET_GLYPH (gstring, XFIXNUM (n), Qnil);
  4384 
  4385   /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
  4386      GLYPHS covers all characters (except for the last few ones) in
  4387      GSTRING.  More formally, provided that NCHARS is the number of
  4388      characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
  4389      and TO_IDX of each glyph must satisfy these conditions:
  4390 
  4391        GLYPHS[0].FROM_IDX == 0
  4392        GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
  4393        if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
  4394          ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
  4395          GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
  4396        else
  4397          ;; Be sure to cover all characters.
  4398          GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
  4399   glyph = LGSTRING_GLYPH (gstring, 0);
  4400   from = LGLYPH_FROM (glyph);
  4401   to = LGLYPH_TO (glyph);
  4402   if (from != 0 || to < from)
  4403     goto shaper_error;
  4404   for (i = 1; i < LGSTRING_GLYPH_LEN (gstring); i++)
  4405     {
  4406       glyph = LGSTRING_GLYPH (gstring, i);
  4407       if (NILP (glyph))
  4408         break;
  4409       if (! (LGLYPH_FROM (glyph) <= LGLYPH_TO (glyph)
  4410              && (LGLYPH_FROM (glyph) == from
  4411                  ? LGLYPH_TO (glyph) == to
  4412                  : LGLYPH_FROM (glyph) == to + 1)))
  4413         goto shaper_error;
  4414       from = LGLYPH_FROM (glyph);
  4415       to = LGLYPH_TO (glyph);
  4416     }
  4417   composition_gstring_adjust_zero_width (gstring);
  4418   return composition_gstring_put_cache (gstring, XFIXNUM (n));
  4419 
  4420  shaper_error:
  4421   return Qnil;
  4422 }
  4423 
  4424 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
  4425        2, 2, 0,
  4426        doc: /* Return a list of variation glyphs for CHARACTER in FONT-OBJECT.
  4427 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
  4428 where
  4429   VARIATION-SELECTOR is a character code of variation selector
  4430     (#xFE00..#xFE0F or #xE0100..#xE01EF).
  4431   GLYPH-ID is a glyph code of the corresponding variation glyph, an integer.  */)
  4432   (Lisp_Object font_object, Lisp_Object character)
  4433 {
  4434   unsigned variations[256];
  4435   struct font *font;
  4436   int i, n;
  4437   Lisp_Object val;
  4438 
  4439   CHECK_FONT_OBJECT (font_object);
  4440   CHECK_CHARACTER (character);
  4441   font = XFONT_OBJECT (font_object);
  4442   if (! font->driver->get_variation_glyphs)
  4443     return Qnil;
  4444   n = font->driver->get_variation_glyphs (font, XFIXNUM (character), variations);
  4445   if (! n)
  4446     return Qnil;
  4447   val = Qnil;
  4448   for (i = 0; i < 255; i++)
  4449     if (variations[i])
  4450       {
  4451         int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
  4452         Lisp_Object code = INT_TO_INTEGER (variations[i]);
  4453         val = Fcons (Fcons (make_fixnum (vs), code), val);
  4454       }
  4455   return val;
  4456 }
  4457 
  4458 /* Return a description of the font at POSITION in the current buffer.
  4459    If the 2nd optional arg CH is non-nil, it is a character to check
  4460    the font instead of the character at POSITION.
  4461 
  4462    For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
  4463    FONT-OBJECT is the font for the character at POSITION in the current
  4464    buffer.  This is computed from all the text properties and overlays
  4465    that apply to POSITION.  POSITION may be nil, in which case,
  4466    FONT-SPEC is the font for displaying the character CH with the
  4467    default face.  GLYPH-CODE is the glyph code in the font to use for
  4468    the character, it is a fixnum, if it is small enough, otherwise a
  4469    bignum.
  4470 
  4471    For a text terminal, return a nonnegative integer glyph code for
  4472    the character, or a negative integer if the character is not
  4473    displayable.  Terminal glyph codes are system-dependent integers
  4474    that represent displayable characters: for example, on a Linux x86
  4475    console they represent VGA code points.
  4476 
  4477    It returns nil in the following cases:
  4478 
  4479    (1) The window system doesn't have a font for the character (thus
  4480    it is displayed by an empty box).
  4481 
  4482    (2) The character code is invalid.
  4483 
  4484    (3) If POSITION is not nil, and the current buffer is not displayed
  4485    in any window.
  4486 
  4487    (4) For a text terminal, the terminal does not report glyph codes.
  4488 
  4489    In addition, the returned font name may not take into account of
  4490    such redisplay engine hooks as what used in jit-lock-mode if
  4491    POSITION is currently not visible.  */
  4492 
  4493 
  4494 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
  4495        doc: /* For internal use only.  */)
  4496   (Lisp_Object position, Lisp_Object ch)
  4497 {
  4498   ptrdiff_t pos, pos_byte, dummy;
  4499   int face_id;
  4500   int c;
  4501   struct frame *f;
  4502 
  4503   if (NILP (position))
  4504     {
  4505       CHECK_CHARACTER (ch);
  4506       c = XFIXNUM (ch);
  4507       f = XFRAME (selected_frame);
  4508       face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
  4509       pos = -1;
  4510     }
  4511   else
  4512     {
  4513       Lisp_Object window;
  4514       struct window *w;
  4515 
  4516       EMACS_INT fixed_pos = fix_position (position);
  4517       if (! (BEGV <= fixed_pos && fixed_pos < ZV))
  4518         args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
  4519       pos = fixed_pos;
  4520       pos_byte = CHAR_TO_BYTE (pos);
  4521       if (NILP (ch))
  4522         c = FETCH_CHAR (pos_byte);
  4523       else
  4524         {
  4525           CHECK_FIXNAT (ch);
  4526           c = XFIXNUM (ch);
  4527         }
  4528       window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
  4529       if (NILP (window))
  4530         return Qnil;
  4531       w = XWINDOW (window);
  4532       f = XFRAME (w->frame);
  4533       face_id = face_at_buffer_position (w, pos, &dummy,
  4534                                          pos + 100, false, -1, 0);
  4535     }
  4536   if (! CHAR_VALID_P (c))
  4537     return Qnil;
  4538 
  4539   if (! FRAME_WINDOW_P (f))
  4540     return terminal_glyph_code (FRAME_TERMINAL (f), c);
  4541 
  4542   /* We need the basic faces to be valid below, so recompute them if
  4543      some code just happened to clear the face cache.  */
  4544   if (FRAME_FACE_CACHE (f)->used == 0)
  4545     recompute_basic_faces (f);
  4546 
  4547   face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
  4548   struct face *face = FACE_FROM_ID (f, face_id);
  4549   if (! face->font)
  4550     return Qnil;
  4551   unsigned code = face->font->driver->encode_char (face->font, c);
  4552   if (code == FONT_INVALID_CODE)
  4553     return Qnil;
  4554   Lisp_Object font_object;
  4555   XSETFONT (font_object, face->font);
  4556   return Fcons (font_object, INT_TO_INTEGER (code));
  4557 }
  4558 
  4559 
  4560 /* This part (through the next ^L) is still experimental and not
  4561    tested much.  We may drastically change codes.  */
  4562 
  4563 /* This code implements support for extracting OTF features of a font
  4564    and exposing them to Lisp, including application of those features
  4565    to arbitrary stretches of text.  FIXME: it would be good to finish
  4566    this work and have this in Emacs.  */
  4567 
  4568 /* OTF handler.  */
  4569 
  4570 #if 0
  4571 
  4572 #define LGSTRING_HEADER_SIZE 6
  4573 #define LGSTRING_GLYPH_SIZE 8
  4574 
  4575 static int
  4576 check_gstring (Lisp_Object gstring)
  4577 {
  4578   Lisp_Object val;
  4579   ptrdiff_t i;
  4580   int j;
  4581 
  4582   CHECK_VECTOR (gstring);
  4583   val = AREF (gstring, 0);
  4584   CHECK_VECTOR (val);
  4585   if (ASIZE (val) < LGSTRING_HEADER_SIZE)
  4586     goto err;
  4587   CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
  4588   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
  4589     CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
  4590   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
  4591     CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
  4592   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
  4593     CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
  4594   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
  4595     CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
  4596   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
  4597     CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
  4598 
  4599   for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
  4600     {
  4601       val = LGSTRING_GLYPH (gstring, i);
  4602       CHECK_VECTOR (val);
  4603       if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
  4604         goto err;
  4605       if (NILP (AREF (val, LGLYPH_IX_CHAR)))
  4606         break;
  4607       CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
  4608       CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
  4609       CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
  4610       if (!NILP (AREF (val, LGLYPH_IX_CODE)))
  4611         CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
  4612       if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
  4613         CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
  4614       if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
  4615         {
  4616           val = AREF (val, LGLYPH_IX_ADJUSTMENT);
  4617           CHECK_VECTOR (val);
  4618           if (ASIZE (val) < 3)
  4619             goto err;
  4620           for (j = 0; j < 3; j++)
  4621             CHECK_FIXNUM (AREF (val, j));
  4622         }
  4623     }
  4624   return i;
  4625  err:
  4626   error ("Invalid glyph-string format");
  4627   return -1;
  4628 }
  4629 
  4630 static void
  4631 check_otf_features (Lisp_Object otf_features)
  4632 {
  4633   Lisp_Object val;
  4634 
  4635   CHECK_CONS (otf_features);
  4636   CHECK_SYMBOL (XCAR (otf_features));
  4637   otf_features = XCDR (otf_features);
  4638   CHECK_CONS (otf_features);
  4639   CHECK_SYMBOL (XCAR (otf_features));
  4640   otf_features = XCDR (otf_features);
  4641   for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
  4642     {
  4643       CHECK_SYMBOL (XCAR (val));
  4644       if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
  4645         error ("Invalid OTF GSUB feature: %s",
  4646                SDATA (SYMBOL_NAME (XCAR (val))));
  4647     }
  4648   otf_features = XCDR (otf_features);
  4649   for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
  4650     {
  4651       CHECK_SYMBOL (XCAR (val));
  4652       if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
  4653         error ("Invalid OTF GPOS feature: %s",
  4654                SDATA (SYMBOL_NAME (XCAR (val))));
  4655     }
  4656 }
  4657 
  4658 #ifdef HAVE_LIBOTF
  4659 #include <otf.h>
  4660 
  4661 Lisp_Object otf_list;
  4662 
  4663 static Lisp_Object
  4664 otf_tag_symbol (OTF_Tag tag)
  4665 {
  4666   char name[5];
  4667 
  4668   OTF_tag_name (tag, name);
  4669   return Fintern (make_unibyte_string (name, 4), Qnil);
  4670 }
  4671 
  4672 static OTF *
  4673 otf_open (Lisp_Object file)
  4674 {
  4675   Lisp_Object val = Fassoc (file, otf_list, Qnil);
  4676   OTF *otf;
  4677 
  4678   if (! NILP (val))
  4679     otf = xmint_pointer (XCDR (val));
  4680   else
  4681     {
  4682       otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
  4683       val = make_mint_ptr (otf);
  4684       otf_list = Fcons (Fcons (file, val), otf_list);
  4685     }
  4686   return otf;
  4687 }
  4688 
  4689 
  4690 /* Return a list describing which scripts/languages FONT supports by
  4691    which GSUB/GPOS features of OpenType tables.  See the comment of
  4692    (struct font_driver).otf_capability.  */
  4693 
  4694 Lisp_Object
  4695 font_otf_capability (struct font *font)
  4696 {
  4697   OTF *otf;
  4698   Lisp_Object capability = Fcons (Qnil, Qnil);
  4699   int i;
  4700 
  4701   otf = otf_open (font->props[FONT_FILE_INDEX]);
  4702   if (! otf)
  4703     return Qnil;
  4704   for (i = 0; i < 2; i++)
  4705     {
  4706       OTF_GSUB_GPOS *gsub_gpos;
  4707       Lisp_Object script_list = Qnil;
  4708       int j;
  4709 
  4710       if (OTF_get_features (otf, i == 0) < 0)
  4711         continue;
  4712       gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
  4713       for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
  4714         {
  4715           OTF_Script *script = gsub_gpos->ScriptList.Script + j;
  4716           Lisp_Object langsys_list = Qnil;
  4717           Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
  4718           int k;
  4719 
  4720           for (k = script->LangSysCount; k >= 0; k--)
  4721             {
  4722               OTF_LangSys *langsys;
  4723               Lisp_Object feature_list = Qnil;
  4724               Lisp_Object langsys_tag;
  4725               int l;
  4726 
  4727               if (k == script->LangSysCount)
  4728                 {
  4729                   langsys = &script->DefaultLangSys;
  4730                   langsys_tag = Qnil;
  4731                 }
  4732               else
  4733                 {
  4734                   langsys = script->LangSys + k;
  4735                   langsys_tag
  4736                     = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
  4737                 }
  4738               for (l = langsys->FeatureCount - 1; l >= 0; l--)
  4739                 {
  4740                   OTF_Feature *feature
  4741                     = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
  4742                   Lisp_Object feature_tag
  4743                     = otf_tag_symbol (feature->FeatureTag);
  4744 
  4745                   feature_list = Fcons (feature_tag, feature_list);
  4746                 }
  4747               langsys_list = Fcons (Fcons (langsys_tag, feature_list),
  4748                                     langsys_list);
  4749             }
  4750           script_list = Fcons (Fcons (script_tag, langsys_list),
  4751                                script_list);
  4752         }
  4753 
  4754       if (i == 0)
  4755         XSETCAR (capability, script_list);
  4756       else
  4757         XSETCDR (capability, script_list);
  4758     }
  4759 
  4760   return capability;
  4761 }
  4762 
  4763 /* Parse OTF features in SPEC and write a proper features spec string
  4764    in FEATURES for the call of OTF_drive_gsub/gpos (of libotf).  It is
  4765    assured that the sufficient memory has already allocated for
  4766    FEATURES.  */
  4767 
  4768 static void
  4769 generate_otf_features (Lisp_Object spec, char *features)
  4770 {
  4771   Lisp_Object val;
  4772   char *p;
  4773   bool asterisk;
  4774 
  4775   p = features;
  4776   *p = '\0';
  4777   for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
  4778     {
  4779       val = XCAR (spec);
  4780       CHECK_SYMBOL (val);
  4781       if (p > features)
  4782         *p++ = ',';
  4783       if (SREF (SYMBOL_NAME (val), 0) == '*')
  4784         {
  4785           asterisk = 1;
  4786           *p++ = '*';
  4787         }
  4788       else if (! asterisk)
  4789         {
  4790           val = SYMBOL_NAME (val);
  4791           p += esprintf (p, "%s", SDATA (val));
  4792         }
  4793       else
  4794         {
  4795           val = SYMBOL_NAME (val);
  4796           p += esprintf (p, "~%s", SDATA (val));
  4797         }
  4798     }
  4799   if (CONSP (spec))
  4800     error ("OTF spec too long");
  4801 }
  4802 
  4803 Lisp_Object
  4804 font_otf_DeviceTable (OTF_DeviceTable *device_table)
  4805 {
  4806   int len = device_table->StartSize - device_table->EndSize + 1;
  4807 
  4808   return Fcons (make_fixnum (len),
  4809                 make_unibyte_string (device_table->DeltaValue, len));
  4810 }
  4811 
  4812 Lisp_Object
  4813 font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
  4814 {
  4815   Lisp_Object val = make_nil_vector (8);
  4816 
  4817   if (value_format & OTF_XPlacement)
  4818     ASET (val, 0, make_fixnum (value_record->XPlacement));
  4819   if (value_format & OTF_YPlacement)
  4820     ASET (val, 1, make_fixnum (value_record->YPlacement));
  4821   if (value_format & OTF_XAdvance)
  4822     ASET (val, 2, make_fixnum (value_record->XAdvance));
  4823   if (value_format & OTF_YAdvance)
  4824     ASET (val, 3, make_fixnum (value_record->YAdvance));
  4825   if (value_format & OTF_XPlaDevice)
  4826     ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
  4827   if (value_format & OTF_YPlaDevice)
  4828     ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
  4829   if (value_format & OTF_XAdvDevice)
  4830     ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
  4831   if (value_format & OTF_YAdvDevice)
  4832     ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
  4833   return val;
  4834 }
  4835 
  4836 Lisp_Object
  4837 font_otf_Anchor (OTF_Anchor *anchor)
  4838 {
  4839   Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
  4840   ASET (val, 0, make_fixnum (anchor->XCoordinate));
  4841   ASET (val, 1, make_fixnum (anchor->YCoordinate));
  4842   if (anchor->AnchorFormat == 2)
  4843     ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
  4844   else
  4845     {
  4846       ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
  4847       ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
  4848     }
  4849   return val;
  4850 }
  4851 #endif  /* HAVE_LIBOTF */
  4852 
  4853 DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
  4854        doc: /* Apply OpenType features on glyph-string GSTRING-IN.
  4855 OTF-FEATURES specifies which features to apply in this format:
  4856   (SCRIPT LANGSYS GSUB GPOS)
  4857 where
  4858   SCRIPT is a symbol specifying a script tag of OpenType,
  4859   LANGSYS is a symbol specifying a langsys tag of OpenType,
  4860   GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
  4861 
  4862 If LANGSYS is nil, the default langsys is selected.
  4863 
  4864 The features are applied in the order they appear in the list.  The
  4865 symbol `*' means to apply all available features not present in this
  4866 list, and the remaining features are ignored.  For instance, (vatu
  4867 pstf * haln) is to apply vatu and pstf in this order, then to apply
  4868 all available features other than vatu, pstf, and haln.
  4869 
  4870 The features are applied to the glyphs in the range FROM and TO of
  4871 the glyph-string GSTRING-IN.
  4872 
  4873 If some feature is actually applicable, the resulting glyphs are
  4874 produced in the glyph-string GSTRING-OUT from the index INDEX.  In
  4875 this case, the value is the number of produced glyphs.
  4876 
  4877 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
  4878 the value is 0.
  4879 
  4880 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
  4881 produced in GSTRING-OUT, and the value is nil.
  4882 
  4883 See the documentation of `composition-get-gstring' for the format of
  4884 glyph-string.  */)
  4885   (Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object index)
  4886 {
  4887   Lisp_Object font_object = LGSTRING_FONT (gstring_in);
  4888   Lisp_Object val;
  4889   struct font *font;
  4890   int len, num;
  4891 
  4892   check_otf_features (otf_features);
  4893   CHECK_FONT_OBJECT (font_object);
  4894   font = XFONT_OBJECT (font_object);
  4895   if (! font->driver->otf_drive)
  4896     error ("Font backend %s can't drive OpenType GSUB table",
  4897            SDATA (SYMBOL_NAME (font->driver->type)));
  4898   CHECK_CONS (otf_features);
  4899   CHECK_SYMBOL (XCAR (otf_features));
  4900   val = XCDR (otf_features);
  4901   CHECK_SYMBOL (XCAR (val));
  4902   val = XCDR (otf_features);
  4903   if (! NILP (val))
  4904     CHECK_CONS (val);
  4905   len = check_gstring (gstring_in);
  4906   CHECK_VECTOR (gstring_out);
  4907   CHECK_FIXNAT (from);
  4908   CHECK_FIXNAT (to);
  4909   CHECK_FIXNAT (index);
  4910 
  4911   if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len)
  4912     args_out_of_range_3 (from, to, make_fixnum (len));
  4913   if (XFIXNUM (index) >= ASIZE (gstring_out))
  4914     args_out_of_range (index, make_fixnum (ASIZE (gstring_out)));
  4915   num = font->driver->otf_drive (font, otf_features,
  4916                                  gstring_in, XFIXNUM (from), XFIXNUM (to),
  4917                                  gstring_out, XFIXNUM (index), 0);
  4918   if (num < 0)
  4919     return Qnil;
  4920   return make_fixnum (num);
  4921 }
  4922 
  4923 DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
  4924        3, 3, 0,
  4925        doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
  4926 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
  4927 in this format:
  4928   (SCRIPT LANGSYS FEATURE ...)
  4929 See the documentation of `font-drive-otf' for more detail.
  4930 
  4931 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
  4932 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
  4933 character code corresponding to the glyph or nil if there's no
  4934 corresponding character.  */)
  4935   (Lisp_Object font_object, Lisp_Object character, Lisp_Object otf_features)
  4936 {
  4937   struct font *font = CHECK_FONT_GET_OBJECT (font_object);
  4938   Lisp_Object gstring_in, gstring_out, g;
  4939   Lisp_Object alternates;
  4940   int i, num;
  4941 
  4942   if (! font->driver->otf_drive)
  4943     error ("Font backend %s can't drive OpenType GSUB table",
  4944            SDATA (SYMBOL_NAME (font->driver->type)));
  4945   CHECK_CHARACTER (character);
  4946   CHECK_CONS (otf_features);
  4947 
  4948   gstring_in = Ffont_make_gstring (font_object, make_fixnum (1));
  4949   g = LGSTRING_GLYPH (gstring_in, 0);
  4950   LGLYPH_SET_CHAR (g, XFIXNUM (character));
  4951   gstring_out = Ffont_make_gstring (font_object, make_fixnum (10));
  4952   while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
  4953                                          gstring_out, 0, 1)) < 0)
  4954     gstring_out = Ffont_make_gstring (font_object,
  4955                                       make_fixnum (ASIZE (gstring_out) * 2));
  4956   alternates = Qnil;
  4957   for (i = 0; i < num; i++)
  4958     {
  4959       Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
  4960       int c = LGLYPH_CHAR (g);
  4961       unsigned code = LGLYPH_CODE (g);
  4962 
  4963       alternates = Fcons (Fcons (make_fixnum (code),
  4964                                  c > 0 ? make_fixnum (c) : Qnil),
  4965                           alternates);
  4966     }
  4967   return Fnreverse (alternates);
  4968 }
  4969 #endif  /* 0 */
  4970 
  4971 
  4972 #ifdef FONT_DEBUG
  4973 
  4974 DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
  4975        doc: /* Open FONT-ENTITY.  */)
  4976   (Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame)
  4977 {
  4978   intmax_t isize;
  4979   struct frame *f = decode_live_frame (frame);
  4980 
  4981   CHECK_FONT_ENTITY (font_entity);
  4982 
  4983   if (NILP (size))
  4984     isize = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX));
  4985   else
  4986     {
  4987       CHECK_NUMBER (size);
  4988       if (FLOATP (size))
  4989         isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES (f));
  4990       else if (! integer_to_intmax (size, &isize))
  4991         args_out_of_range (font_entity, size);
  4992       if (! (INT_MIN <= isize && isize <= INT_MAX))
  4993         args_out_of_range (font_entity, size);
  4994       if (isize == 0)
  4995         isize = 120;
  4996     }
  4997   return font_open_entity (f, font_entity, isize);
  4998 }
  4999 
  5000 DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
  5001        doc: /* Close FONT-OBJECT.  */)
  5002   (Lisp_Object font_object, Lisp_Object frame)
  5003 {
  5004   CHECK_FONT_OBJECT (font_object);
  5005   font_close_object (decode_live_frame (frame), font_object);
  5006   return Qnil;
  5007 }
  5008 
  5009 DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
  5010        doc: /* Return information about FONT-OBJECT.
  5011 The value is a vector:
  5012   [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
  5013     CAPABILITY ]
  5014 
  5015 NAME is the font name, a string (or nil if the font backend doesn't
  5016 provide a name).
  5017 
  5018 FILENAME is the font file name, a string (or nil if the font backend
  5019 doesn't provide a file name).
  5020 
  5021 PIXEL-SIZE is a pixel size by which the font is opened.
  5022 
  5023 SIZE is a maximum advance width of the font in pixels.
  5024 
  5025 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
  5026 pixels.
  5027 
  5028 CAPABILITY is a list whose first element is a symbol representing the
  5029 font format (x, opentype, truetype, type1, pcf, or bdf) and the
  5030 remaining elements describe the details of the font capability.
  5031 
  5032 If the font is OpenType font, the form of the list is
  5033   (opentype GSUB GPOS)
  5034 where GSUB shows which "GSUB" features the font supports, and GPOS
  5035 shows which "GPOS" features the font supports.  Both GSUB and GPOS are
  5036 lists of the format:
  5037   ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
  5038 
  5039 If the font is not OpenType font, currently the length of the form is
  5040 one.
  5041 
  5042 SCRIPT is a symbol representing OpenType script tag.
  5043 
  5044 LANGSYS is a symbol representing OpenType langsys tag, or nil
  5045 representing the default langsys.
  5046 
  5047 FEATURE is a symbol representing OpenType feature tag.
  5048 
  5049 If the font is not OpenType font, CAPABILITY is nil.  */)
  5050   (Lisp_Object font_object)
  5051 {
  5052   struct font *font = CHECK_FONT_GET_OBJECT (font_object);
  5053   return CALLN (Fvector,
  5054                 AREF (font_object, FONT_NAME_INDEX),
  5055                 AREF (font_object, FONT_FILE_INDEX),
  5056                 make_fixnum (font->pixel_size),
  5057                 make_fixnum (font->max_width),
  5058                 make_fixnum (font->ascent),
  5059                 make_fixnum (font->descent),
  5060                 make_fixnum (font->space_width),
  5061                 make_fixnum (font->average_width),
  5062                 (font->driver->otf_capability
  5063                  ? Fcons (Qopentype, font->driver->otf_capability (font))
  5064                  : Qnil));
  5065 }
  5066 
  5067 DEFUN ("font-has-char-p", Ffont_has_char_p, Sfont_has_char_p, 2, 3, 0,
  5068        doc:
  5069        /* Return non-nil if FONT on FRAME has a glyph for character CH.
  5070 FONT can be either a font-entity or a font-object.  If it is
  5071 a font-entity and the result is nil, it means the font needs to be
  5072 opened (with `open-font') to check.
  5073 FRAME defaults to the selected frame if it is nil or omitted.  */)
  5074   (Lisp_Object font, Lisp_Object ch, Lisp_Object frame)
  5075 {
  5076   struct frame *f;
  5077   CHECK_FONT (font);
  5078   CHECK_CHARACTER (ch);
  5079 
  5080   if (NILP (frame))
  5081     f = XFRAME (selected_frame);
  5082   else
  5083     {
  5084       CHECK_FRAME (frame);
  5085       f = XFRAME (frame);
  5086     }
  5087 
  5088   if (font_has_char (f, font, XFIXNAT (ch)) <= 0)
  5089     return Qnil;
  5090   else
  5091     return Qt;
  5092 }
  5093 
  5094 DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
  5095        doc:
  5096        /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
  5097 FROM and TO are positions (integers or markers) specifying a region
  5098 of the current buffer, and can be in either order.  If the optional
  5099 fourth arg OBJECT is not nil, it is a string or a vector containing
  5100 the target characters between indices FROM and TO, which are treated
  5101 as in `substring'.
  5102 
  5103 Each element is a vector containing information of a glyph in this format:
  5104   [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
  5105 where
  5106   FROM is an index numbers of a character the glyph corresponds to.
  5107   TO is the same as FROM.
  5108   C is the character of the glyph.
  5109   CODE is the glyph-code of C in FONT-OBJECT.
  5110   WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
  5111   ADJUSTMENT is always nil.
  5112 
  5113 If FONT-OBJECT doesn't have a glyph for a character, the corresponding
  5114 element is nil.
  5115 
  5116 Also see `font-has-char-p', which is more efficient than this function
  5117 if you just want to check whether FONT-OBJECT has a glyph for a
  5118 character.  */)
  5119   (Lisp_Object font_object, Lisp_Object from, Lisp_Object to,
  5120    Lisp_Object object)
  5121 {
  5122   struct font *font = CHECK_FONT_GET_OBJECT (font_object);
  5123   ptrdiff_t len;
  5124   Lisp_Object *chars;
  5125   USE_SAFE_ALLOCA;
  5126 
  5127   if (NILP (object))
  5128     {
  5129       ptrdiff_t charpos, bytepos;
  5130 
  5131       validate_region (&from, &to);
  5132       if (EQ (from, to))
  5133         return Qnil;
  5134       len = XFIXNAT (to) - XFIXNAT (from);
  5135       SAFE_ALLOCA_LISP (chars, len);
  5136       charpos = XFIXNAT (from);
  5137       bytepos = CHAR_TO_BYTE (charpos);
  5138       for (ptrdiff_t i = 0; charpos < XFIXNAT (to); i++)
  5139         {
  5140           int c = fetch_char_advance (&charpos, &bytepos);
  5141           chars[i] = make_fixnum (c);
  5142         }
  5143     }
  5144   else if (STRINGP (object))
  5145     {
  5146       const unsigned char *p;
  5147       ptrdiff_t ifrom, ito;
  5148 
  5149       validate_subarray (object, from, to, SCHARS (object), &ifrom, &ito);
  5150       if (ifrom == ito)
  5151         return Qnil;
  5152       len = ito - ifrom;
  5153       SAFE_ALLOCA_LISP (chars, len);
  5154       p = SDATA (object);
  5155       if (STRING_MULTIBYTE (object))
  5156         {
  5157           int c;
  5158 
  5159           /* Skip IFROM characters from the beginning.  */
  5160           for (ptrdiff_t i = 0; i < ifrom; i++)
  5161             p += BYTES_BY_CHAR_HEAD (*p);
  5162 
  5163           /* Now fetch an interesting characters.  */
  5164           for (ptrdiff_t i = 0; i < len; i++)
  5165             {
  5166               c = string_char_advance (&p);
  5167               chars[i] = make_fixnum (c);
  5168             }
  5169         }
  5170       else
  5171         for (ptrdiff_t i = 0; i < len; i++)
  5172           chars[i] = make_fixnum (p[ifrom + i]);
  5173     }
  5174   else if (VECTORP (object))
  5175     {
  5176       ptrdiff_t ifrom, ito;
  5177 
  5178       validate_subarray (object, from, to, ASIZE (object), &ifrom, &ito);
  5179       if (ifrom == ito)
  5180         return Qnil;
  5181       len = ito - ifrom;
  5182       for (ptrdiff_t i = 0; i < len; i++)
  5183         {
  5184           Lisp_Object elt = AREF (object, ifrom + i);
  5185           CHECK_CHARACTER (elt);
  5186         }
  5187       chars = aref_addr (object, ifrom);
  5188     }
  5189   else
  5190     wrong_type_argument (Qarrayp, object);
  5191 
  5192   Lisp_Object vec = make_nil_vector (len);
  5193   for (ptrdiff_t i = 0; i < len; i++)
  5194     {
  5195       Lisp_Object g;
  5196       int c = XFIXNAT (chars[i]);
  5197       unsigned code;
  5198       struct font_metrics metrics;
  5199 
  5200       code = font->driver->encode_char (font, c);
  5201       if (code == FONT_INVALID_CODE)
  5202         {
  5203           ASET (vec, i, Qnil);
  5204           continue;
  5205         }
  5206       g = LGLYPH_NEW ();
  5207       LGLYPH_SET_FROM (g, i);
  5208       LGLYPH_SET_TO (g, i);
  5209       LGLYPH_SET_CHAR (g, c);
  5210       LGLYPH_SET_CODE (g, code);
  5211       font->driver->text_extents (font, &code, 1, &metrics);
  5212       LGLYPH_SET_WIDTH (g, metrics.width);
  5213       LGLYPH_SET_LBEARING (g, metrics.lbearing);
  5214       LGLYPH_SET_RBEARING (g, metrics.rbearing);
  5215       LGLYPH_SET_ASCENT (g, metrics.ascent);
  5216       LGLYPH_SET_DESCENT (g, metrics.descent);
  5217       ASET (vec, i, g);
  5218     }
  5219   if (! VECTORP (object))
  5220     SAFE_FREE ();
  5221   return vec;
  5222 }
  5223 
  5224 DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
  5225        doc: /* Return t if and only if font-spec SPEC matches with FONT.
  5226 FONT is a font-spec, font-entity, or font-object. */)
  5227   (Lisp_Object spec, Lisp_Object font)
  5228 {
  5229   CHECK_FONT_SPEC (spec);
  5230   CHECK_FONT (font);
  5231 
  5232   return (font_match_p (spec, font) ? Qt : Qnil);
  5233 }
  5234 
  5235 DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0,
  5236        doc: /* Return a font-object for displaying a character at POSITION.
  5237 Optional second arg WINDOW, if non-nil, is a window displaying
  5238 the current buffer.  It defaults to the currently selected window.
  5239 Optional third arg STRING, if non-nil, is a string containing the target
  5240 character at index specified by POSITION.  */)
  5241   (Lisp_Object position, Lisp_Object window, Lisp_Object string)
  5242 {
  5243   struct window *w = decode_live_window (window);
  5244   EMACS_INT pos;
  5245 
  5246   if (NILP (string))
  5247     {
  5248       if (XBUFFER (w->contents) != current_buffer)
  5249         error ("Specified window is not displaying the current buffer");
  5250       pos = fix_position (position);
  5251       if (! (BEGV <= pos && pos < ZV))
  5252         args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
  5253     }
  5254   else
  5255     {
  5256       CHECK_FIXNUM (position);
  5257       CHECK_STRING (string);
  5258       pos = XFIXNUM (position);
  5259       if (! (0 <= pos && pos < SCHARS (string)))
  5260         args_out_of_range (string, position);
  5261     }
  5262 
  5263   return font_at (-1, pos, NULL, w, string);
  5264 }
  5265 
  5266 #if 0
  5267 DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
  5268        doc: /*  Draw STRING by FONT-OBJECT on the top left corner of the current frame.
  5269 The value is a number of glyphs drawn.
  5270 Type C-l to recover what previously shown.  */)
  5271   (Lisp_Object font_object, Lisp_Object string)
  5272 {
  5273   Lisp_Object frame = selected_frame;
  5274   struct frame *f = XFRAME (frame);
  5275   struct font *font;
  5276   struct face *face;
  5277   int i, len, width;
  5278   unsigned *code;
  5279 
  5280   CHECK_FONT_GET_OBJECT (font_object, font);
  5281   CHECK_STRING (string);
  5282   len = SCHARS (string);
  5283   code = alloca (sizeof (unsigned) * len);
  5284   for (i = 0; i < len; i++)
  5285     {
  5286       Lisp_Object ch = Faref (string, make_fixnum (i));
  5287       Lisp_Object val;
  5288       int c = XFIXNUM (ch);
  5289 
  5290       code[i] = font->driver->encode_char (font, c);
  5291       if (code[i] == FONT_INVALID_CODE)
  5292         break;
  5293     }
  5294   face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  5295   face->fontp = font;
  5296   if (font->driver->prepare_face)
  5297     font->driver->prepare_face (f, face);
  5298   width = font->driver->text_extents (font, code, i, NULL);
  5299   len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
  5300   if (font->driver->done_face)
  5301     font->driver->done_face (f, face);
  5302   face->fontp = NULL;
  5303   return make_fixnum (len);
  5304 }
  5305 #endif
  5306 
  5307 DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0,
  5308        doc: /* Return FRAME's font cache.  Mainly used for debugging.
  5309 If FRAME is omitted or nil, use the selected frame.  */)
  5310   (Lisp_Object frame)
  5311 {
  5312 #ifdef HAVE_WINDOW_SYSTEM
  5313   struct frame *f = decode_live_frame (frame);
  5314 
  5315   if (FRAME_WINDOW_P (f))
  5316     return FRAME_DISPLAY_INFO (f)->name_list_element;
  5317   else
  5318 #endif
  5319     return Qnil;
  5320 }
  5321 
  5322 #endif  /* FONT_DEBUG */
  5323 
  5324 #ifdef HAVE_WINDOW_SYSTEM
  5325 
  5326 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
  5327        doc: /* Return information about a font named NAME on frame FRAME.
  5328 If FRAME is omitted or nil, use the selected frame.
  5329 
  5330 The returned value is a vector of 14 elements:
  5331   [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
  5332     DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
  5333     FILENAME CAPABILITY ]
  5334 where
  5335   OPENED-NAME is the name used for opening the font,
  5336   FULL-NAME is the full name of the font,
  5337   SIZE is the pixelsize of the font,
  5338   HEIGHT is the pixel-height of the font (i.e., ascent + descent),
  5339   BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
  5340   RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
  5341     how to compose characters,
  5342   MAX-WIDTH is the maximum advance width of the font,
  5343   ASCENT, DESCENT, SPACE-WIDTH, and AVERAGE-WIDTH are metrics of
  5344     the font in pixels,
  5345   FILENAME is the font file name, a string (or nil if the font backend
  5346     doesn't provide a file name).
  5347   CAPABILITY is a list whose first element is a symbol representing the
  5348     font format, one of `x', `opentype', `truetype', `type1', `pcf', or `bdf'.
  5349     The remaining elements describe the details of the font capabilities,
  5350     as follows:
  5351 
  5352       If the font is OpenType font, the form of the list is
  5353         (opentype GSUB GPOS)
  5354       where GSUB shows which "GSUB" features the font supports, and GPOS
  5355       shows which "GPOS" features the font supports.  Both GSUB and GPOS are
  5356       lists of the form:
  5357         ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
  5358 
  5359       where
  5360         SCRIPT is a symbol representing OpenType script tag.
  5361         LANGSYS is a symbol representing OpenType langsys tag, or nil
  5362          representing the default langsys.
  5363         FEATURE is a symbol representing OpenType feature tag.
  5364 
  5365       If the font is not an OpenType font, there are no elements
  5366       in CAPABILITY except the font format symbol.
  5367 
  5368 If the named font cannot be opened and loaded, return nil.  */)
  5369   (Lisp_Object name, Lisp_Object frame)
  5370 {
  5371   struct frame *f;
  5372   struct font *font;
  5373   Lisp_Object info;
  5374   Lisp_Object font_object;
  5375 
  5376   if (! FONTP (name))
  5377     CHECK_STRING (name);
  5378   f = decode_window_system_frame (frame);
  5379 
  5380   if (STRINGP (name))
  5381     {
  5382       int fontset = fs_query_fontset (name, 0);
  5383 
  5384       if (fontset >= 0)
  5385         name = fontset_ascii (fontset);
  5386       font_object = font_open_by_name (f, name);
  5387     }
  5388   else if (FONT_OBJECT_P (name))
  5389     font_object = name;
  5390   else if (FONT_ENTITY_P (name))
  5391     font_object = font_open_entity (f, name, 0);
  5392   else
  5393     {
  5394       struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  5395       Lisp_Object entity = font_matching_entity (f, face->lface, name);
  5396 
  5397       font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
  5398     }
  5399   if (NILP (font_object))
  5400     return Qnil;
  5401   font = XFONT_OBJECT (font_object);
  5402 
  5403   /* Sanity check to make sure we have initialized max_width.  */
  5404   eassert (XFONT_OBJECT (font_object)->max_width < 1024 * 1024 * 1024);
  5405 
  5406   info = CALLN (Fvector,
  5407                 AREF (font_object, FONT_NAME_INDEX),
  5408                 AREF (font_object, FONT_FULLNAME_INDEX),
  5409                 make_fixnum (font->pixel_size),
  5410                 make_fixnum (font->height),
  5411                 make_fixnum (font->baseline_offset),
  5412                 make_fixnum (font->relative_compose),
  5413                 make_fixnum (font->default_ascent),
  5414                 make_fixnum (font->max_width),
  5415                 make_fixnum (font->ascent),
  5416                 make_fixnum (font->descent),
  5417                 make_fixnum (font->space_width),
  5418                 make_fixnum (font->average_width),
  5419                 AREF (font_object, FONT_FILE_INDEX),
  5420                 (font->driver->otf_capability
  5421                  ? Fcons (Qopentype, font->driver->otf_capability (font))
  5422                  : Qnil));
  5423 
  5424 #if 0
  5425   /* As font_object is still in FONT_OBJLIST of the entity, we can't
  5426      close it now.  Perhaps, we should manage font-objects
  5427      by `reference-count'.  */
  5428   font_close_object (f, font_object);
  5429 #endif
  5430   return info;
  5431 }
  5432 #endif
  5433 
  5434 
  5435 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
  5436 
  5437 static Lisp_Object
  5438 build_style_table (const struct table_entry *entry, int nelement)
  5439 {
  5440   Lisp_Object table = make_nil_vector (nelement);
  5441   for (int i = 0; i < nelement; i++)
  5442     {
  5443       int j;
  5444       for (j = 0; entry[i].names[j]; j++)
  5445         continue;
  5446       Lisp_Object elt = make_nil_vector (j + 1);
  5447       ASET (elt, 0, make_fixnum (entry[i].numeric));
  5448       for (j = 0; entry[i].names[j]; j++)
  5449         ASET (elt, j + 1, intern_c_string (entry[i].names[j]));
  5450       ASET (table, i, elt);
  5451     }
  5452   return table;
  5453 }
  5454 
  5455 /* The deferred font-log data of the form [ACTION ARG RESULT].
  5456    If ACTION is not nil, that is added to the log when font_add_log is
  5457    called next time.  At that time, ACTION is set back to nil.  */
  5458 static Lisp_Object Vfont_log_deferred;
  5459 
  5460 /* Prepend the font-related logging data in Vfont_log if it is not
  5461    t.  ACTION describes a kind of font-related action (e.g. listing,
  5462    opening), ARG is the argument for the action, and RESULT is the
  5463    result of the action.  */
  5464 void
  5465 font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
  5466 {
  5467   Lisp_Object val;
  5468   int i;
  5469 
  5470   if (EQ (Vfont_log, Qt))
  5471     return;
  5472   if (STRINGP (AREF (Vfont_log_deferred, 0)))
  5473     {
  5474       char *str = SSDATA (AREF (Vfont_log_deferred, 0));
  5475 
  5476       ASET (Vfont_log_deferred, 0, Qnil);
  5477       font_add_log (str, AREF (Vfont_log_deferred, 1),
  5478                     AREF (Vfont_log_deferred, 2));
  5479     }
  5480 
  5481   if (FONTP (arg))
  5482     {
  5483       Lisp_Object tail, elt;
  5484       AUTO_STRING (equal, "=");
  5485 
  5486       val = Ffont_xlfd_name (arg, Qt);
  5487       for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
  5488            tail = XCDR (tail))
  5489         {
  5490           elt = XCAR (tail);
  5491           if (EQ (XCAR (elt), QCscript)
  5492               && SYMBOLP (XCDR (elt)))
  5493             val = concat3 (val, SYMBOL_NAME (QCscript),
  5494                            concat2 (equal, SYMBOL_NAME (XCDR (elt))));
  5495           else if (EQ (XCAR (elt), QClang)
  5496                    && SYMBOLP (XCDR (elt)))
  5497             val = concat3 (val, SYMBOL_NAME (QClang),
  5498                            concat2 (equal, SYMBOL_NAME (XCDR (elt))));
  5499           else if (EQ (XCAR (elt), QCotf)
  5500                    && CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
  5501             val = concat3 (val, SYMBOL_NAME (QCotf),
  5502                            concat2 (equal, SYMBOL_NAME (XCAR (XCDR (elt)))));
  5503         }
  5504       arg = val;
  5505     }
  5506 
  5507   if (CONSP (result)
  5508       && VECTORP (XCAR (result))
  5509       && ASIZE (XCAR (result)) > 0
  5510       && FONTP (AREF (XCAR (result), 0)))
  5511     result = font_vconcat_entity_vectors (result);
  5512   if (FONTP (result))
  5513     {
  5514       val = Ffont_xlfd_name (result, Qt);
  5515       if (! FONT_SPEC_P (result))
  5516         {
  5517           AUTO_STRING (colon, ":");
  5518           val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
  5519                          colon, val);
  5520         }
  5521       result = val;
  5522     }
  5523   else if (CONSP (result))
  5524     {
  5525       Lisp_Object tail;
  5526       result = Fcopy_sequence (result);
  5527       for (tail = result; CONSP (tail); tail = XCDR (tail))
  5528         {
  5529           val = XCAR (tail);
  5530           if (FONTP (val))
  5531             val = Ffont_xlfd_name (val, Qt);
  5532           XSETCAR (tail, val);
  5533         }
  5534     }
  5535   else if (VECTORP (result))
  5536     {
  5537       result = Fcopy_sequence (result);
  5538       for (i = 0; i < ASIZE (result); i++)
  5539         {
  5540           val = AREF (result, i);
  5541           if (FONTP (val))
  5542             val = Ffont_xlfd_name (val, Qt);
  5543           ASET (result, i, val);
  5544         }
  5545     }
  5546   Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
  5547 }
  5548 
  5549 /* Record a font-related logging data to be added to Vfont_log when
  5550    font_add_log is called next time.  ACTION, ARG, RESULT are the same
  5551    as font_add_log.  */
  5552 
  5553 void
  5554 font_deferred_log (const char *action, Lisp_Object arg, Lisp_Object result)
  5555 {
  5556   if (EQ (Vfont_log, Qt))
  5557     return;
  5558   ASET (Vfont_log_deferred, 0, build_string (action));
  5559   ASET (Vfont_log_deferred, 1, arg);
  5560   ASET (Vfont_log_deferred, 2, result);
  5561 }
  5562 
  5563 void
  5564 font_drop_xrender_surfaces (struct frame *f)
  5565 {
  5566   struct font_driver_list *list;
  5567 
  5568   for (list = f->font_driver_list; list; list = list->next)
  5569     if (list->on && list->driver->drop_xrender_surfaces)
  5570       list->driver->drop_xrender_surfaces (f);
  5571 }
  5572 
  5573 void
  5574 syms_of_font (void)
  5575 {
  5576   sort_shift_bits[FONT_TYPE_INDEX] = 0;
  5577   sort_shift_bits[FONT_SLANT_INDEX] = 2;
  5578   sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
  5579   sort_shift_bits[FONT_SIZE_INDEX] = 16;
  5580   sort_shift_bits[FONT_WIDTH_INDEX] = 23;
  5581   /* Note that the other elements in sort_shift_bits are not used.  */
  5582   PDUMPER_REMEMBER_SCALAR (sort_shift_bits);
  5583 
  5584   font_charset_alist = Qnil;
  5585   staticpro (&font_charset_alist);
  5586 
  5587   DEFSYM (Qopentype, "opentype");
  5588 
  5589   /* Currently used by hbfont.c, which has no syms_of_hbfont function
  5590      of its own.  */
  5591   DEFSYM (Qcanonical_combining_class, "canonical-combining-class");
  5592 
  5593   /* Important character set symbols.  */
  5594   DEFSYM (Qascii_0, "ascii-0");
  5595   DEFSYM (Qiso8859_1, "iso8859-1");
  5596   DEFSYM (Qiso10646_1, "iso10646-1");
  5597   DEFSYM (Qunicode_bmp, "unicode-bmp");
  5598   DEFSYM (Qemoji, "emoji");
  5599 
  5600   /* Symbols representing keys of font extra info.  */
  5601   DEFSYM (QCotf, ":otf");
  5602   DEFSYM (QClang, ":lang");
  5603   DEFSYM (QCscript, ":script");
  5604   DEFSYM (QCantialias, ":antialias");
  5605   DEFSYM (QCfoundry, ":foundry");
  5606   DEFSYM (QCadstyle, ":adstyle");
  5607   DEFSYM (QCregistry, ":registry");
  5608   DEFSYM (QCspacing, ":spacing");
  5609   DEFSYM (QCdpi, ":dpi");
  5610   DEFSYM (QCscalable, ":scalable");
  5611   DEFSYM (QCavgwidth, ":avgwidth");
  5612   DEFSYM (QCfont_entity, ":font-entity");
  5613   DEFSYM (QCcombining_capability, ":combining-capability");
  5614 
  5615   /* Symbols representing values of font spacing property.  */
  5616   DEFSYM (Qc, "c");
  5617   DEFSYM (Qm, "m");
  5618   DEFSYM (Qp, "p");
  5619   DEFSYM (Qd, "d");
  5620 
  5621   /* Special ADSTYLE properties to avoid fonts used for Latin
  5622      characters; used in xfont.c and ftfont.c.  */
  5623   DEFSYM (Qja, "ja");
  5624   DEFSYM (Qko, "ko");
  5625 
  5626   DEFSYM (QCuser_spec, ":user-spec");
  5627 
  5628   /* For shapers that need to know text directionality.  */
  5629   DEFSYM (QL2R, "L2R");
  5630   DEFSYM (QR2L, "R2L");
  5631 
  5632   DEFSYM (Qfont_extra_type, "font-extra-type");
  5633   DEFSYM (Qfont_driver_superseded_by, "font-driver-superseded-by");
  5634 
  5635   scratch_font_spec = Ffont_spec (0, NULL);
  5636   staticpro (&scratch_font_spec);
  5637   scratch_font_prefer = Ffont_spec (0, NULL);
  5638   staticpro (&scratch_font_prefer);
  5639 
  5640   Vfont_log_deferred = make_nil_vector (3);
  5641   staticpro (&Vfont_log_deferred);
  5642 
  5643 #if 0
  5644 #ifdef HAVE_LIBOTF
  5645   staticpro (&otf_list);
  5646   otf_list = Qnil;
  5647 #endif  /* HAVE_LIBOTF */
  5648 #endif  /* 0 */
  5649 
  5650   defsubr (&Sfontp);
  5651   defsubr (&Sfont_spec);
  5652   defsubr (&Sfont_get);
  5653 #ifdef HAVE_WINDOW_SYSTEM
  5654   defsubr (&Sfont_face_attributes);
  5655 #endif
  5656   defsubr (&Sfont_put);
  5657   defsubr (&Slist_fonts);
  5658   defsubr (&Sfont_family_list);
  5659   defsubr (&Sfind_font);
  5660   defsubr (&Sfont_xlfd_name);
  5661   defsubr (&Sclear_font_cache);
  5662   defsubr (&Sfont_shape_gstring);
  5663   defsubr (&Sfont_variation_glyphs);
  5664   defsubr (&Sinternal_char_font);
  5665 #if 0
  5666   defsubr (&Sfont_drive_otf);
  5667   defsubr (&Sfont_otf_alternates);
  5668 #endif  /* 0 */
  5669 
  5670 #ifdef FONT_DEBUG
  5671   defsubr (&Sopen_font);
  5672   defsubr (&Sclose_font);
  5673   defsubr (&Squery_font);
  5674   defsubr (&Sfont_get_glyphs);
  5675   defsubr (&Sfont_has_char_p);
  5676   defsubr (&Sfont_match_p);
  5677   defsubr (&Sfont_at);
  5678 #if 0
  5679   defsubr (&Sdraw_string);
  5680 #endif
  5681   defsubr (&Sframe_font_cache);
  5682 #endif  /* FONT_DEBUG */
  5683 #ifdef HAVE_WINDOW_SYSTEM
  5684   defsubr (&Sfont_info);
  5685 #endif
  5686 
  5687   DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist,
  5688                doc: /*
  5689 Alist of fontname patterns vs the corresponding encoding and repertory info.
  5690 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
  5691 where ENCODING is a charset or a char-table,
  5692 and REPERTORY is a charset, a char-table, or nil.
  5693 
  5694 If ENCODING and REPERTORY are the same, the element can have the form
  5695 \(REGEXP . ENCODING).
  5696 
  5697 ENCODING is for converting a character to a glyph code of the font.
  5698 If ENCODING is a charset, encoding a character by the charset gives
  5699 the corresponding glyph code.  If ENCODING is a char-table, looking up
  5700 the table by a character gives the corresponding glyph code.
  5701 
  5702 REPERTORY specifies a repertory of characters supported by the font.
  5703 If REPERTORY is a charset, all characters belonging to the charset are
  5704 supported.  If REPERTORY is a char-table, all characters who have a
  5705 non-nil value in the table are supported.  If REPERTORY is nil, Emacs
  5706 gets the repertory information by an opened font and ENCODING.  */);
  5707   Vfont_encoding_alist = Qnil;
  5708 
  5709   /* FIXME: These 3 vars are not quite what they appear: setq on them
  5710      won't have any effect other than disconnect them from the style
  5711      table used by the font display code.  So we make them read-only,
  5712      to avoid this confusing situation.  */
  5713 
  5714   DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table,
  5715                doc: /*  Vector of valid font weight values.
  5716 Each element has the form:
  5717     [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
  5718 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols.
  5719 This variable cannot be set; trying to do so will signal an error.  */);
  5720   Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
  5721   make_symbol_constant (intern_c_string ("font-weight-table"));
  5722 
  5723   DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table,
  5724                doc: /*  Vector of font slant symbols vs the corresponding numeric values.
  5725 See `font-weight-table' for the format of the vector.
  5726 This variable cannot be set; trying to do so will signal an error.  */);
  5727   Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
  5728   make_symbol_constant (intern_c_string ("font-slant-table"));
  5729 
  5730   DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table,
  5731                doc: /*  Alist of font width symbols vs the corresponding numeric values.
  5732 See `font-weight-table' for the format of the vector.
  5733 This variable cannot be set; trying to do so will signal an error.  */);
  5734   Vfont_width_table = BUILD_STYLE_TABLE (width_table);
  5735   make_symbol_constant (intern_c_string ("font-width-table"));
  5736 
  5737   staticpro (&font_style_table);
  5738   font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table,
  5739                             Vfont_width_table);
  5740 
  5741   DEFVAR_LISP ("font-log", Vfont_log, doc: /*
  5742 A list that logs font-related actions and results, for debugging.
  5743 The default value is t, which means to suppress logging.
  5744 Set it to nil to enable logging.  If the environment variable
  5745 EMACS_FONT_LOG is set at startup, it defaults to nil.  */);
  5746   Vfont_log = Qnil;
  5747 
  5748   DEFVAR_BOOL ("inhibit-compacting-font-caches", inhibit_compacting_font_caches,
  5749                doc: /*
  5750 If non-nil, don't compact font caches during GC.
  5751 Some large fonts cause lots of consing and trigger GC.  If they
  5752 are removed from the font caches, they will need to be opened
  5753 again during redisplay, which slows down redisplay.  If you
  5754 see font-related delays in displaying some special characters,
  5755 and cannot switch to a smaller font for those characters, set
  5756 this variable non-nil.
  5757 Disabling compaction of font caches might enlarge the Emacs memory
  5758 footprint in sessions that use lots of different fonts.  */);
  5759 
  5760 #ifdef WINDOWSNT
  5761   /* Compacting font caches causes slow redisplay on Windows with many
  5762      large fonts, so we disable it by default.  */
  5763   inhibit_compacting_font_caches = 1;
  5764 #else
  5765   inhibit_compacting_font_caches = 0;
  5766 #endif
  5767 
  5768   DEFVAR_BOOL ("xft-ignore-color-fonts",
  5769                xft_ignore_color_fonts,
  5770                doc: /*
  5771 Non-nil means don't query fontconfig for color fonts, since they often
  5772 cause Xft crashes.  Only has an effect in Xft builds.  */);
  5773   xft_ignore_color_fonts = true;
  5774 
  5775   DEFVAR_BOOL ("query-all-font-backends", query_all_font_backends,
  5776                doc: /*
  5777 If non-nil, attempt to query all available font backends.
  5778 By default Emacs will stop searching for a matching font at the first
  5779 match.  */);
  5780   query_all_font_backends = false;
  5781 
  5782 #ifdef HAVE_WINDOW_SYSTEM
  5783 #ifdef HAVE_FREETYPE
  5784   syms_of_ftfont ();
  5785 #ifdef HAVE_X_WINDOWS
  5786   syms_of_xfont ();
  5787 #ifdef USE_CAIRO
  5788   syms_of_ftcrfont ();
  5789 #else
  5790 #ifdef HAVE_XFT
  5791   syms_of_xftfont ();
  5792 #endif  /* HAVE_XFT */
  5793 #endif  /* not USE_CAIRO */
  5794 #else   /* not HAVE_X_WINDOWS */
  5795 #ifdef USE_CAIRO
  5796   syms_of_ftcrfont ();
  5797 #endif
  5798 #endif  /* not HAVE_X_WINDOWS */
  5799 #else   /* not HAVE_FREETYPE */
  5800 #ifdef HAVE_X_WINDOWS
  5801   syms_of_xfont ();
  5802 #endif  /* HAVE_X_WINDOWS */
  5803 #endif  /* not HAVE_FREETYPE */
  5804 #ifdef HAVE_BDFFONT
  5805   syms_of_bdffont ();
  5806 #endif  /* HAVE_BDFFONT */
  5807 #ifdef HAVE_NTGUI
  5808   syms_of_w32font ();
  5809 #endif  /* HAVE_NTGUI */
  5810 #ifdef USE_BE_CAIRO
  5811   syms_of_ftcrfont ();
  5812 #endif
  5813 #endif  /* HAVE_WINDOW_SYSTEM */
  5814 }
  5815 
  5816 void
  5817 init_font (void)
  5818 {
  5819   Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
  5820 }
/* [<][>][^][v][top][bottom][index][help] */
root/src/font.c

DEFINITIONS
