w32font.c 43.3 KB
Newer Older
Jason Rumney's avatar
Jason Rumney committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
/* Font backend for the Microsoft W32 API.
   Copyright (C) 2007 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */

#include <config.h>
#include <windows.h>

#include "lisp.h"
#include "w32term.h"
#include "frame.h"
#include "dispextern.h"
#include "character.h"
#include "charset.h"
#include "fontset.h"
#include "font.h"

/* The actual structure for a w32 font, that can be cast to struct font.  */
struct w32font_info
{
  struct font font;
  TEXTMETRIC metrics;
};

extern struct font_driver w32font_driver;

Jason Rumney's avatar
Jason Rumney committed
42
Lisp_Object Qgdi, QCfamily;
43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
static Lisp_Object Qmonospace, Qsans_serif, Qserif, Qmono, Qsans, Qsans__serif;
static Lisp_Object Qscript, Qdecorative, Qraster, Qoutline, Qunknown;

/* scripts */
static Lisp_Object Qlatin, Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
static Lisp_Object Qmusical_symbol, Qmathematical;

/* Font spacing symbols - defined in font.c.  */
extern Lisp_Object Qc, Qp, Qm;
Jason Rumney's avatar
Jason Rumney committed
60 61 62 63

static void fill_in_logfont P_ ((FRAME_PTR f, LOGFONT *logfont,
                                 Lisp_Object font_spec));

64
static Lisp_Object font_supported_scripts P_ ((FONTSIGNATURE * sig));
Jason Rumney's avatar
Jason Rumney committed
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81

/* From old font code in w32fns.c */
char * w32_to_x_charset P_ ((int charset, char * matching));

static Lisp_Object w32_registry P_ ((LONG w32_charset));

/* EnumFontFamiliesEx callbacks.  */
static int CALLBACK add_font_entity_to_list P_ ((ENUMLOGFONTEX *,
                                                 NEWTEXTMETRICEX *,
                                                 DWORD, LPARAM));
static int CALLBACK add_one_font_entity_to_list P_ ((ENUMLOGFONTEX *,
                                                     NEWTEXTMETRICEX *,
                                                     DWORD, LPARAM));
static int CALLBACK add_font_name_to_list P_ ((ENUMLOGFONTEX *,
                                               NEWTEXTMETRICEX *,
                                               DWORD, LPARAM));

82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
/* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
   of what we really want.  */
struct font_callback_data
{
  /* The logfont we are matching against. EnumFontFamiliesEx only matches
     face name and charset, so we need to manually match everything else
     in the callback function.  */
  LOGFONT pattern;
  /* The original font spec or entity.  */
  Lisp_Object orig_font_spec;
  /* The frame the font is being loaded on.  */
  Lisp_Object frame;
  /* The list to add matches to.  */
  Lisp_Object list;
};

/* Handles the problem that EnumFontFamiliesEx will not return all
   style variations if the font name is not specified.  */
static void list_all_matching_fonts P_ ((struct font_callback_data *match_data));


Jason Rumney's avatar
Jason Rumney committed
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
/* MingW headers only define this when _WIN32_WINNT >= 0x0500, but we
   target older versions.  */
#define GGI_MARK_NONEXISTING_GLYPHS 1

static int
memq_no_quit (elt, list)
     Lisp_Object elt, list;
{
  while (CONSP (list) && ! EQ (XCAR (list), elt))
    list = XCDR (list);
  return (CONSP (list));
}

/* w32 implementation of get_cache for font backend.
   Return a cache of font-entities on FRAME.  The cache must be a
   cons whose cdr part is the actual cache area.  */
119 120 121
static Lisp_Object
w32font_get_cache (frame)
     Lisp_Object frame;
Jason Rumney's avatar
Jason Rumney committed
122 123 124 125 126 127 128 129 130 131
{
  struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (frame));

  return (dpyinfo->name_list_element);
}

/* w32 implementation of list for font backend.
   List fonts exactly matching with FONT_SPEC on FRAME.  The value
   is a vector of font-entities.  This is the sole API that
   allocates font-entities.  */
132 133 134
static Lisp_Object
w32font_list (frame, font_spec)
     Lisp_Object frame, font_spec;
Jason Rumney's avatar
Jason Rumney committed
135
{
136 137
  Lisp_Object tem;
  struct font_callback_data match_data;
Jason Rumney's avatar
Jason Rumney committed
138 139 140
  HDC dc;
  FRAME_PTR f = XFRAME (frame);

141 142 143 144 145
  match_data.orig_font_spec = font_spec;
  match_data.list = Qnil;
  match_data.frame = frame;
  bzero (&match_data.pattern, sizeof (LOGFONT));
  fill_in_logfont (f, &match_data.pattern, font_spec);
Jason Rumney's avatar
Jason Rumney committed
146

147
  if (match_data.pattern.lfFaceName[0] == '\0')
Jason Rumney's avatar
Jason Rumney committed
148 149 150
    {
      /* EnumFontFamiliesEx does not take other fields into account if
         font name is blank, so need to use two passes.  */
151
      list_all_matching_fonts (&match_data);
Jason Rumney's avatar
Jason Rumney committed
152 153 154 155 156
    }
  else
    {
      dc = get_frame_dc (f);

157
      EnumFontFamiliesEx (dc, &match_data.pattern,
Jason Rumney's avatar
Jason Rumney committed
158
                          (FONTENUMPROC) add_font_entity_to_list,
159
                          (LPARAM) &match_data, 0);
Jason Rumney's avatar
Jason Rumney committed
160 161 162
      release_frame_dc (f, dc);
    }

163
  return NILP (match_data.list) ? null_vector : Fvconcat (1, &match_data.list);
Jason Rumney's avatar
Jason Rumney committed
164 165 166 167 168 169
}

/* w32 implementation of match for font backend.
   Return a font entity most closely matching with FONT_SPEC on
   FRAME.  The closeness is detemined by the font backend, thus
   `face-font-selection-order' is ignored here.  */
170 171 172
static Lisp_Object
w32font_match (frame, font_spec)
     Lisp_Object frame, font_spec;
