src/fontset.c

   1 /* Fontset handler.
   2    Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
   3    Licensed to the Free Software Foundation.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 #include <config.h>
  23 #if HAVE_ALLOCA_H
  24 #include <alloca.h>
  25 #endif /* HAVE_ALLOCA_H */
  26 #include "lisp.h"
  27 #include "charset.h"
  28 #include "ccl.h"
  29 #include "fontset.h"
  30 #include "frame.h"
  31
  32 Lisp_Object Vglobal_fontset_alist;
  33 Lisp_Object Vfont_encoding_alist;
  34 Lisp_Object Vuse_default_ascent;
  35 Lisp_Object Valternative_fontname_alist;
  36 Lisp_Object Vfontset_alias_alist;
  37 Lisp_Object Vhighlight_wrong_size_font;
  38 Lisp_Object Vclip_large_size_font;
  39
  40 /* Used as a temporary in macro FS_LOAD_FONT.  */
  41 int font_idx_temp;
  42
  43 /* We had better have our own strcasecmp function because some system
  44    doesn't have it.  */
  45 static char my_strcasetbl[256];
  46
  47 /* Compare two strings S0 and S1 while ignoring differences in case.
  48    Return 1 if they differ, else return 0.  */
  49 static int
  50 my_strcasecmp (s0, s1)
  51      unsigned char *s0, *s1;
  52 {
  53   while (*s0)
  54     if (my_strcasetbl[*s0++] != my_strcasetbl[*s1++]) return 1;
  55   return (int) *s1;
  56 }
  57
  58 /* The following six are window system dependent functions.  See
  59    the comments in src/fontset.h for more detail.  */
  60
  61 /* Return a pointer to struct font_info of font FONT_IDX of frame F.  */
  62 struct font_info *(*get_font_info_func) (/* FRAME_PTR f; int font_idx */);
  63
  64 /* Return a list of font names which matches PATTERN.  See the document of
  65    `x-list-fonts' for more detail.  */
  66 Lisp_Object (*list_fonts_func) (/* Lisp_Object pattern, face, frame, width */);
  67
  68 /* Load a font named NAME for frame F and return a pointer to the
  69    information of the loaded font.  If loading is failed, return 0.  */
  70 struct font_info *(*load_font_func) (/* FRAME_PTR f; char *name */);
  71
  72 /* Return a pointer to struct font_info of a font named NAME for frame F.  */
  73 struct font_info *(*query_font_func) (/* FRAME_PTR f; char *name */);
  74
  75 /* Additional function for setting fontset or changing fontset
  76    contents of frame F.  */
  77 void (*set_frame_fontset_func) (/* FRAME_PTR f; Lisp_Object arg, oldval */);
  78
  79 /* Check if any window system is used now.  */
  80 void (*check_window_system_func) ();
  81
  82 struct fontset_data *
  83 alloc_fontset_data ()
  84 {
  85   struct fontset_data *fontset_data
  86     = (struct fontset_data *) xmalloc (sizeof (struct fontset_data));
  87
  88   bzero (fontset_data, sizeof (struct fontset_data));
  89
  90   return fontset_data;
  91 }
  92
  93 void
  94 free_fontset_data (fontset_data)
  95      struct fontset_data *fontset_data;
  96 {
  97   int i;
  98
  99   for (i = 0; i < fontset_data->n_fontsets; i++)
 100     {
 101       int j;
 102
 103       xfree (fontset_data->fontset_table[i]->name);
 104       for (j = 0; j <= MAX_CHARSET; j++)
 105         if (fontset_data->fontset_table[i]->fontname[j])
 106           xfree (fontset_data->fontset_table[i]->fontname[j]);
 107       xfree (fontset_data->fontset_table[i]);
 108     }
 109   xfree (fontset_data->fontset_table);
 110
 111   xfree (fontset_data);
 112 }
 113
 114 /* Load a font named FONTNAME for displaying CHARSET on frame F.
 115    All fonts for frame F is stored in a table pointed by FONT_TABLE.
 116    Return a pointer to the struct font_info of the loaded font.
 117    If loading fails, return 0;
 118    If FONTNAME is NULL, the name is taken from the information of FONTSET.
 119    If FONTSET is given, try to load a font whose size matches that of
 120    FONTSET, and, the font index is stored in the table for FONTSET.
 121
 122    If you give FONTSET argument, don't call this function directry,
 123    instead call macro FS_LOAD_FONT with the same argument.  */
 124
 125 struct font_info *
 126 fs_load_font (f, font_table, charset, fontname, fontset)
 127      FRAME_PTR f;
 128      struct font_info *font_table;
 129      int charset, fontset;
 130      char *fontname;
 131 {
 132   Lisp_Object font_list;
 133   Lisp_Object list, elt;
 134   int font_idx;
 135   int size = 0;
 136   struct fontset_info *fontsetp = 0;
 137   struct font_info *fontp;
 138
 139   if (fontset >= 0 && fontset < FRAME_FONTSET_DATA (f)->n_fontsets)
 140     {
 141       fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
 142       font_idx = fontsetp->font_indexes[charset];
 143       if (font_idx >= 0)
 144         /* We have already loaded a font.  */
 145         return font_table + font_idx;
 146       else if (font_idx == FONT_NOT_FOUND)
 147         /* We have already tried loading a font and failed.  */
 148         return 0;
 149       if (!fontname)
 150         fontname = fontsetp->fontname[charset];
 151     }
 152
 153   if (!fontname)
 154     /* No way to get fontname.  */
 155     return 0;
 156
 157   /* If CHARSET is not ASCII and FONTSET is specified, we must load a
 158      font of appropriate size to be used with other fonts in this
 159      fontset.  */
 160   if (charset != CHARSET_ASCII && fontsetp)
 161     {
 162       /* If we have not yet loaded ASCII font of FONTSET, we must load
 163          it now to decided the size and height of this fontset.  */
 164       if (fontsetp->size == 0)
 165         {
 166           fontp = fs_load_font (f, font_table, CHARSET_ASCII, 0, fontset);
 167           if (!fontp)
 168             /* Any fontset should contain avairable ASCII.  */
 169             return 0;
 170         }
 171       /* Now we have surely decided the size of this fontset.  */
 172       size = fontsetp->size * CHARSET_WIDTH (charset);
 173     }
 174
 175   fontp = (*load_font_func) (f, fontname, size);
 176
 177   if (!fontp)
 178     {
 179       if (fontsetp)
 180         fontsetp->font_indexes[charset] = FONT_NOT_FOUND;
 181       return 0;
 182     }
 183
 184   /* Fill in fields (CHARSET, ENCODING, and FONT_ENCODER) which are
 185      not set by (*load_font_func).  */
 186   fontp->charset = charset;
 187
 188   if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
 189     {
 190       /* The font itself tells which code points to be used.  Use this
 191          encoding for all other charsets.  */
 192       int i;
 193
 194       fontp->encoding[0] = fontp->encoding[1];
 195       for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
 196         fontp->encoding[i] = fontp->encoding[1];
 197     }
 198   else
 199     {
 200       /* The font itself doesn't tell which code points to be used.  */
 201       int i;
 202
 203       /* At first, set 1 (means 0xA0..0xFF) as the default.  */
 204       fontp->encoding[0] = 1;
 205       for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
 206         fontp->encoding[i] = 1;
 207       /* Then override them by a specification in Vfont_encoding_alist.  */
 208       for (list = Vfont_encoding_alist; CONSP (list); list = XCONS (list)->cdr)
 209         {
 210           elt = XCONS (list)->car;
 211           if (CONSP (elt)
 212               && STRINGP (XCONS (elt)->car) && CONSP (XCONS (elt)->cdr)
 213               && (fast_c_string_match_ignore_case (XCONS (elt)->car, fontname)
 214                   >= 0))
 215             {
 216               Lisp_Object tmp;
 217
 218               for (tmp = XCONS (elt)->cdr; CONSP (tmp); tmp = XCONS (tmp)->cdr)
 219                 if (CONSP (XCONS (tmp)->car)
 220                     && ((i = get_charset_id (XCONS (XCONS (tmp)->car)->car))
 221                         >= 0)
 222                     && INTEGERP (XCONS (XCONS (tmp)->car)->cdr)
 223                     && XFASTINT (XCONS (XCONS (tmp)->car)->cdr) < 4)
 224                   fontp->encoding[i]
 225                     = XFASTINT (XCONS (XCONS (tmp)->car)->cdr);
 226             }
 227         }
 228     }
 229
 230   fontp->font_encoder = (struct ccl_program *) 0;
 231   for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
 232     {
 233       elt = XCONS (list)->car;
 234       if (CONSP (elt)
 235           && STRINGP (XCONS (elt)->car) && VECTORP (XCONS (elt)->cdr)
 236           && fast_c_string_match_ignore_case (XCONS (elt)->car, fontname) >= 0)
 237         {
 238           fontp->font_encoder
 239             = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
 240           setup_ccl_program (fontp->font_encoder, XCONS (elt)->cdr);
 241           break;
 242         }
 243     }
 244
 245   /* If FONTSET is specified, setup various fields of it.  */
 246   if (fontsetp)
 247     {
 248       fontsetp->font_indexes[charset] = fontp->font_idx;
 249       if (charset == CHARSET_ASCII)
 250         {
 251           /* Decide or change the size and height of this fontset.  */
 252           if (fontsetp->size == 0)
 253             {
 254               fontsetp->size = fontp->size;
 255               fontsetp->height = fontp->height;
 256             }
 257           else if (fontsetp->size != fontp->size
 258                    || fontsetp->height != fontp->height)
 259             {
 260               /* When loading ASCII font of the different size from
 261                  the size of FONTSET, we have to update the size of
 262                  FONTSET.  Since changing the size of FONTSET may make
 263                  some fonts already loaded inappropriate to be used in
 264                  FONTSET, we must delete the record of such fonts.  In
 265                  that case, we also have to calculate the height of
 266                  FONTSET from the remaining fonts.  */
 267               int i;
 268
 269               fontsetp->size = fontp->size;
 270               fontsetp->height = fontp->height;
 271               for (i = CHARSET_ASCII + 1; i <= MAX_CHARSET; i++)
 272                 {
 273                   font_idx = fontsetp->font_indexes[i];
 274                   if (font_idx >= 0)
 275                     {
 276                       struct font_info *fontp2 = font_table + font_idx;
 277
 278                       if (fontp2->size != fontp->size * CHARSET_WIDTH (i))
 279                         fontsetp->font_indexes[i] = FONT_NOT_OPENED;
 280                       /* The following code should be disabled until
 281                          Emacs supports variable height lines.  */
 282 #if 0
 283                       else if (fontsetp->height < fontp->height)
 284                         fontsetp->height = fontp->height;
 285 #endif
 286                     }
 287                 }
 288             }
 289         }
 290     }
 291
 292   return fontp;
 293 }
 294
 295 /* Return ID of the fontset named NAME on frame F.  */
 296
 297 int
 298 fs_query_fontset (f, name)
 299      FRAME_PTR f;
 300      char *name;
 301 {
 302   struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
 303   int i;
 304
 305   for (i = 0; i < fontset_data->n_fontsets; i++)
 306     if (!my_strcasecmp(name, fontset_data->fontset_table[i]->name))
 307       return i;
 308   return -1;
 309 }
 310
 311 /* Register a fontset specified by FONTSET_INFO for frame FRAME.
 312    Return the fontset ID if successfully registered, else return -1.
 313    FONTSET_INFO is a cons of name of the fontset and FONTLIST, where
 314    FONTLIST is an alist of charsets vs fontnames.  */
 315
 316 int
 317 fs_register_fontset (f, fontset_info)
 318      FRAME_PTR f;
 319      Lisp_Object fontset_info;
 320 {
 321   struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
 322   Lisp_Object name, fontlist;
 323   int fontset;
 324   struct fontset_info *fontsetp;
 325   int i;
 326
 327   if (!CONSP (fontset_info)
 328       || !STRINGP (XCONS (fontset_info)->car)
 329       || !CONSP (XCONS (fontset_info)->cdr))
 330     /* Invalid data in FONTSET_INFO.  */
 331     return -1;
 332
 333   name = XCONS (fontset_info)->car;
 334   if ((fontset = fs_query_fontset (f, XSTRING (name)->data)) >= 0)
 335     /* This fontset already exists on frame F.  */
 336     return fontset;
 337
 338   fontsetp = (struct fontset_info *) xmalloc (sizeof (struct fontset_info));
 339
 340   fontsetp->name = (char *) xmalloc (XSTRING (name)->size + 1);
 341   bcopy(XSTRING (name)->data, fontsetp->name, XSTRING (name)->size + 1);
 342
 343   fontsetp->size = fontsetp->height = 0;
 344
 345   for (i = 0; i <= MAX_CHARSET; i++)
 346     {
 347       fontsetp->fontname[i] = (char *) 0;
 348       fontsetp->font_indexes[i] = FONT_NOT_OPENED;
 349     }
 350
 351   for (fontlist = XCONS (fontset_info)->cdr; CONSP (fontlist);
 352        fontlist = XCONS (fontlist)->cdr)
 353     {
 354       Lisp_Object tem = Fcar (fontlist);
 355       int charset;
 356
 357       if (CONSP (tem)
 358           && (charset = get_charset_id (XCONS (tem)->car)) >= 0
 359           && STRINGP (XCONS (tem)->cdr))
 360         {
 361           fontsetp->fontname[charset]
 362              = (char *) xmalloc (XSTRING (XCONS (tem)->cdr)->size + 1);
 363           bcopy (XSTRING (XCONS (tem)->cdr)->data,
 364                  fontsetp->fontname[charset],
 365                  XSTRING (XCONS (tem)->cdr)->size + 1);
 366         }
 367       else
 368         /* Broken or invalid data structure.  */
 369         return -1;
 370     }
 371
 372   /* Do we need to create the table?  */
 373   if (fontset_data->fontset_table_size == 0)
 374     {
 375       fontset_data->fontset_table_size = 8;
 376       fontset_data->fontset_table
 377         = (struct fontset_info **) xmalloc (fontset_data->fontset_table_size
 378                                             * sizeof (struct fontset_info *));
 379     }
 380   /* Do we need to grow the table?  */
 381   else if (fontset_data->n_fontsets >= fontset_data->fontset_table_size)
 382     {
 383       fontset_data->fontset_table_size += 8;
 384       fontset_data->fontset_table
 385         = (struct fontset_info **) xrealloc (fontset_data->fontset_table,
 386                                              fontset_data->fontset_table_size
 387                                              * sizeof (struct fontset_info *));
 388     }
 389   fontset = fontset_data->n_fontsets++;
 390   fontset_data->fontset_table[fontset] = fontsetp;
 391
 392   return fontset;
 393 }
 394
 395 /* Cache data used by fontset_pattern_regexp.  The car part is a
 396    pattern string containing at least one wild card, the cdr part is
 397    the corresponding regular expression.  */
 398 static Lisp_Object Vcached_fontset_data;
 399
 400 #define CACHED_FONTSET_NAME (XSTRING (XCONS (Vcached_fontset_data)->car)->data)
 401 #define CACHED_FONTSET_REGEX (XCONS (Vcached_fontset_data)->cdr)
 402
 403 /* If fontset name PATTERN contains any wild card, return regular
 404    expression corresponding to PATTERN.  */
 405
 406 Lisp_Object
 407 fontset_pattern_regexp (pattern)
 408      Lisp_Object pattern;
 409 {
 410   if (!index (XSTRING (pattern)->data, '*')
 411       && !index (XSTRING (pattern)->data, '?'))
 412     /* PATTERN does not contain any wild cards.  */
 413     return Qnil;
 414
 415   if (!CONSP (Vcached_fontset_data)
 416       || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
 417     {
 418       /* We must at first update the cached data.  */
 419       char *regex = (char *) alloca (XSTRING (pattern)->size * 2);
 420       char *p0, *p1 = regex;
 421
 422       /* Convert "*" to ".*", "?" to ".".  */
 423       *p1++ = '^';
 424       for (p0 = (char *) XSTRING (pattern)->data; *p0; p0++)
 425         {
 426           if (*p0 == '*')
 427             {
 428               *p1++ = '.';
 429               *p1++ = '*';
 430             }
 431           else if (*p0 == '?')
 432             *p1++ == '.';
 433           else
 434             *p1++ = *p0;
 435         }
 436       *p1++ = '$';
 437       *p1++ = 0;
 438
 439       Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data),
 440                                     build_string (regex));
 441     }
 442
 443   return CACHED_FONTSET_REGEX;
 444 }
 445
 446 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 1, 0,
 447   "Return a fontset name which matches PATTERN, nil if no matching fontset.\n\
 448 PATTERN can contain `*' or `?' as a wild card\n\
 449 just like X's font name matching algorithm allows.")
 450   (pattern)
 451      Lisp_Object pattern;
 452 {
 453   Lisp_Object regexp, tem;
 454
 455   (*check_window_system_func) ();
 456
 457   CHECK_STRING (pattern, 0);
 458
 459   if (XSTRING (pattern)->size == 0)
 460     return Qnil;
 461
 462   tem = Frassoc (pattern, Vfontset_alias_alist);
 463   if (!NILP (tem))
 464     return Fcar (tem);
 465
 466   regexp = fontset_pattern_regexp (pattern);
 467
 468   for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
 469     {
 470       Lisp_Object fontset_name = XCONS (XCONS (tem)->car)->car;
 471       if (!NILP (regexp))
 472         {
 473           if (fast_c_string_match_ignore_case (regexp,
 474                                                XSTRING (fontset_name)->data)
 475               >= 0)
 476             return fontset_name;
 477         }
 478       else
 479         {
 480           if (!my_strcasecmp (XSTRING (pattern)->data,
 481                               XSTRING (fontset_name)->data))
 482             return fontset_name;
 483         }
 484     }
 485
 486   return Qnil;
 487 }
 488
 489 Lisp_Object Fframe_char_width ();
 490
 491 /* Return a list of names of available fontsets matching PATTERN on
 492    frame F.  If SIZE is not 0, it is the size (maximum bound width) of
 493    fontsets to be listed. */
 494
 495 Lisp_Object
 496 list_fontsets (f, pattern, size)
 497      FRAME_PTR f;
 498      Lisp_Object pattern;
 499      int size;
 500 {
 501   int i;
 502   Lisp_Object regexp, val;
 503
 504   regexp = fontset_pattern_regexp (pattern);
 505
 506   val = Qnil;
 507   for (i = 0; i < FRAME_FONTSET_DATA (f)->n_fontsets; i++)
 508     {
 509       struct fontset_info *fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[i];
 510       int name_matched = 0;
 511       int size_matched = 0;
 512
 513       if (!NILP (regexp))
 514         {
 515           if (fast_c_string_match_ignore_case (regexp, fontsetp->name) >= 0)
 516             name_matched = 1;
 517         }
 518       else
 519         {
 520           if (!my_strcasecmp (XSTRING (pattern)->data, fontsetp->name))
 521             name_matched = 1;
 522         }
 523
 524       if (name_matched)
 525         {
 526           if (!size || fontsetp->size == size)
 527             size_matched = 1;
 528           else if (fontsetp->size == 0)
 529             {
 530               /* No font of this fontset has loaded yet.  Try loading
 531                  one with SIZE.  */
 532               int j;
 533
 534               for (j = 0; j <= MAX_CHARSET; j++)
 535                 if (fontsetp->fontname[j])
 536                   {
 537                     if ((*load_font_func) (f, fontsetp->fontname[j], size))
 538                       size_matched = 1;
 539                     break;
 540                   }
 541             }
 542
 543           if (size_matched)
 544             val = Fcons (build_string (fontsetp->name), val);
 545         }
 546     }
 547
 548   return val;
 549 }
 550
 551 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
 552   "Create a new fontset NAME which contains fonts in FONTLIST.\n\
 553 FONTLIST is an alist of charsets vs corresponding font names.")
 554   (name, fontlist)
 555      Lisp_Object name, fontlist;
 556 {
 557   Lisp_Object fullname, fontset_info;
 558   Lisp_Object tail;
 559
 560   (*check_window_system_func) ();
 561
 562   CHECK_STRING (name, 0);
 563   CHECK_LIST (fontlist, 1);
 564
 565   fullname = Fquery_fontset (name);
 566   if (!NILP (fullname))
 567     error ("Fontset \"%s\" matches the existing fontset \"%s\"",
 568            XSTRING (name)->data, XSTRING (fullname)->data);
 569
 570   /* Check the validity of FONTLIST.  */
 571   for (tail = fontlist; CONSP (tail); tail = XCONS (tail)->cdr)
 572     {
 573       Lisp_Object tem = XCONS (tail)->car;
 574       int charset;
 575
 576       if (!CONSP (tem)
 577           || (charset = get_charset_id (XCONS (tem)->car)) < 0
 578           || !STRINGP (XCONS (tem)->cdr))
 579         error ("Elements of fontlist must be a cons of charset and font name");
 580     }
 581
 582   fontset_info = Fcons (name, fontlist);
 583   Vglobal_fontset_alist  = Fcons (fontset_info, Vglobal_fontset_alist);
 584
 585   /* Register this fontset for all existing frames.  */
 586   {
 587     Lisp_Object framelist, frame;
 588
 589     FOR_EACH_FRAME (framelist, frame)
 590       if (!FRAME_TERMCAP_P (XFRAME (frame)))
 591         fs_register_fontset (XFRAME (frame), fontset_info);
 592   }
 593
 594   return Qnil;
 595 }
 596
 597 extern Lisp_Object Fframe_parameters ();
 598 extern Lisp_Object Qfont;
 599 Lisp_Object Qfontset;
 600
 601 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
 602   "Set FONTNAME for a font of CHARSET in fontset NAME on frame FRAME.\n\
 603 If FRAME is omitted or nil, all frames are affected.")
 604   (name, charset_symbol, fontname, frame)
 605      Lisp_Object name, charset_symbol, fontname, frame;
 606 {
 607   int charset;
 608   Lisp_Object fullname, fontlist;
 609
 610   (*check_window_system_func) ();
 611
 612   CHECK_STRING (name, 0);
 613   CHECK_SYMBOL (charset_symbol, 1);
 614   CHECK_STRING (fontname, 2);
 615   if (!NILP (frame))
 616     CHECK_LIVE_FRAME (frame, 3);
 617
 618   if ((charset = get_charset_id (charset_symbol)) < 0)
 619     error ("Invalid charset: %s", XSYMBOL (charset_symbol)->name->data);
 620
 621   fullname = Fquery_fontset (name);
 622   if (NILP (fullname))
 623     error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
 624
 625   /* If FRAME is not specified, we must, at first, update contents of
 626      `global-fontset-alist' for a frame created in the future.  */
 627   if (NILP (frame))
 628     {
 629       Lisp_Object fontset_info = Fassoc (fullname, Vglobal_fontset_alist);
 630       Lisp_Object tem = Fassq (charset_symbol, XCONS (fontset_info)->cdr);
 631
 632       if (NILP (tem))
 633         XCONS (fontset_info)->cdr
 634           = Fcons (Fcons (charset_symbol, fontname),
 635                    XCONS (fontset_info)->cdr);
 636       else
 637         XCONS (tem)->cdr = fontname;
 638     }
 639
 640   /* Then, update information in the specified frame or all existing
 641      frames.  */
 642   {
 643     Lisp_Object framelist, tem;
 644
 645     FOR_EACH_FRAME (framelist, tem)
 646       if (!FRAME_TERMCAP_P (XFRAME (tem))
 647           && (NILP (frame) || EQ (frame, tem)))
 648         {
 649           FRAME_PTR f = XFRAME (tem);
 650           int fontset = fs_query_fontset (f, XSTRING (fullname)->data);
 651           struct fontset_info *fontsetp
 652             = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
 653
 654           if (fontsetp->fontname[charset])
 655             xfree (fontsetp->fontname[charset]);
 656           fontsetp->fontname[charset]
 657             = (char *) xmalloc (XSTRING (fontname)->size + 1);
 658           bcopy (XSTRING (fontname)->data, fontsetp->fontname[charset],
 659                  XSTRING (fontname)->size + 1);
 660           fontsetp->font_indexes[charset] = FONT_NOT_OPENED;
 661
 662           if (charset == CHARSET_ASCII)
 663             {
 664               Lisp_Object font_param = Fassq (Qfont, Fframe_parameters (tem));
 665
 666               if (set_frame_fontset_func
 667                   && !NILP (font_param)
 668                   && !strcmp (XSTRING (fullname)->data,
 669                               XSTRING (XCONS (font_param)->cdr)->data))
 670                 /* This fontset is the default fontset on frame TEM.
 671                    We may have to resize this frame because of new
 672                    ASCII font.  */
 673                 (*set_frame_fontset_func) (f, fullname, Qnil);
 674             }
 675         }
 676   }
 677
 678   return Qnil;
 679 }
 680
 681 DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
 682   "Return information about a font named NAME on frame FRAME.\n\
 683 If FRAME is omitted or nil, use the selected frame.\n\
 684 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
 685   HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
 686 where\n\
 687   OPENED-NAME is the name used for opening the font,\n\
 688   FULL-NAME is the full name of the font,\n\
 689   CHARSET is the charset displayed by the font,\n\
 690   SIZE is the minimum bound width of the font,\n\
 691   HEIGHT is the height of the font,\n\
 692   BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
 693   RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
 694     how to compose characters.\n\
 695 If the named font is not yet loaded, return nil.")
 696   (name, frame)
 697      Lisp_Object name, frame;
 698 {
 699   FRAME_PTR f;
 700   struct font_info *fontp;
 701   Lisp_Object info;
 702
 703   (*check_window_system_func) ();
 704
 705   CHECK_STRING (name, 0);
 706   if (NILP (frame))
 707     f = selected_frame;
 708   else
 709     {
 710       CHECK_LIVE_FRAME (frame, 1);
 711       f = XFRAME (frame);
 712     }
 713
 714   if (!query_font_func)
 715     error ("Font query function is not supported");
 716
 717   fontp = (*query_font_func) (f, XSTRING (name)->data);
 718   if (!fontp)
 719     return Qnil;
 720
 721   info = Fmake_vector (make_number (8), Qnil);
 722
 723   XVECTOR (info)->contents[0] = build_string (fontp->name);
 724   XVECTOR (info)->contents[1] = build_string (fontp->full_name);
 725   XVECTOR (info)->contents[2] = CHARSET_SYMBOL (fontp->charset);
 726   XVECTOR (info)->contents[3] = make_number (fontp->size);
 727   XVECTOR (info)->contents[4] = make_number (fontp->height);
 728   XVECTOR (info)->contents[5] = make_number (fontp->baseline_offset);
 729   XVECTOR (info)->contents[6] = make_number (fontp->relative_compose);
 730   XVECTOR (info)->contents[7] = make_number (fontp->default_ascent);
 731
 732   return info;
 733 }
 734
 735 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
 736   "Return information about a fontset named NAME on frame FRAME.\n\
 737 If FRAME is omitted or nil, use the selected frame.\n\
 738 The returned value is a vector of SIZE, HEIGHT, and FONT-LIST,\n\
 739 where\n\
 740   SIZE is the minimum bound width of ASCII font of the fontset,\n\
 741   HEIGHT is the height of the tallest font in the fontset, and\n\
 742   FONT-LIST is an alist of the format:\n\
 743     (CHARSET REQUESTED-FONT-NAME LOADED-FONT-NAME).\n\
 744 LOADED-FONT-NAME t means the font is not yet loaded, nil means the\n\
 745 loading failed.")
 746   (name, frame)
 747      Lisp_Object name, frame;
 748 {
 749   FRAME_PTR f;
 750   int fontset;
 751   struct fontset_info *fontsetp;
 752   Lisp_Object info, val;
 753   int i;
 754
 755   (*check_window_system_func) ();
 756
 757   CHECK_STRING(name, 0);
 758   if (NILP (frame))
 759     f = selected_frame;
 760   else
 761     {
 762       CHECK_LIVE_FRAME (frame, 1);
 763       f = XFRAME (frame);
 764     }
 765
 766   fontset = fs_query_fontset (f, XSTRING (name)->data);
 767   if (fontset < 0)
 768     error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
 769
 770   info = Fmake_vector (make_number (3), Qnil);
 771
 772   fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
 773
 774   XVECTOR (info)->contents[0] = make_number (fontsetp->size);
 775   XVECTOR (info)->contents[1] = make_number (fontsetp->height);
 776   val = Qnil;
 777   for (i = 0; i <= MAX_CHARSET; i++)
 778     if (fontsetp->fontname[i])
 779       {
 780         int font_idx = fontsetp->font_indexes[i];
 781         Lisp_Object loaded;
 782
 783         if (font_idx == FONT_NOT_OPENED)
 784           loaded = Qt;
 785         else if (font_idx == FONT_NOT_FOUND)
 786           loaded = Qnil;
 787         else
 788           loaded
 789             = build_string ((*get_font_info_func) (f, font_idx)->full_name);
 790         val = Fcons (Fcons (CHARSET_SYMBOL (i),
 791                             Fcons (build_string (fontsetp->fontname[i]),
 792                                    Fcons (loaded, Qnil))),
 793                      val);
 794       }
 795   XVECTOR (info)->contents[2] = val;
 796   return info;
 797 }
 798
 799 syms_of_fontset ()
 800 {
 801   int i;
 802
 803   for (i = 0; i < 256; i++)
 804     my_strcasetbl[i] = (i >= 'A' && i <= 'Z') ? i + 'a' - 'A' : i;
 805
 806   if (!load_font_func)
 807     /* Window system initializer should have set proper functions.  */
 808     abort ();
 809
 810   Qfontset = intern ("fontset");
 811   staticpro (&Qfontset);
 812
 813   Vcached_fontset_data = Qnil;
 814   staticpro (&Vcached_fontset_data);
 815
 816   DEFVAR_LISP ("global-fontset-alist", &Vglobal_fontset_alist,
 817     "Internal data for fontset.  Not for external use.\n\
 818 This is an alist associating fontset names with the lists of fonts\n\
 819  contained in them.\n\
 820 Newly created frames make their own fontset database from here.");
 821   Vglobal_fontset_alist = Qnil;
 822
 823   DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
 824     "Alist of fontname patterns vs corresponding encoding info.\n\
 825 Each element looks like (REGEXP . ENCODING-INFO),\n\
 826  where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
 827 ENCODING is one of the following integer values:\n\
 828         0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
 829         1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
 830         2: code points 0x20A0..0x7FFF are used,\n\
 831         3: code points 0xA020..0xFF7F are used.");
 832   Vfont_encoding_alist = Qnil;
 833
 834   DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
 835      "Char table of characters of which ascent values should be ignored.\n\
 836 If an entry for a character is non-nil, the ascent value of the glyph\n\
 837 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.");
 838   Vuse_default_ascent = Qnil;
 839
 840   DEFVAR_LISP ("alternative-fontname-alist", &Valternative_fontname_alist,
 841      "Alist of fontname vs list of the alternative fontnames.\n\
 842 When no font can be opened by a fontname, the corresponding\n\
 843 alternative fontnames are tried.");
 844   Valternative_fontname_alist = Qnil;
 845
 846   DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
 847      "Alist of fontset names vs the aliases.");
 848   Vfontset_alias_alist = Qnil;
 849
 850   DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font,
 851      "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
 852 The way to highlight them depends on window system on which Emacs runs.\n\
 853 On X window, a rectangle is shown around each such character.");
 854   Vhighlight_wrong_size_font = Qnil;
 855
 856   DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font,
 857      "*Non-nil means characters shown in large size fonts are clipped.\n\
 858 The height of clipping area is the same as that of an ASCII character.\n\
 859 The width of the area is the same as that of an ASCII character or\n\
 860 twice wider than that of an ASCII character depending on\n\
 861 the width (i.e. column numbers occupied on screen) of the character set\n\
 862 of the character.\n\
 863 \n\
 864 In the case that you only have too large size font for a specific\n\
 865 charscter set, and clipping characters of the character set makes them\n\
 866 almost unreadable, you can set this variable to t to see the\n\
 867 characters in exchage for garbage dots left on your screen.");
 868   Vclip_large_size_font = Qt;
 869
 870   defsubr (&Squery_fontset);
 871   defsubr (&Snew_fontset);
 872   defsubr (&Sset_fontset_font);
 873   defsubr (&Sfont_info);
 874   defsubr (&Sfontset_info);
 875 }