src/xfont.c

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