Jason Rumney's avatar
Jason Rumney committed
173
{
174
  struct font_callback_data match_data;
Jason Rumney's avatar
Jason Rumney committed
175 176 177
  HDC dc;
  FRAME_PTR f = XFRAME (frame);

178 179 180 181 182
  match_data.orig_font_spec = font_spec;
  match_data.frame = frame;
  match_data.list = Qnil;
  bzero (&match_data.pattern, sizeof (LOGFONT));
  fill_in_logfont (f, &match_data.pattern, font_spec);
Jason Rumney's avatar
Jason Rumney committed
183 184 185

  dc = get_frame_dc (f);

186
  EnumFontFamiliesEx (dc, &match_data.pattern,
Jason Rumney's avatar
Jason Rumney committed
187
                      (FONTENUMPROC) add_one_font_entity_to_list,
188
                      (LPARAM) &match_data, 0);
Jason Rumney's avatar
Jason Rumney committed
189 190
  release_frame_dc (f, dc);

191
  return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
Jason Rumney's avatar
Jason Rumney committed
192 193 194 195 196 197
}


/* w32 implementation of list_family for font backend.
   List available families.  The value is a list of family names
   (symbols).  */
198 199 200
static Lisp_Object
w32font_list_family (frame)
     Lisp_Object frame;
Jason Rumney's avatar
Jason Rumney committed
201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221
{
  Lisp_Object list = Qnil;
  LOGFONT font_match_pattern;
  HDC dc;
  FRAME_PTR f = XFRAME (frame);

  bzero (&font_match_pattern, sizeof (font_match_pattern));

  dc = get_frame_dc (f);

  EnumFontFamiliesEx (dc, &font_match_pattern,
                      (FONTENUMPROC) add_font_name_to_list,
                      (LPARAM) &list, 0);
  release_frame_dc (f, dc);

  return list;
}

/* w32 implementation of open for font backend.
   Open a font specified by FONT_ENTITY on frame F.
   If the font is scalable, open it with PIXEL_SIZE.  */
222 223 224 225 226
static struct font *
w32font_open (f, font_entity, pixel_size)
     FRAME_PTR f;
     Lisp_Object font_entity;
     int pixel_size;
Jason Rumney's avatar
Jason Rumney committed
227
{
228
  int len, size;
Jason Rumney's avatar
Jason Rumney committed
229 230 231
  LOGFONT logfont;
  HDC dc;
  HFONT hfont, old_font;
232
  Lisp_Object val, extra;
Jason Rumney's avatar
Jason Rumney committed
233 234 235 236 237 238 239 240 241 242 243 244
  /* For backwards compatibility.  */
  W32FontStruct *compat_w32_font;

  struct w32font_info *w32_font = xmalloc (sizeof (struct w32font_info));

  struct font * font = (struct font *) w32_font;
  if (!font)
    return NULL;

  bzero (&logfont, sizeof (logfont));
  fill_in_logfont (f, &logfont, font_entity);

245
  size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
246
  if (!size)
247 248
    size = pixel_size;

249
  logfont.lfHeight = -size;
Jason Rumney's avatar
Jason Rumney committed
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
  hfont = CreateFontIndirect (&logfont);

  if (hfont == NULL)
    {
      xfree (w32_font);
      return NULL;
    }

  /* Get the metrics for this font.  */
  dc = get_frame_dc (f);
  old_font = SelectObject (dc, hfont);

  GetTextMetrics (dc, &w32_font->metrics);

  SelectObject (dc, old_font);
  release_frame_dc (f, dc);
  /* W32FontStruct - we should get rid of this, and use the w32font_info
     struct for any W32 specific fields. font->font.font can then be hfont.  */
  font->font.font = xmalloc (sizeof (W32FontStruct));
  compat_w32_font = (W32FontStruct *) font->font.font;
  bzero (compat_w32_font, sizeof (W32FontStruct));
  compat_w32_font->font_type = UNICODE_FONT;
  /* Duplicate the text metrics.  */
  bcopy (&w32_font->metrics,  &compat_w32_font->tm, sizeof (TEXTMETRIC));
  compat_w32_font->hfont = hfont;

  len = strlen (logfont.lfFaceName);
  font->font.name = (char *) xmalloc (len + 1);
  bcopy (logfont.lfFaceName, font->font.name, len);
  font->font.name[len] = '\0';
  font->font.full_name = font->font.name;
  font->font.charset = 0;
  font->font.codepage = 0;
283 284 285
  font->font.size = w32_font->metrics.tmMaxCharWidth;
  font->font.height = w32_font->metrics.tmHeight
    + w32_font->metrics.tmExternalLeading;
Jason Rumney's avatar
Jason Rumney committed
286 287 288 289 290 291 292 293 294 295
  font->font.space_width = font->font.average_width
    = w32_font->metrics.tmAveCharWidth;

  font->font.vertical_centering = 0;
  font->font.encoding_type = 0;
  font->font.baseline_offset = 0;
  font->font.relative_compose = 0;
  font->font.default_ascent = w32_font->metrics.tmAscent;
  font->font.font_encoder = NULL;
  font->entity = font_entity;
296
  font->pixel_size = size;
Jason Rumney's avatar
Jason Rumney committed
297
  font->driver = &w32font_driver;
Jason Rumney's avatar
Jason Rumney committed
298
  font->format = Qgdi;
Jason Rumney's avatar
Jason Rumney committed
299 300 301 302 303 304 305 306 307 308 309 310 311
  font->file_name = NULL;
  font->encoding_charset = -1;
  font->repertory_charset = -1;
  font->min_width = 0;
  font->ascent = w32_font->metrics.tmAscent;
  font->descent = w32_font->metrics.tmDescent;
  font->scalable = w32_font->metrics.tmPitchAndFamily & TMPF_VECTOR;

  return font;
}

/* w32 implementation of close for font_backend.
   Close FONT on frame F.  */
312 313 314 315
static void
w32font_close (f, font)
     FRAME_PTR f;
     struct font *font;
Jason Rumney's avatar
Jason Rumney committed
316 317 318 319
{
  if (font->font.font)
    {
      W32FontStruct *old_w32_font = (W32FontStruct *)font->font.font;
320
      DeleteObject (old_w32_font->hfont);
Jason Rumney's avatar
Jason Rumney committed
321 322 323 324 325 326 327 328 329 330 331 332 333 334
      xfree (old_w32_font);
      font->font.font = 0;
    }

  if (font->font.name)
    xfree (font->font.name);
  xfree (font);
}

/* w32 implementation of has_char for font backend.
   Optional.
   If FONT_ENTITY has a glyph for character C (Unicode code point),
   return 1.  If not, return 0.  If a font must be opened to check
   it, return -1.  */
335 336 337 338
static int
w32font_has_char (entity, c)
     Lisp_Object entity;
     int c;
