code.delx.au - gnu-emacs/blob - 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 <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 P_ ((Display *));
  50
  51 static XCharStruct *xfont_get_pcm P_ ((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 (xfont, char2b)
  58      XFontStruct *xfont;
  59      XChar2b *char2b;
  60 {
  61   /* The result metric information.  */
  62   XCharStruct *pcm = NULL;
  63
  64   font_assert (xfont && char2b);
  65
  66   if (xfont->per_char != NULL)
  67     {
  68       if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
  69         {
  70           /* min_char_or_byte2 specifies the linear character index
  71              corresponding to the first element of the per_char array,
  72              max_char_or_byte2 is the index of the last character.  A
  73              character with non-zero CHAR2B->byte1 is not in the font.
  74              A character with byte2 less than min_char_or_byte2 or
  75              greater max_char_or_byte2 is not in the font.  */
  76           if (char2b->byte1 == 0
  77               && char2b->byte2 >= xfont->min_char_or_byte2
  78               && char2b->byte2 <= xfont->max_char_or_byte2)
  79             pcm = xfont->per_char + char2b->byte2 - xfont->min_char_or_byte2;
  80         }
  81       else
  82         {
  83           /* If either min_byte1 or max_byte1 are nonzero, both
  84              min_char_or_byte2 and max_char_or_byte2 are less than
  85              256, and the 2-byte character index values corresponding
  86              to the per_char array element N (counting from 0) are:
  87
  88              byte1 = N/D + min_byte1
  89              byte2 = N\D + min_char_or_byte2
  90
  91              where:
  92
  93              D = max_char_or_byte2 - min_char_or_byte2 + 1
  94              / = integer division
  95              \ = integer modulus  */
  96           if (char2b->byte1 >= xfont->min_byte1
  97               && char2b->byte1 <= xfont->max_byte1
  98               && char2b->byte2 >= xfont->min_char_or_byte2
  99               && char2b->byte2 <= xfont->max_char_or_byte2)
 100             pcm = (xfont->per_char
 101                    + ((xfont->max_char_or_byte2 - xfont->min_char_or_byte2 + 1)
 102                       * (char2b->byte1 - xfont->min_byte1))
 103                    + (char2b->byte2 - xfont->min_char_or_byte2));
 104         }
 105     }
 106   else
 107     {
 108       /* If the per_char pointer is null, all glyphs between the first
 109          and last character indexes inclusive have the same
 110          information, as given by both min_bounds and max_bounds.  */
 111       if (char2b->byte2 >= xfont->min_char_or_byte2
 112           && char2b->byte2 <= xfont->max_char_or_byte2)
 113         pcm = &xfont->max_bounds;
 114     }
 115
 116   return ((pcm == NULL
 117            || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0))
 118           ? NULL : pcm);
 119 }
 120
 121 static Lisp_Object xfont_get_cache P_ ((FRAME_PTR));
 122 static Lisp_Object xfont_list P_ ((Lisp_Object, Lisp_Object));
 123 static Lisp_Object xfont_match P_ ((Lisp_Object, Lisp_Object));
 124 static Lisp_Object xfont_list_family P_ ((Lisp_Object));
 125 static Lisp_Object xfont_open P_ ((FRAME_PTR, Lisp_Object, int));
 126 static void xfont_close P_ ((FRAME_PTR, struct font *));
 127 static int xfont_prepare_face P_ ((FRAME_PTR, struct face *));
 128 static int xfont_has_char P_ ((Lisp_Object, int));
 129 static unsigned xfont_encode_char P_ ((struct font *, int));
 130 static int xfont_text_extents P_ ((struct font *, unsigned *, int,
 131                                    struct font_metrics *));
 132 static int xfont_draw P_ ((struct glyph_string *, int, int, int, int, int));
 133 static int xfont_check P_ ((FRAME_PTR, struct font *));
 134
 135 struct font_driver xfont_driver =
 136   {
 137     0,                          /* Qx */
 138     0,                          /* case insensitive */
 139     xfont_get_cache,
 140     xfont_list,
 141     xfont_match,
 142     xfont_list_family,
 143     NULL,
 144     xfont_open,
 145     xfont_close,
 146     xfont_prepare_face,
 147     NULL,
 148     xfont_has_char,
 149     xfont_encode_char,
 150     xfont_text_extents,
 151     xfont_draw,
 152     NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
 153     xfont_check
 154   };
 155
 156 extern Lisp_Object QCname;
 157
 158 static Lisp_Object
 159 xfont_get_cache (f)
 160      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 (frame, spec)
 498      Lisp_Object frame, spec;
 499 {
 500   FRAME_PTR f = XFRAME (frame);
 501   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
 502   Lisp_Object registry, list, val, extra, script;
 503   int len;
 504   /* Large enough to contain the longest XLFD (255 bytes) in UTF-8.  */
 505   char name[512];
 506
 507   extra = AREF (spec, FONT_EXTRA_INDEX);
 508   if (CONSP (extra))
 509     {
 510       val = assq_no_quit (QCotf, extra);
 511       if (! NILP (val))
 512         return Qnil;
 513       val = assq_no_quit (QClang, extra);
 514       if (! NILP (val))
 515         return Qnil;
 516     }
 517
 518   registry = AREF (spec, FONT_REGISTRY_INDEX);
 519   len = font_unparse_xlfd (spec, 0, name, 512);
 520   if (len < 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 521     return Qnil;
 522
 523   val = assq_no_quit (QCscript, extra);
 524   script = CDR (val);
 525   list = xfont_list_pattern (display, name, registry, script);
 526   if (NILP (list) && NILP (registry))
 527     {
 528       /* Try iso10646-1 */
 529       char *r = name + len - 9; /* 9 == strlen (iso8859-1) */
 530
 531       if (r - name + 10 < 256)  /* 10 == strlen (iso10646-1) */
 532         {
 533           strcpy (r, "iso10646-1");
 534           list = xfont_list_pattern (display, name, Qiso10646_1, script);
 535         }
 536     }
 537   if (NILP (list) && ! NILP (registry))
 538     {
 539       /* Try alternate registries.  */
 540       Lisp_Object alter;
 541
 542       if ((alter = Fassoc (SYMBOL_NAME (registry),
 543                            Vface_alternative_font_registry_alist),
 544            CONSP (alter)))
 545         {
 546           /* Pointer to REGISTRY-ENCODING field.  */
 547           char *r = name + len - SBYTES (SYMBOL_NAME (registry));
 548
 549           for (alter = XCDR (alter); CONSP (alter); alter = XCDR (alter))
 550             if (STRINGP (XCAR (alter))
 551                 && ((r - name) + SBYTES (XCAR (alter))) < 256)
 552               {
 553                 strcpy (r, (char *) SDATA (XCAR (alter)));
 554                 list = xfont_list_pattern (display, name, registry, script);
 555                 if (! NILP (list))
 556                   break;
 557               }
 558         }
 559     }
 560   if (NILP (list))
 561     {
 562       /* Try alias.  */
 563       val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
 564       if (CONSP (val) && STRINGP (XCDR (val)) && SBYTES (XCDR (val)) < 512)
 565         {
 566           bcopy (SDATA (XCDR (val)), name, SBYTES (XCDR (val)) + 1);
 567           if (xfont_encode_coding_xlfd (name) < 0)
 568             return Qnil;
 569           list = xfont_list_pattern (display, name, registry, script);
 570         }
 571     }
 572
 573   return list;
 574 }
 575
 576 static Lisp_Object
 577 xfont_match (frame, spec)
 578      Lisp_Object frame, spec;
 579 {
 580   FRAME_PTR f = XFRAME (frame);
 581   Display *display = FRAME_X_DISPLAY_INFO (f)->display;
 582   Lisp_Object extra, val, entity;
 583   char name[512];
 584   XFontStruct *xfont;
 585   unsigned long value;
 586
 587   extra = AREF (spec, FONT_EXTRA_INDEX);
 588   val = assq_no_quit (QCname, extra);
 589   if (! CONSP (val) || ! STRINGP (XCDR (val)))
 590     {
 591       if (font_unparse_xlfd (spec, 0, name, 512) < 0)
 592         return Qnil;
 593     }
 594   else if (SBYTES (XCDR (val)) < 512)
 595     bcopy (SDATA (XCDR (val)), name, SBYTES (XCDR (val)) + 1);
 596   else
 597     return Qnil;
 598   if (xfont_encode_coding_xlfd (name) < 0)
 599     return Qnil;
 600
 601   BLOCK_INPUT;
 602   entity = Qnil;
 603   xfont = XLoadQueryFont (display, name);
 604   if (xfont)
 605     {
 606       if (XGetFontProperty (xfont, XA_FONT, &value))
 607         {
 608           int len;
 609           char *s;
 610
 611           s = (char *) XGetAtomName (display, (Atom) value);
 612           len = strlen (s);
 613
 614           /* If DXPC (a Differential X Protocol Compressor)
 615              Ver.3.7 is running, XGetAtomName will return null
 616              string.  We must avoid such a name.  */
 617           if (len > 0)
 618             {
 619               entity = font_make_entity ();
 620               ASET (entity, FONT_TYPE_INDEX, Qx);
 621               xfont_decode_coding_xlfd (s, -1, name);
 622               if (font_parse_xlfd (name, entity) < 0)
 623                 entity = Qnil;
 624             }
 625           XFree (s);
 626         }
 627       XFreeFont (display, xfont);
 628     }
 629   UNBLOCK_INPUT;
 630
 631   FONT_ADD_LOG ("xfont-match", spec, entity);
 632   return entity;
 633 }
 634
 635 static Lisp_Object
 636 xfont_list_family (frame)
 637      Lisp_Object frame;
 638 {
 639   FRAME_PTR f = XFRAME (frame);
 640   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 641   char **names;
 642   int num_fonts, i;
 643   Lisp_Object list;
 644   char *last_family;
 645   int last_len;
 646
 647   BLOCK_INPUT;
 648   x_catch_errors (dpyinfo->display);
 649   names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
 650                       0x8000, &num_fonts);
 651   if (x_had_errors_p (dpyinfo->display))
 652     {
 653       /* This error is perhaps due to insufficient memory on X server.
 654          Let's just ignore it.  */
 655       x_clear_errors (dpyinfo->display);
 656       num_fonts = 0;
 657     }
 658
 659   list = Qnil;
 660   for (i = 0, last_len = 0; i < num_fonts; i++)
 661     {
 662       char *p0 = names[i], *p1, buf[512];
 663       Lisp_Object family;
 664       int decoded_len;
 665
 666       p0++;                     /* skip the leading '-' */
 667       while (*p0 && *p0 != '-') p0++; /* skip foundry */
 668       if (! *p0)
 669         continue;
 670       p1 = ++p0;
 671       while (*p1 && *p1 != '-') p1++; /* find the end of family */
 672       if (! *p1 || p1 == p0)
 673         continue;
 674       if (last_len == p1 - p0
 675           && bcmp (last_family, p0, last_len) == 0)
 676         continue;
 677       last_len = p1 - p0;
 678       last_family = p0;
 679
 680       decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
 681       family = font_intern_prop (p0, decoded_len, 1);
 682       if (NILP (assq_no_quit (family, list)))
 683         list = Fcons (family, list);
 684     }
 685
 686   XFreeFontNames (names);
 687   x_uncatch_errors ();
 688   UNBLOCK_INPUT;
 689
 690   return list;
 691 }
 692
 693 extern Lisp_Object QCavgwidth;
 694
 695 static Lisp_Object
 696 xfont_open (f, entity, pixel_size)
 697      FRAME_PTR f;
 698      Lisp_Object entity;
 699      int pixel_size;
 700 {
 701   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
 702   Display *display = dpyinfo->display;
 703   char name[512];
 704   int len;
 705   unsigned long value;
 706   Lisp_Object registry;
 707   struct charset *encoding, *repertory;
 708   Lisp_Object font_object, fullname;
 709   struct font *font;
 710   XFontStruct *xfont;
 711
 712   /* At first, check if we know how to encode characters for this
 713      font.  */
 714   registry = AREF (entity, FONT_REGISTRY_INDEX);
 715   if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 716     {
 717       FONT_ADD_LOG ("  x:unknown registry", registry, Qnil);
 718       return Qnil;
 719     }
 720
 721   if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
 722     pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
 723   else if (pixel_size == 0)
 724     {
 725       if (FRAME_FONT (f))
 726         pixel_size = FRAME_FONT (f)->pixel_size;
 727       else
 728         pixel_size = 14;
 729     }
 730   len = font_unparse_xlfd (entity, pixel_size, name, 512);
 731   if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 732     {
 733       FONT_ADD_LOG ("  x:unparse failed", entity, Qnil);
 734       return Qnil;
 735     }
 736
 737   BLOCK_INPUT;
 738   x_catch_errors (display);
 739   xfont = XLoadQueryFont (display, name);
 740   if (x_had_errors_p (display))
 741     {
 742       /* This error is perhaps due to insufficient memory on X server.
 743          Let's just ignore it.  */
 744       x_clear_errors (display);
 745       xfont = NULL;
 746     }
 747   else if (! xfont)
 748     {
 749       /* Some version of X lists:
 750            -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
 751            -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
 752          but can open only:
 753            -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
 754          and
 755            -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
 756          So, we try again with wildcards in RESX and RESY.  */
 757       Lisp_Object temp;
 758
 759       temp = Fcopy_font_spec (entity);
 760       ASET (temp, FONT_DPI_INDEX, Qnil);
 761       len = font_unparse_xlfd (temp, pixel_size, name, 512);
 762       if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
 763         {
 764           FONT_ADD_LOG ("  x:unparse failed", temp, Qnil);
 765           return Qnil;
 766         }
 767       xfont = XLoadQueryFont (display, name);
 768       if (x_had_errors_p (display))
 769         {
 770           /* This error is perhaps due to insufficient memory on X server.
 771              Let's just ignore it.  */
 772           x_clear_errors (display);
 773           xfont = NULL;
 774         }
 775     }
 776   fullname = Qnil;
 777   /* Try to get the full name of FONT.  */
 778   if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
 779     {
 780       char *p0, *p;
 781       int dashes = 0;
 782
 783       p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
 784       /* Count the number of dashes in the "full name".
 785          If it is too few, this isn't really the font's full name,
 786          so don't use it.
 787          In X11R4, the fonts did not come with their canonical names
 788          stored in them.  */
 789       while (*p)
 790         {
 791           if (*p == '-')
 792             dashes++;
 793           p++;
 794         }
 795
 796       if (dashes >= 13)
 797         {
 798           len = xfont_decode_coding_xlfd (p0, -1, name);
 799           fullname = Fdowncase (make_string (name, len));
 800         }
 801       XFree (p0);
 802     }
 803   x_uncatch_errors ();
 804   UNBLOCK_INPUT;
 805
 806   if (! xfont)
 807     {
 808       FONT_ADD_LOG ("  x:open failed", build_string (name), Qnil);
 809       return Qnil;
 810     }
 811
 812   font_object = font_make_object (VECSIZE (struct xfont_info),
 813                                   entity, pixel_size);
 814   ASET (font_object, FONT_TYPE_INDEX, Qx);
 815   if (STRINGP (fullname))
 816     {
 817       font_parse_xlfd ((char *) SDATA (fullname), font_object);
 818       ASET (font_object, FONT_NAME_INDEX, fullname);
 819     }
 820   else
 821     {
 822       char buf[512];
 823
 824       len = xfont_decode_coding_xlfd (name, -1, buf);
 825       ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
 826     }
 827   ASET (font_object, FONT_FULLNAME_INDEX, fullname);
 828   ASET (font_object, FONT_FILE_INDEX, Qnil);
 829   ASET (font_object, FONT_FORMAT_INDEX, Qx);
 830   font = XFONT_OBJECT (font_object);
 831   ((struct xfont_info *) font)->xfont = xfont;
 832   ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
 833   font->pixel_size = pixel_size;
 834   font->driver = &xfont_driver;
 835   font->encoding_charset = encoding->id;
 836   font->repertory_charset = repertory ? repertory->id : -1;
 837   font->ascent = xfont->ascent;
 838   font->descent = xfont->descent;
 839   font->height = font->ascent + font->descent;
 840   font->min_width = xfont->min_bounds.width;
 841   if (xfont->min_bounds.width == xfont->max_bounds.width)
 842     {
 843       /* Fixed width font.  */
 844       font->average_width = font->space_width = xfont->min_bounds.width;
 845     }
 846   else
 847     {
 848       XCharStruct *pcm;
 849       XChar2b char2b;
 850       Lisp_Object val;
 851
 852       char2b.byte1 = 0x00, char2b.byte2 = 0x20;
 853       pcm = xfont_get_pcm (xfont, &char2b);
 854       if (pcm)
 855         font->space_width = pcm->width;
 856       else
 857         font->space_width = 0;
 858
 859       val = Ffont_get (font_object, QCavgwidth);
 860       if (INTEGERP (val))
 861         font->average_width = XINT (val);
 862       if (font->average_width < 0)
 863         font->average_width = - font->average_width;
 864       if (font->average_width == 0
 865           && encoding->ascii_compatible_p)
 866         {
 867           int width = font->space_width, n = pcm != NULL;
 868
 869           for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
 870             if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
 871               width += pcm->width, n++;
 872           if (n > 0)
 873             font->average_width = width / n;
 874         }
 875       if (font->average_width == 0)
 876         /* No easy way other than this to get a reasonable
 877            average_width.  */
 878         font->average_width
 879           = (xfont->min_bounds.width + xfont->max_bounds.width) / 2;
 880     }
 881
 882   BLOCK_INPUT;
 883   font->underline_thickness
 884     = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
 885        ? (long) value : 0);
 886   font->underline_position
 887     = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
 888        ? (long) value : -1);
 889   font->baseline_offset
 890     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
 891        ? (long) value : 0);
 892   font->relative_compose
 893     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
 894        ? (long) value : 0);
 895   font->default_ascent
 896     = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
 897        ? (long) value : 0);
 898   UNBLOCK_INPUT;
 899
 900   if (NILP (fullname))
 901     fullname = AREF (font_object, FONT_NAME_INDEX);
 902   font->vertical_centering
 903     = (STRINGP (Vvertical_centering_font_regexp)
 904        && (fast_string_match_ignore_case
 905            (Vvertical_centering_font_regexp, fullname) >= 0));
 906
 907   return font_object;
 908 }
 909
 910 static void
 911 xfont_close (f, font)
 912      FRAME_PTR f;
 913      struct font *font;
 914 {
 915   BLOCK_INPUT;
 916   XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
 917   UNBLOCK_INPUT;
 918 }
 919
 920 static int
 921 xfont_prepare_face (f, face)
 922      FRAME_PTR f;
 923      struct face *face;
 924 {
 925   BLOCK_INPUT;
 926   XSetFont (FRAME_X_DISPLAY (f), face->gc,
 927             ((struct xfont_info *) face->font)->xfont->fid);
 928   UNBLOCK_INPUT;
 929
 930   return 0;
 931 }
 932
 933 static int
 934 xfont_has_char (font, c)
 935      Lisp_Object font;
 936      int c;
 937 {
 938   Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
 939   struct charset *encoding;
 940   struct charset *repertory = NULL;
 941
 942   if (EQ (registry, Qiso10646_1))
 943     {
 944       encoding = CHARSET_FROM_ID (charset_unicode);
 945       /* We use a font of `ja' and `ko' adstyle only for a character
 946          in JISX0208 and KSC5601 charsets respectively.  */
 947       if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
 948           && charset_jisx0208 >= 0)
 949         repertory = CHARSET_FROM_ID (charset_jisx0208);
 950       else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
 951                && charset_ksc5601 >= 0)
 952         repertory = CHARSET_FROM_ID (charset_ksc5601);
 953     }
 954   else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
 955     /* Unknown REGISTRY, not usable.  */
 956     return 0;
 957   if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
 958     return 1;
 959   if (! repertory)
 960     return -1;
 961   return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
 962 }
 963
 964 static unsigned
 965 xfont_encode_char (font, c)
 966      struct font *font;
 967      int c;
 968 {
 969   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 970   struct charset *charset;
 971   unsigned code;
 972   XChar2b char2b;
 973
 974   charset = CHARSET_FROM_ID (font->encoding_charset);
 975   code = ENCODE_CHAR (charset, c);
 976   if (code == CHARSET_INVALID_CODE (charset))
 977     return FONT_INVALID_CODE;
 978   if (font->repertory_charset >= 0)
 979     {
 980       charset = CHARSET_FROM_ID (font->repertory_charset);
 981       return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
 982               ? code : FONT_INVALID_CODE);
 983     }
 984   char2b.byte1 = code >> 8;
 985   char2b.byte2 = code & 0xFF;
 986   return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
 987 }
 988
 989 static int
 990 xfont_text_extents (font, code, nglyphs, metrics)
 991      struct font *font;
 992      unsigned *code;
 993      int nglyphs;
 994      struct font_metrics *metrics;
 995 {
 996   XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
 997   int width = 0;
 998   int i, first, x;
 999
1000   if (metrics)
1001     bzero (metrics, sizeof (struct font_metrics));
1002   for (i = 0, x = 0, first = 1; i < nglyphs; i++)
1003     {
1004       XChar2b char2b;
1005       static XCharStruct *pcm;
1006
1007       if (code[i] >= 0x10000)
1008         continue;
1009       char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
1010       pcm = xfont_get_pcm (xfont, &char2b);
1011       if (! pcm)
1012         continue;
1013       if (first)
1014         {
1015           if (metrics)
1016             {
1017               metrics->lbearing = pcm->lbearing;
1018               metrics->rbearing = pcm->rbearing;
1019               metrics->ascent = pcm->ascent;
1020               metrics->descent = pcm->descent;
1021             }
1022           first = 0;
1023         }
1024       else
1025         {
1026           if (metrics)
1027             {
1028               if (metrics->lbearing > width + pcm->lbearing)
1029                 metrics->lbearing = width + pcm->lbearing;
1030               if (metrics->rbearing < width + pcm->rbearing)
1031                 metrics->rbearing = width + pcm->rbearing;
1032               if (metrics->ascent < pcm->ascent)
1033                 metrics->ascent = pcm->ascent;
1034               if (metrics->descent < pcm->descent)
1035                 metrics->descent = pcm->descent;
1036             }
1037         }
1038       width += pcm->width;
1039     }
1040   if (metrics)
1041     metrics->width = width;
1042   return width;
1043 }
1044
1045 static int
1046 xfont_draw (s, from, to, x, y, with_background)
1047      struct glyph_string *s;
1048      int from, to, x, y, with_background;
1049 {
1050   XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1051   int len = to - from;
1052   GC gc = s->gc;
1053   int i;
1054
1055   if (s->gc != s->face->gc)
1056     {
1057       BLOCK_INPUT;
1058       XSetFont (s->display, gc, xfont->fid);
1059       UNBLOCK_INPUT;
1060     }
1061
1062   if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1063     {
1064       char *str;
1065       USE_SAFE_ALLOCA;
1066
1067       SAFE_ALLOCA (str, char *, len);
1068       for (i = 0; i < len ; i++)
1069         str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1070       BLOCK_INPUT;
1071       if (with_background > 0)
1072         {
1073           if (s->padding_p)
1074             for (i = 0; i < len; i++)
1075               XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1076                                 gc, x + i, y, str + i, 1);
1077           else
1078             XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1079                               gc, x, y, str, len);
1080         }
1081       else
1082         {
1083           if (s->padding_p)
1084             for (i = 0; i < len; i++)
1085               XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1086                            gc, x + i, y, str + i, 1);
1087           else
1088             XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1089                          gc, x, y, str, len);
1090         }
1091       UNBLOCK_INPUT;
1092       SAFE_FREE ();
1093       return s->nchars;
1094     }
1095
1096   BLOCK_INPUT;
1097   if (with_background > 0)
1098     {
1099       if (s->padding_p)
1100         for (i = 0; i < len; i++)
1101           XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1102                               gc, x + i, y, s->char2b + from + i, 1);
1103       else
1104         XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1105                             gc, x, y, s->char2b + from, len);
1106     }
1107   else
1108     {
1109       if (s->padding_p)
1110         for (i = 0; i < len; i++)
1111           XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1112                          gc, x + i, y, s->char2b + from + i, 1);
1113       else
1114         XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1115                        gc, x, y, s->char2b + from, len);
1116     }
1117   UNBLOCK_INPUT;
1118
1119   return len;
1120 }
1121
1122 static int
1123 xfont_check (f, font)
1124      FRAME_PTR f;
1125      struct font *font;
1126 {
1127   struct xfont_info *xfont = (struct xfont_info *) font;
1128
1129   return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1130 }
1131
1132 \f
1133 void
1134 syms_of_xfont ()
1135 {
1136   staticpro (&xfont_scripts_cache);
1137   { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1138        is called fairly late, when QCtest and Qequal are known to be set.  */
1139     Lisp_Object args[2];
1140     args[0] = QCtest;
1141     args[1] = Qequal;
1142     xfont_scripts_cache = Fmake_hash_table (2, args);
1143   }
1144   staticpro (&xfont_scratch_props);
1145   xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
1146   xfont_driver.type = Qx;
1147   register_font_driver (&xfont_driver, NULL);
1148 }
1149
1150 /* arch-tag: 23c5f366-a5ee-44b7-a3b7-90d6da7fd749
1151    (do not change this comment) */