root/src/fontset.c

DEFINITIONS

1. fontset_id_valid_p
2. set_fontset_id
3. set_fontset_name
4. set_fontset_ascii
5. set_fontset_base
6. set_fontset_frame
7. set_fontset_nofont_face
8. set_fontset_default
9. set_fontset_fallback
10. font_def_new
11. fontset_ref
12. fontset_add
13. fontset_compare_rfontdef
14. reorder_font_vector
15. fontset_get_font_group
16. fontset_find_font
17. fontset_font
18. make_fontset
19. fontset_name
20. fontset_ascii
21. free_face_fontset
22. face_for_char
23. font_for_char
24. make_fontset_for_ascii_face
25. fontset_pattern_regexp
26. fs_query_fontset
27. list_fontsets
28. free_realized_fontsets
29. check_fontset_name
30. accumulate_script_ranges
31. set_fontset_font
32. fontset_from_font
33. update_auto_fontset_alist
34. DEFUN
35. dump_fontset
36. DEFUN
37. syms_of_fontset

     1 /* Fontset handler.
     2 
     3 Copyright (C) 2001-2023 Free Software Foundation, Inc.
     4 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
     5   2005, 2006, 2007, 2008, 2009, 2010, 2011
     6   National Institute of Advanced Industrial Science and Technology (AIST)
     7   Registration Number H14PRO021
     8 Copyright (C) 2003, 2006
     9   National Institute of Advanced Industrial Science and Technology (AIST)
    10   Registration Number H13PRO009
    11 
    12 This file is part of GNU Emacs.
    13 
    14 GNU Emacs is free software: you can redistribute it and/or modify
    15 it under the terms of the GNU General Public License as published by
    16 the Free Software Foundation, either version 3 of the License, or (at
    17 your option) any later version.
    18 
    19 GNU Emacs is distributed in the hope that it will be useful,
    20 but WITHOUT ANY WARRANTY; without even the implied warranty of
    21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    22 GNU General Public License for more details.
    23 
    24 You should have received a copy of the GNU General Public License
    25 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    26 
    27 #include <config.h>
    28 #include <stdio.h>
    29 #include <stdlib.h>
    30 
    31 #include "lisp.h"
    32 #include "blockinput.h"
    33 #include "character.h"
    34 #include "charset.h"
    35 #include "frame.h"
    36 #include "dispextern.h"
    37 #include "fontset.h"
    38 #ifdef HAVE_WINDOW_SYSTEM
    39 #include TERM_HEADER
    40 #endif /* HAVE_WINDOW_SYSTEM */
    41 #include "font.h"
    42 #include "pdumper.h"
    43 
    44 /* FONTSET
    45 
    46    A fontset is a collection of font related information to give
    47    similar appearance (style, etc) of characters.  A fontset has two
    48    roles.  One is to use for the frame parameter `font' as if it is an
    49    ASCII font.  In that case, Emacs uses the font specified for
    50    `ascii' script for the frame's default font.
    51 
    52    Another role, the more important one, is to provide information
    53    about which font to use for each non-ASCII character.
    54 
    55    There are two kinds of fontsets; base and realized.  A base fontset
    56    is created by `new-fontset' from Emacs Lisp explicitly.  A realized
    57    fontset is created implicitly when a face is realized for ASCII
    58    characters.  A face is also realized for non-ASCII characters based
    59    on an ASCII face.  All of non-ASCII faces based on the same ASCII
    60    face share the same realized fontset.
    61 
    62    A fontset object is implemented by a char-table whose default value
    63    and parent are always nil.
    64 
    65    An element of a base fontset is a vector of FONT-DEFs which themselves
    66    are vectors of the form [ FONT-SPEC ENCODING REPERTORY ].
    67 
    68    An element of a realized fontset is nil, t, 0, or a cons that has
    69    this from:
    70 
    71         (CHARSET-ORDERED-LIST-TICK . FONT-GROUP)
    72 
    73    CHARSET_ORDERED_LIST_TICK is the same as charset_ordered_list_tick or -1.
    74 
    75    FONT-GROUP is a vector of elements that have this form:
    76 
    77         [ RFONT-DEF0 RFONT-DEF1 ... ]
    78 
    79    Each RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
    80 
    81         [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
    82 
    83    RFONT-DEFn are automatically reordered considering the current
    84    charset priority list, the current language environment, and
    85    priorities determined by font-backends.
    86 
    87    RFONT-DEFn may not be a vector in the following cases.
    88 
    89    The value nil means that we have not yet generated the above vector
    90    from the base of the fontset.
    91 
    92    The value t means that no font is available for the corresponding
    93    range of characters.
    94 
    95    The value 0 means that no font is available for the corresponding
    96    range of characters in this fontset, but may be available in the
    97    fallback font-group or in the default fontset.
    98 
    99    A fontset has 8 extra slots.
   100 
   101    The 1st slot:
   102         base: the ID number of the fontset
   103         realized: Likewise
   104 
   105    The 2nd slot:
   106         base: the name of the fontset
   107         realized: nil
   108 
   109    The 3rd slot:
   110         base: the font name for ASCII characters
   111         realized: nil
   112 
   113    The 4th slot:
   114         base: nil
   115         realized: the base fontset
   116 
   117    The 5th slot:
   118         base: nil
   119         realized: the frame that the fontset belongs to
   120 
   121    The 6th slot:
   122         base: nil
   123         realized: the ID number of a face to use for characters that
   124                   has no font in a realized fontset.
   125 
   126    The 7th slot:
   127         base: nil
   128         realized: If the base is not the default fontset, a fontset
   129                   realized from the default fontset, else nil.
   130 
   131    The 8th slot:
   132         base: Same as element value (but for fallback fonts).
   133         realized: Likewise.
   134 
   135    All fontsets are recorded in the vector Vfontset_table.
   136 
   137 
   138    DEFAULT FONTSET
   139 
   140    There's a special base fontset named `default fontset' which
   141    defines the default font specifications.  When a base fontset
   142    doesn't specify a font for a specific character, the corresponding
   143    value in the default fontset is used.
   144 
   145    The parent of a realized fontset created for such a face that has
   146    no fontset is the default fontset.
   147 
   148 
   149    These structures are hidden from the other codes than this file.
   150    The other codes handle fontsets only by their ID numbers.  They
   151    usually use the variable name `fontset' for IDs.  But, in this
   152    file, we always use variable name `id' for IDs, and name `fontset'
   153    for an actual fontset object, i.e., char-table.
   154 
   155 */
   156 
   157 /********** VARIABLES and FUNCTION PROTOTYPES **********/
   158 
   159 /* Vector containing all fontsets.  */
   160 static Lisp_Object Vfontset_table;
   161 
   162 /* Next possibly free fontset ID.  Usually this keeps the minimum
   163    fontset ID not yet used.  */
   164 static int next_fontset_id;
   165 
   166 /* The default fontset.  This gives default FAMILY and REGISTRY of
   167    font for each character.  */
   168 static Lisp_Object Vdefault_fontset;
   169 
   170 /* Prototype declarations for static functions.  */
   171 static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
   172 
   173 /* Return true if ID is a valid fontset id.
   174    Optimized away if ENABLE_CHECKING is not defined.  */
   175 
   176 static bool
   177 fontset_id_valid_p (int id)
   178 {
   179   return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
   180 }
   181 
   182 
   183 
   184 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
   185 
   186 /* Return the fontset with ID.  No check of ID's validness.  */
   187 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
   188 
   189 /* Access special values of FONTSET.  */
   190 
   191 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
   192 static void
   193 set_fontset_id (Lisp_Object fontset, Lisp_Object id)
   194 {
   195   set_char_table_extras (fontset, 0, id);
   196 }
   197 
   198 /* Access special values of (base) FONTSET.  */
   199 
   200 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
   201 static void
   202 set_fontset_name (Lisp_Object fontset, Lisp_Object name)
   203 {
   204   set_char_table_extras (fontset, 1, name);
   205 }
   206 
   207 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[2]
   208 static void
   209 set_fontset_ascii (Lisp_Object fontset, Lisp_Object ascii)
   210 {
   211   set_char_table_extras (fontset, 2, ascii);
   212 }
   213 
   214 /* Access special values of (realized) FONTSET.  */
   215 
   216 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[3]
   217 static void
   218 set_fontset_base (Lisp_Object fontset, Lisp_Object base)
   219 {
   220   set_char_table_extras (fontset, 3, base);
   221 }
   222 
   223 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[4]
   224 static void
   225 set_fontset_frame (Lisp_Object fontset, Lisp_Object frame)
   226 {
   227   set_char_table_extras (fontset, 4, frame);
   228 }
   229 
   230 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
   231 static void
   232 set_fontset_nofont_face (Lisp_Object fontset, Lisp_Object face)
   233 {
   234   set_char_table_extras (fontset, 5, face);
   235 }
   236 
   237 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[6]
   238 static void
   239 set_fontset_default (Lisp_Object fontset, Lisp_Object def)
   240 {
   241   set_char_table_extras (fontset, 6, def);
   242 }
   243 
   244 /* For both base and realized fontset.  */
   245 
   246 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[7]
   247 static void
   248 set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
   249 {
   250   set_char_table_extras (fontset, 7, fallback);
   251 }
   252 
   253 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
   254 
   255 /* Definitions for FONT-DEF and RFONT-DEF of fontset.  */
   256 static Lisp_Object
   257 font_def_new (Lisp_Object font_spec, Lisp_Object encoding,
   258               Lisp_Object repertory)
   259 {
   260   return CALLN (Fvector, font_spec, encoding, repertory);
   261 }
   262 
   263 #define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
   264 #define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
   265 #define FONT_DEF_REPERTORY(font_def) AREF (font_def, 2)
   266 
   267 #define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
   268 #define RFONT_DEF_SET_FACE(rfont_def, face_id)  \
   269   ASET ((rfont_def), 0, make_fixnum (face_id))
   270 #define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
   271 #define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
   272 #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
   273 #define RFONT_DEF_SET_OBJECT(rfont_def, object) \
   274   ASET ((rfont_def), 2, (object))
   275 /* Score of RFONT_DEF is an integer value; the lowest 8 bits represent
   276    the order of listing by font backends, the higher bits represents
   277    the order given by charset priority list.  The smaller value is
   278    preferable.  */
   279 #define RFONT_DEF_SCORE(rfont_def) XFIXNUM (AREF (rfont_def, 3))
   280 #define RFONT_DEF_SET_SCORE(rfont_def, score) \
   281   ASET ((rfont_def), 3, make_fixnum (score))
   282 #define RFONT_DEF_NEW(rfont_def, font_def)              \
   283   do {                                                  \
   284     (rfont_def) = make_nil_vector (4);                  \
   285     ASET (rfont_def, 1, font_def);                      \
   286     RFONT_DEF_SET_SCORE (rfont_def, 0);                 \
   287   } while (false)
   288 
   289 
   290 /* Return the element of FONTSET for the character C.  If FONTSET is a
   291    base fontset other then the default fontset and FONTSET doesn't
   292    contain information for C, return the information in the default
   293    fontset.  */
   294 
   295 #define FONTSET_REF(fontset, c)         \
   296   (EQ (fontset, Vdefault_fontset)       \
   297    ? CHAR_TABLE_REF (fontset, c)        \
   298    : fontset_ref ((fontset), (c)))
   299 
   300 static Lisp_Object
   301 fontset_ref (Lisp_Object fontset, int c)
   302 {
   303   Lisp_Object elt;
   304 
   305   elt = CHAR_TABLE_REF (fontset, c);
   306   if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
   307       /* Don't check Vdefault_fontset for a realized fontset.  */
   308       && NILP (FONTSET_BASE (fontset)))
   309     elt = CHAR_TABLE_REF (Vdefault_fontset, c);
   310   return elt;
   311 }
   312 
   313 /* Set elements of FONTSET for characters in RANGE to the value ELT.
   314    RANGE is a cons (FROM . TO), where FROM and TO are character codes
   315    specifying a range.  */
   316 
   317 #define FONTSET_SET(fontset, range, elt)        \
   318   Fset_char_table_range ((fontset), (range), (elt))
   319 
   320 
   321 /* Modify the elements of FONTSET for characters in RANGE by replacing
   322    with ELT or adding ELT.  RANGE is a cons (FROM . TO), where FROM
   323    and TO are character codes specifying a range.  If ADD is nil,
   324    replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
   325    append ELT.  */
   326 
   327 #define FONTSET_ADD(fontset, range, elt, add)                           \
   328   (NILP (add)                                                           \
   329    ? (NILP (range)                                                      \
   330       ? set_fontset_fallback (fontset, make_vector (1, elt))            \
   331       : (void) Fset_char_table_range (fontset, range, make_vector (1, elt))) \
   332    : fontset_add ((fontset), (range), (elt), (add)))
   333 
   334 static void
   335 fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
   336 {
   337   Lisp_Object args[2];
   338   int idx = (EQ (add, Qappend) ? 0 : 1);
   339 
   340   args[1 - idx] = make_vector (1, elt);
   341 
   342   if (CONSP (range))
   343     {
   344       int from = XFIXNUM (XCAR (range));
   345       int to = XFIXNUM (XCDR (range));
   346       int from1, to1;
   347 
   348       do {
   349         from1 = from, to1 = to;
   350         args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
   351         char_table_set_range (fontset, from, to1,
   352                               (NILP (args[idx]) ? args[1 - idx]
   353                                : CALLMANY (Fvconcat, args)));
   354         from = to1 + 1;
   355       } while (from <= to);
   356     }
   357   else
   358     {
   359       args[idx] = FONTSET_FALLBACK (fontset);
   360       set_fontset_fallback (fontset,
   361                             (NILP (args[idx]) ? args[1 - idx]
   362                              : CALLMANY (Fvconcat, args)));
   363     }
   364 }
   365 
   366 static int
   367 fontset_compare_rfontdef (const void *val1, const void *val2)
   368 {
   369   Lisp_Object v1 = *(Lisp_Object *) val1, v2 = *(Lisp_Object *) val2;
   370   if (NILP (v1) && NILP (v2))
   371     return 0;
   372   else if (NILP (v1))
   373     return INT_MIN;
   374   else if (NILP (v2))
   375     return INT_MAX;
   376   return (RFONT_DEF_SCORE (v1) - RFONT_DEF_SCORE (v2));
   377 }
   378 
   379 /* Update a cons cell which has this form:
   380         (CHARSET-ORDERED-LIST-TICK . FONT-GROUP)
   381    where FONT-GROUP is of the form
   382         [ PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ... ]
   383    Reorder RFONT-DEFs according to the current language, and update
   384    CHARSET-ORDERED-LIST-TICK.  */
   385 
   386 static void
   387 reorder_font_vector (Lisp_Object font_group, struct font *font)
   388 {
   389   Lisp_Object vec, font_object;
   390   int size;
   391   int i;
   392   bool score_changed = false;
   393 
   394   if (font)
   395     XSETFONT (font_object, font);
   396   else
   397     font_object = Qnil;
   398 
   399   vec = XCDR (font_group);
   400   size = ASIZE (vec);
   401   /* Exclude the tailing nil element from the reordering.  */
   402   if (NILP (AREF (vec, size - 1)))
   403     size--;
   404 
   405   for (i = 0; i < size; i++)
   406     {
   407       Lisp_Object rfont_def = AREF (vec, i);
   408       if (NILP (rfont_def))
   409         continue;
   410       Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
   411       Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
   412       int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
   413       Lisp_Object otf_spec = Ffont_get (font_spec, QCotf);
   414 
   415       if (! NILP (otf_spec))
   416         /* A font-spec with :otf is preferable regardless of encoding
   417            and language..  */
   418         ;
   419       else if (! font_match_p (font_spec, font_object))
   420         {
   421           Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
   422 
   423           if (! NILP (encoding))
   424             {
   425               /* This spec specifies an encoding by a charset set
   426                  name.  Reflect the preference order of that charset
   427                  in the upper bits of SCORE.  */
   428               Lisp_Object tail;
   429 
   430               for (tail = Vcharset_ordered_list;
   431                    ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
   432                    tail = XCDR (tail))
   433                 if (EQ (encoding, XCAR (tail)))
   434                   break;
   435                 else if (score <= min (INT_MAX, MOST_POSITIVE_FIXNUM) - 0x100)
   436                   score += 0x100;
   437             }
   438           else
   439             {
   440               /* This spec does not specify an encoding.  If the spec
   441                  specifies a language, and the language is not for the
   442                  current language environment, make the score
   443                  larger.  */
   444               Lisp_Object lang = Ffont_get (font_spec, QClang);
   445 
   446               if (! NILP (lang)
   447                   && ! EQ (lang, Vcurrent_iso639_language)
   448                   && (! CONSP (Vcurrent_iso639_language)
   449                       || NILP (Fmemq (lang, Vcurrent_iso639_language))))
   450                 score |= 0x100;
   451             }
   452         }
   453       if (RFONT_DEF_SCORE (rfont_def) != score)
   454         {
   455           RFONT_DEF_SET_SCORE (rfont_def, score);
   456           score_changed = true;
   457         }
   458     }
   459 
   460   if (score_changed)
   461     qsort (XVECTOR (vec)->contents, size, word_size,
   462            fontset_compare_rfontdef);
   463   EMACS_INT low_tick_bits = charset_ordered_list_tick & MOST_POSITIVE_FIXNUM;
   464   XSETCAR (font_group, make_fixnum (low_tick_bits));
   465 }
   466 
   467 /* Return a font-group (actually a cons (CHARSET_ORDERED_LIST_TICK
   468    . FONT-GROUP)) for character C or a fallback font-group in the
   469    realized fontset FONTSET.  The elements of FONT-GROUP are
   470    RFONT-DEFs.  The value may not be a cons.  See the comment at the
   471    head of this file for the detail of the return value.  */
   472 
   473 static Lisp_Object
   474 fontset_get_font_group (Lisp_Object fontset, int c)
   475 {
   476   Lisp_Object font_group;
   477   Lisp_Object base_fontset;
   478   int from = 0, to = MAX_CHAR, i;
   479 
   480   eassert (! BASE_FONTSET_P (fontset));
   481   if (c >= 0)
   482     font_group = CHAR_TABLE_REF (fontset, c);
   483   else
   484     font_group = FONTSET_FALLBACK (fontset);
   485   if (! NILP (font_group))
   486     /* We have already realized FONT-DEFs of this font group for C or
   487        for fallback (FONT_GROUP is a cons), or we have already found
   488        that no appropriate font was found (FONT_GROUP is t or 0).  */
   489     return font_group;
   490   base_fontset = FONTSET_BASE (fontset);
   491   if (NILP (base_fontset))
   492     /* Actually we never come here because FONTSET is a realized one,
   493        and thus it should have a base.  */
   494     font_group = Qnil;
   495   else if (c >= 0)
   496     font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
   497   else
   498     font_group = FONTSET_FALLBACK (base_fontset);
   499 
   500   /* FONT_GROUP not being a vector means that no fonts are specified
   501      for C, or the fontset does not have fallback fonts.  */
   502   if (NILP (font_group))
   503     {
   504       font_group = make_fixnum (0);
   505       if (c >= 0)
   506         /* Record that FONTSET does not specify fonts for C.  As
   507            there's a possibility that a font is found in a fallback
   508            font group, we set 0 at the moment.  */
   509         char_table_set_range (fontset, from, to, font_group);
   510       return font_group;
   511     }
   512   if (!VECTORP (font_group))
   513     return font_group;
   514 
   515   /* Now realize FONT-DEFs of this font group, and update the realized
   516      fontset FONTSET. */
   517   font_group = Fcopy_sequence (font_group);
   518   for (i = 0; i < ASIZE (font_group); i++)
   519     if (! NILP (AREF (font_group, i)))
   520       {
   521         Lisp_Object rfont_def;
   522 
   523         RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
   524         /* Remember the original order.  */
   525         RFONT_DEF_SET_SCORE (rfont_def, i);
   526         ASET (font_group, i, rfont_def);
   527       }
   528   font_group = Fcons (make_fixnum (-1), font_group);
   529   if (c >= 0)
   530     char_table_set_range (fontset, from, to, font_group);
   531   else
   532     set_fontset_fallback (fontset, font_group);
   533   return font_group;
   534 }
   535 
   536 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
   537    character C.  If no font is found, return Qnil or 0 if there's a
   538    possibility that the default fontset or the fallback font groups
   539    have a proper font, and return Qt if not.
   540 
   541    If a font is found but is not yet opened, open it (if FACE is not
   542    NULL) or return Qnil (if FACE is NULL).
   543 
   544    CHARSET_ID is a charset-id that must be preferred, or -1 meaning no
   545    preference.
   546 
   547    If FALLBACK, search only fallback fonts.  */
   548 
   549 static Lisp_Object
   550 fontset_find_font (Lisp_Object fontset, int c, struct face *face,
   551                    int charset_id, bool fallback)
   552 {
   553   Lisp_Object vec, font_group;
   554   int i, charset_matched = 0, found_index;
   555   struct frame *f = (FRAMEP (FONTSET_FRAME (fontset))
   556                      ? XFRAME (FONTSET_FRAME (fontset))
   557                      : XFRAME (selected_frame));
   558   Lisp_Object rfont_def;
   559 
   560   font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
   561   if (! CONSP (font_group))
   562     return font_group;
   563   vec = XCDR (font_group);
   564   if (ASIZE (vec) == 0)
   565     return Qnil;
   566 
   567   if (ASIZE (vec) > 1)
   568     {
   569       if (XFIXNUM (XCAR (font_group)) != charset_ordered_list_tick)
   570         /* We have just created the font-group,
   571            or the charset priorities were changed.  */
   572         reorder_font_vector (font_group, face->ascii_face->font);
   573       if (charset_id >= 0)
   574         {
   575           Lisp_Object lcsetid = make_fixnum (charset_id);
   576           /* Find a spec matching with CHARSET_ID to try it at first.  */
   577           for (i = 0; i < ASIZE (vec); i++)
   578             {
   579               Lisp_Object repertory;
   580 
   581               rfont_def = AREF (vec, i);
   582               if (NILP (rfont_def))
   583                 break;
   584               repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
   585 
   586               if (EQ (repertory, lcsetid))
   587                 {
   588                   charset_matched = i;
   589                   break;
   590                 }
   591             }
   592         }
   593     }
   594 
   595   /* Find the first available font in the vector of RFONT-DEF.  If
   596      CHARSET_MATCHED > 0, try the corresponding RFONT-DEF first, then
   597      try the rest.  */
   598   for (i = 0; i < ASIZE (vec); i++)
   599     {
   600       Lisp_Object font_def;
   601       Lisp_Object font_entity, font_object;
   602 
   603       found_index = i;
   604       if (i == 0)
   605         {
   606           if (charset_matched > 0)
   607             {
   608               /* Try the element matching with CHARSET_ID at first.  */
   609               found_index = charset_matched;
   610               /* Make this negative so that we don't come here in the
   611                  next loop.  */
   612               charset_matched = - charset_matched;
   613               /* We must try the first element in the next loop.  */
   614               i = -1;
   615             }
   616         }
   617       else if (i == - charset_matched)
   618         {
   619           /* We have already tried this element and the followings
   620              that have the same font specifications in the first
   621              iteration.  So, skip them all.  */
   622           rfont_def = AREF (vec, i);
   623           font_def = RFONT_DEF_FONT_DEF (rfont_def);
   624           for (; i + 1 < ASIZE (vec); i++)
   625             {
   626               rfont_def = AREF (vec, i + 1);
   627               if (NILP (rfont_def))
   628                 break;
   629               if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
   630                 break;
   631             }
   632           continue;
   633         }
   634 
   635       rfont_def = AREF (vec, found_index);
   636       if (NILP (rfont_def))
   637         {
   638           if (i < 0)
   639             continue;
   640           /* This is a sign of not to try the other fonts.  */
   641           return Qt;
   642         }
   643       if (FIXNUMP (RFONT_DEF_FACE (rfont_def))
   644           && XFIXNUM (RFONT_DEF_FACE (rfont_def)) < 0)
   645         /* We couldn't open this font last time.  */
   646         continue;
   647 
   648       font_object = RFONT_DEF_OBJECT (rfont_def);
   649       if (NILP (font_object))
   650         {
   651           font_def = RFONT_DEF_FONT_DEF (rfont_def);
   652 
   653           if (! face)
   654             /* We have not yet opened the font.  */
   655             return Qnil;
   656           /* Find a font best-matching with the spec without checking
   657              the support of the character C.  That checking is costly,
   658              and even without the checking, the found font supports C
   659              in high possibility.  */
   660           font_entity = font_find_for_lface (f, face->lface,
   661                                              FONT_DEF_SPEC (font_def), -1);
   662           if (NILP (font_entity))
   663             {
   664               /* Record that no font matches the spec.  */
   665               RFONT_DEF_SET_FACE (rfont_def, -1);
   666               continue;
   667             }
   668           font_object = font_open_for_lface (f, font_entity, face->lface,
   669                                              FONT_DEF_SPEC (font_def));
   670 
   671           /* If the font registry is not the same as explicitly
   672              specified in the font spec, do not cache the font.
   673              TrueType fonts have contrived character map selection
   674              semantics which makes determining the repertory at font
   675              spec matching time unduly expensive.  */
   676 
   677           {
   678             Lisp_Object spec;
   679 
   680             spec = FONT_DEF_SPEC (font_def);
   681 
   682             if (!NILP (font_object)
   683                 && !NILP (AREF (spec, FONT_REGISTRY_INDEX))
   684                 && !NILP (AREF (font_object, FONT_REGISTRY_INDEX))
   685                 && !EQ (AREF (spec, FONT_REGISTRY_INDEX),
   686                         AREF (font_object, FONT_REGISTRY_INDEX))
   687                 /* See sfntfont_registries_compatible_p in
   688                    sfntfont.c.  */
   689                 && !(EQ (AREF (spec, FONT_REGISTRY_INDEX),
   690                          Qiso8859_1)
   691                      && EQ (AREF (font_object, FONT_REGISTRY_INDEX),
   692                             Qiso10646_1)))
   693               goto strangeness;
   694           }
   695 
   696           if (NILP (font_object))
   697             {
   698             strangeness:
   699               /* Something strange happened, perhaps because of a
   700                  Font-backend problem.  To avoid crashing, record
   701                  that this spec is unusable.  It may be better to find
   702                  another font of the same spec, but currently we don't
   703                  have such an API in font-backend.  */
   704               RFONT_DEF_SET_FACE (rfont_def, -1);
   705               continue;
   706             }
   707           RFONT_DEF_SET_OBJECT (rfont_def, font_object);
   708         }
   709 
   710       if (font_has_char (f, font_object, c))
   711         goto found;
   712 
   713       /* Find a font already opened, matching with the current spec,
   714          and supporting C. */
   715       font_def = RFONT_DEF_FONT_DEF (rfont_def);
   716       for (; found_index + 1 < ASIZE (vec); found_index++)
   717         {
   718           rfont_def = AREF (vec, found_index + 1);
   719           if (NILP (rfont_def))
   720             break;
   721           if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
   722             break;
   723           font_object = RFONT_DEF_OBJECT (rfont_def);
   724           if (! NILP (font_object) && font_has_char (f, font_object, c))
   725             {
   726               found_index++;
   727               goto found;
   728             }
   729         }
   730 
   731       /* Find a font-entity with the current spec and supporting C.  */
   732       font_entity = font_find_for_lface (f, face->lface,
   733                                          FONT_DEF_SPEC (font_def), c);
   734       if (! NILP (font_entity))
   735         {
   736           /* We found a font.  Open it and insert a new element for
   737              that font in VEC.  */
   738           int j;
   739 
   740           font_object = font_open_for_lface (f, font_entity, face->lface,
   741                                              Qnil);
   742           if (NILP (font_object))
   743             continue;
   744           RFONT_DEF_NEW (rfont_def, font_def);
   745           RFONT_DEF_SET_OBJECT (rfont_def, font_object);
   746           RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
   747           Lisp_Object new_vec = make_nil_vector (ASIZE (vec) + 1);
   748           found_index++;
   749           for (j = 0; j < found_index; j++)
   750             ASET (new_vec, j, AREF (vec, j));
   751           ASET (new_vec, j, rfont_def);
   752           for (j++; j < ASIZE (new_vec); j++)
   753             ASET (new_vec, j, AREF (vec, j - 1));
   754           XSETCDR (font_group, new_vec);
   755           vec = new_vec;
   756           goto found;
   757         }
   758       if (i >= 0)
   759         i = found_index;
   760     }
   761 
   762   /* Record that no font in this font group supports C.  */
   763   FONTSET_SET (fontset, make_fixnum (c), make_fixnum (0));
   764   return Qnil;
   765 
   766  found:
   767   if (fallback && found_index > 0)
   768     {
   769       /* The order of fonts in the fallback font-group is not that
   770          important, and it is better to move the found font to the
   771          first of the group so that the next try will find it
   772          quickly. */
   773       for (i = found_index; i > 0; i--)
   774         ASET (vec, i, AREF (vec, i - 1));
   775       ASET (vec, 0, rfont_def);
   776     }
   777   return rfont_def;
   778 }
   779 
   780 
   781 /* Return RFONT-DEF (vector) corresponding to the font for character
   782    C.  The value is not a vector if no font is found for C.  */
   783 
   784 static Lisp_Object
   785 fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
   786 {
   787   Lisp_Object rfont_def;
   788   Lisp_Object default_rfont_def UNINIT;
   789   Lisp_Object base_fontset;
   790 
   791   /* Try a font-group of FONTSET. */
   792   FONT_DEFERRED_LOG ("current fontset: font for", make_fixnum (c), Qnil);
   793   rfont_def = fontset_find_font (fontset, c, face, id, 0);
   794   if (VECTORP (rfont_def))
   795     return rfont_def;
   796   if (NILP (rfont_def))
   797     FONTSET_SET (fontset, make_fixnum (c), make_fixnum (0));
   798 
   799   /* Try a font-group of the default fontset. */
   800   base_fontset = FONTSET_BASE (fontset);
   801   if (! EQ (base_fontset, Vdefault_fontset))
   802     {
   803       if (NILP (FONTSET_DEFAULT (fontset)))
   804         set_fontset_default
   805           (fontset,
   806            make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
   807       FONT_DEFERRED_LOG ("default fontset: font for", make_fixnum (c), Qnil);
   808       default_rfont_def
   809         = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
   810       if (VECTORP (default_rfont_def))
   811         return default_rfont_def;
   812       if (NILP (default_rfont_def))
   813         FONTSET_SET (FONTSET_DEFAULT (fontset), make_fixnum (c),
   814                      make_fixnum (0));
   815     }
   816 
   817   /* Try a fallback font-group of FONTSET. */
   818   if (! EQ (rfont_def, Qt))
   819     {
   820       FONT_DEFERRED_LOG ("current fallback: font for", make_fixnum (c), Qnil);
   821       rfont_def = fontset_find_font (fontset, c, face, id, 1);
   822       if (VECTORP (rfont_def))
   823         return rfont_def;
   824       /* Remember that FONTSET has no font for C.  */
   825       FONTSET_SET (fontset, make_fixnum (c), Qt);
   826     }
   827 
   828   /* Try a fallback font-group of the default fontset. */
   829   if (! EQ (base_fontset, Vdefault_fontset)
   830       && ! EQ (default_rfont_def, Qt))
   831     {
   832       FONT_DEFERRED_LOG ("default fallback: font for", make_fixnum (c), Qnil);
   833       rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
   834       if (VECTORP (rfont_def))
   835         return rfont_def;
   836       /* Remember that the default fontset has no font for C.  */
   837       FONTSET_SET (FONTSET_DEFAULT (fontset), make_fixnum (c), Qt);
   838     }
   839 
   840   return Qnil;
   841 }
   842 
   843 /* Return a newly created fontset with NAME.  If BASE is nil, make a
   844    base fontset.  Otherwise make a realized fontset whose base is
   845    BASE.  */
   846 
   847 static Lisp_Object
   848 make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
   849 {
   850   Lisp_Object fontset;
   851   int size = ASIZE (Vfontset_table);
   852   int id = next_fontset_id;
   853 
   854   /* Find a free slot in Vfontset_table.  Usually, next_fontset_id is
   855      the next available fontset ID.  So it is expected that this loop
   856      terminates quickly.  In addition, as the last element of
   857      Vfontset_table is always nil, we don't have to check the range of
   858      id.  */
   859   while (!NILP (AREF (Vfontset_table, id))) id++;
   860 
   861   if (id + 1 == size)
   862     Vfontset_table = larger_vector (Vfontset_table, 1, -1);
   863 
   864   fontset = Fmake_char_table (Qfontset, Qnil);
   865 
   866   set_fontset_id (fontset, make_fixnum (id));
   867   if (NILP (base))
   868     set_fontset_name (fontset, name);
   869   else
   870     {
   871       set_fontset_name (fontset, Qnil);
   872       set_fontset_frame (fontset, frame);
   873       set_fontset_base (fontset, base);
   874     }
   875 
   876   ASET (Vfontset_table, id, fontset);
   877   next_fontset_id = id + 1;
   878   return fontset;
   879 }
   880 
   881 
   882 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
   883 
   884 /* Return the name of the fontset who has ID.  */
   885 
   886 Lisp_Object
   887 fontset_name (int id)
   888 {
   889   Lisp_Object fontset;
   890 
   891   fontset = FONTSET_FROM_ID (id);
   892   return FONTSET_NAME (fontset);
   893 }
   894 
   895 
   896 /* Return the ASCII font name of the fontset who has ID.  */
   897 
   898 Lisp_Object
   899 fontset_ascii (int id)
   900 {
   901   Lisp_Object fontset, elt;
   902 
   903   fontset= FONTSET_FROM_ID (id);
   904   elt = FONTSET_ASCII (fontset);
   905   if (CONSP (elt))
   906     elt = XCAR (elt);
   907   return elt;
   908 }
   909 
   910 /* Free fontset of FACE defined on frame F.  Called from
   911    free_realized_face.  */
   912 
   913 void
   914 free_face_fontset (struct frame *f, struct face *face)
   915 {
   916   Lisp_Object fontset;
   917 
   918   fontset = FONTSET_FROM_ID (face->fontset);
   919   if (NILP (fontset))
   920     return;
   921   eassert (! BASE_FONTSET_P (fontset));
   922   eassert (f == XFRAME (FONTSET_FRAME (fontset)));
   923   ASET (Vfontset_table, face->fontset, Qnil);
   924   if (face->fontset < next_fontset_id)
   925     next_fontset_id = face->fontset;
   926   if (! NILP (FONTSET_DEFAULT (fontset)))
   927     {
   928       int id = XFIXNUM (FONTSET_ID (FONTSET_DEFAULT (fontset)));
   929 
   930       fontset = AREF (Vfontset_table, id);
   931       eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
   932       eassert (f == XFRAME (FONTSET_FRAME (fontset)));
   933       ASET (Vfontset_table, id, Qnil);
   934       if (id < next_fontset_id)
   935         next_fontset_id = face->fontset;
   936     }
   937   face->fontset = -1;
   938 }
   939 
   940 /* Return ID of face suitable for displaying character C at buffer position
   941    POS on frame F.  FACE must be realized for ASCII characters in advance.
   942    Called from the macro FACE_FOR_CHAR.  */
   943 
   944 int
   945 face_for_char (struct frame *f, struct face *face, int c,
   946                ptrdiff_t pos, Lisp_Object object)
   947 {
   948   Lisp_Object fontset, rfont_def, charset;
   949   int face_id;
   950   int id;
   951 
   952   if (ASCII_CHAR_P (c) || CHAR_BYTE8_P (c))
   953     return face->ascii_face->id;
   954 
   955   if (use_default_font_for_symbols  /* let the user disable this feature */
   956       && c > 0 && EQ (CHAR_TABLE_REF (Vchar_script_table, c), Qsymbol))
   957     {
   958       /* Fonts often have characters for punctuation and other
   959          symbols, even if they don't match the 'symbol' script.  So
   960          check if the character is present in the current ASCII face
   961          first, and if so, use the same font as used by that face.
   962          This avoids unnecessarily switching to another font when the
   963          frame's default font will do.  We only do this for symbols so
   964          that users could still setup fontsets to force Emacs to use
   965          specific fonts for characters from other scripts, because
   966          choice of fonts is frequently affected by cultural
   967          preferences and font features, not by font coverage.
   968          However, these considerations are unlikely to be relevant to
   969          punctuation and other symbols, since the latter generally
   970          aren't specific to any culture, and don't require
   971          sophisticated OTF features.  */
   972       Lisp_Object font_object;
   973 
   974       if (face->ascii_face->font)
   975         {
   976           XSETFONT (font_object, face->ascii_face->font);
   977           if (font_has_char (f, font_object, c))
   978             return face->ascii_face->id;
   979         }
   980 
   981 #if 0
   982       /* Try the current face.  Disabled because it can cause
   983          counter-intuitive results, whereby the font used for some
   984          character depends on the characters that precede it on
   985          display.  See the discussion of bug #15138.  Note that the
   986          original bug reported in #15138 was in a situation where face
   987          == face->ascii_face, so the above code solves that situation
   988          without risking the undesirable consequences.  */
   989       if (face->font)
   990         {
   991           XSETFONT (font_object, face->font);
   992           if (font_has_char (f, font_object, c)) return face->id;
   993         }
   994 #endif
   995     }
   996 
   997   /* If the parent face has no fontset we could work with, and has no
   998      font, just return that same face, so that the caller will
   999      consider the character to have no font capable of displaying it,
  1000      and display it as "glyphless".  That is certainly better than
  1001      violating the assertion below or crashing when assertions are not
  1002      compiled in.  */
  1003   if (face->fontset < 0 && !face->font)
  1004     return face->id;
  1005 
  1006   eassert (fontset_id_valid_p (face->fontset));
  1007   fontset = FONTSET_FROM_ID (face->fontset);
  1008   eassert (!BASE_FONTSET_P (fontset));
  1009 
  1010   if (pos < 0)
  1011     {
  1012       id = -1;
  1013       charset = Qnil;
  1014     }
  1015   else
  1016     {
  1017       charset = Fget_char_property (make_fixnum (pos), Qcharset, object);
  1018       if (CHARSETP (charset))
  1019         {
  1020           Lisp_Object val;
  1021 
  1022           val = assq_no_quit (charset, Vfont_encoding_charset_alist);
  1023           if (CONSP (val) && CHARSETP (XCDR (val)))
  1024             charset = XCDR (val);
  1025           id = XFIXNUM (CHARSET_SYMBOL_ID (charset));
  1026         }
  1027       else
  1028         id = -1;
  1029     }
  1030 
  1031   rfont_def = fontset_font (fontset, c, face, id);
  1032   if (VECTORP (rfont_def))
  1033     {
  1034       if (FIXNUMP (RFONT_DEF_FACE (rfont_def)))
  1035         face_id = XFIXNUM (RFONT_DEF_FACE (rfont_def));
  1036       else
  1037         {
  1038           Lisp_Object font_object;
  1039 
  1040           font_object = RFONT_DEF_OBJECT (rfont_def);
  1041           face_id = face_for_font (f, font_object, face);
  1042           RFONT_DEF_SET_FACE (rfont_def, face_id);
  1043         }
  1044     }
  1045   else
  1046     {
  1047       if (FIXNUMP (FONTSET_NOFONT_FACE (fontset)))
  1048         face_id = XFIXNUM (FONTSET_NOFONT_FACE (fontset));
  1049       else
  1050         {
  1051           face_id = face_for_font (f, Qnil, face);
  1052           set_fontset_nofont_face (fontset, make_fixnum (face_id));
  1053         }
  1054     }
  1055   eassert (face_id >= 0);
  1056   return face_id;
  1057 }
  1058 
  1059 
  1060 Lisp_Object
  1061 font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object)
  1062 {
  1063   Lisp_Object fontset, rfont_def, charset;
  1064   int id;
  1065 
  1066   if (ASCII_CHAR_P (c))
  1067     {
  1068       Lisp_Object font_object;
  1069 
  1070       XSETFONT (font_object, face->ascii_face->font);
  1071       return font_object;
  1072     }
  1073 
  1074   eassert (fontset_id_valid_p (face->fontset));
  1075   fontset = FONTSET_FROM_ID (face->fontset);
  1076   eassert (!BASE_FONTSET_P (fontset));
  1077   if (pos < 0)
  1078     {
  1079       id = -1;
  1080       charset = Qnil;
  1081     }
  1082   else
  1083     {
  1084       charset = Fget_char_property (make_fixnum (pos), Qcharset, object);
  1085       if (CHARSETP (charset))
  1086         {
  1087           Lisp_Object val;
  1088 
  1089           val = assq_no_quit (charset, Vfont_encoding_charset_alist);
  1090           if (CONSP (val) && CHARSETP (XCDR (val)))
  1091             charset = XCDR (val);
  1092           id = XFIXNUM (CHARSET_SYMBOL_ID (charset));
  1093         }
  1094       else
  1095         id = -1;
  1096     }
  1097 
  1098   rfont_def = fontset_font (fontset, c, face, id);
  1099   return (VECTORP (rfont_def)
  1100           ? RFONT_DEF_OBJECT (rfont_def)
  1101           : Qnil);
  1102 }
  1103 
  1104 
  1105 /* Make a realized fontset for ASCII face FACE on frame F from the
  1106    base fontset BASE_FONTSET_ID.  If BASE_FONTSET_ID is -1, use the
  1107    default fontset as the base.  Value is the id of the new fontset.
  1108    Called from realize_gui_face.  */
  1109 
  1110 int
  1111 make_fontset_for_ascii_face (struct frame *f, int base_fontset_id, struct face *face)
  1112 {
  1113   Lisp_Object base_fontset, fontset, frame;
  1114 
  1115   XSETFRAME (frame, f);
  1116   if (base_fontset_id >= 0)
  1117     {
  1118       base_fontset = FONTSET_FROM_ID (base_fontset_id);
  1119       if (!BASE_FONTSET_P (base_fontset))
  1120         base_fontset = FONTSET_BASE (base_fontset);
  1121       eassert (BASE_FONTSET_P (base_fontset));
  1122     }
  1123   else
  1124     base_fontset = Vdefault_fontset;
  1125 
  1126   fontset = make_fontset (frame, Qnil, base_fontset);
  1127   return XFIXNUM (FONTSET_ID (fontset));
  1128 }
  1129 
  1130 
  1131 
  1132 /* Cache data used by fontset_pattern_regexp.  The car part is a
  1133    pattern string containing at least one wild card, the cdr part is
  1134    the corresponding regular expression.  */
  1135 static Lisp_Object Vcached_fontset_data;
  1136 
  1137 #define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
  1138 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
  1139 
  1140 /* If fontset name PATTERN contains any wild card, return regular
  1141    expression corresponding to PATTERN.  */
  1142 
  1143 static Lisp_Object
  1144 fontset_pattern_regexp (Lisp_Object pattern)
  1145 {
  1146   if (!strchr (SSDATA (pattern), '*')
  1147       && !strchr (SSDATA (pattern), '?'))
  1148     /* PATTERN does not contain any wild cards.  */
  1149     return Qnil;
  1150 
  1151   if (!CONSP (Vcached_fontset_data)
  1152       || strcmp (SSDATA (pattern), CACHED_FONTSET_NAME))
  1153     {
  1154       /* We must at first update the cached data.  */
  1155       unsigned char *regex, *p0, *p1;
  1156       int ndashes = 0, nstars = 0, nescs = 0;
  1157 
  1158       for (p0 = SDATA (pattern); *p0; p0++)
  1159         {
  1160           if (*p0 == '-')
  1161             ndashes++;
  1162           else if (*p0 == '*')
  1163             nstars++;
  1164           else if (*p0 == '['
  1165                    || *p0 == '.' || *p0 == '\\'
  1166                    || *p0 == '+' || *p0 == '^'
  1167                    || *p0 == '$')
  1168             nescs++;
  1169         }
  1170 
  1171       /* If PATTERN is not full XLFD we convert "*" to ".*".  Otherwise
  1172          we convert "*" to "[^-]*" which is much faster in regular
  1173          expression matching.  */
  1174       ptrdiff_t regexsize = (SBYTES (pattern)
  1175                              + (ndashes < 14 ? 2 : 5) * nstars
  1176                              + 2 * nescs + 3);
  1177       USE_SAFE_ALLOCA;
  1178       p1 = regex = SAFE_ALLOCA (regexsize);
  1179 
  1180       *p1++ = '^';
  1181       for (p0 = SDATA (pattern); *p0; p0++)
  1182         {
  1183           if (*p0 == '*')
  1184             {
  1185               if (ndashes < 14)
  1186                 *p1++ = '.';
  1187               else
  1188                 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
  1189               *p1++ = '*';
  1190             }
  1191           else if (*p0 == '?')
  1192             *p1++ = '.';
  1193           else if (*p0 == '['
  1194                    || *p0 == '.' || *p0 == '\\'
  1195                    || *p0 == '+' || *p0 == '^'
  1196                    || *p0 == '$')
  1197             *p1++ = '\\', *p1++ = *p0;
  1198           else
  1199             *p1++ = *p0;
  1200         }
  1201       *p1++ = '$';
  1202       *p1++ = 0;
  1203 
  1204       Vcached_fontset_data = Fcons (build_string (SSDATA (pattern)),
  1205                                     build_string ((char *) regex));
  1206       SAFE_FREE ();
  1207     }
  1208 
  1209   return CACHED_FONTSET_REGEX;
  1210 }
  1211 
  1212 /* Return ID of the base fontset named NAME.  If there's no such
  1213    fontset, return -1.  NAME_PATTERN specifies how to treat NAME as this:
  1214      0: pattern containing '*' and '?' as wildcards
  1215      1: regular expression
  1216      2: literal fontset name
  1217 */
  1218 
  1219 int
  1220 fs_query_fontset (Lisp_Object name, int name_pattern)
  1221 {
  1222   Lisp_Object tem;
  1223   int i;
  1224 
  1225   name = Fdowncase (name);
  1226   if (name_pattern != 1)
  1227     {
  1228       tem = Frassoc (name, Vfontset_alias_alist);
  1229       if (NILP (tem))
  1230         tem = Fassoc (name, Vfontset_alias_alist, Qnil);
  1231       if (CONSP (tem) && STRINGP (XCAR (tem)))
  1232         name = XCAR (tem);
  1233       else if (name_pattern == 0)
  1234         {
  1235           tem = fontset_pattern_regexp (name);
  1236           if (STRINGP (tem))
  1237             {
  1238               name = tem;
  1239               name_pattern = 1;
  1240             }
  1241         }
  1242     }
  1243 
  1244   for (i = 0; i < ASIZE (Vfontset_table); i++)
  1245     {
  1246       Lisp_Object fontset, this_name;
  1247 
  1248       fontset = FONTSET_FROM_ID (i);
  1249       if (NILP (fontset)
  1250           || !BASE_FONTSET_P (fontset))
  1251         continue;
  1252 
  1253       this_name = FONTSET_NAME (fontset);
  1254       if (name_pattern == 1
  1255           ? fast_string_match_ignore_case (name, this_name) >= 0
  1256           : !xstrcasecmp (SSDATA (name), SSDATA (this_name)))
  1257         return i;
  1258     }
  1259   return -1;
  1260 }
  1261 
  1262 
  1263 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
  1264        doc: /* Return the name of a fontset that matches PATTERN.
  1265 The value is nil if there is no matching fontset.
  1266 PATTERN can contain `*' or `?' as a wildcard
  1267 just as X font name matching algorithm allows.
  1268 If REGEXPP is non-nil, PATTERN is a regular expression.  */)
  1269   (Lisp_Object pattern, Lisp_Object regexpp)
  1270 {
  1271   Lisp_Object fontset;
  1272   int id;
  1273 
  1274   check_window_system (NULL);
  1275 
  1276   CHECK_STRING (pattern);
  1277 
  1278   if (SCHARS (pattern) == 0)
  1279     return Qnil;
  1280 
  1281   id = fs_query_fontset (pattern, !NILP (regexpp));
  1282   if (id < 0)
  1283     return Qnil;
  1284 
  1285   fontset = FONTSET_FROM_ID (id);
  1286   return FONTSET_NAME (fontset);
  1287 }
  1288 
  1289 /* Return a list of base fontset names matching PATTERN on frame F.  */
  1290 
  1291 Lisp_Object
  1292 list_fontsets (struct frame *f, Lisp_Object pattern, int size)
  1293 {
  1294   Lisp_Object frame, regexp, val;
  1295   int id;
  1296 
  1297   XSETFRAME (frame, f);
  1298 
  1299   regexp = fontset_pattern_regexp (pattern);
  1300   val = Qnil;
  1301 
  1302   for (id = 0; id < ASIZE (Vfontset_table); id++)
  1303     {
  1304       Lisp_Object fontset, name;
  1305 
  1306       fontset = FONTSET_FROM_ID (id);
  1307       if (NILP (fontset)
  1308           || !BASE_FONTSET_P (fontset)
  1309           || !EQ (frame, FONTSET_FRAME (fontset)))
  1310         continue;
  1311       name = FONTSET_NAME (fontset);
  1312 
  1313       if (STRINGP (regexp)
  1314           ? (fast_string_match (regexp, name) < 0)
  1315           : strcmp (SSDATA (pattern), SSDATA (name)))
  1316         continue;
  1317 
  1318       val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
  1319     }
  1320 
  1321   return val;
  1322 }
  1323 
  1324 
  1325 /* Free all realized fontsets whose base fontset is BASE.  */
  1326 
  1327 static void
  1328 free_realized_fontsets (Lisp_Object base)
  1329 {
  1330   int id;
  1331 
  1332 #if 0
  1333   /* For the moment, this doesn't work because free_realized_face
  1334      doesn't remove FACE from a cache.  Until we find a solution, we
  1335      suppress this code, and simply use Fclear_face_cache even though
  1336      that is not efficient.  */
  1337   block_input ();
  1338   for (id = 0; id < ASIZE (Vfontset_table); id++)
  1339     {
  1340       Lisp_Object this = AREF (Vfontset_table, id);
  1341 
  1342       if (EQ (FONTSET_BASE (this), base))
  1343         {
  1344           Lisp_Object tail;
  1345 
  1346           for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
  1347                tail = XCDR (tail))
  1348             {
  1349               struct frame *f = XFRAME (FONTSET_FRAME (this));
  1350               int face_id = XFIXNUM (XCDR (XCAR (tail)));
  1351               struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
  1352 
  1353               /* Face THIS itself is also freed by the following call.  */
  1354               free_realized_face (f, face);
  1355             }
  1356         }
  1357     }
  1358   unblock_input ();
  1359 #else  /* not 0 */
  1360   /* But, we don't have to call Fclear_face_cache if no fontset has
  1361      been realized from BASE.  */
  1362   for (id = 0; id < ASIZE (Vfontset_table); id++)
  1363     {
  1364       Lisp_Object this = AREF (Vfontset_table, id);
  1365 
  1366       if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
  1367         {
  1368           Fclear_face_cache (Qt);
  1369           /* This is in case some Lisp calls this function and then
  1370              proceeds with calling some other function, like font-at,
  1371              which needs the basic faces.  */
  1372           recompute_basic_faces (XFRAME (FONTSET_FRAME (this)));
  1373           break;
  1374         }
  1375     }
  1376 #endif /* not 0 */
  1377 }
  1378 
  1379 
  1380 /* Check validity of NAME as a fontset name and return the
  1381    corresponding fontset.  If not valid, signal an error.
  1382 
  1383    If NAME is t, return Vdefault_fontset.  If NAME is nil, return the
  1384    fontset of *FRAME.
  1385 
  1386    Set *FRAME to the actual frame.  */
  1387 
  1388 static Lisp_Object
  1389 check_fontset_name (Lisp_Object name, Lisp_Object *frame)
  1390 {
  1391   int id;
  1392   struct frame *f = decode_live_frame (*frame);
  1393 
  1394   XSETFRAME (*frame, f);
  1395 
  1396   if (EQ (name, Qt))
  1397     return Vdefault_fontset;
  1398   if (NILP (name))
  1399     {
  1400       if (!FRAME_WINDOW_P (f))
  1401         error ("Can't use fontsets in non-GUI frames");
  1402       id = FRAME_FONTSET (f);
  1403     }
  1404   else
  1405     {
  1406       CHECK_STRING (name);
  1407       /* First try NAME as literal.  */
  1408       id = fs_query_fontset (name, 2);
  1409       if (id < 0)
  1410         /* For backward compatibility, try again NAME as pattern.  */
  1411         id = fs_query_fontset (name, 0);
  1412       if (id < 0)
  1413         error ("Fontset `%s' does not exist", SDATA (name));
  1414     }
  1415   return FONTSET_FROM_ID (id);
  1416 }
  1417 
  1418 static void
  1419 accumulate_script_ranges (Lisp_Object arg, Lisp_Object range, Lisp_Object val)
  1420 {
  1421   if (EQ (XCAR (arg), val))
  1422     {
  1423       if (CONSP (range))
  1424         XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
  1425       else
  1426         XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
  1427     }
  1428 }
  1429 
  1430 
  1431 /* Callback function for map_charset_chars in Fset_fontset_font.
  1432    ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
  1433 
  1434    In FONTSET, set FONT_DEF in a fashion specified by ADD for
  1435    characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
  1436    The consumed ranges are popped up from SCRIPT_RANGE_LIST, and the
  1437    new SCRIPT_RANGE_LIST is stored in ARG.
  1438 
  1439    If ASCII is nil, don't set FONT_DEF for ASCII characters.  It is
  1440    assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
  1441    case.  */
  1442 
  1443 static void
  1444 set_fontset_font (Lisp_Object arg, Lisp_Object range)
  1445 {
  1446   Lisp_Object fontset, font_def, add, ascii, script_range_list;
  1447   int from = XFIXNUM (XCAR (range)), to = XFIXNUM (XCDR (range));
  1448 
  1449   fontset = AREF (arg, 0);
  1450   font_def = AREF (arg, 1);
  1451   add = AREF (arg, 2);
  1452   ascii = AREF (arg, 3);
  1453   script_range_list = AREF (arg, 4);
  1454 
  1455   if (NILP (ascii) && from < 0x80)
  1456     {
  1457       if (to < 0x80)
  1458         return;
  1459       from = 0x80;
  1460       range = Fcons (make_fixnum (0x80), XCDR (range));
  1461     }
  1462 
  1463 #define SCRIPT_FROM XFIXNUM (XCAR (XCAR (script_range_list)))
  1464 #define SCRIPT_TO XFIXNUM (XCDR (XCAR (script_range_list)))
  1465 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
  1466 
  1467   for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
  1468     FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
  1469   if (CONSP (script_range_list))
  1470     {
  1471       if (SCRIPT_FROM < from)
  1472         range = Fcons (make_fixnum (SCRIPT_FROM), XCDR (range));
  1473       while (CONSP (script_range_list) && SCRIPT_TO <= to)
  1474         POP_SCRIPT_RANGE ();
  1475       if (CONSP (script_range_list) && SCRIPT_FROM <= to)
  1476         XSETCAR (XCAR (script_range_list), make_fixnum (to + 1));
  1477     }
  1478 
  1479   FONTSET_ADD (fontset, range, font_def, add);
  1480   ASET (arg, 4, script_range_list);
  1481 }
  1482 
  1483 static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
  1484 
  1485 
  1486 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
  1487        doc: /*
  1488 Modify FONTSET to use font specification in FONT-SPEC for displaying CHARACTERS.
  1489 
  1490 FONTSET should be a fontset name (a string); or nil, meaning the
  1491 fontset of FRAME; or t, meaning the default fontset.
  1492 
  1493 CHARACTERS may be a single character to use FONT-SPEC for.
  1494 
  1495 CHARACTERS may be a cons (FROM . TO), where FROM and TO are characters.
  1496 In that case, use FONT-SPEC for all the characters in the range
  1497 between FROM and TO (inclusive).
  1498 
  1499 CHARACTERS may be a script symbol.  In that case, use FONT-SPEC for
  1500 all the characters that belong to the script.  See the variable
  1501 `script-representative-chars' for the list of known scripts, and
  1502 see the variable `char-script-table' for the script of any specific
  1503 character.
  1504 
  1505 CHARACTERS may be a charset symbol.  In that case, use FONT-SPEC for
  1506 all the characters in the charset.  See `list-character-sets' and
  1507 `list-charset-chars' for the list of character sets and their
  1508 characters.
  1509 
  1510 CHARACTERS may be nil.  In that case, use FONT-SPEC for any
  1511 character for which no font-spec is specified in FONTSET.
  1512 
  1513 FONT-SPEC may one of these:
  1514  * A font-spec object made by the function `font-spec' (which see).
  1515  * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
  1516    REGISTRY is a font registry name.  FAMILY may contain foundry
  1517    name, and REGISTRY may contain encoding name.
  1518  * A font name string.
  1519  * nil, which explicitly specifies that there's no font for CHARACTERS.
  1520 
  1521 Optional 4th argument FRAME is a frame whose fontset should be modified;
  1522 it is used if FONTSET is nil.  If FONTSET is nil and FRAME is omitted
  1523 or nil, that stands for the fontset of the selected frame.
  1524 
  1525 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
  1526 to the previously set font specifications for CHARACTERS.  If it is
  1527 `prepend', FONT-SPEC is prepended to the existing font specifications.
  1528 If it is `append', FONT-SPEC is appended.  By default, FONT-SPEC
  1529 overwrites the previous settings.  */)
  1530   (Lisp_Object fontset, Lisp_Object characters, Lisp_Object font_spec,
  1531    Lisp_Object frame, Lisp_Object add)
  1532 {
  1533   Lisp_Object fontset_obj;
  1534   Lisp_Object font_def, registry, family;
  1535   Lisp_Object range_list;
  1536   struct charset *charset = NULL;
  1537   Lisp_Object fontname;
  1538   bool ascii_changed = 0;
  1539 
  1540   fontset_obj = check_fontset_name (fontset, &frame);
  1541 
  1542   fontname = Qnil;
  1543   if (CONSP (font_spec))
  1544     {
  1545       Lisp_Object spec = Ffont_spec (0, NULL);
  1546 
  1547       font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
  1548       font_spec = spec;
  1549       fontname = Ffont_xlfd_name (font_spec, Qnil);
  1550     }
  1551   else if (STRINGP (font_spec))
  1552     {
  1553       fontname = font_spec;
  1554       font_spec = CALLN (Ffont_spec, QCname, fontname);
  1555     }
  1556   else if (FONT_SPEC_P (font_spec))
  1557     fontname = Ffont_xlfd_name (font_spec, Qnil);
  1558   else if (! NILP (font_spec))
  1559     Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
  1560 
  1561   if (! NILP (font_spec))
  1562     {
  1563       Lisp_Object encoding, repertory;
  1564 
  1565       family = AREF (font_spec, FONT_FAMILY_INDEX);
  1566       if (! NILP (family) )
  1567         family = SYMBOL_NAME (family);
  1568       registry = AREF (font_spec, FONT_REGISTRY_INDEX);
  1569       if (! NILP (registry))
  1570         registry = Fdowncase (SYMBOL_NAME (registry));
  1571       AUTO_STRING (dash, "-");
  1572       encoding = find_font_encoding (concat3 (family, dash, registry));
  1573       if (NILP (encoding))
  1574         encoding = Qascii;
  1575 
  1576       if (SYMBOLP (encoding))
  1577         {
  1578           CHECK_CHARSET (encoding);
  1579           encoding = repertory = CHARSET_SYMBOL_ID (encoding);
  1580         }
  1581       else
  1582         {
  1583           repertory = XCDR (encoding);
  1584           encoding = XCAR (encoding);
  1585           CHECK_CHARSET (encoding);
  1586           encoding = CHARSET_SYMBOL_ID (encoding);
  1587           if (! NILP (repertory) && SYMBOLP (repertory))
  1588             {
  1589               CHECK_CHARSET (repertory);
  1590               repertory = CHARSET_SYMBOL_ID (repertory);
  1591             }
  1592         }
  1593       font_def = font_def_new (font_spec, encoding, repertory);
  1594     }
  1595   else
  1596     font_def = Qnil;
  1597 
  1598   if (CHARACTERP (characters))
  1599     {
  1600       if (XFIXNAT (characters) < 0x80)
  1601         error ("Can't set a font for partial ASCII range");
  1602       range_list = list1 (Fcons (characters, characters));
  1603     }
  1604   else if (CONSP (characters))
  1605     {
  1606       Lisp_Object from, to;
  1607 
  1608       from = Fcar (characters);
  1609       to = Fcdr (characters);
  1610       CHECK_CHARACTER (from);
  1611       CHECK_CHARACTER (to);
  1612       if (XFIXNAT (from) < 0x80)
  1613         {
  1614           if (XFIXNAT (from) != 0 || XFIXNAT (to) < 0x7F)
  1615             error ("Can't set a font for partial ASCII range");
  1616           ascii_changed = 1;
  1617         }
  1618       range_list = list1 (characters);
  1619     }
  1620   else if (SYMBOLP (characters) && !NILP (characters))
  1621     {
  1622       Lisp_Object script_list;
  1623       Lisp_Object val;
  1624 
  1625       range_list = Qnil;
  1626       script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
  1627       if (! NILP (Fmemq (characters, script_list)))
  1628         {
  1629           if (EQ (characters, Qlatin))
  1630             ascii_changed = 1;
  1631           val = list1 (characters);
  1632           map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
  1633                           val);
  1634           range_list = Fnreverse (XCDR (val));
  1635         }
  1636       if (CHARSETP (characters))
  1637         {
  1638           CHECK_CHARSET_GET_CHARSET (characters, charset);
  1639           if (charset->ascii_compatible_p)
  1640             ascii_changed = 1;
  1641         }
  1642       else if (NILP (range_list))
  1643         error ("Invalid script or charset name: %s",
  1644                SDATA (SYMBOL_NAME (characters)));
  1645     }
  1646   else if (NILP (characters))
  1647     range_list = list1 (Qnil);
  1648   else
  1649     error ("Invalid second argument for setting a font in a fontset");
  1650 
  1651   if (ascii_changed)
  1652     {
  1653       Lisp_Object val;
  1654 
  1655       if (NILP (font_spec))
  1656         error ("Can't set ASCII font to nil");
  1657       val = CHAR_TABLE_REF (fontset_obj, 0);
  1658       if (! NILP (val) && EQ (add, Qappend))
  1659         /* We are going to change just an additional font for ASCII.  */
  1660         ascii_changed = 0;
  1661     }
  1662 
  1663   if (charset)
  1664     {
  1665       Lisp_Object arg = CALLN (Fvector, fontset_obj, font_def, add,
  1666                                ascii_changed ? Qt : Qnil, range_list);
  1667 
  1668       map_charset_chars (set_fontset_font, Qnil, arg, charset,
  1669                          CHARSET_MIN_CODE (charset),
  1670                          CHARSET_MAX_CODE (charset));
  1671       range_list = AREF (arg, 4);
  1672     }
  1673   for (; CONSP (range_list); range_list = XCDR (range_list))
  1674     FONTSET_ADD (fontset_obj, XCAR (range_list), font_def, add);
  1675 
  1676   if (ascii_changed)
  1677     {
  1678       Lisp_Object tail, fr;
  1679       int fontset_id = XFIXNUM (FONTSET_ID (fontset_obj));
  1680 
  1681       set_fontset_ascii (fontset_obj, fontname);
  1682       fontset = FONTSET_NAME (fontset_obj);
  1683       FOR_EACH_FRAME (tail, fr)
  1684         {
  1685           struct frame *f = XFRAME (fr);
  1686           Lisp_Object font_object;
  1687           struct face *face;
  1688 
  1689           if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
  1690             continue;
  1691           if (fontset_id != FRAME_FONTSET (f))
  1692             continue;
  1693           face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
  1694           if (face)
  1695             font_object = font_load_for_lface (f, face->lface, font_spec);
  1696           else
  1697             font_object = font_open_by_spec (f, font_spec);
  1698           if (! NILP (font_object))
  1699             {
  1700               update_auto_fontset_alist (font_object, fontset_obj);
  1701               AUTO_FRAME_ARG (arg, Qfont, Fcons (fontset, font_object));
  1702 
  1703 #ifdef HAVE_WINDOW_SYSTEM
  1704               if (FRAME_WINDOW_P (f))
  1705                 /* This is a window-system frame.  Prevent changes of
  1706                    the `font' parameter here from messing with the
  1707                    `font-parameter' frame property, as the frame
  1708                    parameter is not being changed by the user.  */
  1709                 gui_set_frame_parameters_1 (f, arg, true);
  1710               else
  1711 #endif
  1712                 Fmodify_frame_parameters (fr, arg);
  1713             }
  1714         }
  1715     }
  1716 
  1717   /* Free all realized fontsets whose base is FONTSET_OBJ.  This way, the
  1718      specified character(s) are surely redisplayed by a correct
  1719      font.  */
  1720   free_realized_fontsets (fontset_obj);
  1721 
  1722   return Qnil;
  1723 }
  1724 
  1725 
  1726 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
  1727        doc: /* Create a new fontset NAME from font information in FONTLIST.
  1728 
  1729 FONTLIST is an alist of scripts vs the corresponding font specification list.
  1730 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
  1731 character of SCRIPT is displayed by a font that matches one of
  1732 FONT-SPEC.
  1733 
  1734 SCRIPT is a symbol that appears in the first extra slot of the
  1735 char-table `char-script-table'.
  1736 
  1737 FONT-SPEC is a vector, a cons, or a string.  See the documentation of
  1738 `set-fontset-font' for the meaning.  */)
  1739   (Lisp_Object name, Lisp_Object fontlist)
  1740 {
  1741   Lisp_Object fontset, tail;
  1742   int id;
  1743 
  1744   CHECK_STRING (name);
  1745 
  1746   name = Fdowncase (name);
  1747   id = fs_query_fontset (name, 0);
  1748   if (id < 0)
  1749     {
  1750       Lisp_Object font_spec = Ffont_spec (0, NULL);
  1751       Lisp_Object short_name;
  1752       char xlfd[256];
  1753       int len;
  1754 
  1755       if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0)
  1756         error ("Fontset name must be in XLFD format");
  1757       short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
  1758       if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
  1759           || SBYTES (SYMBOL_NAME (short_name)) < 9)
  1760         error ("Registry field of fontset name must be \"fontset-*\"");
  1761       Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
  1762                                     Vfontset_alias_alist);
  1763       ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
  1764       fontset = make_fontset (Qnil, name, Qnil);
  1765       len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
  1766       if (len < 0)
  1767         error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
  1768       set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
  1769     }
  1770   else
  1771     {
  1772       fontset = FONTSET_FROM_ID (id);
  1773       free_realized_fontsets (fontset);
  1774       Fset_char_table_range (fontset, Qt, Qnil);
  1775     }
  1776 
  1777   for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
  1778     {
  1779       Lisp_Object elt, script;
  1780 
  1781       elt = XCAR (tail);
  1782       script = Fcar (elt);
  1783       elt = Fcdr (elt);
  1784       if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
  1785         for (; CONSP (elt); elt = XCDR (elt))
  1786           Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
  1787       else
  1788         Fset_fontset_font (name, script, elt, Qnil, Qappend);
  1789     }
  1790   CHECK_LIST_END (tail, fontlist);
  1791   return name;
  1792 }
  1793 
  1794 
  1795 /* Alist of automatically created fontsets.  Each element is a cons
  1796    (FONT-SPEC . FONTSET-ID).  */
  1797 static Lisp_Object auto_fontset_alist;
  1798 
  1799 /* Number of automatically created fontsets.  */
  1800 static ptrdiff_t num_auto_fontsets;
  1801 
  1802 /* Return a fontset synthesized from FONT-OBJECT.  This is called from
  1803    the terminal hook set_new_font_hook when FONT-OBJECT is used for
  1804    the default ASCII font of a frame, and the returned fontset is used
  1805    for the default fontset of that frame.  The fontset specifies a
  1806    font of the same registry as FONT-OBJECT for all characters in the
  1807    repertory of the registry (see Vfont_encoding_alist).  If the
  1808    repertory is not known, the fontset specifies the font for all
  1809    Latin characters assuming that a user intends to use FONT-OBJECT
  1810    for Latin characters.  */
  1811 
  1812 int
  1813 fontset_from_font (Lisp_Object font_object)
  1814 {
  1815   Lisp_Object font_name = font_get_name (font_object);
  1816   Lisp_Object font_spec = copy_font_spec (font_object);
  1817   Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
  1818   Lisp_Object fontset_spec, alias, name, fontset;
  1819   Lisp_Object val;
  1820 
  1821   val = assoc_no_quit (font_spec, auto_fontset_alist);
  1822   if (CONSP (val))
  1823     return XFIXNUM (FONTSET_ID (XCDR (val)));
  1824   if (num_auto_fontsets++ == 0)
  1825     alias = intern ("fontset-startup");
  1826   else
  1827     {
  1828       char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
  1829 
  1830       sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
  1831       alias = intern (temp);
  1832     }
  1833   fontset_spec = copy_font_spec (font_spec);
  1834   ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
  1835   name = Ffont_xlfd_name (fontset_spec, Qnil);
  1836   eassert (!NILP (name));
  1837   fontset = make_fontset (Qnil, name, Qnil);
  1838   Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
  1839                                 Vfontset_alias_alist);
  1840   alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
  1841   Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
  1842   auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
  1843   font_spec = Ffont_spec (0, NULL);
  1844   ASET (font_spec, FONT_REGISTRY_INDEX, registry);
  1845   {
  1846     Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
  1847 
  1848     if (CONSP (target))
  1849       target = XCDR (target);
  1850     if (! CHARSETP (target))
  1851       target = Qlatin;
  1852     Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
  1853     Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
  1854   }
  1855 
  1856   set_fontset_ascii (fontset, font_name);
  1857 
  1858   return XFIXNUM (FONTSET_ID (fontset));
  1859 }
  1860 
  1861 
  1862 /* Update auto_fontset_alist for FONTSET.  When an ASCII font of
  1863    FONTSET is changed, we delete an entry of FONTSET if any from
  1864    auto_fontset_alist so that FONTSET is not re-used by
  1865    fontset_from_font.  */
  1866 
  1867 static void
  1868 update_auto_fontset_alist (Lisp_Object font_object, Lisp_Object fontset)
  1869 {
  1870   Lisp_Object prev, tail;
  1871 
  1872   for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
  1873        prev = tail, tail = XCDR (tail))
  1874     if (EQ (fontset, XCDR (XCAR (tail))))
  1875       {
  1876         if (NILP (prev))
  1877           auto_fontset_alist = XCDR (tail);
  1878         else
  1879           XSETCDR (prev, XCDR (tail));
  1880         break;
  1881       }
  1882 }
  1883 
  1884 
  1885 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
  1886        doc: /* Return information about a fontset FONTSET on frame FRAME.
  1887 
  1888 FONTSET is a fontset name string, nil for the fontset of FRAME, or t
  1889 for the default fontset.  FRAME nil means the selected frame.
  1890 
  1891 The value is a char-table whose elements have this form:
  1892 
  1893     ((FONT OPENED-FONT ...) ...)
  1894 
  1895 FONT is a name of font specified for a range of characters.
  1896 
  1897 OPENED-FONT is a name of a font actually opened.
  1898 
  1899 The char-table has one extra slot.  If FONTSET is not the default
  1900 fontset, the value the extra slot is a char-table containing the
  1901 information about the derived fonts from the default fontset.  The
  1902 format is the same as above.  */)
  1903   (Lisp_Object fontset, Lisp_Object frame)
  1904 {
  1905   Lisp_Object *realized[2], fontsets[2], tables[2];
  1906   Lisp_Object val, elt;
  1907   int c, i, j, k;
  1908 
  1909   check_window_system (NULL);
  1910   fontset = check_fontset_name (fontset, &frame);
  1911 
  1912   /* Recode fontsets realized on FRAME from the base fontset FONTSET
  1913      in the table `realized'.  */
  1914   USE_SAFE_ALLOCA;
  1915   SAFE_ALLOCA_LISP (realized[0], 2 * ASIZE (Vfontset_table));
  1916   realized[1] = realized[0] + ASIZE (Vfontset_table);
  1917   for (i = j = 0; i < ASIZE (Vfontset_table); i++)
  1918     {
  1919       elt = FONTSET_FROM_ID (i);
  1920       if (!NILP (elt)
  1921           && EQ (FONTSET_BASE (elt), fontset)
  1922           && EQ (FONTSET_FRAME (elt), frame))
  1923         realized[0][j++] = elt;
  1924     }
  1925   realized[0][j] = Qnil;
  1926 
  1927   for (i = j = 0; ! NILP (realized[0][i]); i++)
  1928     {
  1929       elt = FONTSET_DEFAULT (realized[0][i]);
  1930       if (! NILP (elt))
  1931         realized[1][j++] = elt;
  1932     }
  1933   realized[1][j] = Qnil;
  1934 
  1935   tables[0] = Fmake_char_table (Qfontset_info, Qnil);
  1936   fontsets[0] = fontset;
  1937   if (!EQ (fontset, Vdefault_fontset))
  1938     {
  1939       tables[1] = Fmake_char_table (Qnil, Qnil);
  1940       set_char_table_extras (tables[0], 0, tables[1]);
  1941       fontsets[1] = Vdefault_fontset;
  1942     }
  1943 
  1944   /* Accumulate information of the fontset in TABLE.  The format of
  1945      each element is ((FONT-SPEC OPENED-FONT ...) ...).  */
  1946   for (k = 0; k <= 1; k++)
  1947     {
  1948       for (c = 0; c <= MAX_CHAR; )
  1949         {
  1950           int from = c, to = MAX_5_BYTE_CHAR;
  1951 
  1952           if (c <= MAX_5_BYTE_CHAR)
  1953             {
  1954               val = char_table_ref_and_range (fontsets[k], c, &from, &to);
  1955             }
  1956           else
  1957             {
  1958               val = FONTSET_FALLBACK (fontsets[k]);
  1959               to = MAX_CHAR;
  1960             }
  1961           if (VECTORP (val))
  1962             {
  1963               Lisp_Object alist;
  1964 
  1965               /* At first, set ALIST to ((FONT-SPEC) ...).  */
  1966               for (alist = Qnil, i = 0; i < ASIZE (val); i++)
  1967                 if (! NILP (AREF (val, i)))
  1968                   alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
  1969                                  alist);
  1970               alist = Fnreverse (alist);
  1971 
  1972               /* Then store opened font names to cdr of each elements.  */
  1973               for (i = 0; ! NILP (realized[k][i]); i++)
  1974                 {
  1975                   if (c <= MAX_5_BYTE_CHAR)
  1976                     val = FONTSET_REF (realized[k][i], c);
  1977                   else
  1978                     val = FONTSET_FALLBACK (realized[k][i]);
  1979                   if (! CONSP (val) || ! VECTORP (XCDR (val)))
  1980                     continue;
  1981                   /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ])  */
  1982                   val = XCDR (val);
  1983                   for (j = 0; j < ASIZE (val); j++)
  1984                     {
  1985                       elt = AREF (val, j);
  1986                       if (!NILP (elt) && FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
  1987                         {
  1988                           Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
  1989                           Lisp_Object slot, name;
  1990 
  1991                           slot = Fassq (RFONT_DEF_SPEC (elt), alist);
  1992                           name = AREF (font_object, FONT_NAME_INDEX);
  1993                           if (NILP (Fmember (name, XCDR (slot))))
  1994                             nconc2 (slot, list1 (name));
  1995                         }
  1996                     }
  1997                 }
  1998 
  1999               /* Store ALIST in TBL for characters C..TO.  */
  2000               if (c <= MAX_5_BYTE_CHAR)
  2001                 char_table_set_range (tables[k], c, to, alist);
  2002               else
  2003                 set_char_table_defalt (tables[k], alist);
  2004 
  2005               /* At last, change each elements to font names.  */
  2006               for (; CONSP (alist); alist = XCDR (alist))
  2007                 {
  2008                   elt = XCAR (alist);
  2009                   XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
  2010                 }
  2011             }
  2012           c = to + 1;
  2013         }
  2014       if (EQ (fontset, Vdefault_fontset))
  2015         break;
  2016     }
  2017 
  2018   SAFE_FREE ();
  2019   return tables[0];
  2020 }
  2021 
  2022 
  2023 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
  2024        doc: /* Return a font name pattern for character CH in fontset NAME.
  2025 If NAME is t, find a pattern in the default fontset.
  2026 If NAME is nil, find a pattern in the fontset of the selected frame.
  2027 
  2028 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
  2029 family name and REGISTRY is a font registry name.  This is actually
  2030 the first font name pattern for CH in the fontset or in the default
  2031 fontset.
  2032 
  2033 If the 2nd optional arg ALL is non-nil, return a list of all font name
  2034 patterns.  */)
  2035   (Lisp_Object name, Lisp_Object ch, Lisp_Object all)
  2036 {
  2037   int c;
  2038   Lisp_Object fontset, elt, list, repertory, val;
  2039   int i, j;
  2040   Lisp_Object frame;
  2041 
  2042   frame = Qnil;
  2043   fontset = check_fontset_name (name, &frame);
  2044 
  2045   CHECK_CHARACTER (ch);
  2046   c = XFIXNUM (ch);
  2047   list = Qnil;
  2048   while (1)
  2049     {
  2050       for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
  2051            i++, elt = FONTSET_FALLBACK (fontset))
  2052         if (VECTORP (elt))
  2053           for (j = 0; j < ASIZE (elt); j++)
  2054             {
  2055               Lisp_Object family, registry;
  2056 
  2057               val = AREF (elt, j);
  2058               if (NILP (val))
  2059                 return Qnil;
  2060               repertory = AREF (val, 1);
  2061               if (FIXNUMP (repertory))
  2062                 {
  2063                   struct charset *charset = CHARSET_FROM_ID (XFIXNUM (repertory));
  2064 
  2065                   if (! CHAR_CHARSET_P (c, charset))
  2066                     continue;
  2067                 }
  2068               else if (CHAR_TABLE_P (repertory))
  2069                 {
  2070                   if (NILP (CHAR_TABLE_REF (repertory, c)))
  2071                     continue;
  2072                 }
  2073               val = AREF (val, 0);
  2074               /* VAL is a FONT-SPEC */
  2075               family = AREF (val, FONT_FAMILY_INDEX);
  2076               if (! NILP (family))
  2077                 family = SYMBOL_NAME (family);
  2078               registry = AREF (val, FONT_REGISTRY_INDEX);
  2079               if (! NILP (registry))
  2080                 registry = SYMBOL_NAME (registry);
  2081               val = Fcons (family, registry);
  2082               if (NILP (all))
  2083                 return val;
  2084               list = Fcons (val, list);
  2085             }
  2086       if (EQ (fontset, Vdefault_fontset))
  2087         break;
  2088       fontset = Vdefault_fontset;
  2089     }
  2090   return (Fnreverse (list));
  2091 }
  2092 
  2093 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
  2094        doc: /* Return a list of all defined fontset names.  */)
  2095   (void)
  2096 {
  2097   Lisp_Object fontset, list;
  2098   int i;
  2099 
  2100   list = Qnil;
  2101   for (i = 0; i < ASIZE (Vfontset_table); i++)
  2102     {
  2103       fontset = FONTSET_FROM_ID (i);
  2104       if (!NILP (fontset)
  2105           && BASE_FONTSET_P (fontset))
  2106         list = Fcons (FONTSET_NAME (fontset), list);
  2107     }
  2108 
  2109   return list;
  2110 }
  2111 
  2112 
  2113 #ifdef ENABLE_CHECKING
  2114 
  2115 Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
  2116 
  2117 Lisp_Object
  2118 dump_fontset (Lisp_Object fontset)
  2119 {
  2120   Lisp_Object vec = make_nil_vector (3);
  2121   ASET (vec, 0, FONTSET_ID (fontset));
  2122 
  2123   if (BASE_FONTSET_P (fontset))
  2124     {
  2125       ASET (vec, 1, FONTSET_NAME (fontset));
  2126     }
  2127   else
  2128     {
  2129       Lisp_Object frame;
  2130 
  2131       frame = FONTSET_FRAME (fontset);
  2132       if (FRAMEP (frame))
  2133         {
  2134           struct frame *f = XFRAME (frame);
  2135 
  2136           if (FRAME_LIVE_P (f))
  2137             ASET (vec, 1,
  2138                   Fcons (FONTSET_NAME (FONTSET_BASE (fontset)),
  2139                          f->name));
  2140           else
  2141             ASET (vec, 1,
  2142                   Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
  2143         }
  2144       if (!NILP (FONTSET_DEFAULT (fontset)))
  2145         ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
  2146     }
  2147   return vec;
  2148 }
  2149 
  2150 DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
  2151        doc: /* Return a brief summary of all fontsets for debug use.  */)
  2152   (void)
  2153 {
  2154   Lisp_Object val;
  2155   int i;
  2156 
  2157   for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
  2158     if (! NILP (AREF (Vfontset_table, i)))
  2159       val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
  2160   return (Fnreverse (val));
  2161 }
  2162 #endif  /* ENABLE_CHECKING */
  2163 
  2164 void
  2165 syms_of_fontset (void)
  2166 {
  2167   DEFSYM (Qfontset, "fontset");
  2168   Fput (Qfontset, Qchar_table_extra_slots, make_fixnum (8));
  2169   DEFSYM (Qfontset_info, "fontset-info");
  2170   Fput (Qfontset_info, Qchar_table_extra_slots, make_fixnum (1));
  2171 
  2172   DEFSYM (Qappend, "append");
  2173   DEFSYM (Qlatin, "latin");
  2174 
  2175   Vcached_fontset_data = Qnil;
  2176   staticpro (&Vcached_fontset_data);
  2177 
  2178   Vfontset_table = make_nil_vector (32);
  2179   staticpro (&Vfontset_table);
  2180 
  2181   Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
  2182   staticpro (&Vdefault_fontset);
  2183   set_fontset_id (Vdefault_fontset, make_fixnum (0));
  2184   set_fontset_name
  2185     (Vdefault_fontset,
  2186      build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
  2187   ASET (Vfontset_table, 0, Vdefault_fontset);
  2188   next_fontset_id = 1;
  2189   PDUMPER_REMEMBER_SCALAR (next_fontset_id);
  2190 
  2191   auto_fontset_alist = Qnil;
  2192   staticpro (&auto_fontset_alist);
  2193 
  2194   DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist,
  2195                doc: /*
  2196 Alist of charsets vs the charsets to determine the preferred font encoding.
  2197 Each element looks like (CHARSET . ENCODING-CHARSET),
  2198 where ENCODING-CHARSET is a charset registered in the variable
  2199 `font-encoding-alist' as ENCODING.
  2200 
  2201 When a text has a property `charset' and the value is CHARSET, a font
  2202 whose encoding corresponds to ENCODING-CHARSET is preferred.  */);
  2203   Vfont_encoding_charset_alist = Qnil;
  2204 
  2205   DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent,
  2206                doc: /*
  2207 Char table of characters whose ascent values should be ignored.
  2208 If an entry for a character is non-nil, the ascent value of the glyph
  2209 is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
  2210 
  2211 This affects how a composite character which contains
  2212 such a character is displayed on screen.  */);
  2213   Vuse_default_ascent = Qnil;
  2214 
  2215   DEFVAR_BOOL ("use-default-font-for-symbols", use_default_font_for_symbols,
  2216                doc: /*
  2217 If non-nil, use the default face's font for symbols and punctuation.
  2218 
  2219 By default, Emacs will try to use the default face's font for
  2220 displaying symbol and punctuation characters, disregarding the
  2221 fontsets, if the default font can display the character.
  2222 Set this to nil to make Emacs honor the fontsets instead.  */);
  2223   use_default_font_for_symbols = 1;
  2224 
  2225   DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition,
  2226                doc: /*
  2227 Char table of characters which are not composed relatively.
  2228 If an entry for a character is non-nil, a composition sequence
  2229 which contains that character is displayed so that
  2230 the glyph of that character is put without considering
  2231 an ascent and descent value of a previous character.  */);
  2232   Vignore_relative_composition = Qnil;
  2233 
  2234   DEFVAR_LISP ("alternate-fontname-alist", Valternate_fontname_alist,
  2235                doc: /* Alist of fontname vs list of the alternate fontnames.
  2236 When a specified font name is not found, the corresponding
  2237 alternate fontnames (if any) are tried instead.  */);
  2238   Valternate_fontname_alist = Qnil;
  2239 
  2240   DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
  2241                doc: /* Alist of fontset names vs the aliases.  */);
  2242   Vfontset_alias_alist
  2243     = list1 (Fcons (FONTSET_NAME (Vdefault_fontset),
  2244                     build_pure_c_string ("fontset-default")));
  2245 
  2246   DEFVAR_LISP ("vertical-centering-font-regexp",
  2247                Vvertical_centering_font_regexp,
  2248                doc: /* Regexp matching font names that require vertical centering on display.
  2249 When a character is displayed with such fonts, the character is displayed
  2250 at the vertical center of lines.  */);
  2251   Vvertical_centering_font_regexp = Qnil;
  2252 
  2253   DEFVAR_LISP ("otf-script-alist", Votf_script_alist,
  2254                doc: /* Alist of OpenType script tags vs the corresponding script names.  */);
  2255   Votf_script_alist = Qnil;
  2256 
  2257   defsubr (&Squery_fontset);
  2258   defsubr (&Snew_fontset);
  2259   defsubr (&Sset_fontset_font);
  2260   defsubr (&Sfontset_info);
  2261   defsubr (&Sfontset_font);
  2262   defsubr (&Sfontset_list);
  2263 #ifdef ENABLE_CHECKING
  2264   defsubr (&Sfontset_list_all);
  2265 #endif
  2266 }