Jason Rumney's avatar
Jason Rumney committed
339
{
340
  Lisp_Object supported_scripts, extra, script;
Jason Rumney's avatar
Jason Rumney committed
341 342
  DWORD mask;

343 344 345 346
  extra = AREF (entity, FONT_EXTRA_INDEX);
  if (!CONSP (extra))
    return -1;

347 348
  supported_scripts = assq_no_quit (QCscript, extra);
  if (!CONSP (supported_scripts))
Jason Rumney's avatar
Jason Rumney committed
349 350
    return -1;

351
  supported_scripts = XCDR (supported_scripts);
Jason Rumney's avatar
Jason Rumney committed
352

353
  script = CHAR_TABLE_REF (Vchar_script_table, c);
Jason Rumney's avatar
Jason Rumney committed
354

355
  return (memq_no_quit (script, supported_scripts)) ? 1 : 0;
Jason Rumney's avatar
Jason Rumney committed
356 357 358 359 360
}

/* w32 implementation of encode_char for font backend.
   Return a glyph code of FONT for characer C (Unicode code point).
   If FONT doesn't have such a glyph, return FONT_INVALID_CODE.  */
361 362 363 364
static unsigned
w32font_encode_char (font, c)
     struct font *font;
     int c;
Jason Rumney's avatar
Jason Rumney committed
365
{
366 367
  /* Avoid unneccesary conversion - all the Win32 APIs will take a unicode
     character.  */
Jason Rumney's avatar
Jason Rumney committed
368 369 370 371 372 373
  return c;
}

/* w32 implementation of text_extents for font backend.
   Perform the size computation of glyphs of FONT and fillin members
   of METRICS.  The glyphs are specified by their glyph codes in
374
   CODE (length NGLYPHS).  Apparently metrics can be NULL, in this
Jason Rumney's avatar
Jason Rumney committed
375
   case just return the overall width.  */
376 377 378 379 380 381
static int
w32font_text_extents (font, code, nglyphs, metrics)
     struct font *font;
     unsigned *code;
     int nglyphs;
     struct font_metrics *metrics;
Jason Rumney's avatar
Jason Rumney committed
382 383 384 385 386 387 388 389
{
  int i;
  HFONT old_font;
  /* FIXME: Be nice if we had a frame here, rather than getting the desktop's
     device context to measure against... */
  HDC dc = GetDC (NULL);
  int total_width = 0;
  WORD *wcode = alloca(nglyphs * sizeof (WORD));
390
  SIZE size;
Jason Rumney's avatar
Jason Rumney committed
391 392 393 394 395 396

  old_font = SelectObject (dc, ((W32FontStruct *)(font->font.font))->hfont);

  if (metrics)
    {
      GLYPHMETRICS gm;
397 398 399 400 401 402
      MAT2 transform;

      /* Set transform to the identity matrix.  */
      bzero (&transform, sizeof (transform));
      transform.eM11.value = 1;
      transform.eM22.value = 1;
403 404 405
      metrics->width = 0;
      metrics->ascent = 0;
      metrics->descent = 0;
Jason Rumney's avatar
Jason Rumney committed
406 407 408

      for (i = 0; i < nglyphs; i++)
        {
409
          if (GetGlyphOutlineW (dc, *(code + i), GGO_METRICS, &gm, 0,
410
                                NULL, &transform) != GDI_ERROR)
Jason Rumney's avatar
Jason Rumney committed
411
            {
412 413 414 415 416 417 418 419 420
              int new_val = metrics->width + gm.gmBlackBoxX
                + gm.gmptGlyphOrigin.x;

              metrics->rbearing = max (metrics->rbearing, new_val);
              metrics->width += gm.gmCellIncX;
              new_val = -gm.gmptGlyphOrigin.y;
              metrics->ascent = max (metrics->ascent, new_val);
              new_val = gm.gmBlackBoxY + gm.gmptGlyphOrigin.y;
              metrics->descent = max (metrics->descent, new_val);
421
            }
Jason Rumney's avatar
Jason Rumney committed
422 423
          else
            {
424 425
              /* Rely on an estimate based on the overall font metrics.  */
              break;
Jason Rumney's avatar
Jason Rumney committed
426 427
            }
        }
428 429 430 431 432 433 434 435 436 437

      /* If we got through everything, return.  */
      if (i == nglyphs)
        {
          /* Restore state and release DC.  */
          SelectObject (dc, old_font);
          ReleaseDC (NULL, dc);

          return metrics->width;
        }
Jason Rumney's avatar
Jason Rumney committed
438
    }
439 440

  for (i = 0; i < nglyphs; i++)
Jason Rumney's avatar
Jason Rumney committed
441
    {
442 443 444 445 446 447 448
      if (code[i] < 0x10000)
        wcode[i] = code[i];
      else
        {
          /* TODO: Convert to surrogate, reallocating array if needed */
          wcode[i] = 0xffff;
        }
Jason Rumney's avatar
Jason Rumney committed
449 450
    }

451
  if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
Jason Rumney's avatar
Jason Rumney committed
452
    {
453
      total_width = size.cx;
Jason Rumney's avatar
Jason Rumney committed
454 455
    }

456
  if (!total_width)
Jason Rumney's avatar
Jason Rumney committed
457 458 459 460 461 462 463
    {
      RECT rect;
      rect.top = 0; rect.bottom = font->font.height; rect.left = 0; rect.right = 1;
      DrawTextW (dc, wcode, nglyphs, &rect,
                 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
      total_width = rect.right;
    }
464

465 466 467 468 469 470 471 472 473 474
  if (metrics)
    {
      metrics->width = total_width;
      metrics->ascent = font->ascent;
      metrics->descent = font->descent;
      metrics->lbearing = 0;
      metrics->rbearing = total_width
        + ((struct w32font_info *) font)->metrics.tmOverhang;
    }

Jason Rumney's avatar
Jason Rumney committed
475 476 477 478 479 480 481 482 483 484 485 486 487
  /* Restore state and release DC.  */
  SelectObject (dc, old_font);
  ReleaseDC (NULL, dc);

  return total_width;
}

/* w32 implementation of draw for font backend.
   Optional.
   Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
   position of frame F with S->FACE and S->GC.  If WITH_BACKGROUND
   is nonzero, fill the background in advance.  It is assured that
   WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).  */
488 489 490 491
static int
w32font_draw (s, from, to, x, y, with_background)
     struct glyph_string *s;
     int from, to, x, y, with_background;
Jason Rumney's avatar
Jason Rumney committed
492 493
{
  UINT options = 0;
494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513
  HRGN orig_clip;

  /* Save clip region for later restoration.  */
  GetClipRgn(s->hdc, orig_clip);

  if (s->num_clips > 0)
    {
      HRGN new_clip = CreateRectRgnIndirect (s->clip);

      if (s->num_clips > 1)
        {
          HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);

          CombineRgn (new_clip, new_clip, clip2, RGN_OR);
          DeleteObject (clip2);
        }

      SelectClipRgn (s->hdc, new_clip);
      DeleteObject (new_clip);
    }
Jason Rumney's avatar
Jason Rumney committed
514 515 516

  if (with_background)
    {
517 518 519
      SetBkColor (s->hdc, s->gc->background);
      SetBkMode (s->hdc, OPAQUE);
#if 0
520 521 522 523 524 525 526 527 528
      HBRUSH brush;
      RECT rect;

      brush = CreateSolidBrush (s->gc->background);
      rect.left = x;
      rect.top = y - ((struct font *) (s->font_info->font))->ascent;
      rect.right = x + s->width;
      rect.bottom = y + ((struct font *) (s->font_info->font))->descent;
      FillRect (s->hdc, &rect, brush);
529
      DeleteObject (brush);
530
#endif
Jason Rumney's avatar
Jason Rumney committed
531 532 533
    }
  else
    SetBkMode (s->hdc, TRANSPARENT);
534 535

  ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, to - from, NULL);
