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           if (NILP (font_object))
   671             {
   672               /* Something strange happened, perhaps because of a
   673                  Font-backend problem.  To avoid crashing, record
   674                  that this spec is unusable.  It may be better to find
   675                  another font of the same spec, but currently we don't
   676                  have such an API in font-backend.  */
   677               RFONT_DEF_SET_FACE (rfont_def, -1);
   678               continue;
   679             }
   680           RFONT_DEF_SET_OBJECT (rfont_def, font_object);
   681         }
   682 
   683       if (font_has_char (f, font_object, c))
   684         goto found;
   685 
   686       /* Find a font already opened, matching with the current spec,
   687          and supporting C. */
   688       font_def = RFONT_DEF_FONT_DEF (rfont_def);
   689       for (; found_index + 1 < ASIZE (vec); found_index++)
   690         {
   691           rfont_def = AREF (vec, found_index + 1);
   692           if (NILP (rfont_def))
   693             break;
   694           if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
   695             break;
   696           font_object = RFONT_DEF_OBJECT (rfont_def);
   697           if (! NILP (font_object) && font_has_char (f, font_object, c))
   698             {
   699               found_index++;
   700               goto found;
   701             }
   702         }
   703 
   704       /* Find a font-entity with the current spec and supporting C.  */
   705       font_entity = font_find_for_lface (f, face->lface,
   706                                          FONT_DEF_SPEC (font_def), c);
   707       if (! NILP (font_entity))
   708         {
   709           /* We found a font.  Open it and insert a new element for
   710              that font in VEC.  */
   711           int j;
   712 
   713           font_object = font_open_for_lface (f, font_entity, face->lface,
   714                                              Qnil);
   715           if (NILP (font_object))
   716             continue;
   717           RFONT_DEF_NEW (rfont_def, font_def);
   718           RFONT_DEF_SET_OBJECT (rfont_def, font_object);
   719           RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
   720           Lisp_Object new_vec = make_nil_vector (ASIZE (vec) + 1);
   721           found_index++;
   722           for (j = 0; j < found_index; j++)
   723             ASET (new_vec, j, AREF (vec, j));
   724           ASET (new_vec, j, rfont_def);
   725           for (j++; j < ASIZE (new_vec); j++)
   726             ASET (new_vec, j, AREF (vec, j - 1));
   727           XSETCDR (font_group, new_vec);
   728           vec = new_vec;
   729           goto found;
   730         }
   731       if (i >= 0)
   732         i = found_index;
   733     }
   734 
   735   /* Record that no font in this font group supports C.  */
   736   FONTSET_SET (fontset, make_fixnum (c), make_fixnum (0));
   737   return Qnil;
   738 
   739  found:
   740   if (fallback && found_index > 0)
   741     {
   742       /* The order of fonts in the fallback font-group is not that
   743          important, and it is better to move the found font to the
   744          first of the group so that the next try will find it
   745          quickly. */
   746       for (i = found_index; i > 0; i--)
   747         ASET (vec, i, AREF (vec, i - 1));
   748       ASET (vec, 0, rfont_def);
   749     }
   750   return rfont_def;
   751 }
   752 
   753 
   754 /* Return RFONT-DEF (vector) corresponding to the font for character
   755    C.  The value is not a vector if no font is found for C.  */
   756 
   757 static Lisp_Object
   758 fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
   759 {
   760   Lisp_Object rfont_def;
   761   Lisp_Object default_rfont_def UNINIT;
   762   Lisp_Object base_fontset;
   763 
   764   /* Try a font-group of FONTSET. */
   765   FONT_DEFERRED_LOG ("current fontset: font for", make_fixnum (c), Qnil);
   766   rfont_def = fontset_find_font (fontset, c, face, id, 0);
   767   if (VECTORP (rfont_def))
   768     return rfont_def;
   769   if (NILP (rfont_def))
   770     FONTSET_SET (fontset, make_fixnum (c), make_fixnum (0));
   771 
   772   /* Try a font-group of the default fontset. */
   773   base_fontset = FONTSET_BASE (fontset);
   774   if (! EQ (base_fontset, Vdefault_fontset))
   775     {
   776       if (NILP (FONTSET_DEFAULT (fontset)))
   777         set_fontset_default
   778           (fontset,
   779            make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
   780       FONT_DEFERRED_LOG ("default fontset: font for", make_fixnum (c), Qnil);
   781       default_rfont_def
   782         = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
   783       if (VECTORP (default_rfont_def))
   784         return default_rfont_def;
   785       if (NILP (default_rfont_def))
   786         FONTSET_SET (FONTSET_DEFAULT (fontset), make_fixnum (c),
   787                      make_fixnum (0));
   788     }
   789 
   790   /* Try a fallback font-group of FONTSET. */
   791   if (! EQ (rfont_def, Qt))
   792     {
   793       FONT_DEFERRED_LOG ("current fallback: font for", make_fixnum (c), Qnil);
   794       rfont_def = fontset_find_font (fontset, c, face, id, 1);
   795       if (VECTORP (rfont_def))
   796         return rfont_def;
   797       /* Remember that FONTSET has no font for C.  */
   798       FONTSET_SET (fontset, make_fixnum (c), Qt);
   799     }
   800 
   801   /* Try a fallback font-group of the default fontset. */
   802   if (! EQ (base_fontset, Vdefault_fontset)
   803       && ! EQ (default_rfont_def, Qt))
   804     {
   805       FONT_DEFERRED_LOG ("default fallback: font for", make_fixnum (c), Qnil);
   806       rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
   807       if (VECTORP (rfont_def))
   808         return rfont_def;
   809       /* Remember that the default fontset has no font for C.  */
   810       FONTSET_SET (FONTSET_DEFAULT (fontset), make_fixnum (c), Qt);
   811     }
   812 
   813   return Qnil;
   814 }
   815 
   816 /* Return a newly created fontset with NAME.  If BASE is nil, make a
   817    base fontset.  Otherwise make a realized fontset whose base is
   818    BASE.  */
   819 
   820 static Lisp_Object
   821 make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
   822 {
   823   Lisp_Object fontset;
   824   int size = ASIZE (Vfontset_table);
   825   int id = next_fontset_id;
   826 
   827   /* Find a free slot in Vfontset_table.  Usually, next_fontset_id is
   828      the next available fontset ID.  So it is expected that this loop
   829      terminates quickly.  In addition, as the last element of
   830      Vfontset_table is always nil, we don't have to check the range of
   831      id.  */
   832   while (!NILP (AREF (Vfontset_table, id))) id++;
   833 
   834   if (id + 1 == size)
   835     Vfontset_table = larger_vector (Vfontset_table, 1, -1);
   836 
   837   fontset = Fmake_char_table (Qfontset, Qnil);
   838 
   839   set_fontset_id (fontset, make_fixnum (id));
   840   if (NILP (base))
   841     set_fontset_name (fontset, name);
   842   else
   843     {
   844       set_fontset_name (fontset, Qnil);
   845       set_fontset_frame (fontset, frame);
   846       set_fontset_base (fontset, base);
   847     }
   848 
   849   ASET (Vfontset_table, id, fontset);
   850   next_fontset_id = id + 1;
   851   return fontset;
   852 }
   853 
   854 
   855 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
   856 
   857 /* Return the name of the fontset who has ID.  */
   858 
   859 Lisp_Object
   860 fontset_name (int id)
   861 {
   862   Lisp_Object fontset;
   863 
   864   fontset = FONTSET_FROM_ID (id);
   865   return FONTSET_NAME (fontset);
   866 }
   867 
   868 
   869 /* Return the ASCII font name of the fontset who has ID.  */
   870 
   871 Lisp_Object
   872 fontset_ascii (int id)
   873 {
   874   Lisp_Object fontset, elt;
   875 
   876   fontset= FONTSET_FROM_ID (id);
   877   elt = FONTSET_ASCII (fontset);
   878   if (CONSP (elt))
   879     elt = XCAR (elt);
   880   return elt;
   881 }
   882 
   883 /* Free fontset of FACE defined on frame F.  Called from
   884    free_realized_face.  */
   885 
   886 void
   887 free_face_fontset (struct frame *f, struct face *face)
   888 {
   889   Lisp_Object fontset;
   890 
   891   fontset = FONTSET_FROM_ID (face->fontset);
   892   if (NILP (fontset))
   893     return;
   894   eassert (! BASE_FONTSET_P (fontset));
   895   eassert (f == XFRAME (FONTSET_FRAME (fontset)));
   896   ASET (Vfontset_table, face->fontset, Qnil);
   897   if (face->fontset < next_fontset_id)
   898     next_fontset_id = face->fontset;
   899   if (! NILP (FONTSET_DEFAULT (fontset)))
   900     {
   901       int id = XFIXNUM (FONTSET_ID (FONTSET_DEFAULT (fontset)));
   902 
   903       fontset = AREF (Vfontset_table, id);
   904       eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
   905       eassert (f == XFRAME (FONTSET_FRAME (fontset)));
   906       ASET (Vfontset_table, id, Qnil);
   907       if (id < next_fontset_id)
   908         next_fontset_id = face->fontset;
   909     }
   910   face->fontset = -1;
   911 }
   912 
   913 /* Return ID of face suitable for displaying character C at buffer position
   914    POS on frame F.  FACE must be realized for ASCII characters in advance.
   915    Called from the macro FACE_FOR_CHAR.  */
   916 
   917 int
   918 face_for_char (struct frame *f, struct face *face, int c,
   919                ptrdiff_t pos, Lisp_Object object)
   920 {
   921   Lisp_Object fontset, rfont_def, charset;
   922   int face_id;
   923   int id;
   924 
   925   if (ASCII_CHAR_P (c) || CHAR_BYTE8_P (c))
   926     return face->ascii_face->id;
   927 
   928   if (use_default_font_for_symbols  /* let the user disable this feature */
   929       && c > 0 && EQ (CHAR_TABLE_REF (Vchar_script_table, c), Qsymbol))
   930     {
   931       /* Fonts often have characters for punctuation and other
   932          symbols, even if they don't match the 'symbol' script.  So
   933          check if the character is present in the current ASCII face
   934          first, and if so, use the same font as used by that face.
   935          This avoids unnecessarily switching to another font when the
   936          frame's default font will do.  We only do this for symbols so
   937          that users could still setup fontsets to force Emacs to use
   938          specific fonts for characters from other scripts, because
   939          choice of fonts is frequently affected by cultural
   940          preferences and font features, not by font coverage.
   941          However, these considerations are unlikely to be relevant to
   942          punctuation and other symbols, since the latter generally
   943          aren't specific to any culture, and don't require
   944          sophisticated OTF features.  */
   945       Lisp_Object font_object;
   946 
   947       if (face->ascii_face->font)
   948         {
   949           XSETFONT (font_object, face->ascii_face->font);
   950           if (font_has_char (f, font_object, c))
   951             return face->ascii_face->id;
   952         }
   953 
   954 #if 0
   955       /* Try the current face.  Disabled because it can cause
   956          counter-intuitive results, whereby the font used for some
   957          character depends on the characters that precede it on
   958          display.  See the discussion of bug #15138.  Note that the
   959          original bug reported in #15138 was in a situation where face
   960          == face->ascii_face, so the above code solves that situation
   961          without risking the undesirable consequences.  */
   962       if (face->font)
   963         {
   964           XSETFONT (font_object, face->font);
   965           if (font_has_char (f, font_object, c)) return face->id;
   966         }
   967 #endif
   968     }
   969 
   970   /* If the parent face has no fontset we could work with, and has no
   971      font, just return that same face, so that the caller will
   972      consider the character to have no font capable of displaying it,
   973      and display it as "glyphless".  That is certainly better than
   974      violating the assertion below or crashing when assertions are not
   975      compiled in.  */
   976   if (face->fontset < 0 && !face->font)
   977     return face->id;
   978 
   979   eassert (fontset_id_valid_p (face->fontset));
   980   fontset = FONTSET_FROM_ID (face->fontset);
   981   eassert (!BASE_FONTSET_P (fontset));
   982 
   983   if (pos < 0)
   984     {
   985       id = -1;
   986       charset = Qnil;
   987     }
   988   else
   989     {
   990       charset = Fget_char_property (make_fixnum (pos), Qcharset, object);
   991       if (CHARSETP (charset))
   992         {
   993           Lisp_Object val;
   994 
   995           val = assq_no_quit (charset, Vfont_encoding_charset_alist);
   996           if (CONSP (val) && CHARSETP (XCDR (val)))
   997             charset = XCDR (val);
   998           id = XFIXNUM (CHARSET_SYMBOL_ID (charset));
   999         }
  1000       else
  1001         id = -1;
  1002     }
  1003 
  1004   rfont_def = fontset_font (fontset, c, face, id);
  1005   if (VECTORP (rfont_def))
  1006     {
  1007       if (FIXNUMP (RFONT_DEF_FACE (rfont_def)))
  1008         face_id = XFIXNUM (RFONT_DEF_FACE (rfont_def));
  1009       else
  1010         {
  1011           Lisp_Object font_object;
  1012 
  1013           font_object = RFONT_DEF_OBJECT (rfont_def);
  1014           face_id = face_for_font (f, font_object, face);
  1015           RFONT_DEF_SET_FACE (rfont_def, face_id);
  1016         }
  1017     }
  1018   else
  1019     {
  1020       if (FIXNUMP (FONTSET_NOFONT_FACE (fontset)))
  1021         face_id = XFIXNUM (FONTSET_NOFONT_FACE (fontset));
  1022       else
  1023         {
  1024           face_id = face_for_font (f, Qnil, face);
  1025           set_fontset_nofont_face (fontset, make_fixnum (face_id));
  1026         }
  1027     }
  1028   eassert (face_id >= 0);
  1029   return face_id;
  1030 }
  1031 
  1032 
  1033 Lisp_Object
  1034 font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object)
  1035 {
  1036   Lisp_Object fontset, rfont_def, charset;
  1037   int id;
  1038 
  1039   if (ASCII_CHAR_P (c))
  1040     {
  1041       Lisp_Object font_object;
  1042 
  1043       XSETFONT (font_object, face->ascii_face->font);
  1044       return font_object;
  1045     }
  1046 
  1047   eassert (fontset_id_valid_p (face->fontset));
  1048   fontset = FONTSET_FROM_ID (face->fontset);
  1049   eassert (!BASE_FONTSET_P (fontset));
  1050   if (pos < 0)
  1051     {
  1052       id = -1;
  1053       charset = Qnil;
  1054     }
  1055   else
  1056     {
  1057       charset = Fget_char_property (make_fixnum (pos), Qcharset, object);
  1058       if (CHARSETP (charset))
  1059         {
  1060           Lisp_Object val;
  1061 
  1062           val = assq_no_quit (charset, Vfont_encoding_charset_alist);
  1063           if (CONSP (val) && CHARSETP (XCDR (val)))
  1064             charset = XCDR (val);
  1065           id = XFIXNUM (CHARSET_SYMBOL_ID (charset));
  1066         }
  1067       else
  1068         id = -1;
  1069     }
  1070 
  1071   rfont_def = fontset_font (fontset, c, face, id);
  1072   return (VECTORP (rfont_def)
  1073           ? RFONT_DEF_OBJECT (rfont_def)
  1074           : Qnil);
  1075 }
  1076 
  1077 
  1078 /* Make a realized fontset for ASCII face FACE on frame F from the
  1079    base fontset BASE_FONTSET_ID.  If BASE_FONTSET_ID is -1, use the
  1080    default fontset as the base.  Value is the id of the new fontset.
  1081    Called from realize_gui_face.  */
  1082 
  1083 int
  1084 make_fontset_for_ascii_face (struct frame *f, int base_fontset_id, struct face *face)
  1085 {
  1086   Lisp_Object base_fontset, fontset, frame;
  1087 
  1088   XSETFRAME (frame, f);
  1089   if (base_fontset_id >= 0)
  1090     {
  1091       base_fontset = FONTSET_FROM_ID (base_fontset_id);
  1092       if (!BASE_FONTSET_P (base_fontset))
  1093         base_fontset = FONTSET_BASE (base_fontset);
  1094       eassert (BASE_FONTSET_P (base_fontset));
  1095     }
  1096   else
  1097     base_fontset = Vdefault_fontset;
  1098 
  1099   fontset = make_fontset (frame, Qnil, base_fontset);
  1100   return XFIXNUM (FONTSET_ID (fontset));
  1101 }
  1102 
  1103 
  1104 
  1105 /* Cache data used by fontset_pattern_regexp.  The car part is a
  1106    pattern string containing at least one wild card, the cdr part is
  1107    the corresponding regular expression.  */
  1108 static Lisp_Object Vcached_fontset_data;
  1109 
  1110 #define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
  1111 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
  1112 
  1113 /* If fontset name PATTERN contains any wild card, return regular
  1114    expression corresponding to PATTERN.  */
  1115 
  1116 static Lisp_Object
  1117 fontset_pattern_regexp (Lisp_Object pattern)
  1118 {
  1119   if (!strchr (SSDATA (pattern), '*')
  1120       && !strchr (SSDATA (pattern), '?'))
  1121     /* PATTERN does not contain any wild cards.  */
  1122     return Qnil;
  1123 
  1124   if (!CONSP (Vcached_fontset_data)
  1125       || strcmp (SSDATA (pattern), CACHED_FONTSET_NAME))
  1126     {
  1127       /* We must at first update the cached data.  */
  1128       unsigned char *regex, *p0, *p1;
  1129       int ndashes = 0, nstars = 0, nescs = 0;
  1130 
  1131       for (p0 = SDATA (pattern); *p0; p0++)
  1132         {
  1133           if (*p0 == '-')
  1134             ndashes++;
  1135           else if (*p0 == '*')
  1136             nstars++;
  1137           else if (*p0 == '['
  1138                    || *p0 == '.' || *p0 == '\\'
  1139                    || *p0 == '+' || *p0 == '^'
  1140                    || *p0 == '$')
  1141             nescs++;
  1142         }
  1143 
  1144       /* If PATTERN is not full XLFD we convert "*" to ".*".  Otherwise
  1145          we convert "*" to "[^-]*" which is much faster in regular
  1146          expression matching.  */
  1147       ptrdiff_t regexsize = (SBYTES (pattern)
  1148                              + (ndashes < 14 ? 2 : 5) * nstars
  1149                              + 2 * nescs + 3);
  1150       USE_SAFE_ALLOCA;
  1151       p1 = regex = SAFE_ALLOCA (regexsize);
  1152 
  1153       *p1++ = '^';
  1154       for (p0 = SDATA (pattern); *p0; p0++)
  1155         {
  1156           if (*p0 == '*')
  1157             {
  1158               if (ndashes < 14)
  1159                 *p1++ = '.';
  1160               else
  1161                 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
  1162               *p1++ = '*';
  1163             }
  1164           else if (*p0 == '?')
  1165             *p1++ = '.';
  1166           else if (*p0 == '['
  1167                    || *p0 == '.' || *p0 == '\\'
  1168                    || *p0 == '+' || *p0 == '^'
  1169                    || *p0 == '$')
  1170             *p1++ = '\\', *p1++ = *p0;
  1171           else
  1172             *p1++ = *p0;
  1173         }
  1174       *p1++ = '$';
  1175       *p1++ = 0;
  1176 
  1177       Vcached_fontset_data = Fcons (build_string (SSDATA (pattern)),
  1178                                     build_string ((char *) regex));
  1179       SAFE_FREE ();
  1180     }
  1181 
  1182   return CACHED_FONTSET_REGEX;
  1183 }
  1184 
  1185 /* Return ID of the base fontset named NAME.  If there's no such
  1186    fontset, return -1.  NAME_PATTERN specifies how to treat NAME as this:
  1187      0: pattern containing '*' and '?' as wildcards
  1188      1: regular expression
  1189      2: literal fontset name
  1190 */
  1191 
  1192 int
  1193 fs_query_fontset (Lisp_Object name, int name_pattern)
  1194 {
  1195   Lisp_Object tem;
  1196   int i;
  1197 
  1198   name = Fdowncase (name);
  1199   if (name_pattern != 1)
  1200     {
  1201       tem = Frassoc (name, Vfontset_alias_alist);
  1202       if (NILP (tem))
  1203         tem = Fassoc (name, Vfontset_alias_alist, Qnil);
  1204       if (CONSP (tem) && STRINGP (XCAR (tem)))
  1205         name = XCAR (tem);
  1206       else if (name_pattern == 0)
  1207         {
  1208           tem = fontset_pattern_regexp (name);
  1209           if (STRINGP (tem))
  1210             {
  1211               name = tem;
  1212               name_pattern = 1;
  1213             }
  1214         }
  1215     }
  1216 
  1217   for (i = 0; i < ASIZE (Vfontset_table); i++)
  1218     {
  1219       Lisp_Object fontset, this_name;
  1220 
  1221       fontset = FONTSET_FROM_ID (i);
  1222       if (NILP (fontset)
  1223           || !BASE_FONTSET_P (fontset))
  1224         continue;
  1225 
  1226       this_name = FONTSET_NAME (fontset);
  1227       if (name_pattern == 1
  1228           ? fast_string_match_ignore_case (name, this_name) >= 0
  1229           : !xstrcasecmp (SSDATA (name), SSDATA (this_name)))
  1230         return i;
  1231     }
  1232   return -1;
  1233 }
  1234 
  1235 
  1236 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
  1237        doc: /* Return the name of a fontset that matches PATTERN.
  1238 The value is nil if there is no matching fontset.
  1239 PATTERN can contain `*' or `?' as a wildcard
  1240 just as X font name matching algorithm allows.
  1241 If REGEXPP is non-nil, PATTERN is a regular expression.  */)
  1242   (Lisp_Object pattern, Lisp_Object regexpp)
  1243 {
  1244   Lisp_Object fontset;
  1245   int id;
  1246 
  1247   check_window_system (NULL);
  1248 
  1249   CHECK_STRING (pattern);
  1250 
  1251   if (SCHARS (pattern) == 0)
  1252     return Qnil;
  1253 
  1254   id = fs_query_fontset (pattern, !NILP (regexpp));
  1255   if (id < 0)
  1256     return Qnil;
  1257 
  1258   fontset = FONTSET_FROM_ID (id);
  1259   return FONTSET_NAME (fontset);
  1260 }
  1261 
  1262 /* Return a list of base fontset names matching PATTERN on frame F.  */
  1263 
  1264 Lisp_Object
  1265 list_fontsets (struct frame *f, Lisp_Object pattern, int size)
  1266 {
  1267   Lisp_Object frame, regexp, val;
  1268   int id;
  1269 
  1270   XSETFRAME (frame, f);
  1271 
  1272   regexp = fontset_pattern_regexp (pattern);
  1273   val = Qnil;
  1274 
  1275   for (id = 0; id < ASIZE (Vfontset_table); id++)
  1276     {
  1277       Lisp_Object fontset, name;
  1278 
  1279       fontset = FONTSET_FROM_ID (id);
  1280       if (NILP (fontset)
  1281           || !BASE_FONTSET_P (fontset)
  1282           || !EQ (frame, FONTSET_FRAME (fontset)))
  1283         continue;
  1284       name = FONTSET_NAME (fontset);
  1285 
  1286       if (STRINGP (regexp)
  1287           ? (fast_string_match (regexp, name) < 0)
  1288           : strcmp (SSDATA (pattern), SSDATA (name)))
  1289         continue;
  1290 
  1291       val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
  1292     }
  1293 
  1294   return val;
  1295 }
  1296 
  1297 
  1298 /* Free all realized fontsets whose base fontset is BASE.  */
  1299 
  1300 static void
  1301 free_realized_fontsets (Lisp_Object base)
  1302 {
  1303   int id;
  1304 
  1305 #if 0
  1306   /* For the moment, this doesn't work because free_realized_face
  1307      doesn't remove FACE from a cache.  Until we find a solution, we
  1308      suppress this code, and simply use Fclear_face_cache even though
  1309      that is not efficient.  */
  1310   block_input ();
  1311   for (id = 0; id < ASIZE (Vfontset_table); id++)
  1312     {
  1313       Lisp_Object this = AREF (Vfontset_table, id);
  1314 
  1315       if (EQ (FONTSET_BASE (this), base))
  1316         {
  1317           Lisp_Object tail;
  1318 
  1319           for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
  1320                tail = XCDR (tail))
  1321             {
  1322               struct frame *f = XFRAME (FONTSET_FRAME (this));
  1323               int face_id = XFIXNUM (XCDR (XCAR (tail)));
  1324               struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
  1325 
  1326               /* Face THIS itself is also freed by the following call.  */
  1327               free_realized_face (f, face);
  1328             }
  1329         }
  1330     }
  1331   unblock_input ();
  1332 #else  /* not 0 */
  1333   /* But, we don't have to call Fclear_face_cache if no fontset has
  1334      been realized from BASE.  */
  1335   for (id = 0; id < ASIZE (Vfontset_table); id++)
  1336     {
  1337       Lisp_Object this = AREF (Vfontset_table, id);
  1338 
  1339       if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
  1340         {
  1341           Fclear_face_cache (Qt);
  1342           /* This is in case some Lisp calls this function and then
  1343              proceeds with calling some other function, like font-at,
  1344              which needs the basic faces.  */
  1345           recompute_basic_faces (XFRAME (FONTSET_FRAME (this)));
  1346           break;
  1347         }
  1348     }
  1349 #endif /* not 0 */
  1350 }
  1351 
  1352 
  1353 /* Check validity of NAME as a fontset name and return the
  1354    corresponding fontset.  If not valid, signal an error.
  1355 
  1356    If NAME is t, return Vdefault_fontset.  If NAME is nil, return the
  1357    fontset of *FRAME.
  1358 
  1359    Set *FRAME to the actual frame.  */
  1360 
  1361 static Lisp_Object
  1362 check_fontset_name (Lisp_Object name, Lisp_Object *frame)
  1363 {
  1364   int id;
  1365   struct frame *f = decode_live_frame (*frame);
  1366 
  1367   XSETFRAME (*frame, f);
  1368 
  1369   if (EQ (name, Qt))
  1370     return Vdefault_fontset;
  1371   if (NILP (name))
  1372     {
  1373       if (!FRAME_WINDOW_P (f))
  1374         error ("Can't use fontsets in non-GUI frames");
  1375       id = FRAME_FONTSET (f);
  1376     }
  1377   else
  1378     {
  1379       CHECK_STRING (name);
  1380       /* First try NAME as literal.  */
  1381       id = fs_query_fontset (name, 2);
  1382       if (id < 0)
  1383         /* For backward compatibility, try again NAME as pattern.  */
  1384         id = fs_query_fontset (name, 0);
  1385       if (id < 0)
  1386         error ("Fontset `%s' does not exist", SDATA (name));
  1387     }
  1388   return FONTSET_FROM_ID (id);
  1389 }
  1390 
  1391 static void
  1392 accumulate_script_ranges (Lisp_Object arg, Lisp_Object range, Lisp_Object val)
  1393 {
  1394   if (EQ (XCAR (arg), val))
  1395     {
  1396       if (CONSP (range))
  1397         XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
  1398       else
  1399         XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
  1400     }
  1401 }
  1402 
  1403 
  1404 /* Callback function for map_charset_chars in Fset_fontset_font.
  1405    ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
  1406 
  1407    In FONTSET, set FONT_DEF in a fashion specified by ADD for
  1408    characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
  1409    The consumed ranges are popped up from SCRIPT_RANGE_LIST, and the
  1410    new SCRIPT_RANGE_LIST is stored in ARG.
  1411 
  1412    If ASCII is nil, don't set FONT_DEF for ASCII characters.  It is
  1413    assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
  1414    case.  */
  1415 
  1416 static void
  1417 set_fontset_font (Lisp_Object arg, Lisp_Object range)
  1418 {
  1419   Lisp_Object fontset, font_def, add, ascii, script_range_list;
  1420   int from = XFIXNUM (XCAR (range)), to = XFIXNUM (XCDR (range));
  1421 
  1422   fontset = AREF (arg, 0);
  1423   font_def = AREF (arg, 1);
  1424   add = AREF (arg, 2);
  1425   ascii = AREF (arg, 3);
  1426   script_range_list = AREF (arg, 4);
  1427 
  1428   if (NILP (ascii) && from < 0x80)
  1429     {
  1430       if (to < 0x80)
  1431         return;
  1432       from = 0x80;
  1433       range = Fcons (make_fixnum (0x80), XCDR (range));
  1434     }
  1435 
  1436 #define SCRIPT_FROM XFIXNUM (XCAR (XCAR (script_range_list)))
  1437 #define SCRIPT_TO XFIXNUM (XCDR (XCAR (script_range_list)))
  1438 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
  1439 
  1440   for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
  1441     FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
  1442   if (CONSP (script_range_list))
  1443     {
  1444       if (SCRIPT_FROM < from)
  1445         range = Fcons (make_fixnum (SCRIPT_FROM), XCDR (range));
  1446       while (CONSP (script_range_list) && SCRIPT_TO <= to)
  1447         POP_SCRIPT_RANGE ();
  1448       if (CONSP (script_range_list) && SCRIPT_FROM <= to)
  1449         XSETCAR (XCAR (script_range_list), make_fixnum (to + 1));
  1450     }
  1451 
  1452   FONTSET_ADD (fontset, range, font_def, add);
  1453   ASET (arg, 4, script_range_list);
  1454 }
  1455 
  1456 static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
  1457 
  1458 
  1459 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
  1460        doc: /*
  1461 Modify FONTSET to use font specification in FONT-SPEC for displaying CHARACTERS.
  1462 
  1463 FONTSET should be a fontset name (a string); or nil, meaning the
  1464 fontset of FRAME; or t, meaning the default fontset.
  1465 
  1466 CHARACTERS may be a single character to use FONT-SPEC for.
  1467 
  1468 CHARACTERS may be a cons (FROM . TO), where FROM and TO are characters.
  1469 In that case, use FONT-SPEC for all the characters in the range
  1470 between FROM and TO (inclusive).
  1471 
  1472 CHARACTERS may be a script symbol.  In that case, use FONT-SPEC for
  1473 all the characters that belong to the script.  See the variable
  1474 `script-representative-chars' for the list of known scripts, and
  1475 see the variable `char-script-table' for the script of any specific
  1476 character.
  1477 
  1478 CHARACTERS may be a charset symbol.  In that case, use FONT-SPEC for
  1479 all the characters in the charset.  See `list-character-sets' and
  1480 `list-charset-chars' for the list of character sets and their
  1481 characters.
  1482 
  1483 CHARACTERS may be nil.  In that case, use FONT-SPEC for any
  1484 character for which no font-spec is specified in FONTSET.
  1485 
  1486 FONT-SPEC may one of these:
  1487  * A font-spec object made by the function `font-spec' (which see).
  1488  * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
  1489    REGISTRY is a font registry name.  FAMILY may contain foundry
  1490    name, and REGISTRY may contain encoding name.
  1491  * A font name string.
  1492  * nil, which explicitly specifies that there's no font for CHARACTERS.
  1493 
  1494 Optional 4th argument FRAME is a frame whose fontset should be modified;
  1495 it is used if FONTSET is nil.  If FONTSET is nil and FRAME is omitted
  1496 or nil, that stands for the fontset of the selected frame.
  1497 
  1498 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
  1499 to the previously set font specifications for CHARACTERS.  If it is
  1500 `prepend', FONT-SPEC is prepended to the existing font specifications.
  1501 If it is `append', FONT-SPEC is appended.  By default, FONT-SPEC
  1502 overwrites the previous settings.  */)
  1503   (Lisp_Object fontset, Lisp_Object characters, Lisp_Object font_spec,
  1504    Lisp_Object frame, Lisp_Object add)
  1505 {
  1506   Lisp_Object fontset_obj;
  1507   Lisp_Object font_def, registry, family;
  1508   Lisp_Object range_list;
  1509   struct charset *charset = NULL;
  1510   Lisp_Object fontname;
  1511   bool ascii_changed = 0;
  1512 
  1513   fontset_obj = check_fontset_name (fontset, &frame);
  1514 
  1515   fontname = Qnil;
  1516   if (CONSP (font_spec))
  1517     {
  1518       Lisp_Object spec = Ffont_spec (0, NULL);
  1519 
  1520       font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
  1521       font_spec = spec;
  1522       fontname = Ffont_xlfd_name (font_spec, Qnil);
  1523     }
  1524   else if (STRINGP (font_spec))
  1525     {
  1526       fontname = font_spec;
  1527       font_spec = CALLN (Ffont_spec, QCname, fontname);
  1528     }
  1529   else if (FONT_SPEC_P (font_spec))
  1530     fontname = Ffont_xlfd_name (font_spec, Qnil);
  1531   else if (! NILP (font_spec))
  1532     Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
  1533 
  1534   if (! NILP (font_spec))
  1535     {
  1536       Lisp_Object encoding, repertory;
  1537 
  1538       family = AREF (font_spec, FONT_FAMILY_INDEX);
  1539       if (! NILP (family) )
  1540         family = SYMBOL_NAME (family);
  1541       registry = AREF (font_spec, FONT_REGISTRY_INDEX);
  1542       if (! NILP (registry))
  1543         registry = Fdowncase (SYMBOL_NAME (registry));
  1544       AUTO_STRING (dash, "-");
  1545       encoding = find_font_encoding (concat3 (family, dash, registry));
  1546       if (NILP (encoding))
  1547         encoding = Qascii;
  1548 
  1549       if (SYMBOLP (encoding))
  1550         {
  1551           CHECK_CHARSET (encoding);
  1552           encoding = repertory = CHARSET_SYMBOL_ID (encoding);
  1553         }
  1554       else
  1555         {
  1556           repertory = XCDR (encoding);
  1557           encoding = XCAR (encoding);
  1558           CHECK_CHARSET (encoding);
  1559           encoding = CHARSET_SYMBOL_ID (encoding);
  1560           if (! NILP (repertory) && SYMBOLP (repertory))
  1561             {
  1562               CHECK_CHARSET (repertory);
  1563               repertory = CHARSET_SYMBOL_ID (repertory);
  1564             }
  1565         }
  1566       font_def = font_def_new (font_spec, encoding, repertory);
  1567     }
  1568   else
  1569     font_def = Qnil;
  1570 
  1571   if (CHARACTERP (characters))
  1572     {
  1573       if (XFIXNAT (characters) < 0x80)
  1574         error ("Can't set a font for partial ASCII range");
  1575       range_list = list1 (Fcons (characters, characters));
  1576     }
  1577   else if (CONSP (characters))
  1578     {
  1579       Lisp_Object from, to;
  1580 
  1581       from = Fcar (characters);
  1582       to = Fcdr (characters);
  1583       CHECK_CHARACTER (from);
  1584       CHECK_CHARACTER (to);
  1585       if (XFIXNAT (from) < 0x80)
  1586         {
  1587           if (XFIXNAT (from) != 0 || XFIXNAT (to) < 0x7F)
  1588             error ("Can't set a font for partial ASCII range");
  1589           ascii_changed = 1;
  1590         }
  1591       range_list = list1 (characters);
  1592     }
  1593   else if (SYMBOLP (characters) && !NILP (characters))
  1594     {
  1595       Lisp_Object script_list;
  1596       Lisp_Object val;
  1597 
  1598       range_list = Qnil;
  1599       script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
  1600       if (! NILP (Fmemq (characters, script_list)))
  1601         {
  1602           if (EQ (characters, Qlatin))
  1603             ascii_changed = 1;
  1604           val = list1 (characters);
  1605           map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
  1606                           val);
  1607           range_list = Fnreverse (XCDR (val));
  1608         }
  1609       if (CHARSETP (characters))
  1610         {
  1611           CHECK_CHARSET_GET_CHARSET (characters, charset);
  1612           if (charset->ascii_compatible_p)
  1613             ascii_changed = 1;
  1614         }
  1615       else if (NILP (range_list))
  1616         error ("Invalid script or charset name: %s",
  1617                SDATA (SYMBOL_NAME (characters)));
  1618     }
  1619   else if (NILP (characters))
  1620     range_list = list1 (Qnil);
  1621   else
  1622     error ("Invalid second argument for setting a font in a fontset");
  1623 
  1624   if (ascii_changed)
  1625     {
  1626       Lisp_Object val;
  1627 
  1628       if (NILP (font_spec))
  1629         error ("Can't set ASCII font to nil");
  1630       val = CHAR_TABLE_REF (fontset_obj, 0);
  1631       if (! NILP (val) && EQ (add, Qappend))
  1632         /* We are going to change just an additional font for ASCII.  */
  1633         ascii_changed = 0;
  1634     }
  1635 
  1636   if (charset)
  1637     {
  1638       Lisp_Object arg = CALLN (Fvector, fontset_obj, font_def, add,
  1639                                ascii_changed ? Qt : Qnil, range_list);
  1640 
  1641       map_charset_chars (set_fontset_font, Qnil, arg, charset,
  1642                          CHARSET_MIN_CODE (charset),
  1643                          CHARSET_MAX_CODE (charset));
  1644       range_list = AREF (arg, 4);
  1645     }
  1646   for (; CONSP (range_list); range_list = XCDR (range_list))
  1647     FONTSET_ADD (fontset_obj, XCAR (range_list), font_def, add);
  1648 
  1649   if (ascii_changed)
  1650     {
  1651       Lisp_Object tail, fr;
  1652       int fontset_id = XFIXNUM (FONTSET_ID (fontset_obj));
  1653 
  1654       set_fontset_ascii (fontset_obj, fontname);
  1655       fontset = FONTSET_NAME (fontset_obj);
  1656       FOR_EACH_FRAME (tail, fr)
  1657         {
  1658           struct frame *f = XFRAME (fr);
  1659           Lisp_Object font_object;
  1660           struct face *face;
  1661 
  1662           if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
  1663             continue;
  1664           if (fontset_id != FRAME_FONTSET (f))
  1665             continue;
  1666           face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
  1667           if (face)
  1668             font_object = font_load_for_lface (f, face->lface, font_spec);
  1669           else
  1670             font_object = font_open_by_spec (f, font_spec);
  1671           if (! NILP (font_object))
  1672             {
  1673               update_auto_fontset_alist (font_object, fontset_obj);
  1674               AUTO_FRAME_ARG (arg, Qfont, Fcons (fontset, font_object));
  1675 
  1676 #ifdef HAVE_WINDOW_SYSTEM
  1677               if (FRAME_WINDOW_P (f))
  1678                 /* This is a window-system frame.  Prevent changes of
  1679                    the `font' parameter here from messing with the
  1680                    `font-parameter' frame property, as the frame
  1681                    parameter is not being changed by the user.  */
  1682                 gui_set_frame_parameters_1 (f, arg, true);
  1683               else
  1684 #endif
  1685                 Fmodify_frame_parameters (fr, arg);
  1686             }
  1687         }
  1688     }
  1689 
  1690   /* Free all realized fontsets whose base is FONTSET_OBJ.  This way, the
  1691      specified character(s) are surely redisplayed by a correct
  1692      font.  */
  1693   free_realized_fontsets (fontset_obj);
  1694 
  1695   return Qnil;
  1696 }
  1697 
  1698 
  1699 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
  1700        doc: /* Create a new fontset NAME from font information in FONTLIST.
  1701 
  1702 FONTLIST is an alist of scripts vs the corresponding font specification list.
  1703 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
  1704 character of SCRIPT is displayed by a font that matches one of
  1705 FONT-SPEC.
  1706 
  1707 SCRIPT is a symbol that appears in the first extra slot of the
  1708 char-table `char-script-table'.
  1709 
  1710 FONT-SPEC is a vector, a cons, or a string.  See the documentation of
  1711 `set-fontset-font' for the meaning.  */)
  1712   (Lisp_Object name, Lisp_Object fontlist)
  1713 {
  1714   Lisp_Object fontset, tail;
  1715   int id;
  1716 
  1717   CHECK_STRING (name);
  1718 
  1719   name = Fdowncase (name);
  1720   id = fs_query_fontset (name, 0);
  1721   if (id < 0)
  1722     {
  1723       Lisp_Object font_spec = Ffont_spec (0, NULL);
  1724       Lisp_Object short_name;
  1725       char xlfd[256];
  1726       int len;
  1727 
  1728       if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0)
  1729         error ("Fontset name must be in XLFD format");
  1730       short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
  1731       if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
  1732           || SBYTES (SYMBOL_NAME (short_name)) < 9)
  1733         error ("Registry field of fontset name must be \"fontset-*\"");
  1734       Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
  1735                                     Vfontset_alias_alist);
  1736       ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
  1737       fontset = make_fontset (Qnil, name, Qnil);
  1738       len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
  1739       if (len < 0)
  1740         error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
  1741       set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
  1742     }
  1743   else
  1744     {
  1745       fontset = FONTSET_FROM_ID (id);
  1746       free_realized_fontsets (fontset);
  1747       Fset_char_table_range (fontset, Qt, Qnil);
  1748     }
  1749 
  1750   for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
  1751     {
  1752       Lisp_Object elt, script;
  1753 
  1754       elt = XCAR (tail);
  1755       script = Fcar (elt);
  1756       elt = Fcdr (elt);
  1757       if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
  1758         for (; CONSP (elt); elt = XCDR (elt))
  1759           Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
  1760       else
  1761         Fset_fontset_font (name, script, elt, Qnil, Qappend);
  1762     }
  1763   CHECK_LIST_END (tail, fontlist);
  1764   return name;
  1765 }
  1766 
  1767 
  1768 /* Alist of automatically created fontsets.  Each element is a cons
  1769    (FONT-SPEC . FONTSET-ID).  */
  1770 static Lisp_Object auto_fontset_alist;
  1771 
  1772 /* Number of automatically created fontsets.  */
  1773 static ptrdiff_t num_auto_fontsets;
  1774 
  1775 /* Return a fontset synthesized from FONT-OBJECT.  This is called from
  1776    the terminal hook set_new_font_hook when FONT-OBJECT is used for
  1777    the default ASCII font of a frame, and the returned fontset is used
  1778    for the default fontset of that frame.  The fontset specifies a
  1779    font of the same registry as FONT-OBJECT for all characters in the
  1780    repertory of the registry (see Vfont_encoding_alist).  If the
  1781    repertory is not known, the fontset specifies the font for all
  1782    Latin characters assuming that a user intends to use FONT-OBJECT
  1783    for Latin characters.  */
  1784 
  1785 int
  1786 fontset_from_font (Lisp_Object font_object)
  1787 {
  1788   Lisp_Object font_name = font_get_name (font_object);
  1789   Lisp_Object font_spec = copy_font_spec (font_object);
  1790   Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
  1791   Lisp_Object fontset_spec, alias, name, fontset;
  1792   Lisp_Object val;
  1793 
  1794   val = assoc_no_quit (font_spec, auto_fontset_alist);
  1795   if (CONSP (val))
  1796     return XFIXNUM (FONTSET_ID (XCDR (val)));
  1797   if (num_auto_fontsets++ == 0)
  1798     alias = intern ("fontset-startup");
  1799   else
  1800     {
  1801       char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
  1802 
  1803       sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
  1804       alias = intern (temp);
  1805     }
  1806   fontset_spec = copy_font_spec (font_spec);
  1807   ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
  1808   name = Ffont_xlfd_name (fontset_spec, Qnil);
  1809   eassert (!NILP (name));
  1810   fontset = make_fontset (Qnil, name, Qnil);
  1811   Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
  1812                                 Vfontset_alias_alist);
  1813   alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
  1814   Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
  1815   auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
  1816   font_spec = Ffont_spec (0, NULL);
  1817   ASET (font_spec, FONT_REGISTRY_INDEX, registry);
  1818   {
  1819     Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
  1820 
  1821     if (CONSP (target))
  1822       target = XCDR (target);
  1823     if (! CHARSETP (target))
  1824       target = Qlatin;
  1825     Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
  1826     Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
  1827   }
  1828 
  1829   set_fontset_ascii (fontset, font_name);
  1830 
  1831   return XFIXNUM (FONTSET_ID (fontset));
  1832 }
  1833 
  1834 
  1835 /* Update auto_fontset_alist for FONTSET.  When an ASCII font of
  1836    FONTSET is changed, we delete an entry of FONTSET if any from
  1837    auto_fontset_alist so that FONTSET is not re-used by
  1838    fontset_from_font.  */
  1839 
  1840 static void
  1841 update_auto_fontset_alist (Lisp_Object font_object, Lisp_Object fontset)
  1842 {
  1843   Lisp_Object prev, tail;
  1844 
  1845   for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
  1846        prev = tail, tail = XCDR (tail))
  1847     if (EQ (fontset, XCDR (XCAR (tail))))
  1848       {
  1849         if (NILP (prev))
  1850           auto_fontset_alist = XCDR (tail);
  1851         else
  1852           XSETCDR (prev, XCDR (tail));
  1853         break;
  1854       }
  1855 }
  1856 
  1857 
  1858 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
  1859        doc: /* Return information about a fontset FONTSET on frame FRAME.
  1860 
  1861 FONTSET is a fontset name string, nil for the fontset of FRAME, or t
  1862 for the default fontset.  FRAME nil means the selected frame.
  1863 
  1864 The value is a char-table whose elements have this form:
  1865 
  1866     ((FONT OPENED-FONT ...) ...)
  1867 
  1868 FONT is a name of font specified for a range of characters.
  1869 
  1870 OPENED-FONT is a name of a font actually opened.
  1871 
  1872 The char-table has one extra slot.  If FONTSET is not the default
  1873 fontset, the value the extra slot is a char-table containing the
  1874 information about the derived fonts from the default fontset.  The
  1875 format is the same as above.  */)
  1876   (Lisp_Object fontset, Lisp_Object frame)
  1877 {
  1878   Lisp_Object *realized[2], fontsets[2], tables[2];
  1879   Lisp_Object val, elt;
  1880   int c, i, j, k;
  1881 
  1882   check_window_system (NULL);
  1883   fontset = check_fontset_name (fontset, &frame);
  1884 
  1885   /* Recode fontsets realized on FRAME from the base fontset FONTSET
  1886      in the table `realized'.  */
  1887   USE_SAFE_ALLOCA;
  1888   SAFE_ALLOCA_LISP (realized[0], 2 * ASIZE (Vfontset_table));
  1889   realized[1] = realized[0] + ASIZE (Vfontset_table);
  1890   for (i = j = 0; i < ASIZE (Vfontset_table); i++)
  1891     {
  1892       elt = FONTSET_FROM_ID (i);
  1893       if (!NILP (elt)
  1894           && EQ (FONTSET_BASE (elt), fontset)
  1895           && EQ (FONTSET_FRAME (elt), frame))
  1896         realized[0][j++] = elt;
  1897     }
  1898   realized[0][j] = Qnil;
  1899 
  1900   for (i = j = 0; ! NILP (realized[0][i]); i++)
  1901     {
  1902       elt = FONTSET_DEFAULT (realized[0][i]);
  1903       if (! NILP (elt))
  1904         realized[1][j++] = elt;
  1905     }
  1906   realized[1][j] = Qnil;
  1907 
  1908   tables[0] = Fmake_char_table (Qfontset_info, Qnil);
  1909   fontsets[0] = fontset;
  1910   if (!EQ (fontset, Vdefault_fontset))
  1911     {
  1912       tables[1] = Fmake_char_table (Qnil, Qnil);
  1913       set_char_table_extras (tables[0], 0, tables[1]);
  1914       fontsets[1] = Vdefault_fontset;
  1915     }
  1916 
  1917   /* Accumulate information of the fontset in TABLE.  The format of
  1918      each element is ((FONT-SPEC OPENED-FONT ...) ...).  */
  1919   for (k = 0; k <= 1; k++)
  1920     {
  1921       for (c = 0; c <= MAX_CHAR; )
  1922         {
  1923           int from = c, to = MAX_5_BYTE_CHAR;
  1924 
  1925           if (c <= MAX_5_BYTE_CHAR)
  1926             {
  1927               val = char_table_ref_and_range (fontsets[k], c, &from, &to);
  1928             }
  1929           else
  1930             {
  1931               val = FONTSET_FALLBACK (fontsets[k]);
  1932               to = MAX_CHAR;
  1933             }
  1934           if (VECTORP (val))
  1935             {
  1936               Lisp_Object alist;
  1937 
  1938               /* At first, set ALIST to ((FONT-SPEC) ...).  */
  1939               for (alist = Qnil, i = 0; i < ASIZE (val); i++)
  1940                 if (! NILP (AREF (val, i)))
  1941                   alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
  1942                                  alist);
  1943               alist = Fnreverse (alist);
  1944 
  1945               /* Then store opened font names to cdr of each elements.  */
  1946               for (i = 0; ! NILP (realized[k][i]); i++)
  1947                 {
  1948                   if (c <= MAX_5_BYTE_CHAR)
  1949                     val = FONTSET_REF (realized[k][i], c);
  1950                   else
  1951                     val = FONTSET_FALLBACK (realized[k][i]);
  1952                   if (! CONSP (val) || ! VECTORP (XCDR (val)))
  1953                     continue;
  1954                   /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ])  */
  1955                   val = XCDR (val);
  1956                   for (j = 0; j < ASIZE (val); j++)
  1957                     {
  1958                       elt = AREF (val, j);
  1959                       if (!NILP (elt) && FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
  1960                         {
  1961                           Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
  1962                           Lisp_Object slot, name;
  1963 
  1964                           slot = Fassq (RFONT_DEF_SPEC (elt), alist);
  1965                           name = AREF (font_object, FONT_NAME_INDEX);
  1966                           if (NILP (Fmember (name, XCDR (slot))))
  1967                             nconc2 (slot, list1 (name));
  1968                         }
  1969                     }
  1970                 }
  1971 
  1972               /* Store ALIST in TBL for characters C..TO.  */
  1973               if (c <= MAX_5_BYTE_CHAR)
  1974                 char_table_set_range (tables[k], c, to, alist);
  1975               else
  1976                 set_char_table_defalt (tables[k], alist);
  1977 
  1978               /* At last, change each elements to font names.  */
  1979               for (; CONSP (alist); alist = XCDR (alist))
  1980                 {
  1981                   elt = XCAR (alist);
  1982                   XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
  1983                 }
  1984             }
  1985           c = to + 1;
  1986         }
  1987       if (EQ (fontset, Vdefault_fontset))
  1988         break;
  1989     }
  1990 
  1991   SAFE_FREE ();
  1992   return tables[0];
  1993 }
  1994 
  1995 
  1996 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
  1997        doc: /* Return a font name pattern for character CH in fontset NAME.
  1998 If NAME is t, find a pattern in the default fontset.
  1999 If NAME is nil, find a pattern in the fontset of the selected frame.
  2000 
  2001 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
  2002 family name and REGISTRY is a font registry name.  This is actually
  2003 the first font name pattern for CH in the fontset or in the default
  2004 fontset.
  2005 
  2006 If the 2nd optional arg ALL is non-nil, return a list of all font name
  2007 patterns.  */)
  2008   (Lisp_Object name, Lisp_Object ch, Lisp_Object all)
  2009 {
  2010   int c;
  2011   Lisp_Object fontset, elt, list, repertory, val;
  2012   int i, j;
  2013   Lisp_Object frame;
  2014 
  2015   frame = Qnil;
  2016   fontset = check_fontset_name (name, &frame);
  2017 
  2018   CHECK_CHARACTER (ch);
  2019   c = XFIXNUM (ch);
  2020   list = Qnil;
  2021   while (1)
  2022     {
  2023       for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
  2024            i++, elt = FONTSET_FALLBACK (fontset))
  2025         if (VECTORP (elt))
  2026           for (j = 0; j < ASIZE (elt); j++)
  2027             {
  2028               Lisp_Object family, registry;
  2029 
  2030               val = AREF (elt, j);
  2031               if (NILP (val))
  2032                 return Qnil;
  2033               repertory = AREF (val, 1);
  2034               if (FIXNUMP (repertory))
  2035                 {
  2036                   struct charset *charset = CHARSET_FROM_ID (XFIXNUM (repertory));
  2037 
  2038                   if (! CHAR_CHARSET_P (c, charset))
  2039                     continue;
  2040                 }
  2041               else if (CHAR_TABLE_P (repertory))
  2042                 {
  2043                   if (NILP (CHAR_TABLE_REF (repertory, c)))
  2044                     continue;
  2045                 }
  2046               val = AREF (val, 0);
  2047               /* VAL is a FONT-SPEC */
  2048               family = AREF (val, FONT_FAMILY_INDEX);
  2049               if (! NILP (family))
  2050                 family = SYMBOL_NAME (family);
  2051               registry = AREF (val, FONT_REGISTRY_INDEX);
  2052               if (! NILP (registry))
  2053                 registry = SYMBOL_NAME (registry);
  2054               val = Fcons (family, registry);
  2055               if (NILP (all))
  2056                 return val;
  2057               list = Fcons (val, list);
  2058             }
  2059       if (EQ (fontset, Vdefault_fontset))
  2060         break;
  2061       fontset = Vdefault_fontset;
  2062     }
  2063   return (Fnreverse (list));
  2064 }
  2065 
  2066 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
  2067        doc: /* Return a list of all defined fontset names.  */)
  2068   (void)
  2069 {
  2070   Lisp_Object fontset, list;
  2071   int i;
  2072 
  2073   list = Qnil;
  2074   for (i = 0; i < ASIZE (Vfontset_table); i++)
  2075     {
  2076       fontset = FONTSET_FROM_ID (i);
  2077       if (!NILP (fontset)
  2078           && BASE_FONTSET_P (fontset))
  2079         list = Fcons (FONTSET_NAME (fontset), list);
  2080     }
  2081 
  2082   return list;
  2083 }
  2084 
  2085 
  2086 #ifdef ENABLE_CHECKING
  2087 
  2088 Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
  2089 
  2090 Lisp_Object
  2091 dump_fontset (Lisp_Object fontset)
  2092 {
  2093   Lisp_Object vec = make_nil_vector (3);
  2094   ASET (vec, 0, FONTSET_ID (fontset));
  2095 
  2096   if (BASE_FONTSET_P (fontset))
  2097     {
  2098       ASET (vec, 1, FONTSET_NAME (fontset));
  2099     }
  2100   else
  2101     {
  2102       Lisp_Object frame;
  2103 
  2104       frame = FONTSET_FRAME (fontset);
  2105       if (FRAMEP (frame))
  2106         {
  2107           struct frame *f = XFRAME (frame);
  2108 
  2109           if (FRAME_LIVE_P (f))
  2110             ASET (vec, 1,
  2111                   Fcons (FONTSET_NAME (FONTSET_BASE (fontset)),
  2112                          f->name));
  2113           else
  2114             ASET (vec, 1,
  2115                   Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
  2116         }
  2117       if (!NILP (FONTSET_DEFAULT (fontset)))
  2118         ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
  2119     }
  2120   return vec;
  2121 }
  2122 
  2123 DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
  2124        doc: /* Return a brief summary of all fontsets for debug use.  */)
  2125   (void)
  2126 {
  2127   Lisp_Object val;
  2128   int i;
  2129 
  2130   for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
  2131     if (! NILP (AREF (Vfontset_table, i)))
  2132       val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
  2133   return (Fnreverse (val));
  2134 }
  2135 #endif  /* ENABLE_CHECKING */
  2136 
  2137 void
  2138 syms_of_fontset (void)
  2139 {
  2140   DEFSYM (Qfontset, "fontset");
  2141   Fput (Qfontset, Qchar_table_extra_slots, make_fixnum (8));
  2142   DEFSYM (Qfontset_info, "fontset-info");
  2143   Fput (Qfontset_info, Qchar_table_extra_slots, make_fixnum (1));
  2144 
  2145   DEFSYM (Qappend, "append");
  2146   DEFSYM (Qlatin, "latin");
  2147 
  2148   Vcached_fontset_data = Qnil;
  2149   staticpro (&Vcached_fontset_data);
  2150 
  2151   Vfontset_table = make_nil_vector (32);
  2152   staticpro (&Vfontset_table);
  2153 
  2154   Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
  2155   staticpro (&Vdefault_fontset);
  2156   set_fontset_id (Vdefault_fontset, make_fixnum (0));
  2157   set_fontset_name
  2158     (Vdefault_fontset,
  2159      build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
  2160   ASET (Vfontset_table, 0, Vdefault_fontset);
  2161   next_fontset_id = 1;
  2162   PDUMPER_REMEMBER_SCALAR (next_fontset_id);
  2163 
  2164   auto_fontset_alist = Qnil;
  2165   staticpro (&auto_fontset_alist);
  2166 
  2167   DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist,
  2168                doc: /*
  2169 Alist of charsets vs the charsets to determine the preferred font encoding.
  2170 Each element looks like (CHARSET . ENCODING-CHARSET),
  2171 where ENCODING-CHARSET is a charset registered in the variable
  2172 `font-encoding-alist' as ENCODING.
  2173 
  2174 When a text has a property `charset' and the value is CHARSET, a font
  2175 whose encoding corresponds to ENCODING-CHARSET is preferred.  */);
  2176   Vfont_encoding_charset_alist = Qnil;
  2177 
  2178   DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent,
  2179                doc: /*
  2180 Char table of characters whose ascent values should be ignored.
  2181 If an entry for a character is non-nil, the ascent value of the glyph
  2182 is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
  2183 
  2184 This affects how a composite character which contains
  2185 such a character is displayed on screen.  */);
  2186   Vuse_default_ascent = Qnil;
  2187 
  2188   DEFVAR_BOOL ("use-default-font-for-symbols", use_default_font_for_symbols,
  2189                doc: /*
  2190 If non-nil, use the default face's font for symbols and punctuation.
  2191 
  2192 By default, Emacs will try to use the default face's font for
  2193 displaying symbol and punctuation characters, disregarding the
  2194 fontsets, if the default font can display the character.
  2195 Set this to nil to make Emacs honor the fontsets instead.  */);
  2196   use_default_font_for_symbols = 1;
  2197 
  2198   DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition,
  2199                doc: /*
  2200 Char table of characters which are not composed relatively.
  2201 If an entry for a character is non-nil, a composition sequence
  2202 which contains that character is displayed so that
  2203 the glyph of that character is put without considering
  2204 an ascent and descent value of a previous character.  */);
  2205   Vignore_relative_composition = Qnil;
  2206 
  2207   DEFVAR_LISP ("alternate-fontname-alist", Valternate_fontname_alist,
  2208                doc: /* Alist of fontname vs list of the alternate fontnames.
  2209 When a specified font name is not found, the corresponding
  2210 alternate fontnames (if any) are tried instead.  */);
  2211   Valternate_fontname_alist = Qnil;
  2212 
  2213   DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
  2214                doc: /* Alist of fontset names vs the aliases.  */);
  2215   Vfontset_alias_alist
  2216     = list1 (Fcons (FONTSET_NAME (Vdefault_fontset),
  2217                     build_pure_c_string ("fontset-default")));
  2218 
  2219   DEFVAR_LISP ("vertical-centering-font-regexp",
  2220                Vvertical_centering_font_regexp,
  2221                doc: /* Regexp matching font names that require vertical centering on display.
  2222 When a character is displayed with such fonts, the character is displayed
  2223 at the vertical center of lines.  */);
  2224   Vvertical_centering_font_regexp = Qnil;
  2225 
  2226   DEFVAR_LISP ("otf-script-alist", Votf_script_alist,
  2227                doc: /* Alist of OpenType script tags vs the corresponding script names.  */);
  2228   Votf_script_alist = Qnil;
  2229 
  2230   defsubr (&Squery_fontset);
  2231   defsubr (&Snew_fontset);
  2232   defsubr (&Sset_fontset_font);
  2233   defsubr (&Sfontset_info);
  2234   defsubr (&Sfontset_font);
  2235   defsubr (&Sfontset_list);
  2236 #ifdef ENABLE_CHECKING
  2237   defsubr (&Sfontset_list_all);
  2238 #endif
  2239 }