+#define SNAME(VAL) SSDATA (SYMBOL_NAME (VAL))
+
+/* Uniscribe APIs available only since Windows Vista. */
+typedef HRESULT (WINAPI *ScriptGetFontScriptTags_Proc)
+ (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, int, OPENTYPE_TAG *, int *);
+
+typedef HRESULT (WINAPI *ScriptGetFontLanguageTags_Proc)
+ (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, OPENTYPE_TAG, int, OPENTYPE_TAG *, int *);
+
+typedef HRESULT (WINAPI *ScriptGetFontFeatureTags_Proc)
+ (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, OPENTYPE_TAG, OPENTYPE_TAG, int, OPENTYPE_TAG *, int *);
+
+ScriptGetFontScriptTags_Proc script_get_font_scripts_fn;
+ScriptGetFontLanguageTags_Proc script_get_font_languages_fn;
+ScriptGetFontFeatureTags_Proc script_get_font_features_fn;
+
+static bool uniscribe_new_apis;
+
+/* Verify that all the required features in FEATURES, each of whose
+ elements is a list or nil, can be found among the N feature tags in
+ FTAGS. Return 'true' if the required features are supported,
+ 'false' if not. Each list in FEATURES can include an element of
+ nil, which means all the elements after it must not be in FTAGS. */
+static bool
+uniscribe_check_features (Lisp_Object features[2], OPENTYPE_TAG *ftags, int n)
+{
+ int j;
+
+ for (j = 0; j < 2; j++)
+ {
+ bool negative = false;
+ Lisp_Object rest;
+
+ for (rest = features[j]; CONSP (rest); rest = XCDR (rest))
+ {
+ Lisp_Object feature = XCAR (rest);
+
+ /* The font must NOT have any of the features after nil.
+ See the doc string of 'font-spec', under ':otf'. */
+ if (NILP (feature))
+ negative = true;
+ else
+ {
+ OPENTYPE_TAG feature_tag = OTF_TAG (SNAME (feature));
+ int i;
+
+ for (i = 0; i < n; i++)
+ {
+ if (ftags[i] == feature_tag)
+ {
+ /* Test fails if we find a feature that the font
+ must NOT have. */
+ if (negative)
+ return false;
+ break;
+ }
+ }
+
+ /* Test fails if we do NOT find a feature that the font
+ should have. */
+ if (i >= n && !negative)
+ return false;
+ }
+ }
+ }
+
+ return true;
+}
+
+/* Check if font supports the required OTF script/language/features
+ using the Unsicribe APIs available since Windows Vista. We prefer
+ these APIs as a kind of future-proofing Emacs: they seem to
+ retrieve script tags that the old code (and also libotf) doesn't
+ seem to be able to get, e.g., some fonts that claim support for
+ "dev2" script don't show "deva", but the new APIs do report it. */
+static int
+uniscribe_check_otf_1 (HDC context, Lisp_Object script, Lisp_Object lang,
+ Lisp_Object features[2], int *retval)
+{
+ SCRIPT_CACHE cache = NULL;
+ OPENTYPE_TAG tags[32], script_tag, lang_tag;
+ int max_tags = ARRAYELTS (tags);
+ int ntags, i, ret = 0;
+ HRESULT rslt;
+
+ *retval = 0;
+
+ rslt = script_get_font_scripts_fn (context, &cache, NULL, max_tags,
+ tags, &ntags);
+ if (FAILED (rslt))
+ {
+ DebPrint (("ScriptGetFontScriptTags failed with 0x%x\n", rslt));
+ ret = -1;
+ goto no_support;
+ }
+ if (NILP (script))
+ script_tag = OTF_TAG ("DFLT");
+ else
+ script_tag = OTF_TAG (SNAME (script));
+ for (i = 0; i < ntags; i++)
+ if (tags[i] == script_tag)
+ break;
+
+ if (i >= ntags)
+ goto no_support;
+
+ if (NILP (lang))
+ lang_tag = OTF_TAG ("dflt");
+ else
+ {
+ rslt = script_get_font_languages_fn (context, &cache, NULL, script_tag,
+ max_tags, tags, &ntags);
+ if (FAILED (rslt))
+ {
+ DebPrint (("ScriptGetFontLanguageTags failed with 0x%x\n", rslt));
+ ret = -1;
+ goto no_support;
+ }
+ if (ntags == 0)
+ lang_tag = OTF_TAG ("dflt");
+ else
+ {
+ lang_tag = OTF_TAG (SNAME (lang));
+ for (i = 0; i < ntags; i++)
+ if (tags[i] == lang_tag)
+ break;
+
+ if (i >= ntags)
+ goto no_support;
+ }
+ }
+
+ if (!NILP (features[0]))
+ {
+ /* Are the 2 feature lists valid? */
+ if (!CONSP (features[0])
+ || (!NILP (features[1]) && !CONSP (features[1])))
+ goto no_support;
+ rslt = script_get_font_features_fn (context, &cache, NULL,
+ script_tag, lang_tag,
+ max_tags, tags, &ntags);
+ if (FAILED (rslt))
+ {
+ DebPrint (("ScriptGetFontFeatureTags failed with 0x%x\n", rslt));
+ ret = -1;
+ goto no_support;
+ }
+
+ /* ScriptGetFontFeatureTags doesn't let us query features
+ separately for GSUB and GPOS, so we check them all together.
+ It doesn't really matter, since the features in GSUB and GPOS
+ are disjoint, i.e. no feature can appear in both tables. */
+ if (!uniscribe_check_features (features, tags, ntags))
+ goto no_support;
+ }
+
+ ret = 1;
+ *retval = 1;
+
+ no_support:
+ if (cache)
+ ScriptFreeCache (&cache);
+ return ret;
+}