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   eassert (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 ptrdiff_t
 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         ASET (xfont_scratch_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           ptrdiff_t len;
 401           Lisp_Object entity;
 402
 403           if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
 404             continue;
 405           entity = font_make_entity ();
 406           len = xfont_decode_coding_xlfd (indices[i], -1, buf);
 407           if (font_parse_xlfd (buf, len, entity) < 0)
 408             continue;
 409           ASET (entity, FONT_TYPE_INDEX, Qx);
 410           /* Avoid auto-scaled fonts.  */
 411           if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
 412               && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
 413               && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
 414               && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
 415             continue;
 416           /* Avoid not-allowed scalable fonts.  */
 417           if (NILP (Vscalable_fonts_allowed))
 418             {
 419               int size = 0;
 420
 421               if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
 422                 size = XINT (AREF (entity, FONT_SIZE_INDEX));
 423               else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
 424                 size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
 425               if (size == 0)
 426                 continue;
 427             }
 428           else if (CONSP (Vscalable_fonts_allowed))
 429             {
 430               Lisp_Object tail, elt;
 431
 432               for (tail = Vscalable_fonts_allowed; CONSP (tail);
 433                    tail = XCDR (tail))
 434                 {
 435                   elt = XCAR (tail);
 436                   if (STRINGP (elt)
 437                       && fast_c_string_match_ignore_case (elt, indices[i],
 438                                                           len) >= 0)
 439                     break;
 440                 }
 441               if (! CONSP (tail))
 442                 continue;
 443             }
 444
 445           /* Avoid fonts of invalid registry.  */
 446           if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
 447             continue;
 448
 449           /* Update encoding and repertory if necessary.  */
 450           if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
 451             {
 452               registry = AREF (entity, FONT_REGISTRY_INDEX);
 453               if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 454                 encoding = NULL;
 455             }
 456           if (! encoding)
 457             /* Unknown REGISTRY, not supported.  */
 458             continue;
 459           if (repertory)
 460             {
 461               if (NILP (script)
 462                   || xfont_chars_supported (chars, NULL, encoding, repertory))
 463                 list = Fcons (entity, list);
 464               continue;
 465             }
 466           if (memcmp (props, aref_addr (entity, FONT_FOUNDRY_INDEX),
 467                       word_size * 7)
 468               || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
 469             {
 470               vcopy (xfont_scratch_props, 0,
 471                      aref_addr (entity, FONT_FOUNDRY_INDEX), 7);
 472               ASET (xfont_scratch_props, 7, AREF (entity, FONT_SPACING_INDEX));
 473               scripts = xfont_supported_scripts (display, indices[i],
 474                                                  xfont_scratch_props, encoding);
 475             }
 476           if (NILP (script)
 477               || ! NILP (Fmemq (script, scripts)))
 478             list = Fcons (entity, list);
 479         }
 480       XFreeFontNames (names);
 481     }
 482
 483   x_uncatch_errors ();
 484   UNBLOCK_INPUT;
 485
 486   FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
 487   return list;
 488 }
 489
 490 static Lisp_Object
 491 xfont_list (Lisp_Object frame, Lisp_Object spec)
 492 {
 493   FRAME_PTR f = XFRAME (frame);
 494   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
 495   Lisp_Object registry, list, val, extra, script;
 496   int len;
 497   /* Large enough to contain the longest XLFD (255 bytes) in UTF-8.  */
 498   char name[512];
 499
 500   extra = AREF (spec, FONT_EXTRA_INDEX);
 501   if (CONSP (extra))
 502     {
 503       val = assq_no_quit (QCotf, extra);
 504       if (! NILP (val))
 505         return Qnil;
 506       val = assq_no_quit (QClang, extra);
 507       if (! NILP (val))
 508         return Qnil;
 509     }
 510
 511   registry = AREF (spec, FONT_REGISTRY_INDEX);
 512   len = font_unparse_xlfd (spec, 0, name, 512);
 513   if (len < 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 514     return Qnil;
 515
 516   val = assq_no_quit (QCscript, extra);
 517   script = CDR (val);
 518   list = xfont_list_pattern (display, name, registry, script);
 519   if (NILP (list) && NILP (registry))
 520     {
 521       /* Try iso10646-1 */
 522       char *r = name + len - 9; /* 9 == strlen (iso8859-1) */
 523
 524       if (r - name + 10 < 256)  /* 10 == strlen (iso10646-1) */
 525         {
 526           strcpy (r, "iso10646-1");
 527           list = xfont_list_pattern (display, name, Qiso10646_1, script);
 528         }
 529     }
 530   if (NILP (list) && ! NILP (registry))
 531     {
 532       /* Try alternate registries.  */
 533       Lisp_Object alter;
 534
 535       if ((alter = Fassoc (SYMBOL_NAME (registry),
 536                            Vface_alternative_font_registry_alist),
 537            CONSP (alter)))
 538         {
 539           /* Pointer to REGISTRY-ENCODING field.  */
 540           char *r = name + len - SBYTES (SYMBOL_NAME (registry));
 541
 542           for (alter = XCDR (alter); CONSP (alter); alter = XCDR (alter))
 543             if (STRINGP (XCAR (alter))
 544                 && ((r - name) + SBYTES (XCAR (alter))) < 256)
 545               {
 546                 strcpy (r, SSDATA (XCAR (alter)));
 547                 list = xfont_list_pattern (display, name, registry, script);
 548                 if (! NILP (list))
 549                   break;
 550               }
 551         }
 552     }
 553   if (NILP (list))
 554     {
 555       /* Try alias.  */
 556       val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
 557       if (CONSP (val) && STRINGP (XCDR (val)) && SBYTES (XCDR (val)) < 512)
 558         {
 559           memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
 560           if (xfont_encode_coding_xlfd (name) < 0)
 561             return Qnil;
 562           list = xfont_list_pattern (display, name, registry, script);
 563         }
 564     }
 565
 566   return list;
 567 }
 568
 569 static Lisp_Object
 570 xfont_match (Lisp_Object frame, Lisp_Object spec)
 571 {
 572   FRAME_PTR f = XFRAME (frame);
 573   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
 574   Lisp_Object extra, val, entity;
 575   char name[512];
 576   XFontStruct *xfont;
 577   unsigned long value;
 578
 579   extra = AREF (spec, FONT_EXTRA_INDEX);
 580   val = assq_no_quit (QCname, extra);
 581   if (! CONSP (val) || ! STRINGP (XCDR (val)))
 582     {
 583       if (font_unparse_xlfd (spec, 0, name, 512) < 0)
 584         return Qnil;
 585     }
 586   else if (SBYTES (XCDR (val)) < 512)
 587     memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
 588   else
 589     return Qnil;
 590   if (xfont_encode_coding_xlfd (name) < 0)
 591     return Qnil;
 592
 593   BLOCK_INPUT;
 594   entity = Qnil;
 595   xfont = XLoadQueryFont (display, name);
 596   if (xfont)
 597     {
 598       if (XGetFontProperty (xfont, XA_FONT, &value))
 599         {
 600           char *s;
 601
 602           s = (char *) XGetAtomName (display, (Atom) value);
 603
 604           /* If DXPC (a Differential X Protocol Compressor)
 605              Ver.3.7 is running, XGetAtomName will return null
 606              string.  We must avoid such a name.  */
 607           if (*s)
 608             {
 609               ptrdiff_t len;
 610               entity = font_make_entity ();
 611               ASET (entity, FONT_TYPE_INDEX, Qx);
 612               len = xfont_decode_coding_xlfd (s, -1, name);
 613               if (font_parse_xlfd (name, len, entity) < 0)
 614                 entity = Qnil;
 615             }
 616           XFree (s);
 617         }
 618       XFreeFont (display, xfont);
 619     }
 620   UNBLOCK_INPUT;
 621
 622   FONT_ADD_LOG ("xfont-match", spec, entity);
 623   return entity;
 624 }
 625
 626 static Lisp_Object
 627 xfont_list_family (Lisp_Object frame)
 628 {
 629   FRAME_PTR f = XFRAME (frame);
 630   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 631   char **names;
 632   int num_fonts, i;
 633   Lisp_Object list;
 634   char *last_family IF_LINT (= 0);
 635   int last_len;
 636
 637   BLOCK_INPUT;
 638   x_catch_errors (dpyinfo->display);
 639   names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
 640                       0x8000, &num_fonts);
 641   if (x_had_errors_p (dpyinfo->display))
 642     {
 643       /* This error is perhaps due to insufficient memory on X server.
 644          Let's just ignore it.  */
 645       x_clear_errors (dpyinfo->display);
 646       num_fonts = 0;
 647     }
 648
 649   list = Qnil;
 650   for (i = 0, last_len = 0; i < num_fonts; i++)
 651     {
 652       char *p0 = names[i], *p1, buf[512];
 653       Lisp_Object family;
 654       int decoded_len;
 655
 656       p0++;                     /* skip the leading '-' */
 657       while (*p0 && *p0 != '-') p0++; /* skip foundry */
 658       if (! *p0)
 659         continue;
 660       p1 = ++p0;
 661       while (*p1 && *p1 != '-') p1++; /* find the end of family */
 662       if (! *p1 || p1 == p0)
 663         continue;
 664       if (last_len == p1 - p0
 665           && memcmp (last_family, p0, last_len) == 0)
 666         continue;
 667       last_len = p1 - p0;
 668       last_family = p0;
 669
 670       decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
 671       family = font_intern_prop (p0, decoded_len, 1);
 672       if (NILP (assq_no_quit (family, list)))
 673         list = Fcons (family, list);
 674     }
 675
 676   XFreeFontNames (names);
 677   x_uncatch_errors ();
 678   UNBLOCK_INPUT;
 679
 680   return list;
 681 }
 682
 683 static Lisp_Object
 684 xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
 685 {
 686   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 687   Display *display = dpyinfo->display;
 688   char name[512];
 689   int len;
 690   unsigned long value;
 691   Lisp_Object registry;
 692   struct charset *encoding, *repertory;
 693   Lisp_Object font_object, fullname;
 694   struct font *font;
 695   XFontStruct *xfont;
 696
 697   /* At first, check if we know how to encode characters for this
 698      font.  */
 699   registry = AREF (entity, FONT_REGISTRY_INDEX);
 700   if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 701     {
 702       FONT_ADD_LOG ("  x:unknown registry", registry, Qnil);
 703       return Qnil;
 704     }
 705
 706   if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
 707     pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
 708   else if (pixel_size == 0)
 709     {
 710       if (FRAME_FONT (f))
 711         pixel_size = FRAME_FONT (f)->pixel_size;
 712       else
 713         pixel_size = 14;
 714     }
 715   len = font_unparse_xlfd (entity, pixel_size, name, 512);
 716   if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 717     {
 718       FONT_ADD_LOG ("  x:unparse failed", entity, Qnil);
 719       return Qnil;
 720     }
 721
 722   BLOCK_INPUT;
 723   x_catch_errors (display);
 724   xfont = XLoadQueryFont (display, name);
 725   if (x_had_errors_p (display))
 726     {
 727       /* This error is perhaps due to insufficient memory on X server.
 728          Let's just ignore it.  */
 729       x_clear_errors (display);
 730       xfont = NULL;
 731     }
 732   else if (! xfont)
 733     {
 734       /* Some version of X lists:
 735            -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
 736            -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
 737          but can open only:
 738            -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
 739          and
 740            -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
 741          So, we try again with wildcards in RESX and RESY.  */
 742       Lisp_Object temp;
 743
 744       temp = copy_font_spec (entity);
 745       ASET (temp, FONT_DPI_INDEX, Qnil);
 746       len = font_unparse_xlfd (temp, pixel_size, name, 512);
 747       if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 748         {
 749           FONT_ADD_LOG ("  x:unparse failed", temp, Qnil);
 750           return Qnil;
 751         }
 752       xfont = XLoadQueryFont (display, name);
 753       if (x_had_errors_p (display))
 754         {
 755           /* This error is perhaps due to insufficient memory on X server.
 756              Let's just ignore it.  */
 757           x_clear_errors (display);
 758           xfont = NULL;
 759         }
 760     }
 761   fullname = Qnil;
 762   /* Try to get the full name of FONT.  */
 763   if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
 764     {
 765       char *p0, *p;
 766       int dashes = 0;
 767
 768       p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
 769       /* Count the number of dashes in the "full name".
 770          If it is too few, this isn't really the font's full name,
 771          so don't use it.
 772          In X11R4, the fonts did not come with their canonical names
 773          stored in them.  */
 774       while (*p)
 775         {
 776           if (*p == '-')
 777             dashes++;
 778           p++;
 779         }
 780
 781       if (dashes >= 13)
 782         {
 783           len = xfont_decode_coding_xlfd (p0, -1, name);
 784           fullname = Fdowncase (make_string (name, len));
 785         }
 786       XFree (p0);
 787     }
 788   x_uncatch_errors ();
 789   UNBLOCK_INPUT;
 790
 791   if (! xfont)
 792     {
 793       FONT_ADD_LOG ("  x:open failed", build_string (name), Qnil);
 794       return Qnil;
 795     }
 796
 797   font_object = font_make_object (VECSIZE (struct xfont_info),
 798                                   entity, pixel_size);
 799   ASET (font_object, FONT_TYPE_INDEX, Qx);
 800   if (STRINGP (fullname))
 801     {
 802       font_parse_xlfd (SSDATA (fullname), SBYTES (fullname), font_object);
 803       ASET (font_object, FONT_NAME_INDEX, fullname);
 804     }
 805   else
 806     {
 807       char buf[512];
 808
 809       len = xfont_decode_coding_xlfd (name, -1, buf);
 810       ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
 811     }
 812   ASET (font_object, FONT_FULLNAME_INDEX, fullname);
 813   ASET (font_object, FONT_FILE_INDEX, Qnil);
 814   ASET (font_object, FONT_FORMAT_INDEX, Qx);
 815   font = XFONT_OBJECT (font_object);
 816   ((struct xfont_info *) font)->xfont = xfont;
 817   ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
 818   font->pixel_size = pixel_size;
 819   font->driver = &xfont_driver;
 820   font->encoding_charset = encoding->id;
 821   font->repertory_charset = repertory ? repertory->id : -1;
 822   font->ascent = xfont->ascent;
 823   font->descent = xfont->descent;
 824   font->height = font->ascent + font->descent;
 825   font->min_width = xfont->min_bounds.width;
 826   font->max_width = xfont->max_bounds.width;
 827   if (xfont->min_bounds.width == xfont->max_bounds.width)
 828     {
 829       /* Fixed width font.  */
 830       font->average_width = font->space_width = xfont->min_bounds.width;
 831     }
 832   else
 833     {
 834       XCharStruct *pcm;
 835       XChar2b char2b;
 836       Lisp_Object val;
 837
 838       char2b.byte1 = 0x00, char2b.byte2 = 0x20;
 839       pcm = xfont_get_pcm (xfont, &char2b);
 840       if (pcm)
 841         font->space_width = pcm->width;
 842       else
 843         font->space_width = 0;
 844
 845       val = Ffont_get (font_object, QCavgwidth);
 846       if (INTEGERP (val))
 847         font->average_width = XINT (val) / 10;
 848       if (font->average_width < 0)
 849         font->average_width = - font->average_width;
 850       else
 851         {
 852           if (font->average_width == 0
 853               && encoding->ascii_compatible_p)
 854             {
 855               int width = font->space_width, n = pcm != NULL;
 856
 857               for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
 858                 if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
 859                   width += pcm->width, n++;
 860               if (n > 0)
 861                 font->average_width = width / n;
 862             }
 863           if (font->average_width == 0)
 864             /* No easy way other than this to get a reasonable
 865                average_width.  */
 866             font->average_width
 867               = (xfont->min_bounds.width + xfont->max_bounds.width) / 2;
 868         }
 869     }
 870
 871   BLOCK_INPUT;
 872   font->underline_thickness
 873     = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
 874        ? (long) value : 0);
 875   font->underline_position
 876     = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
 877        ? (long) value : -1);
 878   font->baseline_offset
 879     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
 880        ? (long) value : 0);
 881   font->relative_compose
 882     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
 883        ? (long) value : 0);
 884   font->default_ascent
 885     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
 886        ? (long) value : 0);
 887   UNBLOCK_INPUT;
 888
 889   if (NILP (fullname))
 890     fullname = AREF (font_object, FONT_NAME_INDEX);
 891   font->vertical_centering
 892     = (STRINGP (Vvertical_centering_font_regexp)
 893        && (fast_string_match_ignore_case
 894            (Vvertical_centering_font_regexp, fullname) >= 0));
 895
 896   return font_object;
 897 }
 898
 899 static void
 900 xfont_close (FRAME_PTR f, struct font *font)
 901 {
 902   BLOCK_INPUT;
 903   XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
 904   UNBLOCK_INPUT;
 905 }
 906
 907 static int
 908 xfont_prepare_face (FRAME_PTR f, struct face *face)
 909 {
 910   BLOCK_INPUT;
 911   XSetFont (FRAME_X_DISPLAY (f), face->gc,
 912             ((struct xfont_info *) face->font)->xfont->fid);
 913   UNBLOCK_INPUT;
 914
 915   return 0;
 916 }
 917
 918 static int
 919 xfont_has_char (Lisp_Object font, int c)
 920 {
 921   Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
 922   struct charset *encoding;
 923   struct charset *repertory = NULL;
 924
 925   if (EQ (registry, Qiso10646_1))
 926     {
 927       encoding = CHARSET_FROM_ID (charset_unicode);
 928       /* We use a font of `ja' and `ko' adstyle only for a character
 929          in JISX0208 and KSC5601 charsets respectively.  */
 930       if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
 931           && charset_jisx0208 >= 0)
 932         repertory = CHARSET_FROM_ID (charset_jisx0208);
 933       else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
 934                && charset_ksc5601 >= 0)
 935         repertory = CHARSET_FROM_ID (charset_ksc5601);
 936     }
 937   else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 938     /* Unknown REGISTRY, not usable.  */
 939     return 0;
 940   if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
 941     return 1;
 942   if (! repertory)
 943     return -1;
 944   return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
 945 }
 946
 947 static unsigned
 948 xfont_encode_char (struct font *font, int c)
 949 {
 950   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 951   struct charset *charset;
 952   unsigned code;
 953   XChar2b char2b;
 954
 955   charset = CHARSET_FROM_ID (font->encoding_charset);
 956   code = ENCODE_CHAR (charset, c);
 957   if (code == CHARSET_INVALID_CODE (charset))
 958     return FONT_INVALID_CODE;
 959   if (font->repertory_charset >= 0)
 960     {
 961       charset = CHARSET_FROM_ID (font->repertory_charset);
 962       return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
 963               ? code : FONT_INVALID_CODE);
 964     }
 965   char2b.byte1 = code >> 8;
 966   char2b.byte2 = code & 0xFF;
 967   return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
 968 }
 969
 970 static int
 971 xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
 972 {
 973   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 974   int width = 0;
 975   int i, first;
 976
 977   if (metrics)
 978     memset (metrics, 0, sizeof (struct font_metrics));
 979   for (i = 0, first = 1; i < nglyphs; i++)
 980     {
 981       XChar2b char2b;
 982       static XCharStruct *pcm;
 983
 984       if (code[i] >= 0x10000)
 985         continue;
 986       char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
 987       pcm = xfont_get_pcm (xfont, &char2b);
 988       if (! pcm)
 989         continue;
 990       if (first)
 991         {
 992           if (metrics)
 993             {
 994               metrics->lbearing = pcm->lbearing;
 995               metrics->rbearing = pcm->rbearing;
 996               metrics->ascent = pcm->ascent;
 997               metrics->descent = pcm->descent;
 998             }
 999           first = 0;
1000         }
1001       else
1002         {
1003           if (metrics)
1004             {
1005               if (metrics->lbearing > width + pcm->lbearing)
1006                 metrics->lbearing = width + pcm->lbearing;
1007               if (metrics->rbearing < width + pcm->rbearing)
1008                 metrics->rbearing = width + pcm->rbearing;
1009               if (metrics->ascent < pcm->ascent)
1010                 metrics->ascent = pcm->ascent;
1011               if (metrics->descent < pcm->descent)
1012                 metrics->descent = pcm->descent;
1013             }
1014         }
1015       width += pcm->width;
1016     }
1017   if (metrics)
1018     metrics->width = width;
1019   return width;
1020 }
1021
1022 static int
1023 xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
1024 {
1025   XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1026   int len = to - from;
1027   GC gc = s->gc;
1028   int i;
1029
1030   if (s->gc != s->face->gc)
1031     {
1032       BLOCK_INPUT;
1033       XSetFont (s->display, gc, xfont->fid);
1034       UNBLOCK_INPUT;
1035     }
1036
1037   if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1038     {
1039       USE_SAFE_ALLOCA;
1040       char *str = SAFE_ALLOCA (len);
1041       for (i = 0; i < len ; i++)
1042         str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1043       BLOCK_INPUT;
1044       if (with_background > 0)
1045         {
1046           if (s->padding_p)
1047             for (i = 0; i < len; i++)
1048               XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1049                                 gc, x + i, y, str + i, 1);
1050           else
1051             XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1052                               gc, x, y, str, len);
1053         }
1054       else
1055         {
1056           if (s->padding_p)
1057             for (i = 0; i < len; i++)
1058               XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1059                            gc, x + i, y, str + i, 1);
1060           else
1061             XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1062                          gc, x, y, str, len);
1063         }
1064       UNBLOCK_INPUT;
1065       SAFE_FREE ();
1066       return s->nchars;
1067     }
1068
1069   BLOCK_INPUT;
1070   if (with_background > 0)
1071     {
1072       if (s->padding_p)
1073         for (i = 0; i < len; i++)
1074           XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1075                               gc, x + i, y, s->char2b + from + i, 1);
1076       else
1077         XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1078                             gc, x, y, s->char2b + from, len);
1079     }
1080   else
1081     {
1082       if (s->padding_p)
1083         for (i = 0; i < len; i++)
1084           XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1085                          gc, x + i, y, s->char2b + from + i, 1);
1086       else
1087         XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1088                        gc, x, y, s->char2b + from, len);
1089     }
1090   UNBLOCK_INPUT;
1091
1092   return len;
1093 }
1094
1095 static int
1096 xfont_check (FRAME_PTR f, struct font *font)
1097 {
1098   struct xfont_info *xfont = (struct xfont_info *) font;
1099
1100   return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1101 }
1102
1103 \f
1104 void
1105 syms_of_xfont (void)
1106 {
1107   staticpro (&xfont_scripts_cache);
1108   { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1109        is called fairly late, when QCtest and Qequal are known to be set.  */
1110     Lisp_Object args[2];
1111     args[0] = QCtest;
1112     args[1] = Qequal;
1113     xfont_scripts_cache = Fmake_hash_table (2, args);
1114   }
1115   staticpro (&xfont_scratch_props);
1116   xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
1117   xfont_driver.type = Qx;
1118   register_font_driver (&xfont_driver, NULL);
1119 }