src/xfont.c

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