536 537 538 539 540 541

  /* Restore clip region.  */
  if (s->num_clips > 0)
    {
      SelectClipRgn (s->hdc, orig_clip);
    }
Jason Rumney's avatar
Jason Rumney committed
542 543 544 545 546
}

/* w32 implementation of free_entity for font backend.
   Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
   Free FONT_EXTRA_INDEX field of FONT_ENTITY.
547 548
static void
w32font_free_entity (Lisp_Object entity);
Jason Rumney's avatar
Jason Rumney committed
549 550 551 552 553 554 555
  */

/* w32 implementation of prepare_face for font backend.
   Optional (if FACE->extra is not used).
   Prepare FACE for displaying characters by FONT on frame F by
   storing some data in FACE->extra.  If successful, return 0.
   Otherwise, return -1.
556 557
static int
w32font_prepare_face (FRAME_PTR f, struct face *face);
Jason Rumney's avatar
Jason Rumney committed
558 559 560 561
  */
/* w32 implementation of done_face for font backend.
   Optional.
   Done FACE for displaying characters by FACE->font on frame F.
562 563
static void
w32font_done_face (FRAME_PTR f, struct face *face);  */
Jason Rumney's avatar
Jason Rumney committed
564 565 566 567

/* w32 implementation of get_bitmap for font backend.
   Optional.
   Store bitmap data for glyph-code CODE of FONT in BITMAP.  It is
568
   intended that this method is called from the other font-driver
Jason Rumney's avatar
Jason Rumney committed
569
   for actual drawing.
570 571 572
static int
w32font_get_bitmap (struct font *font, unsigned code,
                    struct font_bitmap *bitmap, int bits_per_pixel);
Jason Rumney's avatar
Jason Rumney committed
573 574 575 576
  */
/* w32 implementation of free_bitmap for font backend.
   Optional.
   Free bitmap data in BITMAP.
577 578
static void
w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
Jason Rumney's avatar
Jason Rumney committed
579 580 581 582 583
  */
/* w32 implementation of get_outline for font backend.
   Optional.
   Return an outline data for glyph-code CODE of FONT.  The format
   of the outline data depends on the font-driver.
584 585
static void *
w32font_get_outline (struct font *font, unsigned code);
Jason Rumney's avatar
Jason Rumney committed
586 587 588 589
  */
/* w32 implementation of free_outline for font backend.
   Optional.
   Free OUTLINE (that is obtained by the above method).
590 591
static void
w32font_free_outline (struct font *font, void *outline);
Jason Rumney's avatar
Jason Rumney committed
592 593 594 595 596 597
  */
/* w32 implementation of anchor_point for font backend.
   Optional.
   Get coordinates of the INDEXth anchor point of the glyph whose
   code is CODE.  Store the coordinates in *X and *Y.  Return 0 if
   the operations was successfull.  Otherwise return -1.
598 599
static int
w32font_anchor_point (struct font *font, unsigned code,
Jason Rumney's avatar
Jason Rumney committed
600 601 602 603 604 605
                                 int index, int *x, int *y);
  */
/* w32 implementation of otf_capability for font backend.
   Optional.
   Return a list describing which scripts/languages FONT
   supports by which GSUB/GPOS features of OpenType tables.
606 607
static Lisp_Object
w32font_otf_capability (struct font *font);
Jason Rumney's avatar
Jason Rumney committed
608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624
  */
/* w32 implementation of otf_drive for font backend.
   Optional.
   Apply FONT's OTF-FEATURES to the glyph string.

   FEATURES specifies which OTF features to apply in this format:
      (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
   See the documentation of `font-drive-otf' for the detail.

   This method applies the specified features to the codes in the
   elements of GSTRING-IN (between FROMth and TOth).  The output
   codes are stored in GSTRING-OUT at the IDXth element and the
   following elements.

   Return the number of output codes.  If none of the features are
   applicable to the input data, return 0.  If GSTRING-OUT is too
   short, return -1.
625 626 627 628 629
static int
w32font_otf_drive (struct font *font, Lisp_Object features,
                   Lisp_Object gstring_in, int from, int to,
                   Lisp_Object gstring_out, int idx,
                   int alternate_subst);
Jason Rumney's avatar
Jason Rumney committed
630 631 632 633
  */

/* Callback function for EnumFontFamiliesEx.
 * Adds the name of a font to a Lisp list (passed in as the lParam arg).  */
634 635 636 637 638 639
static int CALLBACK
add_font_name_to_list (logical_font, physical_font, font_type, list_object)
     ENUMLOGFONTEX *logical_font;
     NEWTEXTMETRICEX *physical_font;
     DWORD font_type;
     LPARAM list_object;
Jason Rumney's avatar
Jason Rumney committed
640 641 642 643 644 645 646 647 648 649 650
{
  Lisp_Object* list = (Lisp_Object *) list_object;
  Lisp_Object family = intern_downcase (logical_font->elfLogFont.lfFaceName,
                                        strlen (logical_font->elfLogFont.lfFaceName));
  if (! memq_no_quit (family, *list))
    *list = Fcons (family, *list);

  return 1;
}

/* Convert an enumerated Windows font to an Emacs font entity.  */
651
static Lisp_Object
652 653
w32_enumfont_pattern_entity (frame, logical_font, physical_font, font_type)
     Lisp_Object frame;
654 655 656
     ENUMLOGFONTEX *logical_font;
     NEWTEXTMETRICEX *physical_font;
     DWORD font_type;
