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