src/xfont.c

   1 /* xfont.c -- X core font driver.
   2    Copyright (C) 2006-2012 Free Software Foundation, Inc.
   3    Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
   4      National Institute of Advanced Industrial Science and Technology (AIST)
   5      Registration Number H13PRO009
   6
   7 This file is part of GNU Emacs.
   8
   9 GNU Emacs is free software: you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation, either version 3 of the License, or
  12 (at your option) any later version.
  13
  14 GNU Emacs is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  21
  22 #include <config.h>
  23 #include <stdio.h>
  24 #include <setjmp.h>
  25 #include <X11/Xlib.h>
  26
  27 #include "lisp.h"
  28 #include "dispextern.h"
  29 #include "xterm.h"
  30 #include "frame.h"
  31 #include "blockinput.h"
  32 #include "character.h"
  33 #include "charset.h"
  34 #include "fontset.h"
  35 #include "font.h"
  36 #include "ccl.h"
  37
  38 \f
  39 /* X core font driver.  */
  40
  41 struct xfont_info
  42 {
  43   struct font font;
  44   Display *display;
  45   XFontStruct *xfont;
  46 };
  47
  48 /* Prototypes of support functions.  */
  49 extern void x_clear_errors (Display *);
  50
  51 static XCharStruct *xfont_get_pcm (XFontStruct *, XChar2b *);
  52
  53 /* Get metrics of character CHAR2B in XFONT.  Value is null if CHAR2B
  54    is not contained in the font.  */
  55
  56 static XCharStruct *
  57 xfont_get_pcm (XFontStruct *xfont, XChar2b *char2b)
  58 {
  59   /* The result metric information.  */
  60   XCharStruct *pcm = NULL;
  61
  62   font_assert (xfont && char2b);
  63
  64   if (xfont->per_char != NULL)
  65     {
  66       if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
  67         {
  68           /* min_char_or_byte2 specifies the linear character index
  69              corresponding to the first element of the per_char array,
  70              max_char_or_byte2 is the index of the last character.  A
  71              character with non-zero CHAR2B->byte1 is not in the font.
  72              A character with byte2 less than min_char_or_byte2 or
  73              greater max_char_or_byte2 is not in the font.  */
  74           if (char2b->byte1 == 0
  75               && char2b->byte2 >= xfont->min_char_or_byte2
  76               && char2b->byte2 <= xfont->max_char_or_byte2)
  77             pcm = xfont->per_char + char2b->byte2 - xfont->min_char_or_byte2;
  78         }
  79       else
  80         {
  81           /* If either min_byte1 or max_byte1 are nonzero, both
  82              min_char_or_byte2 and max_char_or_byte2 are less than
  83              256, and the 2-byte character index values corresponding
  84              to the per_char array element N (counting from 0) are:
  85
  86              byte1 = N/D + min_byte1
  87              byte2 = N\D + min_char_or_byte2
  88
  89              where:
  90
  91              D = max_char_or_byte2 - min_char_or_byte2 + 1
  92              / = integer division
  93              \ = integer modulus  */
  94           if (char2b->byte1 >= xfont->min_byte1
  95               && char2b->byte1 <= xfont->max_byte1
  96               && char2b->byte2 >= xfont->min_char_or_byte2
  97               && char2b->byte2 <= xfont->max_char_or_byte2)
  98             pcm = (xfont->per_char
  99                    + ((xfont->max_char_or_byte2 - xfont->min_char_or_byte2 + 1)
 100                       * (char2b->byte1 - xfont->min_byte1))
 101                    + (char2b->byte2 - xfont->min_char_or_byte2));
 102         }
 103     }
 104   else
 105     {
 106       /* If the per_char pointer is null, all glyphs between the first
 107          and last character indexes inclusive have the same
 108          information, as given by both min_bounds and max_bounds.  */
 109       if (char2b->byte2 >= xfont->min_char_or_byte2
 110           && char2b->byte2 <= xfont->max_char_or_byte2)
 111         pcm = &xfont->max_bounds;
 112     }
 113
 114   return ((pcm == NULL
 115            || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0))
 116           ? NULL : pcm);
 117 }
 118
 119 static Lisp_Object xfont_get_cache (FRAME_PTR);
 120 static Lisp_Object xfont_list (Lisp_Object, Lisp_Object);
 121 static Lisp_Object xfont_match (Lisp_Object, Lisp_Object);
 122 static Lisp_Object xfont_list_family (Lisp_Object);
 123 static Lisp_Object xfont_open (FRAME_PTR, Lisp_Object, int);
 124 static void xfont_close (FRAME_PTR, struct font *);
 125 static int xfont_prepare_face (FRAME_PTR, struct face *);
 126 static int xfont_has_char (Lisp_Object, int);
 127 static unsigned xfont_encode_char (struct font *, int);
 128 static int xfont_text_extents (struct font *, unsigned *, int,
 129                                struct font_metrics *);
 130 static int xfont_draw (struct glyph_string *, int, int, int, int, int);
 131 static int xfont_check (FRAME_PTR, struct font *);
 132
 133 struct font_driver xfont_driver =
 134   {
 135     LISP_INITIALLY_ZERO,        /* Qx */
 136     0,                          /* case insensitive */
 137     xfont_get_cache,
 138     xfont_list,
 139     xfont_match,
 140     xfont_list_family,
 141     NULL,
 142     xfont_open,
 143     xfont_close,
 144     xfont_prepare_face,
 145     NULL,
 146     xfont_has_char,
 147     xfont_encode_char,
 148     xfont_text_extents,
 149     xfont_draw,
 150     NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
 151     xfont_check,
 152     NULL, /* get_variation_glyphs */
 153     NULL, /* filter_properties */
 154   };
 155
 156 static Lisp_Object
 157 xfont_get_cache (FRAME_PTR f)
 158 {
 159   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 160
 161   return (dpyinfo->name_list_element);
 162 }
 163
 164 static int
 165 compare_font_names (const void *name1, const void *name2)
 166 {
 167   char *const *n1 = name1;
 168   char *const *n2 = name2;
 169   return xstrcasecmp (*n1, *n2);
 170 }
 171
 172 /* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length
 173    of the decoding result.  LEN is the byte length of XLFD, or -1 if
 174    XLFD is NULL terminated.  The caller must assure that OUTPUT is at
 175    least twice (plus 1) as large as XLFD.  */
 176
 177 static ptrdiff_t
 178 xfont_decode_coding_xlfd (char *xlfd, int len, char *output)
 179 {
 180   char *p0 = xlfd, *p1 = output;
 181   int c;
 182
 183   while (*p0)
 184     {
 185       c = *(unsigned char *) p0++;
 186       p1 += CHAR_STRING (c, (unsigned char *) p1);
 187       if (--len == 0)
 188         break;
 189     }
 190   *p1 = 0;
 191   return (p1 - output);
 192 }
 193
 194 /* Encode XLFD from UTF-8 to iso-8859-1 destructively, and return the
 195    resulting byte length.  If XLFD contains unencodable character,
 196    return -1.  */
 197
 198 static int
 199 xfont_encode_coding_xlfd (char *xlfd)
 200 {
 201   const unsigned char *p0 = (unsigned char *) xlfd;
 202   unsigned char *p1 = (unsigned char *) xlfd;
 203   int len = 0;
 204
 205   while (*p0)
 206     {
 207       int c = STRING_CHAR_ADVANCE (p0);
 208
 209       if (c >= 0x100)
 210         return -1;
 211       *p1++ = c;
 212       len++;
 213     }
 214   *p1 = 0;
 215   return len;
 216 }
 217
 218 /* Check if CHARS (cons or vector) is supported by XFONT whose
 219    encoding charset is ENCODING (XFONT is NULL) or by a font whose
 220    registry corresponds to ENCODING and REPERTORY.
 221    Return 1 if supported, return 0 otherwise.  */
 222
 223 static int
 224 xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
 225                        struct charset *encoding, struct charset *repertory)
 226 {
 227   struct charset *charset = repertory ? repertory : encoding;
 228
 229   if (CONSP (chars))
 230     {
 231       for (; CONSP (chars); chars = XCDR (chars))
 232         {
 233           int c = XINT (XCAR (chars));
 234           unsigned code = ENCODE_CHAR (charset, c);
 235           XChar2b char2b;
 236
 237           if (code == CHARSET_INVALID_CODE (charset))
 238             break;
 239           if (! xfont)
 240             continue;
 241           if (code >= 0x10000)
 242             break;
 243           char2b.byte1 = code >> 8;
 244           char2b.byte2 = code & 0xFF;
 245           if (! xfont_get_pcm (xfont, &char2b))
 246             break;
 247         }
 248       return (NILP (chars));
 249     }
 250   else if (VECTORP (chars))
 251     {
 252       ptrdiff_t i;
 253
 254       for (i = ASIZE (chars) - 1; i >= 0; i--)
 255         {
 256           int c = XINT (AREF (chars, i));
 257           unsigned code = ENCODE_CHAR (charset, c);
 258           XChar2b char2b;
 259
 260           if (code == CHARSET_INVALID_CODE (charset))
 261             continue;
 262           if (! xfont)
 263             break;
 264           if (code >= 0x10000)
 265             continue;
 266           char2b.byte1 = code >> 8;
 267           char2b.byte2 = code & 0xFF;
 268           if (xfont_get_pcm (xfont, &char2b))
 269             break;
 270         }
 271       return (i >= 0);
 272     }
 273   return 0;
 274 }
 275
 276 /* A hash table recoding which font supports which scripts.  Each key
 277    is a vector of characteristic font properties FOUNDRY to WIDTH and
 278    ADDSTYLE, and each value is a list of script symbols.
 279
 280    We assume that fonts that have the same value in the above
 281    properties supports the same set of characters on all displays.  */
 282
 283 static Lisp_Object xfont_scripts_cache;
 284
 285 /* Re-usable vector to store characteristic font properties.   */
 286 static Lisp_Object xfont_scratch_props;
 287
 288 /* Return a list of scripts supported by the font of FONTNAME whose
 289    characteristic properties are in PROPS and whose encoding charset
 290    is ENCODING.  A caller must call BLOCK_INPUT in advance.  */
 291
 292 static Lisp_Object
 293 xfont_supported_scripts (Display *display, char *fontname, Lisp_Object props,
 294                          struct charset *encoding)
 295 {
 296   Lisp_Object scripts;
 297
 298   /* Two special cases to avoid opening rather big fonts.  */
 299   if (EQ (AREF (props, 2), Qja))
 300     return Fcons (intern ("kana"), Fcons (intern ("han"), Qnil));
 301   if (EQ (AREF (props, 2), Qko))
 302     return Fcons (intern ("hangul"), Qnil);
 303   scripts = Fgethash (props, xfont_scripts_cache, Qt);
 304   if (EQ (scripts, Qt))
 305     {
 306       XFontStruct *xfont;
 307       Lisp_Object val;
 308
 309       scripts = Qnil;
 310       xfont = XLoadQueryFont (display, fontname);
 311       if (xfont)
 312         {
 313           if (xfont->per_char)
 314             {
 315               for (val = Vscript_representative_chars; CONSP (val);
 316                    val = XCDR (val))
 317                 if (CONSP (XCAR (val)) && SYMBOLP (XCAR (XCAR (val))))
 318                   {
 319                     Lisp_Object script = XCAR (XCAR (val));
 320                     Lisp_Object chars = XCDR (XCAR (val));
 321
 322                     if (xfont_chars_supported (chars, xfont, encoding, NULL))
 323                       scripts = Fcons (script, scripts);
 324                   }
 325             }
 326           XFreeFont (display, xfont);
 327         }
 328       if (EQ (AREF (props, 3), Qiso10646_1)
 329           && NILP (Fmemq (Qlatin, scripts)))
 330         scripts = Fcons (Qlatin, scripts);
 331       Fputhash (Fcopy_sequence (props), scripts, xfont_scripts_cache);
 332     }
 333   return scripts;
 334 }
 335
 336 static Lisp_Object
 337 xfont_list_pattern (Display *display, const char *pattern,
 338                     Lisp_Object registry, Lisp_Object script)
 339 {
 340   Lisp_Object list = Qnil;
 341   Lisp_Object chars = Qnil;
 342   struct charset *encoding, *repertory = NULL;
 343   int i, limit, num_fonts;
 344   char **names;
 345   /* Large enough to decode the longest XLFD (255 bytes). */
 346   char buf[512];
 347
 348   if (! NILP (registry)
 349       && font_registry_charsets (registry, &encoding, &repertory) < 0)
 350     /* Unknown REGISTRY, not supported.  */
 351     return Qnil;
 352   if (! NILP (script))
 353     {
 354       chars = assq_no_quit (script, Vscript_representative_chars);
 355       if (NILP (chars))
 356         /* We can't tell whether or not a font supports SCRIPT.  */
 357         return Qnil;
 358       chars = XCDR (chars);
 359       if (repertory)
 360         {
 361           if (! xfont_chars_supported (chars, NULL, encoding, repertory))
 362             return Qnil;
 363           script = Qnil;
 364         }
 365     }
 366
 367   BLOCK_INPUT;
 368   x_catch_errors (display);
 369
 370   for (limit = 512; ; limit *= 2)
 371     {
 372       names = XListFonts (display, pattern, limit, &num_fonts);
 373       if (x_had_errors_p (display))
 374         {
 375           /* This error is perhaps due to insufficient memory on X
 376              server.  Let's just ignore it.  */
 377           x_clear_errors (display);
 378           num_fonts = 0;
 379           break;
 380         }
 381       if (num_fonts < limit)
 382         break;
 383       XFreeFontNames (names);
 384     }
 385
 386   if (num_fonts > 0)
 387     {
 388       char **indices = alloca (sizeof (char *) * num_fonts);
 389       Lisp_Object *props = XVECTOR (xfont_scratch_props)->contents;
 390       Lisp_Object scripts = Qnil;
 391
 392       for (i = 0; i < ASIZE (xfont_scratch_props); i++)
 393         props[i] = Qnil;
 394       for (i = 0; i < num_fonts; i++)
 395         indices[i] = names[i];
 396       qsort (indices, num_fonts, sizeof (char *), compare_font_names);
 397
 398       for (i = 0; i < num_fonts; i++)
 399         {
 400           ptrdiff_t len;
 401           Lisp_Object entity;
 402
 403           if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
 404             continue;
 405           entity = font_make_entity ();
 406           len = xfont_decode_coding_xlfd (indices[i], -1, buf);
 407           if (font_parse_xlfd (buf, len, entity) < 0)
 408             continue;
 409           ASET (entity, FONT_TYPE_INDEX, Qx);
 410           /* Avoid auto-scaled fonts.  */
 411           if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
 412               && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
 413               && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
 414               && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
 415             continue;
 416           /* Avoid not-allowed scalable fonts.  */
 417           if (NILP (Vscalable_fonts_allowed))
 418             {
 419               int size = 0;
 420
 421               if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
 422                 size = XINT (AREF (entity, FONT_SIZE_INDEX));
 423               else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
 424                 size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
 425               if (size == 0)
 426                 continue;
 427             }
 428           else if (CONSP (Vscalable_fonts_allowed))
 429             {
 430               Lisp_Object tail, elt;
 431
 432               for (tail = Vscalable_fonts_allowed; CONSP (tail);
 433                    tail = XCDR (tail))
 434                 {
 435                   elt = XCAR (tail);
 436                   if (STRINGP (elt)
 437                       && fast_c_string_match_ignore_case (elt, indices[i],
 438                                                           len) >= 0)
 439                     break;
 440                 }
 441               if (! CONSP (tail))
 442                 continue;
 443             }
 444
 445           /* Avoid fonts of invalid registry.  */
 446           if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
 447             continue;
 448
 449           /* Update encoding and repertory if necessary.  */
 450           if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
 451             {
 452               registry = AREF (entity, FONT_REGISTRY_INDEX);
 453               if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 454                 encoding = NULL;
 455             }
 456           if (! encoding)
 457             /* Unknown REGISTRY, not supported.  */
 458             continue;
 459           if (repertory)
 460             {
 461               if (NILP (script)
 462                   || xfont_chars_supported (chars, NULL, encoding, repertory))
 463                 list = Fcons (entity, list);
 464               continue;
 465             }
 466           if (memcmp (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
 467                       sizeof (Lisp_Object) * 7)
 468               || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
 469             {
 470               memcpy (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
 471                       sizeof (Lisp_Object) * 7);
 472               props[7] = AREF (entity, FONT_SPACING_INDEX);
 473               scripts = xfont_supported_scripts (display, indices[i],
 474                                                  xfont_scratch_props, encoding);
 475             }
 476           if (NILP (script)
 477               || ! NILP (Fmemq (script, scripts)))
 478             list = Fcons (entity, list);
 479         }
 480       XFreeFontNames (names);
 481     }
 482
 483   x_uncatch_errors ();
 484   UNBLOCK_INPUT;
 485
 486   FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
 487   return list;
 488 }
 489
 490 static Lisp_Object
 491 xfont_list (Lisp_Object frame, Lisp_Object spec)
 492 {
 493   FRAME_PTR f = XFRAME (frame);
 494   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
 495   Lisp_Object registry, list, val, extra, script;
 496   int len;
 497   /* Large enough to contain the longest XLFD (255 bytes) in UTF-8.  */
 498   char name[512];
 499
 500   extra = AREF (spec, FONT_EXTRA_INDEX);
 501   if (CONSP (extra))
 502     {
 503       val = assq_no_quit (QCotf, extra);
 504       if (! NILP (val))
 505         return Qnil;
 506       val = assq_no_quit (QClang, extra);
 507       if (! NILP (val))
 508         return Qnil;
 509     }
 510
 511   registry = AREF (spec, FONT_REGISTRY_INDEX);
 512   len = font_unparse_xlfd (spec, 0, name, 512);
 513   if (len < 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 514     return Qnil;
 515
 516   val = assq_no_quit (QCscript, extra);
 517   script = CDR (val);
 518   list = xfont_list_pattern (display, name, registry, script);
 519   if (NILP (list) && NILP (registry))
 520     {
 521       /* Try iso10646-1 */
 522       char *r = name + len - 9; /* 9 == strlen (iso8859-1) */
 523
 524       if (r - name + 10 < 256)  /* 10 == strlen (iso10646-1) */
 525         {
 526           strcpy (r, "iso10646-1");
 527           list = xfont_list_pattern (display, name, Qiso10646_1, script);
 528         }
 529     }
 530   if (NILP (list) && ! NILP (registry))
 531     {
 532       /* Try alternate registries.  */
 533       Lisp_Object alter;
 534
 535       if ((alter = Fassoc (SYMBOL_NAME (registry),
 536                            Vface_alternative_font_registry_alist),
 537            CONSP (alter)))
 538         {
 539           /* Pointer to REGISTRY-ENCODING field.  */
 540           char *r = name + len - SBYTES (SYMBOL_NAME (registry));
 541
 542           for (alter = XCDR (alter); CONSP (alter); alter = XCDR (alter))
 543             if (STRINGP (XCAR (alter))
 544                 && ((r - name) + SBYTES (XCAR (alter))) < 256)
 545               {
 546                 strcpy (r, SSDATA (XCAR (alter)));
 547                 list = xfont_list_pattern (display, name, registry, script);
 548                 if (! NILP (list))
 549                   break;
 550               }
 551         }
 552     }
 553   if (NILP (list))
 554     {
 555       /* Try alias.  */
 556       val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
 557       if (CONSP (val) && STRINGP (XCDR (val)) && SBYTES (XCDR (val)) < 512)
 558         {
 559           memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
 560           if (xfont_encode_coding_xlfd (name) < 0)
 561             return Qnil;
 562           list = xfont_list_pattern (display, name, registry, script);
 563         }
 564     }
 565
 566   return list;
 567 }
 568
 569 static Lisp_Object
 570 xfont_match (Lisp_Object frame, Lisp_Object spec)
 571 {
 572   FRAME_PTR f = XFRAME (frame);
 573   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
 574   Lisp_Object extra, val, entity;
 575   char name[512];
 576   XFontStruct *xfont;
 577   unsigned long value;
 578
 579   extra = AREF (spec, FONT_EXTRA_INDEX);
 580   val = assq_no_quit (QCname, extra);
 581   if (! CONSP (val) || ! STRINGP (XCDR (val)))
 582     {
 583       if (font_unparse_xlfd (spec, 0, name, 512) < 0)
 584         return Qnil;
 585     }
 586   else if (SBYTES (XCDR (val)) < 512)
 587     memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
 588   else
 589     return Qnil;
 590   if (xfont_encode_coding_xlfd (name) < 0)
 591     return Qnil;
 592
 593   BLOCK_INPUT;
 594   entity = Qnil;
 595   xfont = XLoadQueryFont (display, name);
 596   if (xfont)
 597     {
 598       if (XGetFontProperty (xfont, XA_FONT, &value))
 599         {
 600           char *s;
 601
 602           s = (char *) XGetAtomName (display, (Atom) value);
 603
 604           /* If DXPC (a Differential X Protocol Compressor)
 605              Ver.3.7 is running, XGetAtomName will return null
 606              string.  We must avoid such a name.  */
 607           if (*s)
 608             {
 609               ptrdiff_t len;
 610               entity = font_make_entity ();
 611               ASET (entity, FONT_TYPE_INDEX, Qx);
 612               len = xfont_decode_coding_xlfd (s, -1, name);
 613               if (font_parse_xlfd (name, len, entity) < 0)
 614                 entity = Qnil;
 615             }
 616           XFree (s);
 617         }
 618       XFreeFont (display, xfont);
 619     }
 620   UNBLOCK_INPUT;
 621
 622   FONT_ADD_LOG ("xfont-match", spec, entity);
 623   return entity;
 624 }
 625
 626 static Lisp_Object
 627 xfont_list_family (Lisp_Object frame)
 628 {
 629   FRAME_PTR f = XFRAME (frame);
 630   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 631   char **names;
 632   int num_fonts, i;
 633   Lisp_Object list;
 634   char *last_family IF_LINT (= 0);
 635   int last_len;
 636
 637   BLOCK_INPUT;
 638   x_catch_errors (dpyinfo->display);
 639   names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
 640                       0x8000, &num_fonts);
 641   if (x_had_errors_p (dpyinfo->display))
 642     {
 643       /* This error is perhaps due to insufficient memory on X server.
 644          Let's just ignore it.  */
 645       x_clear_errors (dpyinfo->display);
 646       num_fonts = 0;
 647     }
 648
 649   list = Qnil;
 650   for (i = 0, last_len = 0; i < num_fonts; i++)
 651     {
 652       char *p0 = names[i], *p1, buf[512];
 653       Lisp_Object family;
 654       int decoded_len;
 655
 656       p0++;                     /* skip the leading '-' */
 657       while (*p0 && *p0 != '-') p0++; /* skip foundry */
 658       if (! *p0)
 659         continue;
 660       p1 = ++p0;
 661       while (*p1 && *p1 != '-') p1++; /* find the end of family */
 662       if (! *p1 || p1 == p0)
 663         continue;
 664       if (last_len == p1 - p0
 665           && memcmp (last_family, p0, last_len) == 0)
 666         continue;
 667       last_len = p1 - p0;
 668       last_family = p0;
 669
 670       decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
 671       family = font_intern_prop (p0, decoded_len, 1);
 672       if (NILP (assq_no_quit (family, list)))
 673         list = Fcons (family, list);
 674     }
 675
 676   XFreeFontNames (names);
 677   x_uncatch_errors ();
 678   UNBLOCK_INPUT;
 679
 680   return list;
 681 }
 682
 683 static Lisp_Object
 684 xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
 685 {
 686   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 687   Display *display = dpyinfo->display;
 688   char name[512];
 689   int len;
 690   unsigned long value;
 691   Lisp_Object registry;
 692   struct charset *encoding, *repertory;
 693   Lisp_Object font_object, fullname;
 694   struct font *font;
 695   XFontStruct *xfont;
 696
 697   /* At first, check if we know how to encode characters for this
 698      font.  */
 699   registry = AREF (entity, FONT_REGISTRY_INDEX);
 700   if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 701     {
 702       FONT_ADD_LOG ("  x:unknown registry", registry, Qnil);
 703       return Qnil;
 704     }
 705
 706   if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
 707     pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
 708   else if (pixel_size == 0)
 709     {
 710       if (FRAME_FONT (f))
 711         pixel_size = FRAME_FONT (f)->pixel_size;
 712       else
 713         pixel_size = 14;
 714     }
 715   len = font_unparse_xlfd (entity, pixel_size, name, 512);
 716   if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 717     {
 718       FONT_ADD_LOG ("  x:unparse failed", entity, Qnil);
 719       return Qnil;
 720     }
 721
 722   BLOCK_INPUT;
 723   x_catch_errors (display);
 724   xfont = XLoadQueryFont (display, name);
 725   if (x_had_errors_p (display))
 726     {
 727       /* This error is perhaps due to insufficient memory on X server.
 728          Let's just ignore it.  */
 729       x_clear_errors (display);
 730       xfont = NULL;
 731     }
 732   else if (! xfont)
 733     {
 734       /* Some version of X lists:
 735            -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
 736            -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
 737          but can open only:
 738            -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
 739          and
 740            -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
 741          So, we try again with wildcards in RESX and RESY.  */
 742       Lisp_Object temp;
 743
 744       temp = copy_font_spec (entity);
 745       ASET (temp, FONT_DPI_INDEX, Qnil);
 746       len = font_unparse_xlfd (temp, pixel_size, name, 512);
 747       if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 748         {
 749           FONT_ADD_LOG ("  x:unparse failed", temp, Qnil);
 750           return Qnil;
 751         }
 752       xfont = XLoadQueryFont (display, name);
 753       if (x_had_errors_p (display))
 754         {
 755           /* This error is perhaps due to insufficient memory on X server.
 756              Let's just ignore it.  */
 757           x_clear_errors (display);
 758           xfont = NULL;
 759         }
 760     }
 761   fullname = Qnil;
 762   /* Try to get the full name of FONT.  */
 763   if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
 764     {
 765       char *p0, *p;
 766       int dashes = 0;
 767
 768       p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
 769       /* Count the number of dashes in the "full name".
 770          If it is too few, this isn't really the font's full name,
 771          so don't use it.
 772          In X11R4, the fonts did not come with their canonical names
 773          stored in them.  */
 774       while (*p)
 775         {
 776           if (*p == '-')
 777             dashes++;
 778           p++;
 779         }
 780
 781       if (dashes >= 13)
 782         {
 783           len = xfont_decode_coding_xlfd (p0, -1, name);
 784           fullname = Fdowncase (make_string (name, len));
 785         }
 786       XFree (p0);
 787     }
 788   x_uncatch_errors ();
 789   UNBLOCK_INPUT;
 790
 791   if (! xfont)
 792     {
 793       FONT_ADD_LOG ("  x:open failed", build_string (name), Qnil);
 794       return Qnil;
 795     }
 796
 797   font_object = font_make_object (VECSIZE (struct xfont_info),
 798                                   entity, pixel_size);
 799   ASET (font_object, FONT_TYPE_INDEX, Qx);
 800   if (STRINGP (fullname))
 801     {
 802       font_parse_xlfd (SSDATA (fullname), SBYTES (fullname), font_object);
 803       ASET (font_object, FONT_NAME_INDEX, fullname);
 804     }
 805   else
 806     {
 807       char buf[512];
 808
 809       len = xfont_decode_coding_xlfd (name, -1, buf);
 810       ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
 811     }
 812   ASET (font_object, FONT_FULLNAME_INDEX, fullname);
 813   ASET (font_object, FONT_FILE_INDEX, Qnil);
 814   ASET (font_object, FONT_FORMAT_INDEX, Qx);
 815   font = XFONT_OBJECT (font_object);
 816   ((struct xfont_info *) font)->xfont = xfont;
 817   ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
 818   font->pixel_size = pixel_size;
 819   font->driver = &xfont_driver;
 820   font->encoding_charset = encoding->id;
 821   font->repertory_charset = repertory ? repertory->id : -1;
 822   font->ascent = xfont->ascent;
 823   font->descent = xfont->descent;
 824   font->height = font->ascent + font->descent;
 825   font->min_width = xfont->min_bounds.width;
 826   if (xfont->min_bounds.width == xfont->max_bounds.width)
 827     {
 828       /* Fixed width font.  */
 829       font->average_width = font->space_width = xfont->min_bounds.width;
 830     }
 831   else
 832     {
 833       XCharStruct *pcm;
 834       XChar2b char2b;
 835       Lisp_Object val;
 836
 837       char2b.byte1 = 0x00, char2b.byte2 = 0x20;
 838       pcm = xfont_get_pcm (xfont, &char2b);
 839       if (pcm)
 840         font->space_width = pcm->width;
 841       else
 842         font->space_width = 0;
 843
 844       val = Ffont_get (font_object, QCavgwidth);
 845       if (INTEGERP (val))
 846         font->average_width = XINT (val) / 10;
 847       if (font->average_width < 0)
 848         font->average_width = - font->average_width;
 849       else
 850         {
 851           if (font->average_width == 0
 852               && encoding->ascii_compatible_p)
 853             {
 854               int width = font->space_width, n = pcm != NULL;
 855
 856               for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
 857                 if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
 858                   width += pcm->width, n++;
 859               if (n > 0)
 860                 font->average_width = width / n;
 861             }
 862           if (font->average_width == 0)
 863             /* No easy way other than this to get a reasonable
 864                average_width.  */
 865             font->average_width
 866               = (xfont->min_bounds.width + xfont->max_bounds.width) / 2;
 867         }
 868     }
 869
 870   BLOCK_INPUT;
 871   font->underline_thickness
 872     = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
 873        ? (long) value : 0);
 874   font->underline_position
 875     = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
 876        ? (long) value : -1);
 877   font->baseline_offset
 878     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
 879        ? (long) value : 0);
 880   font->relative_compose
 881     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
 882        ? (long) value : 0);
 883   font->default_ascent
 884     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
 885        ? (long) value : 0);
 886   UNBLOCK_INPUT;
 887
 888   if (NILP (fullname))
 889     fullname = AREF (font_object, FONT_NAME_INDEX);
 890   font->vertical_centering
 891     = (STRINGP (Vvertical_centering_font_regexp)
 892        && (fast_string_match_ignore_case
 893            (Vvertical_centering_font_regexp, fullname) >= 0));
 894
 895   return font_object;
 896 }
 897
 898 static void
 899 xfont_close (FRAME_PTR f, struct font *font)
 900 {
 901   BLOCK_INPUT;
 902   XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
 903   UNBLOCK_INPUT;
 904 }
 905
 906 static int
 907 xfont_prepare_face (FRAME_PTR f, struct face *face)
 908 {
 909   BLOCK_INPUT;
 910   XSetFont (FRAME_X_DISPLAY (f), face->gc,
 911             ((struct xfont_info *) face->font)->xfont->fid);
 912   UNBLOCK_INPUT;
 913
 914   return 0;
 915 }
 916
 917 static int
 918 xfont_has_char (Lisp_Object font, int c)
 919 {
 920   Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
 921   struct charset *encoding;
 922   struct charset *repertory = NULL;
 923
 924   if (EQ (registry, Qiso10646_1))
 925     {
 926       encoding = CHARSET_FROM_ID (charset_unicode);
 927       /* We use a font of `ja' and `ko' adstyle only for a character
 928          in JISX0208 and KSC5601 charsets respectively.  */
 929       if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
 930           && charset_jisx0208 >= 0)
 931         repertory = CHARSET_FROM_ID (charset_jisx0208);
 932       else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
 933                && charset_ksc5601 >= 0)
 934         repertory = CHARSET_FROM_ID (charset_ksc5601);
 935     }
 936   else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 937     /* Unknown REGISTRY, not usable.  */
 938     return 0;
 939   if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
 940     return 1;
 941   if (! repertory)
 942     return -1;
 943   return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
 944 }
 945
 946 static unsigned
 947 xfont_encode_char (struct font *font, int c)
 948 {
 949   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 950   struct charset *charset;
 951   unsigned code;
 952   XChar2b char2b;
 953
 954   charset = CHARSET_FROM_ID (font->encoding_charset);
 955   code = ENCODE_CHAR (charset, c);
 956   if (code == CHARSET_INVALID_CODE (charset))
 957     return FONT_INVALID_CODE;
 958   if (font->repertory_charset >= 0)
 959     {
 960       charset = CHARSET_FROM_ID (font->repertory_charset);
 961       return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
 962               ? code : FONT_INVALID_CODE);
 963     }
 964   char2b.byte1 = code >> 8;
 965   char2b.byte2 = code & 0xFF;
 966   return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
 967 }
 968
 969 static int
 970 xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
 971 {
 972   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 973   int width = 0;
 974   int i, first;
 975
 976   if (metrics)
 977     memset (metrics, 0, sizeof (struct font_metrics));
 978   for (i = 0, first = 1; i < nglyphs; i++)
 979     {
 980       XChar2b char2b;
 981       static XCharStruct *pcm;
 982
 983       if (code[i] >= 0x10000)
 984         continue;
 985       char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
 986       pcm = xfont_get_pcm (xfont, &char2b);
 987       if (! pcm)
 988         continue;
 989       if (first)
 990         {
 991           if (metrics)
 992             {
 993               metrics->lbearing = pcm->lbearing;
 994               metrics->rbearing = pcm->rbearing;
 995               metrics->ascent = pcm->ascent;
 996               metrics->descent = pcm->descent;
 997             }
 998           first = 0;
 999         }
1000       else
1001         {
1002           if (metrics)
1003             {
1004               if (metrics->lbearing > width + pcm->lbearing)
1005                 metrics->lbearing = width + pcm->lbearing;
1006               if (metrics->rbearing < width + pcm->rbearing)
1007                 metrics->rbearing = width + pcm->rbearing;
1008               if (metrics->ascent < pcm->ascent)
1009                 metrics->ascent = pcm->ascent;
1010               if (metrics->descent < pcm->descent)
1011                 metrics->descent = pcm->descent;
1012             }
1013         }
1014       width += pcm->width;
1015     }
1016   if (metrics)
1017     metrics->width = width;
1018   return width;
1019 }
1020
1021 static int
1022 xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
1023 {
1024   XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1025   int len = to - from;
1026   GC gc = s->gc;
1027   int i;
1028
1029   if (s->gc != s->face->gc)
1030     {
1031       BLOCK_INPUT;
1032       XSetFont (s->display, gc, xfont->fid);
1033       UNBLOCK_INPUT;
1034     }
1035
1036   if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1037     {
1038       char *str;
1039       USE_SAFE_ALLOCA;
1040
1041       SAFE_ALLOCA (str, char *, len);
1042       for (i = 0; i < len ; i++)
1043         str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1044       BLOCK_INPUT;
1045       if (with_background > 0)
1046         {
1047           if (s->padding_p)
1048             for (i = 0; i < len; i++)
1049               XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1050                                 gc, x + i, y, str + i, 1);
1051           else
1052             XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1053                               gc, x, y, str, len);
1054         }
1055       else
1056         {
1057           if (s->padding_p)
1058             for (i = 0; i < len; i++)
1059               XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1060                            gc, x + i, y, str + i, 1);
1061           else
1062             XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1063                          gc, x, y, str, len);
1064         }
1065       UNBLOCK_INPUT;
1066       SAFE_FREE ();
1067       return s->nchars;
1068     }
1069
1070   BLOCK_INPUT;
1071   if (with_background > 0)
1072     {
1073       if (s->padding_p)
1074         for (i = 0; i < len; i++)
1075           XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1076                               gc, x + i, y, s->char2b + from + i, 1);
1077       else
1078         XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1079                             gc, x, y, s->char2b + from, len);
1080     }
1081   else
1082     {
1083       if (s->padding_p)
1084         for (i = 0; i < len; i++)
1085           XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1086                          gc, x + i, y, s->char2b + from + i, 1);
1087       else
1088         XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1089                        gc, x, y, s->char2b + from, len);
1090     }
1091   UNBLOCK_INPUT;
1092
1093   return len;
1094 }
1095
1096 static int
1097 xfont_check (FRAME_PTR f, struct font *font)
1098 {
1099   struct xfont_info *xfont = (struct xfont_info *) font;
1100
1101   return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1102 }
1103
1104 \f
1105 void
1106 syms_of_xfont (void)
1107 {
1108   staticpro (&xfont_scripts_cache);
1109   { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1110        is called fairly late, when QCtest and Qequal are known to be set.  */
1111     Lisp_Object args[2];
1112     args[0] = QCtest;
1113     args[1] = Qequal;
1114     xfont_scripts_cache = Fmake_hash_table (2, args);
1115   }
1116   staticpro (&xfont_scratch_props);
1117   xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
1118   xfont_driver.type = Qx;
1119   register_font_driver (&xfont_driver, NULL);
1120 }