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

   1 /* ftfont.c -- FreeType font driver.
   2    Copyright (C) 2006 Free Software Foundation, Inc.
   3    Copyright (C) 2006
   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 2, or (at your option)
  12 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; see the file COPYING.  If not, write to
  21 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 Boston, MA 02110-1301, USA.  */
  23
  24 #include <config.h>
  25 #include <stdio.h>
  26
  27 #include <ft2build.h>
  28 #include FT_FREETYPE_H
  29 #include FT_SIZES_H
  30 #include <fontconfig/fontconfig.h>
  31 #include <fontconfig/fcfreetype.h>
  32
  33 #include "lisp.h"
  34 #include "dispextern.h"
  35 #include "frame.h"
  36 #include "blockinput.h"
  37 #include "character.h"
  38 #include "charset.h"
  39 #include "coding.h"
  40 #include "fontset.h"
  41 #include "font.h"
  42
  43 /* Symbolic type of this font-driver.  */
  44 Lisp_Object Qfreetype;
  45
  46 /* Fontconfig's generic families and their aliases.  */
  47 static Lisp_Object Qmonospace, Qsans_serif, Qserif, Qmono, Qsans, Qsans__serif;
  48
  49 /* Flag to tell if FcInit is areadly called or not.  */
  50 static int fc_initialized;
  51
  52 /* Handle to a FreeType library instance.  */
  53 static FT_Library ft_library;
  54
  55 /* Cache for FreeType fonts.  */
  56 static Lisp_Object freetype_font_cache;
  57
  58 /* Fontconfig's charset used for finding fonts of registry
  59    "iso8859-1".  */
  60 static FcCharSet *cs_iso8859_1;
  61
  62 /* The actual structure for FreeType font that can be casted to struct
  63    font.  */
  64
  65 struct ftfont_info
  66 {
  67   struct font font;
  68   FT_Size ft_size;
  69 };
  70
  71 static int ftfont_build_basic_charsets P_ ((void));
  72 static Lisp_Object ftfont_pattern_entity P_ ((FcPattern *,
  73                                               Lisp_Object, Lisp_Object));
  74 static Lisp_Object ftfont_list_generic_family P_ ((Lisp_Object, Lisp_Object,
  75                                                    Lisp_Object));
  76
  77 #define SYMBOL_FcChar8(SYM) (FcChar8 *) SDATA (SYMBOL_NAME (SYM))
  78
  79 static int
  80 ftfont_build_basic_charsets ()
  81 {
  82   FcChar32 c;
  83
  84   cs_iso8859_1 = FcCharSetCreate ();
  85   if (! cs_iso8859_1)
  86     return -1;
  87   for (c = ' '; c < 127; c++)
  88     if (! FcCharSetAddChar (cs_iso8859_1, c))
  89       return -1;
  90 #if 0
  91   /* This part is currently disabled.  Should be fixed later.  */
  92   for (c = 192; c < 256; c++)
  93     if (! FcCharSetAddChar (cs_iso8859_1, c))
  94       return -1;
  95 #endif
  96   return 0;
  97 }
  98
  99 static Lisp_Object
 100 ftfont_pattern_entity (p, frame, registry)
 101      FcPattern *p;
 102      Lisp_Object frame, registry;
 103 {
 104   Lisp_Object entity;
 105   FcChar8 *file;
 106   FcCharSet *charset;
 107   char *str;
 108   int numeric;
 109   double dbl;
 110
 111   if (FcPatternGetString (p, FC_FILE, 0, &file) != FcResultMatch)
 112     return Qnil;
 113   if (FcPatternGetCharSet (p, FC_CHARSET, 0, &charset) != FcResultMatch)
 114     charset = NULL;
 115
 116   entity = Fmake_vector (make_number (FONT_ENTITY_MAX), null_string);
 117
 118   ASET (entity, FONT_TYPE_INDEX, Qfreetype);
 119   ASET (entity, FONT_REGISTRY_INDEX, registry);
 120   ASET (entity, FONT_FRAME_INDEX, frame);
 121   ASET (entity, FONT_OBJLIST_INDEX, Qnil);
 122
 123   if (FcPatternGetString (p, FC_FOUNDRY, 0, (FcChar8 **) &str) == FcResultMatch)
 124     ASET (entity, FONT_FOUNDRY_INDEX, intern_downcase (str, strlen (str)));
 125   if (FcPatternGetString (p, FC_FAMILY, 0, (FcChar8 **) &str) == FcResultMatch)
 126     ASET (entity, FONT_FAMILY_INDEX, intern_downcase (str, strlen (str)));
 127   if (FcPatternGetInteger (p, FC_WEIGHT, 0, &numeric) == FcResultMatch)
 128     {
 129       if (numeric == FC_WEIGHT_REGULAR)
 130         numeric = 100;
 131       ASET (entity, FONT_WEIGHT_INDEX, make_number (numeric));
 132     }
 133   if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch)
 134     ASET (entity, FONT_SLANT_INDEX, make_number (numeric + 100));
 135   if (FcPatternGetInteger (p, FC_WIDTH, 0, &numeric) == FcResultMatch)
 136     ASET (entity, FONT_WIDTH_INDEX, make_number (numeric));
 137   if (FcPatternGetDouble (p, FC_PIXEL_SIZE, 0, &dbl) == FcResultMatch)
 138     ASET (entity, FONT_SIZE_INDEX, make_number (dbl));
 139   else
 140     ASET (entity, FONT_SIZE_INDEX, make_number (0));
 141
 142   if (FcPatternGetInteger (p, FC_SPACING, 0, &numeric) != FcResultMatch)
 143     numeric = -1;
 144   file = FcStrCopy (file);
 145   if (! file)
 146     return Qnil;
 147
 148   p = FcPatternCreate ();
 149   if (! p)
 150     return Qnil;
 151
 152   if (FcPatternAddString (p, FC_FILE, file) == FcFalse
 153       || (charset && FcPatternAddCharSet (p, FC_CHARSET, charset) == FcFalse)
 154       || (numeric >= 0
 155           && FcPatternAddInteger (p, FC_SPACING, numeric) == FcFalse))
 156     {
 157       FcPatternDestroy (p);
 158       return Qnil;
 159     }
 160   ASET (entity, FONT_EXTRA_INDEX, make_save_value (p, 0));
 161   return entity;
 162 }
 163
 164 static Lisp_Object ftfont_generic_family_list;
 165
 166 static Lisp_Object
 167 ftfont_list_generic_family (spec, frame, registry)
 168      Lisp_Object spec, frame, registry;
 169 {
 170   Lisp_Object family = AREF (spec, FONT_FAMILY_INDEX);
 171   Lisp_Object slot, list, val;
 172
 173   if (EQ (family, Qmono))
 174     family = Qmonospace;
 175   else if (EQ (family, Qsans) || EQ (family, Qsans__serif))
 176     family = Qsans_serif;
 177   slot = assq_no_quit (family, ftfont_generic_family_list);
 178   if (! CONSP (slot))
 179     return null_vector;
 180   list = XCDR (slot);
 181   if (EQ (list, Qt))
 182     {
 183       /* Not yet listed.  */
 184       FcObjectSet *objset = NULL;
 185       FcPattern *pattern = NULL, *pat = NULL;
 186       FcFontSet *fontset = NULL;
 187       FcChar8 *fam;
 188       int i, j;
 189
 190       objset = FcObjectSetBuild (FC_FOUNDRY, FC_FAMILY, FC_WEIGHT, FC_SLANT,
 191                                  FC_WIDTH, FC_PIXEL_SIZE, FC_SPACING,
 192                                  FC_CHARSET, FC_FILE, NULL);
 193       if (! objset)
 194         goto err;
 195       pattern = FcPatternBuild (NULL, FC_FAMILY, FcTypeString,
 196                                 SYMBOL_FcChar8 (family), (char *) 0);
 197       if (! pattern)
 198         goto err;
 199       pat = FcPatternCreate ();
 200       if (! pat)
 201         goto err;
 202       FcConfigSubstitute (NULL, pattern, FcMatchPattern);
 203       for (i = 0, val = Qnil;
 204            FcPatternGetString (pattern, FC_FAMILY, i, &fam) == FcResultMatch;
 205            i++)
 206         {
 207           if (strcmp ((char *) fam, (char *) SYMBOL_FcChar8 (family)) == 0)
 208             continue;
 209           if (! FcPatternAddString (pat, FC_FAMILY, fam))
 210             goto err;
 211           fontset = FcFontList (NULL, pat, objset);
 212           if (! fontset)
 213             goto err;
 214           /* Here we build the list in reverse order so that the last
 215              loop in this function build a list in the correct
 216              order.  */
 217           for (j = 0; j < fontset->nfont; j++)
 218             {
 219               Lisp_Object entity;
 220
 221               entity = ftfont_pattern_entity (fontset->fonts[j],
 222                                               frame, registry);
 223               if (! NILP (entity))
 224                 val = Fcons (entity, val);
 225             }
 226           FcFontSetDestroy (fontset);
 227           fontset = NULL;
 228           FcPatternDel (pat, FC_FAMILY);
 229         }
 230       list = val;
 231       XSETCDR (slot, list);
 232     err:
 233       if (pat) FcPatternDestroy (pat);
 234       if (pattern) FcPatternDestroy (pattern);
 235       if (fontset) FcFontSetDestroy (fontset);
 236       if (objset) FcObjectSetDestroy (objset);
 237       if (EQ (list, Qt))
 238         return Qnil;
 239     }
 240   ASET (spec, FONT_FAMILY_INDEX, Qnil);
 241   for (val = Qnil; CONSP (list); list = XCDR (list))
 242     if (font_match_p (spec, XCAR (list)))
 243       val = Fcons (XCAR (list), val);
 244   ASET (spec, FONT_FAMILY_INDEX, family);
 245   return Fvconcat (1, &val);
 246 }
 247
 248
 249 static Lisp_Object ftfont_get_cache P_ ((Lisp_Object));
 250 static Lisp_Object ftfont_list P_ ((Lisp_Object, Lisp_Object));
 251 static Lisp_Object ftfont_match P_ ((Lisp_Object, Lisp_Object));
 252 static Lisp_Object ftfont_list_family P_ ((Lisp_Object));
 253 static void ftfont_free_entity P_ ((Lisp_Object));
 254 static struct font *ftfont_open P_ ((FRAME_PTR, Lisp_Object, int));
 255 static void ftfont_close P_ ((FRAME_PTR, struct font *));
 256 static int ftfont_has_char P_ ((Lisp_Object, int));
 257 static unsigned ftfont_encode_char P_ ((struct font *, int));
 258 static int ftfont_text_extents P_ ((struct font *, unsigned *, int,
 259                                     struct font_metrics *));
 260 static int ftfont_get_bitmap P_ ((struct font *, unsigned,
 261                                   struct font_bitmap *, int));
 262 static int ftfont_anchor_point P_ ((struct font *, unsigned, int,
 263                                     int *, int *));
 264
 265 struct font_driver ftfont_driver =
 266   {
 267     (Lisp_Object) NULL,         /* Qfreetype */
 268     ftfont_get_cache,
 269     ftfont_list,
 270     ftfont_match,
 271     ftfont_list_family,
 272     ftfont_free_entity,
 273     ftfont_open,
 274     ftfont_close,
 275     /* We can't draw a text without device dependent functions.  */
 276     NULL,
 277     NULL,
 278     ftfont_has_char,
 279     ftfont_encode_char,
 280     ftfont_text_extents,
 281     /* We can't draw a text without device dependent functions.  */
 282     NULL,
 283     ftfont_get_bitmap,
 284     NULL,
 285     NULL,
 286     NULL,
 287     ftfont_anchor_point,
 288 #ifdef HAVE_LIBOTF
 289     font_otf_capability,
 290     font_otf_gsub,
 291     font_otf_gpos
 292 #else
 293     NULL,
 294     NULL,
 295     NULL
 296 #endif  /* HAVE_LIBOTF */
 297   };
 298
 299 extern Lisp_Object QCname;
 300
 301 static Lisp_Object
 302 ftfont_get_cache (frame)
 303      Lisp_Object frame;
 304 {
 305   return freetype_font_cache;
 306 }
 307
 308 static Lisp_Object
 309 ftfont_list (frame, spec)
 310      Lisp_Object frame, spec;
 311 {
 312   Lisp_Object val, tmp, extra;
 313   int i;
 314   FcPattern *pattern = NULL;
 315   FcCharSet *charset = NULL;
 316   FcLangSet *langset = NULL;
 317   FcFontSet *fontset = NULL;
 318   FcObjectSet *objset = NULL;
 319   Lisp_Object script;
 320   Lisp_Object registry = Qunicode_bmp;
 321   int weight = 0;
 322   double dpi = -1;
 323   int spacing = -1;
 324   int scalable = -1;
 325   char otf_script[15];          /* For "otlayout\:XXXX" */
 326
 327   val = null_vector;
 328
 329   if (! fc_initialized)
 330     {
 331       FcInit ();
 332       fc_initialized = 1;
 333     }
 334
 335   if (! NILP (AREF (spec, FONT_ADSTYLE_INDEX))
 336       && ! EQ (AREF (spec, FONT_ADSTYLE_INDEX), null_string))
 337     return val;
 338   if (! NILP (AREF (spec, FONT_SLANT_INDEX))
 339       && XINT (AREF (spec, FONT_SLANT_INDEX)) < 100)
 340     /* Fontconfig doesn't support reverse-italic/obligue.  */
 341     return val;
 342
 343   if (! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
 344     {
 345       registry = AREF (spec, FONT_REGISTRY_INDEX);
 346       if (EQ (registry, Qiso8859_1))
 347         {
 348           if (! cs_iso8859_1
 349               && ftfont_build_basic_charsets () < 0)
 350             return Qnil;
 351           charset = cs_iso8859_1;
 352         }
 353       else if (! EQ (registry, Qiso10646_1) && ! EQ (registry, Qunicode_bmp))
 354         return val;
 355     }
 356
 357   otf_script[0] = '\0';
 358   script = Qnil;
 359   for (extra = AREF (spec, FONT_EXTRA_INDEX);
 360        CONSP (extra); extra = XCDR (extra))
 361     {
 362       Lisp_Object key, val;
 363
 364       tmp = XCAR (extra);
 365       key = XCAR (tmp), val = XCDR (tmp);
 366       if (EQ (key, QCotf))
 367         {
 368           script = assq_no_quit (val, Votf_script_alist);
 369           if (CONSP (script) && SYMBOLP (XCDR (script)))
 370             script = XCDR (script);
 371           tmp = SYMBOL_NAME (val);
 372           sprintf (otf_script, "otlayout:%s", (char *) SDATA (tmp));
 373         }
 374       else if (EQ (key, QClanguage))
 375         {
 376           langset = FcLangSetCreate ();
 377           if (! langset)
 378             goto err;
 379           if (SYMBOLP (val))
 380             {
 381               if (! FcLangSetAdd (langset, SYMBOL_FcChar8 (val)))
 382                 goto err;
 383             }
 384           else
 385             for (; CONSP (val); val = XCDR (val))
 386               if (SYMBOLP (XCAR (val))
 387                   && ! FcLangSetAdd (langset, SYMBOL_FcChar8 (XCAR (val))))
 388                 goto err;
 389         }
 390       else if (EQ (key, QCscript))
 391         script = val;
 392       else if (EQ (key, QCdpi))
 393         dpi = XINT (val);
 394       else if (EQ (key, QCspacing))
 395         spacing = XINT (val);
 396       else if (EQ (key, QCscalable))
 397         scalable = ! NILP (val);
 398     }
 399
 400   if (! NILP (script) && ! charset)
 401     {
 402       Lisp_Object chars = assq_no_quit (script, Vscript_representative_chars);
 403
 404       if (CONSP (chars))
 405         {
 406           charset = FcCharSetCreate ();
 407           if (! charset)
 408             goto err;
 409           for (chars = XCDR (chars); CONSP (chars); chars = XCDR (chars))
 410             if (CHARACTERP (XCAR (chars))
 411                 && ! FcCharSetAddChar (charset, XUINT (XCAR (chars))))
 412               goto err;
 413         }
 414     }
 415
 416   pattern = FcPatternCreate ();
 417   if (! pattern)
 418     goto err;
 419   tmp = AREF (spec, FONT_FOUNDRY_INDEX);
 420   if (SYMBOLP (tmp) && ! NILP (tmp)
 421       && ! FcPatternAddString (pattern, FC_FOUNDRY, SYMBOL_FcChar8 (tmp)))
 422     goto err;
 423   tmp = AREF (spec, FONT_FAMILY_INDEX);
 424   if (SYMBOLP (tmp) && ! NILP (tmp)
 425       && ! FcPatternAddString (pattern, FC_FAMILY, SYMBOL_FcChar8 (tmp)))
 426     goto err;
 427   /* Emacs conventionally doesn't distinguish normal, regular, and
 428      medium weight, but fontconfig does.  So, we can't restrict font
 429      listing by weight.  We check it after getting a list.  */
 430   tmp = AREF (spec, FONT_WEIGHT_INDEX);
 431   if (INTEGERP (tmp))
 432     weight = XINT (tmp);
 433   tmp = AREF (spec, FONT_SLANT_INDEX);
 434   if (INTEGERP (tmp)
 435       && ! FcPatternAddInteger (pattern, FC_SLANT, XINT (tmp) - 100))
 436     goto err;
 437   tmp = AREF (spec, FONT_WIDTH_INDEX);
 438   if (INTEGERP (tmp)
 439       && ! FcPatternAddInteger (pattern, FC_WIDTH, XINT (tmp)))
 440     goto err;
 441
 442   if (charset
 443       && ! FcPatternAddCharSet (pattern, FC_CHARSET, charset))
 444     goto err;
 445   if (langset
 446       && ! FcPatternAddLangSet (pattern, FC_LANG, langset))
 447     goto err;
 448   if (dpi >= 0
 449       && ! FcPatternAddDouble (pattern, FC_DPI, dpi))
 450     goto err;
 451   if (spacing >= 0
 452       && ! FcPatternAddInteger (pattern, FC_SPACING, spacing))
 453     goto err;
 454   if (scalable >= 0
 455       && ! FcPatternAddBool (pattern, FC_SCALABLE, scalable ? FcTrue : FcFalse))
 456     goto err;
 457
 458   objset = FcObjectSetBuild (FC_FOUNDRY, FC_FAMILY, FC_WEIGHT, FC_SLANT,
 459                              FC_WIDTH, FC_PIXEL_SIZE, FC_SPACING,
 460                              FC_CHARSET, FC_FILE, NULL);
 461   if (! objset)
 462     goto err;
 463   if (otf_script[0])
 464     {
 465 #ifndef FC_CAPABILITY
 466       goto finish;
 467 #else  /* not FC_CAPABILITY */
 468       if (! FcObjectSetAdd (objset, FC_CAPABILITY))
 469         goto err;
 470 #endif  /* not FC_CAPABILITY */
 471     }
 472
 473   fontset = FcFontList (NULL, pattern, objset);
 474   if (! fontset)
 475     goto err;
 476
 477   if (fontset->nfont > 0)
 478     {
 479       double pixel_size;
 480
 481       if (NILP (AREF (spec, FONT_SIZE_INDEX)))
 482         pixel_size = 0;
 483       else
 484         pixel_size = XINT (AREF (spec, FONT_SIZE_INDEX));
 485
 486       for (i = 0, val = Qnil; i < fontset->nfont; i++)
 487         {
 488           Lisp_Object entity;
 489
 490           if (pixel_size > 0)
 491             {
 492               double this;
 493
 494               if (FcPatternGetDouble (fontset->fonts[i], FC_PIXEL_SIZE, 0,
 495                                       &this) == FcResultMatch
 496                   && ((this < pixel_size - FONT_PIXEL_SIZE_QUANTUM)
 497                       || (this > pixel_size + FONT_PIXEL_SIZE_QUANTUM)))
 498                 continue;
 499             }
 500           if (weight > 0)
 501             {
 502               int this;
 503
 504               if (FcPatternGetInteger (fontset->fonts[i], FC_WEIGHT, 0,
 505                                        &this) != FcResultMatch
 506                   || (this != weight
 507                       && (weight != 100
 508                           || this < FC_WEIGHT_REGULAR
 509                           || this > FC_WEIGHT_MEDIUM)))
 510                 continue;
 511             }
 512 #ifdef FC_CAPABILITY
 513           if (otf_script[0])
 514             {
 515               FcChar8 *this;
 516
 517               if (FcPatternGetString (fontset->fonts[i], FC_CAPABILITY, 0,
 518                                       &this) != FcResultMatch
 519                   || ! strstr ((char *) this, otf_script))
 520                 continue;
 521             }
 522 #endif  /* FC_CAPABILITY */
 523           entity = ftfont_pattern_entity (fontset->fonts[i], frame, registry);
 524           if (! NILP (entity))
 525             val = Fcons (entity, val);
 526         }
 527       val = Fvconcat (1, &val);
 528     }
 529   else if (! NILP (AREF (spec, FONT_FAMILY_INDEX)))
 530     val = ftfont_list_generic_family (spec, frame, registry);
 531   goto finish;
 532
 533  err:
 534   /* We come here because of unexpected error in fontconfig API call
 535      (usually insufficient memory).  */
 536   val = Qnil;
 537
 538  finish:
 539   if (charset && charset != cs_iso8859_1) FcCharSetDestroy (charset);
 540   if (objset) FcObjectSetDestroy (objset);
 541   if (fontset) FcFontSetDestroy (fontset);
 542   if (langset) FcLangSetDestroy (langset);
 543   if (pattern) FcPatternDestroy (pattern);
 544
 545   return val;
 546 }
 547
 548 static Lisp_Object
 549 ftfont_match (frame, spec)
 550      Lisp_Object frame, spec;
 551 {
 552   Lisp_Object extra, val, entity;
 553   FcPattern *pattern = NULL, *match = NULL;
 554   FcResult result;
 555
 556   if (! fc_initialized)
 557     {
 558       FcInit ();
 559       fc_initialized = 1;
 560     }
 561
 562   extra = AREF (spec, FONT_EXTRA_INDEX);
 563   val = assq_no_quit (QCname, extra);
 564   if (! CONSP (val) || ! STRINGP (XCDR (val)))
 565     return Qnil;
 566
 567   entity = Qnil;
 568   pattern = FcNameParse (SDATA (XCDR (val)));
 569   if (pattern)
 570     {
 571       if (FcConfigSubstitute (NULL, pattern, FcMatchPattern) == FcTrue)
 572         {
 573           FcDefaultSubstitute (pattern);
 574           match = FcFontMatch (NULL, pattern, &result);
 575           if (match)
 576             {
 577               entity = ftfont_pattern_entity (match, frame, Qunicode_bmp);
 578               FcPatternDestroy (match);
 579             }
 580         }
 581       FcPatternDestroy (pattern);
 582     }
 583
 584   return entity;
 585 }
 586
 587 static Lisp_Object
 588 ftfont_list_family (frame)
 589      Lisp_Object frame;
 590 {
 591   Lisp_Object list;
 592   FcPattern *pattern = NULL;
 593   FcFontSet *fontset = NULL;
 594   FcObjectSet *objset = NULL;
 595   int i;
 596
 597   if (! fc_initialized)
 598     {
 599       FcInit ();
 600       fc_initialized = 1;
 601     }
 602
 603   pattern = FcPatternCreate ();
 604   if (! pattern)
 605     goto finish;
 606   objset = FcObjectSetBuild (FC_FAMILY, NULL);
 607   if (! objset)
 608     goto finish;
 609   fontset = FcFontList (NULL, pattern, objset);
 610   if (! fontset)
 611     goto finish;
 612
 613   list = Qnil;
 614   for (i = 0; i < fontset->nfont; i++)
 615     {
 616       FcPattern *pat = fontset->fonts[i];
 617       FcChar8 *str;
 618
 619       if (FcPatternGetString (pat, FC_FAMILY, 0, &str) == FcResultMatch)
 620         list = Fcons (intern_downcase ((char *) str, strlen ((char *) str)),
 621                       list);
 622     }
 623
 624  finish:
 625   if (objset) FcObjectSetDestroy (objset);
 626   if (fontset) FcFontSetDestroy (fontset);
 627   if (pattern) FcPatternDestroy (pattern);
 628
 629   return list;
 630 }
 631
 632
 633 static void
 634 ftfont_free_entity (entity)
 635      Lisp_Object entity;
 636 {
 637   Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX);
 638   FcPattern *pattern = XSAVE_VALUE (val)->pointer;
 639
 640   FcPatternDestroy (pattern);
 641 }
 642
 643 static struct font *
 644 ftfont_open (f, entity, pixel_size)
 645      FRAME_PTR f;
 646      Lisp_Object entity;
 647      int pixel_size;
 648 {
 649   struct ftfont_info *ftfont_info;
 650   struct font *font;
 651   FT_Face ft_face;
 652   FT_Size ft_size;
 653   FT_UInt size;
 654   Lisp_Object val;
 655   FcPattern *pattern;
 656   FcChar8 *file;
 657   int spacing;
 658   char *name;
 659   int len;
 660
 661   val = AREF (entity, FONT_EXTRA_INDEX);
 662   if (XTYPE (val) != Lisp_Misc
 663       || XMISCTYPE (val) != Lisp_Misc_Save_Value)
 664     return NULL;
 665   pattern = XSAVE_VALUE (val)->pointer;
 666   if (XSAVE_VALUE (val)->integer == 0)
 667     {
 668       /* We have not yet created FT_Face for this font.  */
 669       if (! ft_library
 670           && FT_Init_FreeType (&ft_library) != 0)
 671         return NULL;
 672       if (FcPatternGetString (pattern, FC_FILE, 0, &file) != FcResultMatch)
 673         return NULL;
 674       if (FT_New_Face (ft_library, (char *) file, 0, &ft_face) != 0)
 675         return NULL;
 676       FcPatternAddFTFace (pattern, FC_FT_FACE, ft_face);
 677       ft_size = ft_face->size;
 678     }
 679   else
 680     {
 681       if (FcPatternGetFTFace (pattern, FC_FT_FACE, 0, &ft_face)
 682           != FcResultMatch)
 683         return NULL;
 684       if (FT_New_Size (ft_face, &ft_size) != 0)
 685         return NULL;
 686       if (FT_Activate_Size (ft_size) != 0)
 687         {
 688           FT_Done_Size (ft_size);
 689           return NULL;
 690         }
 691     }
 692
 693   size = XINT (AREF (entity, FONT_SIZE_INDEX));
 694   if (size == 0)
 695     size = pixel_size;
 696   if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0)
 697     {
 698       if (XSAVE_VALUE (val)->integer == 0)
 699         FT_Done_Face (ft_face);
 700       return NULL;
 701     }
 702
 703   ftfont_info = malloc (sizeof (struct ftfont_info));
 704   if (! ftfont_info)
 705     return NULL;
 706   ftfont_info->ft_size = ft_size;
 707
 708   font = (struct font *) ftfont_info;
 709   font->entity = entity;
 710   font->pixel_size = size;
 711   font->driver = &ftfont_driver;
 712   len = 96;
 713   name = malloc (len);
 714   while (name && font_unparse_fcname (entity, pixel_size, name, len) < 0)
 715     {
 716       char *new = realloc (name, len += 32);
 717
 718       if (! new)
 719         free (name);
 720       name = new;
 721     }
 722   font->font.full_name = font->font.name = name;
 723   font->file_name = (char *) file;
 724   font->font.size = ft_face->size->metrics.max_advance >> 6;
 725   if (font->font.size <= 0)
 726     font->font.size = size;
 727   font->font.charset = font->encoding_charset = font->repertory_charset = -1;
 728   font->ascent = ft_face->size->metrics.ascender >> 6;
 729   font->descent = - ft_face->size->metrics.descender >> 6;
 730   font->font.height = font->ascent + font->descent;
 731   if (FcPatternGetInteger (pattern, FC_SPACING, 0, &spacing) != FcResultMatch)
 732     spacing = FC_PROPORTIONAL;
 733   if (spacing != FC_PROPORTIONAL)
 734     font->font.average_width = font->font.space_width = font->font.size;
 735   else
 736     {
 737       int i;
 738
 739       for (i = 32; i < 127; i++)
 740         {
 741           if (FT_Load_Char (ft_face, i, FT_LOAD_DEFAULT) != 0)
 742             break;
 743           if (i == 32)
 744             font->font.space_width = ft_face->glyph->metrics.horiAdvance >> 6;
 745           font->font.average_width += ft_face->glyph->metrics.horiAdvance >> 6;
 746         }
 747       if (i == 127)
 748         {
 749           /* The font contains all ASCII printable characters.  */
 750           font->font.average_width /= 95;
 751         }
 752       else
 753         {
 754           if (i == 32)
 755             font->font.space_width = font->font.size;
 756           font->font.average_width = font->font.size;
 757         }
 758     }
 759
 760   /* Unfortunately FreeType doesn't provide a way to get minimum char
 761      width.  So, we use space_width instead.  */
 762   font->min_width = font->font.space_width;
 763
 764   font->font.baseline_offset = 0;
 765   font->font.relative_compose = 0;
 766   font->font.default_ascent = 0;
 767   font->font.vertical_centering = 0;
 768
 769   (XSAVE_VALUE (val)->integer)++;
 770
 771   return font;
 772 }
 773
 774 static void
 775 ftfont_close (f, font)
 776      FRAME_PTR f;
 777      struct font *font;
 778 {
 779   struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
 780   Lisp_Object entity = font->entity;
 781   Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX);
 782
 783   (XSAVE_VALUE (val)->integer)--;
 784   if (XSAVE_VALUE (val)->integer == 0)
 785     FT_Done_Face (ftfont_info->ft_size->face);
 786   else
 787     FT_Done_Size (ftfont_info->ft_size);
 788
 789   free (font);
 790 }
 791
 792 static int
 793 ftfont_has_char (entity, c)
 794      Lisp_Object entity;
 795      int c;
 796 {
 797   Lisp_Object val;
 798   FcPattern *pattern;
 799   FcCharSet *charset;
 800
 801   val = AREF (entity, FONT_EXTRA_INDEX);
 802   pattern = XSAVE_VALUE (val)->pointer;
 803   if (FcPatternGetCharSet (pattern, FC_CHARSET, 0, &charset) != FcResultMatch)
 804     return -1;
 805   return (FcCharSetHasChar (charset, (FcChar32) c) == FcTrue);
 806 }
 807
 808 static unsigned
 809 ftfont_encode_char (font, c)
 810      struct font *font;
 811      int c;
 812 {
 813   struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
 814   FT_Face ft_face = ftfont_info->ft_size->face;
 815   FT_ULong charcode = c;
 816   FT_UInt code = FT_Get_Char_Index (ft_face, charcode);
 817
 818   return (code > 0 ? code : 0xFFFFFFFF);
 819 }
 820
 821 static int
 822 ftfont_text_extents (font, code, nglyphs, metrics)
 823      struct font *font;
 824      unsigned *code;
 825      int nglyphs;
 826      struct font_metrics *metrics;
 827 {
 828   struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
 829   FT_Face ft_face = ftfont_info->ft_size->face;
 830   int width = 0;
 831   int i;
 832
 833   if (ftfont_info->ft_size != ft_face->size)
 834     FT_Activate_Size (ftfont_info->ft_size);
 835   if (metrics)
 836     bzero (metrics, sizeof (struct font_metrics));
 837   for (i = 0; i < nglyphs; i++)
 838     {
 839       if (FT_Load_Glyph (ft_face, code[i], FT_LOAD_DEFAULT) == 0)
 840         {
 841           FT_Glyph_Metrics *m = &ft_face->glyph->metrics;
 842
 843           if (metrics)
 844             {
 845               if (metrics->lbearing > width + (m->horiBearingX >> 6))
 846                 metrics->lbearing = width + (m->horiBearingX >> 6);
 847               if (metrics->rbearing
 848                   < width + ((m->horiBearingX + m->width) >> 6))
 849                 metrics->rbearing
 850                   = width + ((m->horiBearingX + m->width) >> 6);
 851               if (metrics->ascent < (m->horiBearingY >> 6))
 852                 metrics->ascent = m->horiBearingY >> 6;
 853               if (metrics->descent > ((m->horiBearingY + m->height) >> 6))
 854                 metrics->descent = (m->horiBearingY + m->height) >> 6;
 855             }
 856           width += m->horiAdvance >> 6;
 857         }
 858       else
 859         {
 860           width += font->font.space_width;
 861         }
 862     }
 863   if (metrics)
 864     metrics->width = width;
 865
 866   return width;
 867 }
 868
 869 static int
 870 ftfont_get_bitmap (font, code, bitmap, bits_per_pixel)
 871      struct font *font;
 872      unsigned code;
 873      struct font_bitmap *bitmap;
 874      int bits_per_pixel;
 875 {
 876   struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
 877   FT_Face ft_face = ftfont_info->ft_size->face;
 878   FT_Int32 load_flags = FT_LOAD_RENDER;
 879
 880   if (ftfont_info->ft_size != ft_face->size)
 881     FT_Activate_Size (ftfont_info->ft_size);
 882   if (bits_per_pixel == 1)
 883     {
 884 #ifdef FT_LOAD_TARGET_MONO
 885       load_flags |= FT_LOAD_TARGET_MONO;
 886 #else
 887       load_flags |= FT_LOAD_MONOCHROME;
 888 #endif
 889     }
 890   else if (bits_per_pixel != 8)
 891     /* We don't support such a rendering.  */
 892     return -1;
 893
 894   if (FT_Load_Glyph (ft_face, code, load_flags) != 0)
 895     return -1;
 896   bitmap->rows = ft_face->glyph->bitmap.rows;
 897   bitmap->width = ft_face->glyph->bitmap.width;
 898   bitmap->pitch = ft_face->glyph->bitmap.pitch;
 899   bitmap->buffer = ft_face->glyph->bitmap.buffer;
 900   bitmap->left = ft_face->glyph->bitmap_left;
 901   bitmap->top = ft_face->glyph->bitmap_top;
 902   bitmap->advance = ft_face->glyph->metrics.horiAdvance >> 6;
 903   bitmap->extra = NULL;
 904
 905   return 0;
 906 }
 907
 908 static int
 909 ftfont_anchor_point (font, code, index, x, y)
 910      struct font *font;
 911      unsigned code;
 912      int index;
 913      int *x, *y;
 914 {
 915   struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
 916   FT_Face ft_face = ftfont_info->ft_size->face;
 917
 918   if (ftfont_info->ft_size != ft_face->size)
 919     FT_Activate_Size (ftfont_info->ft_size);
 920   if (FT_Load_Glyph (ft_face, code, FT_LOAD_DEFAULT) != 0)
 921     return -1;
 922   if (ft_face->glyph->format != FT_GLYPH_FORMAT_OUTLINE)
 923     return -1;
 924   if (index >= ft_face->glyph->outline.n_points)
 925     return -1;
 926   *x = ft_face->glyph->outline.points[index].x;
 927   *y = ft_face->glyph->outline.points[index].y;
 928   return 0;
 929 }
 930
 931 \f
 932 void
 933 syms_of_ftfont ()
 934 {
 935   DEFSYM (Qfreetype, "freetype");
 936   DEFSYM (Qmonospace, "monospace");
 937   DEFSYM (Qsans_serif, "sans-serif");
 938   DEFSYM (Qserif, "serif");
 939   DEFSYM (Qmono, "mono");
 940   DEFSYM (Qsans, "sans");
 941   DEFSYM (Qsans__serif, "sans serif");
 942
 943   staticpro (&freetype_font_cache);
 944   freetype_font_cache = Fcons (Qt, Qnil);
 945
 946   staticpro (&ftfont_generic_family_list);
 947   ftfont_generic_family_list
 948     = Fcons (Fcons (Qmonospace, Qt),
 949              Fcons (Fcons (Qsans_serif, Qt),
 950                     Fcons (Fcons (Qsans, Qt), Qnil)));
 951
 952   ftfont_driver.type = Qfreetype;
 953   register_font_driver (&ftfont_driver, NULL);
 954 }
 955
 956 /* arch-tag: 7cfa432c-33a6-4988-83d2-a82ed8604aca
 957    (do not change this comment) */