src/xfont.c

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