/* Font backend for the Microsoft W32 Uniscribe API.
- Copyright (C) 2008-2015 Free Software Foundation, Inc.
+ Copyright (C) 2008-2016 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <config.h>
-/* Override API version - Uniscribe is only available as standard since
- Windows 2000, though most users of older systems will have it
+/* Override API version - Uniscribe is only available as standard
+ since Windows 2000, though most users of older systems will have it
since it installs with Internet Explorer 5.0 and other software.
- We only enable the feature if it is available, so there is no chance
- of calling non-existent functions. */
+ Also, MinGW64 w32api headers by default define OPENTYPE_TAG typedef
+ only if _WIN32_WINNT >= 0x0600. We only use the affected APIs if
+ they are available, so there is no chance of calling non-existent
+ functions. */
#undef _WIN32_WINNT
-#define _WIN32_WINNT 0x500
+#define _WIN32_WINNT 0x0600
#include <windows.h>
#include <usp10.h>
#include "lisp.h"
#include "w32term.h"
#include "frame.h"
-#include "dispextern.h"
-#include "character.h"
-#include "charset.h"
#include "composite.h"
-#include "fontset.h"
#include "font.h"
#include "w32font.h"
static Lisp_Object
uniscribe_list (struct frame *f, Lisp_Object font_spec)
{
- Lisp_Object fonts = w32font_list_internal (f, font_spec, 1);
+ Lisp_Object fonts = w32font_list_internal (f, font_spec, true);
FONT_ADD_LOG ("uniscribe-list", font_spec, fonts);
return fonts;
}
static Lisp_Object
uniscribe_match (struct frame *f, Lisp_Object font_spec)
{
- Lisp_Object entity = w32font_match_internal (f, font_spec, 1);
+ Lisp_Object entity = w32font_match_internal (f, font_spec, true);
FONT_ADD_LOG ("uniscribe-match", font_spec, entity);
return entity;
}
}
/* Return a list describing which scripts/languages FONT supports by
- which GSUB/GPOS features of OpenType tables. */
+ which GSUB/GPOS features of OpenType tables.
+
+ Implementation note: otf_features called by this function uses
+ GetFontData to access the font tables directly, instead of using
+ ScriptGetFontScriptTags etc. APIs even if those are available. The
+ reason is that font-get, which uses the result of this function,
+ expects a cons cell (GSUB . GPOS) where the features are reported
+ separately for these 2 OTF tables, while the Uniscribe APIs report
+ the features as a single list. There doesn't seem to be a reason
+ for returning the features in 2 separate parts, except for
+ compatibility with libotf; the features are disjoint (each can
+ appear only in one of the 2 slots), and no client of this data
+ discerns between the two slots: the few that request this data all
+ look in both slots. If use of the Uniscribe APIs ever becomes
+ necessary here, and the 2 separate slots are still required, it
+ should be possible to split the feature list the APIs return into 2
+ because each sub-list is alphabetically sorted, so the place where
+ the sorting order breaks is where the GSUB features end and GPOS
+ features begin. But for now, this is not necessary, so we leave
+ the original code in place. */
static Lisp_Object
uniscribe_otf_capability (struct font *font)
{
\f
/* :otf property handling.
Since the necessary Uniscribe APIs for getting font tag information
- are only available in Vista, we need to parse the font data directly
+ are only available in Vista, we may need to parse the font data directly
according to the OpenType Specification. */
/* Push into DWORD backwards to cope with endianness. */
STR[4] = '\0'; \
} while (0)
-#define SNAME(VAL) SDATA (SYMBOL_NAME (VAL))
+#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;
+}
/* Check if font supports the otf script/language/features specified.
OTF_SPEC is in the format
HDC context;
HFONT check_font, old_font;
int i, retval = 0;
- struct gcpro gcpro1;
/* Check the spec is in the right format. */
if (!CONSP (otf_spec) || XINT (Flength (otf_spec)) < 3)
else
features[1] = XCAR (rest);
+ /* Set up graphics context so we can use the font. */
+ f = XFRAME (selected_frame);
+ context = get_frame_dc (f);
+ check_font = CreateFontIndirect (font);
+ old_font = SelectObject (context, check_font);
+
+ /* If we are on Vista or later, use the new APIs. */
+ if (uniscribe_new_apis
+ && !w32_disable_new_uniscribe_apis
+ && uniscribe_check_otf_1 (context, script, lang, features, &retval) != -1)
+ goto done;
+
/* Set up tags we will use in the search. */
feature_tables[0] = OTF_TAG ("GSUB");
feature_tables[1] = OTF_TAG ("GPOS");
if (!NILP (lang))
lang_tag = OTF_TAG (SNAME (lang));
- /* Set up graphics context so we can use the font. */
- f = XFRAME (selected_frame);
- context = get_frame_dc (f);
- check_font = CreateFontIndirect (font);
- old_font = SelectObject (context, check_font);
-
- /* Everything else is contained within otf_spec so should get
- marked along with it. */
- GCPRO1 (otf_spec);
-
/* Scan GSUB and GPOS tables. */
for (i = 0; i < 2; i++)
{
unsigned short script_table, langsys_table, n_langs;
unsigned short feature_index, n_features;
DWORD tbl = feature_tables[i];
+ DWORD feature_id, *ftags;
+ Lisp_Object farray[2];
/* Skip if no features requested from this table. */
if (NILP (features[i]))
/* Offset is from beginning of script table. */
langsys_table += script_table;
- /* Check the features. Features may contain nil according to
- documentation in font_prop_validate_otf, so count them. */
- n_match_features = 0;
- for (rest = features[i]; CONSP (rest); rest = XCDR (rest))
- {
- Lisp_Object feature = XCAR (rest);
- if (!NILP (feature))
- n_match_features++;
- }
-
/* If there are no features to check, skip checking. */
- if (!n_match_features)
+ if (NILP (features[i]))
continue;
+ if (!CONSP (features[i]))
+ goto no_support;
+
+ n_match_features = 0;
- /* First check required feature (if any). */
+ /* First get required feature (if any). */
OTF_INT16_VAL (tbl, langsys_table + 2, &feature_index);
+ if (feature_index != 0xFFFF)
+ n_match_features = 1;
+ OTF_INT16_VAL (tbl, langsys_table + 4, &n_features);
+ n_match_features += n_features;
+ USE_SAFE_ALLOCA;
+ SAFE_NALLOCA (ftags, 1, n_match_features);
+ int k = 0;
if (feature_index != 0xFFFF)
{
- char feature_id[5];
- OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
- OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
- /* Assume no duplicates in the font table. This allows us to mark
- the features off by simply decrementing a counter. */
- if (!NILP (Fmemq (intern (feature_id), features[i])))
- n_match_features--;
+ OTF_DWORDTAG_VAL (tbl, feature_table + 2 + feature_index * 6,
+ &feature_id);
+ ftags[k++] = feature_id;
}
- /* Now check all the other features. */
- OTF_INT16_VAL (tbl, langsys_table + 4, &n_features);
+ /* Now get all the other features. */
for (j = 0; j < n_features; j++)
{
- char feature_id[5];
OTF_INT16_VAL (tbl, langsys_table + 6 + j * 2, &feature_index);
- OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
- /* Assume no duplicates in the font table. This allows us to mark
- the features off by simply decrementing a counter. */
- if (!NILP (Fmemq (intern (feature_id), features[i])))
- n_match_features--;
+ OTF_DWORDTAG_VAL (tbl, feature_table + 2 + feature_index * 6,
+ &feature_id);
+ ftags[k++] = feature_id;
}
- if (n_match_features > 0)
+ /* Check the features for this table. */
+ farray[0] = features[i];
+ farray[1] = Qnil;
+ if (!uniscribe_check_features (farray, ftags, n_match_features))
goto no_support;
+ SAFE_FREE ();
}
retval = 1;
+ done:
no_support:
font_table_error:
/* restore graphics context. */
OTF_INT16_VAL (tbl, 6, &feature_table);
OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);
- for (i = 0; i < n_scripts; i++)
+ for (i = n_scripts - 1; i >= 0; i--)
{
char script[5], lang[5];
unsigned short script_table, lang_count, langsys_table, feature_count;
langsys_tag = Qnil;
feature_list = Qnil;
OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
- for (k = 0; k < feature_count; k++)
+ for (k = feature_count - 1; k >= 0; k--)
{
char feature[5];
unsigned short index;
/* List of supported languages. */
OTF_INT16_VAL (tbl, script_table + 2, &lang_count);
- for (j = 0; j < lang_count; j++)
+ for (j = lang_count - 1; j >= 0; j--)
{
record_offset = script_table + 4 + j * 6;
OTF_TAG_VAL (tbl, record_offset, lang);
langsys_tag = intern (lang);
feature_list = Qnil;
OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
- for (k = 0; k < feature_count; k++)
+ for (k = feature_count - 1; k >= 0; k--)
{
char feature[5];
unsigned short index;
uniscribe_available = 1;
register_font_driver (&uniscribe_font_driver, NULL);
+
+ script_get_font_scripts_fn = (ScriptGetFontScriptTags_Proc)
+ GetProcAddress (uniscribe, "ScriptGetFontScriptTags");
+ script_get_font_languages_fn = (ScriptGetFontLanguageTags_Proc)
+ GetProcAddress (uniscribe, "ScriptGetFontLanguageTags");
+ script_get_font_features_fn = (ScriptGetFontFeatureTags_Proc)
+ GetProcAddress (uniscribe, "ScriptGetFontFeatureTags");
+ if (script_get_font_scripts_fn
+ && script_get_font_languages_fn
+ && script_get_font_features_fn)
+ uniscribe_new_apis = true;
+ else
+ uniscribe_new_apis = false;
}