src/xfont.c

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