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   font->frame = f;
 810   ((struct xfont_info *) font)->xfont = xfont;
 811   ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
 812   font->pixel_size = pixel_size;
 813   font->driver = &xfont_driver;
 814   font->encoding_charset = encoding->id;
 815   font->repertory_charset = repertory ? repertory->id : -1;
 816   font->ascent = xfont->ascent;
 817   font->descent = xfont->descent;
 818   font->height = font->ascent + font->descent;
 819   font->min_width = xfont->min_bounds.width;
 820   font->max_width = xfont->max_bounds.width;
 821   if (xfont->min_bounds.width == xfont->max_bounds.width)
 822     {
 823       /* Fixed width font.  */
 824       font->average_width = font->space_width = xfont->min_bounds.width;
 825     }
 826   else
 827     {
 828       XCharStruct *pcm;
 829       XChar2b char2b;
 830       Lisp_Object val;
 831
 832       char2b.byte1 = 0x00, char2b.byte2 = 0x20;
 833       pcm = xfont_get_pcm (xfont, &char2b);
 834       if (pcm)
 835         font->space_width = pcm->width;
 836       else
 837         font->space_width = 0;
 838
 839       val = Ffont_get (font_object, QCavgwidth);
 840       if (INTEGERP (val))
 841         font->average_width = XINT (val) / 10;
 842       if (font->average_width < 0)
 843         font->average_width = - font->average_width;
 844       else
 845         {
 846           if (font->average_width == 0
 847               && encoding->ascii_compatible_p)
 848             {
 849               int width = font->space_width, n = pcm != NULL;
 850
 851               for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
 852                 if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
 853                   width += pcm->width, n++;
 854               if (n > 0)
 855                 font->average_width = width / n;
 856             }
 857           if (font->average_width == 0)
 858             /* No easy way other than this to get a reasonable
 859                average_width.  */
 860             font->average_width
 861               = (xfont->min_bounds.width + xfont->max_bounds.width) / 2;
 862         }
 863     }
 864
 865   block_input ();
 866   font->underline_thickness
 867     = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
 868        ? (long) value : 0);
 869   font->underline_position
 870     = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
 871        ? (long) value : -1);
 872   font->baseline_offset
 873     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
 874        ? (long) value : 0);
 875   font->relative_compose
 876     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
 877        ? (long) value : 0);
 878   font->default_ascent
 879     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
 880        ? (long) value : 0);
 881   unblock_input ();
 882
 883   if (NILP (fullname))
 884     fullname = AREF (font_object, FONT_NAME_INDEX);
 885   font->vertical_centering
 886     = (STRINGP (Vvertical_centering_font_regexp)
 887        && (fast_string_match_ignore_case
 888            (Vvertical_centering_font_regexp, fullname) >= 0));
 889
 890   return font_object;
 891 }
 892
 893 static void
 894 xfont_close (struct font *font)
 895 {
 896   struct xfont_info *xfi = (struct xfont_info *) font;
 897
 898   if (xfi->xfont)
 899     {
 900       block_input ();
 901       XFreeFont (xfi->display, xfi->xfont);
 902       unblock_input ();
 903       xfi->xfont = NULL;
 904     }
 905 }
 906
 907 static int
 908 xfont_prepare_face (struct frame *f, struct face *face)
 909 {
 910   block_input ();
 911   XSetFont (FRAME_X_DISPLAY (f), face->gc,
 912             ((struct xfont_info *) face->font)->xfont->fid);
 913   unblock_input ();
 914
 915   return 0;
 916 }
 917
 918 static int
 919 xfont_has_char (Lisp_Object font, int c)
 920 {
 921   Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
 922   struct charset *encoding;
 923   struct charset *repertory = NULL;
 924
 925   if (EQ (registry, Qiso10646_1))
 926     {
 927       encoding = CHARSET_FROM_ID (charset_unicode);
 928       /* We use a font of `ja' and `ko' adstyle only for a character
 929          in JISX0208 and KSC5601 charsets respectively.  */
 930       if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
 931           && charset_jisx0208 >= 0)
 932         repertory = CHARSET_FROM_ID (charset_jisx0208);
 933       else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
 934                && charset_ksc5601 >= 0)
 935         repertory = CHARSET_FROM_ID (charset_ksc5601);
 936     }
 937   else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 938     /* Unknown REGISTRY, not usable.  */
 939     return 0;
 940   if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
 941     return 1;
 942   if (! repertory)
 943     return -1;
 944   return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
 945 }
 946
 947 static unsigned
 948 xfont_encode_char (struct font *font, int c)
 949 {
 950   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 951   struct charset *charset;
 952   unsigned code;
 953   XChar2b char2b;
 954
 955   charset = CHARSET_FROM_ID (font->encoding_charset);
 956   code = ENCODE_CHAR (charset, c);
 957   if (code == CHARSET_INVALID_CODE (charset))
 958     return FONT_INVALID_CODE;
 959   if (font->repertory_charset >= 0)
 960     {
 961       charset = CHARSET_FROM_ID (font->repertory_charset);
 962       return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
 963               ? code : FONT_INVALID_CODE);
 964     }
 965   char2b.byte1 = code >> 8;
 966   char2b.byte2 = code & 0xFF;
 967   return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
 968 }
 969
 970 static int
 971 xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
 972 {
 973   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 974   int width = 0;
 975   int i, first;
 976
 977   if (metrics)
 978     memset (metrics, 0, sizeof (struct font_metrics));
 979   for (i = 0, first = 1; i < nglyphs; i++)
 980     {
 981       XChar2b char2b;
 982       static XCharStruct *pcm;
 983
 984       if (code[i] >= 0x10000)
 985         continue;
 986       char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
 987       pcm = xfont_get_pcm (xfont, &char2b);
 988       if (! pcm)
 989         continue;
 990       if (first)
 991         {
 992           if (metrics)
 993             {
 994               metrics->lbearing = pcm->lbearing;
 995               metrics->rbearing = pcm->rbearing;
 996               metrics->ascent = pcm->ascent;
 997               metrics->descent = pcm->descent;
 998             }
 999           first = 0;
1000         }
1001       else
1002         {
1003           if (metrics)
1004             {
1005               if (metrics->lbearing > width + pcm->lbearing)
1006                 metrics->lbearing = width + pcm->lbearing;
1007               if (metrics->rbearing < width + pcm->rbearing)
1008                 metrics->rbearing = width + pcm->rbearing;
1009               if (metrics->ascent < pcm->ascent)
1010                 metrics->ascent = pcm->ascent;
1011               if (metrics->descent < pcm->descent)
1012                 metrics->descent = pcm->descent;
1013             }
1014         }
1015       width += pcm->width;
1016     }
1017   if (metrics)
1018     metrics->width = width;
1019   return width;
1020 }
1021
1022 static int
1023 xfont_draw (struct glyph_string *s, int from, int to, int x, int y,
1024             bool with_background)
1025 {
1026   XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1027   int len = to - from;
1028   GC gc = s->gc;
1029   int i;
1030
1031   if (s->gc != s->face->gc)
1032     {
1033       block_input ();
1034       XSetFont (s->display, gc, xfont->fid);
1035       unblock_input ();
1036     }
1037
1038   if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1039     {
1040       USE_SAFE_ALLOCA;
1041       char *str = SAFE_ALLOCA (len);
1042       for (i = 0; i < len ; i++)
1043         str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1044       block_input ();
1045       if (with_background)
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)
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 (struct frame *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 }