Jason Rumney's avatar
Jason Rumney committed
657 658 659 660 661
{
  Lisp_Object entity, tem;
  LOGFONT *lf = (LOGFONT*) logical_font;
  BYTE generic_type;

662
  entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil);
Jason Rumney's avatar
Jason Rumney committed
663

Jason Rumney's avatar
Jason Rumney committed
664
  ASET (entity, FONT_TYPE_INDEX, Qgdi);
665
  ASET (entity, FONT_FRAME_INDEX, frame);
Jason Rumney's avatar
Jason Rumney committed
666 667 668 669
  ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet));
  ASET (entity, FONT_OBJLIST_INDEX, Qnil);

  /* Foundry is difficult to get in readable form on Windows.
670 671 672 673 674 675 676 677 678 679 680 681 682
     But Emacs crashes if it is not set, so set it to something more
     generic.  Thes values make xflds compatible with Emacs 22. */
  if (lf->lfOutPrecision == OUT_STRING_PRECIS)
    tem = Qraster;
  else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
    tem = Qoutline;
  else
    tem = Qunknown;

  ASET (entity, FONT_FOUNDRY_INDEX, tem);

  /* Save the generic family in the extra info, as it is likely to be
     useful to users looking for a close match.  */
Jason Rumney's avatar
Jason Rumney committed
683 684 685 686
  generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
  if (generic_type == FF_DECORATIVE)
    tem = Qdecorative;
  else if (generic_type == FF_MODERN)
687
    tem = Qmonospace;
Jason Rumney's avatar
Jason Rumney committed
688
  else if (generic_type == FF_ROMAN)
689
    tem = Qserif;
Jason Rumney's avatar
Jason Rumney committed
690 691 692
  else if (generic_type == FF_SCRIPT)
    tem = Qscript;
  else if (generic_type == FF_SWISS)
693
    tem = Qsans_serif;
Jason Rumney's avatar
Jason Rumney committed
694
  else
695 696 697 698
    tem = Qnil;
    
  if (! NILP (tem))
    font_put_extra (entity, QCfamily, tem);
Jason Rumney's avatar
Jason Rumney committed
699

700 701 702 703 704

  if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
    font_put_extra (entity, QCspacing, make_number (FONT_SPACING_PROPORTIONAL));
  else
    font_put_extra (entity, QCspacing, make_number (FONT_SPACING_MONO));
Jason Rumney's avatar
Jason Rumney committed
705 706 707 708 709 710

  ASET (entity, FONT_FAMILY_INDEX,
        intern_downcase (lf->lfFaceName, strlen (lf->lfFaceName)));

  ASET (entity, FONT_WEIGHT_INDEX, make_number (lf->lfWeight));
  ASET (entity, FONT_SLANT_INDEX, make_number (lf->lfItalic ? 200 : 100));
711 712 713
  /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
     to get it.  */
  ASET (entity, FONT_WIDTH_INDEX, make_number (100));
Jason Rumney's avatar
Jason Rumney committed
714

715 716 717 718
  if (font_type & RASTER_FONTTYPE)
    ASET (entity, FONT_SIZE_INDEX, make_number (physical_font->ntmTm.tmHeight));
  else
    ASET (entity, FONT_SIZE_INDEX, make_number (0));
Jason Rumney's avatar
Jason Rumney committed
719 720 721

  /* Cache unicode codepoints covered by this font, as there is no other way
     of getting this information easily.  */
722
  if (font_type & TRUETYPE_FONTTYPE)
Jason Rumney's avatar
Jason Rumney committed
723
    {
724 725
      font_put_extra (entity, QCscript,
                      font_supported_scripts (&physical_font->ntmFontSig));
Jason Rumney's avatar
Jason Rumney committed
726
    }
727

Jason Rumney's avatar
Jason Rumney committed
728 729 730
  return entity;
}

731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929

/* Convert generic families to the family portion of lfPitchAndFamily.  */
BYTE
w32_generic_family (Lisp_Object name)
{
  /* Generic families.  */
  if (EQ (name, Qmonospace) || EQ (name, Qmono))
    return FF_MODERN;
  else if (EQ (name, Qsans_serif) || EQ (name, Qsans__serif)
           || EQ (name, Qsans))
    return FF_SWISS;
  else if (EQ (name, Qserif))
    return FF_ROMAN;
  else if (EQ (name, Qdecorative))
    return FF_DECORATIVE;
  else if (EQ (name, Qscript))
    return FF_SCRIPT;
  else
    return FF_DONTCARE;
}

static int
logfonts_match (font, pattern)
     LOGFONT *font, *pattern;
{
  /* Only check height for raster fonts.  */
  if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
      && font->lfHeight != pattern->lfHeight)
    return 0;

  /* Have some flexibility with weights.  */
  if (pattern->lfWeight
      && ((font->lfWeight < (pattern->lfWeight - 150))
          || font->lfWeight > (pattern->lfWeight + 150)))
      return 0;

  /* Charset and face should be OK.  Italic has to be checked
     against the original spec, in case we don't have any preference.  */
  return 1;
}

