Merge from emacs--rel--22
[bpt/emacs.git] / src / w32font.c
1 /* Font backend for the Microsoft W32 API.
2 Copyright (C) 2007, 2008 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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, or (at your option)
9 any later version.
10
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.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA. */
20
21 #include <config.h>
22 #include <windows.h>
23
24 #include "lisp.h"
25 #include "w32term.h"
26 #include "frame.h"
27 #include "dispextern.h"
28 #include "character.h"
29 #include "charset.h"
30 #include "fontset.h"
31 #include "font.h"
32 #include "w32font.h"
33
34 /* Cleartype available on Windows XP, cleartype_natural from XP SP1.
35 The latter does not try to fit cleartype smoothed fonts into the
36 same bounding box as the non-antialiased version of the font.
37 */
38 #ifndef CLEARTYPE_QUALITY
39 #define CLEARTYPE_QUALITY 5
40 #endif
41 #ifndef CLEARTYPE_NATURAL_QUALITY
42 #define CLEARTYPE_NATURAL_QUALITY 6
43 #endif
44
45 extern struct font_driver w32font_driver;
46
47 Lisp_Object Qgdi;
48 static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif;
49 static Lisp_Object Qserif, Qscript, Qdecorative;
50 static Lisp_Object Qraster, Qoutline, Qunknown;
51
52 /* antialiasing */
53 extern Lisp_Object QCantialias; /* defined in font.c */
54 extern Lisp_Object Qnone; /* reuse from w32fns.c */
55 static Lisp_Object Qstandard, Qsubpixel, Qnatural;
56
57 /* scripts */
58 static Lisp_Object Qlatin, Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
59 static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
60 static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
61 static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
62 static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
63 static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
64 static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
65 static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
66 static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
67 static Lisp_Object Qmusical_symbol, Qmathematical;
68
69 /* Font spacing symbols - defined in font.c. */
70 extern Lisp_Object Qc, Qp, Qm;
71
72 static void fill_in_logfont P_ ((FRAME_PTR f, LOGFONT *logfont,
73 Lisp_Object font_spec));
74
75 static BYTE w32_antialias_type P_ ((Lisp_Object type));
76 static Lisp_Object lispy_antialias_type P_ ((BYTE type));
77
78 static Lisp_Object font_supported_scripts P_ ((FONTSIGNATURE * sig));
79
80 /* From old font code in w32fns.c */
81 char * w32_to_x_charset P_ ((int charset, char * matching));
82
83 static Lisp_Object w32_registry P_ ((LONG w32_charset));
84
85 /* EnumFontFamiliesEx callbacks. */
86 static int CALLBACK add_font_entity_to_list P_ ((ENUMLOGFONTEX *,
87 NEWTEXTMETRICEX *,
88 DWORD, LPARAM));
89 static int CALLBACK add_one_font_entity_to_list P_ ((ENUMLOGFONTEX *,
90 NEWTEXTMETRICEX *,
91 DWORD, LPARAM));
92 static int CALLBACK add_font_name_to_list P_ ((ENUMLOGFONTEX *,
93 NEWTEXTMETRICEX *,
94 DWORD, LPARAM));
95
96 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
97 of what we really want. */
98 struct font_callback_data
99 {
100 /* The logfont we are matching against. EnumFontFamiliesEx only matches
101 face name and charset, so we need to manually match everything else
102 in the callback function. */
103 LOGFONT pattern;
104 /* The original font spec or entity. */
105 Lisp_Object orig_font_spec;
106 /* The frame the font is being loaded on. */
107 Lisp_Object frame;
108 /* The list to add matches to. */
109 Lisp_Object list;
110 /* Whether to match only opentype fonts. */
111 int opentype_only;
112 };
113
114 /* Handles the problem that EnumFontFamiliesEx will not return all
115 style variations if the font name is not specified. */
116 static void list_all_matching_fonts P_ ((struct font_callback_data *match));
117
118
119 /* MingW headers only define this when _WIN32_WINNT >= 0x0500, but we
120 target older versions. */
121 #ifndef GGI_MARK_NONEXISTING_GLYPHS
122 #define GGI_MARK_NONEXISTING_GLYPHS 1
123 #endif
124
125 static int
126 memq_no_quit (elt, list)
127 Lisp_Object elt, list;
128 {
129 while (CONSP (list) && ! EQ (XCAR (list), elt))
130 list = XCDR (list);
131 return (CONSP (list));
132 }
133
134 /* w32 implementation of get_cache for font backend.
135 Return a cache of font-entities on FRAME. The cache must be a
136 cons whose cdr part is the actual cache area. */
137 Lisp_Object
138 w32font_get_cache (f)
139 FRAME_PTR f;
140 {
141 struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
142
143 return (dpyinfo->name_list_element);
144 }
145
146 /* w32 implementation of list for font backend.
147 List fonts exactly matching with FONT_SPEC on FRAME. The value
148 is a vector of font-entities. This is the sole API that
149 allocates font-entities. */
150 static Lisp_Object
151 w32font_list (frame, font_spec)
152 Lisp_Object frame, font_spec;
153 {
154 return w32font_list_internal (frame, font_spec, 0);
155 }
156
157 /* w32 implementation of match for font backend.
158 Return a font entity most closely matching with FONT_SPEC on
159 FRAME. The closeness is detemined by the font backend, thus
160 `face-font-selection-order' is ignored here. */
161 static Lisp_Object
162 w32font_match (frame, font_spec)
163 Lisp_Object frame, font_spec;
164 {
165 return w32font_match_internal (frame, font_spec, 0);
166 }
167
168 /* w32 implementation of list_family for font backend.
169 List available families. The value is a list of family names
170 (symbols). */
171 static Lisp_Object
172 w32font_list_family (frame)
173 Lisp_Object frame;
174 {
175 Lisp_Object list = Qnil;
176 LOGFONT font_match_pattern;
177 HDC dc;
178 FRAME_PTR f = XFRAME (frame);
179
180 bzero (&font_match_pattern, sizeof (font_match_pattern));
181
182 dc = get_frame_dc (f);
183
184 EnumFontFamiliesEx (dc, &font_match_pattern,
185 (FONTENUMPROC) add_font_name_to_list,
186 (LPARAM) &list, 0);
187 release_frame_dc (f, dc);
188
189 return list;
190 }
191
192 /* w32 implementation of open for font backend.
193 Open a font specified by FONT_ENTITY on frame F.
194 If the font is scalable, open it with PIXEL_SIZE. */
195 static struct font *
196 w32font_open (f, font_entity, pixel_size)
197 FRAME_PTR f;
198 Lisp_Object font_entity;
199 int pixel_size;
200 {
201 struct w32font_info *w32_font = xmalloc (sizeof (struct w32font_info));
202
203 if (w32_font == NULL)
204 return NULL;
205
206 if (!w32font_open_internal (f, font_entity, pixel_size, w32_font))
207 {
208 xfree (w32_font);
209 return NULL;
210 }
211
212 return (struct font *) w32_font;
213 }
214
215 /* w32 implementation of close for font_backend.
216 Close FONT on frame F. */
217 void
218 w32font_close (f, font)
219 FRAME_PTR f;
220 struct font *font;
221 {
222 if (font->font.font)
223 {
224 W32FontStruct *old_w32_font = (W32FontStruct *)font->font.font;
225 DeleteObject (old_w32_font->hfont);
226 xfree (old_w32_font);
227 font->font.font = 0;
228 }
229
230 if (font->font.full_name && font->font.full_name != font->font.name)
231 xfree (font->font.full_name);
232
233 if (font->font.name)
234 xfree (font->font.name);
235
236 xfree (font);
237 }
238
239 /* w32 implementation of has_char for font backend.
240 Optional.
241 If FONT_ENTITY has a glyph for character C (Unicode code point),
242 return 1. If not, return 0. If a font must be opened to check
243 it, return -1. */
244 int
245 w32font_has_char (entity, c)
246 Lisp_Object entity;
247 int c;
248 {
249 Lisp_Object supported_scripts, extra, script;
250 DWORD mask;
251
252 extra = AREF (entity, FONT_EXTRA_INDEX);
253 if (!CONSP (extra))
254 return -1;
255
256 supported_scripts = assq_no_quit (QCscript, extra);
257 if (!CONSP (supported_scripts))
258 return -1;
259
260 supported_scripts = XCDR (supported_scripts);
261
262 script = CHAR_TABLE_REF (Vchar_script_table, c);
263
264 return (memq_no_quit (script, supported_scripts)) ? 1 : 0;
265 }
266
267 /* w32 implementation of encode_char for font backend.
268 Return a glyph code of FONT for characer C (Unicode code point).
269 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
270 unsigned
271 w32font_encode_char (font, c)
272 struct font *font;
273 int c;
274 {
275 /* Avoid unneccesary conversion - all the Win32 APIs will take a unicode
276 character. */
277 return c;
278 }
279
280 /* w32 implementation of text_extents for font backend.
281 Perform the size computation of glyphs of FONT and fillin members
282 of METRICS. The glyphs are specified by their glyph codes in
283 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
284 case just return the overall width. */
285 int
286 w32font_text_extents (font, code, nglyphs, metrics)
287 struct font *font;
288 unsigned *code;
289 int nglyphs;
290 struct font_metrics *metrics;
291 {
292 int i;
293 HFONT old_font;
294 HDC dc;
295 struct frame * f;
296 int total_width = 0;
297 WORD *wcode = alloca(nglyphs * sizeof (WORD));
298 SIZE size;
299
300 #if 0
301 /* Frames can come and go, and their fonts outlive them. This is
302 particularly troublesome with tooltip frames, and causes crashes. */
303 f = ((struct w32font_info *)font)->owning_frame;
304 #else
305 f = XFRAME (selected_frame);
306 #endif
307
308 dc = get_frame_dc (f);
309 old_font = SelectObject (dc, ((W32FontStruct *)(font->font.font))->hfont);
310
311 if (metrics)
312 {
313 GLYPHMETRICS gm;
314 MAT2 transform;
315
316 /* Set transform to the identity matrix. */
317 bzero (&transform, sizeof (transform));
318 transform.eM11.value = 1;
319 transform.eM22.value = 1;
320 metrics->width = 0;
321 metrics->ascent = 0;
322 metrics->descent = 0;
323
324 for (i = 0; i < nglyphs; i++)
325 {
326 if (GetGlyphOutlineW (dc, *(code + i), GGO_METRICS, &gm, 0,
327 NULL, &transform) != GDI_ERROR)
328 {
329 int new_val = metrics->width + gm.gmBlackBoxX
330 + gm.gmptGlyphOrigin.x;
331
332 metrics->rbearing = max (metrics->rbearing, new_val);
333 metrics->width += gm.gmCellIncX;
334 new_val = -gm.gmptGlyphOrigin.y;
335 metrics->ascent = max (metrics->ascent, new_val);
336 new_val = gm.gmBlackBoxY + gm.gmptGlyphOrigin.y;
337 metrics->descent = max (metrics->descent, new_val);
338 }
339 else
340 {
341 /* Rely on an estimate based on the overall font metrics. */
342 break;
343 }
344 }
345
346 /* If we got through everything, return. */
347 if (i == nglyphs)
348 {
349 /* Restore state and release DC. */
350 SelectObject (dc, old_font);
351 release_frame_dc (f, dc);
352
353 return metrics->width;
354 }
355 }
356
357 for (i = 0; i < nglyphs; i++)
358 {
359 if (code[i] < 0x10000)
360 wcode[i] = code[i];
361 else
362 {
363 /* TODO: Convert to surrogate, reallocating array if needed */
364 wcode[i] = 0xffff;
365 }
366 }
367
368 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
369 {
370 total_width = size.cx;
371 }
372
373 if (!total_width)
374 {
375 RECT rect;
376 rect.top = 0; rect.bottom = font->font.height; rect.left = 0; rect.right = 1;
377 DrawTextW (dc, wcode, nglyphs, &rect,
378 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
379 total_width = rect.right;
380 }
381
382 if (metrics)
383 {
384 metrics->width = total_width;
385 metrics->ascent = font->ascent;
386 metrics->descent = font->descent;
387 metrics->lbearing = 0;
388 metrics->rbearing = total_width
389 + ((struct w32font_info *) font)->metrics.tmOverhang;
390 }
391
392 /* Restore state and release DC. */
393 SelectObject (dc, old_font);
394 release_frame_dc (f, dc);
395
396 return total_width;
397 }
398
399 /* w32 implementation of draw for font backend.
400 Optional.
401 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
402 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
403 is nonzero, fill the background in advance. It is assured that
404 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
405
406 TODO: Currently this assumes that the colors and fonts are already
407 set in the DC. This seems to be true now, but maybe only due to
408 the old font code setting it up. It may be safer to resolve faces
409 and fonts in here and set them explicitly
410 */
411
412 int
413 w32font_draw (s, from, to, x, y, with_background)
414 struct glyph_string *s;
415 int from, to, x, y, with_background;
416 {
417 UINT options = 0;
418 HRGN orig_clip;
419
420 /* Save clip region for later restoration. */
421 GetClipRgn(s->hdc, orig_clip);
422
423 if (s->num_clips > 0)
424 {
425 HRGN new_clip = CreateRectRgnIndirect (s->clip);
426
427 if (s->num_clips > 1)
428 {
429 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
430
431 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
432 DeleteObject (clip2);
433 }
434
435 SelectClipRgn (s->hdc, new_clip);
436 DeleteObject (new_clip);
437 }
438
439 /* Using OPAQUE background mode can clear more background than expected
440 when Cleartype is used. Draw the background manually to avoid this. */
441 SetBkMode (s->hdc, TRANSPARENT);
442 if (with_background)
443 {
444 HBRUSH brush;
445 RECT rect;
446 struct font *font = (struct font *) s->face->font_info;
447
448 brush = CreateSolidBrush (s->gc->background);
449 rect.left = x;
450 rect.top = y - font->ascent;
451 rect.right = x + s->width;
452 rect.bottom = y + font->descent;
453 FillRect (s->hdc, &rect, brush);
454 DeleteObject (brush);
455 }
456
457 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, to - from, NULL);
458
459 /* Restore clip region. */
460 if (s->num_clips > 0)
461 {
462 SelectClipRgn (s->hdc, orig_clip);
463 }
464 }
465
466 /* w32 implementation of free_entity for font backend.
467 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
468 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
469 static void
470 w32font_free_entity (Lisp_Object entity);
471 */
472
473 /* w32 implementation of prepare_face for font backend.
474 Optional (if FACE->extra is not used).
475 Prepare FACE for displaying characters by FONT on frame F by
476 storing some data in FACE->extra. If successful, return 0.
477 Otherwise, return -1.
478 static int
479 w32font_prepare_face (FRAME_PTR f, struct face *face);
480 */
481 /* w32 implementation of done_face for font backend.
482 Optional.
483 Done FACE for displaying characters by FACE->font on frame F.
484 static void
485 w32font_done_face (FRAME_PTR f, struct face *face); */
486
487 /* w32 implementation of get_bitmap for font backend.
488 Optional.
489 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
490 intended that this method is called from the other font-driver
491 for actual drawing.
492 static int
493 w32font_get_bitmap (struct font *font, unsigned code,
494 struct font_bitmap *bitmap, int bits_per_pixel);
495 */
496 /* w32 implementation of free_bitmap for font backend.
497 Optional.
498 Free bitmap data in BITMAP.
499 static void
500 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
501 */
502 /* w32 implementation of get_outline for font backend.
503 Optional.
504 Return an outline data for glyph-code CODE of FONT. The format
505 of the outline data depends on the font-driver.
506 static void *
507 w32font_get_outline (struct font *font, unsigned code);
508 */
509 /* w32 implementation of free_outline for font backend.
510 Optional.
511 Free OUTLINE (that is obtained by the above method).
512 static void
513 w32font_free_outline (struct font *font, void *outline);
514 */
515 /* w32 implementation of anchor_point for font backend.
516 Optional.
517 Get coordinates of the INDEXth anchor point of the glyph whose
518 code is CODE. Store the coordinates in *X and *Y. Return 0 if
519 the operations was successfull. Otherwise return -1.
520 static int
521 w32font_anchor_point (struct font *font, unsigned code,
522 int index, int *x, int *y);
523 */
524 /* w32 implementation of otf_capability for font backend.
525 Optional.
526 Return a list describing which scripts/languages FONT
527 supports by which GSUB/GPOS features of OpenType tables.
528 static Lisp_Object
529 w32font_otf_capability (struct font *font);
530 */
531 /* w32 implementation of otf_drive for font backend.
532 Optional.
533 Apply FONT's OTF-FEATURES to the glyph string.
534
535 FEATURES specifies which OTF features to apply in this format:
536 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
537 See the documentation of `font-drive-otf' for the detail.
538
539 This method applies the specified features to the codes in the
540 elements of GSTRING-IN (between FROMth and TOth). The output
541 codes are stored in GSTRING-OUT at the IDXth element and the
542 following elements.
543
544 Return the number of output codes. If none of the features are
545 applicable to the input data, return 0. If GSTRING-OUT is too
546 short, return -1.
547 static int
548 w32font_otf_drive (struct font *font, Lisp_Object features,
549 Lisp_Object gstring_in, int from, int to,
550 Lisp_Object gstring_out, int idx,
551 int alternate_subst);
552 */
553
554 /* Internal implementation of w32font_list.
555 Additional parameter opentype_only restricts the returned fonts to
556 opentype fonts, which can be used with the Uniscribe backend. */
557 Lisp_Object
558 w32font_list_internal (frame, font_spec, opentype_only)
559 Lisp_Object frame, font_spec;
560 int opentype_only;
561 {
562 struct font_callback_data match_data;
563 HDC dc;
564 FRAME_PTR f = XFRAME (frame);
565
566 match_data.orig_font_spec = font_spec;
567 match_data.list = Qnil;
568 match_data.frame = frame;
569
570 bzero (&match_data.pattern, sizeof (LOGFONT));
571 fill_in_logfont (f, &match_data.pattern, font_spec);
572
573 match_data.opentype_only = opentype_only;
574 if (opentype_only)
575 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
576
577 if (match_data.pattern.lfFaceName[0] == '\0')
578 {
579 /* EnumFontFamiliesEx does not take other fields into account if
580 font name is blank, so need to use two passes. */
581 list_all_matching_fonts (&match_data);
582 }
583 else
584 {
585 dc = get_frame_dc (f);
586
587 EnumFontFamiliesEx (dc, &match_data.pattern,
588 (FONTENUMPROC) add_font_entity_to_list,
589 (LPARAM) &match_data, 0);
590 release_frame_dc (f, dc);
591 }
592
593 return NILP (match_data.list) ? null_vector : Fvconcat (1, &match_data.list);
594 }
595
596 /* Internal implementation of w32font_match.
597 Additional parameter opentype_only restricts the returned fonts to
598 opentype fonts, which can be used with the Uniscribe backend. */
599 Lisp_Object
600 w32font_match_internal (frame, font_spec, opentype_only)
601 Lisp_Object frame, font_spec;
602 int opentype_only;
603 {
604 struct font_callback_data match_data;
605 HDC dc;
606 FRAME_PTR f = XFRAME (frame);
607
608 match_data.orig_font_spec = font_spec;
609 match_data.frame = frame;
610 match_data.list = Qnil;
611
612 bzero (&match_data.pattern, sizeof (LOGFONT));
613 fill_in_logfont (f, &match_data.pattern, font_spec);
614
615 match_data.opentype_only = opentype_only;
616 if (opentype_only)
617 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
618
619 dc = get_frame_dc (f);
620
621 EnumFontFamiliesEx (dc, &match_data.pattern,
622 (FONTENUMPROC) add_one_font_entity_to_list,
623 (LPARAM) &match_data, 0);
624 release_frame_dc (f, dc);
625
626 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
627 }
628
629 int
630 w32font_open_internal (f, font_entity, pixel_size, w32_font)
631 FRAME_PTR f;
632 Lisp_Object font_entity;
633 int pixel_size;
634 struct w32font_info *w32_font;
635 {
636 int len, size;
637 LOGFONT logfont;
638 HDC dc;
639 HFONT hfont, old_font;
640 Lisp_Object val, extra;
641 /* For backwards compatibility. */
642 W32FontStruct *compat_w32_font;
643
644 struct font * font = (struct font *) w32_font;
645 if (!font)
646 return 0;
647
648 bzero (&logfont, sizeof (logfont));
649 fill_in_logfont (f, &logfont, font_entity);
650
651 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
652 if (!size)
653 size = pixel_size;
654
655 logfont.lfHeight = -size;
656 hfont = CreateFontIndirect (&logfont);
657
658 if (hfont == NULL)
659 return 0;
660
661 w32_font->owning_frame = f;
662
663 /* Get the metrics for this font. */
664 dc = get_frame_dc (f);
665 old_font = SelectObject (dc, hfont);
666
667 GetTextMetrics (dc, &w32_font->metrics);
668
669 SelectObject (dc, old_font);
670 release_frame_dc (f, dc);
671 /* W32FontStruct - we should get rid of this, and use the w32font_info
672 struct for any W32 specific fields. font->font.font can then be hfont. */
673 font->font.font = xmalloc (sizeof (W32FontStruct));
674 compat_w32_font = (W32FontStruct *) font->font.font;
675 bzero (compat_w32_font, sizeof (W32FontStruct));
676 compat_w32_font->font_type = UNICODE_FONT;
677 /* Duplicate the text metrics. */
678 bcopy (&w32_font->metrics, &compat_w32_font->tm, sizeof (TEXTMETRIC));
679 compat_w32_font->hfont = hfont;
680
681 len = strlen (logfont.lfFaceName);
682 font->font.name = (char *) xmalloc (len + 1);
683 bcopy (logfont.lfFaceName, font->font.name, len);
684 font->font.name[len] = '\0';
685
686 {
687 char *name;
688
689 /* We don't know how much space we need for the full name, so start with
690 96 bytes and go up in steps of 32. */
691 len = 96;
692 name = malloc (len);
693 while (name && font_unparse_fcname (font_entity, pixel_size, name, len) < 0)
694 {
695 char *new = realloc (name, len += 32);
696
697 if (! new)
698 free (name);
699 name = new;
700 }
701 if (name)
702 font->font.full_name = name;
703 else
704 font->font.full_name = font->font.name;
705 }
706 font->font.charset = 0;
707 font->font.codepage = 0;
708 font->font.size = w32_font->metrics.tmMaxCharWidth;
709 font->font.height = w32_font->metrics.tmHeight
710 + w32_font->metrics.tmExternalLeading;
711 font->font.space_width = font->font.average_width
712 = w32_font->metrics.tmAveCharWidth;
713
714 font->font.vertical_centering = 0;
715 font->font.encoding_type = 0;
716 font->font.baseline_offset = 0;
717 font->font.relative_compose = 0;
718 font->font.default_ascent = w32_font->metrics.tmAscent;
719 font->font.font_encoder = NULL;
720 font->entity = font_entity;
721 font->pixel_size = size;
722 font->driver = &w32font_driver;
723 font->format = Qgdi;
724 font->file_name = NULL;
725 font->encoding_charset = -1;
726 font->repertory_charset = -1;
727 font->min_width = 0;
728 font->ascent = w32_font->metrics.tmAscent;
729 font->descent = w32_font->metrics.tmDescent;
730 font->scalable = w32_font->metrics.tmPitchAndFamily & TMPF_VECTOR;
731
732 return 1;
733 }
734
735 /* Callback function for EnumFontFamiliesEx.
736 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
737 static int CALLBACK
738 add_font_name_to_list (logical_font, physical_font, font_type, list_object)
739 ENUMLOGFONTEX *logical_font;
740 NEWTEXTMETRICEX *physical_font;
741 DWORD font_type;
742 LPARAM list_object;
743 {
744 Lisp_Object* list = (Lisp_Object *) list_object;
745 Lisp_Object family;
746
747 /* Skip vertical fonts (intended only for printing) */
748 if (logical_font->elfLogFont.lfFaceName[0] == '@')
749 return 1;
750
751 family = intern_downcase (logical_font->elfLogFont.lfFaceName,
752 strlen (logical_font->elfLogFont.lfFaceName));
753 if (! memq_no_quit (family, *list))
754 *list = Fcons (family, *list);
755
756 return 1;
757 }
758
759 /* Convert an enumerated Windows font to an Emacs font entity. */
760 static Lisp_Object
761 w32_enumfont_pattern_entity (frame, logical_font, physical_font,
762 font_type, requested_font)
763 Lisp_Object frame;
764 ENUMLOGFONTEX *logical_font;
765 NEWTEXTMETRICEX *physical_font;
766 DWORD font_type;
767 LOGFONT *requested_font;
768 {
769 Lisp_Object entity, tem;
770 LOGFONT *lf = (LOGFONT*) logical_font;
771 BYTE generic_type;
772
773 entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil);
774
775 ASET (entity, FONT_TYPE_INDEX, Qgdi);
776 ASET (entity, FONT_FRAME_INDEX, frame);
777 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet));
778 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
779
780 /* Foundry is difficult to get in readable form on Windows.
781 But Emacs crashes if it is not set, so set it to something more
782 generic. Thes values make xflds compatible with Emacs 22. */
783 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
784 tem = Qraster;
785 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
786 tem = Qoutline;
787 else
788 tem = Qunknown;
789
790 ASET (entity, FONT_FOUNDRY_INDEX, tem);
791
792 /* Save the generic family in the extra info, as it is likely to be
793 useful to users looking for a close match. */
794 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
795 if (generic_type == FF_DECORATIVE)
796 tem = Qdecorative;
797 else if (generic_type == FF_MODERN)
798 tem = Qmono;
799 else if (generic_type == FF_ROMAN)
800 tem = Qserif;
801 else if (generic_type == FF_SCRIPT)
802 tem = Qscript;
803 else if (generic_type == FF_SWISS)
804 tem = Qsans;
805 else
806 tem = null_string;
807
808 ASET (entity, FONT_ADSTYLE_INDEX, tem);
809
810 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
811 font_put_extra (entity, QCspacing, make_number (FONT_SPACING_PROPORTIONAL));
812 else
813 font_put_extra (entity, QCspacing, make_number (FONT_SPACING_MONO));
814
815 if (requested_font->lfQuality != DEFAULT_QUALITY)
816 {
817 font_put_extra (entity, QCantialias,
818 lispy_antialias_type (requested_font->lfQuality));
819 }
820 ASET (entity, FONT_FAMILY_INDEX,
821 intern_downcase (lf->lfFaceName, strlen (lf->lfFaceName)));
822
823 ASET (entity, FONT_WEIGHT_INDEX, make_number (lf->lfWeight));
824 ASET (entity, FONT_SLANT_INDEX, make_number (lf->lfItalic ? 200 : 100));
825 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
826 to get it. */
827 ASET (entity, FONT_WIDTH_INDEX, make_number (100));
828
829 if (font_type & RASTER_FONTTYPE)
830 ASET (entity, FONT_SIZE_INDEX, make_number (physical_font->ntmTm.tmHeight));
831 else
832 ASET (entity, FONT_SIZE_INDEX, make_number (0));
833
834 /* Cache unicode codepoints covered by this font, as there is no other way
835 of getting this information easily. */
836 if (font_type & TRUETYPE_FONTTYPE)
837 {
838 font_put_extra (entity, QCscript,
839 font_supported_scripts (&physical_font->ntmFontSig));
840 }
841
842 return entity;
843 }
844
845
846 /* Convert generic families to the family portion of lfPitchAndFamily. */
847 BYTE
848 w32_generic_family (Lisp_Object name)
849 {
850 /* Generic families. */
851 if (EQ (name, Qmonospace) || EQ (name, Qmono))
852 return FF_MODERN;
853 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
854 return FF_SWISS;
855 else if (EQ (name, Qserif))
856 return FF_ROMAN;
857 else if (EQ (name, Qdecorative))
858 return FF_DECORATIVE;
859 else if (EQ (name, Qscript))
860 return FF_SCRIPT;
861 else
862 return FF_DONTCARE;
863 }
864
865 static int
866 logfonts_match (font, pattern)
867 LOGFONT *font, *pattern;
868 {
869 /* Only check height for raster fonts. */
870 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
871 && font->lfHeight != pattern->lfHeight)
872 return 0;
873
874 /* Have some flexibility with weights. */
875 if (pattern->lfWeight
876 && ((font->lfWeight < (pattern->lfWeight - 150))
877 || font->lfWeight > (pattern->lfWeight + 150)))
878 return 0;
879
880 /* Charset and face should be OK. Italic has to be checked
881 against the original spec, in case we don't have any preference. */
882 return 1;
883 }
884
885 static int
886 font_matches_spec (type, font, spec)
887 DWORD type;
888 NEWTEXTMETRICEX *font;
889 Lisp_Object spec;
890 {
891 Lisp_Object extra, val;
892
893 /* Check italic. Can't check logfonts, since it is a boolean field,
894 so there is no difference between "non-italic" and "don't care". */
895 val = AREF (spec, FONT_SLANT_INDEX);
896 if (INTEGERP (val))
897 {
898 int slant = XINT (val);
899 if ((slant > 150 && !font->ntmTm.tmItalic)
900 || (slant <= 150 && font->ntmTm.tmItalic))
901 return 0;
902 }
903
904 /* Check adstyle against generic family. */
905 val = AREF (spec, FONT_ADSTYLE_INDEX);
906 if (!NILP (val))
907 {
908 BYTE family = w32_generic_family (val);
909 if (family != FF_DONTCARE
910 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
911 return 0;
912 }
913
914 /* Check extra parameters. */
915 for (extra = AREF (spec, FONT_EXTRA_INDEX);
916 CONSP (extra); extra = XCDR (extra))
917 {
918 Lisp_Object extra_entry;
919 extra_entry = XCAR (extra);
920 if (CONSP (extra_entry))
921 {
922 Lisp_Object key = XCAR (extra_entry);
923 val = XCDR (extra_entry);
924 if (EQ (key, QCspacing))
925 {
926 int proportional;
927 if (INTEGERP (val))
928 {
929 int spacing = XINT (val);
930 proportional = (spacing < FONT_SPACING_MONO);
931 }
932 else if (EQ (val, Qp))
933 proportional = 1;
934 else if (EQ (val, Qc) || EQ (val, Qm))
935 proportional = 0;
936 else
937 return 0; /* Bad font spec. */
938
939 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
940 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
941 return 0;
942 }
943 else if (EQ (key, QCscript) && SYMBOLP (val))
944 {
945 /* Only truetype fonts will have information about what
946 scripts they support. This probably means the user
947 will have to force Emacs to use raster, postscript
948 or atm fonts for non-ASCII text. */
949 if (type & TRUETYPE_FONTTYPE)
950 {
951 Lisp_Object support
952 = font_supported_scripts (&font->ntmFontSig);
953 if (! memq_no_quit (val, support))
954 return 0;
955 }
956 else
957 {
958 /* Return specific matches, but play it safe. Fonts
959 that cover more than their charset would suggest
960 are likely to be truetype or opentype fonts,
961 covered above. */
962 if (EQ (val, Qlatin))
963 {
964 /* Although every charset but symbol, thai and
965 arabic contains the basic ASCII set of latin
966 characters, Emacs expects much more. */
967 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
968 return 0;
969 }
970 else if (EQ (val, Qsymbol))
971 {
972 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
973 return 0;
974 }
975 else if (EQ (val, Qcyrillic))
976 {
977 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
978 return 0;
979 }
980 else if (EQ (val, Qgreek))
981 {
982 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
983 return 0;
984 }
985 else if (EQ (val, Qarabic))
986 {
987 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
988 return 0;
989 }
990 else if (EQ (val, Qhebrew))
991 {
992 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
993 return 0;
994 }
995 else if (EQ (val, Qthai))
996 {
997 if (font->ntmTm.tmCharSet != THAI_CHARSET)
998 return 0;
999 }
1000 else if (EQ (val, Qkana))
1001 {
1002 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1003 return 0;
1004 }
1005 else if (EQ (val, Qbopomofo))
1006 {
1007 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1008 return 0;
1009 }
1010 else if (EQ (val, Qhangul))
1011 {
1012 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1013 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1014 return 0;
1015 }
1016 else if (EQ (val, Qhan))
1017 {
1018 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1019 && font->ntmTm.tmCharSet != GB2312_CHARSET
1020 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1021 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1022 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1023 return 0;
1024 }
1025 else
1026 /* Other scripts unlikely to be handled. */
1027 return 0;
1028 }
1029 }
1030 }
1031 }
1032 return 1;
1033 }
1034
1035 /* Callback function for EnumFontFamiliesEx.
1036 * Checks if a font matches everything we are trying to check agaist,
1037 * and if so, adds it to a list. Both the data we are checking against
1038 * and the list to which the fonts are added are passed in via the
1039 * lparam argument, in the form of a font_callback_data struct. */
1040 static int CALLBACK
1041 add_font_entity_to_list (logical_font, physical_font, font_type, lParam)
1042 ENUMLOGFONTEX *logical_font;
1043 NEWTEXTMETRICEX *physical_font;
1044 DWORD font_type;
1045 LPARAM lParam;
1046 {
1047 struct font_callback_data *match_data
1048 = (struct font_callback_data *) lParam;
1049
1050 if ((!match_data->opentype_only
1051 || (physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE))
1052 && logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1053 && font_matches_spec (font_type, physical_font,
1054 match_data->orig_font_spec)
1055 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1056 We limit this to raster fonts, because the test can catch some
1057 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1058 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1059 therefore get through this test. Since full names can be prefixed
1060 by a foundry, we accept raster fonts if the font name is found
1061 anywhere within the full name. */
1062 && (logical_font->elfLogFont.lfOutPrecision != OUT_STRING_PRECIS
1063 || strstr (logical_font->elfFullName,
1064 logical_font->elfLogFont.lfFaceName)))
1065 {
1066 Lisp_Object entity
1067 = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1068 physical_font, font_type,
1069 &match_data->pattern);
1070 if (!NILP (entity))
1071 match_data->list = Fcons (entity, match_data->list);
1072 }
1073 return 1;
1074 }
1075
1076 /* Callback function for EnumFontFamiliesEx.
1077 * Terminates the search once we have a match. */
1078 static int CALLBACK
1079 add_one_font_entity_to_list (logical_font, physical_font, font_type, lParam)
1080 ENUMLOGFONTEX *logical_font;
1081 NEWTEXTMETRICEX *physical_font;
1082 DWORD font_type;
1083 LPARAM lParam;
1084 {
1085 struct font_callback_data *match_data
1086 = (struct font_callback_data *) lParam;
1087 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1088
1089 /* If we have a font in the list, terminate the search. */
1090 return !NILP (match_data->list);
1091 }
1092
1093 /* Convert a Lisp font registry (symbol) to a windows charset. */
1094 static LONG
1095 registry_to_w32_charset (charset)
1096 Lisp_Object charset;
1097 {
1098 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1099 || EQ (charset, Qunicode_sip))
1100 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1101 else if (EQ (charset, Qiso8859_1))
1102 return ANSI_CHARSET;
1103 else if (SYMBOLP (charset))
1104 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
1105 else if (STRINGP (charset))
1106 return x_to_w32_charset (SDATA (charset));
1107 else
1108 return DEFAULT_CHARSET;
1109 }
1110
1111 static Lisp_Object
1112 w32_registry (w32_charset)
1113 LONG w32_charset;
1114 {
1115 if (w32_charset == ANSI_CHARSET)
1116 return Qiso10646_1;
1117 else
1118 {
1119 char * charset = w32_to_x_charset (w32_charset, NULL);
1120 return intern_downcase (charset, strlen(charset));
1121 }
1122 }
1123
1124 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1125 static void
1126 fill_in_logfont (f, logfont, font_spec)
1127 FRAME_PTR f;
1128 LOGFONT *logfont;
1129 Lisp_Object font_spec;
1130 {
1131 Lisp_Object tmp, extra;
1132 int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
1133
1134 extra = AREF (font_spec, FONT_EXTRA_INDEX);
1135 /* Allow user to override dpi settings. */
1136 if (CONSP (extra))
1137 {
1138 tmp = assq_no_quit (QCdpi, extra);
1139 if (CONSP (tmp) && INTEGERP (XCDR (tmp)))
1140 {
1141 dpi = XINT (XCDR (tmp));
1142 }
1143 else if (CONSP (tmp) && FLOATP (XCDR (tmp)))
1144 {
1145 dpi = (int) (XFLOAT_DATA (XCDR (tmp)) + 0.5);
1146 }
1147 }
1148
1149 /* Height */
1150 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1151 if (INTEGERP (tmp))
1152 logfont->lfHeight = -1 * XINT (tmp);
1153 else if (FLOATP (tmp))
1154 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
1155
1156 /* Escapement */
1157
1158 /* Orientation */
1159
1160 /* Weight */
1161 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1162 if (INTEGERP (tmp))
1163 logfont->lfWeight = XINT (tmp);
1164
1165 /* Italic */
1166 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1167 if (INTEGERP (tmp))
1168 {
1169 int slant = XINT (tmp);
1170 logfont->lfItalic = slant > 150 ? 1 : 0;
1171 }
1172
1173 /* Underline */
1174
1175 /* Strikeout */
1176
1177 /* Charset */
1178 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
1179 if (! NILP (tmp))
1180 logfont->lfCharSet = registry_to_w32_charset (tmp);
1181
1182 /* Out Precision */
1183
1184 /* Clip Precision */
1185
1186 /* Quality */
1187 logfont->lfQuality = DEFAULT_QUALITY;
1188
1189 /* Generic Family and Face Name */
1190 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
1191
1192 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
1193 if (! NILP (tmp))
1194 {
1195 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
1196 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
1197 ; /* Font name was generic, don't fill in font name. */
1198 /* Font families are interned, but allow for strings also in case of
1199 user input. */
1200 else if (SYMBOLP (tmp))
1201 strncpy (logfont->lfFaceName, SDATA (SYMBOL_NAME (tmp)), LF_FACESIZE);
1202 else if (STRINGP (tmp))
1203 strncpy (logfont->lfFaceName, SDATA (tmp), LF_FACESIZE);
1204 }
1205
1206 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
1207 if (!NILP (tmp))
1208 {
1209 /* Override generic family. */
1210 BYTE family = w32_generic_family (tmp);
1211 if (family != FF_DONTCARE)
1212 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
1213 }
1214
1215 /* Process EXTRA info. */
1216 for ( ; CONSP (extra); extra = XCDR (extra))
1217 {
1218 tmp = XCAR (extra);
1219 if (CONSP (tmp))
1220 {
1221 Lisp_Object key, val;
1222 key = XCAR (tmp), val = XCDR (tmp);
1223 if (EQ (key, QCspacing))
1224 {
1225 /* Set pitch based on the spacing property. */
1226 if (INTEGERP (val))
1227 {
1228 int spacing = XINT (val);
1229 if (spacing < FONT_SPACING_MONO)
1230 logfont->lfPitchAndFamily
1231 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
1232 else
1233 logfont->lfPitchAndFamily
1234 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
1235 }
1236 else if (EQ (val, Qp))
1237 logfont->lfPitchAndFamily
1238 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
1239 else if (EQ (val, Qc) || EQ (val, Qm))
1240 logfont->lfPitchAndFamily
1241 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
1242 }
1243 /* Only use QCscript if charset is not provided, or is unicode
1244 and a single script is specified. This is rather crude,
1245 and is only used to narrow down the fonts returned where
1246 there is a definite match. Some scripts, such as latin, han,
1247 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1248 them. */
1249 else if (EQ (key, QCscript)
1250 && logfont->lfCharSet == DEFAULT_CHARSET
1251 && SYMBOLP (val))
1252 {
1253 if (EQ (val, Qgreek))
1254 logfont->lfCharSet = GREEK_CHARSET;
1255 else if (EQ (val, Qhangul))
1256 logfont->lfCharSet = HANGUL_CHARSET;
1257 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
1258 logfont->lfCharSet = SHIFTJIS_CHARSET;
1259 else if (EQ (val, Qbopomofo))
1260 logfont->lfCharSet = CHINESEBIG5_CHARSET;
1261 /* GB 18030 supports tibetan, yi, mongolian,
1262 fonts that support it should show up if we ask for
1263 GB2312 fonts. */
1264 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
1265 || EQ (val, Qmongolian))
1266 logfont->lfCharSet = GB2312_CHARSET;
1267 else if (EQ (val, Qhebrew))
1268 logfont->lfCharSet = HEBREW_CHARSET;
1269 else if (EQ (val, Qarabic))
1270 logfont->lfCharSet = ARABIC_CHARSET;
1271 else if (EQ (val, Qthai))
1272 logfont->lfCharSet = THAI_CHARSET;
1273 else if (EQ (val, Qsymbol))
1274 logfont->lfCharSet = SYMBOL_CHARSET;
1275 }
1276 else if (EQ (key, QCantialias) && SYMBOLP (val))
1277 {
1278 logfont->lfQuality = w32_antialias_type (val);
1279 }
1280 }
1281 }
1282 }
1283
1284 static void
1285 list_all_matching_fonts (match_data)
1286 struct font_callback_data *match_data;
1287 {
1288 HDC dc;
1289 Lisp_Object families = w32font_list_family (match_data->frame);
1290 struct frame *f = XFRAME (match_data->frame);
1291
1292 dc = get_frame_dc (f);
1293
1294 while (!NILP (families))
1295 {
1296 /* TODO: Use the Unicode versions of the W32 APIs, so we can
1297 handle non-ASCII font names. */
1298 char *name;
1299 Lisp_Object family = CAR (families);
1300 families = CDR (families);
1301 if (NILP (family))
1302 continue;
1303 else if (STRINGP (family))
1304 name = SDATA (family);
1305 else
1306 name = SDATA (SYMBOL_NAME (family));
1307
1308 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
1309 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
1310
1311 EnumFontFamiliesEx (dc, &match_data->pattern,
1312 (FONTENUMPROC) add_font_entity_to_list,
1313 (LPARAM) match_data, 0);
1314 }
1315
1316 release_frame_dc (f, dc);
1317 }
1318
1319 static Lisp_Object
1320 lispy_antialias_type (type)
1321 BYTE type;
1322 {
1323 Lisp_Object lispy;
1324
1325 switch (type)
1326 {
1327 case NONANTIALIASED_QUALITY:
1328 lispy = Qnone;
1329 break;
1330 case ANTIALIASED_QUALITY:
1331 lispy = Qstandard;
1332 break;
1333 case CLEARTYPE_QUALITY:
1334 lispy = Qsubpixel;
1335 break;
1336 case CLEARTYPE_NATURAL_QUALITY:
1337 lispy = Qnatural;
1338 break;
1339 default:
1340 lispy = Qnil;
1341 break;
1342 }
1343 return lispy;
1344 }
1345
1346 /* Convert antialiasing symbols to lfQuality */
1347 static BYTE
1348 w32_antialias_type (type)
1349 Lisp_Object type;
1350 {
1351 if (EQ (type, Qnone))
1352 return NONANTIALIASED_QUALITY;
1353 else if (EQ (type, Qstandard))
1354 return ANTIALIASED_QUALITY;
1355 else if (EQ (type, Qsubpixel))
1356 return CLEARTYPE_QUALITY;
1357 else if (EQ (type, Qnatural))
1358 return CLEARTYPE_NATURAL_QUALITY;
1359 else
1360 return DEFAULT_QUALITY;
1361 }
1362
1363 /* Return a list of all the scripts that the font supports. */
1364 static Lisp_Object
1365 font_supported_scripts (FONTSIGNATURE * sig)
1366 {
1367 DWORD * subranges = sig->fsUsb;
1368 Lisp_Object supported = Qnil;
1369
1370 /* Match a single subrange. SYM is set if bit N is set in subranges. */
1371 #define SUBRANGE(n,sym) \
1372 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
1373 supported = Fcons ((sym), supported)
1374
1375 /* Match multiple subranges. SYM is set if any MASK bit is set in
1376 subranges[0 - 3]. */
1377 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
1378 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
1379 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
1380 supported = Fcons ((sym), supported)
1381
1382 SUBRANGE (0, Qlatin); /* There are many others... */
1383
1384 SUBRANGE (7, Qgreek);
1385 SUBRANGE (8, Qcoptic);
1386 SUBRANGE (9, Qcyrillic);
1387 SUBRANGE (10, Qarmenian);
1388 SUBRANGE (11, Qhebrew);
1389 SUBRANGE (13, Qarabic);
1390 SUBRANGE (14, Qnko);
1391 SUBRANGE (15, Qdevanagari);
1392 SUBRANGE (16, Qbengali);
1393 SUBRANGE (17, Qgurmukhi);
1394 SUBRANGE (18, Qgujarati);
1395 SUBRANGE (19, Qoriya);
1396 SUBRANGE (20, Qtamil);
1397 SUBRANGE (21, Qtelugu);
1398 SUBRANGE (22, Qkannada);
1399 SUBRANGE (23, Qmalayalam);
1400 SUBRANGE (24, Qthai);
1401 SUBRANGE (25, Qlao);
1402 SUBRANGE (26, Qgeorgian);
1403
1404 SUBRANGE (48, Qcjk_misc);
1405 SUBRANGE (51, Qbopomofo);
1406 SUBRANGE (54, Qkanbun); /* Is this right? */
1407 SUBRANGE (56, Qhangul);
1408
1409 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
1410 SUBRANGE (59, Qideographic_description); /* Windows lumps this in */
1411
1412 SUBRANGE (70, Qtibetan);
1413 SUBRANGE (71, Qsyriac);
1414 SUBRANGE (72, Qthaana);
1415 SUBRANGE (73, Qsinhala);
1416 SUBRANGE (74, Qmyanmar);
1417 SUBRANGE (75, Qethiopic);
1418 SUBRANGE (76, Qcherokee);
1419 SUBRANGE (77, Qcanadian_aboriginal);
1420 SUBRANGE (78, Qogham);
1421 SUBRANGE (79, Qrunic);
1422 SUBRANGE (80, Qkhmer);
1423 SUBRANGE (81, Qmongolian);
1424 SUBRANGE (82, Qbraille);
1425 SUBRANGE (83, Qyi);
1426
1427 SUBRANGE (88, Qbyzantine_musical_symbol);
1428 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
1429
1430 SUBRANGE (89, Qmathematical);
1431
1432 /* Match either katakana or hiragana for kana. */
1433 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
1434
1435 /* There isn't really a main symbol range, so include symbol if any
1436 relevant range is set. */
1437 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
1438
1439 #undef SUBRANGE
1440 #undef MASK_ANY
1441
1442 return supported;
1443 }
1444
1445
1446 struct font_driver w32font_driver =
1447 {
1448 0, /* Qgdi */
1449 w32font_get_cache,
1450 w32font_list,
1451 w32font_match,
1452 w32font_list_family,
1453 NULL, /* free_entity */
1454 w32font_open,
1455 w32font_close,
1456 NULL, /* prepare_face */
1457 NULL, /* done_face */
1458 w32font_has_char,
1459 w32font_encode_char,
1460 w32font_text_extents,
1461 w32font_draw,
1462 NULL, /* get_bitmap */
1463 NULL, /* free_bitmap */
1464 NULL, /* get_outline */
1465 NULL, /* free_outline */
1466 NULL, /* anchor_point */
1467 NULL, /* otf_capability */
1468 NULL, /* otf_drive */
1469 NULL, /* start_for_frame */
1470 NULL, /* end_for_frame */
1471 NULL /* shape */
1472 };
1473
1474
1475 /* Initialize state that does not change between invocations. This is only
1476 called when Emacs is dumped. */
1477 void
1478 syms_of_w32font ()
1479 {
1480 DEFSYM (Qgdi, "gdi");
1481
1482 /* Generic font families. */
1483 DEFSYM (Qmonospace, "monospace");
1484 DEFSYM (Qserif, "serif");
1485 DEFSYM (Qsansserif, "sansserif");
1486 DEFSYM (Qscript, "script");
1487 DEFSYM (Qdecorative, "decorative");
1488 /* Aliases. */
1489 DEFSYM (Qsans_serif, "sans_serif");
1490 DEFSYM (Qsans, "sans");
1491 DEFSYM (Qmono, "mono");
1492
1493 /* Fake foundries. */
1494 DEFSYM (Qraster, "raster");
1495 DEFSYM (Qoutline, "outline");
1496 DEFSYM (Qunknown, "unknown");
1497
1498 /* Antialiasing. */
1499 DEFSYM (Qstandard, "standard");
1500 DEFSYM (Qsubpixel, "subpixel");
1501 DEFSYM (Qnatural, "natural");
1502
1503 /* Scripts */
1504 DEFSYM (Qlatin, "latin");
1505 DEFSYM (Qgreek, "greek");
1506 DEFSYM (Qcoptic, "coptic");
1507 DEFSYM (Qcyrillic, "cyrillic");
1508 DEFSYM (Qarmenian, "armenian");
1509 DEFSYM (Qhebrew, "hebrew");
1510 DEFSYM (Qarabic, "arabic");
1511 DEFSYM (Qsyriac, "syriac");
1512 DEFSYM (Qnko, "nko");
1513 DEFSYM (Qthaana, "thaana");
1514 DEFSYM (Qdevanagari, "devanagari");
1515 DEFSYM (Qbengali, "bengali");
1516 DEFSYM (Qgurmukhi, "gurmukhi");
1517 DEFSYM (Qgujarati, "gujarati");
1518 DEFSYM (Qoriya, "oriya");
1519 DEFSYM (Qtamil, "tamil");
1520 DEFSYM (Qtelugu, "telugu");
1521 DEFSYM (Qkannada, "kannada");
1522 DEFSYM (Qmalayalam, "malayalam");
1523 DEFSYM (Qsinhala, "sinhala");
1524 DEFSYM (Qthai, "thai");
1525 DEFSYM (Qlao, "lao");
1526 DEFSYM (Qtibetan, "tibetan");
1527 DEFSYM (Qmyanmar, "myanmar");
1528 DEFSYM (Qgeorgian, "georgian");
1529 DEFSYM (Qhangul, "hangul");
1530 DEFSYM (Qethiopic, "ethiopic");
1531 DEFSYM (Qcherokee, "cherokee");
1532 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
1533 DEFSYM (Qogham, "ogham");
1534 DEFSYM (Qrunic, "runic");
1535 DEFSYM (Qkhmer, "khmer");
1536 DEFSYM (Qmongolian, "mongolian");
1537 DEFSYM (Qsymbol, "symbol");
1538 DEFSYM (Qbraille, "braille");
1539 DEFSYM (Qhan, "han");
1540 DEFSYM (Qideographic_description, "ideographic-description");
1541 DEFSYM (Qcjk_misc, "cjk-misc");
1542 DEFSYM (Qkana, "kana");
1543 DEFSYM (Qbopomofo, "bopomofo");
1544 DEFSYM (Qkanbun, "kanbun");
1545 DEFSYM (Qyi, "yi");
1546 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
1547 DEFSYM (Qmusical_symbol, "musical-symbol");
1548 DEFSYM (Qmathematical, "mathematical");
1549
1550 w32font_driver.type = Qgdi;
1551 register_font_driver (&w32font_driver, NULL);
1552 }
1553
1554 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
1555 (do not change this comment) */