Fix drawing of relief rects on X and W32.
[emacs.git] / src / w32uniscribe.c
blob5d160b9d42f22dad437e8010a485c4d37370784c
1 /* Font backend for the Microsoft W32 Uniscribe API.
2 Copyright (C) 2008-2012 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/>. */
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-existent functions. */
26 #undef _WIN32_WINNT
27 #define _WIN32_WINNT 0x500
28 #include <windows.h>
29 #include <usp10.h>
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 "composite.h"
38 #include "fontset.h"
39 #include "font.h"
40 #include "w32font.h"
42 struct uniscribe_font_info
44 struct w32font_info w32_font;
45 SCRIPT_CACHE cache;
48 int uniscribe_available = 0;
50 /* Defined in w32font.c, since it is required there as well. */
51 extern Lisp_Object Quniscribe;
52 extern Lisp_Object Qopentype;
54 /* EnumFontFamiliesEx callback. */
55 static int CALLBACK add_opentype_font_name_to_list (ENUMLOGFONTEX *,
56 NEWTEXTMETRICEX *,
57 DWORD, LPARAM);
58 /* Used by uniscribe_otf_capability. */
59 static Lisp_Object otf_features (HDC context, char *table);
61 static int
62 memq_no_quit (Lisp_Object elt, Lisp_Object list)
64 while (CONSP (list) && ! EQ (XCAR (list), elt))
65 list = XCDR (list);
66 return (CONSP (list));
70 /* Font backend interface implementation. */
71 static Lisp_Object
72 uniscribe_list (Lisp_Object frame, Lisp_Object font_spec)
74 Lisp_Object fonts = w32font_list_internal (frame, font_spec, 1);
75 FONT_ADD_LOG ("uniscribe-list", font_spec, fonts);
76 return fonts;
79 static Lisp_Object
80 uniscribe_match (Lisp_Object frame, Lisp_Object font_spec)
82 Lisp_Object entity = w32font_match_internal (frame, font_spec, 1);
83 FONT_ADD_LOG ("uniscribe-match", font_spec, entity);
84 return entity;
87 static Lisp_Object
88 uniscribe_list_family (Lisp_Object frame)
90 Lisp_Object list = Qnil;
91 LOGFONT font_match_pattern;
92 HDC dc;
93 FRAME_PTR f = XFRAME (frame);
95 memset (&font_match_pattern, 0, sizeof (font_match_pattern));
96 /* Limit enumerated fonts to outline fonts to save time. */
97 font_match_pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
99 dc = get_frame_dc (f);
101 EnumFontFamiliesEx (dc, &font_match_pattern,
102 (FONTENUMPROC) add_opentype_font_name_to_list,
103 (LPARAM) &list, 0);
104 release_frame_dc (f, dc);
106 return list;
109 static Lisp_Object
110 uniscribe_open (FRAME_PTR 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))
122 return Qnil;
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 /* Mark the format as opentype */
132 uniscribe_font->w32_font.font.props[FONT_FORMAT_INDEX] = Qopentype;
133 uniscribe_font->w32_font.font.driver = &uniscribe_font_driver;
135 return font_object;
138 static void
139 uniscribe_close (FRAME_PTR f, struct font *font)
141 struct uniscribe_font_info *uniscribe_font
142 = (struct uniscribe_font_info *) font;
144 if (uniscribe_font->cache)
145 ScriptFreeCache (&(uniscribe_font->cache));
147 w32font_close (f, font);
150 /* Return a list describing which scripts/languages FONT supports by
151 which GSUB/GPOS features of OpenType tables. */
152 static Lisp_Object
153 uniscribe_otf_capability (struct font *font)
155 HDC context;
156 HFONT old_font;
157 struct frame *f;
158 Lisp_Object capability = Fcons (Qnil, Qnil);
159 Lisp_Object features;
161 f = XFRAME (selected_frame);
162 context = get_frame_dc (f);
163 old_font = SelectObject (context, FONT_HANDLE (font));
165 features = otf_features (context, "GSUB");
166 XSETCAR (capability, features);
167 features = otf_features (context, "GPOS");
168 XSETCDR (capability, features);
170 SelectObject (context, old_font);
171 release_frame_dc (f, context);
173 return capability;
176 /* Uniscribe implementation of shape for font backend.
178 Shape text in LGSTRING. See the docstring of
179 `composition-get-gstring' for the format of LGSTRING. If the
180 (N+1)th element of LGSTRING is nil, input of shaping is from the
181 1st to (N)th elements. In each input glyph, FROM, TO, CHAR, and
182 CODE are already set.
184 This function updates all fields of the input glyphs. If the
185 output glyphs (M) are more than the input glyphs (N), (N+1)th
186 through (M)th elements of LGSTRING are updated possibly by making
187 a new glyph object and storing it in LGSTRING. If (M) is greater
188 than the length of LGSTRING, nil should be returned. In that case,
189 this function is called again with a larger LGSTRING. */
190 static Lisp_Object
191 uniscribe_shape (Lisp_Object lgstring)
193 struct font * font;
194 struct uniscribe_font_info * uniscribe_font;
195 EMACS_UINT nchars;
196 int nitems, max_items, i, max_glyphs, done_glyphs;
197 wchar_t *chars;
198 WORD *glyphs, *clusters;
199 SCRIPT_ITEM *items;
200 SCRIPT_VISATTR *attributes;
201 int *advances;
202 GOFFSET *offsets;
203 ABC overall_metrics;
204 HRESULT result;
205 struct frame * f = NULL;
206 HDC context = NULL;
207 HFONT old_font = NULL;
209 CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring), font);
210 uniscribe_font = (struct uniscribe_font_info *) font;
212 /* Get the chars from lgstring in a form we can use with uniscribe. */
213 max_glyphs = nchars = LGSTRING_GLYPH_LEN (lgstring);
214 done_glyphs = 0;
215 chars = (wchar_t *) alloca (nchars * sizeof (wchar_t));
216 /* FIXME: This loop assumes that characters in the input LGSTRING
217 are all inside the BMP. Need to encode characters beyond the BMP
218 as UTF-16. */
219 for (i = 0; i < nchars; i++)
221 /* lgstring can be bigger than the number of characters in it, in
222 the case where more glyphs are required to display those characters.
223 If that is the case, note the real number of characters. */
224 if (NILP (LGSTRING_GLYPH (lgstring, i)))
225 nchars = i;
226 else
227 chars[i] = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i));
230 /* First we need to break up the glyph string into runs of glyphs that
231 can be treated together. First try a single run. */
232 max_items = 2;
233 items = xmalloc (sizeof (SCRIPT_ITEM) * max_items + 1);
235 while ((result = ScriptItemize (chars, nchars, max_items, NULL, NULL,
236 items, &nitems)) == E_OUTOFMEMORY)
238 /* If that wasn't enough, keep trying with one more run. */
239 max_items++;
240 items = (SCRIPT_ITEM *) xrealloc (items,
241 sizeof (SCRIPT_ITEM) * max_items + 1);
244 if (FAILED (result))
246 xfree (items);
247 return Qnil;
250 glyphs = alloca (max_glyphs * sizeof (WORD));
251 clusters = alloca (nchars * sizeof (WORD));
252 attributes = alloca (max_glyphs * sizeof (SCRIPT_VISATTR));
253 advances = alloca (max_glyphs * sizeof (int));
254 offsets = alloca (max_glyphs * sizeof (GOFFSET));
256 for (i = 0; i < nitems; i++)
258 int nglyphs, nchars_in_run;
259 nchars_in_run = items[i+1].iCharPos - items[i].iCharPos;
260 /* Force ScriptShape to generate glyphs in the same order as
261 they are in the input LGSTRING, which is in the logical
262 order. */
263 items[i].a.fLogicalOrder = 1;
265 /* Context may be NULL here, in which case the cache should be
266 used without needing to select the font. */
267 result = ScriptShape (context, &(uniscribe_font->cache),
268 chars + items[i].iCharPos, nchars_in_run,
269 max_glyphs - done_glyphs, &(items[i].a),
270 glyphs, clusters, attributes, &nglyphs);
272 if (result == E_PENDING && !context)
274 /* This assumes the selected frame is on the same display as the
275 one we are drawing. It would be better for the frame to be
276 passed in. */
277 f = XFRAME (selected_frame);
278 context = get_frame_dc (f);
279 old_font = SelectObject (context, FONT_HANDLE (font));
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);
287 if (result == E_OUTOFMEMORY)
289 /* Need a bigger lgstring. */
290 lgstring = Qnil;
291 break;
293 else if (FAILED (result))
295 /* Can't shape this run - return results so far if any. */
296 break;
298 else if (items[i].a.fNoGlyphIndex)
300 /* Glyph indices not supported by this font (or OS), means we
301 can't really do any meaningful shaping. */
302 break;
304 else
306 result = ScriptPlace (context, &(uniscribe_font->cache),
307 glyphs, nglyphs, attributes, &(items[i].a),
308 advances, offsets, &overall_metrics);
309 if (result == E_PENDING && !context)
311 /* Cache not complete... */
312 f = XFRAME (selected_frame);
313 context = get_frame_dc (f);
314 old_font = SelectObject (context, FONT_HANDLE (font));
316 result = ScriptPlace (context, &(uniscribe_font->cache),
317 glyphs, nglyphs, attributes, &(items[i].a),
318 advances, offsets, &overall_metrics);
320 if (SUCCEEDED (result))
322 int j, from, to, adj_offset = 0;
324 from = 0;
325 to = from;
327 for (j = 0; j < nglyphs; j++)
329 int lglyph_index = j + done_glyphs;
330 Lisp_Object lglyph = LGSTRING_GLYPH (lgstring, lglyph_index);
331 ABC char_metric;
332 unsigned gl;
334 if (NILP (lglyph))
336 lglyph = Fmake_vector (make_number (LGLYPH_SIZE), Qnil);
337 LGSTRING_SET_GLYPH (lgstring, lglyph_index, lglyph);
339 /* Copy to a 32-bit data type to shut up the
340 compiler warning in LGLYPH_SET_CODE about
341 comparison being always false. */
342 gl = glyphs[j];
343 LGLYPH_SET_CODE (lglyph, gl);
345 /* Detect clusters, for linking codes back to
346 characters. */
347 if (attributes[j].fClusterStart)
349 while (from < nchars_in_run && clusters[from] < j)
350 from++;
351 if (from >= nchars_in_run)
352 from = to = nchars_in_run - 1;
353 else
355 int k;
356 to = nchars_in_run - 1;
357 for (k = from + 1; k < nchars_in_run; k++)
359 if (clusters[k] > j)
361 to = k - 1;
362 break;
367 /* For RTL text, the Uniscribe shaper prepares
368 the values in ADVANCES array for layout in
369 reverse order, whereby "advance width" is
370 applied to move the pen in reverse direction
371 and _before_ drawing the glyph. Since we
372 draw glyphs in their normal left-to-right
373 order, we need to adjust the coordinates of
374 each non-base glyph in a grapheme cluster via
375 X-OFF component of the gstring's ADJUSTMENT
376 sub-vector. This loop computes, for each
377 grapheme cluster, the initial value of the
378 adjustment for the base character, which is
379 then updated for each successive glyph in the
380 grapheme cluster. */
381 if (items[i].a.fRTL)
383 int j1 = j;
385 adj_offset = 0;
386 while (j1 < nglyphs && !attributes[j1].fClusterStart)
388 adj_offset += advances[j1];
389 j1++;
394 LGLYPH_SET_CHAR (lglyph, chars[items[i].iCharPos
395 + from]);
396 LGLYPH_SET_FROM (lglyph, items[i].iCharPos + from);
397 LGLYPH_SET_TO (lglyph, items[i].iCharPos + to);
399 /* Metrics. */
400 LGLYPH_SET_WIDTH (lglyph, advances[j]);
401 LGLYPH_SET_ASCENT (lglyph, font->ascent);
402 LGLYPH_SET_DESCENT (lglyph, font->descent);
404 result = ScriptGetGlyphABCWidth (context,
405 &(uniscribe_font->cache),
406 glyphs[j], &char_metric);
407 if (result == E_PENDING && !context)
409 /* Cache incomplete... */
410 f = XFRAME (selected_frame);
411 context = get_frame_dc (f);
412 old_font = SelectObject (context, FONT_HANDLE (font));
413 result = ScriptGetGlyphABCWidth (context,
414 &(uniscribe_font->cache),
415 glyphs[j], &char_metric);
418 if (SUCCEEDED (result))
420 int lbearing = char_metric.abcA;
421 int rbearing = char_metric.abcA + char_metric.abcB;
423 LGLYPH_SET_LBEARING (lglyph, lbearing);
424 LGLYPH_SET_RBEARING (lglyph, rbearing);
426 else
428 LGLYPH_SET_LBEARING (lglyph, 0);
429 LGLYPH_SET_RBEARING (lglyph, advances[j]);
432 if (offsets[j].du || offsets[j].dv
433 /* For non-base glyphs of RTL grapheme clusters,
434 adjust the X offset even if both DU and DV
435 are zero. */
436 || (!attributes[j].fClusterStart && items[i].a.fRTL))
438 Lisp_Object vec;
439 vec = Fmake_vector (make_number (3), Qnil);
440 if (items[i].a.fRTL)
442 /* Empirically, it looks like Uniscribe
443 interprets DU in reverse direction for
444 RTL clusters. E.g., if we don't reverse
445 the direction, the Hebrew point HOLAM is
446 drawn above the right edge of the base
447 consonant, instead of above the left edge. */
448 ASET (vec, 0, make_number (-offsets[j].du
449 + adj_offset));
450 /* Update the adjustment value for the width
451 advance of the glyph we just emitted. */
452 adj_offset -= 2 * advances[j];
454 else
455 ASET (vec, 0, make_number (offsets[j].du + adj_offset));
456 /* In the font definition coordinate system, the
457 Y coordinate points up, while in our screen
458 coordinates Y grows downwards. So we need to
459 reverse the sign of Y-OFFSET here. */
460 ASET (vec, 1, make_number (-offsets[j].dv));
461 /* Based on what ftfont.c does... */
462 ASET (vec, 2, make_number (advances[j]));
463 LGLYPH_SET_ADJUSTMENT (lglyph, vec);
465 else
467 LGLYPH_SET_ADJUSTMENT (lglyph, Qnil);
468 /* Update the adjustment value to compensate for
469 the width of the base character. */
470 if (items[i].a.fRTL)
471 adj_offset -= advances[j];
476 done_glyphs += nglyphs;
479 xfree (items);
481 if (context)
483 SelectObject (context, old_font);
484 release_frame_dc (f, context);
487 if (NILP (lgstring))
488 return Qnil;
489 else
490 return make_number (done_glyphs);
493 /* Uniscribe implementation of encode_char for font backend.
494 Return a glyph code of FONT for character C (Unicode code point).
495 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
496 static unsigned
497 uniscribe_encode_char (struct font *font, int c)
499 HDC context = NULL;
500 struct frame *f = NULL;
501 HFONT old_font = NULL;
502 unsigned code = FONT_INVALID_CODE;
503 wchar_t ch[2];
504 int len;
505 SCRIPT_ITEM* items;
506 int nitems;
507 struct uniscribe_font_info *uniscribe_font
508 = (struct uniscribe_font_info *)font;
510 if (c < 0x10000)
512 ch[0] = (wchar_t) c;
513 len = 1;
515 else
517 DWORD surrogate = c - 0x10000;
519 /* High surrogate: U+D800 - U+DBFF. */
520 ch[0] = 0xD800 + ((surrogate >> 10) & 0x03FF);
521 /* Low surrogate: U+DC00 - U+DFFF. */
522 ch[1] = 0xDC00 + (surrogate & 0x03FF);
523 len = 2;
526 /* Non BMP characters must be handled by the uniscribe shaping
527 engine as GDI functions (except blindly displaying lines of
528 Unicode text) and the promising looking ScriptGetCMap do not
529 convert surrogate pairs to glyph indexes correctly. */
531 items = (SCRIPT_ITEM *) alloca (sizeof (SCRIPT_ITEM) * 2 + 1);
532 if (SUCCEEDED (ScriptItemize (ch, len, 2, NULL, NULL, items, &nitems)))
534 HRESULT result;
535 /* Surrogates seem to need 2 here, even though only one glyph is
536 returned. Indic characters can also produce 2 or more glyphs for
537 a single code point, but they need to use uniscribe_shape
538 above for correct display. */
539 WORD glyphs[2], clusters[2];
540 SCRIPT_VISATTR attrs[2];
541 int nglyphs;
543 /* Force ScriptShape to generate glyphs in the logical
544 order. */
545 items[0].a.fLogicalOrder = 1;
547 result = ScriptShape (context, &(uniscribe_font->cache),
548 ch, len, 2, &(items[0].a),
549 glyphs, clusters, attrs, &nglyphs);
551 if (result == E_PENDING)
553 /* Use selected frame until API is updated to pass
554 the frame. */
555 f = XFRAME (selected_frame);
556 context = get_frame_dc (f);
557 old_font = SelectObject (context, FONT_HANDLE (font));
558 result = ScriptShape (context, &(uniscribe_font->cache),
559 ch, len, 2, &(items[0].a),
560 glyphs, clusters, attrs, &nglyphs);
563 if (SUCCEEDED (result) && nglyphs == 1)
565 /* Some fonts return .notdef glyphs instead of failing.
566 (TrueType spec reserves glyph code 0 for .notdef) */
567 if (glyphs[0])
568 code = glyphs[0];
570 else if (SUCCEEDED (result) || result == E_OUTOFMEMORY)
572 /* This character produces zero or more than one glyph
573 when shaped. But we still need the return from here
574 to be valid for the shaping engine to be invoked
575 later. */
576 result = ScriptGetCMap (context, &(uniscribe_font->cache),
577 ch, len, 0, glyphs);
578 if (SUCCEEDED (result) && glyphs[0])
579 code = glyphs[0];
583 if (context)
585 SelectObject (context, old_font);
586 release_frame_dc (f, context);
589 return code;
593 Shared with w32font:
594 Lisp_Object uniscribe_get_cache (Lisp_Object frame);
595 void uniscribe_free_entity (Lisp_Object font_entity);
596 int uniscribe_has_char (Lisp_Object entity, int c);
597 int uniscribe_text_extents (struct font *font, unsigned *code,
598 int nglyphs, struct font_metrics *metrics);
599 int uniscribe_draw (struct glyph_string *s, int from, int to,
600 int x, int y, int with_background);
602 Unused:
603 int uniscribe_prepare_face (FRAME_PTR f, struct face *face);
604 void uniscribe_done_face (FRAME_PTR f, struct face *face);
605 int uniscribe_get_bitmap (struct font *font, unsigned code,
606 struct font_bitmap *bitmap, int bits_per_pixel);
607 void uniscribe_free_bitmap (struct font *font, struct font_bitmap *bitmap);
608 void * uniscribe_get_outline (struct font *font, unsigned code);
609 void uniscribe_free_outline (struct font *font, void *outline);
610 int uniscribe_anchor_point (struct font *font, unsigned code,
611 int index, int *x, int *y);
612 int uniscribe_start_for_frame (FRAME_PTR f);
613 int uniscribe_end_for_frame (FRAME_PTR f);
618 /* Callback function for EnumFontFamiliesEx.
619 Adds the name of opentype fonts to a Lisp list (passed in as the
620 lParam arg). */
621 static int CALLBACK
622 add_opentype_font_name_to_list (ENUMLOGFONTEX *logical_font,
623 NEWTEXTMETRICEX *physical_font,
624 DWORD font_type, LPARAM list_object)
626 Lisp_Object* list = (Lisp_Object *) list_object;
627 Lisp_Object family;
629 /* Skip vertical fonts (intended only for printing) */
630 if (logical_font->elfLogFont.lfFaceName[0] == '@')
631 return 1;
633 /* Skip non opentype fonts. Count old truetype fonts as opentype,
634 as some of them do contain GPOS and GSUB data that Uniscribe
635 can make use of. */
636 if (!(physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
637 && font_type != TRUETYPE_FONTTYPE)
638 return 1;
640 /* Skip fonts that have no Unicode coverage. */
641 if (!physical_font->ntmFontSig.fsUsb[3]
642 && !physical_font->ntmFontSig.fsUsb[2]
643 && !physical_font->ntmFontSig.fsUsb[1]
644 && !(physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff))
645 return 1;
647 family = intern_font_name (logical_font->elfLogFont.lfFaceName);
648 if (! memq_no_quit (family, *list))
649 *list = Fcons (family, *list);
651 return 1;
655 /* :otf property handling.
656 Since the necessary Uniscribe APIs for getting font tag information
657 are only available in Vista, we need to parse the font data directly
658 according to the OpenType Specification. */
660 /* Push into DWORD backwards to cope with endianness. */
661 #define OTF_TAG(STR) \
662 ((STR[3] << 24) | (STR[2] << 16) | (STR[1] << 8) | STR[0])
664 #define OTF_INT16_VAL(TABLE, OFFSET, PTR) \
665 do { \
666 BYTE temp, data[2]; \
667 if (GetFontData (context, TABLE, OFFSET, data, 2) != 2) \
668 goto font_table_error; \
669 temp = data[0], data[0] = data[1], data[1] = temp; \
670 memcpy (PTR, data, 2); \
671 } while (0)
673 /* Do not reverse the bytes, because we will compare with a OTF_TAG value
674 that has them reversed already. */
675 #define OTF_DWORDTAG_VAL(TABLE, OFFSET, PTR) \
676 do { \
677 if (GetFontData (context, TABLE, OFFSET, PTR, 4) != 4) \
678 goto font_table_error; \
679 } while (0)
681 #define OTF_TAG_VAL(TABLE, OFFSET, STR) \
682 do { \
683 if (GetFontData (context, TABLE, OFFSET, STR, 4) != 4) \
684 goto font_table_error; \
685 STR[4] = '\0'; \
686 } while (0)
688 #define SNAME(VAL) SDATA (SYMBOL_NAME (VAL))
690 /* Check if font supports the otf script/language/features specified.
691 OTF_SPEC is in the format
692 (script lang [(gsub_feature ...)|nil] [(gpos_feature ...)]?) */
694 uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec)
696 Lisp_Object script, lang, rest;
697 Lisp_Object features[2];
698 DWORD feature_tables[2];
699 DWORD script_tag, default_script, lang_tag = 0;
700 struct frame * f;
701 HDC context;
702 HFONT check_font, old_font;
703 int i, retval = 0;
704 struct gcpro gcpro1;
706 /* Check the spec is in the right format. */
707 if (!CONSP (otf_spec) || XINT (Flength (otf_spec)) < 3)
708 return 0;
710 /* Break otf_spec into its components. */
711 script = XCAR (otf_spec);
712 rest = XCDR (otf_spec);
714 lang = XCAR (rest);
715 rest = XCDR (rest);
717 features[0] = XCAR (rest);
718 rest = XCDR (rest);
719 if (NILP (rest))
720 features[1] = Qnil;
721 else
722 features[1] = XCAR (rest);
724 /* Set up tags we will use in the search. */
725 feature_tables[0] = OTF_TAG ("GSUB");
726 feature_tables[1] = OTF_TAG ("GPOS");
727 default_script = OTF_TAG ("DFLT");
728 if (NILP (script))
729 script_tag = default_script;
730 else
731 script_tag = OTF_TAG (SNAME (script));
732 if (!NILP (lang))
733 lang_tag = OTF_TAG (SNAME (lang));
735 /* Set up graphics context so we can use the font. */
736 f = XFRAME (selected_frame);
737 context = get_frame_dc (f);
738 check_font = CreateFontIndirect (font);
739 old_font = SelectObject (context, check_font);
741 /* Everything else is contained within otf_spec so should get
742 marked along with it. */
743 GCPRO1 (otf_spec);
745 /* Scan GSUB and GPOS tables. */
746 for (i = 0; i < 2; i++)
748 int j, n_match_features;
749 unsigned short scriptlist_table, feature_table, n_scripts;
750 unsigned short script_table, langsys_table, n_langs;
751 unsigned short feature_index, n_features;
752 DWORD tbl = feature_tables[i];
754 /* Skip if no features requested from this table. */
755 if (NILP (features[i]))
756 continue;
758 /* If features is not a cons, this font spec is messed up. */
759 if (!CONSP (features[i]))
760 goto no_support;
762 /* Read GPOS/GSUB header. */
763 OTF_INT16_VAL (tbl, 4, &scriptlist_table);
764 OTF_INT16_VAL (tbl, 6, &feature_table);
765 OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);
767 /* Find the appropriate script table. */
768 script_table = 0;
769 for (j = 0; j < n_scripts; j++)
771 DWORD script_id;
772 OTF_DWORDTAG_VAL (tbl, scriptlist_table + 2 + j * 6, &script_id);
773 if (script_id == script_tag)
775 OTF_INT16_VAL (tbl, scriptlist_table + 6 + j * 6, &script_table);
776 break;
778 #if 0 /* Causes false positives. */
779 /* If there is a DFLT script defined in the font, use it
780 if the specified script is not found. */
781 else if (script_id == default_script)
782 OTF_INT16_VAL (tbl, scriptlist_table + 6 + j * 6, &script_table);
783 #endif
785 /* If no specific or default script table was found, then this font
786 does not support the script. */
787 if (!script_table)
788 goto no_support;
790 /* Offset is from beginning of scriptlist_table. */
791 script_table += scriptlist_table;
793 /* Get default langsys table. */
794 OTF_INT16_VAL (tbl, script_table, &langsys_table);
796 /* If lang was specified, see if font contains a specific entry. */
797 if (!NILP (lang))
799 OTF_INT16_VAL (tbl, script_table + 2, &n_langs);
801 for (j = 0; j < n_langs; j++)
803 DWORD lang_id;
804 OTF_DWORDTAG_VAL (tbl, script_table + 4 + j * 6, &lang_id);
805 if (lang_id == lang_tag)
807 OTF_INT16_VAL (tbl, script_table + 8 + j * 6, &langsys_table);
808 break;
813 if (!langsys_table)
814 goto no_support;
816 /* Offset is from beginning of script table. */
817 langsys_table += script_table;
819 /* Check the features. Features may contain nil according to
820 documentation in font_prop_validate_otf, so count them. */
821 n_match_features = 0;
822 for (rest = features[i]; CONSP (rest); rest = XCDR (rest))
824 Lisp_Object feature = XCAR (rest);
825 if (!NILP (feature))
826 n_match_features++;
829 /* If there are no features to check, skip checking. */
830 if (!n_match_features)
831 continue;
833 /* First check required feature (if any). */
834 OTF_INT16_VAL (tbl, langsys_table + 2, &feature_index);
835 if (feature_index != 0xFFFF)
837 char feature_id[5];
838 OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
839 OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
840 /* Assume no duplicates in the font table. This allows us to mark
841 the features off by simply decrementing a counter. */
842 if (!NILP (Fmemq (intern (feature_id), features[i])))
843 n_match_features--;
845 /* Now check all the other features. */
846 OTF_INT16_VAL (tbl, langsys_table + 4, &n_features);
847 for (j = 0; j < n_features; j++)
849 char feature_id[5];
850 OTF_INT16_VAL (tbl, langsys_table + 6 + j * 2, &feature_index);
851 OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id);
852 /* Assume no duplicates in the font table. This allows us to mark
853 the features off by simply decrementing a counter. */
854 if (!NILP (Fmemq (intern (feature_id), features[i])))
855 n_match_features--;
858 if (n_match_features > 0)
859 goto no_support;
862 retval = 1;
864 no_support:
865 font_table_error:
866 /* restore graphics context. */
867 SelectObject (context, old_font);
868 DeleteObject (check_font);
869 release_frame_dc (f, context);
871 return retval;
874 static Lisp_Object
875 otf_features (HDC context, char *table)
877 Lisp_Object script_list = Qnil;
878 unsigned short scriptlist_table, n_scripts, feature_table;
879 DWORD tbl = OTF_TAG (table);
880 int i, j, k;
882 /* Look for scripts in the table. */
883 OTF_INT16_VAL (tbl, 4, &scriptlist_table);
884 OTF_INT16_VAL (tbl, 6, &feature_table);
885 OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts);
887 for (i = 0; i < n_scripts; i++)
889 char script[5], lang[5];
890 unsigned short script_table, lang_count, langsys_table, feature_count;
891 Lisp_Object script_tag, langsys_list, langsys_tag, feature_list;
892 unsigned short record_offset = scriptlist_table + 2 + i * 6;
893 OTF_TAG_VAL (tbl, record_offset, script);
894 OTF_INT16_VAL (tbl, record_offset + 4, &script_table);
896 /* Offset is from beginning of script table. */
897 script_table += scriptlist_table;
899 script_tag = intern (script);
900 langsys_list = Qnil;
902 /* Optional default lang. */
903 OTF_INT16_VAL (tbl, script_table, &langsys_table);
904 if (langsys_table)
906 /* Offset is from beginning of script table. */
907 langsys_table += script_table;
909 langsys_tag = Qnil;
910 feature_list = Qnil;
911 OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
912 for (k = 0; k < feature_count; k++)
914 char feature[5];
915 unsigned short index;
916 OTF_INT16_VAL (tbl, langsys_table + 6 + k * 2, &index);
917 OTF_TAG_VAL (tbl, feature_table + 2 + index * 6, feature);
918 feature_list = Fcons (intern (feature), feature_list);
920 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
921 langsys_list);
924 /* List of supported languages. */
925 OTF_INT16_VAL (tbl, script_table + 2, &lang_count);
927 for (j = 0; j < lang_count; j++)
929 record_offset = script_table + 4 + j * 6;
930 OTF_TAG_VAL (tbl, record_offset, lang);
931 OTF_INT16_VAL (tbl, record_offset + 4, &langsys_table);
933 /* Offset is from beginning of script table. */
934 langsys_table += script_table;
936 langsys_tag = intern (lang);
937 feature_list = Qnil;
938 OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count);
939 for (k = 0; k < feature_count; k++)
941 char feature[5];
942 unsigned short index;
943 OTF_INT16_VAL (tbl, langsys_table + 6 + k * 2, &index);
944 OTF_TAG_VAL (tbl, feature_table + 2 + index * 6, feature);
945 feature_list = Fcons (intern (feature), feature_list);
947 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
948 langsys_list);
952 script_list = Fcons (Fcons (script_tag, langsys_list), script_list);
955 return script_list;
957 font_table_error:
958 return Qnil;
961 #undef OTF_INT16_VAL
962 #undef OTF_TAG_VAL
963 #undef OTF_TAG
966 struct font_driver uniscribe_font_driver =
968 0, /* Quniscribe */
969 0, /* case insensitive */
970 w32font_get_cache,
971 uniscribe_list,
972 uniscribe_match,
973 uniscribe_list_family,
974 NULL, /* free_entity */
975 uniscribe_open,
976 uniscribe_close,
977 NULL, /* prepare_face */
978 NULL, /* done_face */
979 w32font_has_char,
980 uniscribe_encode_char,
981 w32font_text_extents,
982 w32font_draw,
983 NULL, /* get_bitmap */
984 NULL, /* free_bitmap */
985 NULL, /* get_outline */
986 NULL, /* free_outline */
987 NULL, /* anchor_point */
988 uniscribe_otf_capability, /* Defined so (font-get FONTOBJ :otf) works. */
989 NULL, /* otf_drive - use shape instead. */
990 NULL, /* start_for_frame */
991 NULL, /* end_for_frame */
992 uniscribe_shape,
993 NULL, /* check */
994 NULL, /* get_variation_glyphs */
995 NULL, /* filter_properties */
996 NULL, /* cached_font_ok */
999 /* Note that this should be called at every startup, not just when dumping,
1000 as it needs to test for the existence of the Uniscribe library. */
1001 void
1002 syms_of_w32uniscribe (void)
1004 HMODULE uniscribe;
1006 /* Don't init uniscribe when dumping */
1007 if (!initialized)
1008 return;
1010 /* Don't register if uniscribe is not available. */
1011 uniscribe = GetModuleHandle ("usp10");
1012 if (!uniscribe)
1013 return;
1015 uniscribe_font_driver.type = Quniscribe;
1016 uniscribe_available = 1;
1018 register_font_driver (&uniscribe_font_driver, NULL);