static int
font_matches_spec (type, font, spec)
     DWORD type;
     NEWTEXTMETRICEX *font;
     Lisp_Object spec;
{
  Lisp_Object extra, val;

  /* Check italic. Can't check logfonts, since it is a boolean field,
     so there is no difference between "non-italic" and "don't care".  */
  val = AREF (spec, FONT_SLANT_INDEX);
  if (INTEGERP (val))
    {
      int slant = XINT (val);
      if ((slant > 150 && !font->ntmTm.tmItalic)
          || (slant <= 150 && font->ntmTm.tmItalic))
        {
          OutputDebugString ("italic mismatch");
        return 0;
        }
    }

  /* Check extra parameters.  */
  for (extra = AREF (spec, FONT_EXTRA_INDEX);
       CONSP (extra); extra = XCDR (extra))
    {
      Lisp_Object extra_entry;
      extra_entry = XCAR (extra);
      if (CONSP (extra_entry))
        {
          Lisp_Object key = XCAR (extra_entry);
          val = XCDR (extra_entry);
          if (EQ (key, QCfamily))
            {
              /* Generic family. Most useful when there is no font name
                 specified. eg, if a script does not exist in the default
                 font, we could look for a font with the same generic family
                 that does support the script. Full PANOSE support would
                 be better, but we need to open the font to get that.  */
              BYTE w32_family = w32_generic_family (val);

              /* Reject if FF_DONTCARE is returned, as it means the
                 font spec is bad.  */
              if (w32_family == FF_DONTCARE
                  || w32_family != (font->ntmTm.tmPitchAndFamily & 0xF0))
                return 0;
            }
          else if (EQ (key, QCspacing))
            {
              int proportional;
              if (INTEGERP (val))
                {
                  int spacing = XINT (val);
                  proportional = (spacing < FONT_SPACING_MONO);
                }
              else if (EQ (val, Qp))
                proportional = 1;
              else if (EQ (val, Qc) || EQ (val, Qm))
                proportional = 0;
              else
                return 0; /* Bad font spec.  */

              if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
                  || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
                return 0;
            }
          else if (EQ (key, QCscript) && SYMBOLP (val))
            {
              /* Only truetype fonts will have information about what
                 scripts they support.  This probably means the user
                 will have to force Emacs to use raster, postscript
                 or atm fonts for non-ASCII text.  */
              if (type & TRUETYPE_FONTTYPE)
                {
                  Lisp_Object support
                    = font_supported_scripts (&font->ntmFontSig);
                  if (! memq_no_quit (val, support))
                    return 0;
                }
              else
                {
                  /* Return specific matches, but play it safe. Fonts
                     that cover more than their charset would suggest
                     are likely to be truetype or opentype fonts,
                     covered above.  */
                  if (EQ (val, Qlatin))
                    {
                      /* Although every charset but symbol, thai and
                         arabic contains the basic ASCII set of latin
                         characters, Emacs expects much more.  */
                      if (font->ntmTm.tmCharSet != ANSI_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qsymbol))
                    {
                      if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qcyrillic))
                    {
                      if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qgreek))
                    {
                      if (font->ntmTm.tmCharSet != GREEK_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qarabic))
                    {
                      if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qhebrew))
                    {
                      if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qthai))
                    {
                      if (font->ntmTm.tmCharSet != THAI_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qkana))
                    {
                      if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qbopomofo))
                    {
                      if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qhangul))
                    {
                      if (font->ntmTm.tmCharSet != HANGUL_CHARSET
                          && font->ntmTm.tmCharSet != JOHAB_CHARSET)
                        return 0;
                    }
                  else if (EQ (val, Qhan))
                    {
                      if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
                          && font->ntmTm.tmCharSet != GB2312_CHARSET
                          && font->ntmTm.tmCharSet != HANGUL_CHARSET
                          && font->ntmTm.tmCharSet != JOHAB_CHARSET
                          && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
                        return 0;
                    }
                  else
                    /* Other scripts unlikely to be handled.  */
                    return 0;
                }
            }
        }
    }
  return 1;
}

Jason Rumney's avatar
Jason Rumney committed
930
/* Callback function for EnumFontFamiliesEx.
931 932 933 934
 * Checks if a font matches everything we are trying to check agaist,
 * and if so, adds it to a list. Both the data we are checking against
 * and the list to which the fonts are added are passed in via the
 * lparam argument, in the form of a font_callback_data struct. */
935
static int CALLBACK
936
add_font_entity_to_list (logical_font, physical_font, font_type, lParam)
937 938 939
     ENUMLOGFONTEX *logical_font;
     NEWTEXTMETRICEX *physical_font;
     DWORD font_type;
940
     LPARAM lParam;
Jason Rumney's avatar
Jason Rumney committed
941
{
942 943
  struct font_callback_data *match_data
    = (struct font_callback_data *) lParam;
Jason Rumney's avatar
Jason Rumney committed
944

945 946 947 948 949 950 951 952 953 954
  if (logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
      && font_matches_spec (font_type, physical_font,
                            match_data->orig_font_spec))
    {
      Lisp_Object entity
        = w32_enumfont_pattern_entity (match_data->frame, logical_font,
                                       physical_font, font_type);
      if (!NILP (entity))
        match_data->list = Fcons (entity, match_data->list);
    }
Jason Rumney's avatar
Jason Rumney committed
955 956 957 958
  return 1;
}

/* Callback function for EnumFontFamiliesEx.
959
 * Terminates the search once we have a match. */
960
static int CALLBACK
961
add_one_font_entity_to_list (logical_font, physical_font, font_type, lParam)
962 963 964
     ENUMLOGFONTEX *logical_font;
     NEWTEXTMETRICEX *physical_font;
     DWORD font_type;
965
     LPARAM lParam;
Jason Rumney's avatar
Jason Rumney committed
966
{
967 968 969 970 971 972
  struct font_callback_data *match_data
    = (struct font_callback_data *) lParam;
  add_font_entity_to_list (logical_font, physical_font, font_type, lParam);

  /* If we have a font in the list, terminate the search.  */
  return !NILP (match_data->list);
Jason Rumney's avatar
Jason Rumney committed
973 974 975
}

/* Convert a Lisp font registry (symbol) to a windows charset.  */
976 977 978
static LONG
registry_to_w32_charset (charset)
     Lisp_Object charset;
Jason Rumney's avatar
Jason Rumney committed
979 980 981 982 983 984
{
  if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
      || EQ (charset, Qunicode_sip))
    return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
  else if (EQ (charset, Qiso8859_1))
    return ANSI_CHARSET;
985 986
  else if (SYMBOLP (charset))
    return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
Jason Rumney's avatar
Jason Rumney committed
987 988 989 990 991 992
  else if (STRINGP (charset))
    return x_to_w32_charset (SDATA (charset));
  else
    return DEFAULT_CHARSET;
}

993 994 995
static Lisp_Object
w32_registry (w32_charset)
     LONG w32_charset;
Jason Rumney's avatar
Jason Rumney committed
996 997
{
  if (w32_charset == ANSI_CHARSET)
998
    return Qiso10646_1;
Jason Rumney's avatar
Jason Rumney committed
999
  else
1000 1001 1002 1003
    {
      char * charset = w32_to_x_charset (w32_charset, NULL);
      return intern_downcase (charset, strlen(charset));
    }
Jason Rumney's avatar
Jason Rumney committed
1004 1005 1006
}

/* Fill in all the available details of LOGFONT from FONT_SPEC.  */
1007 1008 1009 1010 1011
static void
fill_in_logfont (f, logfont, font_spec)
     FRAME_PTR f;
     LOGFONT *logfont;
     Lisp_Object font_spec;
