src/xfont.c

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