src/fontset.c

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