Jason Rumney's avatar
Jason Rumney committed
1012
{
1013
  Lisp_Object tmp, extra;
Jason Rumney's avatar
Jason Rumney committed
1014 1015
  int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;

1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029
  extra = AREF (font_spec, FONT_EXTRA_INDEX);
  /* Allow user to override dpi settings.  */
  if (CONSP (extra))
    {
      tmp = assq_no_quit (QCdpi, extra);
      if (CONSP (tmp) && INTEGERP (XCDR (tmp)))
        {
          dpi = XINT (XCDR (tmp));
        }
      else if (CONSP (tmp) && FLOATP (XCDR (tmp)))
        {
          dpi = (int) (XFLOAT_DATA (XCDR (tmp)) + 0.5);
        }
    }
Jason Rumney's avatar
Jason Rumney committed
1030 1031 1032 1033

  /* Height  */
  tmp = AREF (font_spec, FONT_SIZE_INDEX);
  if (INTEGERP (tmp))
1034
    logfont->lfHeight = -1 * XINT (tmp);
Jason Rumney's avatar
Jason Rumney committed
1035
  else if (FLOATP (tmp))
1036
    logfont->lfHeight = (int) (-1.0 *  dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
Jason Rumney's avatar
Jason Rumney committed
1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061

  /* Escapement  */

  /* Orientation  */

  /* Weight  */
  tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
  if (INTEGERP (tmp))
    logfont->lfWeight = XINT (tmp);

  /* Italic  */
  tmp = AREF (font_spec, FONT_SLANT_INDEX);
  if (INTEGERP (tmp))
    {
      int slant = XINT (tmp);
      logfont->lfItalic = slant > 150 ? 1 : 0;
    }

  /* Underline  */

  /* Strikeout  */

  /* Charset  */
  tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
  if (! NILP (tmp))
1062
    logfont->lfCharSet = registry_to_w32_charset (tmp);
Jason Rumney's avatar
Jason Rumney committed
1063 1064 1065

  /* Out Precision  */
  /* Clip Precision  */
1066 1067 1068 1069
  /* Quality  TODO: Allow different quality to be specified, so user
     can enable/disable anti-aliasing for individual fonts.  */
  logfont->lfQuality = DEFAULT_QUALITY;

1070 1071 1072
  /* Generic Family and Face Name  */
  logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;

Jason Rumney's avatar
Jason Rumney committed
1073
  tmp = AREF (font_spec, FONT_FAMILY_INDEX);
1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085
  if (! NILP (tmp))
    {
      logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
      if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
        ; /* Font name was generic, don't fill in font name.  */
        /* Font families are interned, but allow for strings also in case of
           user input.  */
      else if (SYMBOLP (tmp))
        strncpy (logfont->lfFaceName, SDATA (SYMBOL_NAME (tmp)), LF_FACESIZE);
      else if (STRINGP (tmp))
        strncpy (logfont->lfFaceName, SDATA (tmp), LF_FACESIZE);
    }
Jason Rumney's avatar
Jason Rumney committed
1086

1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157
  /* Process EXTRA info.  */
  for ( ; CONSP (extra); extra = XCDR (extra))
    {
      tmp = XCAR (extra);
      if (CONSP (tmp))
        {
          Lisp_Object key, val;
          key = XCAR (tmp), val = XCDR (tmp);
          if (EQ (key, QCfamily))
            {
              /* Override generic family.  */
              BYTE family = w32_generic_family (val);
              if (family != FF_DONTCARE)
                logfont->lfPitchAndFamily
                  = logfont->lfPitchAndFamily & 0x0F | family;
            }
          else if (EQ (key, QCspacing))
            {
              /* Set pitch based on the spacing property.  */
              if (INTEGERP (val))
                {
                  int spacing = XINT (val);
                  if (spacing < FONT_SPACING_MONO)
                    logfont->lfPitchAndFamily
                      = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
                  else
                    logfont->lfPitchAndFamily
                      = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
                }
              else if (EQ (val, Qp))
                logfont->lfPitchAndFamily
                  = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
              else if (EQ (val, Qc) || EQ (val, Qm))
                logfont->lfPitchAndFamily
                  = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
            }
          /* Only use QCscript if charset is not provided, or is unicode
             and a single script is specified.  This is rather crude,
             and is only used to narrow down the fonts returned where
             there is a definite match.  Some scripts, such as latin, han,
             cjk-misc match multiple lfCharSet values, so we can't pre-filter
             them.  */
          else if (EQ (key, QCscript)
                   && logfont->lfCharSet == DEFAULT_CHARSET
                   && SYMBOLP (val))
            {
              if (EQ (val, Qgreek))
                logfont->lfCharSet = GREEK_CHARSET;
              else if (EQ (val, Qhangul))
                logfont->lfCharSet = HANGUL_CHARSET;
              else if (EQ (val, Qkana) || EQ (val, Qkanbun))
                logfont->lfCharSet = SHIFTJIS_CHARSET;
              else if (EQ (val, Qbopomofo))
                logfont->lfCharSet = CHINESEBIG5_CHARSET;
              /* GB 18030 supports tibetan, yi, mongolian,
                 fonts that support it should show up if we ask for
                 GB2312 fonts. */
              else if (EQ (val, Qtibetan) || EQ (val, Qyi)
                       || EQ (val, Qmongolian))
                logfont->lfCharSet = GB2312_CHARSET;
              else if (EQ (val, Qhebrew))
                logfont->lfCharSet = HEBREW_CHARSET;
              else if (EQ (val, Qarabic))
                logfont->lfCharSet = ARABIC_CHARSET;
              else if (EQ (val, Qthai))
                logfont->lfCharSet = THAI_CHARSET;
              else if (EQ (val, Qsymbol))
                logfont->lfCharSet = SYMBOL_CHARSET;
            }
        }
    }
Jason Rumney's avatar
Jason Rumney committed
1158 1159
}

1160
static void
1161 1162
list_all_matching_fonts (match_data)
     struct font_callback_data *match_data;
Jason Rumney's avatar
Jason Rumney committed
1163 1164
{
  HDC dc;
1165 1166
  Lisp_Object families = w32font_list_family (match_data->frame);
  struct frame *f = XFRAME (match_data->frame);
Jason Rumney's avatar
Jason Rumney committed
1167 1168 1169 1170 1171

  dc = get_frame_dc (f);

  while (!NILP (families))
    {
1172 1173 1174
      /* TODO: Use the Unicode versions of the W32 APIs, so we can
         handle non-ASCII font names.  */
      char *name;
Jason Rumney's avatar
Jason Rumney committed
1175 1176
      Lisp_Object family = CAR (families);
      families = CDR (families);
1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189
      if (NILP (family))
        continue;
      else if (STRINGP (family))
        name = SDATA (family);
      else
        name = SDATA (SYMBOL_NAME (family)); 

      strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
      match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';

      EnumFontFamiliesEx (dc, &match_data->pattern,
                          (FONTENUMPROC) add_font_entity_to_list,
                          (LPARAM) match_data, 0);
Jason Rumney's avatar
Jason Rumney committed
1190 1191 1192 1193 1194
    }

  release_frame_dc (f, dc);
}

1195 1196 1197
/* Return a list of all the scripts that the font supports.  */
static Lisp_Object
font_supported_scripts (FONTSIGNATURE * sig)
Jason Rumney's avatar
Jason Rumney committed
1198
{
1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274
  DWORD * subranges = sig->fsUsb;
  Lisp_Object supported = Qnil;

  /* Match a single subrange. SYM is set if bit N is set in subranges.  */
#define SUBRANGE(n,sym) \
  if (subranges[(n) / 32] & (1 << ((n) % 32))) \
    supported = Fcons ((sym), supported)

  /* Match multiple subranges. SYM is set if any MASK bit is set in
     subranges[0 - 3].  */
#define MASK_ANY(mask0,mask1,mask2,mask3,sym)      \
  if ((subranges[0] & (mask0)) || (subranges[1] & (mask1))     \
      || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
    supported = Fcons ((sym), supported)

  SUBRANGE (0, Qlatin); /* There are many others... */

  SUBRANGE (7, Qgreek);
  SUBRANGE (8, Qcoptic);
  SUBRANGE (9, Qcyrillic);
  SUBRANGE (10, Qarmenian);
  SUBRANGE (11, Qhebrew);
  SUBRANGE (13, Qarabic);
  SUBRANGE (14, Qnko);
  SUBRANGE (15, Qdevanagari);
  SUBRANGE (16, Qbengali);
  SUBRANGE (17, Qgurmukhi);
  SUBRANGE (18, Qgujarati);
  SUBRANGE (19, Qoriya);
  SUBRANGE (20, Qtamil);
  SUBRANGE (21, Qtelugu);
  SUBRANGE (22, Qkannada);
  SUBRANGE (23, Qmalayalam);
  SUBRANGE (24, Qthai);
  SUBRANGE (25, Qlao);
  SUBRANGE (26, Qgeorgian);

  SUBRANGE (48, Qcjk_misc);
  SUBRANGE (51, Qbopomofo);
  SUBRANGE (54, Qkanbun); /* Is this right?  */
  SUBRANGE (56, Qhangul);

  SUBRANGE (59, Qhan); /* There are others, but this is the main one.  */
  SUBRANGE (59, Qideographic_description); /* Windows lumps this in  */

  SUBRANGE (70, Qtibetan);
  SUBRANGE (71, Qsyriac);
  SUBRANGE (72, Qthaana);
  SUBRANGE (73, Qsinhala);
  SUBRANGE (74, Qmyanmar);
  SUBRANGE (75, Qethiopic);
  SUBRANGE (76, Qcherokee);
  SUBRANGE (77, Qcanadian_aboriginal);
  SUBRANGE (78, Qogham);
  SUBRANGE (79, Qrunic);
  SUBRANGE (80, Qkhmer);
  SUBRANGE (81, Qmongolian);
  SUBRANGE (82, Qbraille);
  SUBRANGE (83, Qyi);

  SUBRANGE (88, Qbyzantine_musical_symbol);
  SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these.  */

  SUBRANGE (89, Qmathematical);

  /* Match either katakana or hiragana for kana.  */
  MASK_ANY (0, 0x00060000, 0, 0, Qkana);

  /* There isn't really a main symbol range, so include symbol if any
     relevant range is set.  */
  MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);

#undef SUBRANGE
#undef MASK_ANY

  return supported;
Jason Rumney's avatar
Jason Rumney committed
1275 1276 1277 1278 1279
}


struct font_driver w32font_driver =
  {
Jason Rumney's avatar
Jason Rumney committed
1280
    0, /* Qgdi */
Jason Rumney's avatar
Jason Rumney committed
1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305
    w32font_get_cache,
    w32font_list,
    w32font_match,
    w32font_list_family,
    NULL, /* free_entity */
    w32font_open,
    w32font_close,
    NULL, /* prepare_face */
    NULL, /* done_face */
    w32font_has_char,
    w32font_encode_char,
    w32font_text_extents,
    w32font_draw,
    NULL, /* get_bitmap */
    NULL, /* free_bitmap */
    NULL, /* get_outline */
    NULL, /* free_outline */
    NULL, /* anchor_point */
    NULL, /* otf_capability */
    NULL /* otf_drive */
  };


/* Initialize state that does not change between invocations. This is only
   called when Emacs is dumped.  */
1306 1307
void
syms_of_w32font ()
Jason Rumney's avatar
Jason Rumney committed
1308
{
Jason Rumney's avatar
Jason Rumney committed
1309
  DEFSYM (Qgdi, "gdi");
1310 1311 1312 1313 1314

  /* Generic font families.  */
  DEFSYM (Qmonospace, "monospace");
  DEFSYM (Qserif, "serif");
  DEFSYM (Qsans_serif, "sans-serif");
Jason Rumney's avatar
Jason Rumney committed
1315
  DEFSYM (Qscript, "script");
1316 1317 1318 1319 1320 1321 1322 1323 1324
  DEFSYM (Qdecorative, "decorative");
  /* Aliases.  */
  DEFSYM (Qsans__serif, "sans_serif");
  DEFSYM (Qsans, "sans");
  DEFSYM (Qmono, "mono");

  /* Fake foundries.  */
  DEFSYM (Qraster, "raster");
  DEFSYM (Qoutline, "outline");
Jason Rumney's avatar
Jason Rumney committed
1325
  DEFSYM (Qunknown, "unknown");
1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376

  /* Indexes for extra info.  */
  DEFSYM (QCfamily, ":family");

  /* Scripts  */
  DEFSYM (Qlatin, "latin");
  DEFSYM (Qgreek, "greek");
  DEFSYM (Qcoptic, "coptic");
  DEFSYM (Qcyrillic, "cyrillic");
  DEFSYM (Qarmenian, "armenian");
  DEFSYM (Qhebrew, "hebrew");
  DEFSYM (Qarabic, "arabic");
  DEFSYM (Qsyriac, "syriac");
  DEFSYM (Qnko, "nko");
  DEFSYM (Qthaana, "thaana");
  DEFSYM (Qdevanagari, "devanagari");
  DEFSYM (Qbengali, "bengali");
  DEFSYM (Qgurmukhi, "gurmukhi");
  DEFSYM (Qgujarati, "gujarati");
  DEFSYM