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