code.delx.au - gnu-emacs/blob - src/xfont.c

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