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;
 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 = 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 + 1);
 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 + 1);
 251     }
 252
 253   /* 0 = success in Microsoft's backwards world.  */
 254   if (result)
 255     {
 256       xfree (items);
 257       return Qnil;
 258     }
 259
 260   /* TODO: When we get BIDI support, we need to call ScriptLayout here.
 261      Requires that we know the surrounding context.  */
 262
 263   f = XFRAME (selected_frame);
 264   context = get_frame_dc (f);
 265   old_font = SelectObject (context,
 266                            ((W32FontStruct *) (font->font.font))->hfont);
 267
 268   glyphs = alloca (max_glyphs * sizeof (WORD));
 269   clusters = alloca (nchars * sizeof (WORD));
 270   attributes = alloca (max_glyphs * sizeof (SCRIPT_VISATTR));
 271   advances = alloca (max_glyphs * sizeof (int));
 272   offsets = alloca (max_glyphs * sizeof (GOFFSET));
 273   bzero (&transform, sizeof (transform));
 274   transform.eM11.value = 1;
 275   transform.eM22.value = 1;
 276
 277   for (i = 0; i < nitems; i++)
 278     {
 279       int nglyphs, nchars_in_run, rtl = items[i].a.fRTL ? -1 : 1;
 280       nchars_in_run = items[i+1].iCharPos - items[i].iCharPos;
 281
 282       result = ScriptShape (context, &(uniscribe_font->cache),
 283                             chars + items[i].iCharPos, nchars_in_run,
 284                             max_glyphs - done_glyphs, &(items[i].a),
 285                             glyphs, clusters, attributes, &nglyphs);
 286       if (result == E_OUTOFMEMORY)
 287         {
 288           /* Need a bigger lgstring.  */
 289           lgstring = Qnil;
 290           break;
 291         }
 292       else if (result) /* Failure.  */
 293         {
 294           /* Can't shape this run - return results so far if any.  */
 295           break;
 296         }
 297       else if (items[i].a.fNoGlyphIndex)
 298         {
 299           /* Glyph indices not supported by this font (or OS), means we
 300              can't really do any meaningful shaping.  */
 301           break;
 302         }
 303       else
 304         {
 305           result = ScriptPlace (context, &(uniscribe_font->cache),
 306                                 glyphs, nglyphs, attributes, &(items[i].a),
 307                                 advances, offsets, &overall_metrics);
 308           if (result == 0) /* Success.  */
 309             {
 310               int j, nclusters, from, to;
 311
 312               from = rtl > 0 ? 0 : nchars_in_run - 1;
 313               to = from;
 314
 315               for (j = 0; j < nglyphs; j++)
 316                 {
 317                   int lglyph_index = j + done_glyphs;
 318                   Lisp_Object lglyph = LGSTRING_GLYPH (lgstring, lglyph_index);
 319                   ABC char_metric;
 320
 321                   if (NILP (lglyph))
 322                     {
 323                       lglyph = Fmake_vector (make_number (LGLYPH_SIZE), Qnil);
 324                       LGSTRING_SET_GLYPH (lgstring, lglyph_index, lglyph);
 325                     }
 326                   LGLYPH_SET_CODE (lglyph, glyphs[j]);
 327
 328                   /* Detect clusters, for linking codes back to characters.  */
 329                   if (attributes[j].fClusterStart)
 330                     {
 331                       while (from >= 0 && from < nchars_in_run
 332                              && clusters[from] < j)
 333                         from += rtl;
 334                       if (from < 0)
 335                         from = to = 0;
 336                       else if (from >= nchars_in_run)
 337                         from = to = nchars_in_run - 1;
 338                       else
 339                         {
 340                           int k;
 341                           to = rtl > 0 ? nchars_in_run - 1 : 0;
 342                           for (k = from + rtl; k >= 0 && k < nchars_in_run;
 343                                k += rtl)
 344                             {
 345                               if (clusters[k] > j)
 346                                 {
 347                                   to = k - 1;
 348                                   break;
 349                                 }
 350                             }
 351                         }
 352                     }
 353
 354                   LGLYPH_SET_CHAR (lglyph, chars[items[i].iCharPos
 355                                                  + from]);
 356                   LGLYPH_SET_FROM (lglyph, items[i].iCharPos + from);
 357                   LGLYPH_SET_TO (lglyph, items[i].iCharPos + to);
 358
 359                   /* Metrics.  */
 360                   LGLYPH_SET_WIDTH (lglyph, advances[j]);
 361                   LGLYPH_SET_ASCENT (lglyph, font->ascent);
 362                   LGLYPH_SET_DESCENT (lglyph, font->descent);
 363
 364                   result = ScriptGetGlyphABCWidth (context,
 365                                                    &(uniscribe_font->cache),
 366                                                    glyphs[j], &char_metric);
 367
 368                   if (result == 0) /* Success.  */
 369                     {
 370                       LGLYPH_SET_LBEARING (lglyph, char_metric.abcA);
 371                       LGLYPH_SET_RBEARING (lglyph, (char_metric.abcA
 372                                                     + char_metric.abcB));
 373                     }
 374                   else
 375                     {
 376                       LGLYPH_SET_LBEARING (lglyph, 0);
 377                       LGLYPH_SET_RBEARING (lglyph, advances[j]);
 378                     }
 379
 380                   if (offsets[j].du || offsets[j].dv)
 381                     {
 382                       Lisp_Object vec;
 383                       vec = Fmake_vector (make_number (3), Qnil);
 384                       ASET (vec, 0, make_number (offsets[j].du));
 385                       ASET (vec, 1, make_number (offsets[j].dv));
 386                       /* Based on what ftfont.c does... */
 387                       ASET (vec, 2, make_number (advances[j]));
 388                       LGLYPH_SET_ADJUSTMENT (lglyph, vec);
 389                     }
 390                   else
 391                     LGLYPH_SET_ADJUSTMENT (lglyph, Qnil);
 392                 }           }
 393         }
 394       done_glyphs += nglyphs;
 395     }
 396
 397   xfree (items);
 398   SelectObject (context, old_font);
 399   release_frame_dc (f, context);
 400
 401   if (NILP (lgstring))
 402     return Qnil;
 403   else
 404     return make_number (done_glyphs);
 405 }
 406
 407 /* Uniscribe implementation of encode_char for font backend.
 408    Return a glyph code of FONT for characer C (Unicode code point).
 409    If FONT doesn't have such a glyph, return FONT_INVALID_CODE.  */
 410 static unsigned
 411 uniscribe_encode_char (font, c)
 412      struct font *font;
 413      int c;
 414 {
 415   wchar_t chars[1];
 416   WORD indices[1];
 417   HDC context;
 418   struct frame *f;
 419   HFONT old_font;
 420   DWORD retval;
 421
 422   /* TODO: surrogates.  */
 423   if (c > 0xFFFF)
 424     return FONT_INVALID_CODE;
 425
 426   chars[0] = (wchar_t) c;
 427
 428   /* Use selected frame until API is updated to pass the frame.  */
 429   f = XFRAME (selected_frame);
 430   context = get_frame_dc (f);
 431   old_font = SelectObject (context,
 432                            ((W32FontStruct *)(font->font.font))->hfont);
 433
 434   retval = GetGlyphIndicesW (context, chars, 1, indices,
 435                              GGI_MARK_NONEXISTING_GLYPHS);
 436
 437   SelectObject (context, old_font);
 438   release_frame_dc (f, context);
 439
 440   if (retval == 1)
 441     return indices[0] == 0xFFFF ? FONT_INVALID_CODE : indices[0];
 442   else
 443     return FONT_INVALID_CODE;
 444 }
 445
 446 /*
 447    Shared with w32font:
 448    Lisp_Object uniscribe_get_cache (Lisp_Object frame);
 449    void uniscribe_free_entity (Lisp_Object font_entity);
 450    int uniscribe_has_char (Lisp_Object entity, int c);
 451    int uniscribe_text_extents (struct font *font, unsigned *code,
 452                                int nglyphs, struct font_metrics *metrics);
 453    int uniscribe_draw (struct glyph_string *s, int from, int to,
 454                        int x, int y, int with_background);
 455
 456    Unused:
 457    int uniscribe_prepare_face (FRAME_PTR f, struct face *face);
 458    void uniscribe_done_face (FRAME_PTR f, struct face *face);
 459    int uniscribe_get_bitmap (struct font *font, unsigned code,
 460                              struct font_bitmap *bitmap, int bits_per_pixel);
 461    void uniscribe_free_bitmap (struct font *font, struct font_bitmap *bitmap);
 462    void * uniscribe_get_outline (struct font *font, unsigned code);
 463    void uniscribe_free_outline (struct font *font, void *outline);
 464    int uniscribe_anchor_point (struct font *font, unsigned code,
 465                                int index, int *x, int *y);
 466    int uniscribe_start_for_frame (FRAME_PTR f);
 467    int uniscribe_end_for_frame (FRAME_PTR f);
 468
 469 */
 470
 471 \f
 472 /* Callback function for EnumFontFamiliesEx.
 473    Adds the name of opentype fonts to a Lisp list (passed in as the
 474    lParam arg). */
 475 static int CALLBACK
 476 add_opentype_font_name_to_list (logical_font, physical_font, font_type,
 477                                 list_object)
 478      ENUMLOGFONTEX *logical_font;
 479      NEWTEXTMETRICEX *physical_font;
 480      DWORD font_type;
 481      LPARAM list_object;
 482 {
 483   Lisp_Object* list = (Lisp_Object *) list_object;
 484   Lisp_Object family;
 485
 486   /* Skip vertical fonts (intended only for printing)  */
 487   if (logical_font->elfLogFont.lfFaceName[0] == '@')
 488     return 1;
 489
 490   /* Skip non opentype fonts.  Count old truetype fonts as opentype,
 491      as some of them do contain GPOS and GSUB data that Uniscribe
 492      can make use of.  */
 493   if (!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
 494       && font_type != TRUETYPE_FONTTYPE)
 495     return 1;
 496
 497   family = intern_downcase (logical_font->elfLogFont.lfFaceName,
 498                             strlen (logical_font->elfLogFont.lfFaceName));
 499   if (! memq_no_quit (family, *list))
 500     *list = Fcons (family, *list);
 501
 502   return 1;
 503 }
 504
 505 \f
 506 /* :otf property handling.
 507    Since the necessary Uniscribe APIs for getting font tag information
 508    are only available in Vista, we need to parse the font data directly
 509    according to the OpenType Specification.  */
 510
 511 /* Push into DWORD backwards to cope with endianness.  */
 512 #define OTF_TAG(STR)                                          \
 513   ((STR[3] << 24) | (STR[2] << 16) | (STR[1] << 8) | STR[0])
 514
 515 #define OTF_INT16_VAL(TABLE, OFFSET, PTR)                    \
 516   do {                                                       \
 517     BYTE temp, data[2];                                      \
 518     if (GetFontData (context, TABLE, OFFSET, data, 2) != 2)  \
 519       goto font_table_error;                                 \
 520     temp = data[0], data[0] = data[1], data[1] = temp;       \
 521     memcpy (PTR, data, 2);                                   \
 522   } while (0)
 523
 524 /* Do not reverse the bytes, because we will compare with a OTF_TAG value
 525    that has them reversed already.  */
 526 #define OTF_DWORDTAG_VAL(TABLE, OFFSET, PTR)                    \
 527   do {                                                          \
 528     if (GetFontData (context, TABLE, OFFSET, PTR, 4) != 4)      \
 529       goto font_table_error;                                    \
 530   } while (0)
 531
 532 #define OTF_TAG_VAL(TABLE, OFFSET, STR)                      \
 533   do {                                                       \
 534     if (GetFontData (context, TABLE, OFFSET, STR, 4) != 4)   \
 535       goto font_table_error;                                 \
 536     STR[4] = '\0';                                           \
 537   } while (0)
 538
 539 static char* NOTHING = "    ";
 540
 541 #define SNAME(VAL) SDATA (SYMBOL_NAME (VAL))
 542
 543 /* Check if font supports the otf script/language/features specified.
 544    OTF_SPEC is in the format
 545      (script lang [(gsub_feature ...)|nil] [(gpos_feature ...)]?) */
 546 int uniscribe_check_otf (font, otf_spec)
 547      LOGFONT *font;
 548      Lisp_Object otf_spec;
 549 {
 550   Lisp_Object script, lang, rest;
 551   Lisp_Object features[2];
 552   DWORD feature_tables[2];
 553   DWORD script_tag, default_script, lang_tag = 0;
 554   struct frame * f;
 555   HDC context;
 556   HFONT check_font, old_font;
 557   DWORD table;
 558   int i, retval = 0;
 559   struct gcpro gcpro1;
 560
 561   /* Check the spec is in the right format.  */
 562   if (!CONSP (otf_spec) || Flength (otf_spec) < 3)
 563     return 0;
 564
 565   /* Break otf_spec into its components.  */
 566   script = XCAR (otf_spec);
 567   rest = XCDR (otf_spec);
 568
 569   lang = XCAR (rest);
 570   rest = XCDR (rest);
 571
 572   features[0] = XCAR (rest);
 573   rest = XCDR (rest);
 574   if (NILP (rest))
 575     features[1] = Qnil;
 576   else
 577     features[1] = XCAR (rest);
 578
 579   /* Set up tags we will use in the search.  */
 580   feature_tables[0] = OTF_TAG ("GSUB");
 581   feature_tables[1] = OTF_TAG ("GPOS");
 582   default_script = OTF_TAG ("DFLT");
 583   if (NILP (script))
 584     script_tag = default_script;
 585   else
 586     script_tag = OTF_TAG (SNAME (script));
 587   if (!NILP (lang))
 588     lang_tag = OTF_TAG (SNAME (lang));
 589
 590   /* Set up graphics context so we can use the font.  */
 591   f = XFRAME (selected_frame);
 592   context = get_frame_dc (f);
 593   check_font = CreateFontIndirect (font);
 594   old_font = SelectObject (context, check_font);
 595
 596   /* Everything else is contained within otf_spec so should get
 597      marked along with it.  */
 598   GCPRO1 (otf_spec);
 599
 600   /* Scan GSUB and GPOS tables.  */
 601   for (i = 0; i < 2; i++)
 602     {
 603       int j, n_match_features;
 604       unsigned short scriptlist_table, feature_table, n_scripts;
 605       unsigned short script_table, langsys_table, n_langs;
 606       unsigned short feature_index, n_features;
 607       DWORD tbl = feature_tables[i];
 608
 609       /* Skip if no features requested from this table.  */
 610       if (NILP (features[i]))
 611         continue;
 612
 613       /* If features is not a cons, this font spec is messed up.  */
 614       if (!CONSP (features[i]))
 615         goto no_support;
 616
 617       /* Read GPOS/GSUB header.  */
 618       OTF_INT16_VAL (tbl, 4, &scriptlist_table);
 619       OTF_INT16_VAL (tbl, 6, &feature_table);
 620       OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);
 621
 622       /* Find the appropriate script table.  */
 623       script_table = 0;
 624       for (j = 0; j < n_scripts; j++)
 625         {
 626           DWORD script_id;
 627           OTF_DWORDTAG_VAL (tbl, scriptlist_table + 2 + j * 6, &script_id);
 628           if (script_id == script_tag)
 629             {
 630               OTF_INT16_VAL (tbl, scriptlist_table + 6 + j * 6, &script_table);
 631               break;
 632             }
 633           /* If there is a DFLT script defined in the font, use it
 634              if the specified script is not found.  */
 635           else if (script_id == default_script)
 636             OTF_INT16_VAL (tbl, scriptlist_table + 6 + j * 6, &script_table);
 637         }
 638       /* If no specific or default script table was found, then this font
 639          does not support the script.  */
 640       if (!script_table)
 641         goto no_support;
 642
 643       /* Offset is from beginning of scriptlist_table.  */
 644       script_table += scriptlist_table;
 645
 646       /* Get default langsys table.  */
 647       OTF_INT16_VAL (tbl, script_table, &langsys_table);
 648
 649       /* If lang was specified, see if font contains a specific entry.  */
 650       if (!NILP (lang))
 651         {
 652           OTF_INT16_VAL (tbl, script_table + 2, &n_langs);
 653
 654           for (j = 0; j < n_langs; j++)
 655             {
 656               DWORD lang_id;
 657               OTF_DWORDTAG_VAL (tbl, script_table + 4 + j * 6, &lang_id);
 658               if (lang_id == lang_tag)
 659                 {
 660                   OTF_INT16_VAL (tbl, script_table + 8 + j * 6, &langsys_table);
 661                   break;
 662                 }
 663             }
 664         }
 665
 666       if (!langsys_table)
 667         goto no_support;
 668
 669       /* Offset is from beginning of script table.  */
 670       langsys_table += script_table;
 671
 672       /* Check the features.  Features may contain nil according to
 673          documentation in font_prop_validate_otf, so count them.  */
 674       n_match_features = 0;
 675       for (rest = features[i]; CONSP (rest); rest = XCDR (rest))
 676         {
 677           Lisp_Object feature = XCAR (rest);
 678           if (!NILP (feature))
 679             n_match_features++;
 680         }
 681
 682       /* If there are no features to check, skip checking.  */
 683       if (!n_match_features)
 684         continue;
 685
 686       /* First check required feature (if any).  */
 687       OTF_INT16_VAL (tbl, langsys_table + 2, &feature_index);
 688       if (feature_index != 0xFFFF)
 689         {
 690           char feature_id[5];
 691           OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
 692           OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
 693           /* Assume no duplicates in the font table. This allows us to mark
 694              the features off by simply decrementing a counter.  */
 695           if (!NILP (Fmemq (intern (feature_id), features[i])))
 696             n_match_features--;
 697         }
 698       /* Now check all the other features.  */
 699       OTF_INT16_VAL (tbl, langsys_table + 4, &n_features);
 700       for (j = 0; j < n_features; j++)
 701         {
 702           char feature_id[5];
 703           OTF_INT16_VAL (tbl, langsys_table + 6 + j * 2, &feature_index);
 704           OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
 705           /* Assume no duplicates in the font table. This allows us to mark
 706              the features off by simply decrementing a counter.  */
 707           if (!NILP (Fmemq (intern (feature_id), features[i])))
 708             n_match_features--;
 709         }
 710
 711       if (n_match_features > 0)
 712         goto no_support;
 713     }
 714
 715   retval = 1;
 716
 717  no_support:
 718  font_table_error:
 719   /* restore graphics context.  */
 720   SelectObject (context, old_font);
 721   DeleteObject (check_font);
 722   release_frame_dc (f, context);
 723
 724   return retval;
 725 }
 726
 727 static Lisp_Object
 728 otf_features (HDC context, char *table)
 729 {
 730   Lisp_Object script_list = Qnil;
 731   unsigned short scriptlist_table, n_scripts, feature_table;
 732   DWORD tbl = OTF_TAG (table);
 733   int i, j, k;
 734
 735   /* Look for scripts in the table.  */
 736   OTF_INT16_VAL (tbl, 4, &scriptlist_table);
 737   OTF_INT16_VAL (tbl, 6, &feature_table);
 738   OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);
 739
 740   for (i = 0; i < n_scripts; i++)
 741     {
 742       char script[5], lang[5];
 743       unsigned short script_table, lang_count, langsys_table, feature_count;
 744       Lisp_Object script_tag, langsys_list, langsys_tag, feature_list;
 745       unsigned short record_offset = scriptlist_table + 2 + i * 6;
 746       OTF_TAG_VAL (tbl, record_offset, script);
 747       OTF_INT16_VAL (tbl, record_offset + 4, &script_table);
 748
 749       /* Offset is from beginning of script table.  */
 750       script_table += scriptlist_table;
 751
 752       script_tag = intern (script);
 753       langsys_list = Qnil;
 754
 755       /* Optional default lang.  */
 756       OTF_INT16_VAL (tbl, script_table, &langsys_table);
 757       if (langsys_table)
 758         {
 759           /* Offset is from beginning of script table.  */
 760           langsys_table += script_table;
 761
 762           langsys_tag = Qnil;
 763           feature_list = Qnil;
 764           OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
 765           for (k = 0; k < feature_count; k++)
 766             {
 767               char feature[5];
 768               unsigned short index;
 769               OTF_INT16_VAL (tbl, langsys_table + 6 + k * 2, &index);
 770               OTF_TAG_VAL (tbl, feature_table + 2 + index * 6, feature);
 771               feature_list = Fcons (intern (feature), feature_list);
 772             }
 773           langsys_list = Fcons (Fcons (langsys_tag, feature_list),
 774                                 langsys_list);
 775         }
 776
 777       /* List of supported languages.  */
 778       OTF_INT16_VAL (tbl, script_table + 2, &lang_count);
 779
 780       for (j = 0; j < lang_count; j++)
 781         {
 782           record_offset = script_table + 4 + j * 6;
 783           OTF_TAG_VAL (tbl, record_offset, lang);
 784           OTF_INT16_VAL (tbl, record_offset + 4, &langsys_table);
 785
 786           /* Offset is from beginning of script table.  */
 787           langsys_table += script_table;
 788
 789           langsys_tag = intern (lang);
 790           feature_list = Qnil;
 791           OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
 792           for (k = 0; k < feature_count; k++)
 793             {
 794               char feature[5];
 795               unsigned short index;
 796               OTF_INT16_VAL (tbl, langsys_table + 6 + k * 2, &index);
 797               OTF_TAG_VAL (tbl, feature_table + 2 + index * 6, feature);
 798               feature_list = Fcons (intern (feature), feature_list);
 799             }
 800           langsys_list = Fcons (Fcons (langsys_tag, feature_list),
 801                                 langsys_list);
 802
 803         }
 804
 805       script_list = Fcons (Fcons (script_tag, langsys_list), script_list);
 806     }
 807
 808   return script_list;
 809
 810 font_table_error:
 811   return Qnil;
 812 }
 813
 814 #undef OTF_INT16_VAL
 815 #undef OTF_TAG_VAL
 816 #undef OTF_TAG
 817
 818 \f
 819 struct font_driver uniscribe_font_driver =
 820   {
 821     0, /* Quniscribe */
 822     w32font_get_cache,
 823     uniscribe_list,
 824     uniscribe_match,
 825     uniscribe_list_family,
 826     NULL, /* free_entity */
 827     uniscribe_open,
 828     uniscribe_close,
 829     NULL, /* prepare_face */
 830     NULL, /* done_face */
 831     w32font_has_char,
 832     uniscribe_encode_char,
 833     w32font_text_extents,
 834     w32font_draw,
 835     NULL, /* get_bitmap */
 836     NULL, /* free_bitmap */
 837     NULL, /* get_outline */
 838     NULL, /* free_outline */
 839     NULL, /* anchor_point */
 840     uniscribe_otf_capability, /* Defined so (font-get FONTOBJ :otf) works.  */
 841     NULL, /* otf_drive - use shape instead.  */
 842     NULL, /* start_for_frame */
 843     NULL, /* end_for_frame */
 844     uniscribe_shape
 845   };
 846
 847 /* Note that this should be called at every startup, not just when dumping,
 848    as it needs to test for the existence of the Uniscribe library.  */
 849 void
 850 syms_of_w32uniscribe ()
 851 {
 852   HMODULE uniscribe;
 853
 854   /* Don't init uniscribe when dumping */
 855   if (!initialized)
 856     return;
 857
 858   /* Don't register if uniscribe is not available.  */
 859   uniscribe = GetModuleHandle ("usp10");
 860   if (!uniscribe)
 861     return;
 862
 863   uniscribe_font_driver.type = Quniscribe;
 864   uniscribe_available = 1;
 865
 866   register_font_driver (&uniscribe_font_driver, NULL);
 867 }
 868
 869 #endif /* USE_FONT_BACKEND  */
 870
 871 /* arch-tag: 9530f0e1-7471-47dd-a780-94330af87ea0
 872    (do not change this comment) */