1: /* Fontset handler.
    2:    Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
    3:      Free Software Foundation, Inc.
    4:    Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
    5:      2005, 2006, 2007
    6:      National Institute of Advanced Industrial Science and Technology (AIST)
    7:      Registration Number H14PRO021
    8: 
    9: This file is part of GNU Emacs.
   10: 
   11: GNU Emacs is free software; you can redistribute it and/or modify
   12: it under the terms of the GNU General Public License as published by
   13: the Free Software Foundation; either version 2, or (at your option)
   14: any later version.
   15: 
   16: GNU Emacs is distributed in the hope that it will be useful,
   17: but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: GNU General Public License for more details.
   20: 
   21: You should have received a copy of the GNU General Public License
   22: along with GNU Emacs; see the file COPYING.  If not, write to
   23: the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   24: Boston, MA 02110-1301, USA.  */
   25: 
   26: /* #define FONTSET_DEBUG */
   27: 
   28: #include <config.h>
   29: 
   30: #ifdef FONTSET_DEBUG
   31: #include <stdio.h>
   32: #endif
   33: 
   34: #include "lisp.h"
   35: #include "buffer.h"
   36: #include "charset.h"
   37: #include "ccl.h"
   38: #include "keyboard.h"
   39: #include "frame.h"
   40: #include "dispextern.h"
   41: #include "fontset.h"
   42: #include "window.h"
   43: #ifdef HAVE_X_WINDOWS
   44: #include "xterm.h"
   45: #endif
   46: #ifdef WINDOWSNT
   47: #include "w32term.h"
   48: #endif
   49: #ifdef MAC_OS
   50: #include "macterm.h"
   51: #endif
   52: 
   53: #ifdef FONTSET_DEBUG
   54: #undef xassert
   55: #define xassert(X)      do {if (!(X)) abort ();} while (0)
   56: #undef INLINE
   57: #define INLINE
   58: #endif
   59: 
   60: 
   61: /* FONTSET
   62: 
   63:    A fontset is a collection of font related information to give
   64:    similar appearance (style, size, etc) of characters.  There are two
   65:    kinds of fontsets; base and realized.  A base fontset is created by
   66:    new-fontset from Emacs Lisp explicitly.  A realized fontset is
   67:    created implicitly when a face is realized for ASCII characters.  A
   68:    face is also realized for multibyte characters based on an ASCII
   69:    face.  All of the multibyte faces based on the same ASCII face
   70:    share the same realized fontset.
   71: 
   72:    A fontset object is implemented by a char-table.
   73: 
   74:    An element of a base fontset is:
   75:         (INDEX . FONTNAME) or
   76:         (INDEX . (FOUNDRY . REGISTRY ))
   77:    FONTNAME is a font name pattern for the corresponding character.
   78:    FOUNDRY and REGISTRY are respectively foundry and registry fields of
   79:    a font name for the corresponding character.  INDEX specifies for
   80:    which character (or generic character) the element is defined.  It
   81:    may be different from an index to access this element.  For
   82:    instance, if a fontset defines some font for all characters of
   83:    charset `japanese-jisx0208', INDEX is the generic character of this
   84:    charset.  REGISTRY is the
   85: 
   86:    An element of a realized fontset is FACE-ID which is a face to use
   87:    for displaying the corresponding character.
   88: 
   89:    All single byte characters (ASCII and 8bit-unibyte) share the same
   90:    element in a fontset.  The element is stored in the first element
   91:    of the fontset.
   92: 
   93:    To access or set each element, use macros FONTSET_REF and
   94:    FONTSET_SET respectively for efficiency.
   95: 
   96:    A fontset has 3 extra slots.
   97: 
   98:    The 1st slot is an ID number of the fontset.
   99: 
  100:    The 2nd slot is a name of the fontset.  This is nil for a realized
  101:    face.
  102: 
  103:    The 3rd slot is a frame that the fontset belongs to.  This is nil
  104:    for a default face.
  105: 
  106:    A parent of a base fontset is nil.  A parent of a realized fontset
  107:    is a base fontset.
  108: 
  109:    All fontsets are recorded in Vfontset_table.
  110: 
  111: 
  112:    DEFAULT FONTSET
  113: 
  114:    There's a special fontset named `default fontset' which defines a
  115:    default fontname pattern.  When a base fontset doesn't specify a
  116:    font for a specific character, the corresponding value in the
  117:    default fontset is used.  The format is the same as a base fontset.
  118: 
  119:    The parent of a realized fontset created for such a face that has
  120:    no fontset is the default fontset.
  121: 
  122: 
  123:    These structures are hidden from the other codes than this file.
  124:    The other codes handle fontsets only by their ID numbers.  They
  125:    usually use variable name `fontset' for IDs.  But, in this file, we
  126:    always use variable name `id' for IDs, and name `fontset' for the
  127:    actual fontset objects.
  128: 
  129: */
  130: 
  131: /********** VARIABLES and FUNCTION PROTOTYPES **********/
  132: 
  133: extern Lisp_Object Qfont;
  134: Lisp_Object Qfontset;
  135: 
  136: /* Vector containing all fontsets.  */
  137: static Lisp_Object Vfontset_table;
  138: 
  139: /* Next possibly free fontset ID.  Usually this keeps the minimum
  140:    fontset ID not yet used.  */
  141: static int next_fontset_id;
  142: 
  143: /* The default fontset.  This gives default FAMILY and REGISTRY of
  144:    font for each characters.  */
  145: static Lisp_Object Vdefault_fontset;
  146: 
  147: /* Alist of font specifications.  It override the font specification
  148:    in the default fontset.  */
  149: static Lisp_Object Voverriding_fontspec_alist;
  150: 
  151: Lisp_Object Vfont_encoding_alist;
  152: Lisp_Object Vuse_default_ascent;
  153: Lisp_Object Vignore_relative_composition;
  154: Lisp_Object Valternate_fontname_alist;
  155: Lisp_Object Vfontset_alias_alist;
  156: Lisp_Object Vvertical_centering_font_regexp;
  157: 
  158: /* The following six are declarations of callback functions depending
  159:    on window system.  See the comments in src/fontset.h for more
  160:    detail.  */
  161: 
  162: /* Return a pointer to struct font_info of font FONT_IDX of frame F.  */
  163: struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
  164: 
  165: /* Return a list of font names which matches PATTERN.  See the documentation
  166:    of `x-list-fonts' for more details.  */
  167: Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
  168:                                     Lisp_Object pattern,
  169:                                     int size,
  170:                                     int maxnames));
  171: 
  172: /* Load a font named NAME for frame F and return a pointer to the
  173:    information of the loaded font.  If loading is failed, return 0.  */
  174: struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
  175: 
  176: /* Return a pointer to struct font_info of a font named NAME for frame F.  */
  177: struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
  178: 
  179: /* Additional function for setting fontset or changing fontset
  180:    contents of frame F.  */
  181: void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
  182:                                     Lisp_Object oldval));
  183: 
  184: /* To find a CCL program, fs_load_font calls this function.
  185:    The argument is a pointer to the struct font_info.
  186:    This function set the member `encoder' of the structure.  */
  187: void (*find_ccl_program_func) P_ ((struct font_info *));
  188: 
  189: /* Check if any window system is used now.  */
  190: void (*check_window_system_func) P_ ((void));
  191: 
  192: 
  193: /* Prototype declarations for static functions.  */
  194: static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
  195: static Lisp_Object lookup_overriding_fontspec P_ ((Lisp_Object, int));
  196: static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
  197: static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
  198: static int fontset_id_valid_p P_ ((int));
  199: static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
  200: static Lisp_Object font_family_registry P_ ((Lisp_Object, int));
  201: static Lisp_Object regularize_fontname P_ ((Lisp_Object));
  202: 
  203: ^L
  204: /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
  205: 
  206: /* Return the fontset with ID.  No check of ID's validness.  */
  207: #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
  208: 
  209: /* Macros to access special values of FONTSET.  */
  210: #define FONTSET_ID(fontset)             XCHAR_TABLE (fontset)->extras[0]
  211: #define FONTSET_NAME(fontset)           XCHAR_TABLE (fontset)->extras[1]
  212: #define FONTSET_FRAME(fontset)          XCHAR_TABLE (fontset)->extras[2]
  213: #define FONTSET_ASCII(fontset)          XCHAR_TABLE (fontset)->contents[0]
  214: #define FONTSET_BASE(fontset)           XCHAR_TABLE (fontset)->parent
  215: 
  216: #define BASE_FONTSET_P(fontset)         NILP (FONTSET_BASE(fontset))
  217: 
  218: 
  219: /* Return the element of FONTSET (char-table) at index C (character).  */
  220: 
  221: #define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
  222: 
  223: static Lisp_Object
  224: fontset_ref (fontset, c)
  225:      Lisp_Object fontset;
  226:      int c;
  227: {
  228:   int charset, c1, c2;
  229:   Lisp_Object elt, defalt;
  230: 
  231:   if (SINGLE_BYTE_CHAR_P (c))
  232:     return FONTSET_ASCII (fontset);
  233: 
  234:   SPLIT_CHAR (c, charset, c1, c2);
  235:   elt = XCHAR_TABLE (fontset)->contents[charset + 128];
  236:   if (!SUB_CHAR_TABLE_P (elt))
  237:     return elt;
  238:   defalt = XCHAR_TABLE (elt)->defalt;
  239:   if (c1 < 32
  240:       || (elt = XCHAR_TABLE (elt)->contents[c1],
  241:           NILP (elt)))
  242:     return defalt;
  243:   if (!SUB_CHAR_TABLE_P (elt))
  244:     return elt;
  245:   defalt = XCHAR_TABLE (elt)->defalt;
  246:   if (c2 < 32
  247:       || (elt = XCHAR_TABLE (elt)->contents[c2],
  248:           NILP (elt)))
  249:     return defalt;
  250:   return elt;
  251: }
  252: 
  253: 
  254: static Lisp_Object
  255: lookup_overriding_fontspec (frame, c)
  256:      Lisp_Object frame;
  257:      int c;
  258: {
  259:   Lisp_Object tail;
  260: 
  261:   for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail))
  262:     {
  263:       Lisp_Object val, target, elt;
  264: 
  265:       val = XCAR (tail);
  266:       target = XCAR (val);
  267:       val = XCDR (val);
  268:       /* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME).  */
  269:       if (NILP (Fmemq (frame, XCAR (val)))
  270:           && (CHAR_TABLE_P (target)
  271:               ? ! NILP (CHAR_TABLE_REF (target, c))
  272:               : XINT (target) == CHAR_CHARSET (c)))
  273:         {
  274:           val = XCDR (val);
  275:           elt = XCDR (val);
  276:           if (NILP (Fmemq (frame, XCAR (val))))
  277:             {
  278:               if (! face_font_available_p (XFRAME (frame), XCDR (elt)))
  279:                 {
  280:                   val = XCDR (XCAR (tail));
  281:                   XSETCAR (val, Fcons (frame, XCAR (val)));
  282:                   continue;
  283:                 }
  284:               XSETCAR (val, Fcons (frame, XCAR (val)));
  285:             }
  286:           if (NILP (XCAR (elt)))
  287:             XSETCAR (elt, make_number (c));
  288:           return elt;
  289:         }
  290:     }
  291:   return Qnil;
  292: }
  293: 
  294: #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
  295: 
  296: static Lisp_Object
  297: fontset_ref_via_base (fontset, c)
  298:      Lisp_Object fontset;
  299:      int *c;
  300: {
  301:   int charset, c1, c2;
  302:   Lisp_Object elt;
  303: 
  304:   if (SINGLE_BYTE_CHAR_P (*c))
  305:     return FONTSET_ASCII (fontset);
  306: 
  307:   elt = Qnil;
  308:   if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset))
  309:     elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
  310:   if (NILP (elt))
  311:     elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c);
  312:   if (NILP (elt))
  313:     elt = FONTSET_REF (Vdefault_fontset, *c);
  314:   if (NILP (elt))
  315:     return Qnil;
  316: 
  317:   *c = XINT (XCAR (elt));
  318:   SPLIT_CHAR (*c, charset, c1, c2);
  319:   elt = XCHAR_TABLE (fontset)->contents[charset + 128];
  320:   if (c1 < 32)
  321:     return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
  322:   if (!SUB_CHAR_TABLE_P (elt))
  323:     return Qnil;
  324:   elt = XCHAR_TABLE (elt)->contents[c1];
  325:   if (c2 < 32)
  326:     return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
  327:   if (!SUB_CHAR_TABLE_P (elt))
  328:     return Qnil;
  329:   elt = XCHAR_TABLE (elt)->contents[c2];
  330:   return elt;
  331: }
  332: 
  333: 
  334: /* Store into the element of FONTSET at index C the value NEWELT.  */
  335: #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
  336: 
  337: static void
  338: fontset_set (fontset, c, newelt)
  339:      Lisp_Object fontset;
  340:      int c;
  341:      Lisp_Object newelt;
  342: {
  343:   int charset, code[3];
  344:   Lisp_Object *elt;
  345:   int i;
  346: 
  347:   if (SINGLE_BYTE_CHAR_P (c))
  348:     {
  349:       FONTSET_ASCII (fontset) = newelt;
  350:       return;
  351:     }
  352: 
  353:   SPLIT_CHAR (c, charset, code[0], code[1]);
  354:   code[2] = 0;                  /* anchor */
  355:   elt = &XCHAR_TABLE (fontset)->contents[charset + 128];
  356:   for (i = 0; code[i] > 0; i++)
  357:     {
  358:       if (!SUB_CHAR_TABLE_P (*elt))
  359:         {
  360:           Lisp_Object val = *elt;
  361:           *elt = make_sub_char_table (Qnil);
  362:           XCHAR_TABLE (*elt)->defalt = val;
  363:         }
  364:       elt = &XCHAR_TABLE (*elt)->contents[code[i]];
  365:     }
  366:   if (SUB_CHAR_TABLE_P (*elt))
  367:     XCHAR_TABLE (*elt)->defalt = newelt;
  368:   else
  369:     *elt = newelt;
  370: }
  371: 
  372: 
  373: /* Return a newly created fontset with NAME.  If BASE is nil, make a
  374:    base fontset.  Otherwise make a realized fontset whose parent is
  375:    BASE.  */
  376: 
  377: static Lisp_Object
  378: make_fontset (frame, name, base)
  379:      Lisp_Object frame, name, base;
  380: {
  381:   Lisp_Object fontset;
  382:   int size = ASIZE (Vfontset_table);
  383:   int id = next_fontset_id;
  384: 
  385:   /* Find a free slot in Vfontset_table.  Usually, next_fontset_id is
  386:      the next available fontset ID.  So it is expected that this loop
  387:      terminates quickly.  In addition, as the last element of
  388:      Vfontset_table is always nil, we don't have to check the range of
  389:      id.  */
  390:   while (!NILP (AREF (Vfontset_table, id))) id++;
  391: 
  392:   if (id + 1 == size)
  393:     {
  394:       Lisp_Object tem;
  395:       int i;
  396: 
  397:       tem = Fmake_vector (make_number (size + 8), Qnil);
  398:       for (i = 0; i < size; i++)
  399:         AREF (tem, i) = AREF (Vfontset_table, i);
  400:       Vfontset_table = tem;
  401:     }
  402: 
  403:   fontset = Fmake_char_table (Qfontset, Qnil);
  404: 
  405:   FONTSET_ID (fontset) = make_number (id);
  406:   FONTSET_NAME (fontset) = name;
  407:   FONTSET_FRAME (fontset) = frame;
  408:   FONTSET_BASE (fontset) = base;
  409: 
  410:   AREF (Vfontset_table, id) = fontset;
  411:   next_fontset_id = id + 1;
  412:   return fontset;
  413: }
  414: 
  415: 
  416: /* Return 1 if ID is a valid fontset id, else return 0.  */
  417: 
  418: static INLINE int
  419: fontset_id_valid_p (id)
  420:      int id;
  421: {
  422:   return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
  423: }
  424: 
  425: 
  426: /* Extract `family' and `registry' string from FONTNAME and a cons of
  427:    them.  Actually, `family' may also contain `foundry', `registry'
  428:    may also contain `encoding' of FONTNAME.  But, if FONTNAME doesn't
  429:    conform to XLFD nor explicitely specifies the other fields
  430:    (i.e. not using wildcard `*'), return FONTNAME.  If FORCE is
  431:    nonzero, specifications of the other fields are ignored, and return
  432:    a cons as far as FONTNAME conform to XLFD.  */
  433: 
  434: static Lisp_Object
  435: font_family_registry (fontname, force)
  436:      Lisp_Object fontname;
  437:      int force;
  438: {
  439:   Lisp_Object family, registry;
  440:   const char *p = SDATA (fontname);
  441:   const char *sep[15];
  442:   int i = 0;
  443: 
  444:   while (*p && i < 15)
  445:     if (*p++ == '-')
  446:       {
  447:         if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-')
  448:           return fontname;
  449:         sep[i++] = p;
  450:       }
  451:   if (i != 14)
  452:     return fontname;
  453: 
  454:   family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
  455:   registry = make_unibyte_string (sep[12], p - sep[12]);
  456:   return Fcons (family, registry);
  457: }
  458: 
  459: ^L
  460: /********** INTERFACES TO xfaces.c and dispextern.h **********/
  461: 
  462: /* Return name of the fontset with ID.  */
  463: 
  464: Lisp_Object
  465: fontset_name (id)
  466:      int id;
  467: {
  468:   Lisp_Object fontset;
  469:   fontset = FONTSET_FROM_ID (id);
  470:   return FONTSET_NAME (fontset);
  471: }
  472: 
  473: 
  474: /* Return ASCII font name of the fontset with ID.  */
  475: 
  476: Lisp_Object
  477: fontset_ascii (id)
  478:      int id;
  479: {
  480:   Lisp_Object fontset, elt;
  481:   fontset= FONTSET_FROM_ID (id);
  482:   elt = FONTSET_ASCII (fontset);
  483:   return XCDR (elt);
  484: }
  485: 
  486: 
  487: /* Free fontset of FACE.  Called from free_realized_face.  */
  488: 
  489: void
  490: free_face_fontset (f, face)
  491:      FRAME_PTR f;
  492:      struct face *face;
  493: {
  494:   if (fontset_id_valid_p (face->fontset))
  495:     {
  496:       AREF (Vfontset_table, face->fontset) = Qnil;
  497:       if (face->fontset < next_fontset_id)
  498:         next_fontset_id = face->fontset;
  499:     }
  500: }
  501: 
  502: 
  503: /* Return 1 iff FACE is suitable for displaying character C.
  504:    Otherwise return 0.  Called from the macro FACE_SUITABLE_FOR_CHAR_P
  505:    when C is not a single byte character..  */
  506: 
  507: int
  508: face_suitable_for_char_p (face, c)
  509:      struct face *face;
  510:      int c;
  511: {
  512:   Lisp_Object fontset, elt;
  513: 
  514:   if (SINGLE_BYTE_CHAR_P (c))
  515:     return (face == face->ascii_face);
  516: 
  517:   xassert (fontset_id_valid_p (face->fontset));
  518:   fontset = FONTSET_FROM_ID (face->fontset);
  519:   xassert (!BASE_FONTSET_P (fontset));
  520: 
  521:   elt = FONTSET_REF_VIA_BASE (fontset, c);
  522:   return (!NILP (elt) && face->id == XFASTINT (elt));
  523: }
  524: 
  525: 
  526: /* Return ID of face suitable for displaying character C on frame F.
  527:    The selection of face is done based on the fontset of FACE.  FACE
  528:    should already have been realized for ASCII characters.  Called
  529:    from the macro FACE_FOR_CHAR when C is not a single byte character.  */
  530: 
  531: int
  532: face_for_char (f, face, c)
  533:      FRAME_PTR f;
  534:      struct face *face;
  535:      int c;
  536: {
  537:   Lisp_Object fontset, elt;
  538:   int face_id;
  539: 
  540:   xassert (fontset_id_valid_p (face->fontset));
  541:   fontset = FONTSET_FROM_ID (face->fontset);
  542:   xassert (!BASE_FONTSET_P (fontset));
  543: 
  544:   elt = FONTSET_REF_VIA_BASE (fontset, c);
  545:   if (!NILP (elt))
  546:     return XINT (elt);
  547: 
  548:   /* No face is recorded for C in the fontset of FACE.  Make a new
  549:      realized face for C that has the same fontset.  */
  550:   face_id = lookup_face (f, face->lface, c, face);
  551: 
  552:   /* Record the face ID in FONTSET at the same index as the
  553:      information in the base fontset.  */
  554:   FONTSET_SET (fontset, c, make_number (face_id));
  555:   return face_id;
  556: }
  557: 
  558: 
  559: /* Make a realized fontset for ASCII face FACE on frame F from the
  560:    base fontset BASE_FONTSET_ID.  If BASE_FONTSET_ID is -1, use the
  561:    default fontset as the base.  Value is the id of the new fontset.
  562:    Called from realize_x_face.  */
  563: 
  564: int
  565: make_fontset_for_ascii_face (f, base_fontset_id)
  566:      FRAME_PTR f;
  567:      int base_fontset_id;
  568: {
  569:   Lisp_Object base_fontset, fontset, frame;
  570: 
  571:   XSETFRAME (frame, f);
  572:   if (base_fontset_id >= 0)
  573:     {
  574:       base_fontset = FONTSET_FROM_ID (base_fontset_id);
  575:       if (!BASE_FONTSET_P (base_fontset))
  576:         base_fontset = FONTSET_BASE (base_fontset);
  577:       xassert (BASE_FONTSET_P (base_fontset));
  578:     }
  579:   else
  580:     base_fontset = Vdefault_fontset;
  581: 
  582:   fontset = make_fontset (frame, Qnil, base_fontset);
  583:   return XINT (FONTSET_ID (fontset));
  584: }
  585: 
  586: 
  587: /* Return the font name pattern for C that is recorded in the fontset
  588:    with ID.  If a font name pattern is specified (instead of a cons of
  589:    family and registry), check if a font can be opened by that pattern
  590:    to get the fullname.  If a font is opened, return that name.
  591:    Otherwise, return nil.  If ID is -1, or the fontset doesn't contain
  592:    information about C, get the registry and encoding of C from the
  593:    default fontset.  Called from choose_face_font.  */
  594: 
  595: Lisp_Object