src/w32uniscribe.c

   1 /* Font backend for the Microsoft W32 Uniscribe API.
   2    Copyright (C) 2008 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 3, 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 #ifdef USE_FONT_BACKEND
  22
  23 #include <config.h>
  24 /* Override API version - Uniscribe is only available as standard since
  25    Windows 2000, though most users of older systems will have it
  26    since it installs with Internet Explorer 5.0 and other software.
  27    We only enable the feature if it is available, so there is no chance
  28    of calling non-existant functions.  */
  29 #undef _WIN32_WINNT
  30 #define _WIN32_WINNT 0x500
  31 #include <windows.h>
  32 #include <usp10.h>
  33
  34 #include "lisp.h"
  35 #include "w32term.h"
  36 #include "frame.h"
  37 #include "dispextern.h"
  38 #include "character.h"
  39 #include "charset.h"
  40 #include "fontset.h"
  41 #include "font.h"
  42 #include "w32font.h"
  43
  44 struct uniscribe_font_info
  45 {
  46   struct w32font_info w32_font;
  47   SCRIPT_CACHE cache;
  48 };
  49
  50 int uniscribe_available = 0;
  51
  52 /* Defined in w32font.c, since it is required there as well.  */
  53 extern Lisp_Object Quniscribe;
  54 extern Lisp_Object Qopentype;
  55
  56 extern int initialized;
  57
  58 extern struct font_driver uniscribe_font_driver;
  59
  60 /* EnumFontFamiliesEx callback.  */
  61 static int CALLBACK add_opentype_font_name_to_list P_ ((ENUMLOGFONTEX *,
  62                                                         NEWTEXTMETRICEX *,
  63                                                         DWORD, LPARAM));
  64 /* Used by uniscribe_otf_capability.  */
  65 static Lisp_Object otf_features (HDC context, char *table);
  66
  67 static int
  68 memq_no_quit (elt, list)
  69      Lisp_Object elt, list;
  70 {
  71   while (CONSP (list) && ! EQ (XCAR (list), elt))
  72     list = XCDR (list);
  73   return (CONSP (list));
  74 }
  75
  76 \f
  77 /* Font backend interface implementation.  */
  78 static Lisp_Object
  79 uniscribe_list (frame, font_spec)
  80      Lisp_Object frame, font_spec;
  81 {
  82   return w32font_list_internal (frame, font_spec, 1);
  83 }
  84
  85 static Lisp_Object
  86 uniscribe_match (frame, font_spec)
  87      Lisp_Object frame, font_spec;
  88 {
  89   return w32font_match_internal (frame, font_spec, 1);
  90 }
  91
  92 static Lisp_Object
  93 uniscribe_list_family (frame)
  94      Lisp_Object frame;
  95 {
  96   Lisp_Object list = Qnil;
  97   LOGFONT font_match_pattern;
  98   HDC dc;
  99   FRAME_PTR f = XFRAME (frame);
 100
 101   bzero (&font_match_pattern, sizeof (font_match_pattern));
 102   /* Limit enumerated fonts to outline fonts to save time.  */
 103   font_match_pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
 104
 105   dc = get_frame_dc (f);
 106
 107   EnumFontFamiliesEx (dc, &font_match_pattern,
 108                       (FONTENUMPROC) add_opentype_font_name_to_list,
 109                       (LPARAM) &list, 0);
 110   release_frame_dc (f, dc);
 111
 112   return list;
 113 }
 114
 115 static struct font *
 116 uniscribe_open (f, font_entity, pixel_size)
 117      FRAME_PTR f;
 118      Lisp_Object font_entity;
 119      int pixel_size;
 120 {
 121   struct uniscribe_font_info *uniscribe_font
 122     = xmalloc (sizeof (struct uniscribe_font_info));
 123
 124   if (uniscribe_font == NULL)
 125     return NULL;
 126
 127   if (!w32font_open_internal (f, font_entity, pixel_size,
 128                               (struct w32font_info *) uniscribe_font))
 129     {
 130       xfree (uniscribe_font);
 131       return NULL;
 132     }
 133
 134   /* Initialize the cache for this font.  */
 135   uniscribe_font->cache = NULL;
 136   /* Mark the format as opentype  */
 137   uniscribe_font->w32_font.font.format = Qopentype;
 138   uniscribe_font->w32_font.font.driver = &uniscribe_font_driver;
 139
 140   return (struct font *) uniscribe_font;
 141 }
 142
 143 static void
 144 uniscribe_close (f, font)
 145      FRAME_PTR f;
 146      struct font *font;
 147 {
 148   struct uniscribe_font_info *uniscribe_font
 149     = (struct uniscribe_font_info *) font;
 150
 151   if (uniscribe_font->cache)
 152     ScriptFreeCache (&uniscribe_font->cache);
 153
 154   w32font_close (f, font);
 155 }
 156
 157 /* Return a list describing which scripts/languages FONT supports by
 158    which GSUB/GPOS features of OpenType tables.  */
 159 static Lisp_Object
 160 uniscribe_otf_capability (font)
 161      struct font *font;
 162 {
 163   HDC context;
 164   HFONT old_font;
 165   struct frame *f;
 166   Lisp_Object capability = Fcons (Qnil, Qnil);
 167   Lisp_Object features;
 168
 169   f = XFRAME (selected_frame);
 170   context = get_frame_dc (f);
 171   old_font = SelectObject (context,
 172                            ((W32FontStruct *) (font->font.font))->hfont);
 173
 174   features = otf_features (context, "GSUB");
 175   XSETCAR (capability, features);
 176   features = otf_features (context, "GPOS");
 177   XSETCDR (capability, features);
 178
 179   SelectObject (context, old_font);
 180   release_frame_dc (f, context);
 181
 182   return capability;
 183 }
 184
 185 /* Uniscribe implementation of shape for font backend.
 186
 187    Shape text in LGSTRING.  See the docstring of `font-make-gstring'
 188    for the format of LGSTRING.  If the (N+1)th element of LGSTRING
 189    is nil, input of shaping is from the 1st to (N)th elements.  In
 190    each input glyph, FROM, TO, CHAR, and CODE are already set.
 191
 192    This function updates all fields of the input glyphs.  If the
 193    output glyphs (M) are more than the input glyphs (N), (N+1)th
 194    through (M)th elements of LGSTRING are updated possibly by making
 195    a new glyph object and storing it in LGSTRING.  If (M) is greater
 196    than the length of LGSTRING, nil should be return.  In that case,
 197    this function is called again with the larger LGSTRING.  */
 198 static Lisp_Object
 199 uniscribe_shape (lgstring)
 200      Lisp_Object lgstring;
 201 {
 202   struct font * font;
 203   struct uniscribe_font_info * uniscribe_font;
 204   EMACS_UINT nchars;
 205   int nitems, max_items, i, max_glyphs, done_glyphs, done_chars;
 206   wchar_t *chars;
 207   WORD *glyphs, *clusters;
 208   SCRIPT_ITEM *items;
 209   SCRIPT_CONTROL control;
 210   SCRIPT_VISATTR *attributes;
 211   int *advances;
 212   GOFFSET *offsets;
 213   ABC overall_metrics;
 214   MAT2 transform;
 215   HDC context;
 216   HFONT old_font;
 217   HRESULT result;
 218   struct frame * f;
 219
 220   CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring), font);
 221   uniscribe_font = (struct uniscribe_font_info *) font;
 222
 223   /* Get the chars from lgstring in a form we can use with uniscribe.  */
 224   max_glyphs = nchars = LGSTRING_LENGTH (lgstring);
 225   done_glyphs = done_chars = 0;
 226   chars = (wchar_t *) alloca (nchars * sizeof (wchar_t));
 227   for (i = 0; i < nchars; i++)
 228     {
 229       /* lgstring can be bigger than the number of characters in it, in
 230          the case where more glyphs are required to display those characters.
 231          If that is the case, note the real number of characters.  */
 232       if (NILP (LGSTRING_GLYPH (lgstring, i)))
 233         nchars = i;
 234       else
 235         chars[i] = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i));
 236     }
 237
 238   /* First we need to break up the glyph string into runs of glyphs that
 239      can be treated together.  First try a single run.  */
 240   max_items = 2;
 241   items = (SCRIPT_ITEM *) xmalloc (sizeof (SCRIPT_ITEM) * max_items);
 242   bzero (&control, sizeof (control));
 243
 244   while ((result = ScriptItemize (chars, nchars, max_items, &control, NULL,
 245                                   items, &nitems)) == E_OUTOFMEMORY)
 246     {
 247       /* If that wasn't enough, keep trying with one more run.  */
 248       max_items++;
 249       items = (SCRIPT_ITEM *) xrealloc (items,
 250                                         sizeof (SCRIPT_ITEM) * max_items);
 251     }
 252
 253   /* 0 = success in Microsoft's backwards world.  */
 254   if (result)
 255     {
 256       xfree (items);
 257       return Qnil;
 258     }
 259
 260   f = XFRAME (selected_frame);
 261   context = get_frame_dc (f);
 262   old_font = SelectObject (context,
 263                            ((W32FontStruct *) (font->font.font))->hfont);
 264
 265   glyphs = alloca (max_glyphs * sizeof (WORD));
 266   clusters = alloca (nchars * sizeof (WORD));
 267   attributes = alloca (max_glyphs * sizeof (SCRIPT_VISATTR));
 268   advances = alloca (max_glyphs * sizeof (int));
 269   offsets = alloca (max_glyphs * sizeof (GOFFSET));
 270   bzero (&transform, sizeof (transform));
 271   transform.eM11.value = 1;
 272   transform.eM22.value = 1;
 273
 274   for (i = 0; i < nitems; i++)
 275     {
 276       int nglyphs, nchars_in_run;
 277       nchars_in_run = items[i+1].iCharPos - items[i].iCharPos;
 278
 279       result = ScriptShape (context, &(uniscribe_font->cache),
 280                             chars + items[i].iCharPos, nchars_in_run,
 281                             max_glyphs - done_glyphs, &(items[i].a),
 282                             glyphs, clusters, attributes, &nglyphs);
 283       if (result == E_OUTOFMEMORY)
 284         {
 285           /* Need a bigger lgstring.  */
 286           lgstring = Qnil;
 287           break;
 288         }
 289       else if (result)
 290         {
 291           /* Can't shape this run - return results so far if any.  */
 292           break;
 293         }
 294       else
 295         {
 296           result = ScriptPlace (context, &(uniscribe_font->cache),
 297                                 glyphs, nglyphs, attributes, &(items[i].a),
 298                                 advances, offsets, &overall_metrics);
 299           if (!result)
 300             {
 301               int j, nclusters;
 302
 303               for (j = 0; j < nglyphs; j++)
 304                 {
 305                   int lglyph_index = j + done_glyphs;
 306                   Lisp_Object lglyph = LGSTRING_GLYPH (lgstring, lglyph_index);
 307                   GLYPHMETRICS metrics;
 308
 309                   if (NILP (lglyph))
 310                     {
 311                       lglyph = Fmake_vector (make_number (LGLYPH_SIZE), Qnil);
 312                       LGSTRING_SET_GLYPH (lgstring, lglyph_index, lglyph);
 313                     }
 314                   LGLYPH_SET_CODE (lglyph, glyphs[j]);
 315                   LGLYPH_SET_WIDTH (lglyph, advances[j]);
 316                   if (offsets[j].du || offsets[j].dv)
 317                     {
 318                       Lisp_Object vec;
 319                       /* Convert from logical inches.  */
 320                       int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
 321                       int dx = (int)(offsets[j].du * dpi / 72.27 + 0.5);
 322                       int dy = (int)(offsets[j].dv * dpi / 72.27 + 0.5);
 323                       vec = Fmake_vector (make_number (3), Qnil);
 324                       ASET (vec, 0, make_number (dx));
 325                       ASET (vec, 1, make_number (dy));
 326                       /* Based on what ftfont.c does... */
 327                       ASET (vec, 2, make_number (advances[j]));
 328                       LGLYPH_SET_ADJUSTMENT (lglyph, vec);
 329                     }
 330                   else
 331                     LGLYPH_SET_ADJUSTMENT (lglyph, Qnil);
 332
 333                   if (GetGlyphOutlineW (context, glyphs[j],
 334                                         GGO_METRICS | GGO_GLYPH_INDEX,
 335                                         &metrics, 0, NULL, &transform)
 336                       != GDI_ERROR)
 337                     {
 338                       LGLYPH_SET_LBEARING (lglyph, metrics.gmptGlyphOrigin.x);
 339                       LGLYPH_SET_RBEARING (lglyph,
 340                                            metrics.gmBlackBoxX
 341                                            + metrics.gmptGlyphOrigin.x);
 342                       LGLYPH_SET_ASCENT (lglyph, metrics.gmBlackBoxY);
 343                       LGLYPH_SET_DESCENT (lglyph,
 344                                           (metrics.gmCellIncY
 345                                            - metrics.gmptGlyphOrigin.y
 346                                            - metrics.gmBlackBoxY));
 347                     }
 348                   else
 349                     {
 350                       /* Defaults based on what we know from elsewhere.  */
 351                       LGLYPH_SET_LBEARING (lglyph, 0);
 352                       LGLYPH_SET_RBEARING (lglyph, advances[j]);
 353                       LGLYPH_SET_ASCENT (lglyph, font->ascent);
 354                       LGLYPH_SET_DESCENT (lglyph, font->descent);
 355                     }
 356                 }
 357
 358               /* Set character codes as indicated in clusters.  */
 359               for (j = 0; j < nchars_in_run - 1; j++)
 360                 {
 361                   int k, start, end;
 362                   wchar_t this_char = *(chars + items[i].iCharPos + j);
 363
 364                   start = clusters[i];
 365                   end = clusters[i+1];
 366                   if (start > end)
 367                     {
 368                       int temp = start;
 369                       start = end;
 370                       end = temp;
 371                     }
 372                   for (k = start; k < end; k++)
 373                     {
 374                       Lisp_Object lglyph = LGSTRING_GLYPH (lgstring,
 375                                                            done_glyphs + k);
 376                       LGLYPH_SET_CHAR (lglyph, this_char);
 377                     }
 378                 }
 379               /* Last one until end (or beginning) of string.  */
 380               {
 381                 int k, start, end;
 382                 wchar_t last_char = *(chars + items[i].iCharPos
 383                                       + nchars_in_run - 1);
 384                 start = clusters[nchars_in_run - 1];
 385                 end = nglyphs;
 386                 if (start < clusters[nchars_in_run - 2])
 387                   {
 388                     end = start + 1;
 389                     start = 0;
 390                   }
 391                 for (k = start; k < end; k++)
 392                   {
 393                     Lisp_Object lglyph = LGSTRING_GLYPH (lgstring,
 394                                                          done_glyphs + k);
 395                     LGLYPH_SET_CHAR (lglyph, last_char);
 396                   }
 397               }
 398             }
 399         }
 400       done_glyphs += nglyphs;
 401       done_chars += nchars_in_run;
 402     }
 403
 404   xfree (items);
 405   SelectObject (context, old_font);
 406   release_frame_dc (f, context);
 407
 408   if (NILP (lgstring))
 409     return Qnil;
 410   else
 411     return make_number (done_chars);
 412 }
 413
 414 /* Uniscribe implementation of encode_char for font backend.
 415    Return a glyph code of FONT for characer C (Unicode code point).
 416    If FONT doesn't have such a glyph, return FONT_INVALID_CODE.  */
 417 static unsigned
 418 uniscribe_encode_char (font, c)
 419      struct font *font;
 420      int c;
 421 {
 422   wchar_t chars[1];
 423   WORD indices[1];
 424   HDC context;
 425   struct frame *f;
 426   HFONT old_font;
 427   DWORD retval;
 428
 429   /* TODO: surrogates.  */
 430   if (c > 0xFFFF)
 431     return FONT_INVALID_CODE;
 432
 433   chars[0] = (wchar_t) c;
 434
 435   /* Use selected frame until API is updated to pass the frame.  */
 436   f = XFRAME (selected_frame);
 437   context = get_frame_dc (f);
 438   old_font = SelectObject (context,
 439                            ((W32FontStruct *)(font->font.font))->hfont);
 440
 441   retval = GetGlyphIndicesW (context, chars, 1, indices,
 442                              GGI_MARK_NONEXISTING_GLYPHS);
 443
 444   SelectObject (context, old_font);
 445   release_frame_dc (f, context);
 446
 447   if (retval == 1)
 448     return indices[0] == 0xFFFF ? FONT_INVALID_CODE : indices[0];
 449   else
 450     return FONT_INVALID_CODE;
 451 }
 452
 453 /*
 454    Shared with w32font:
 455    Lisp_Object uniscribe_get_cache (Lisp_Object frame);
 456    void uniscribe_free_entity (Lisp_Object font_entity);
 457    int uniscribe_has_char (Lisp_Object entity, int c);
 458    int uniscribe_text_extents (struct font *font, unsigned *code,
 459                                int nglyphs, struct font_metrics *metrics);
 460    int uniscribe_draw (struct glyph_string *s, int from, int to,
 461                        int x, int y, int with_background);
 462
 463    Unused:
 464    int uniscribe_prepare_face (FRAME_PTR f, struct face *face);
 465    void uniscribe_done_face (FRAME_PTR f, struct face *face);
 466    int uniscribe_get_bitmap (struct font *font, unsigned code,
 467                              struct font_bitmap *bitmap, int bits_per_pixel);
 468    void uniscribe_free_bitmap (struct font *font, struct font_bitmap *bitmap);
 469    void * uniscribe_get_outline (struct font *font, unsigned code);
 470    void uniscribe_free_outline (struct font *font, void *outline);
 471    int uniscribe_anchor_point (struct font *font, unsigned code,
 472                                int index, int *x, int *y);
 473    int uniscribe_start_for_frame (FRAME_PTR f);
 474    int uniscribe_end_for_frame (FRAME_PTR f);
 475
 476 */
 477
 478 \f
 479 /* Callback function for EnumFontFamiliesEx.
 480    Adds the name of opentype fonts to a Lisp list (passed in as the
 481    lParam arg). */
 482 static int CALLBACK
 483 add_opentype_font_name_to_list (logical_font, physical_font, font_type,
 484                                 list_object)
 485      ENUMLOGFONTEX *logical_font;
 486      NEWTEXTMETRICEX *physical_font;
 487      DWORD font_type;
 488      LPARAM list_object;
 489 {
 490   Lisp_Object* list = (Lisp_Object *) list_object;
 491   Lisp_Object family;
 492
 493   /* Skip vertical fonts (intended only for printing)  */
 494   if (logical_font->elfLogFont.lfFaceName[0] == '@')
 495     return 1;
 496
 497   /* Skip non opentype fonts.  Count old truetype fonts as opentype,
 498      as some of them do contain GPOS and GSUB data that Uniscribe
 499      can make use of.  */
 500   if (!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
 501       && font_type != TRUETYPE_FONTTYPE)
 502     return 1;
 503
 504   family = intern_downcase (logical_font->elfLogFont.lfFaceName,
 505                             strlen (logical_font->elfLogFont.lfFaceName));
 506   if (! memq_no_quit (family, *list))
 507     *list = Fcons (family, *list);
 508
 509   return 1;
 510 }
 511
 512 \f
 513 /* :otf property handling.
 514    Since the necessary Uniscribe APIs for getting font tag information
 515    are only available in Vista, we need to parse the font data directly
 516    according to the OpenType Specification.  */
 517
 518 /* Push into DWORD backwards to cope with endianness.  */
 519 #define OTF_TAG(STR)                                          \
 520   ((STR[3] << 24) | (STR[2] << 16) | (STR[1] << 8) | STR[0])
 521
 522 #define OTF_INT16_VAL(TABLE, OFFSET, PTR)                    \
 523   do {                                                       \
 524     BYTE temp, data[2];                                      \
 525     if (GetFontData (context, TABLE, OFFSET, data, 2) != 2)  \
 526       goto font_table_error;                                 \
 527     temp = data[0], data[0] = data[1], data[1] = temp;       \
 528     memcpy (PTR, data, 2);                                   \
 529   } while (0)
 530
 531 /* Do not reverse the bytes, because we will compare with a OTF_TAG value
 532    that has them reversed already.  */
 533 #define OTF_DWORDTAG_VAL(TABLE, OFFSET, PTR)                    \
 534   do {                                                          \
 535     if (GetFontData (context, TABLE, OFFSET, PTR, 4) != 4)      \
 536       goto font_table_error;                                    \
 537   } while (0)
 538
 539 #define OTF_TAG_VAL(TABLE, OFFSET, STR)                      \
 540   do {                                                       \
 541     if (GetFontData (context, TABLE, OFFSET, STR, 4) != 4)   \
 542       goto font_table_error;                                 \
 543     STR[4] = '\0';                                           \
 544   } while (0)
 545
 546 static char* NOTHING = "    ";
 547
 548 #define SNAME(VAL) SDATA (STRINGP (VAL) ? VAL : SYMBOL_NAME (VAL))
 549
 550 /* Check if font supports the otf script/language/features specified.
 551    OTF_SPEC is in the format
 552      (script lang [(gsub_feature ...)|nil] [(gpos_feature ...)]?) */
 553 int uniscribe_check_otf (font, otf_spec)
 554      LOGFONT *font;
 555      Lisp_Object otf_spec;
 556 {
 557   Lisp_Object script, lang, rest;
 558   Lisp_Object features[2];
 559   DWORD feature_tables[2];
 560   DWORD script_tag, default_script, lang_tag = 0;
 561   struct frame * f;
 562   HDC context;
 563   HFONT check_font, old_font;
 564   DWORD table;
 565   int i, retval = 0;
 566   struct gcpro gcpro1;
 567
 568   /* Check the spec is in the right format.  */
 569   if (!CONSP (otf_spec) || Flength (otf_spec) < 3)
 570     return 0;
 571
 572   /* Break otf_spec into its components.  */
 573   script = XCAR (otf_spec);
 574   rest = XCDR (otf_spec);
 575
 576   lang = XCAR (rest);
 577   rest = XCDR (rest);
 578
 579   features[0] = XCAR (rest);
 580   rest = XCDR (rest);
 581   if (NILP (rest))
 582     features[1] = Qnil;
 583   else
 584     features[1] = XCAR (rest);
 585
 586   /* Set up tags we will use in the search.  */
 587   feature_tables[0] = OTF_TAG ("GSUB");
 588   feature_tables[1] = OTF_TAG ("GPOS");
 589   default_script = OTF_TAG ("DFLT");
 590   if (NILP (script))
 591     script_tag = default_script;
 592   else
 593     script_tag = OTF_TAG (SNAME (script));
 594   if (!NILP (lang))
 595     lang_tag = OTF_TAG (SNAME (lang));
 596
 597   /* Set up graphics context so we can use the font.  */
 598   f = XFRAME (selected_frame);
 599   context = get_frame_dc (f);
 600   check_font = CreateFontIndirect (font);
 601   old_font = SelectObject (context, check_font);
 602
 603   /* Everything else is contained within otf_spec so should get
 604      marked along with it.  */
 605   GCPRO1 (otf_spec);
 606
 607   /* Scan GSUB and GPOS tables.  */
 608   for (i = 0; i < 2; i++)
 609     {
 610       int j, n_match_features;
 611       unsigned short scriptlist_table, feature_table, n_scripts;
 612       unsigned short script_table, langsys_table, n_langs;
 613       unsigned short feature_index, n_features;
 614       DWORD tbl = feature_tables[i];
 615
 616       /* Skip if no features requested from this table.  */
 617       if (NILP (features[i]))
 618         continue;
 619
 620       /* If features is not a cons, this font spec is messed up.  */
 621       if (!CONSP (features[i]))
 622         goto no_support;
 623
 624       /* Read GPOS/GSUB header.  */
 625       OTF_INT16_VAL (tbl, 4, &scriptlist_table);
 626       OTF_INT16_VAL (tbl, 6, &feature_table);
 627       OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);
 628
 629       /* Find the appropriate script table.  */
 630       script_table = 0;
 631       for (j = 0; j < n_scripts; j++)
 632         {
 633           DWORD script_id;
 634           OTF_DWORDTAG_VAL (tbl, scriptlist_table + 2 + j * 6, &script_id);
 635           if (script_id == script_tag)
 636             {
 637               OTF_INT16_VAL (tbl, scriptlist_table + 6 + j * 6, &script_table);
 638               break;
 639             }
 640           /* If there is a DFLT script defined in the font, use it
 641              if the specified script is not found.  */
 642           else if (script_id == default_script)
 643             OTF_INT16_VAL (tbl, scriptlist_table + 6 + j * 6, &script_table);
 644         }
 645       /* If no specific or default script table was found, then this font
 646          does not support the script.  */
 647       if (!script_table)
 648         goto no_support;
 649
 650       /* Offset is from beginning of scriptlist_table.  */
 651       script_table += scriptlist_table;
 652
 653       /* Get default langsys table.  */
 654       OTF_INT16_VAL (tbl, script_table, &langsys_table);
 655
 656       /* If lang was specified, see if font contains a specific entry.  */
 657       if (!NILP (lang))
 658         {
 659           OTF_INT16_VAL (tbl, script_table + 2, &n_langs);
 660
 661           for (j = 0; j < n_langs; j++)
 662             {
 663               DWORD lang_id;
 664               OTF_DWORDTAG_VAL (tbl, script_table + 4 + j * 6, &lang_id);
 665               if (lang_id == lang_tag)
 666                 {
 667                   OTF_INT16_VAL (tbl, script_table + 8 + j * 6, &langsys_table);
 668                   break;
 669                 }
 670             }
 671         }
 672
 673       if (!langsys_table)
 674         goto no_support;
 675
 676       /* Offset is from beginning of script table.  */
 677       langsys_table += script_table;
 678
 679       /* Check the features.  Features may contain nil according to
 680          documentation in font_prop_validate_otf, so count them.  */
 681       n_match_features = 0;
 682       for (rest = features[i]; CONSP (rest); rest = XCDR (rest))
 683         {
 684           Lisp_Object feature = XCAR (rest);
 685           if (!NILP (feature))
 686             n_match_features++;
 687         }
 688
 689       /* If there are no features to check, skip checking.  */
 690       if (!n_match_features)
 691         continue;
 692
 693       /* First check required feature (if any).  */
 694       OTF_INT16_VAL (tbl, langsys_table + 2, &feature_index);
 695       if (feature_index != 0xFFFF)
 696         {
 697           char feature_id[5];
 698           OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
 699           OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
 700           /* Assume no duplicates in the font table. This allows us to mark
 701              the features off by simply decrementing a counter.  */
 702           if (!NILP (Fmemq (intern (feature_id), features[i])))
 703             n_match_features--;
 704         }
 705       /* Now check all the other features.  */
 706       OTF_INT16_VAL (tbl, langsys_table + 4, &n_features);
 707       for (j = 0; j < n_features; j++)
 708         {
 709           char feature_id[5];
 710           OTF_INT16_VAL (tbl, langsys_table + 6 + j * 2, &feature_index);
 711           OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
 712           /* Assume no duplicates in the font table. This allows us to mark
 713              the features off by simply decrementing a counter.  */
 714           if (!NILP (Fmemq (intern (feature_id), features[i])))
 715             n_match_features--;
 716         }
 717
 718       if (n_match_features > 0)
 719         goto no_support;
 720     }
 721
 722   retval = 1;
 723
 724  no_support:
 725  font_table_error:
 726   /* restore graphics context.  */
 727   SelectObject (context, old_font);
 728   DeleteObject (check_font);
 729   release_frame_dc (f, context);
 730
 731   return retval;
 732 }
 733
 734 static Lisp_Object
 735 otf_features (HDC context, char *table)
 736 {
 737   Lisp_Object script_list = Qnil;
 738   unsigned short scriptlist_table, n_scripts, feature_table;
 739   DWORD tbl = OTF_TAG (table);
 740   int i, j, k;
 741
 742   /* Look for scripts in the table.  */
 743   OTF_INT16_VAL (tbl, 4, &scriptlist_table);
 744   OTF_INT16_VAL (tbl, 6, &feature_table);
 745   OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);
 746
 747   for (i = 0; i < n_scripts; i++)
 748     {
 749       char script[5], lang[5];
 750       unsigned short script_table, lang_count, langsys_table, feature_count;
 751       Lisp_Object script_tag, langsys_list, langsys_tag, feature_list;
 752       unsigned short record_offset = scriptlist_table + 2 + i * 6;
 753       OTF_TAG_VAL (tbl, record_offset, script);
 754       OTF_INT16_VAL (tbl, record_offset + 4, &script_table);
 755
 756       /* Offset is from beginning of script table.  */
 757       script_table += scriptlist_table;
 758
 759       script_tag = intern (script);
 760       langsys_list = Qnil;
 761
 762       /* Optional default lang.  */
 763       OTF_INT16_VAL (tbl, script_table, &langsys_table);
 764       if (langsys_table)
 765         {
 766           /* Offset is from beginning of script table.  */
 767           langsys_table += script_table;
 768
 769           langsys_tag = Qnil;
 770           feature_list = Qnil;
 771           OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
 772           for (k = 0; k < feature_count; k++)
 773             {
 774               char feature[5];
 775               unsigned short index;
 776               OTF_INT16_VAL (tbl, langsys_table + 6 + k * 2, &index);
 777               OTF_TAG_VAL (tbl, feature_table + 2 + index * 6, feature);
 778               feature_list = Fcons (intern (feature), feature_list);
 779             }
 780           langsys_list = Fcons (Fcons (langsys_tag, feature_list),
 781                                 langsys_list);
 782         }
 783
 784       /* List of supported languages.  */
 785       OTF_INT16_VAL (tbl, script_table + 2, &lang_count);
 786
 787       for (j = 0; j < lang_count; j++)
 788         {
 789           record_offset = script_table + 4 + j * 6;
 790           OTF_TAG_VAL (tbl, record_offset, lang);
 791           OTF_INT16_VAL (tbl, record_offset + 4, &langsys_table);
 792
 793           /* Offset is from beginning of script table.  */
 794           langsys_table += script_table;
 795
 796           langsys_tag = intern (lang);
 797           feature_list = Qnil;
 798           OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
 799           for (k = 0; k < feature_count; k++)
 800             {
 801               char feature[5];
 802               unsigned short index;
 803               OTF_INT16_VAL (tbl, langsys_table + 6 + k * 2, &index);
 804               OTF_TAG_VAL (tbl, feature_table + 2 + index * 6, feature);
 805               feature_list = Fcons (intern (feature), feature_list);
 806             }
 807           langsys_list = Fcons (Fcons (langsys_tag, feature_list),
 808                                 langsys_list);
 809
 810         }
 811
 812       script_list = Fcons (Fcons (script_tag, langsys_list), script_list);
 813     }
 814
 815   return script_list;
 816
 817 font_table_error:
 818   return Qnil;
 819 }
 820
 821 #undef OTF_INT16_VAL
 822 #undef OTF_TAG_VAL
 823 #undef OTF_TAG
 824
 825 \f
 826 struct font_driver uniscribe_font_driver =
 827   {
 828     0, /* Quniscribe */
 829     w32font_get_cache,
 830     uniscribe_list,
 831     uniscribe_match,
 832     uniscribe_list_family,
 833     NULL, /* free_entity */
 834     uniscribe_open,
 835     uniscribe_close,
 836     NULL, /* prepare_face */
 837     NULL, /* done_face */
 838     w32font_has_char,
 839     uniscribe_encode_char,
 840     w32font_text_extents,
 841     w32font_draw,
 842     NULL, /* get_bitmap */
 843     NULL, /* free_bitmap */
 844     NULL, /* get_outline */
 845     NULL, /* free_outline */
 846     NULL, /* anchor_point */
 847     uniscribe_otf_capability, /* Defined so (font-get FONTOBJ :otf) works.  */
 848     NULL, /* otf_drive - use shape instead.  */
 849     NULL, /* start_for_frame */
 850     NULL, /* end_for_frame */
 851     uniscribe_shape
 852   };
 853
 854 /* Note that this should be called at every startup, not just when dumping,
 855    as it needs to test for the existence of the Uniscribe library.  */
 856 void
 857 syms_of_w32uniscribe ()
 858 {
 859   HMODULE uniscribe;
 860
 861   /* Don't init uniscribe when dumping */
 862   if (!initialized)
 863     return;
 864
 865   /* Don't register if uniscribe is not available.  */
 866   uniscribe = GetModuleHandle ("usp10");
 867   if (!uniscribe)
 868     return;
 869
 870   uniscribe_font_driver.type = Quniscribe;
 871   uniscribe_available = 1;
 872
 873   register_font_driver (&uniscribe_font_driver, NULL);
 874 }
 875
 876 #endif /* USE_FONT_BACKEND  */
 877
 878 /* arch-tag: 9530f0e1-7471-47dd-a780-94330af87ea0
 879    (do not change this comment) */