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