1 /* Font backend for the Microsoft W32 Uniscribe API.
2 Copyright (C) 2008-2015 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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.
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.
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/>. */
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-existent functions. */
27 #define _WIN32_WINNT 0x500
34 #include "dispextern.h"
35 #include "character.h"
37 #include "composite.h"
42 struct uniscribe_font_info
44 struct w32font_info w32_font
;
48 int uniscribe_available
= 0;
50 /* EnumFontFamiliesEx callback. */
51 static int CALLBACK ALIGN_STACK
add_opentype_font_name_to_list (ENUMLOGFONTEX
*,
54 /* Used by uniscribe_otf_capability. */
55 static Lisp_Object
otf_features (HDC context
, char *table
);
58 memq_no_quit (Lisp_Object elt
, Lisp_Object list
)
60 while (CONSP (list
) && ! EQ (XCAR (list
), elt
))
62 return (CONSP (list
));
66 /* Font backend interface implementation. */
68 uniscribe_list (struct frame
*f
, Lisp_Object font_spec
)
70 Lisp_Object fonts
= w32font_list_internal (f
, font_spec
, true);
71 FONT_ADD_LOG ("uniscribe-list", font_spec
, fonts
);
76 uniscribe_match (struct frame
*f
, Lisp_Object font_spec
)
78 Lisp_Object entity
= w32font_match_internal (f
, font_spec
, true);
79 FONT_ADD_LOG ("uniscribe-match", font_spec
, entity
);
84 uniscribe_list_family (struct frame
*f
)
86 Lisp_Object list
= Qnil
;
87 LOGFONT font_match_pattern
;
90 memset (&font_match_pattern
, 0, sizeof (font_match_pattern
));
91 /* Limit enumerated fonts to outline fonts to save time. */
92 font_match_pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
94 dc
= get_frame_dc (f
);
96 EnumFontFamiliesEx (dc
, &font_match_pattern
,
97 (FONTENUMPROC
) add_opentype_font_name_to_list
,
99 release_frame_dc (f
, dc
);
105 uniscribe_open (struct frame
*f
, Lisp_Object font_entity
, int pixel_size
)
107 Lisp_Object font_object
108 = font_make_object (VECSIZE (struct uniscribe_font_info
),
109 font_entity
, pixel_size
);
110 struct uniscribe_font_info
*uniscribe_font
111 = (struct uniscribe_font_info
*) XFONT_OBJECT (font_object
);
113 ASET (font_object
, FONT_TYPE_INDEX
, Quniscribe
);
115 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
120 /* Initialize the cache for this font. */
121 uniscribe_font
->cache
= NULL
;
123 /* Uniscribe backend uses glyph indices. */
124 uniscribe_font
->w32_font
.glyph_idx
= ETO_GLYPH_INDEX
;
126 uniscribe_font
->w32_font
.font
.driver
= &uniscribe_font_driver
;
132 uniscribe_close (struct font
*font
)
134 struct uniscribe_font_info
*uniscribe_font
135 = (struct uniscribe_font_info
*) font
;
137 if (uniscribe_font
->cache
)
138 ScriptFreeCache (&(uniscribe_font
->cache
));
140 w32font_close (font
);
143 /* Return a list describing which scripts/languages FONT supports by
144 which GSUB/GPOS features of OpenType tables.
146 Implementation note: otf_features called by this function uses
147 GetFontData to access the font tables directly, instead of using
148 ScriptGetFontScriptTags etc. APIs even if those are available. The
149 reason is that font-get, which uses the result of this function,
150 expects a cons cell (GSUB . GPOS) where the features are reported
151 separately for these 2 OTF tables, while the Uniscribe APIs report
152 the features as a single list. There doesn't seem to be a reason
153 for returning the features in 2 separate parts, except for
154 compatibility with libotf; the features are disjoint (each can
155 appear only in one of the 2 slots), and no client of this data
156 discerns between the two slots: the few that request this data all
157 look in both slots. If use of the Uniscribe APIs ever becomes
158 necessary here, and the 2 separate slots are still required, it
159 should be possible to split the feature list the APIs return into 2
160 because each sub-list is alphabetically sorted, so the place where
161 the sorting order breaks is where the GSUB features end and GPOS
162 features begin. But for now, this is not necessary, so we leave
163 the original code in place. */
165 uniscribe_otf_capability (struct font
*font
)
170 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
171 Lisp_Object features
;
173 f
= XFRAME (selected_frame
);
174 context
= get_frame_dc (f
);
175 old_font
= SelectObject (context
, FONT_HANDLE (font
));
177 features
= otf_features (context
, "GSUB");
178 XSETCAR (capability
, features
);
179 features
= otf_features (context
, "GPOS");
180 XSETCDR (capability
, features
);
182 SelectObject (context
, old_font
);
183 release_frame_dc (f
, context
);
188 /* Uniscribe implementation of shape for font backend.
190 Shape text in LGSTRING. See the docstring of
191 `composition-get-gstring' for the format of LGSTRING. If the
192 (N+1)th element of LGSTRING is nil, input of shaping is from the
193 1st to (N)th elements. In each input glyph, FROM, TO, CHAR, and
194 CODE are already set.
196 This function updates all fields of the input glyphs. If the
197 output glyphs (M) are more than the input glyphs (N), (N+1)th
198 through (M)th elements of LGSTRING are updated possibly by making
199 a new glyph object and storing it in LGSTRING. If (M) is greater
200 than the length of LGSTRING, nil should be returned. In that case,
201 this function is called again with a larger LGSTRING. */
203 uniscribe_shape (Lisp_Object lgstring
)
205 struct font
*font
= CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring
));
206 struct uniscribe_font_info
*uniscribe_font
207 = (struct uniscribe_font_info
*) font
;
209 int nitems
, max_items
, i
, max_glyphs
, done_glyphs
;
211 WORD
*glyphs
, *clusters
;
213 SCRIPT_VISATTR
*attributes
;
218 struct frame
* f
= NULL
;
220 HFONT old_font
= NULL
;
222 /* Get the chars from lgstring in a form we can use with uniscribe. */
223 max_glyphs
= nchars
= LGSTRING_GLYPH_LEN (lgstring
);
225 chars
= (wchar_t *) alloca (nchars
* sizeof (wchar_t));
226 /* FIXME: This loop assumes that characters in the input LGSTRING
227 are all inside the BMP. Need to encode characters beyond the BMP
229 for (i
= 0; i
< nchars
; i
++)
231 /* lgstring can be bigger than the number of characters in it, in
232 the case where more glyphs are required to display those characters.
233 If that is the case, note the real number of characters. */
234 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
237 chars
[i
] = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring
, i
));
240 /* First we need to break up the glyph string into runs of glyphs that
241 can be treated together. First try a single run. */
243 items
= xmalloc (sizeof (SCRIPT_ITEM
) * max_items
+ 1);
245 while ((result
= ScriptItemize (chars
, nchars
, max_items
, NULL
, NULL
,
246 items
, &nitems
)) == E_OUTOFMEMORY
)
248 /* If that wasn't enough, keep trying with one more run. */
250 items
= (SCRIPT_ITEM
*) xrealloc (items
,
251 sizeof (SCRIPT_ITEM
) * max_items
+ 1);
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
));
266 for (i
= 0; i
< nitems
; i
++)
268 int nglyphs
, nchars_in_run
;
269 nchars_in_run
= items
[i
+1].iCharPos
- items
[i
].iCharPos
;
270 /* Force ScriptShape to generate glyphs in the same order as
271 they are in the input LGSTRING, which is in the logical
273 items
[i
].a
.fLogicalOrder
= 1;
275 /* Context may be NULL here, in which case the cache should be
276 used without needing to select the font. */
277 result
= ScriptShape (context
, &(uniscribe_font
->cache
),
278 chars
+ items
[i
].iCharPos
, nchars_in_run
,
279 max_glyphs
- done_glyphs
, &(items
[i
].a
),
280 glyphs
, clusters
, attributes
, &nglyphs
);
282 if (result
== E_PENDING
&& !context
)
284 /* This assumes the selected frame is on the same display as the
285 one we are drawing. It would be better for the frame to be
287 f
= XFRAME (selected_frame
);
288 context
= get_frame_dc (f
);
289 old_font
= SelectObject (context
, FONT_HANDLE (font
));
291 result
= ScriptShape (context
, &(uniscribe_font
->cache
),
292 chars
+ items
[i
].iCharPos
, nchars_in_run
,
293 max_glyphs
- done_glyphs
, &(items
[i
].a
),
294 glyphs
, clusters
, attributes
, &nglyphs
);
297 if (result
== E_OUTOFMEMORY
)
299 /* Need a bigger lgstring. */
303 else if (FAILED (result
))
305 /* Can't shape this run - return results so far if any. */
308 else if (items
[i
].a
.fNoGlyphIndex
)
310 /* Glyph indices not supported by this font (or OS), means we
311 can't really do any meaningful shaping. */
316 result
= ScriptPlace (context
, &(uniscribe_font
->cache
),
317 glyphs
, nglyphs
, attributes
, &(items
[i
].a
),
318 advances
, offsets
, &overall_metrics
);
319 if (result
== E_PENDING
&& !context
)
321 /* Cache not complete... */
322 f
= XFRAME (selected_frame
);
323 context
= get_frame_dc (f
);
324 old_font
= SelectObject (context
, FONT_HANDLE (font
));
326 result
= ScriptPlace (context
, &(uniscribe_font
->cache
),
327 glyphs
, nglyphs
, attributes
, &(items
[i
].a
),
328 advances
, offsets
, &overall_metrics
);
330 if (SUCCEEDED (result
))
332 int j
, from
, to
, adj_offset
= 0;
337 for (j
= 0; j
< nglyphs
; j
++)
339 int lglyph_index
= j
+ done_glyphs
;
340 Lisp_Object lglyph
= LGSTRING_GLYPH (lgstring
, lglyph_index
);
346 lglyph
= LGLYPH_NEW ();
347 LGSTRING_SET_GLYPH (lgstring
, lglyph_index
, lglyph
);
349 /* Copy to a 32-bit data type to shut up the
350 compiler warning in LGLYPH_SET_CODE about
351 comparison being always false. */
353 LGLYPH_SET_CODE (lglyph
, gl
);
355 /* Detect clusters, for linking codes back to
357 if (attributes
[j
].fClusterStart
)
359 while (from
< nchars_in_run
&& clusters
[from
] < j
)
361 if (from
>= nchars_in_run
)
362 from
= to
= nchars_in_run
- 1;
366 to
= nchars_in_run
- 1;
367 for (k
= from
+ 1; k
< nchars_in_run
; k
++)
377 /* For RTL text, the Uniscribe shaper prepares
378 the values in ADVANCES array for layout in
379 reverse order, whereby "advance width" is
380 applied to move the pen in reverse direction
381 and _before_ drawing the glyph. Since we
382 draw glyphs in their normal left-to-right
383 order, we need to adjust the coordinates of
384 each non-base glyph in a grapheme cluster via
385 X-OFF component of the gstring's ADJUSTMENT
386 sub-vector. This loop computes, for each
387 grapheme cluster, the initial value of the
388 adjustment for the base character, which is
389 then updated for each successive glyph in the
396 while (j1
< nglyphs
&& !attributes
[j1
].fClusterStart
)
398 adj_offset
+= advances
[j1
];
404 LGLYPH_SET_CHAR (lglyph
, chars
[items
[i
].iCharPos
406 LGLYPH_SET_FROM (lglyph
, items
[i
].iCharPos
+ from
);
407 LGLYPH_SET_TO (lglyph
, items
[i
].iCharPos
+ to
);
410 LGLYPH_SET_WIDTH (lglyph
, advances
[j
]);
411 LGLYPH_SET_ASCENT (lglyph
, font
->ascent
);
412 LGLYPH_SET_DESCENT (lglyph
, font
->descent
);
414 result
= ScriptGetGlyphABCWidth (context
,
415 &(uniscribe_font
->cache
),
416 glyphs
[j
], &char_metric
);
417 if (result
== E_PENDING
&& !context
)
419 /* Cache incomplete... */
420 f
= XFRAME (selected_frame
);
421 context
= get_frame_dc (f
);
422 old_font
= SelectObject (context
, FONT_HANDLE (font
));
423 result
= ScriptGetGlyphABCWidth (context
,
424 &(uniscribe_font
->cache
),
425 glyphs
[j
], &char_metric
);
428 if (SUCCEEDED (result
))
430 int lbearing
= char_metric
.abcA
;
431 int rbearing
= char_metric
.abcA
+ char_metric
.abcB
;
433 LGLYPH_SET_LBEARING (lglyph
, lbearing
);
434 LGLYPH_SET_RBEARING (lglyph
, rbearing
);
438 LGLYPH_SET_LBEARING (lglyph
, 0);
439 LGLYPH_SET_RBEARING (lglyph
, advances
[j
]);
442 if (offsets
[j
].du
|| offsets
[j
].dv
443 /* For non-base glyphs of RTL grapheme clusters,
444 adjust the X offset even if both DU and DV
446 || (!attributes
[j
].fClusterStart
&& items
[i
].a
.fRTL
))
448 Lisp_Object vec
= make_uninit_vector (3);
452 /* Empirically, it looks like Uniscribe
453 interprets DU in reverse direction for
454 RTL clusters. E.g., if we don't reverse
455 the direction, the Hebrew point HOLAM is
456 drawn above the right edge of the base
457 consonant, instead of above the left edge. */
458 ASET (vec
, 0, make_number (-offsets
[j
].du
460 /* Update the adjustment value for the width
461 advance of the glyph we just emitted. */
462 adj_offset
-= 2 * advances
[j
];
465 ASET (vec
, 0, make_number (offsets
[j
].du
+ adj_offset
));
466 /* In the font definition coordinate system, the
467 Y coordinate points up, while in our screen
468 coordinates Y grows downwards. So we need to
469 reverse the sign of Y-OFFSET here. */
470 ASET (vec
, 1, make_number (-offsets
[j
].dv
));
471 /* Based on what ftfont.c does... */
472 ASET (vec
, 2, make_number (advances
[j
]));
473 LGLYPH_SET_ADJUSTMENT (lglyph
, vec
);
477 LGLYPH_SET_ADJUSTMENT (lglyph
, Qnil
);
478 /* Update the adjustment value to compensate for
479 the width of the base character. */
481 adj_offset
-= advances
[j
];
486 done_glyphs
+= nglyphs
;
493 SelectObject (context
, old_font
);
494 release_frame_dc (f
, context
);
500 return make_number (done_glyphs
);
503 /* Uniscribe implementation of encode_char for font backend.
504 Return a glyph code of FONT for character C (Unicode code point).
505 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
507 uniscribe_encode_char (struct font
*font
, int c
)
510 struct frame
*f
= NULL
;
511 HFONT old_font
= NULL
;
512 unsigned code
= FONT_INVALID_CODE
;
517 struct uniscribe_font_info
*uniscribe_font
518 = (struct uniscribe_font_info
*)font
;
527 DWORD surrogate
= c
- 0x10000;
529 /* High surrogate: U+D800 - U+DBFF. */
530 ch
[0] = 0xD800 + ((surrogate
>> 10) & 0x03FF);
531 /* Low surrogate: U+DC00 - U+DFFF. */
532 ch
[1] = 0xDC00 + (surrogate
& 0x03FF);
536 /* Non BMP characters must be handled by the uniscribe shaping
537 engine as GDI functions (except blindly displaying lines of
538 Unicode text) and the promising looking ScriptGetCMap do not
539 convert surrogate pairs to glyph indexes correctly. */
541 items
= (SCRIPT_ITEM
*) alloca (sizeof (SCRIPT_ITEM
) * 2 + 1);
542 if (SUCCEEDED (ScriptItemize (ch
, len
, 2, NULL
, NULL
, items
, &nitems
)))
545 /* Surrogates seem to need 2 here, even though only one glyph is
546 returned. Indic characters can also produce 2 or more glyphs for
547 a single code point, but they need to use uniscribe_shape
548 above for correct display. */
549 WORD glyphs
[2], clusters
[2];
550 SCRIPT_VISATTR attrs
[2];
553 /* Force ScriptShape to generate glyphs in the logical
555 items
[0].a
.fLogicalOrder
= 1;
557 result
= ScriptShape (context
, &(uniscribe_font
->cache
),
558 ch
, len
, 2, &(items
[0].a
),
559 glyphs
, clusters
, attrs
, &nglyphs
);
561 if (result
== E_PENDING
)
563 /* Use selected frame until API is updated to pass
565 f
= XFRAME (selected_frame
);
566 context
= get_frame_dc (f
);
567 old_font
= SelectObject (context
, FONT_HANDLE (font
));
568 result
= ScriptShape (context
, &(uniscribe_font
->cache
),
569 ch
, len
, 2, &(items
[0].a
),
570 glyphs
, clusters
, attrs
, &nglyphs
);
573 if (SUCCEEDED (result
) && nglyphs
== 1)
575 /* Some fonts return .notdef glyphs instead of failing.
576 (TrueType spec reserves glyph code 0 for .notdef) */
580 else if (SUCCEEDED (result
) || result
== E_OUTOFMEMORY
)
582 /* This character produces zero or more than one glyph
583 when shaped. But we still need the return from here
584 to be valid for the shaping engine to be invoked
586 result
= ScriptGetCMap (context
, &(uniscribe_font
->cache
),
588 if (SUCCEEDED (result
) && glyphs
[0])
595 SelectObject (context
, old_font
);
596 release_frame_dc (f
, context
);
604 Lisp_Object uniscribe_get_cache (Lisp_Object frame);
605 void uniscribe_free_entity (Lisp_Object font_entity);
606 int uniscribe_has_char (Lisp_Object entity, int c);
607 void uniscribe_text_extents (struct font *font, unsigned *code,
608 int nglyphs, struct font_metrics *metrics);
609 int uniscribe_draw (struct glyph_string *s, int from, int to,
610 int x, int y, int with_background);
613 int uniscribe_prepare_face (struct frame *f, struct face *face);
614 void uniscribe_done_face (struct frame *f, struct face *face);
615 int uniscribe_get_bitmap (struct font *font, unsigned code,
616 struct font_bitmap *bitmap, int bits_per_pixel);
617 void uniscribe_free_bitmap (struct font *font, struct font_bitmap *bitmap);
618 int uniscribe_anchor_point (struct font *font, unsigned code,
619 int index, int *x, int *y);
620 int uniscribe_start_for_frame (struct frame *f);
621 int uniscribe_end_for_frame (struct frame *f);
626 /* Callback function for EnumFontFamiliesEx.
627 Adds the name of opentype fonts to a Lisp list (passed in as the
629 static int CALLBACK ALIGN_STACK
630 add_opentype_font_name_to_list (ENUMLOGFONTEX
*logical_font
,
631 NEWTEXTMETRICEX
*physical_font
,
632 DWORD font_type
, LPARAM list_object
)
634 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
637 /* Skip vertical fonts (intended only for printing) */
638 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
641 /* Skip non opentype fonts. Count old truetype fonts as opentype,
642 as some of them do contain GPOS and GSUB data that Uniscribe
644 if (!(physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
645 && font_type
!= TRUETYPE_FONTTYPE
)
648 /* Skip fonts that have no Unicode coverage. */
649 if (!physical_font
->ntmFontSig
.fsUsb
[3]
650 && !physical_font
->ntmFontSig
.fsUsb
[2]
651 && !physical_font
->ntmFontSig
.fsUsb
[1]
652 && !(physical_font
->ntmFontSig
.fsUsb
[0] & 0x3fffffff))
655 family
= intern_font_name (logical_font
->elfLogFont
.lfFaceName
);
656 if (! memq_no_quit (family
, *list
))
657 *list
= Fcons (family
, *list
);
663 /* :otf property handling.
664 Since the necessary Uniscribe APIs for getting font tag information
665 are only available in Vista, we may need to parse the font data directly
666 according to the OpenType Specification. */
668 /* Push into DWORD backwards to cope with endianness. */
669 #define OTF_TAG(STR) \
670 ((STR[3] << 24) | (STR[2] << 16) | (STR[1] << 8) | STR[0])
672 #define OTF_INT16_VAL(TABLE, OFFSET, PTR) \
674 BYTE temp, data[2]; \
675 if (GetFontData (context, TABLE, OFFSET, data, 2) != 2) \
676 goto font_table_error; \
677 temp = data[0], data[0] = data[1], data[1] = temp; \
678 memcpy (PTR, data, 2); \
681 /* Do not reverse the bytes, because we will compare with a OTF_TAG value
682 that has them reversed already. */
683 #define OTF_DWORDTAG_VAL(TABLE, OFFSET, PTR) \
685 if (GetFontData (context, TABLE, OFFSET, PTR, 4) != 4) \
686 goto font_table_error; \
689 #define OTF_TAG_VAL(TABLE, OFFSET, STR) \
691 if (GetFontData (context, TABLE, OFFSET, STR, 4) != 4) \
692 goto font_table_error; \
696 #define SNAME(VAL) SSDATA (SYMBOL_NAME (VAL))
698 /* Uniscribe APIs available only since Windows Vista. */
699 typedef HRESULT (WINAPI
*ScriptGetFontScriptTags_Proc
)
700 (HDC
, SCRIPT_CACHE
*, SCRIPT_ANALYSIS
*, int, OPENTYPE_TAG
*, int *);
702 typedef HRESULT (WINAPI
*ScriptGetFontLanguageTags_Proc
)
703 (HDC
, SCRIPT_CACHE
*, SCRIPT_ANALYSIS
*, OPENTYPE_TAG
, int, OPENTYPE_TAG
*, int *);
705 typedef HRESULT (WINAPI
*ScriptGetFontFeatureTags_Proc
)
706 (HDC
, SCRIPT_CACHE
*, SCRIPT_ANALYSIS
*, OPENTYPE_TAG
, OPENTYPE_TAG
, int, OPENTYPE_TAG
*, int *);
708 ScriptGetFontScriptTags_Proc script_get_font_scripts_fn
;
709 ScriptGetFontLanguageTags_Proc script_get_font_languages_fn
;
710 ScriptGetFontFeatureTags_Proc script_get_font_features_fn
;
712 static bool uniscribe_new_apis
;
714 /* Verify that all the required features in FEATURES, each of whose
715 elements is a list or nil, can be found among the N feature tags in
716 FTAGS. Return 'true' if the required features are supported,
717 'false' if not. Each list in FEATURES can include an element of
718 nil, which means all the elements after it must not be in FTAGS. */
720 uniscribe_check_features (Lisp_Object features
[2], OPENTYPE_TAG
*ftags
, int n
)
724 for (j
= 0; j
< 2; j
++)
726 bool negative
= false;
729 for (rest
= features
[j
]; CONSP (rest
); rest
= XCDR (rest
))
731 Lisp_Object feature
= XCAR (rest
);
733 /* The font must NOT have any of the features after nil.
734 See the doc string of 'font-spec', under ':otf'. */
739 OPENTYPE_TAG feature_tag
= OTF_TAG (SNAME (feature
));
742 for (i
= 0; i
< n
; i
++)
744 if (ftags
[i
] == feature_tag
)
746 /* Test fails if we find a feature that the font
754 /* Test fails if we do NOT find a feature that the font
756 if (i
>= n
&& !negative
)
765 /* Check if font supports the required OTF script/language/features
766 using the Unsicribe APIs available since Windows Vista. We prefer
767 these APIs as a kind of future-proofing Emacs: they seem to
768 retrieve script tags that the old code (and also libotf) doesn't
769 seem to be able to get, e.g., some fonts that claim support for
770 "dev2" script don't show "deva", but the new APIs do report it. */
772 uniscribe_check_otf_1 (HDC context
, Lisp_Object script
, Lisp_Object lang
,
773 Lisp_Object features
[2], int *retval
)
775 SCRIPT_CACHE cache
= NULL
;
776 OPENTYPE_TAG tags
[32], script_tag
, lang_tag
;
777 int max_tags
= ARRAYELTS (tags
);
778 int ntags
, i
, ret
= 0;
784 rslt
= script_get_font_scripts_fn (context
, &cache
, NULL
, max_tags
,
788 DebPrint (("ScriptGetFontScriptTags failed with 0x%x\n", rslt
));
793 script_tag
= OTF_TAG ("DFLT");
795 script_tag
= OTF_TAG (SNAME (script
));
796 for (i
= 0; i
< ntags
; i
++)
797 if (tags
[i
] == script_tag
)
804 lang_tag
= OTF_TAG ("dflt");
807 rslt
= script_get_font_languages_fn (context
, &cache
, NULL
, script_tag
,
808 max_tags
, tags
, &ntags
);
811 DebPrint (("ScriptGetFontLanguageTags failed with 0x%x\n", rslt
));
816 lang_tag
= OTF_TAG ("dflt");
819 lang_tag
= OTF_TAG (SNAME (lang
));
820 for (i
= 0; i
< ntags
; i
++)
821 if (tags
[i
] == lang_tag
)
829 if (!NILP (features
[0]))
831 /* Are the 2 feature lists valid? */
832 if (!CONSP (features
[0])
833 || (!NILP (features
[1]) && !CONSP (features
[1])))
835 rslt
= script_get_font_features_fn (context
, &cache
, NULL
,
836 script_tag
, lang_tag
,
837 max_tags
, tags
, &ntags
);
840 DebPrint (("ScriptGetFontFeatureTags failed with 0x%x\n", rslt
));
845 /* ScriptGetFontFeatureTags doesn't let us query features
846 separately for GSUB and GPOS, so we check them all together.
847 It doesn't really matter, since the features in GSUB and GPOS
848 are disjoint, i.e. no feature can appear in both tables. */
849 if (!uniscribe_check_features (features
, tags
, ntags
))
858 ScriptFreeCache (&cache
);
862 /* Check if font supports the otf script/language/features specified.
863 OTF_SPEC is in the format
864 (script lang [(gsub_feature ...)|nil] [(gpos_feature ...)]?) */
866 uniscribe_check_otf (LOGFONT
*font
, Lisp_Object otf_spec
)
868 Lisp_Object script
, lang
, rest
;
869 Lisp_Object features
[2];
870 DWORD feature_tables
[2];
871 DWORD script_tag
, default_script
, lang_tag
= 0;
874 HFONT check_font
, old_font
;
878 /* Check the spec is in the right format. */
879 if (!CONSP (otf_spec
) || XINT (Flength (otf_spec
)) < 3)
882 /* Break otf_spec into its components. */
883 script
= XCAR (otf_spec
);
884 rest
= XCDR (otf_spec
);
889 features
[0] = XCAR (rest
);
894 features
[1] = XCAR (rest
);
896 /* Set up graphics context so we can use the font. */
897 f
= XFRAME (selected_frame
);
898 context
= get_frame_dc (f
);
899 check_font
= CreateFontIndirect (font
);
900 old_font
= SelectObject (context
, check_font
);
902 /* If we are on Vista or later, use the new APIs. */
903 if (uniscribe_new_apis
904 && !w32_disable_new_uniscribe_apis
905 && uniscribe_check_otf_1 (context
, script
, lang
, features
, &retval
) != -1)
908 /* Set up tags we will use in the search. */
909 feature_tables
[0] = OTF_TAG ("GSUB");
910 feature_tables
[1] = OTF_TAG ("GPOS");
911 default_script
= OTF_TAG ("DFLT");
913 script_tag
= default_script
;
915 script_tag
= OTF_TAG (SNAME (script
));
917 lang_tag
= OTF_TAG (SNAME (lang
));
919 /* Everything else is contained within otf_spec so should get
920 marked along with it. */
923 /* Scan GSUB and GPOS tables. */
924 for (i
= 0; i
< 2; i
++)
926 int j
, n_match_features
;
927 unsigned short scriptlist_table
, feature_table
, n_scripts
;
928 unsigned short script_table
, langsys_table
, n_langs
;
929 unsigned short feature_index
, n_features
;
930 DWORD tbl
= feature_tables
[i
];
931 DWORD feature_id
, *ftags
;
932 Lisp_Object farray
[2];
934 /* Skip if no features requested from this table. */
935 if (NILP (features
[i
]))
938 /* If features is not a cons, this font spec is messed up. */
939 if (!CONSP (features
[i
]))
942 /* Read GPOS/GSUB header. */
943 OTF_INT16_VAL (tbl
, 4, &scriptlist_table
);
944 OTF_INT16_VAL (tbl
, 6, &feature_table
);
945 OTF_INT16_VAL (tbl
, scriptlist_table
, &n_scripts
);
947 /* Find the appropriate script table. */
949 for (j
= 0; j
< n_scripts
; j
++)
952 OTF_DWORDTAG_VAL (tbl
, scriptlist_table
+ 2 + j
* 6, &script_id
);
953 if (script_id
== script_tag
)
955 OTF_INT16_VAL (tbl
, scriptlist_table
+ 6 + j
* 6, &script_table
);
958 #if 0 /* Causes false positives. */
959 /* If there is a DFLT script defined in the font, use it
960 if the specified script is not found. */
961 else if (script_id
== default_script
)
962 OTF_INT16_VAL (tbl
, scriptlist_table
+ 6 + j
* 6, &script_table
);
965 /* If no specific or default script table was found, then this font
966 does not support the script. */
970 /* Offset is from beginning of scriptlist_table. */
971 script_table
+= scriptlist_table
;
973 /* Get default langsys table. */
974 OTF_INT16_VAL (tbl
, script_table
, &langsys_table
);
976 /* If lang was specified, see if font contains a specific entry. */
979 OTF_INT16_VAL (tbl
, script_table
+ 2, &n_langs
);
981 for (j
= 0; j
< n_langs
; j
++)
984 OTF_DWORDTAG_VAL (tbl
, script_table
+ 4 + j
* 6, &lang_id
);
985 if (lang_id
== lang_tag
)
987 OTF_INT16_VAL (tbl
, script_table
+ 8 + j
* 6, &langsys_table
);
996 /* Offset is from beginning of script table. */
997 langsys_table
+= script_table
;
999 /* If there are no features to check, skip checking. */
1000 if (NILP (features
[i
]))
1002 if (!CONSP (features
[i
]))
1005 n_match_features
= 0;
1007 /* First get required feature (if any). */
1008 OTF_INT16_VAL (tbl
, langsys_table
+ 2, &feature_index
);
1009 if (feature_index
!= 0xFFFF)
1010 n_match_features
= 1;
1011 OTF_INT16_VAL (tbl
, langsys_table
+ 4, &n_features
);
1012 n_match_features
+= n_features
;
1014 SAFE_NALLOCA (ftags
, 1, n_match_features
);
1016 if (feature_index
!= 0xFFFF)
1018 OTF_DWORDTAG_VAL (tbl
, feature_table
+ 2 + feature_index
* 6,
1020 ftags
[k
++] = feature_id
;
1022 /* Now get all the other features. */
1023 for (j
= 0; j
< n_features
; j
++)
1025 OTF_INT16_VAL (tbl
, langsys_table
+ 6 + j
* 2, &feature_index
);
1026 OTF_DWORDTAG_VAL (tbl
, feature_table
+ 2 + feature_index
* 6,
1028 ftags
[k
++] = feature_id
;
1031 /* Check the features for this table. */
1032 farray
[0] = features
[i
];
1034 if (!uniscribe_check_features (farray
, ftags
, n_match_features
))
1044 /* restore graphics context. */
1045 SelectObject (context
, old_font
);
1046 DeleteObject (check_font
);
1047 release_frame_dc (f
, context
);
1053 otf_features (HDC context
, char *table
)
1055 Lisp_Object script_list
= Qnil
;
1056 unsigned short scriptlist_table
, n_scripts
, feature_table
;
1057 DWORD tbl
= OTF_TAG (table
);
1060 /* Look for scripts in the table. */
1061 OTF_INT16_VAL (tbl
, 4, &scriptlist_table
);
1062 OTF_INT16_VAL (tbl
, 6, &feature_table
);
1063 OTF_INT16_VAL (tbl
, scriptlist_table
, &n_scripts
);
1065 for (i
= n_scripts
- 1; i
>= 0; i
--)
1067 char script
[5], lang
[5];
1068 unsigned short script_table
, lang_count
, langsys_table
, feature_count
;
1069 Lisp_Object script_tag
, langsys_list
, langsys_tag
, feature_list
;
1070 unsigned short record_offset
= scriptlist_table
+ 2 + i
* 6;
1071 OTF_TAG_VAL (tbl
, record_offset
, script
);
1072 OTF_INT16_VAL (tbl
, record_offset
+ 4, &script_table
);
1074 /* Offset is from beginning of script table. */
1075 script_table
+= scriptlist_table
;
1077 script_tag
= intern (script
);
1078 langsys_list
= Qnil
;
1080 /* Optional default lang. */
1081 OTF_INT16_VAL (tbl
, script_table
, &langsys_table
);
1084 /* Offset is from beginning of script table. */
1085 langsys_table
+= script_table
;
1088 feature_list
= Qnil
;
1089 OTF_INT16_VAL (tbl
, langsys_table
+ 4, &feature_count
);
1090 for (k
= feature_count
- 1; k
>= 0; k
--)
1093 unsigned short index
;
1094 OTF_INT16_VAL (tbl
, langsys_table
+ 6 + k
* 2, &index
);
1095 OTF_TAG_VAL (tbl
, feature_table
+ 2 + index
* 6, feature
);
1096 feature_list
= Fcons (intern (feature
), feature_list
);
1098 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1102 /* List of supported languages. */
1103 OTF_INT16_VAL (tbl
, script_table
+ 2, &lang_count
);
1105 for (j
= lang_count
- 1; j
>= 0; j
--)
1107 record_offset
= script_table
+ 4 + j
* 6;
1108 OTF_TAG_VAL (tbl
, record_offset
, lang
);
1109 OTF_INT16_VAL (tbl
, record_offset
+ 4, &langsys_table
);
1111 /* Offset is from beginning of script table. */
1112 langsys_table
+= script_table
;
1114 langsys_tag
= intern (lang
);
1115 feature_list
= Qnil
;
1116 OTF_INT16_VAL (tbl
, langsys_table
+ 4, &feature_count
);
1117 for (k
= feature_count
- 1; k
>= 0; k
--)
1120 unsigned short index
;
1121 OTF_INT16_VAL (tbl
, langsys_table
+ 6 + k
* 2, &index
);
1122 OTF_TAG_VAL (tbl
, feature_table
+ 2 + index
* 6, feature
);
1123 feature_list
= Fcons (intern (feature
), feature_list
);
1125 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1130 script_list
= Fcons (Fcons (script_tag
, langsys_list
), script_list
);
1139 #undef OTF_INT16_VAL
1144 struct font_driver uniscribe_font_driver
=
1146 LISP_INITIALLY_ZERO
, /* Quniscribe */
1147 0, /* case insensitive */
1151 uniscribe_list_family
,
1152 NULL
, /* free_entity */
1155 NULL
, /* prepare_face */
1156 NULL
, /* done_face */
1158 uniscribe_encode_char
,
1159 w32font_text_extents
,
1161 NULL
, /* get_bitmap */
1162 NULL
, /* free_bitmap */
1163 NULL
, /* anchor_point */
1164 uniscribe_otf_capability
, /* Defined so (font-get FONTOBJ :otf) works. */
1165 NULL
, /* otf_drive - use shape instead. */
1166 NULL
, /* start_for_frame */
1167 NULL
, /* end_for_frame */
1170 NULL
, /* get_variation_glyphs */
1171 NULL
, /* filter_properties */
1172 NULL
, /* cached_font_ok */
1175 /* Note that this should be called at every startup, not just when dumping,
1176 as it needs to test for the existence of the Uniscribe library. */
1178 syms_of_w32uniscribe (void)
1182 /* Don't init uniscribe when dumping */
1186 /* Don't register if uniscribe is not available. */
1187 uniscribe
= GetModuleHandle ("usp10");
1191 uniscribe_font_driver
.type
= Quniscribe
;
1192 uniscribe_available
= 1;
1194 register_font_driver (&uniscribe_font_driver
, NULL
);
1196 script_get_font_scripts_fn
= (ScriptGetFontScriptTags_Proc
)
1197 GetProcAddress (uniscribe
, "ScriptGetFontScriptTags");
1198 script_get_font_languages_fn
= (ScriptGetFontLanguageTags_Proc
)
1199 GetProcAddress (uniscribe
, "ScriptGetFontLanguageTags");
1200 script_get_font_features_fn
= (ScriptGetFontFeatureTags_Proc
)
1201 GetProcAddress (uniscribe
, "ScriptGetFontFeatureTags");
1202 if (script_get_font_scripts_fn
1203 && script_get_font_languages_fn
1204 && script_get_font_features_fn
)
1205 uniscribe_new_apis
= true;
1207 uniscribe_new_apis
= false;