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 (FRAME_PTR);
 118 static Lisp_Object xfont_list (Lisp_Object, Lisp_Object);
 119 static Lisp_Object xfont_match (Lisp_Object, Lisp_Object);
 120 static Lisp_Object xfont_list_family (Lisp_Object);
 121 static Lisp_Object xfont_open (FRAME_PTR, Lisp_Object, int);
 122 static void xfont_close (FRAME_PTR, struct font *);
 123 static int xfont_prepare_face (FRAME_PTR, 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 (FRAME_PTR, 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 (FRAME_PTR f)
 156 {
 157   Display_Info *dpyinfo = FRAME_X_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 Fcons (intern ("kana"), Fcons (intern ("han"), Qnil));
 299   if (EQ (AREF (props, 2), Qko))
 300     return Fcons (intern ("hangul"), Qnil);
 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 (Lisp_Object frame, Lisp_Object spec)
 490 {
 491   FRAME_PTR f = XFRAME (frame);
 492   Display *display = FRAME_X_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 (Lisp_Object frame, Lisp_Object spec)
 569 {
 570   FRAME_PTR f = XFRAME (frame);
 571   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
 572   Lisp_Object extra, val, entity;
 573   char name[512];
 574   XFontStruct *xfont;
 575   unsigned long value;
 576
 577   extra = AREF (spec, FONT_EXTRA_INDEX);
 578   val = assq_no_quit (QCname, extra);
 579   if (! CONSP (val) || ! STRINGP (XCDR (val)))
 580     {
 581       if (font_unparse_xlfd (spec, 0, name, 512) < 0)
 582         return Qnil;
 583     }
 584   else if (SBYTES (XCDR (val)) < 512)
 585     memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
 586   else
 587     return Qnil;
 588   if (xfont_encode_coding_xlfd (name) < 0)
 589     return Qnil;
 590
 591   block_input ();
 592   entity = Qnil;
 593   xfont = XLoadQueryFont (display, name);
 594   if (xfont)
 595     {
 596       if (XGetFontProperty (xfont, XA_FONT, &value))
 597         {
 598           char *s;
 599
 600           s = (char *) XGetAtomName (display, (Atom) value);
 601
 602           /* If DXPC (a Differential X Protocol Compressor)
 603              Ver.3.7 is running, XGetAtomName will return null
 604              string.  We must avoid such a name.  */
 605           if (*s)
 606             {
 607               ptrdiff_t len;
 608               entity = font_make_entity ();
 609               ASET (entity, FONT_TYPE_INDEX, Qx);
 610               len = xfont_decode_coding_xlfd (s, -1, name);
 611               if (font_parse_xlfd (name, len, entity) < 0)
 612                 entity = Qnil;
 613             }
 614           XFree (s);
 615         }
 616       XFreeFont (display, xfont);
 617     }
 618   unblock_input ();
 619
 620   FONT_ADD_LOG ("xfont-match", spec, entity);
 621   return entity;
 622 }
 623
 624 static Lisp_Object
 625 xfont_list_family (Lisp_Object frame)
 626 {
 627   FRAME_PTR f = XFRAME (frame);
 628   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 629   char **names;
 630   int num_fonts, i;
 631   Lisp_Object list;
 632   char *last_family IF_LINT (= 0);
 633   int last_len;
 634
 635   block_input ();
 636   x_catch_errors (dpyinfo->display);
 637   names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
 638                       0x8000, &num_fonts);
 639   if (x_had_errors_p (dpyinfo->display))
 640     {
 641       /* This error is perhaps due to insufficient memory on X server.
 642          Let's just ignore it.  */
 643       x_clear_errors (dpyinfo->display);
 644       num_fonts = 0;
 645     }
 646
 647   list = Qnil;
 648   for (i = 0, last_len = 0; i < num_fonts; i++)
 649     {
 650       char *p0 = names[i], *p1, buf[512];
 651       Lisp_Object family;
 652       int decoded_len;
 653
 654       p0++;                     /* skip the leading '-' */
 655       while (*p0 && *p0 != '-') p0++; /* skip foundry */
 656       if (! *p0)
 657         continue;
 658       p1 = ++p0;
 659       while (*p1 && *p1 != '-') p1++; /* find the end of family */
 660       if (! *p1 || p1 == p0)
 661         continue;
 662       if (last_len == p1 - p0
 663           && memcmp (last_family, p0, last_len) == 0)
 664         continue;
 665       last_len = p1 - p0;
 666       last_family = p0;
 667
 668       decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
 669       family = font_intern_prop (p0, decoded_len, 1);
 670       if (NILP (assq_no_quit (family, list)))
 671         list = Fcons (family, list);
 672     }
 673
 674   XFreeFontNames (names);
 675   x_uncatch_errors ();
 676   unblock_input ();
 677
 678   return list;
 679 }
 680
 681 static Lisp_Object
 682 xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
 683 {
 684   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 685   Display *display = dpyinfo->display;
 686   char name[512];
 687   int len;
 688   unsigned long value;
 689   Lisp_Object registry;
 690   struct charset *encoding, *repertory;
 691   Lisp_Object font_object, fullname;
 692   struct font *font;
 693   XFontStruct *xfont;
 694
 695   /* At first, check if we know how to encode characters for this
 696      font.  */
 697   registry = AREF (entity, FONT_REGISTRY_INDEX);
 698   if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 699     {
 700       FONT_ADD_LOG ("  x:unknown registry", registry, Qnil);
 701       return Qnil;
 702     }
 703
 704   if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
 705     pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
 706   else if (pixel_size == 0)
 707     {
 708       if (FRAME_FONT (f))
 709         pixel_size = FRAME_FONT (f)->pixel_size;
 710       else
 711         pixel_size = 14;
 712     }
 713   len = font_unparse_xlfd (entity, pixel_size, name, 512);
 714   if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 715     {
 716       FONT_ADD_LOG ("  x:unparse failed", entity, Qnil);
 717       return Qnil;
 718     }
 719
 720   block_input ();
 721   x_catch_errors (display);
 722   xfont = XLoadQueryFont (display, name);
 723   if (x_had_errors_p (display))
 724     {
 725       /* This error is perhaps due to insufficient memory on X server.
 726          Let's just ignore it.  */
 727       x_clear_errors (display);
 728       xfont = NULL;
 729     }
 730   else if (! xfont)
 731     {
 732       /* Some version of X lists:
 733            -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
 734            -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
 735          but can open only:
 736            -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
 737          and
 738            -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
 739          So, we try again with wildcards in RESX and RESY.  */
 740       Lisp_Object temp;
 741
 742       temp = copy_font_spec (entity);
 743       ASET (temp, FONT_DPI_INDEX, Qnil);
 744       len = font_unparse_xlfd (temp, pixel_size, name, 512);
 745       if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 746         {
 747           FONT_ADD_LOG ("  x:unparse failed", temp, Qnil);
 748           return Qnil;
 749         }
 750       xfont = XLoadQueryFont (display, name);
 751       if (x_had_errors_p (display))
 752         {
 753           /* This error is perhaps due to insufficient memory on X server.
 754              Let's just ignore it.  */
 755           x_clear_errors (display);
 756           xfont = NULL;
 757         }
 758     }
 759   fullname = Qnil;
 760   /* Try to get the full name of FONT.  */
 761   if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
 762     {
 763       char *p0, *p;
 764       int dashes = 0;
 765
 766       p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
 767       /* Count the number of dashes in the "full name".
 768          If it is too few, this isn't really the font's full name,
 769          so don't use it.
 770          In X11R4, the fonts did not come with their canonical names
 771          stored in them.  */
 772       while (*p)
 773         {
 774           if (*p == '-')
 775             dashes++;
 776           p++;
 777         }
 778
 779       if (dashes >= 13)
 780         {
 781           len = xfont_decode_coding_xlfd (p0, -1, name);
 782           fullname = Fdowncase (make_string (name, len));
 783         }
 784       XFree (p0);
 785     }
 786   x_uncatch_errors ();
 787   unblock_input ();
 788
 789   if (! xfont)
 790     {
 791       FONT_ADD_LOG ("  x:open failed", build_string (name), Qnil);
 792       return Qnil;
 793     }
 794
 795   font_object = font_make_object (VECSIZE (struct xfont_info),
 796                                   entity, pixel_size);
 797   ASET (font_object, FONT_TYPE_INDEX, Qx);
 798   if (STRINGP (fullname))
 799     {
 800       font_parse_xlfd (SSDATA (fullname), SBYTES (fullname), font_object);
 801       ASET (font_object, FONT_NAME_INDEX, fullname);
 802     }
 803   else
 804     {
 805       char buf[512];
 806
 807       len = xfont_decode_coding_xlfd (name, -1, buf);
 808       ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
 809     }
 810   ASET (font_object, FONT_FULLNAME_INDEX, fullname);
 811   ASET (font_object, FONT_FILE_INDEX, Qnil);
 812   ASET (font_object, FONT_FORMAT_INDEX, Qx);
 813   font = XFONT_OBJECT (font_object);
 814   ((struct xfont_info *) font)->xfont = xfont;
 815   ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
 816   font->pixel_size = pixel_size;
 817   font->driver = &xfont_driver;
 818   font->encoding_charset = encoding->id;
 819   font->repertory_charset = repertory ? repertory->id : -1;
 820   font->ascent = xfont->ascent;
 821   font->descent = xfont->descent;
 822   font->height = font->ascent + font->descent;
 823   font->min_width = xfont->min_bounds.width;
 824   font->max_width = xfont->max_bounds.width;
 825   if (xfont->min_bounds.width == xfont->max_bounds.width)
 826     {
 827       /* Fixed width font.  */
 828       font->average_width = font->space_width = xfont->min_bounds.width;
 829     }
 830   else
 831     {
 832       XCharStruct *pcm;
 833       XChar2b char2b;
 834       Lisp_Object val;
 835
 836       char2b.byte1 = 0x00, char2b.byte2 = 0x20;
 837       pcm = xfont_get_pcm (xfont, &char2b);
 838       if (pcm)
 839         font->space_width = pcm->width;
 840       else
 841         font->space_width = 0;
 842
 843       val = Ffont_get (font_object, QCavgwidth);
 844       if (INTEGERP (val))
 845         font->average_width = XINT (val) / 10;
 846       if (font->average_width < 0)
 847         font->average_width = - font->average_width;
 848       else
 849         {
 850           if (font->average_width == 0
 851               && encoding->ascii_compatible_p)
 852             {
 853               int width = font->space_width, n = pcm != NULL;
 854
 855               for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
 856                 if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
 857                   width += pcm->width, n++;
 858               if (n > 0)
 859                 font->average_width = width / n;
 860             }
 861           if (font->average_width == 0)
 862             /* No easy way other than this to get a reasonable
 863                average_width.  */
 864             font->average_width
 865               = (xfont->min_bounds.width + xfont->max_bounds.width) / 2;
 866         }
 867     }
 868
 869   block_input ();
 870   font->underline_thickness
 871     = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
 872        ? (long) value : 0);
 873   font->underline_position
 874     = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
 875        ? (long) value : -1);
 876   font->baseline_offset
 877     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
 878        ? (long) value : 0);
 879   font->relative_compose
 880     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
 881        ? (long) value : 0);
 882   font->default_ascent
 883     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
 884        ? (long) value : 0);
 885   unblock_input ();
 886
 887   if (NILP (fullname))
 888     fullname = AREF (font_object, FONT_NAME_INDEX);
 889   font->vertical_centering
 890     = (STRINGP (Vvertical_centering_font_regexp)
 891        && (fast_string_match_ignore_case
 892            (Vvertical_centering_font_regexp, fullname) >= 0));
 893
 894   return font_object;
 895 }
 896
 897 static void
 898 xfont_close (FRAME_PTR f, struct font *font)
 899 {
 900   block_input ();
 901   XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
 902   unblock_input ();
 903 }
 904
 905 static int
 906 xfont_prepare_face (FRAME_PTR f, struct face *face)
 907 {
 908   block_input ();
 909   XSetFont (FRAME_X_DISPLAY (f), face->gc,
 910             ((struct xfont_info *) face->font)->xfont->fid);
 911   unblock_input ();
 912
 913   return 0;
 914 }
 915
 916 static int
 917 xfont_has_char (Lisp_Object font, int c)
 918 {
 919   Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
 920   struct charset *encoding;
 921   struct charset *repertory = NULL;
 922
 923   if (EQ (registry, Qiso10646_1))
 924     {
 925       encoding = CHARSET_FROM_ID (charset_unicode);
 926       /* We use a font of `ja' and `ko' adstyle only for a character
 927          in JISX0208 and KSC5601 charsets respectively.  */
 928       if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
 929           && charset_jisx0208 >= 0)
 930         repertory = CHARSET_FROM_ID (charset_jisx0208);
 931       else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
 932                && charset_ksc5601 >= 0)
 933         repertory = CHARSET_FROM_ID (charset_ksc5601);
 934     }
 935   else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 936     /* Unknown REGISTRY, not usable.  */
 937     return 0;
 938   if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
 939     return 1;
 940   if (! repertory)
 941     return -1;
 942   return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
 943 }
 944
 945 static unsigned
 946 xfont_encode_char (struct font *font, int c)
 947 {
 948   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 949   struct charset *charset;
 950   unsigned code;
 951   XChar2b char2b;
 952
 953   charset = CHARSET_FROM_ID (font->encoding_charset);
 954   code = ENCODE_CHAR (charset, c);
 955   if (code == CHARSET_INVALID_CODE (charset))
 956     return FONT_INVALID_CODE;
 957   if (font->repertory_charset >= 0)
 958     {
 959       charset = CHARSET_FROM_ID (font->repertory_charset);
 960       return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
 961               ? code : FONT_INVALID_CODE);
 962     }
 963   char2b.byte1 = code >> 8;
 964   char2b.byte2 = code & 0xFF;
 965   return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
 966 }
 967
 968 static int
 969 xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
 970 {
 971   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 972   int width = 0;
 973   int i, first;
 974
 975   if (metrics)
 976     memset (metrics, 0, sizeof (struct font_metrics));
 977   for (i = 0, first = 1; i < nglyphs; i++)
 978     {
 979       XChar2b char2b;
 980       static XCharStruct *pcm;
 981
 982       if (code[i] >= 0x10000)
 983         continue;
 984       char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
 985       pcm = xfont_get_pcm (xfont, &char2b);
 986       if (! pcm)
 987         continue;
 988       if (first)
 989         {
 990           if (metrics)
 991             {
 992               metrics->lbearing = pcm->lbearing;
 993               metrics->rbearing = pcm->rbearing;
 994               metrics->ascent = pcm->ascent;
 995               metrics->descent = pcm->descent;
 996             }
 997           first = 0;
 998         }
 999       else
1000         {
1001           if (metrics)
1002             {
1003               if (metrics->lbearing > width + pcm->lbearing)
1004                 metrics->lbearing = width + pcm->lbearing;
1005               if (metrics->rbearing < width + pcm->rbearing)
1006                 metrics->rbearing = width + pcm->rbearing;
1007               if (metrics->ascent < pcm->ascent)
1008                 metrics->ascent = pcm->ascent;
1009               if (metrics->descent < pcm->descent)
1010                 metrics->descent = pcm->descent;
1011             }
1012         }
1013       width += pcm->width;
1014     }
1015   if (metrics)
1016     metrics->width = width;
1017   return width;
1018 }
1019
1020 static int
1021 xfont_draw (struct glyph_string *s, int from, int to, int x, int y,
1022             bool with_background)
1023 {
1024   XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1025   int len = to - from;
1026   GC gc = s->gc;
1027   int i;
1028
1029   if (s->gc != s->face->gc)
1030     {
1031       block_input ();
1032       XSetFont (s->display, gc, xfont->fid);
1033       unblock_input ();
1034     }
1035
1036   if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1037     {
1038       USE_SAFE_ALLOCA;
1039       char *str = SAFE_ALLOCA (len);
1040       for (i = 0; i < len ; i++)
1041         str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1042       block_input ();
1043       if (with_background)
1044         {
1045           if (s->padding_p)
1046             for (i = 0; i < len; i++)
1047               XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1048                                 gc, x + i, y, str + i, 1);
1049           else
1050             XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1051                               gc, x, y, str, len);
1052         }
1053       else
1054         {
1055           if (s->padding_p)
1056             for (i = 0; i < len; i++)
1057               XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1058                            gc, x + i, y, str + i, 1);
1059           else
1060             XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1061                          gc, x, y, str, len);
1062         }
1063       unblock_input ();
1064       SAFE_FREE ();
1065       return s->nchars;
1066     }
1067
1068   block_input ();
1069   if (with_background)
1070     {
1071       if (s->padding_p)
1072         for (i = 0; i < len; i++)
1073           XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1074                               gc, x + i, y, s->char2b + from + i, 1);
1075       else
1076         XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1077                             gc, x, y, s->char2b + from, len);
1078     }
1079   else
1080     {
1081       if (s->padding_p)
1082         for (i = 0; i < len; i++)
1083           XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1084                          gc, x + i, y, s->char2b + from + i, 1);
1085       else
1086         XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1087                        gc, x, y, s->char2b + from, len);
1088     }
1089   unblock_input ();
1090
1091   return len;
1092 }
1093
1094 static int
1095 xfont_check (FRAME_PTR f, struct font *font)
1096 {
1097   struct xfont_info *xfont = (struct xfont_info *) font;
1098
1099   return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1100 }
1101
1102 \f
1103 void
1104 syms_of_xfont (void)
1105 {
1106   staticpro (&xfont_scripts_cache);
1107   { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1108        is called fairly late, when QCtest and Qequal are known to be set.  */
1109     Lisp_Object args[2];
1110     args[0] = QCtest;
1111     args[1] = Qequal;
1112     xfont_scripts_cache = Fmake_hash_table (2, args);
1113   }
1114   staticpro (&xfont_scratch_props);
1115   xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
1116   xfont_driver.type = Qx;
1117   register_font_driver (&xfont_driver, NULL);
1118 }