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