1 /* Font backend for the Microsoft W32 Uniscribe API.
2 Copyright (C) 2008-2019 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 (at
9 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 <https://www.gnu.org/licenses/>. */
21 /* Override API version - Uniscribe is only available as standard
22 since Windows 2000, though most users of older systems will have it
23 since it installs with Internet Explorer 5.0 and other software.
24 Also, MinGW64 w32api headers by default define OPENTYPE_TAG typedef
25 only if _WIN32_WINNT >= 0x0600. We only use the affected APIs if
26 they are available, so there is no chance of calling non-existent
29 #define _WIN32_WINNT 0x0600
36 #include "composite.h"
40 struct uniscribe_font_info
42 struct w32font_info w32_font
;
46 int uniscribe_available
= 0;
48 /* EnumFontFamiliesEx callback. */
49 static int CALLBACK ALIGN_STACK
add_opentype_font_name_to_list (ENUMLOGFONTEX
*,
52 /* Used by uniscribe_otf_capability. */
53 static Lisp_Object
otf_features (HDC context
, const char *table
);
56 memq_no_quit (Lisp_Object elt
, Lisp_Object list
)
58 while (CONSP (list
) && ! EQ (XCAR (list
), elt
))
60 return (CONSP (list
));
64 /* Font backend interface implementation. */
66 uniscribe_list (struct frame
*f
, Lisp_Object font_spec
)
68 Lisp_Object fonts
= w32font_list_internal (f
, font_spec
, true);
69 FONT_ADD_LOG ("uniscribe-list", font_spec
, fonts
);
74 uniscribe_match (struct frame
*f
, Lisp_Object font_spec
)
76 Lisp_Object entity
= w32font_match_internal (f
, font_spec
, true);
77 FONT_ADD_LOG ("uniscribe-match", font_spec
, entity
);
82 uniscribe_list_family (struct frame
*f
)
84 Lisp_Object list
= Qnil
;
85 LOGFONT font_match_pattern
;
88 memset (&font_match_pattern
, 0, sizeof (font_match_pattern
));
89 /* Limit enumerated fonts to outline fonts to save time. */
90 font_match_pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
92 /* Prevent quitting while EnumFontFamiliesEx runs and conses the
93 list it will return. That's because get_frame_dc acquires the
94 critical section, so we cannot quit before we release it in
96 Lisp_Object prev_quit
= Vinhibit_quit
;
98 dc
= get_frame_dc (f
);
100 EnumFontFamiliesEx (dc
, &font_match_pattern
,
101 (FONTENUMPROC
) add_opentype_font_name_to_list
,
103 release_frame_dc (f
, dc
);
104 Vinhibit_quit
= prev_quit
;
110 uniscribe_open (struct frame
*f
, Lisp_Object font_entity
, int pixel_size
)
112 Lisp_Object font_object
113 = font_make_object (VECSIZE (struct uniscribe_font_info
),
114 font_entity
, pixel_size
);
115 struct uniscribe_font_info
*uniscribe_font
116 = (struct uniscribe_font_info
*) XFONT_OBJECT (font_object
);
118 ASET (font_object
, FONT_TYPE_INDEX
, Quniscribe
);
120 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
125 /* Initialize the cache for this font. */
126 uniscribe_font
->cache
= NULL
;
128 /* Uniscribe backend uses glyph indices. */
129 uniscribe_font
->w32_font
.glyph_idx
= ETO_GLYPH_INDEX
;
131 uniscribe_font
->w32_font
.font
.driver
= &uniscribe_font_driver
;
137 uniscribe_close (struct font
*font
)
139 struct uniscribe_font_info
*uniscribe_font
140 = (struct uniscribe_font_info
*) font
;
142 if (uniscribe_font
->cache
)
143 ScriptFreeCache (&(uniscribe_font
->cache
));
145 w32font_close (font
);
148 /* Return a list describing which scripts/languages FONT supports by
149 which GSUB/GPOS features of OpenType tables.
151 Implementation note: otf_features called by this function uses
152 GetFontData to access the font tables directly, instead of using
153 ScriptGetFontScriptTags etc. APIs even if those are available. The
154 reason is that font-get, which uses the result of this function,
155 expects a cons cell (GSUB . GPOS) where the features are reported
156 separately for these 2 OTF tables, while the Uniscribe APIs report
157 the features as a single list. There doesn't seem to be a reason
158 for returning the features in 2 separate parts, except for
159 compatibility with libotf; the features are disjoint (each can
160 appear only in one of the 2 slots), and no client of this data
161 discerns between the two slots: the few that request this data all
162 look in both slots. If use of the Uniscribe APIs ever becomes
163 necessary here, and the 2 separate slots are still required, it
164 should be possible to split the feature list the APIs return into 2
165 because each sub-list is alphabetically sorted, so the place where
166 the sorting order breaks is where the GSUB features end and GPOS
167 features begin. But for now, this is not necessary, so we leave
168 the original code in place. */
170 uniscribe_otf_capability (struct font
*font
)
175 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
176 Lisp_Object features
;
178 f
= XFRAME (selected_frame
);
179 /* Prevent quitting while we cons the lists in otf_features.
180 That's because get_frame_dc acquires the critical section, so we
181 cannot quit before we release it in release_frame_dc. */
182 Lisp_Object prev_quit
= Vinhibit_quit
;
184 context
= get_frame_dc (f
);
185 old_font
= SelectObject (context
, FONT_HANDLE (font
));
187 features
= otf_features (context
, "GSUB");
188 XSETCAR (capability
, features
);
189 features
= otf_features (context
, "GPOS");
190 XSETCDR (capability
, features
);
192 SelectObject (context
, old_font
);
193 release_frame_dc (f
, context
);
194 Vinhibit_quit
= prev_quit
;
199 /* Uniscribe implementation of shape for font backend.
201 Shape text in LGSTRING. See the docstring of
202 `composition-get-gstring' for the format of LGSTRING. If the
203 (N+1)th element of LGSTRING is nil, input of shaping is from the
204 1st to (N)th elements. In each input glyph, FROM, TO, CHAR, and
205 CODE are already set.
207 This function updates all fields of the input glyphs. If the
208 output glyphs (M) are more than the input glyphs (N), (N+1)th
209 through (M)th elements of LGSTRING are updated possibly by making
210 a new glyph object and storing it in LGSTRING. If (M) is greater
211 than the length of LGSTRING, nil should be returned. In that case,
212 this function is called again with a larger LGSTRING. */
214 uniscribe_shape (Lisp_Object lgstring
)
216 struct font
*font
= CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring
));
217 struct uniscribe_font_info
*uniscribe_font
218 = (struct uniscribe_font_info
*) font
;
220 int nitems
, max_items
, i
, max_glyphs
, done_glyphs
;
222 WORD
*glyphs
, *clusters
;
224 SCRIPT_VISATTR
*attributes
;
229 struct frame
* f
= NULL
;
231 HFONT old_font
= NULL
;
233 /* Get the chars from lgstring in a form we can use with uniscribe. */
234 max_glyphs
= nchars
= LGSTRING_GLYPH_LEN (lgstring
);
236 chars
= (wchar_t *) alloca (nchars
* sizeof (wchar_t));
237 /* FIXME: This loop assumes that characters in the input LGSTRING
238 are all inside the BMP. Need to encode characters beyond the BMP
240 for (i
= 0; i
< nchars
; i
++)
242 /* lgstring can be bigger than the number of characters in it, in
243 the case where more glyphs are required to display those characters.
244 If that is the case, note the real number of characters. */
245 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
248 chars
[i
] = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring
, i
));
251 /* First we need to break up the glyph string into runs of glyphs that
252 can be treated together. First try a single run. */
254 items
= xmalloc (sizeof (SCRIPT_ITEM
) * max_items
+ 1);
256 while ((result
= ScriptItemize (chars
, nchars
, max_items
, NULL
, NULL
,
257 items
, &nitems
)) == E_OUTOFMEMORY
)
259 /* If that wasn't enough, keep trying with one more run. */
261 items
= (SCRIPT_ITEM
*) xrealloc (items
,
262 sizeof (SCRIPT_ITEM
) * max_items
+ 1);
271 glyphs
= alloca (max_glyphs
* sizeof (WORD
));
272 clusters
= alloca (nchars
* sizeof (WORD
));
273 attributes
= alloca (max_glyphs
* sizeof (SCRIPT_VISATTR
));
274 advances
= alloca (max_glyphs
* sizeof (int));
275 offsets
= alloca (max_glyphs
* sizeof (GOFFSET
));
277 for (i
= 0; i
< nitems
; i
++)
279 int nglyphs
, nchars_in_run
;
280 nchars_in_run
= items
[i
+1].iCharPos
- items
[i
].iCharPos
;
281 /* Force ScriptShape to generate glyphs in the same order as
282 they are in the input LGSTRING, which is in the logical
284 items
[i
].a
.fLogicalOrder
= 1;
286 /* Context may be NULL here, in which case the cache should be
287 used without needing to select the font. */
288 result
= ScriptShape (context
, &(uniscribe_font
->cache
),
289 chars
+ items
[i
].iCharPos
, nchars_in_run
,
290 max_glyphs
- done_glyphs
, &(items
[i
].a
),
291 glyphs
, clusters
, attributes
, &nglyphs
);
293 if (result
== E_PENDING
&& !context
)
295 /* This assumes the selected frame is on the same display as the
296 one we are drawing. It would be better for the frame to be
298 f
= XFRAME (selected_frame
);
299 context
= get_frame_dc (f
);
300 old_font
= SelectObject (context
, FONT_HANDLE (font
));
302 result
= ScriptShape (context
, &(uniscribe_font
->cache
),
303 chars
+ items
[i
].iCharPos
, nchars_in_run
,
304 max_glyphs
- done_glyphs
, &(items
[i
].a
),
305 glyphs
, clusters
, attributes
, &nglyphs
);
308 if (result
== E_OUTOFMEMORY
)
310 /* Need a bigger lgstring. */
314 else if (FAILED (result
))
316 /* Can't shape this run - return results so far if any. */
319 else if (items
[i
].a
.fNoGlyphIndex
)
321 /* Glyph indices not supported by this font (or OS), means we
322 can't really do any meaningful shaping. */
327 result
= ScriptPlace (context
, &(uniscribe_font
->cache
),
328 glyphs
, nglyphs
, attributes
, &(items
[i
].a
),
329 advances
, offsets
, &overall_metrics
);
330 if (result
== E_PENDING
&& !context
)
332 /* Cache not complete... */
333 f
= XFRAME (selected_frame
);
334 context
= get_frame_dc (f
);
335 old_font
= SelectObject (context
, FONT_HANDLE (font
));
337 result
= ScriptPlace (context
, &(uniscribe_font
->cache
),
338 glyphs
, nglyphs
, attributes
, &(items
[i
].a
),
339 advances
, offsets
, &overall_metrics
);
341 if (SUCCEEDED (result
))
343 int j
, from
, to
, adj_offset
= 0;
348 for (j
= 0; j
< nglyphs
; j
++)
350 int lglyph_index
= j
+ done_glyphs
;
351 Lisp_Object lglyph
= LGSTRING_GLYPH (lgstring
, lglyph_index
);
357 lglyph
= LGLYPH_NEW ();
358 LGSTRING_SET_GLYPH (lgstring
, lglyph_index
, lglyph
);
360 /* Copy to a 32-bit data type to shut up the
361 compiler warning in LGLYPH_SET_CODE about
362 comparison being always false. */
364 LGLYPH_SET_CODE (lglyph
, gl
);
366 /* Detect clusters, for linking codes back to
368 if (attributes
[j
].fClusterStart
)
370 while (from
< nchars_in_run
&& clusters
[from
] < j
)
372 if (from
>= nchars_in_run
)
373 from
= to
= nchars_in_run
- 1;
377 to
= nchars_in_run
- 1;
378 for (k
= from
+ 1; k
< nchars_in_run
; k
++)
388 /* For RTL text, the Uniscribe shaper prepares
389 the values in ADVANCES array for layout in
390 reverse order, whereby "advance width" is
391 applied to move the pen in reverse direction
392 and _before_ drawing the glyph. Since we
393 draw glyphs in their normal left-to-right
394 order, we need to adjust the coordinates of
395 each non-base glyph in a grapheme cluster via
396 X-OFF component of the gstring's ADJUSTMENT
397 sub-vector. This loop computes, for each
398 grapheme cluster, the initial value of the
399 adjustment for the base character, which is
400 then updated for each successive glyph in the
407 while (j1
< nglyphs
&& !attributes
[j1
].fClusterStart
)
409 adj_offset
+= advances
[j1
];
415 LGLYPH_SET_CHAR (lglyph
, chars
[items
[i
].iCharPos
417 LGLYPH_SET_FROM (lglyph
, items
[i
].iCharPos
+ from
);
418 LGLYPH_SET_TO (lglyph
, items
[i
].iCharPos
+ to
);
421 LGLYPH_SET_WIDTH (lglyph
, advances
[j
]);
422 LGLYPH_SET_ASCENT (lglyph
, font
->ascent
);
423 LGLYPH_SET_DESCENT (lglyph
, font
->descent
);
425 result
= ScriptGetGlyphABCWidth (context
,
426 &(uniscribe_font
->cache
),
427 glyphs
[j
], &char_metric
);
428 if (result
== E_PENDING
&& !context
)
430 /* Cache incomplete... */
431 f
= XFRAME (selected_frame
);
432 context
= get_frame_dc (f
);
433 old_font
= SelectObject (context
, FONT_HANDLE (font
));
434 result
= ScriptGetGlyphABCWidth (context
,
435 &(uniscribe_font
->cache
),
436 glyphs
[j
], &char_metric
);
439 if (SUCCEEDED (result
))
441 int lbearing
= char_metric
.abcA
;
442 int rbearing
= char_metric
.abcA
+ char_metric
.abcB
;
444 LGLYPH_SET_LBEARING (lglyph
, lbearing
);
445 LGLYPH_SET_RBEARING (lglyph
, rbearing
);
449 LGLYPH_SET_LBEARING (lglyph
, 0);
450 LGLYPH_SET_RBEARING (lglyph
, advances
[j
]);
453 if (offsets
[j
].du
|| offsets
[j
].dv
454 /* For non-base glyphs of RTL grapheme clusters,
455 adjust the X offset even if both DU and DV
457 || (!attributes
[j
].fClusterStart
&& items
[i
].a
.fRTL
))
459 Lisp_Object vec
= make_uninit_vector (3);
463 /* Empirically, it looks like Uniscribe
464 interprets DU in reverse direction for
465 RTL clusters. E.g., if we don't reverse
466 the direction, the Hebrew point HOLAM is
467 drawn above the right edge of the base
468 consonant, instead of above the left edge. */
469 ASET (vec
, 0, make_number (-offsets
[j
].du
471 /* Update the adjustment value for the width
472 advance of the glyph we just emitted. */
473 adj_offset
-= 2 * advances
[j
];
476 ASET (vec
, 0, make_number (offsets
[j
].du
+ adj_offset
));
477 /* In the font definition coordinate system, the
478 Y coordinate points up, while in our screen
479 coordinates Y grows downwards. So we need to
480 reverse the sign of Y-OFFSET here. */
481 ASET (vec
, 1, make_number (-offsets
[j
].dv
));
482 /* Based on what ftfont.c does... */
483 ASET (vec
, 2, make_number (advances
[j
]));
484 LGLYPH_SET_ADJUSTMENT (lglyph
, vec
);
488 LGLYPH_SET_ADJUSTMENT (lglyph
, Qnil
);
489 /* Update the adjustment value to compensate for
490 the width of the base character. */
492 adj_offset
-= advances
[j
];
497 done_glyphs
+= nglyphs
;
504 SelectObject (context
, old_font
);
505 release_frame_dc (f
, context
);
511 return make_number (done_glyphs
);
514 /* Uniscribe implementation of encode_char for font backend.
515 Return a glyph code of FONT for character C (Unicode code point).
516 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
518 uniscribe_encode_char (struct font
*font
, int c
)
521 struct frame
*f
= NULL
;
522 HFONT old_font
= NULL
;
523 unsigned code
= FONT_INVALID_CODE
;
528 struct uniscribe_font_info
*uniscribe_font
529 = (struct uniscribe_font_info
*)font
;
538 DWORD surrogate
= c
- 0x10000;
540 /* High surrogate: U+D800 - U+DBFF. */
541 ch
[0] = 0xD800 + ((surrogate
>> 10) & 0x03FF);
542 /* Low surrogate: U+DC00 - U+DFFF. */
543 ch
[1] = 0xDC00 + (surrogate
& 0x03FF);
547 /* Non BMP characters must be handled by the uniscribe shaping
548 engine as GDI functions (except blindly displaying lines of
549 Unicode text) and the promising looking ScriptGetCMap do not
550 convert surrogate pairs to glyph indexes correctly. */
552 items
= (SCRIPT_ITEM
*) alloca (sizeof (SCRIPT_ITEM
) * 2 + 1);
553 if (SUCCEEDED (ScriptItemize (ch
, len
, 2, NULL
, NULL
, items
, &nitems
)))
556 /* Surrogates seem to need 2 here, even though only one glyph is
557 returned. Indic characters can also produce 2 or more glyphs for
558 a single code point, but they need to use uniscribe_shape
559 above for correct display. */
560 WORD glyphs
[2], clusters
[2];
561 SCRIPT_VISATTR attrs
[2];
564 /* Force ScriptShape to generate glyphs in the logical
566 items
[0].a
.fLogicalOrder
= 1;
568 result
= ScriptShape (context
, &(uniscribe_font
->cache
),
569 ch
, len
, 2, &(items
[0].a
),
570 glyphs
, clusters
, attrs
, &nglyphs
);
572 if (result
== E_PENDING
)
574 /* Use selected frame until API is updated to pass
576 f
= XFRAME (selected_frame
);
577 context
= get_frame_dc (f
);
578 old_font
= SelectObject (context
, FONT_HANDLE (font
));
579 result
= ScriptShape (context
, &(uniscribe_font
->cache
),
580 ch
, len
, 2, &(items
[0].a
),
581 glyphs
, clusters
, attrs
, &nglyphs
);
584 if (SUCCEEDED (result
) && nglyphs
== 1)
586 /* Some fonts return .notdef glyphs instead of failing.
587 (TrueType spec reserves glyph code 0 for .notdef) */
591 else if (SUCCEEDED (result
) || result
== E_OUTOFMEMORY
)
593 /* This character produces zero or more than one glyph
594 when shaped. But we still need the return from here
595 to be valid for the shaping engine to be invoked
597 result
= ScriptGetCMap (context
, &(uniscribe_font
->cache
),
599 if (SUCCEEDED (result
) && glyphs
[0])
606 SelectObject (context
, old_font
);
607 release_frame_dc (f
, context
);
615 Lisp_Object uniscribe_get_cache (Lisp_Object frame);
616 void uniscribe_free_entity (Lisp_Object font_entity);
617 int uniscribe_has_char (Lisp_Object entity, int c);
618 void uniscribe_text_extents (struct font *font, unsigned *code,
619 int nglyphs, struct font_metrics *metrics);
620 int uniscribe_draw (struct glyph_string *s, int from, int to,
621 int x, int y, int with_background);
624 int uniscribe_prepare_face (struct frame *f, struct face *face);
625 void uniscribe_done_face (struct frame *f, struct face *face);
626 int uniscribe_get_bitmap (struct font *font, unsigned code,
627 struct font_bitmap *bitmap, int bits_per_pixel);
628 void uniscribe_free_bitmap (struct font *font, struct font_bitmap *bitmap);
629 int uniscribe_anchor_point (struct font *font, unsigned code,
630 int index, int *x, int *y);
631 int uniscribe_start_for_frame (struct frame *f);
632 int uniscribe_end_for_frame (struct frame *f);
637 /* Callback function for EnumFontFamiliesEx.
638 Adds the name of opentype fonts to a Lisp list (passed in as the
640 static int CALLBACK ALIGN_STACK
641 add_opentype_font_name_to_list (ENUMLOGFONTEX
*logical_font
,
642 NEWTEXTMETRICEX
*physical_font
,
643 DWORD font_type
, LPARAM list_object
)
645 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
648 /* Skip vertical fonts (intended only for printing) */
649 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
652 /* Skip non opentype fonts. Count old truetype fonts as opentype,
653 as some of them do contain GPOS and GSUB data that Uniscribe
655 if (!(physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
656 && font_type
!= TRUETYPE_FONTTYPE
)
659 /* Skip fonts that have no Unicode coverage. */
660 if (!physical_font
->ntmFontSig
.fsUsb
[3]
661 && !physical_font
->ntmFontSig
.fsUsb
[2]
662 && !physical_font
->ntmFontSig
.fsUsb
[1]
663 && !(physical_font
->ntmFontSig
.fsUsb
[0] & 0x3fffffff))
666 family
= intern_font_name (logical_font
->elfLogFont
.lfFaceName
);
667 if (! memq_no_quit (family
, *list
))
668 *list
= Fcons (family
, *list
);
674 /* :otf property handling.
675 Since the necessary Uniscribe APIs for getting font tag information
676 are only available in Vista, we may need to parse the font data directly
677 according to the OpenType Specification. */
679 /* Push into DWORD backwards to cope with endianness. */
680 #define OTF_TAG(STR) \
681 ((STR[3] << 24) | (STR[2] << 16) | (STR[1] << 8) | STR[0])
683 #define OTF_INT16_VAL(TABLE, OFFSET, PTR) \
685 BYTE temp, data[2]; \
686 if (GetFontData (context, TABLE, OFFSET, data, 2) != 2) \
687 goto font_table_error; \
688 temp = data[0], data[0] = data[1], data[1] = temp; \
689 memcpy (PTR, data, 2); \
692 /* Do not reverse the bytes, because we will compare with a OTF_TAG value
693 that has them reversed already. */
694 #define OTF_DWORDTAG_VAL(TABLE, OFFSET, PTR) \
696 if (GetFontData (context, TABLE, OFFSET, PTR, 4) != 4) \
697 goto font_table_error; \
700 #define OTF_TAG_VAL(TABLE, OFFSET, STR) \
702 if (GetFontData (context, TABLE, OFFSET, STR, 4) != 4) \
703 goto font_table_error; \
707 #define SNAME(VAL) SSDATA (SYMBOL_NAME (VAL))
709 /* Uniscribe APIs available only since Windows Vista. */
710 typedef HRESULT (WINAPI
*ScriptGetFontScriptTags_Proc
)
711 (HDC
, SCRIPT_CACHE
*, SCRIPT_ANALYSIS
*, int, OPENTYPE_TAG
*, int *);
713 typedef HRESULT (WINAPI
*ScriptGetFontLanguageTags_Proc
)
714 (HDC
, SCRIPT_CACHE
*, SCRIPT_ANALYSIS
*, OPENTYPE_TAG
, int, OPENTYPE_TAG
*, int *);
716 typedef HRESULT (WINAPI
*ScriptGetFontFeatureTags_Proc
)
717 (HDC
, SCRIPT_CACHE
*, SCRIPT_ANALYSIS
*, OPENTYPE_TAG
, OPENTYPE_TAG
, int, OPENTYPE_TAG
*, int *);
719 ScriptGetFontScriptTags_Proc script_get_font_scripts_fn
;
720 ScriptGetFontLanguageTags_Proc script_get_font_languages_fn
;
721 ScriptGetFontFeatureTags_Proc script_get_font_features_fn
;
723 static bool uniscribe_new_apis
;
725 /* Verify that all the required features in FEATURES, each of whose
726 elements is a list or nil, can be found among the N feature tags in
727 FTAGS. Return 'true' if the required features are supported,
728 'false' if not. Each list in FEATURES can include an element of
729 nil, which means all the elements after it must not be in FTAGS. */
731 uniscribe_check_features (Lisp_Object features
[2], OPENTYPE_TAG
*ftags
, int n
)
735 for (j
= 0; j
< 2; j
++)
737 bool negative
= false;
740 for (rest
= features
[j
]; CONSP (rest
); rest
= XCDR (rest
))
742 Lisp_Object feature
= XCAR (rest
);
744 /* The font must NOT have any of the features after nil.
745 See the doc string of 'font-spec', under ':otf'. */
750 OPENTYPE_TAG feature_tag
= OTF_TAG (SNAME (feature
));
753 for (i
= 0; i
< n
; i
++)
755 if (ftags
[i
] == feature_tag
)
757 /* Test fails if we find a feature that the font
765 /* Test fails if we do NOT find a feature that the font
767 if (i
>= n
&& !negative
)
776 /* Check if font supports the required OTF script/language/features
777 using the Unsicribe APIs available since Windows Vista. We prefer
778 these APIs as a kind of future-proofing Emacs: they seem to
779 retrieve script tags that the old code (and also libotf) doesn't
780 seem to be able to get, e.g., some fonts that claim support for
781 "dev2" script don't show "deva", but the new APIs do report it. */
783 uniscribe_check_otf_1 (HDC context
, Lisp_Object script
, Lisp_Object lang
,
784 Lisp_Object features
[2], int *retval
)
786 SCRIPT_CACHE cache
= NULL
;
787 OPENTYPE_TAG tags
[32], script_tag
, lang_tag
;
788 int max_tags
= ARRAYELTS (tags
);
789 int ntags
, i
, ret
= 0;
794 rslt
= script_get_font_scripts_fn (context
, &cache
, NULL
, max_tags
,
798 DebPrint (("ScriptGetFontScriptTags failed with 0x%x\n", rslt
));
803 script_tag
= OTF_TAG ("DFLT");
805 script_tag
= OTF_TAG (SNAME (script
));
806 for (i
= 0; i
< ntags
; i
++)
807 if (tags
[i
] == script_tag
)
814 lang_tag
= OTF_TAG ("dflt");
817 rslt
= script_get_font_languages_fn (context
, &cache
, NULL
, script_tag
,
818 max_tags
, tags
, &ntags
);
821 DebPrint (("ScriptGetFontLanguageTags failed with 0x%x\n", rslt
));
826 lang_tag
= OTF_TAG ("dflt");
829 lang_tag
= OTF_TAG (SNAME (lang
));
830 for (i
= 0; i
< ntags
; i
++)
831 if (tags
[i
] == lang_tag
)
839 if (!NILP (features
[0]))
841 /* Are the 2 feature lists valid? */
842 if (!CONSP (features
[0])
843 || (!NILP (features
[1]) && !CONSP (features
[1])))
845 rslt
= script_get_font_features_fn (context
, &cache
, NULL
,
846 script_tag
, lang_tag
,
847 max_tags
, tags
, &ntags
);
850 DebPrint (("ScriptGetFontFeatureTags failed with 0x%x\n", rslt
));
855 /* ScriptGetFontFeatureTags doesn't let us query features
856 separately for GSUB and GPOS, so we check them all together.
857 It doesn't really matter, since the features in GSUB and GPOS
858 are disjoint, i.e. no feature can appear in both tables. */
859 if (!uniscribe_check_features (features
, tags
, ntags
))
868 ScriptFreeCache (&cache
);
872 /* Check if font supports the otf script/language/features specified.
873 OTF_SPEC is in the format
874 (script lang [(gsub_feature ...)|nil] [(gpos_feature ...)]?) */
876 uniscribe_check_otf (LOGFONT
*font
, Lisp_Object otf_spec
)
878 Lisp_Object script
, lang
, rest
;
879 Lisp_Object features
[2];
880 DWORD feature_tables
[2];
881 DWORD script_tag
, default_script
, lang_tag
= 0;
884 HFONT check_font
, old_font
;
887 /* Check the spec is in the right format. */
888 if (!CONSP (otf_spec
) || XINT (Flength (otf_spec
)) < 3)
891 /* Break otf_spec into its components. */
892 script
= XCAR (otf_spec
);
893 rest
= XCDR (otf_spec
);
898 features
[0] = XCAR (rest
);
903 features
[1] = XCAR (rest
);
905 /* Set up graphics context so we can use the font. */
906 f
= XFRAME (selected_frame
);
907 context
= get_frame_dc (f
);
908 check_font
= CreateFontIndirect (font
);
909 old_font
= SelectObject (context
, check_font
);
911 /* If we are on Vista or later, use the new APIs. */
912 if (uniscribe_new_apis
913 && !w32_disable_new_uniscribe_apis
914 && uniscribe_check_otf_1 (context
, script
, lang
, features
, &retval
) != -1)
917 /* Set up tags we will use in the search. */
918 feature_tables
[0] = OTF_TAG ("GSUB");
919 feature_tables
[1] = OTF_TAG ("GPOS");
920 default_script
= OTF_TAG ("DFLT");
922 script_tag
= default_script
;
924 script_tag
= OTF_TAG (SNAME (script
));
926 lang_tag
= OTF_TAG (SNAME (lang
));
928 /* Scan GSUB and GPOS tables. */
929 for (i
= 0; i
< 2; i
++)
931 int j
, n_match_features
;
932 unsigned short scriptlist_table
, feature_table
, n_scripts
;
933 unsigned short script_table
, langsys_table
, n_langs
;
934 unsigned short feature_index
, n_features
;
935 DWORD tbl
= feature_tables
[i
];
936 DWORD feature_id
, *ftags
;
937 Lisp_Object farray
[2];
939 /* Skip if no features requested from this table. */
940 if (NILP (features
[i
]))
943 /* If features is not a cons, this font spec is messed up. */
944 if (!CONSP (features
[i
]))
947 /* Read GPOS/GSUB header. */
948 OTF_INT16_VAL (tbl
, 4, &scriptlist_table
);
949 OTF_INT16_VAL (tbl
, 6, &feature_table
);
950 OTF_INT16_VAL (tbl
, scriptlist_table
, &n_scripts
);
952 /* Find the appropriate script table. */
954 for (j
= 0; j
< n_scripts
; j
++)
957 OTF_DWORDTAG_VAL (tbl
, scriptlist_table
+ 2 + j
* 6, &script_id
);
958 if (script_id
== script_tag
)
960 OTF_INT16_VAL (tbl
, scriptlist_table
+ 6 + j
* 6, &script_table
);
963 #if 0 /* Causes false positives. */
964 /* If there is a DFLT script defined in the font, use it
965 if the specified script is not found. */
966 else if (script_id
== default_script
)
967 OTF_INT16_VAL (tbl
, scriptlist_table
+ 6 + j
* 6, &script_table
);
970 /* If no specific or default script table was found, then this font
971 does not support the script. */
975 /* Offset is from beginning of scriptlist_table. */
976 script_table
+= scriptlist_table
;
978 /* Get default langsys table. */
979 OTF_INT16_VAL (tbl
, script_table
, &langsys_table
);
981 /* If lang was specified, see if font contains a specific entry. */
984 OTF_INT16_VAL (tbl
, script_table
+ 2, &n_langs
);
986 for (j
= 0; j
< n_langs
; j
++)
989 OTF_DWORDTAG_VAL (tbl
, script_table
+ 4 + j
* 6, &lang_id
);
990 if (lang_id
== lang_tag
)
992 OTF_INT16_VAL (tbl
, script_table
+ 8 + j
* 6, &langsys_table
);
1001 /* Offset is from beginning of script table. */
1002 langsys_table
+= script_table
;
1004 /* If there are no features to check, skip checking. */
1005 if (NILP (features
[i
]))
1007 if (!CONSP (features
[i
]))
1010 n_match_features
= 0;
1012 /* First get required feature (if any). */
1013 OTF_INT16_VAL (tbl
, langsys_table
+ 2, &feature_index
);
1014 if (feature_index
!= 0xFFFF)
1015 n_match_features
= 1;
1016 OTF_INT16_VAL (tbl
, langsys_table
+ 4, &n_features
);
1017 n_match_features
+= n_features
;
1019 SAFE_NALLOCA (ftags
, 1, n_match_features
);
1021 if (feature_index
!= 0xFFFF)
1023 OTF_DWORDTAG_VAL (tbl
, feature_table
+ 2 + feature_index
* 6,
1025 ftags
[k
++] = feature_id
;
1027 /* Now get all the other features. */
1028 for (j
= 0; j
< n_features
; j
++)
1030 OTF_INT16_VAL (tbl
, langsys_table
+ 6 + j
* 2, &feature_index
);
1031 OTF_DWORDTAG_VAL (tbl
, feature_table
+ 2 + feature_index
* 6,
1033 ftags
[k
++] = feature_id
;
1036 /* Check the features for this table. */
1037 farray
[0] = features
[i
];
1039 if (!uniscribe_check_features (farray
, ftags
, n_match_features
))
1049 /* restore graphics context. */
1050 SelectObject (context
, old_font
);
1051 DeleteObject (check_font
);
1052 release_frame_dc (f
, context
);
1058 otf_features (HDC context
, const char *table
)
1060 Lisp_Object script_list
= Qnil
;
1061 unsigned short scriptlist_table
, n_scripts
, feature_table
;
1062 DWORD tbl
= OTF_TAG (table
);
1065 /* Look for scripts in the table. */
1066 OTF_INT16_VAL (tbl
, 4, &scriptlist_table
);
1067 OTF_INT16_VAL (tbl
, 6, &feature_table
);
1068 OTF_INT16_VAL (tbl
, scriptlist_table
, &n_scripts
);
1070 for (i
= n_scripts
- 1; i
>= 0; i
--)
1072 char script
[5], lang
[5];
1073 unsigned short script_table
, lang_count
, langsys_table
, feature_count
;
1074 Lisp_Object script_tag
, langsys_list
, langsys_tag
, feature_list
;
1075 unsigned short record_offset
= scriptlist_table
+ 2 + i
* 6;
1076 OTF_TAG_VAL (tbl
, record_offset
, script
);
1077 OTF_INT16_VAL (tbl
, record_offset
+ 4, &script_table
);
1079 /* Offset is from beginning of script table. */
1080 script_table
+= scriptlist_table
;
1082 script_tag
= intern (script
);
1083 langsys_list
= Qnil
;
1085 /* Optional default lang. */
1086 OTF_INT16_VAL (tbl
, script_table
, &langsys_table
);
1089 /* Offset is from beginning of script table. */
1090 langsys_table
+= script_table
;
1093 feature_list
= Qnil
;
1094 OTF_INT16_VAL (tbl
, langsys_table
+ 4, &feature_count
);
1095 for (k
= feature_count
- 1; k
>= 0; k
--)
1098 unsigned short index
;
1099 OTF_INT16_VAL (tbl
, langsys_table
+ 6 + k
* 2, &index
);
1100 OTF_TAG_VAL (tbl
, feature_table
+ 2 + index
* 6, feature
);
1101 feature_list
= Fcons (intern (feature
), feature_list
);
1103 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1107 /* List of supported languages. */
1108 OTF_INT16_VAL (tbl
, script_table
+ 2, &lang_count
);
1110 for (j
= lang_count
- 1; j
>= 0; j
--)
1112 record_offset
= script_table
+ 4 + j
* 6;
1113 OTF_TAG_VAL (tbl
, record_offset
, lang
);
1114 OTF_INT16_VAL (tbl
, record_offset
+ 4, &langsys_table
);
1116 /* Offset is from beginning of script table. */
1117 langsys_table
+= script_table
;
1119 langsys_tag
= intern (lang
);
1120 feature_list
= Qnil
;
1121 OTF_INT16_VAL (tbl
, langsys_table
+ 4, &feature_count
);
1122 for (k
= feature_count
- 1; k
>= 0; k
--)
1125 unsigned short index
;
1126 OTF_INT16_VAL (tbl
, langsys_table
+ 6 + k
* 2, &index
);
1127 OTF_TAG_VAL (tbl
, feature_table
+ 2 + index
* 6, feature
);
1128 feature_list
= Fcons (intern (feature
), feature_list
);
1130 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1135 script_list
= Fcons (Fcons (script_tag
, langsys_list
), script_list
);
1144 #undef OTF_INT16_VAL
1149 struct font_driver uniscribe_font_driver
=
1151 LISPSYM_INITIALLY (Quniscribe
),
1152 0, /* case insensitive */
1156 uniscribe_list_family
,
1157 NULL
, /* free_entity */
1160 NULL
, /* prepare_face */
1161 NULL
, /* done_face */
1163 uniscribe_encode_char
,
1164 w32font_text_extents
,
1166 NULL
, /* get_bitmap */
1167 NULL
, /* free_bitmap */
1168 NULL
, /* anchor_point */
1169 uniscribe_otf_capability
, /* Defined so (font-get FONTOBJ :otf) works. */
1170 NULL
, /* otf_drive - use shape instead. */
1171 NULL
, /* start_for_frame */
1172 NULL
, /* end_for_frame */
1175 NULL
, /* get_variation_glyphs */
1176 NULL
, /* filter_properties */
1177 NULL
, /* cached_font_ok */
1180 /* Note that this should be called at every startup, not just when dumping,
1181 as it needs to test for the existence of the Uniscribe library. */
1182 void syms_of_w32uniscribe (void);
1185 syms_of_w32uniscribe (void)
1189 /* Don't init uniscribe when dumping */
1193 /* Don't register if uniscribe is not available. */
1194 uniscribe
= GetModuleHandle ("usp10");
1198 uniscribe_available
= 1;
1200 register_font_driver (&uniscribe_font_driver
, NULL
);
1202 script_get_font_scripts_fn
= (ScriptGetFontScriptTags_Proc
)
1203 GetProcAddress (uniscribe
, "ScriptGetFontScriptTags");
1204 script_get_font_languages_fn
= (ScriptGetFontLanguageTags_Proc
)
1205 GetProcAddress (uniscribe
, "ScriptGetFontLanguageTags");
1206 script_get_font_features_fn
= (ScriptGetFontFeatureTags_Proc
)
1207 GetProcAddress (uniscribe
, "ScriptGetFontFeatureTags");
1208 if (script_get_font_scripts_fn
1209 && script_get_font_languages_fn
1210 && script_get_font_features_fn
)
1211 uniscribe_new_apis
= true;
1213 uniscribe_new_apis
= false;