src/w32font.c

   1 /* Font backend for the Microsoft W32 API.
   2    Copyright (C) 2007 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  19 Boston, MA 02110-1301, USA.  */
  20
  21 #include <config.h>
  22 #include <windows.h>
  23
  24 #include "lisp.h"
  25 #include "w32term.h"
  26 #include "frame.h"
  27 #include "dispextern.h"
  28 #include "character.h"
  29 #include "charset.h"
  30 #include "fontset.h"
  31 #include "font.h"
  32
  33 /* The actual structure for a w32 font, that can be cast to struct font.  */
  34 struct w32font_info
  35 {
  36   struct font font;
  37   TEXTMETRIC metrics;
  38   /* Unicode subset bitfield. See MSDN documentation for FONTSIGNATURE.  */
  39   DWORD *subranges;
  40 };
  41
  42 extern struct font_driver w32font_driver;
  43
  44 Lisp_Object Qw32;
  45 static Lisp_Object Qmodern, Qswiss, Qroman, Qdecorative, Qscript, Qunknown;
  46
  47 static void fill_in_logfont P_ ((FRAME_PTR f, LOGFONT *logfont,
  48                                  Lisp_Object font_spec));
  49
  50 static void set_fonts_frame P_ ((Lisp_Object fontlist, Lisp_Object frame));
  51
  52 static int unicode_range_for_char (unsigned c);
  53
  54 static void list_all_matching_fonts P_ ((Lisp_Object frame,
  55                                          LOGFONT *font_match_pattern,
  56                                          Lisp_Object* list));
  57
  58 /* From old font code in w32fns.c */
  59 char * w32_to_x_charset P_ ((int charset, char * matching));
  60
  61 static Lisp_Object w32_registry P_ ((LONG w32_charset));
  62
  63 /* EnumFontFamiliesEx callbacks.  */
  64 static int CALLBACK add_font_entity_to_list P_ ((ENUMLOGFONTEX *,
  65                                                  NEWTEXTMETRICEX *,
  66                                                  DWORD, LPARAM));
  67 static int CALLBACK add_one_font_entity_to_list P_ ((ENUMLOGFONTEX *,
  68                                                      NEWTEXTMETRICEX *,
  69                                                      DWORD, LPARAM));
  70 static int CALLBACK add_font_name_to_list P_ ((ENUMLOGFONTEX *,
  71                                                NEWTEXTMETRICEX *,
  72                                                DWORD, LPARAM));
  73
  74 /* W32 API functions only available on some versions of Windows  */
  75 typedef DWORD (*GETGLYPHINDICES) (HDC, wchar_t *, int, LPWORD, DWORD);
  76 typedef BOOL (*GETTEXTEXTENTPTI) (HDC, LPWORD, int, LPSIZE);
  77 static GETGLYPHINDICES get_glyph_indices_fn = NULL;
  78 static GETTEXTEXTENTPTI get_text_extent_pointi_fn = NULL;
  79 /* MingW headers only define this when _WIN32_WINNT >= 0x0500, but we
  80    target older versions.  */
  81 #define GGI_MARK_NONEXISTING_GLYPHS 1
  82
  83 static int
  84 memq_no_quit (elt, list)
  85      Lisp_Object elt, list;
  86 {
  87   while (CONSP (list) && ! EQ (XCAR (list), elt))
  88     list = XCDR (list);
  89   return (CONSP (list));
  90 }
  91
  92 /* w32 implementation of get_cache for font backend.
  93    Return a cache of font-entities on FRAME.  The cache must be a
  94    cons whose cdr part is the actual cache area.  */
  95 static Lisp_Object w32font_get_cache (Lisp_Object frame)
  96 {
  97   struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (frame));
  98
  99   return (dpyinfo->name_list_element);
 100 }
 101
 102 /* w32 implementation of list for font backend.
 103    List fonts exactly matching with FONT_SPEC on FRAME.  The value
 104    is a vector of font-entities.  This is the sole API that
 105    allocates font-entities.  */
 106 static Lisp_Object w32font_list (Lisp_Object frame, Lisp_Object font_spec)
 107 {
 108   Lisp_Object list = Qnil;
 109   LOGFONT font_match_pattern;
 110   HDC dc;
 111   FRAME_PTR f = XFRAME (frame);
 112
 113   bzero (&font_match_pattern, sizeof (font_match_pattern));
 114   fill_in_logfont (f, &font_match_pattern, font_spec);
 115
 116
 117   if (font_match_pattern.lfFaceName[0] == '\0')
 118     {
 119       /* EnumFontFamiliesEx does not take other fields into account if
 120          font name is blank, so need to use two passes.  */
 121       list_all_matching_fonts (frame, &font_match_pattern, &list);
 122     }
 123   else
 124     {
 125       dc = get_frame_dc (f);
 126
 127       EnumFontFamiliesEx (dc, &font_match_pattern,
 128                           (FONTENUMPROC) add_font_entity_to_list,
 129                           (LPARAM) &list, 0);
 130       release_frame_dc (f, dc);
 131     }
 132
 133   set_fonts_frame (list, frame);
 134
 135   return list;
 136 }
 137
 138 /* w32 implementation of match for font backend.
 139    Return a font entity most closely matching with FONT_SPEC on
 140    FRAME.  The closeness is detemined by the font backend, thus
 141    `face-font-selection-order' is ignored here.  */
 142 static Lisp_Object w32font_match (Lisp_Object frame, Lisp_Object font_spec)
 143 {
 144   Lisp_Object list = Qnil;
 145   LOGFONT font_match_pattern;
 146   HDC dc;
 147   FRAME_PTR f = XFRAME (frame);
 148
 149   bzero (&font_match_pattern, sizeof (font_match_pattern));
 150   fill_in_logfont (f, &font_match_pattern, font_spec);
 151
 152   dc = get_frame_dc (f);
 153
 154   EnumFontFamiliesEx (dc, &font_match_pattern,
 155                       (FONTENUMPROC) add_one_font_entity_to_list,
 156                       (LPARAM) &list, 0);
 157   release_frame_dc (f, dc);
 158
 159   set_fonts_frame (list, frame);
 160
 161   return NILP (list) ? Qnil : XCAR (list);
 162 }
 163
 164
 165 /* w32 implementation of list_family for font backend.
 166    List available families.  The value is a list of family names
 167    (symbols).  */
 168 static Lisp_Object w32font_list_family (Lisp_Object frame)
 169 {
 170   Lisp_Object list = Qnil;
 171   LOGFONT font_match_pattern;
 172   HDC dc;
 173   FRAME_PTR f = XFRAME (frame);
 174
 175   bzero (&font_match_pattern, sizeof (font_match_pattern));
 176
 177   dc = get_frame_dc (f);
 178
 179   EnumFontFamiliesEx (dc, &font_match_pattern,
 180                       (FONTENUMPROC) add_font_name_to_list,
 181                       (LPARAM) &list, 0);
 182   release_frame_dc (f, dc);
 183
 184   return list;
 185 }
 186
 187 /* w32 implementation of open for font backend.
 188    Open a font specified by FONT_ENTITY on frame F.
 189    If the font is scalable, open it with PIXEL_SIZE.  */
 190 static struct font* w32font_open (FRAME_PTR f, Lisp_Object font_entity,
 191                                   int pixel_size)
 192 {
 193   int len, size;
 194   LOGFONT logfont;
 195   HDC dc;
 196   HFONT hfont, old_font;
 197   Lisp_Object val;
 198   /* For backwards compatibility.  */
 199   W32FontStruct *compat_w32_font;
 200
 201   struct w32font_info *w32_font = xmalloc (sizeof (struct w32font_info));
 202
 203   struct font * font = (struct font *) w32_font;
 204   if (!font)
 205     return NULL;
 206
 207   bzero (&logfont, sizeof (logfont));
 208   fill_in_logfont (f, &logfont, font_entity);
 209
 210   size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
 211   if (size == 0)
 212     size = pixel_size;
 213
 214   logfont.lfHeight = size;
 215   hfont = CreateFontIndirect (&logfont);
 216
 217   if (hfont == NULL)
 218     {
 219       xfree (w32_font);
 220       return NULL;
 221     }
 222
 223   /* Get the metrics for this font.  */
 224   dc = get_frame_dc (f);
 225   old_font = SelectObject (dc, hfont);
 226
 227   GetTextMetrics (dc, &w32_font->metrics);
 228
 229   SelectObject (dc, old_font);
 230   release_frame_dc (f, dc);
 231   /* W32FontStruct - we should get rid of this, and use the w32font_info
 232      struct for any W32 specific fields. font->font.font can then be hfont.  */
 233   font->font.font = xmalloc (sizeof (W32FontStruct));
 234   compat_w32_font = (W32FontStruct *) font->font.font;
 235   bzero (compat_w32_font, sizeof (W32FontStruct));
 236   compat_w32_font->font_type = UNICODE_FONT;
 237   /* Duplicate the text metrics.  */
 238   bcopy (&w32_font->metrics,  &compat_w32_font->tm, sizeof (TEXTMETRIC));
 239   compat_w32_font->hfont = hfont;
 240
 241   font->font.font_idx = 0;
 242   len = strlen (logfont.lfFaceName);
 243   font->font.name = (char *) xmalloc (len + 1);
 244   bcopy (logfont.lfFaceName, font->font.name, len);
 245   font->font.name[len] = '\0';
 246   font->font.full_name = font->font.name;
 247   font->font.charset = 0;
 248   font->font.codepage = 0;
 249   font->font.size = w32_font->metrics.tmMaxCharWidth;
 250   font->font.height = w32_font->metrics.tmHeight
 251     + w32_font->metrics.tmExternalLeading;
 252   font->font.space_width = font->font.average_width
 253     = w32_font->metrics.tmAveCharWidth;
 254
 255   font->font.vertical_centering = 0;
 256   font->font.encoding_type = 0;
 257   font->font.baseline_offset = 0;
 258   font->font.relative_compose = 0;
 259   font->font.default_ascent = w32_font->metrics.tmAscent;
 260   font->font.font_encoder = NULL;
 261   font->entity = font_entity;
 262   font->pixel_size = size;
 263   font->driver = &w32font_driver;
 264   font->format = Qw32;
 265   font->file_name = NULL;
 266   font->encoding_charset = -1;
 267   font->repertory_charset = -1;
 268   font->min_width = 0;
 269   font->ascent = w32_font->metrics.tmAscent;
 270   font->descent = w32_font->metrics.tmDescent;
 271   font->scalable = w32_font->metrics.tmPitchAndFamily & TMPF_VECTOR;
 272
 273   /* Truetype fonts will have extra information about the characters
 274      covered by the font.  */
 275   val = AREF (font_entity, FONT_EXTRA_INDEX);
 276   if (XTYPE (val) == Lisp_Misc && XMISCTYPE (val) == Lisp_Misc_Save_Value)
 277     ((struct w32font_info *)(font))->subranges = XSAVE_VALUE (val)->pointer;
 278   else
 279     ((struct w32font_info *)(font))->subranges = NULL;
 280
 281   return font;
 282 }
 283
 284 /* w32 implementation of close for font_backend.
 285    Close FONT on frame F.  */
 286 static void w32font_close (FRAME_PTR f, struct font *font)
 287 {
 288   if (font->font.font)
 289     {
 290       W32FontStruct *old_w32_font = (W32FontStruct *)font->font.font;
 291       DeleteObject (font->font.font);
 292       xfree (old_w32_font);
 293       font->font.font = 0;
 294     }
 295
 296   if (font->font.name)
 297     xfree (font->font.name);
 298   xfree (font);
 299 }
 300
 301 /* w32 implementation of has_char for font backend.
 302    Optional.
 303    If FONT_ENTITY has a glyph for character C (Unicode code point),
 304    return 1.  If not, return 0.  If a font must be opened to check
 305    it, return -1.  */
 306 static int w32font_has_char (Lisp_Object entity, int c)
 307 {
 308   Lisp_Object val;
 309   DWORD *ranges;
 310   int index;
 311   DWORD mask;
 312
 313   val = AREF (entity, FONT_EXTRA_INDEX);
 314   if (XTYPE (val) != Lisp_Misc || XMISCTYPE (val) != Lisp_Misc_Save_Value)
 315     return -1;
 316
 317   ranges = XSAVE_VALUE (val)->pointer;
 318
 319   index = unicode_range_for_char (c);
 320   mask = 1 << (index % 32);
 321   index = index / 32;
 322
 323   if (ranges[index] & mask)
 324     return 1;
 325   else
 326     return 0;
 327 }
 328
 329 /* w32 implementation of encode_char for font backend.
 330    Return a glyph code of FONT for characer C (Unicode code point).
 331    If FONT doesn't have such a glyph, return FONT_INVALID_CODE.  */
 332 static unsigned w32font_encode_char (struct font *font, int c)
 333 {
 334   if (get_glyph_indices_fn)
 335     {
 336       HFONT old_font;
 337       WORD glyph[2];
 338       int converted;
 339       /* FIXME: Be nice if we had a frame here, rather than getting
 340          the desktop's device context to measure against... */
 341       HDC dc = GetDC (NULL);
 342       wchar_t string[2];
 343       string[0] = c;
 344       string[1] = 0x0000;
 345
 346       if (get_glyph_indices_fn)
 347         converted = (*get_glyph_indices_fn) (dc, string, 1, glyph,
 348                                              GGI_MARK_NONEXISTING_GLYPHS);
 349
 350       /* Restore state and release DC.  */
 351       SelectObject (dc, old_font);
 352       ReleaseDC (NULL, dc);
 353       if (converted > 0 && glyph[0] != 0xFFFF)
 354         return glyph[0];
 355       else if (converted != GDI_ERROR)
 356         return FONT_INVALID_CODE;
 357     }
 358   /* On older platforms, or if the above fails, return the unicode
 359      code point.  */
 360   return c;
 361 }
 362
 363 /* w32 implementation of text_extents for font backend.
 364    Perform the size computation of glyphs of FONT and fillin members
 365    of METRICS.  The glyphs are specified by their glyph codes in
 366    CODE (length NGLYPHS).  Apparently medtrics can be NULL, in this
 367    case just return the overall width.  */
 368 static int w32font_text_extents (struct font *font,
 369                                  unsigned *code, int nglyphs,
 370                                  struct font_metrics *metrics)
 371 {
 372   int i;
 373   HFONT old_font;
 374   /* FIXME: Be nice if we had a frame here, rather than getting the desktop's
 375      device context to measure against... */
 376   HDC dc = GetDC (NULL);
 377   int total_width = 0;
 378
 379   /* TODO: Allow some extra room for surrogates. */
 380   WORD *wcode = alloca(nglyphs * sizeof (WORD));
 381
 382   old_font = SelectObject (dc, ((W32FontStruct *)(font->font.font))->hfont);
 383
 384   if (metrics)
 385     {
 386       GLYPHMETRICS gm;
 387       int i;
 388       UINT format = GGO_METRICS;
 389       if (get_text_extent_pointi_fn)
 390         format |= GGO_GLYPH_INDEX;
 391
 392       for (i = 0; i < nglyphs; i++)
 393         {
 394           if (GetGlyphOutline (dc, *(code + i), format, &gm, 0, NULL, NULL)
 395               != GDI_ERROR)
 396             {
 397               metrics[i].lbearing = gm.gmptGlyphOrigin.x;
 398               metrics[i].rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
 399               metrics[i].width = gm.gmCellIncX;
 400               metrics[i].ascent = -gm.gmptGlyphOrigin.y;
 401               metrics[i].descent = gm.gmBlackBoxY + gm.gmptGlyphOrigin.y;
 402             }
 403           else
 404             {
 405               metrics[i].lbearing = 0;
 406               metrics[i].rbearing = font->font.size
 407                 + ((struct w32font_info *) font)->metrics.tmOverhang;
 408               metrics[i].width = font->font.size;
 409               metrics[i].ascent = font->ascent;
 410               metrics[i].descent = font->descent;
 411             }
 412         }
 413     }
 414
 415   for (i = 0; i < nglyphs; i++)
 416     {
 417       if (code[i] < 0x10000)
 418         wcode[i] = code[i];
 419       else
 420         {
 421           /* TODO: Convert to surrogate, reallocating array if needed */
 422           wcode[i] = 0xffff;
 423         }
 424     }
 425
 426   if (get_text_extent_pointi_fn)
 427     {
 428       SIZE size;
 429       if ((*get_text_extent_pointi_fn) (dc, wcode, nglyphs, &size))
 430         {
 431           total_width = size.cx;
 432         }
 433     }
 434
 435   if (total_width == 0)
 436     {
 437       RECT rect;
 438       rect.top = 0; rect.bottom = font->font.height; rect.left = 0; rect.right = 1;
 439       DrawTextW (dc, wcode, nglyphs, &rect,
 440                  DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
 441       total_width = rect.right;
 442     }
 443   /* Restore state and release DC.  */
 444   SelectObject (dc, old_font);
 445   ReleaseDC (NULL, dc);
 446
 447   return total_width;
 448 }
 449
 450 /* w32 implementation of draw for font backend.
 451    Optional.
 452    Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
 453    position of frame F with S->FACE and S->GC.  If WITH_BACKGROUND
 454    is nonzero, fill the background in advance.  It is assured that
 455    WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).  */
 456 static int w32font_draw (struct glyph_string *s, int from, int to,
 457                          int x, int y, int with_background)
 458 {
 459   /* TODO: Do we need to specify ETO_GLYPH_INDEX or is char2b always utf-16?  */
 460   UINT options = 0;
 461
 462   if (with_background)
 463     {
 464       options = ETO_OPAQUE;
 465       SetBkColor (s->hdc, s->gc->background);
 466     }
 467   else
 468     SetBkMode (s->hdc, TRANSPARENT);
 469
 470   ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, to - from, NULL);
 471 }
 472
 473 /* w32 implementation of free_entity for font backend.
 474    Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
 475    Free FONT_EXTRA_INDEX field of FONT_ENTITY.
 476 static void w32font_free_entity (Lisp_Object entity);
 477   */
 478
 479 /* w32 implementation of prepare_face for font backend.
 480    Optional (if FACE->extra is not used).
 481    Prepare FACE for displaying characters by FONT on frame F by
 482    storing some data in FACE->extra.  If successful, return 0.
 483    Otherwise, return -1.
 484 static int w32font_prepare_face (FRAME_PTR f, struct face *face);
 485   */
 486 /* w32 implementation of done_face for font backend.
 487    Optional.
 488    Done FACE for displaying characters by FACE->font on frame F.
 489 static void w32font_done_face (FRAME_PTR f, struct face *face);  */
 490
 491 /* w32 implementation of get_bitmap for font backend.
 492    Optional.
 493    Store bitmap data for glyph-code CODE of FONT in BITMAP.  It is
 494    intended that this method is callled from the other font-driver
 495    for actual drawing.
 496 static int w32font_get_bitmap (struct font *font, unsigned code,
 497                                struct font_bitmap *bitmap,
 498                                int bits_per_pixel);
 499   */
 500 /* w32 implementation of free_bitmap for font backend.
 501    Optional.
 502    Free bitmap data in BITMAP.
 503 static void w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
 504   */
 505 /* w32 implementation of get_outline for font backend.
 506    Optional.
 507    Return an outline data for glyph-code CODE of FONT.  The format
 508    of the outline data depends on the font-driver.
 509 static void* w32font_get_outline (struct font *font, unsigned code);
 510   */
 511 /* w32 implementation of free_outline for font backend.
 512    Optional.
 513    Free OUTLINE (that is obtained by the above method).
 514 static void w32font_free_outline (struct font *font, void *outline);
 515   */
 516 /* w32 implementation of anchor_point for font backend.
 517    Optional.
 518    Get coordinates of the INDEXth anchor point of the glyph whose
 519    code is CODE.  Store the coordinates in *X and *Y.  Return 0 if
 520    the operations was successfull.  Otherwise return -1.
 521 static int w32font_anchor_point (struct font *font, unsigned code,
 522                                  int index, int *x, int *y);
 523   */
 524 /* w32 implementation of otf_capability for font backend.
 525    Optional.
 526    Return a list describing which scripts/languages FONT
 527    supports by which GSUB/GPOS features of OpenType tables.
 528 static Lisp_Object w32font_otf_capability (struct font *font);
 529   */
 530 /* w32 implementation of otf_drive for font backend.
 531    Optional.
 532    Apply FONT's OTF-FEATURES to the glyph string.
 533
 534    FEATURES specifies which OTF features to apply in this format:
 535       (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
 536    See the documentation of `font-drive-otf' for the detail.
 537
 538    This method applies the specified features to the codes in the
 539    elements of GSTRING-IN (between FROMth and TOth).  The output
 540    codes are stored in GSTRING-OUT at the IDXth element and the
 541    following elements.
 542
 543    Return the number of output codes.  If none of the features are
 544    applicable to the input data, return 0.  If GSTRING-OUT is too
 545    short, return -1.
 546 static int w32font_otf_drive (struct font *font, Lisp_Object features,
 547                               Lisp_Object gstring_in, int from, int to,
 548                               Lisp_Object gstring_out, int idx,
 549                               int alternate_subst);
 550   */
 551
 552 /* Callback function for EnumFontFamiliesEx.
 553  * Adds the name of a font to a Lisp list (passed in as the lParam arg).  */
 554 static int CALLBACK add_font_name_to_list (ENUMLOGFONTEX *logical_font,
 555                                            NEWTEXTMETRICEX *physical_font,
 556                                            DWORD font_type,
 557                                   LPARAM list_object)
 558 {
 559   Lisp_Object* list = (Lisp_Object *) list_object;
 560   Lisp_Object family = intern_downcase (logical_font->elfLogFont.lfFaceName,
 561                                         strlen (logical_font->elfLogFont.lfFaceName));
 562   if (! memq_no_quit (family, *list))
 563     *list = Fcons (family, *list);
 564
 565   return 1;
 566 }
 567
 568 /* Convert an enumerated Windows font to an Emacs font entity.  */
 569 Lisp_Object w32_enumfont_pattern_entity (ENUMLOGFONTEX *logical_font,
 570                                          NEWTEXTMETRICEX *physical_font,
 571                                          DWORD font_type)
 572 {
 573   Lisp_Object entity, tem;
 574   LOGFONT *lf = (LOGFONT*) logical_font;
 575   BYTE generic_type;
 576
 577   entity = Fmake_vector (make_number (FONT_ENTITY_MAX), null_string);
 578
 579   ASET (entity, FONT_TYPE_INDEX, Qw32);
 580   ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet));
 581   ASET (entity, FONT_OBJLIST_INDEX, Qnil);
 582
 583   /* Foundry is difficult to get in readable form on Windows.
 584      But Emacs crashes if it is not set, so set it to the generic type.  */
 585   generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
 586   if (generic_type == FF_DECORATIVE)
 587     tem = Qdecorative;
 588   else if (generic_type == FF_MODERN)
 589     tem = Qmodern;
 590   else if (generic_type == FF_ROMAN)
 591     tem = Qroman;
 592   else if (generic_type == FF_SCRIPT)
 593     tem = Qscript;
 594   else if (generic_type == FF_SWISS)
 595     tem = Qswiss;
 596   else
 597     tem = Qunknown;
 598
 599   ASET (entity, FONT_FOUNDRY_INDEX, tem);
 600
 601   ASET (entity, FONT_FAMILY_INDEX,
 602         intern_downcase (lf->lfFaceName, strlen (lf->lfFaceName)));
 603
 604   ASET (entity, FONT_WEIGHT_INDEX, make_number (lf->lfWeight));
 605   ASET (entity, FONT_SLANT_INDEX, make_number (lf->lfItalic ? 200 : 100));
 606   ASET (entity, FONT_WIDTH_INDEX,
 607         make_number (physical_font->ntmTm.tmAveCharWidth));
 608
 609   if (font_type & RASTER_FONTTYPE)
 610     ASET (entity, FONT_SIZE_INDEX, make_number (physical_font->ntmTm.tmHeight));
 611   else
 612     ASET (entity, FONT_SIZE_INDEX, make_number (0));
 613
 614   /* Cache unicode codepoints covered by this font, as there is no other way
 615      of getting this information easily.  */
 616   if (font_type & TRUETYPE_FONTTYPE)
 617     {
 618       DWORD *subranges = xmalloc(16);
 619       memcpy (subranges, physical_font->ntmFontSig.fsUsb, 16);
 620       ASET (entity, FONT_EXTRA_INDEX, make_save_value (subranges, 0));
 621     }
 622   return entity;
 623 }
 624
 625 /* Callback function for EnumFontFamiliesEx.
 626  * Adds the name of a font to a Lisp list (passed in as the lParam arg).  */
 627 static int CALLBACK add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
 628                                              NEWTEXTMETRICEX *physical_font,
 629                                              DWORD font_type,
 630                                              LPARAM list_object)
 631 {
 632   Lisp_Object *list = (Lisp_Object *) list_object;
 633   Lisp_Object entity = w32_enumfont_pattern_entity (logical_font,
 634                                                     physical_font, font_type);
 635   if (!NILP (entity))
 636     *list = Fcons (entity, *list);
 637
 638   return 1;
 639 }
 640
 641 /* Callback function for EnumFontFamiliesEx.
 642  * Adds the name of a font to a Lisp list (passed in as the lParam arg),
 643  * then terminate the search.  */
 644 static int CALLBACK add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
 645                                                  NEWTEXTMETRICEX *physical_font,
 646                                                  DWORD font_type,
 647                                                  LPARAM list_object)
 648 {
 649   add_font_entity_to_list (logical_font, physical_font, font_type, list_object);
 650   return 0;
 651 }
 652
 653 /* Convert a Lisp font registry (symbol) to a windows charset.  */
 654 static LONG registry_to_w32_charset (Lisp_Object charset)
 655 {
 656   if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
 657       || EQ (charset, Qunicode_sip))
 658     return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
 659   else if (EQ (charset, Qiso8859_1))
 660     return ANSI_CHARSET;
 661   else if (SYMBOLP (charset))
 662     return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
 663   else if (STRINGP (charset))
 664     return x_to_w32_charset (SDATA (charset));
 665   else
 666     return DEFAULT_CHARSET;
 667 }
 668
 669 static Lisp_Object w32_registry (LONG w32_charset)
 670 {
 671   if (w32_charset == ANSI_CHARSET)
 672     return Qiso8859_1;
 673   else
 674     {
 675       char * charset = w32_to_x_charset (w32_charset, NULL);
 676       return intern_downcase (charset, strlen(charset));
 677     }
 678 }
 679
 680 static void set_fonts_frame (Lisp_Object fontlist, Lisp_Object frame)
 681 {
 682   if (VECTORP (fontlist))
 683     ASET (fontlist, FONT_FRAME_INDEX, frame);
 684   else
 685     {
 686       for ( ; CONSP (fontlist); fontlist = XCDR (fontlist))
 687         {
 688           Lisp_Object entity = XCAR (fontlist);
 689           if (VECTORP (entity))
 690             ASET (entity, FONT_FRAME_INDEX, frame);
 691         }
 692     }
 693 }
 694
 695 /* Fill in all the available details of LOGFONT from FONT_SPEC.  */
 696 static void fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
 697 {
 698   Lisp_Object val, tmp, extra;
 699   int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
 700
 701   /* TODO: Allow user to override dpi settings.  */
 702
 703   /* Height  */
 704   tmp = AREF (font_spec, FONT_SIZE_INDEX);
 705   if (INTEGERP (tmp))
 706     logfont->lfHeight = -1 * XINT (tmp);
 707   else if (FLOATP (tmp))
 708     logfont->lfHeight = (int) (-1.0 *  dpi * XFLOAT_DATA (tmp) / 72.0);
 709
 710   /* Width  TODO: makes fonts look distorted.
 711   tmp = AREF (font_spec, FONT_WIDTH_INDEX);
 712   if (INTEGERP (tmp))
 713     logfont->lfWidth = XINT (tmp);
 714  */
 715
 716   /* Escapement  */
 717
 718   /* Orientation  */
 719
 720   /* Weight  */
 721   tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
 722   if (INTEGERP (tmp))
 723     logfont->lfWeight = XINT (tmp);
 724
 725   /* Italic  */
 726   tmp = AREF (font_spec, FONT_SLANT_INDEX);
 727   if (INTEGERP (tmp))
 728     {
 729       int slant = XINT (tmp);
 730       logfont->lfItalic = slant > 150 ? 1 : 0;
 731     }
 732
 733   /* Underline  */
 734
 735   /* Strikeout  */
 736
 737   /* Charset  */
 738   tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
 739   if (! NILP (tmp))
 740     {
 741       if (STRINGP (tmp))
 742         logfont->lfCharSet = x_to_w32_charset (SDATA (tmp));
 743       else
 744         logfont->lfCharSet = registry_to_w32_charset (tmp);
 745     }
 746
 747   /* Out Precision  */
 748   /* Clip Precision  */
 749   /* Quality  TODO: Allow different quality to be specified, so user
 750      can enable/disable anti-aliasing for individual fonts.  */
 751   logfont->lfQuality = DEFAULT_QUALITY;
 752
 753   /* Pitch and Family  */
 754   /* Facename  TODO: handle generic names  */
 755   tmp = AREF (font_spec, FONT_FAMILY_INDEX);
 756   /* Font families are interned  */
 757   if (SYMBOLP (tmp))
 758     strncpy (logfont->lfFaceName, SDATA (SYMBOL_NAME (tmp)), LF_FACESIZE);
 759   else if (STRINGP (tmp))
 760     strncpy (logfont->lfFaceName, SDATA (tmp), LF_FACESIZE);
 761
 762 }
 763
 764 static void list_all_matching_fonts (Lisp_Object frame,
 765                                      LOGFONT *font_match_pattern,
 766                                      Lisp_Object* list)
 767 {
 768   HDC dc;
 769   Lisp_Object families = w32font_list_family (frame);
 770   struct frame *f = XFRAME (frame);
 771
 772   dc = get_frame_dc (f);
 773
 774   while (!NILP (families))
 775     {
 776       Lisp_Object family = CAR (families);
 777       families = CDR (families);
 778       if (STRINGP (family))
 779         {
 780           /* TODO: Use the Unicode versions of the W32 APIs, so we can
 781              handle non-ASCII font names.  */
 782           char * name = SDATA (family);
 783           strncpy (font_match_pattern->lfFaceName, name, LF_FACESIZE);
 784           font_match_pattern->lfFaceName[LF_FACESIZE - 1] = '\0';
 785
 786           EnumFontFamiliesEx (dc, font_match_pattern,
 787                               (FONTENUMPROC) add_font_entity_to_list,
 788                               (LPARAM)&list, 0);
 789         }
 790     }
 791
 792   release_frame_dc (f, dc);
 793 }
 794
 795 static int unicode_range_for_char (unsigned c)
 796 {
 797   /* Is there really no Windows API function for this?!!! */
 798   if (c < 0x80)
 799     return 0;              // Basic Latin
 800   else if (c < 0x100)
 801     return 1;              // Latin-1 supplement
 802   else if (c < 0x180)
 803     return 2;              // Latin Extended-A
 804   else if (c < 0x250)
 805     return 3;              // Latin Extended-B
 806   else if (c < 0x2B0)
 807     return 4;              // IPA Extensions
 808   else if (c < 0x300)
 809     return 5;              // Spacing modifiers
 810   else if (c < 0x370)
 811     return 6;              // Combining diacritical marks
 812   else if (c < 0x400)
 813     return 7;              // Greek and Coptic
 814   else if (c < 0x530)
 815     return 9;              // Cyrillic, Cyrillic supplementary
 816   else if (c < 0x590)
 817     return 10;             // Armenian
 818   else if (c < 0x600)
 819     return 11;             // Hebrew
 820   else if (c < 0x700)
 821     return 13;             // Arabic
 822   else if (c < 0x750)
 823     return 71;             // Syriac
 824   else if (c < 0x780)
 825     return 13;             // Arabic supplement
 826   else if (c < 0x7c0)
 827     return 72;             // Thaana
 828   else if (c < 0x800)
 829     return 14;             // N'Ko
 830   else if (c < 0x900)
 831     return -1;             // Unsupported range
 832   else if (c < 0x980)
 833     return 15;             // Devanagari
 834   else if (c < 0xA00)
 835     return 16;             // Bengali
 836   else if (c < 0xA80)
 837     return 17;             // Gurmukhi
 838   else if (c < 0xB00)
 839     return 18;             // Gujarati
 840   else if (c < 0xB80)
 841     return 19;             // Oriya
 842   else if (c < 0xC00)
 843     return 20;             // Tamil
 844   else if (c < 0xC80)
 845     return 21;             // Telugu
 846   else if (c < 0xD00)
 847     return 22;             // Kannada
 848   else if (c < 0xD80)
 849     return 23;             // Malayalam
 850   else if (c < 0xE00)
 851     return 73;             // Sinhala
 852   else if (c < 0xE80)
 853     return 24;             // Thai
 854   else if (c < 0xF00)
 855     return 25;             // Lao
 856   else if (c < 0x1000)
 857     return 70;             // Tibetan
 858   else if (c < 0x10A0)
 859     return 74;             // Myanmar
 860   else if (c < 0x1100)
 861     return 26;             // Georgian
 862   else if (c < 0x1200)
 863     return 28;             // Hangul Jamo
 864   else if (c < 0x13A0)
 865     return 75;             // Ethiopic, Ethiopic Supplement
 866   else if (c < 0x1400)
 867     return 76;             // Cherokee
 868   else if (c < 0x1680)
 869     return 77;             // Unified Canadian Aboriginal Syllabics
 870   else if (c < 0x16A0)
 871     return 78;             // Ogham
 872   else if (c < 0x1700)
 873     return 79;             // Runic
 874   else if (c < 0x1780)
 875     return 84;             // Tagalog, Hanunoo, Buhid, Tagbanwa
 876   else if (c < 0x1800)
 877     return 80;             // Khmer
 878   else if (c < 0x18B0)
 879     return 81;             // Mongolian
 880   else if (c < 0x1900)
 881     return -1;             // Unsupported range
 882   else if (c < 0x1950)
 883     return 93;             // Limbu
 884   else if (c < 0x1980)
 885     return 94;             // Tai Le
 886   else if (c < 0x19E0)
 887     return 95;             // New Tai Le
 888   else if (c < 0x1A00)
 889     return 80;             // Khmer Symbols
 890   else if (c < 0x1A20)
 891     return 96;             // Buginese
 892   else if (c < 0x1B00)
 893     return -1;             // Unsupported range
 894   else if (c < 0x1B80)
 895     return 27;             // Balinese
 896   else if (c < 0x1D00)
 897     return -1;             // Unsupported range
 898   else if (c < 0x1DC0)
 899     return 4;              // Phonetic extensions + supplement
 900   else if (c < 0x1E00)
 901     return 6;              // Combining diacritical marks supplement
 902   else if (c < 0x1F00)
 903     return 29;             // Latin Extended additional
 904   else if (c < 0x2000)
 905     return 30;             // Greek Extended
 906   else if (c < 0x2070)
 907     return 31;             // General Punctuation
 908   else if (c < 0x20A0)
 909     return 32;             // Subscripts and Superscripts
 910   else if (c < 0x20D0)
 911     return 33;             // Currency symbols
 912   else if (c < 0x2100)
 913     return 34;             // Combining marks for diacriticals
 914   else if (c < 0x2150)
 915     return 35;             // Letterlike symbols
 916   else if (c < 0x2190)
 917     return 36;             // Number forms
 918   else if (c < 0x2200)
 919     return 37;             // Arrows
 920   else if (c < 0x2300)
 921     return 38;             // Mathematical operators
 922   else if (c < 0x2400)
 923     return 39;             // Miscellaneous technical
 924   else if (c < 0x2440)
 925     return 40;             // Control pictures
 926   else if (c < 0x2460)
 927     return 41;             // Optical character recognition
 928   else if (c < 0x2500)
 929     return 42;             // Enclosed alphanumerics
 930   else if (c < 0x2580)
 931     return 43;             // Box drawing
 932   else if (c < 0x25A0)
 933     return 44;             // Block elements
 934   else if (c < 0x2600)
 935     return 45;             // Geometric shapes
 936   else if (c < 0x2700)
 937     return 46;             // Miscellaneous symbols
 938   else if (c < 0x27C0)
 939     return 47;             // Dingbats
 940   else if (c < 0x27F0)
 941     return 38;             // Misc Math symbols-A
 942   else if (c < 0x2800)
 943     return 37;             // Supplemental arrows-A
 944   else if (c < 0x2900)
 945     return 82;             // Braille patterns
 946   else if (c < 0x2980)
 947     return 37;             // Supplemental arrows-B
 948   else if (c < 0x2B00)
 949     return 38;             // Misc Math symbols-B, Supplemental Math operators
 950   else if (c < 0x2C00)
 951     return 37;             // Misc Symbols and Arrows
 952   else if (c < 0x2C60)
 953     return 97;             // Galgolitic
 954   else if (c < 0x2C80)
 955     return 29;             // Latin Extended-C
 956   else if (c < 0x2D00)
 957     return 8;              // Coptic
 958   else if (c < 0x2D30)
 959     return 26;             // Georgian supplement
 960   else if (c < 0x2D80)
 961     return 98;             // Tifinagh
 962   else if (c < 0x2DE0)
 963     return 75;             // Ethiopic extended
 964   else if (c < 0x2E00)
 965     return -1;             // Unsupported range
 966   else if (c < 0x2E80)
 967     return 31;             // Supplemental punctuation
 968   else if (c < 0x2FE0)
 969     return 59;             // CJK radicals supplement, Kangxi radicals
 970   else if (c < 0x2FF0)
 971     return -1;             // Unsupported range
 972   else if (c < 0x3000)
 973     return 59;             // Ideographic description characters
 974   else if (c < 0x3040)
 975     return 48;             // CJK symbols and punctuation
 976   else if (c < 0x30A0)
 977     return 49;             // Hiragana
 978   else if (c < 0x3100)
 979     return 50;             // Katakana
 980   else if (c < 0x3130)
 981     return 51;             // Bopomofo
 982   else if (c < 0x3190)
 983     return 52;             // Hangul compatibility Jamo
 984   else if (c < 0x31A0)
 985     return 59;             // Kanbun
 986   else if (c < 0x31C0)
 987     return 51;             // Bopomofo extended
 988   else if (c < 0x31F0)
 989     return 61;             // CJK strokes
 990   else if (c < 0x3200)
 991     return 50;             // Katakana phonetic extensions
 992   else if (c < 0x3300)
 993     return 54;             // CJK enclosed letters and months
 994   else if (c < 0x3400)
 995     return 55;             // CJK compatibility
 996   else if (c < 0x4DC0)
 997     return 59;             // CJK unified ideographs extension-A
 998   else if (c < 0x4E00)
 999     return 99;             // Yijing Hexagram Symbols
1000   else if (c < 0xA000)
1001     return 59;             // CJK unified ideographs
1002   else if (c < 0xA4D0)
1003     return 83;             // Yi syllables, Yi radicals
1004   else if (c < 0xA700)
1005     return -1;             // Unsupported range
1006   else if (c < 0xA720)
1007     return 5;              // Modifier tone letters
1008   else if (c < 0xA800)
1009     return 29;             // Latin Extended-D
1010   else if (c < 0xA830)
1011     return 100;            // Syloti Nagri
1012   else if (c < 0xA840)
1013     return -1;             // Unsupported range
1014   else if (c < 0xA880)
1015     return 53;             // Phags-pa
1016   else if (c < 0xAC00)
1017     return -1;             // Unsupported range
1018   else if (c < 0xD7A4)
1019     return 56;             // Hangul syllables
1020   else if (c < 0xD800)
1021     return -1;             // Unsupported range
1022   else if (c < 0xE000)
1023     return 57;             // Surrogates
1024   else if (c < 0xF900)
1025     return 60;             // Private use (plane 0)
1026   else if (c < 0xFB00)
1027     return 61;             // CJK Compatibility ideographs
1028   else if (c < 0xFB50)
1029     return 62;             // Alphabetic Presentation Forms
1030   else if (c < 0xFE00)
1031     return 63;             // Arabic Presentation Forms-A
1032   else if (c < 0xFE10)
1033     return 91;             // Variation selectors
1034   else if (c < 0xFE20)
1035     return 65;             // Vertical forms
1036   else if (c < 0xFE30)
1037     return 64;             // Combining half marks
1038   else if (c < 0xFE50)
1039     return 65;             // CJK compatibility forms
1040   else if (c < 0xFE70)
1041     return 66;             // Small form variants
1042   else if (c < 0xFEFF)
1043     return 67;             // Arabic Presentation Forms-B
1044   else if (c == 0xFEFF)
1045     return -1;             // Unsupported range
1046   else if (c < 0xFFF0)
1047     return 68;             // Halfwidth and fullwidth forms
1048   else if (c <= 0xFFFF)
1049     return 69;             // Specials
1050
1051   // If int is 64 bit, it could represent characters from 10000 up, but
1052   // any font that handles them should have the surrogate bit set (57).
1053   return 57;
1054 }
1055
1056
1057 struct font_driver w32font_driver =
1058   {
1059     0, /* Qw32 */
1060     w32font_get_cache,
1061     w32font_list,
1062     w32font_match,
1063     w32font_list_family,
1064     NULL, /* free_entity */
1065     w32font_open,
1066     w32font_close,
1067     NULL, /* prepare_face */
1068     NULL, /* done_face */
1069     w32font_has_char,
1070     w32font_encode_char,
1071     w32font_text_extents,
1072     w32font_draw,
1073     NULL, /* get_bitmap */
1074     NULL, /* free_bitmap */
1075     NULL, /* get_outline */
1076     NULL, /* free_outline */
1077     NULL, /* anchor_point */
1078     NULL, /* otf_capability */
1079     NULL /* otf_drive */
1080   };
1081
1082 /* Initialize the font subsystem for the environment on which
1083    Emacs is running.   */
1084 void w32font_initialize ()
1085 {
1086   /* Load functions that might not exist on older versions of Windows.  */
1087   HANDLE gdi = LoadLibrary ("gdi32.dll");
1088
1089   get_glyph_indices_fn
1090     = (GETGLYPHINDICES) GetProcAddress (gdi, "GetGlyphIndicesW");
1091   get_text_extent_pointi_fn
1092     = (GETTEXTEXTENTPTI) GetProcAddress (gdi, "GetTextExtentPoint32W");
1093 }
1094
1095 /* Initialize state that does not change between invocations. This is only
1096    called when Emacs is dumped.  */
1097 void syms_of_w32font ()
1098 {
1099   DEFSYM (Qw32, "w32");
1100   DEFSYM (Qdecorative, "decorative");
1101   DEFSYM (Qmodern, "modern");
1102   DEFSYM (Qroman, "roman");
1103   DEFSYM (Qscript, "script");
1104   DEFSYM (Qswiss, "swiss");
1105   DEFSYM (Qunknown, "unknown");
1106
1107   w32font_driver.type = Qw32;
1108   register_font_driver (&w32font_driver, NULL);
1109 }