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