src/xfont.c

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