Tweak regexp in help-mode-finish
[bpt/emacs.git] / src / w32font.c
... / ...
CommitLineData
1/* Font backend for the Microsoft W32 API.
2 Copyright (C) 2007-2011 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software: you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation, either version 3 of the License, or
9(at your option) any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19#include <config.h>
20#include <windows.h>
21#include <math.h>
22#include <ctype.h>
23#include <commdlg.h>
24#include <setjmp.h>
25
26#include "lisp.h"
27#include "w32term.h"
28#include "frame.h"
29#include "dispextern.h"
30#include "character.h"
31#include "charset.h"
32#include "coding.h"
33#include "fontset.h"
34#include "font.h"
35#include "w32font.h"
36
37/* Cleartype available on Windows XP, cleartype_natural from XP SP1.
38 The latter does not try to fit cleartype smoothed fonts into the
39 same bounding box as the non-antialiased version of the font.
40 */
41#ifndef CLEARTYPE_QUALITY
42#define CLEARTYPE_QUALITY 5
43#endif
44#ifndef CLEARTYPE_NATURAL_QUALITY
45#define CLEARTYPE_NATURAL_QUALITY 6
46#endif
47
48/* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
49 of MSVC headers. */
50#ifndef VIETNAMESE_CHARSET
51#define VIETNAMESE_CHARSET 163
52#endif
53#ifndef JOHAB_CHARSET
54#define JOHAB_CHARSET 130
55#endif
56
57Lisp_Object Qgdi;
58Lisp_Object Quniscribe;
59static Lisp_Object QCformat;
60static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif;
61static Lisp_Object Qserif, Qscript, Qdecorative;
62static Lisp_Object Qraster, Qoutline, Qunknown;
63
64/* antialiasing */
65extern Lisp_Object Qnone; /* reuse from w32fns.c */
66static Lisp_Object Qstandard, Qsubpixel, Qnatural;
67
68/* languages */
69static Lisp_Object Qzh;
70
71/* scripts */
72static Lisp_Object Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
73static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
74static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
75static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
76static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
77static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
78static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
79static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
80static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
81static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
82/* Not defined in characters.el, but referenced in fontset.el. */
83static Lisp_Object Qbalinese, Qbuginese, Qbuhid, Qcuneiform, Qcypriot;
84static Lisp_Object Qdeseret, Qglagolitic, Qgothic, Qhanunoo, Qkharoshthi;
85static Lisp_Object Qlimbu, Qlinear_b, Qold_italic, Qold_persian, Qosmanya;
86static Lisp_Object Qphags_pa, Qphoenician, Qshavian, Qsyloti_nagri;
87static Lisp_Object Qtagalog, Qtagbanwa, Qtai_le, Qtifinagh, Qugaritic;
88
89/* W32 charsets: for use in Vw32_charset_info_alist. */
90static Lisp_Object Qw32_charset_ansi, Qw32_charset_default;
91static Lisp_Object Qw32_charset_symbol, Qw32_charset_shiftjis;
92static Lisp_Object Qw32_charset_hangeul, Qw32_charset_gb2312;
93static Lisp_Object Qw32_charset_chinesebig5, Qw32_charset_oem;
94static Lisp_Object Qw32_charset_easteurope, Qw32_charset_turkish;
95static Lisp_Object Qw32_charset_baltic, Qw32_charset_russian;
96static Lisp_Object Qw32_charset_arabic, Qw32_charset_greek;
97static Lisp_Object Qw32_charset_hebrew, Qw32_charset_vietnamese;
98static Lisp_Object Qw32_charset_thai, Qw32_charset_johab, Qw32_charset_mac;
99
100/* Font spacing symbols - defined in font.c. */
101extern Lisp_Object Qc, Qp, Qm;
102
103static void fill_in_logfont (FRAME_PTR, LOGFONT *, Lisp_Object);
104
105static BYTE w32_antialias_type (Lisp_Object);
106static Lisp_Object lispy_antialias_type (BYTE);
107
108static Lisp_Object font_supported_scripts (FONTSIGNATURE *);
109static int w32font_full_name (LOGFONT *, Lisp_Object, int, char *, int);
110static void compute_metrics (HDC, struct w32font_info *, unsigned int,
111 struct w32_metric_cache *);
112
113static Lisp_Object w32_registry (LONG, DWORD);
114
115/* EnumFontFamiliesEx callbacks. */
116static int CALLBACK add_font_entity_to_list (ENUMLOGFONTEX *,
117 NEWTEXTMETRICEX *,
118 DWORD, LPARAM);
119static int CALLBACK add_one_font_entity_to_list (ENUMLOGFONTEX *,
120 NEWTEXTMETRICEX *,
121 DWORD, LPARAM);
122static int CALLBACK add_font_name_to_list (ENUMLOGFONTEX *,
123 NEWTEXTMETRICEX *,
124 DWORD, LPARAM);
125
126/* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
127 of what we really want. */
128struct font_callback_data
129{
130 /* The logfont we are matching against. EnumFontFamiliesEx only matches
131 face name and charset, so we need to manually match everything else
132 in the callback function. */
133 LOGFONT pattern;
134 /* The original font spec or entity. */
135 Lisp_Object orig_font_spec;
136 /* The frame the font is being loaded on. */
137 Lisp_Object frame;
138 /* The list to add matches to. */
139 Lisp_Object list;
140 /* Whether to match only opentype fonts. */
141 int opentype_only;
142};
143
144/* Handles the problem that EnumFontFamiliesEx will not return all
145 style variations if the font name is not specified. */
146static void list_all_matching_fonts (struct font_callback_data *);
147
148
149static int
150memq_no_quit (Lisp_Object elt, Lisp_Object list)
151{
152 while (CONSP (list) && ! EQ (XCAR (list), elt))
153 list = XCDR (list);
154 return (CONSP (list));
155}
156
157Lisp_Object
158intern_font_name (char * string)
159{
160 Lisp_Object obarray, tem, str;
161 int len;
162
163 str = DECODE_SYSTEM (build_string (string));
164 len = SCHARS (str);
165
166 /* The following code is copied from the function intern (in lread.c). */
167 obarray = Vobarray;
168 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
169 obarray = check_obarray (obarray);
170 tem = oblookup (obarray, SDATA (str), len, len);
171 if (SYMBOLP (tem))
172 return tem;
173 return Fintern (str, obarray);
174}
175
176/* w32 implementation of get_cache for font backend.
177 Return a cache of font-entities on FRAME. The cache must be a
178 cons whose cdr part is the actual cache area. */
179Lisp_Object
180w32font_get_cache (FRAME_PTR f)
181{
182 struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
183
184 return (dpyinfo->name_list_element);
185}
186
187/* w32 implementation of list for font backend.
188 List fonts exactly matching with FONT_SPEC on FRAME. The value
189 is a vector of font-entities. This is the sole API that
190 allocates font-entities. */
191static Lisp_Object
192w32font_list (Lisp_Object frame, Lisp_Object font_spec)
193{
194 Lisp_Object fonts = w32font_list_internal (frame, font_spec, 0);
195 FONT_ADD_LOG ("w32font-list", font_spec, fonts);
196 return fonts;
197}
198
199/* w32 implementation of match for font backend.
200 Return a font entity most closely matching with FONT_SPEC on
201 FRAME. The closeness is detemined by the font backend, thus
202 `face-font-selection-order' is ignored here. */
203static Lisp_Object
204w32font_match (Lisp_Object frame, Lisp_Object font_spec)
205{
206 Lisp_Object entity = w32font_match_internal (frame, font_spec, 0);
207 FONT_ADD_LOG ("w32font-match", font_spec, entity);
208 return entity;
209}
210
211/* w32 implementation of list_family for font backend.
212 List available families. The value is a list of family names
213 (symbols). */
214static Lisp_Object
215w32font_list_family (Lisp_Object frame)
216{
217 Lisp_Object list = Qnil;
218 LOGFONT font_match_pattern;
219 HDC dc;
220 FRAME_PTR f = XFRAME (frame);
221
222 memset (&font_match_pattern, 0, sizeof (font_match_pattern));
223 font_match_pattern.lfCharSet = DEFAULT_CHARSET;
224
225 dc = get_frame_dc (f);
226
227 EnumFontFamiliesEx (dc, &font_match_pattern,
228 (FONTENUMPROC) add_font_name_to_list,
229 (LPARAM) &list, 0);
230 release_frame_dc (f, dc);
231
232 return list;
233}
234
235/* w32 implementation of open for font backend.
236 Open a font specified by FONT_ENTITY on frame F.
237 If the font is scalable, open it with PIXEL_SIZE. */
238static Lisp_Object
239w32font_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size)
240{
241 Lisp_Object font_object
242 = font_make_object (VECSIZE (struct w32font_info),
243 font_entity, pixel_size);
244 struct w32font_info *w32_font
245 = (struct w32font_info *) XFONT_OBJECT (font_object);
246
247 ASET (font_object, FONT_TYPE_INDEX, Qgdi);
248
249 if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
250 {
251 return Qnil;
252 }
253
254 /* GDI backend does not use glyph indices. */
255 w32_font->glyph_idx = 0;
256
257 return font_object;
258}
259
260/* w32 implementation of close for font_backend.
261 Close FONT on frame F. */
262void
263w32font_close (FRAME_PTR f, struct font *font)
264{
265 int i;
266 struct w32font_info *w32_font = (struct w32font_info *) font;
267
268 /* Delete the GDI font object. */
269 DeleteObject (w32_font->hfont);
270
271 /* Free all the cached metrics. */
272 if (w32_font->cached_metrics)
273 {
274 for (i = 0; i < w32_font->n_cache_blocks; i++)
275 {
276 xfree (w32_font->cached_metrics[i]);
277 }
278 xfree (w32_font->cached_metrics);
279 w32_font->cached_metrics = NULL;
280 }
281}
282
283/* w32 implementation of has_char for font backend.
284 Optional.
285 If FONT_ENTITY has a glyph for character C (Unicode code point),
286 return 1. If not, return 0. If a font must be opened to check
287 it, return -1. */
288int
289w32font_has_char (Lisp_Object entity, int c)
290{
291 /* We can't be certain about which characters a font will support until
292 we open it. Checking the scripts that the font supports turns out
293 to not be reliable. */
294 return -1;
295
296#if 0
297 Lisp_Object supported_scripts, extra, script;
298 DWORD mask;
299
300 extra = AREF (entity, FONT_EXTRA_INDEX);
301 if (!CONSP (extra))
302 return -1;
303
304 supported_scripts = assq_no_quit (QCscript, extra);
305 /* If font doesn't claim to support any scripts, then we can't be certain
306 until we open it. */
307 if (!CONSP (supported_scripts))
308 return -1;
309
310 supported_scripts = XCDR (supported_scripts);
311
312 script = CHAR_TABLE_REF (Vchar_script_table, c);
313
314 /* If we don't know what script the character is from, then we can't be
315 certain until we open it. Also if the font claims support for the script
316 the character is from, it may only have partial coverage, so we still
317 can't be certain until we open the font. */
318 if (NILP (script) || memq_no_quit (script, supported_scripts))
319 return -1;
320
321 /* Font reports what scripts it supports, and none of them are the script
322 the character is from. But we still can't be certain, as some fonts
323 will contain some/most/all of the characters in that script without
324 claiming support for it. */
325 return -1;
326#endif
327}
328
329/* w32 implementation of encode_char for font backend.
330 Return a glyph code of FONT for character C (Unicode code point).
331 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
332
333 For speed, the gdi backend uses unicode (Emacs calls encode_char
334 far too often for it to be efficient). But we still need to detect
335 which characters are not supported by the font.
336 */
337static unsigned
338w32font_encode_char (struct font *font, int c)
339{
340 struct w32font_info * w32_font = (struct w32font_info *)font;
341
342 if (c < w32_font->metrics.tmFirstChar
343 || c > w32_font->metrics.tmLastChar)
344 return FONT_INVALID_CODE;
345 else
346 return c;
347}
348
349/* w32 implementation of text_extents for font backend.
350 Perform the size computation of glyphs of FONT and fillin members
351 of METRICS. The glyphs are specified by their glyph codes in
352 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
353 case just return the overall width. */
354int
355w32font_text_extents (struct font *font, unsigned *code,
356 int nglyphs, struct font_metrics *metrics)
357{
358 int i;
359 HFONT old_font = NULL;
360 HDC dc = NULL;
361 struct frame * f;
362 int total_width = 0;
363 WORD *wcode;
364 SIZE size;
365
366 struct w32font_info *w32_font = (struct w32font_info *) font;
367
368 if (metrics)
369 {
370 memset (metrics, 0, sizeof (struct font_metrics));
371 metrics->ascent = font->ascent;
372 metrics->descent = font->descent;
373
374 for (i = 0; i < nglyphs; i++)
375 {
376 struct w32_metric_cache *char_metric;
377 int block = *(code + i) / CACHE_BLOCKSIZE;
378 int pos_in_block = *(code + i) % CACHE_BLOCKSIZE;
379
380 if (block >= w32_font->n_cache_blocks)
381 {
382 if (!w32_font->cached_metrics)
383 w32_font->cached_metrics
384 = xmalloc ((block + 1)
385 * sizeof (struct w32_metric_cache *));
386 else
387 w32_font->cached_metrics
388 = xrealloc (w32_font->cached_metrics,
389 (block + 1)
390 * sizeof (struct w32_metric_cache *));
391 memset (w32_font->cached_metrics + w32_font->n_cache_blocks, 0,
392 ((block + 1 - w32_font->n_cache_blocks)
393 * sizeof (struct w32_metric_cache *)));
394 w32_font->n_cache_blocks = block + 1;
395 }
396
397 if (!w32_font->cached_metrics[block])
398 {
399 w32_font->cached_metrics[block]
400 = xmalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
401 memset (w32_font->cached_metrics[block], 0,
402 CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
403 }
404
405 char_metric = w32_font->cached_metrics[block] + pos_in_block;
406
407 if (char_metric->status == W32METRIC_NO_ATTEMPT)
408 {
409 if (dc == NULL)
410 {
411 /* TODO: Frames can come and go, and their fonts
412 outlive them. So we can't cache the frame in the
413 font structure. Use selected_frame until the API
414 is updated to pass in a frame. */
415 f = XFRAME (selected_frame);
416
417 dc = get_frame_dc (f);
418 old_font = SelectObject (dc, w32_font->hfont);
419 }
420 compute_metrics (dc, w32_font, *(code + i), char_metric);
421 }
422
423 if (char_metric->status == W32METRIC_SUCCESS)
424 {
425 metrics->lbearing = min (metrics->lbearing,
426 metrics->width + char_metric->lbearing);
427 metrics->rbearing = max (metrics->rbearing,
428 metrics->width + char_metric->rbearing);
429 metrics->width += char_metric->width;
430 }
431 else
432 /* If we couldn't get metrics for a char,
433 use alternative method. */
434 break;
435 }
436 /* If we got through everything, return. */
437 if (i == nglyphs)
438 {
439 if (dc != NULL)
440 {
441 /* Restore state and release DC. */
442 SelectObject (dc, old_font);
443 release_frame_dc (f, dc);
444 }
445
446 return metrics->width;
447 }
448 }
449
450 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
451 fallback on other methods that will at least give some of the metric
452 information. */
453
454 /* Make array big enough to hold surrogates. */
455 wcode = alloca (nglyphs * sizeof (WORD) * 2);
456 for (i = 0; i < nglyphs; i++)
457 {
458 if (code[i] < 0x10000)
459 wcode[i] = code[i];
460 else
461 {
462 DWORD surrogate = code[i] - 0x10000;
463
464 /* High surrogate: U+D800 - U+DBFF. */
465 wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
466 /* Low surrogate: U+DC00 - U+DFFF. */
467 wcode[i] = 0xDC00 + (surrogate & 0x03FF);
468 /* An extra glyph. wcode is already double the size of code to
469 cope with this. */
470 nglyphs++;
471 }
472 }
473
474 if (dc == NULL)
475 {
476 /* TODO: Frames can come and go, and their fonts outlive
477 them. So we can't cache the frame in the font structure. Use
478 selected_frame until the API is updated to pass in a
479 frame. */
480 f = XFRAME (selected_frame);
481
482 dc = get_frame_dc (f);
483 old_font = SelectObject (dc, w32_font->hfont);
484 }
485
486 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
487 {
488 total_width = size.cx;
489 }
490
491 /* On 95/98/ME, only some unicode functions are available, so fallback
492 on doing a dummy draw to find the total width. */
493 if (!total_width)
494 {
495 RECT rect;
496 rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
497 DrawTextW (dc, wcode, nglyphs, &rect,
498 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
499 total_width = rect.right;
500 }
501
502 /* Give our best estimate of the metrics, based on what we know. */
503 if (metrics)
504 {
505 metrics->width = total_width - w32_font->metrics.tmOverhang;
506 metrics->lbearing = 0;
507 metrics->rbearing = total_width;
508 }
509
510 /* Restore state and release DC. */
511 SelectObject (dc, old_font);
512 release_frame_dc (f, dc);
513
514 return total_width;
515}
516
517/* w32 implementation of draw for font backend.
518 Optional.
519 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
520 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
521 is nonzero, fill the background in advance. It is assured that
522 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
523
524 TODO: Currently this assumes that the colors and fonts are already
525 set in the DC. This seems to be true now, but maybe only due to
526 the old font code setting it up. It may be safer to resolve faces
527 and fonts in here and set them explicitly
528*/
529
530int
531w32font_draw (struct glyph_string *s, int from, int to,
532 int x, int y, int with_background)
533{
534 UINT options;
535 HRGN orig_clip = NULL;
536 struct w32font_info *w32font = (struct w32font_info *) s->font;
537
538 options = w32font->glyph_idx;
539
540 if (s->num_clips > 0)
541 {
542 HRGN new_clip = CreateRectRgnIndirect (s->clip);
543
544 /* Save clip region for later restoration. */
545 orig_clip = CreateRectRgn (0, 0, 0, 0);
546 if (!GetClipRgn (s->hdc, orig_clip))
547 {
548 DeleteObject (orig_clip);
549 orig_clip = NULL;
550 }
551
552 if (s->num_clips > 1)
553 {
554 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
555
556 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
557 DeleteObject (clip2);
558 }
559
560 SelectClipRgn (s->hdc, new_clip);
561 DeleteObject (new_clip);
562 }
563
564 /* Using OPAQUE background mode can clear more background than expected
565 when Cleartype is used. Draw the background manually to avoid this. */
566 SetBkMode (s->hdc, TRANSPARENT);
567 if (with_background)
568 {
569 HBRUSH brush;
570 RECT rect;
571 struct font *font = s->font;
572
573 brush = CreateSolidBrush (s->gc->background);
574 rect.left = x;
575 rect.top = y - font->ascent;
576 rect.right = x + s->width;
577 rect.bottom = y + font->descent;
578 FillRect (s->hdc, &rect, brush);
579 DeleteObject (brush);
580 }
581
582 if (s->padding_p)
583 {
584 int len = to - from, i;
585
586 for (i = 0; i < len; i++)
587 ExtTextOutW (s->hdc, x + i, y, options, NULL,
588 s->char2b + from + i, 1, NULL);
589 }
590 else
591 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, to - from, NULL);
592
593 /* Restore clip region. */
594 if (s->num_clips > 0)
595 SelectClipRgn (s->hdc, orig_clip);
596
597 if (orig_clip)
598 DeleteObject (orig_clip);
599}
600
601/* w32 implementation of free_entity for font backend.
602 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
603 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
604static void
605w32font_free_entity (Lisp_Object entity);
606 */
607
608/* w32 implementation of prepare_face for font backend.
609 Optional (if FACE->extra is not used).
610 Prepare FACE for displaying characters by FONT on frame F by
611 storing some data in FACE->extra. If successful, return 0.
612 Otherwise, return -1.
613static int
614w32font_prepare_face (FRAME_PTR f, struct face *face);
615 */
616/* w32 implementation of done_face for font backend.
617 Optional.
618 Done FACE for displaying characters by FACE->font on frame F.
619static void
620w32font_done_face (FRAME_PTR f, struct face *face); */
621
622/* w32 implementation of get_bitmap for font backend.
623 Optional.
624 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
625 intended that this method is called from the other font-driver
626 for actual drawing.
627static int
628w32font_get_bitmap (struct font *font, unsigned code,
629 struct font_bitmap *bitmap, int bits_per_pixel);
630 */
631/* w32 implementation of free_bitmap for font backend.
632 Optional.
633 Free bitmap data in BITMAP.
634static void
635w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
636 */
637/* w32 implementation of get_outline for font backend.
638 Optional.
639 Return an outline data for glyph-code CODE of FONT. The format
640 of the outline data depends on the font-driver.
641static void *
642w32font_get_outline (struct font *font, unsigned code);
643 */
644/* w32 implementation of free_outline for font backend.
645 Optional.
646 Free OUTLINE (that is obtained by the above method).
647static void
648w32font_free_outline (struct font *font, void *outline);
649 */
650/* w32 implementation of anchor_point for font backend.
651 Optional.
652 Get coordinates of the INDEXth anchor point of the glyph whose
653 code is CODE. Store the coordinates in *X and *Y. Return 0 if
654 the operations was successfull. Otherwise return -1.
655static int
656w32font_anchor_point (struct font *font, unsigned code,
657 int index, int *x, int *y);
658 */
659/* w32 implementation of otf_capability for font backend.
660 Optional.
661 Return a list describing which scripts/languages FONT
662 supports by which GSUB/GPOS features of OpenType tables.
663static Lisp_Object
664w32font_otf_capability (struct font *font);
665 */
666/* w32 implementation of otf_drive for font backend.
667 Optional.
668 Apply FONT's OTF-FEATURES to the glyph string.
669
670 FEATURES specifies which OTF features to apply in this format:
671 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
672 See the documentation of `font-drive-otf' for the detail.
673
674 This method applies the specified features to the codes in the
675 elements of GSTRING-IN (between FROMth and TOth). The output
676 codes are stored in GSTRING-OUT at the IDXth element and the
677 following elements.
678
679 Return the number of output codes. If none of the features are
680 applicable to the input data, return 0. If GSTRING-OUT is too
681 short, return -1.
682static int
683w32font_otf_drive (struct font *font, Lisp_Object features,
684 Lisp_Object gstring_in, int from, int to,
685 Lisp_Object gstring_out, int idx,
686 int alternate_subst);
687 */
688
689/* Internal implementation of w32font_list.
690 Additional parameter opentype_only restricts the returned fonts to
691 opentype fonts, which can be used with the Uniscribe backend. */
692Lisp_Object
693w32font_list_internal (Lisp_Object frame, Lisp_Object font_spec, int opentype_only)
694{
695 struct font_callback_data match_data;
696 HDC dc;
697 FRAME_PTR f = XFRAME (frame);
698
699 match_data.orig_font_spec = font_spec;
700 match_data.list = Qnil;
701 match_data.frame = frame;
702
703 memset (&match_data.pattern, 0, sizeof (LOGFONT));
704 fill_in_logfont (f, &match_data.pattern, font_spec);
705
706 /* If the charset is unrecognized, then we won't find a font, so don't
707 waste time looking for one. */
708 if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
709 {
710 Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
711 if (!NILP (spec_charset)
712 && !EQ (spec_charset, Qiso10646_1)
713 && !EQ (spec_charset, Qunicode_bmp)
714 && !EQ (spec_charset, Qunicode_sip)
715 && !EQ (spec_charset, Qunknown))
716 return Qnil;
717 }
718
719 match_data.opentype_only = opentype_only;
720 if (opentype_only)
721 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
722
723 if (match_data.pattern.lfFaceName[0] == '\0')
724 {
725 /* EnumFontFamiliesEx does not take other fields into account if
726 font name is blank, so need to use two passes. */
727 list_all_matching_fonts (&match_data);
728 }
729 else
730 {
731 dc = get_frame_dc (f);
732
733 EnumFontFamiliesEx (dc, &match_data.pattern,
734 (FONTENUMPROC) add_font_entity_to_list,
735 (LPARAM) &match_data, 0);
736 release_frame_dc (f, dc);
737 }
738
739 return match_data.list;
740}
741
742/* Internal implementation of w32font_match.
743 Additional parameter opentype_only restricts the returned fonts to
744 opentype fonts, which can be used with the Uniscribe backend. */
745Lisp_Object
746w32font_match_internal (Lisp_Object frame, Lisp_Object font_spec, int opentype_only)
747{
748 struct font_callback_data match_data;
749 HDC dc;
750 FRAME_PTR f = XFRAME (frame);
751
752 match_data.orig_font_spec = font_spec;
753 match_data.frame = frame;
754 match_data.list = Qnil;
755
756 memset (&match_data.pattern, 0, sizeof (LOGFONT));
757 fill_in_logfont (f, &match_data.pattern, font_spec);
758
759 match_data.opentype_only = opentype_only;
760 if (opentype_only)
761 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
762
763 dc = get_frame_dc (f);
764
765 EnumFontFamiliesEx (dc, &match_data.pattern,
766 (FONTENUMPROC) add_one_font_entity_to_list,
767 (LPARAM) &match_data, 0);
768 release_frame_dc (f, dc);
769
770 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
771}
772
773int
774w32font_open_internal (FRAME_PTR f, Lisp_Object font_entity,
775 int pixel_size, Lisp_Object font_object)
776{
777 int len, size, i;
778 LOGFONT logfont;
779 HDC dc;
780 HFONT hfont, old_font;
781 Lisp_Object val, extra;
782 struct w32font_info *w32_font;
783 struct font * font;
784 OUTLINETEXTMETRICW* metrics = NULL;
785
786 w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
787 font = (struct font *) w32_font;
788
789 if (!font)
790 return 0;
791
792 memset (&logfont, 0, sizeof (logfont));
793 fill_in_logfont (f, &logfont, font_entity);
794
795 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
796 limitations in bitmap fonts. */
797 val = AREF (font_entity, FONT_FOUNDRY_INDEX);
798 if (!EQ (val, Qraster))
799 logfont.lfOutPrecision = OUT_TT_PRECIS;
800
801 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
802 if (!size)
803 size = pixel_size;
804
805 logfont.lfHeight = -size;
806 hfont = CreateFontIndirect (&logfont);
807
808 if (hfont == NULL)
809 return 0;
810
811 /* Get the metrics for this font. */
812 dc = get_frame_dc (f);
813 old_font = SelectObject (dc, hfont);
814
815 /* Try getting the outline metrics (only works for truetype fonts). */
816 len = GetOutlineTextMetricsW (dc, 0, NULL);
817 if (len)
818 {
819 metrics = (OUTLINETEXTMETRICW *) alloca (len);
820 if (GetOutlineTextMetricsW (dc, len, metrics))
821 memcpy (&w32_font->metrics, &metrics->otmTextMetrics,
822 sizeof (TEXTMETRICW));
823 else
824 metrics = NULL;
825 }
826
827 if (!metrics)
828 GetTextMetricsW (dc, &w32_font->metrics);
829
830 w32_font->cached_metrics = NULL;
831 w32_font->n_cache_blocks = 0;
832
833 SelectObject (dc, old_font);
834 release_frame_dc (f, dc);
835
836 w32_font->hfont = hfont;
837
838 {
839 char *name;
840
841 /* We don't know how much space we need for the full name, so start with
842 96 bytes and go up in steps of 32. */
843 len = 96;
844 name = alloca (len);
845 while (name && w32font_full_name (&logfont, font_entity, pixel_size,
846 name, len) < 0)
847 {
848 len += 32;
849 name = alloca (len);
850 }
851 if (name)
852 font->props[FONT_FULLNAME_INDEX]
853 = DECODE_SYSTEM (build_string (name));
854 else
855 font->props[FONT_FULLNAME_INDEX]
856 = DECODE_SYSTEM (build_string (logfont.lfFaceName));
857 }
858
859 font->max_width = w32_font->metrics.tmMaxCharWidth;
860 /* Parts of Emacs display assume that height = ascent + descent...
861 so height is defined later, after ascent and descent.
862 font->height = w32_font->metrics.tmHeight
863 + w32_font->metrics.tmExternalLeading;
864 */
865
866 font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
867
868 font->vertical_centering = 0;
869 font->encoding_type = 0;
870 font->baseline_offset = 0;
871 font->relative_compose = 0;
872 font->default_ascent = w32_font->metrics.tmAscent;
873 font->font_encoder = NULL;
874 font->pixel_size = size;
875 font->driver = &w32font_driver;
876 /* Use format cached during list, as the information we have access to
877 here is incomplete. */
878 extra = AREF (font_entity, FONT_EXTRA_INDEX);
879 if (CONSP (extra))
880 {
881 val = assq_no_quit (QCformat, extra);
882 if (CONSP (val))
883 font->props[FONT_FORMAT_INDEX] = XCDR (val);
884 else
885 font->props[FONT_FORMAT_INDEX] = Qunknown;
886 }
887 else
888 font->props[FONT_FORMAT_INDEX] = Qunknown;
889
890 font->props[FONT_FILE_INDEX] = Qnil;
891 font->encoding_charset = -1;
892 font->repertory_charset = -1;
893 /* TODO: do we really want the minimum width here, which could be negative? */
894 font->min_width = font->space_width;
895 font->ascent = w32_font->metrics.tmAscent;
896 font->descent = w32_font->metrics.tmDescent;
897 font->height = font->ascent + font->descent;
898
899 if (metrics)
900 {
901 font->underline_thickness = metrics->otmsUnderscoreSize;
902 font->underline_position = -metrics->otmsUnderscorePosition;
903 }
904 else
905 {
906 font->underline_thickness = 0;
907 font->underline_position = -1;
908 }
909
910 /* For temporary compatibility with legacy code that expects the
911 name to be usable in x-list-fonts. Eventually we expect to change
912 x-list-fonts and other places that use fonts so that this can be
913 an fcname or similar. */
914 font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
915
916 return 1;
917}
918
919/* Callback function for EnumFontFamiliesEx.
920 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
921static int CALLBACK
922add_font_name_to_list (ENUMLOGFONTEX *logical_font,
923 NEWTEXTMETRICEX *physical_font,
924 DWORD font_type, LPARAM list_object)
925{
926 Lisp_Object* list = (Lisp_Object *) list_object;
927 Lisp_Object family;
928
929 /* Skip vertical fonts (intended only for printing) */
930 if (logical_font->elfLogFont.lfFaceName[0] == '@')
931 return 1;
932
933 family = intern_font_name (logical_font->elfLogFont.lfFaceName);
934 if (! memq_no_quit (family, *list))
935 *list = Fcons (family, *list);
936
937 return 1;
938}
939
940static int w32_decode_weight (int);
941static int w32_encode_weight (int);
942
943/* Convert an enumerated Windows font to an Emacs font entity. */
944static Lisp_Object
945w32_enumfont_pattern_entity (Lisp_Object frame,
946 ENUMLOGFONTEX *logical_font,
947 NEWTEXTMETRICEX *physical_font,
948 DWORD font_type,
949 LOGFONT *requested_font,
950 Lisp_Object backend)
951{
952 Lisp_Object entity, tem;
953 LOGFONT *lf = (LOGFONT*) logical_font;
954 BYTE generic_type;
955 DWORD full_type = physical_font->ntmTm.ntmFlags;
956
957 entity = font_make_entity ();
958
959 ASET (entity, FONT_TYPE_INDEX, backend);
960 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
961 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
962
963 /* Foundry is difficult to get in readable form on Windows.
964 But Emacs crashes if it is not set, so set it to something more
965 generic. These values make xlfds compatible with Emacs 22. */
966 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
967 tem = Qraster;
968 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
969 tem = Qoutline;
970 else
971 tem = Qunknown;
972
973 ASET (entity, FONT_FOUNDRY_INDEX, tem);
974
975 /* Save the generic family in the extra info, as it is likely to be
976 useful to users looking for a close match. */
977 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
978 if (generic_type == FF_DECORATIVE)
979 tem = Qdecorative;
980 else if (generic_type == FF_MODERN)
981 tem = Qmono;
982 else if (generic_type == FF_ROMAN)
983 tem = Qserif;
984 else if (generic_type == FF_SCRIPT)
985 tem = Qscript;
986 else if (generic_type == FF_SWISS)
987 tem = Qsans;
988 else
989 tem = Qnil;
990
991 ASET (entity, FONT_ADSTYLE_INDEX, tem);
992
993 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
994 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL));
995 else
996 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL));
997
998 if (requested_font->lfQuality != DEFAULT_QUALITY)
999 {
1000 font_put_extra (entity, QCantialias,
1001 lispy_antialias_type (requested_font->lfQuality));
1002 }
1003 ASET (entity, FONT_FAMILY_INDEX,
1004 intern_font_name (lf->lfFaceName));
1005
1006 FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
1007 make_number (w32_decode_weight (lf->lfWeight)));
1008 FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
1009 make_number (lf->lfItalic ? 200 : 100));
1010 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1011 to get it. */
1012 FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100));
1013
1014 if (font_type & RASTER_FONTTYPE)
1015 ASET (entity, FONT_SIZE_INDEX,
1016 make_number (physical_font->ntmTm.tmHeight
1017 + physical_font->ntmTm.tmExternalLeading));
1018 else
1019 ASET (entity, FONT_SIZE_INDEX, make_number (0));
1020
1021 /* Cache unicode codepoints covered by this font, as there is no other way
1022 of getting this information easily. */
1023 if (font_type & TRUETYPE_FONTTYPE)
1024 {
1025 tem = font_supported_scripts (&physical_font->ntmFontSig);
1026 if (!NILP (tem))
1027 font_put_extra (entity, QCscript, tem);
1028 }
1029
1030 /* This information is not fully available when opening fonts, so
1031 save it here. Only Windows 2000 and later return information
1032 about opentype and type1 fonts, so need a fallback for detecting
1033 truetype so that this information is not any worse than we could
1034 have obtained later. */
1035 if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
1036 tem = intern ("opentype");
1037 else if (font_type & TRUETYPE_FONTTYPE)
1038 tem = intern ("truetype");
1039 else if (full_type & NTM_PS_OPENTYPE)
1040 tem = intern ("postscript");
1041 else if (full_type & NTM_TYPE1)
1042 tem = intern ("type1");
1043 else if (font_type & RASTER_FONTTYPE)
1044 tem = intern ("w32bitmap");
1045 else
1046 tem = intern ("w32vector");
1047
1048 font_put_extra (entity, QCformat, tem);
1049
1050 return entity;
1051}
1052
1053
1054/* Convert generic families to the family portion of lfPitchAndFamily. */
1055static BYTE
1056w32_generic_family (Lisp_Object name)
1057{
1058 /* Generic families. */
1059 if (EQ (name, Qmonospace) || EQ (name, Qmono))
1060 return FF_MODERN;
1061 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
1062 return FF_SWISS;
1063 else if (EQ (name, Qserif))
1064 return FF_ROMAN;
1065 else if (EQ (name, Qdecorative))
1066 return FF_DECORATIVE;
1067 else if (EQ (name, Qscript))
1068 return FF_SCRIPT;
1069 else
1070 return FF_DONTCARE;
1071}
1072
1073static int
1074logfonts_match (LOGFONT *font, LOGFONT *pattern)
1075{
1076 /* Only check height for raster fonts. */
1077 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
1078 && font->lfHeight != pattern->lfHeight)
1079 return 0;
1080
1081 /* Have some flexibility with weights. */
1082 if (pattern->lfWeight
1083 && ((font->lfWeight < (pattern->lfWeight - 150))
1084 || font->lfWeight > (pattern->lfWeight + 150)))
1085 return 0;
1086
1087 /* Charset and face should be OK. Italic has to be checked
1088 against the original spec, in case we don't have any preference. */
1089 return 1;
1090}
1091
1092/* Codepage Bitfields in FONTSIGNATURE struct. */
1093#define CSB_JAPANESE (1 << 17)
1094#define CSB_KOREAN ((1 << 19) | (1 << 21))
1095#define CSB_CHINESE ((1 << 18) | (1 << 20))
1096
1097static int
1098font_matches_spec (DWORD type, NEWTEXTMETRICEX *font,
1099 Lisp_Object spec, Lisp_Object backend,
1100 LOGFONT *logfont)
1101{
1102 Lisp_Object extra, val;
1103
1104 /* Check italic. Can't check logfonts, since it is a boolean field,
1105 so there is no difference between "non-italic" and "don't care". */
1106 {
1107 int slant = FONT_SLANT_NUMERIC (spec);
1108
1109 if (slant >= 0
1110 && ((slant > 150 && !font->ntmTm.tmItalic)
1111 || (slant <= 150 && font->ntmTm.tmItalic)))
1112 return 0;
1113 }
1114
1115 /* Check adstyle against generic family. */
1116 val = AREF (spec, FONT_ADSTYLE_INDEX);
1117 if (!NILP (val))
1118 {
1119 BYTE family = w32_generic_family (val);
1120 if (family != FF_DONTCARE
1121 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
1122 return 0;
1123 }
1124
1125 /* Check spacing */
1126 val = AREF (spec, FONT_SPACING_INDEX);
1127 if (INTEGERP (val))
1128 {
1129 int spacing = XINT (val);
1130 int proportional = (spacing < FONT_SPACING_MONO);
1131
1132 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
1133 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
1134 return 0;
1135 }
1136
1137 /* Check extra parameters. */
1138 for (extra = AREF (spec, FONT_EXTRA_INDEX);
1139 CONSP (extra); extra = XCDR (extra))
1140 {
1141 Lisp_Object extra_entry;
1142 extra_entry = XCAR (extra);
1143 if (CONSP (extra_entry))
1144 {
1145 Lisp_Object key = XCAR (extra_entry);
1146
1147 val = XCDR (extra_entry);
1148 if (EQ (key, QCscript) && SYMBOLP (val))
1149 {
1150 /* Only truetype fonts will have information about what
1151 scripts they support. This probably means the user
1152 will have to force Emacs to use raster, postscript
1153 or atm fonts for non-ASCII text. */
1154 if (type & TRUETYPE_FONTTYPE)
1155 {
1156 Lisp_Object support
1157 = font_supported_scripts (&font->ntmFontSig);
1158 if (! memq_no_quit (val, support))
1159 return 0;
1160 }
1161 else
1162 {
1163 /* Return specific matches, but play it safe. Fonts
1164 that cover more than their charset would suggest
1165 are likely to be truetype or opentype fonts,
1166 covered above. */
1167 if (EQ (val, Qlatin))
1168 {
1169 /* Although every charset but symbol, thai and
1170 arabic contains the basic ASCII set of latin
1171 characters, Emacs expects much more. */
1172 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
1173 return 0;
1174 }
1175 else if (EQ (val, Qsymbol))
1176 {
1177 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
1178 return 0;
1179 }
1180 else if (EQ (val, Qcyrillic))
1181 {
1182 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
1183 return 0;
1184 }
1185 else if (EQ (val, Qgreek))
1186 {
1187 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
1188 return 0;
1189 }
1190 else if (EQ (val, Qarabic))
1191 {
1192 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
1193 return 0;
1194 }
1195 else if (EQ (val, Qhebrew))
1196 {
1197 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
1198 return 0;
1199 }
1200 else if (EQ (val, Qthai))
1201 {
1202 if (font->ntmTm.tmCharSet != THAI_CHARSET)
1203 return 0;
1204 }
1205 else if (EQ (val, Qkana))
1206 {
1207 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1208 return 0;
1209 }
1210 else if (EQ (val, Qbopomofo))
1211 {
1212 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1213 return 0;
1214 }
1215 else if (EQ (val, Qhangul))
1216 {
1217 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1218 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1219 return 0;
1220 }
1221 else if (EQ (val, Qhan))
1222 {
1223 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1224 && font->ntmTm.tmCharSet != GB2312_CHARSET
1225 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1226 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1227 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1228 return 0;
1229 }
1230 else
1231 /* Other scripts unlikely to be handled by non-truetype
1232 fonts. */
1233 return 0;
1234 }
1235 }
1236 else if (EQ (key, QClang) && SYMBOLP (val))
1237 {
1238 /* Just handle the CJK languages here, as the lang
1239 parameter is used to select a font with appropriate
1240 glyphs in the cjk unified ideographs block. Other fonts
1241 support for a language can be solely determined by
1242 its character coverage. */
1243 if (EQ (val, Qja))
1244 {
1245 if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
1246 return 0;
1247 }
1248 else if (EQ (val, Qko))
1249 {
1250 if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
1251 return 0;
1252 }
1253 else if (EQ (val, Qzh))
1254 {
1255 if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
1256 return 0;
1257 }
1258 else
1259 /* Any other language, we don't recognize it. Only the above
1260 currently appear in fontset.el, so it isn't worth
1261 creating a mapping table of codepages/scripts to languages
1262 or opening the font to see if there are any language tags
1263 in it that the W32 API does not expose. Fontset
1264 spec should have a fallback, as some backends do
1265 not recognize language at all. */
1266 return 0;
1267 }
1268 else if (EQ (key, QCotf) && CONSP (val))
1269 {
1270 /* OTF features only supported by the uniscribe backend. */
1271 if (EQ (backend, Quniscribe))
1272 {
1273 if (!uniscribe_check_otf (logfont, val))
1274 return 0;
1275 }
1276 else
1277 return 0;
1278 }
1279 }
1280 }
1281 return 1;
1282}
1283
1284static int
1285w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset)
1286{
1287 DWORD subrange1 = coverage->fsUsb[1];
1288
1289#define SUBRANGE1_HAN_MASK 0x08000000
1290#define SUBRANGE1_HANGEUL_MASK 0x01000000
1291#define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1292
1293 if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET)
1294 {
1295 return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK;
1296 }
1297 else if (charset == SHIFTJIS_CHARSET)
1298 {
1299 return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK;
1300 }
1301 else if (charset == HANGEUL_CHARSET)
1302 {
1303 return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK;
1304 }
1305
1306 return 1;
1307}
1308
1309
1310static int
1311check_face_name (LOGFONT *font, char *full_name)
1312{
1313 char full_iname[LF_FULLFACESIZE+1];
1314
1315 /* Just check for names known to cause problems, since the full name
1316 can contain expanded abbreviations, prefixed foundry, postfixed
1317 style, the latter of which sometimes differs from the style indicated
1318 in the shorter name (eg Lt becomes Light or even Extra Light) */
1319
1320 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1321 installed, we run into problems with the Uniscribe backend which tries
1322 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1323 with Arial's characteristics, since that attempt to use Truetype works
1324 some places, but not others. */
1325 if (!xstrcasecmp (font->lfFaceName, "helvetica"))
1326 {
1327 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1328 full_iname[LF_FULLFACESIZE] = 0;
1329 _strlwr (full_iname);
1330 return strstr ("helvetica", full_iname) != NULL;
1331 }
1332 /* Same for Helv. */
1333 if (!xstrcasecmp (font->lfFaceName, "helv"))
1334 {
1335 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1336 full_iname[LF_FULLFACESIZE] = 0;
1337 _strlwr (full_iname);
1338 return strstr ("helv", full_iname) != NULL;
1339 }
1340
1341 /* Since Times is mapped to Times New Roman, a substring
1342 match is not sufficient to filter out the bogus match. */
1343 else if (!xstrcasecmp (font->lfFaceName, "times"))
1344 return xstrcasecmp (full_name, "times") == 0;
1345
1346 return 1;
1347}
1348
1349
1350/* Callback function for EnumFontFamiliesEx.
1351 * Checks if a font matches everything we are trying to check agaist,
1352 * and if so, adds it to a list. Both the data we are checking against
1353 * and the list to which the fonts are added are passed in via the
1354 * lparam argument, in the form of a font_callback_data struct. */
1355static int CALLBACK
1356add_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1357 NEWTEXTMETRICEX *physical_font,
1358 DWORD font_type, LPARAM lParam)
1359{
1360 struct font_callback_data *match_data
1361 = (struct font_callback_data *) lParam;
1362 Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
1363 Lisp_Object entity;
1364
1365 int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1366 || physical_font->ntmFontSig.fsUsb[2]
1367 || physical_font->ntmFontSig.fsUsb[1]
1368 || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1369
1370 /* Skip non matching fonts. */
1371
1372 /* For uniscribe backend, consider only truetype or opentype fonts
1373 that have some unicode coverage. */
1374 if (match_data->opentype_only
1375 && ((!physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE
1376 && !(font_type & TRUETYPE_FONTTYPE))
1377 || !is_unicode))
1378 return 1;
1379
1380 /* Ensure a match. */
1381 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1382 || !font_matches_spec (font_type, physical_font,
1383 match_data->orig_font_spec, backend,
1384 &logical_font->elfLogFont)
1385 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1386 match_data->pattern.lfCharSet))
1387 return 1;
1388
1389 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1390 We limit this to raster fonts, because the test can catch some
1391 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1392 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1393 therefore get through this test. Since full names can be prefixed
1394 by a foundry, we accept raster fonts if the font name is found
1395 anywhere within the full name. */
1396 if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
1397 && !strstr (logical_font->elfFullName,
1398 logical_font->elfLogFont.lfFaceName))
1399 /* Check for well known substitutions that mess things up in the
1400 presence of Type-1 fonts of the same name. */
1401 || (!check_face_name (&logical_font->elfLogFont,
1402 logical_font->elfFullName)))
1403 return 1;
1404
1405 /* Make a font entity for the font. */
1406 entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1407 physical_font, font_type,
1408 &match_data->pattern,
1409 backend);
1410
1411 if (!NILP (entity))
1412 {
1413 Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1414 FONT_REGISTRY_INDEX);
1415
1416 /* iso10646-1 fonts must contain unicode mapping tables. */
1417 if (EQ (spec_charset, Qiso10646_1))
1418 {
1419 if (!is_unicode)
1420 return 1;
1421 }
1422 /* unicode-bmp fonts must contain characters from the BMP. */
1423 else if (EQ (spec_charset, Qunicode_bmp))
1424 {
1425 if (!physical_font->ntmFontSig.fsUsb[3]
1426 && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1427 && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1428 && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1429 return 1;
1430 }
1431 /* unicode-sip fonts must contain characters in unicode plane 2.
1432 so look for bit 57 (surrogates) in the Unicode subranges, plus
1433 the bits for CJK ranges that include those characters. */
1434 else if (EQ (spec_charset, Qunicode_sip))
1435 {
1436 if (!physical_font->ntmFontSig.fsUsb[1] & 0x02000000
1437 || !physical_font->ntmFontSig.fsUsb[1] & 0x28000000)
1438 return 1;
1439 }
1440
1441 /* This font matches. */
1442
1443 /* If registry was specified, ensure it is reported as the same. */
1444 if (!NILP (spec_charset))
1445 ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1446
1447 /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1448 fonts as unicode and skip other charsets. */
1449 else if (match_data->opentype_only)
1450 {
1451 if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1452 || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1453 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1454 else
1455 return 1;
1456 }
1457
1458 /* Add this font to the list. */
1459 match_data->list = Fcons (entity, match_data->list);
1460 }
1461 return 1;
1462}
1463
1464/* Callback function for EnumFontFamiliesEx.
1465 * Terminates the search once we have a match. */
1466static int CALLBACK
1467add_one_font_entity_to_list (ENUMLOGFONTEX *logical_font,
1468 NEWTEXTMETRICEX *physical_font,
1469 DWORD font_type, LPARAM lParam)
1470{
1471 struct font_callback_data *match_data
1472 = (struct font_callback_data *) lParam;
1473 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1474
1475 /* If we have a font in the list, terminate the search. */
1476 return NILP (match_data->list);
1477}
1478
1479/* Old function to convert from x to w32 charset, from w32fns.c. */
1480static LONG
1481x_to_w32_charset (char * lpcs)
1482{
1483 Lisp_Object this_entry, w32_charset;
1484 char *charset;
1485 int len = strlen (lpcs);
1486
1487 /* Support "*-#nnn" format for unknown charsets. */
1488 if (strncmp (lpcs, "*-#", 3) == 0)
1489 return atoi (lpcs + 3);
1490
1491 /* All Windows fonts qualify as unicode. */
1492 if (!strncmp (lpcs, "iso10646", 8))
1493 return DEFAULT_CHARSET;
1494
1495 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1496 charset = alloca (len + 1);
1497 strcpy (charset, lpcs);
1498 lpcs = strchr (charset, '*');
1499 if (lpcs)
1500 *lpcs = '\0';
1501
1502 /* Look through w32-charset-info-alist for the character set.
1503 Format of each entry is
1504 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1505 */
1506 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
1507
1508 if (NILP (this_entry))
1509 {
1510 /* At startup, we want iso8859-1 fonts to come up properly. */
1511 if (xstrcasecmp (charset, "iso8859-1") == 0)
1512 return ANSI_CHARSET;
1513 else
1514 return DEFAULT_CHARSET;
1515 }
1516
1517 w32_charset = Fcar (Fcdr (this_entry));
1518
1519 /* Translate Lisp symbol to number. */
1520 if (EQ (w32_charset, Qw32_charset_ansi))
1521 return ANSI_CHARSET;
1522 if (EQ (w32_charset, Qw32_charset_symbol))
1523 return SYMBOL_CHARSET;
1524 if (EQ (w32_charset, Qw32_charset_shiftjis))
1525 return SHIFTJIS_CHARSET;
1526 if (EQ (w32_charset, Qw32_charset_hangeul))
1527 return HANGEUL_CHARSET;
1528 if (EQ (w32_charset, Qw32_charset_chinesebig5))
1529 return CHINESEBIG5_CHARSET;
1530 if (EQ (w32_charset, Qw32_charset_gb2312))
1531 return GB2312_CHARSET;
1532 if (EQ (w32_charset, Qw32_charset_oem))
1533 return OEM_CHARSET;
1534 if (EQ (w32_charset, Qw32_charset_johab))
1535 return JOHAB_CHARSET;
1536 if (EQ (w32_charset, Qw32_charset_easteurope))
1537 return EASTEUROPE_CHARSET;
1538 if (EQ (w32_charset, Qw32_charset_turkish))
1539 return TURKISH_CHARSET;
1540 if (EQ (w32_charset, Qw32_charset_baltic))
1541 return BALTIC_CHARSET;
1542 if (EQ (w32_charset, Qw32_charset_russian))
1543 return RUSSIAN_CHARSET;
1544 if (EQ (w32_charset, Qw32_charset_arabic))
1545 return ARABIC_CHARSET;
1546 if (EQ (w32_charset, Qw32_charset_greek))
1547 return GREEK_CHARSET;
1548 if (EQ (w32_charset, Qw32_charset_hebrew))
1549 return HEBREW_CHARSET;
1550 if (EQ (w32_charset, Qw32_charset_vietnamese))
1551 return VIETNAMESE_CHARSET;
1552 if (EQ (w32_charset, Qw32_charset_thai))
1553 return THAI_CHARSET;
1554 if (EQ (w32_charset, Qw32_charset_mac))
1555 return MAC_CHARSET;
1556
1557 return DEFAULT_CHARSET;
1558}
1559
1560
1561/* Convert a Lisp font registry (symbol) to a windows charset. */
1562static LONG
1563registry_to_w32_charset (Lisp_Object charset)
1564{
1565 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1566 || EQ (charset, Qunicode_sip))
1567 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1568 else if (EQ (charset, Qiso8859_1))
1569 return ANSI_CHARSET;
1570 else if (SYMBOLP (charset))
1571 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
1572 else
1573 return DEFAULT_CHARSET;
1574}
1575
1576/* Old function to convert from w32 to x charset, from w32fns.c. */
1577static char *
1578w32_to_x_charset (int fncharset, char *matching)
1579{
1580 static char buf[32];
1581 Lisp_Object charset_type;
1582 int match_len = 0;
1583
1584 if (matching)
1585 {
1586 /* If fully specified, accept it as it is. Otherwise use a
1587 substring match. */
1588 char *wildcard = strchr (matching, '*');
1589 if (wildcard)
1590 *wildcard = '\0';
1591 else if (strchr (matching, '-'))
1592 return matching;
1593
1594 match_len = strlen (matching);
1595 }
1596
1597 switch (fncharset)
1598 {
1599 case ANSI_CHARSET:
1600 /* Handle startup case of w32-charset-info-alist not
1601 being set up yet. */
1602 if (NILP (Vw32_charset_info_alist))
1603 return "iso8859-1";
1604 charset_type = Qw32_charset_ansi;
1605 break;
1606 case DEFAULT_CHARSET:
1607 charset_type = Qw32_charset_default;
1608 break;
1609 case SYMBOL_CHARSET:
1610 charset_type = Qw32_charset_symbol;
1611 break;
1612 case SHIFTJIS_CHARSET:
1613 charset_type = Qw32_charset_shiftjis;
1614 break;
1615 case HANGEUL_CHARSET:
1616 charset_type = Qw32_charset_hangeul;
1617 break;
1618 case GB2312_CHARSET:
1619 charset_type = Qw32_charset_gb2312;
1620 break;
1621 case CHINESEBIG5_CHARSET:
1622 charset_type = Qw32_charset_chinesebig5;
1623 break;
1624 case OEM_CHARSET:
1625 charset_type = Qw32_charset_oem;
1626 break;
1627 case EASTEUROPE_CHARSET:
1628 charset_type = Qw32_charset_easteurope;
1629 break;
1630 case TURKISH_CHARSET:
1631 charset_type = Qw32_charset_turkish;
1632 break;
1633 case BALTIC_CHARSET:
1634 charset_type = Qw32_charset_baltic;
1635 break;
1636 case RUSSIAN_CHARSET:
1637 charset_type = Qw32_charset_russian;
1638 break;
1639 case ARABIC_CHARSET:
1640 charset_type = Qw32_charset_arabic;
1641 break;
1642 case GREEK_CHARSET:
1643 charset_type = Qw32_charset_greek;
1644 break;
1645 case HEBREW_CHARSET:
1646 charset_type = Qw32_charset_hebrew;
1647 break;
1648 case VIETNAMESE_CHARSET:
1649 charset_type = Qw32_charset_vietnamese;
1650 break;
1651 case THAI_CHARSET:
1652 charset_type = Qw32_charset_thai;
1653 break;
1654 case MAC_CHARSET:
1655 charset_type = Qw32_charset_mac;
1656 break;
1657 case JOHAB_CHARSET:
1658 charset_type = Qw32_charset_johab;
1659 break;
1660
1661 default:
1662 /* Encode numerical value of unknown charset. */
1663 sprintf (buf, "*-#%u", fncharset);
1664 return buf;
1665 }
1666
1667 {
1668 Lisp_Object rest;
1669 char * best_match = NULL;
1670 int matching_found = 0;
1671
1672 /* Look through w32-charset-info-alist for the character set.
1673 Prefer ISO codepages, and prefer lower numbers in the ISO
1674 range. Only return charsets for codepages which are installed.
1675
1676 Format of each entry is
1677 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1678 */
1679 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1680 {
1681 char * x_charset;
1682 Lisp_Object w32_charset;
1683 Lisp_Object codepage;
1684
1685 Lisp_Object this_entry = XCAR (rest);
1686
1687 /* Skip invalid entries in alist. */
1688 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1689 || !CONSP (XCDR (this_entry))
1690 || !SYMBOLP (XCAR (XCDR (this_entry))))
1691 continue;
1692
1693 x_charset = SDATA (XCAR (this_entry));
1694 w32_charset = XCAR (XCDR (this_entry));
1695 codepage = XCDR (XCDR (this_entry));
1696
1697 /* Look for Same charset and a valid codepage (or non-int
1698 which means ignore). */
1699 if (EQ (w32_charset, charset_type)
1700 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
1701 || IsValidCodePage (XINT (codepage))))
1702 {
1703 /* If we don't have a match already, then this is the
1704 best. */
1705 if (!best_match)
1706 {
1707 best_match = x_charset;
1708 if (matching && !strnicmp (x_charset, matching, match_len))
1709 matching_found = 1;
1710 }
1711 /* If we already found a match for MATCHING, then
1712 only consider other matches. */
1713 else if (matching_found
1714 && strnicmp (x_charset, matching, match_len))
1715 continue;
1716 /* If this matches what we want, and the best so far doesn't,
1717 then this is better. */
1718 else if (!matching_found && matching
1719 && !strnicmp (x_charset, matching, match_len))
1720 {
1721 best_match = x_charset;
1722 matching_found = 1;
1723 }
1724 /* If this is fully specified, and the best so far isn't,
1725 then this is better. */
1726 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1727 /* If this is an ISO codepage, and the best so far isn't,
1728 then this is better, but only if it fully specifies the
1729 encoding. */
1730 || (strnicmp (best_match, "iso", 3) != 0
1731 && strnicmp (x_charset, "iso", 3) == 0
1732 && strchr (x_charset, '-')))
1733 best_match = x_charset;
1734 /* If both are ISO8859 codepages, choose the one with the
1735 lowest number in the encoding field. */
1736 else if (strnicmp (best_match, "iso8859-", 8) == 0
1737 && strnicmp (x_charset, "iso8859-", 8) == 0)
1738 {
1739 int best_enc = atoi (best_match + 8);
1740 int this_enc = atoi (x_charset + 8);
1741 if (this_enc > 0 && this_enc < best_enc)
1742 best_match = x_charset;
1743 }
1744 }
1745 }
1746
1747 /* If no match, encode the numeric value. */
1748 if (!best_match)
1749 {
1750 sprintf (buf, "*-#%u", fncharset);
1751 return buf;
1752 }
1753
1754 strncpy (buf, best_match, 31);
1755 /* If the charset is not fully specified, put -0 on the end. */
1756 if (!strchr (best_match, '-'))
1757 {
1758 int pos = strlen (best_match);
1759 /* Charset specifiers shouldn't be very long. If it is a made
1760 up one, truncating it should not do any harm since it isn't
1761 recognized anyway. */
1762 if (pos > 29)
1763 pos = 29;
1764 strcpy (buf + pos, "-0");
1765 }
1766 buf[31] = '\0';
1767 return buf;
1768 }
1769}
1770
1771static Lisp_Object
1772w32_registry (LONG w32_charset, DWORD font_type)
1773{
1774 char *charset;
1775
1776 /* If charset is defaulted, charset is unicode or unknown, depending on
1777 font type. */
1778 if (w32_charset == DEFAULT_CHARSET)
1779 return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
1780
1781 charset = w32_to_x_charset (w32_charset, NULL);
1782 return font_intern_prop (charset, strlen (charset), 1);
1783}
1784
1785static int
1786w32_decode_weight (int fnweight)
1787{
1788 if (fnweight >= FW_HEAVY) return 210;
1789 if (fnweight >= FW_EXTRABOLD) return 205;
1790 if (fnweight >= FW_BOLD) return 200;
1791 if (fnweight >= FW_SEMIBOLD) return 180;
1792 if (fnweight >= FW_NORMAL) return 100;
1793 if (fnweight >= FW_LIGHT) return 50;
1794 if (fnweight >= FW_EXTRALIGHT) return 40;
1795 if (fnweight > FW_THIN) return 20;
1796 return 0;
1797}
1798
1799static int
1800w32_encode_weight (int n)
1801{
1802 if (n >= 210) return FW_HEAVY;
1803 if (n >= 205) return FW_EXTRABOLD;
1804 if (n >= 200) return FW_BOLD;
1805 if (n >= 180) return FW_SEMIBOLD;
1806 if (n >= 100) return FW_NORMAL;
1807 if (n >= 50) return FW_LIGHT;
1808 if (n >= 40) return FW_EXTRALIGHT;
1809 if (n >= 20) return FW_THIN;
1810 return 0;
1811}
1812
1813/* Convert a Windows font weight into one of the weights supported
1814 by fontconfig (see font.c:font_parse_fcname). */
1815static Lisp_Object
1816w32_to_fc_weight (int n)
1817{
1818 if (n >= FW_EXTRABOLD) return intern ("black");
1819 if (n >= FW_BOLD) return intern ("bold");
1820 if (n >= FW_SEMIBOLD) return intern ("demibold");
1821 if (n >= FW_NORMAL) return intern ("medium");
1822 return intern ("light");
1823}
1824
1825/* Fill in all the available details of LOGFONT from FONT_SPEC. */
1826static void
1827fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
1828{
1829 Lisp_Object tmp, extra;
1830 int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
1831
1832 tmp = AREF (font_spec, FONT_DPI_INDEX);
1833 if (INTEGERP (tmp))
1834 {
1835 dpi = XINT (tmp);
1836 }
1837 else if (FLOATP (tmp))
1838 {
1839 dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
1840 }
1841
1842 /* Height */
1843 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1844 if (INTEGERP (tmp))
1845 logfont->lfHeight = -1 * XINT (tmp);
1846 else if (FLOATP (tmp))
1847 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
1848
1849 /* Escapement */
1850
1851 /* Orientation */
1852
1853 /* Weight */
1854 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1855 if (INTEGERP (tmp))
1856 logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
1857
1858 /* Italic */
1859 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1860 if (INTEGERP (tmp))
1861 {
1862 int slant = FONT_SLANT_NUMERIC (font_spec);
1863 logfont->lfItalic = slant > 150 ? 1 : 0;
1864 }
1865
1866 /* Underline */
1867
1868 /* Strikeout */
1869
1870 /* Charset */
1871 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
1872 if (! NILP (tmp))
1873 logfont->lfCharSet = registry_to_w32_charset (tmp);
1874 else
1875 logfont->lfCharSet = DEFAULT_CHARSET;
1876
1877 /* Out Precision */
1878
1879 /* Clip Precision */
1880
1881 /* Quality */
1882 logfont->lfQuality = DEFAULT_QUALITY;
1883
1884 /* Generic Family and Face Name */
1885 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
1886
1887 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
1888 if (! NILP (tmp))
1889 {
1890 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
1891 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
1892 ; /* Font name was generic, don't fill in font name. */
1893 /* Font families are interned, but allow for strings also in case of
1894 user input. */
1895 else if (SYMBOLP (tmp))
1896 strncpy (logfont->lfFaceName,
1897 SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
1898 }
1899
1900 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
1901 if (!NILP (tmp))
1902 {
1903 /* Override generic family. */
1904 BYTE family = w32_generic_family (tmp);
1905 if (family != FF_DONTCARE)
1906 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
1907 }
1908
1909 /* Set pitch based on the spacing property. */
1910 tmp = AREF (font_spec, FONT_SPACING_INDEX);
1911 if (INTEGERP (tmp))
1912 {
1913 int spacing = XINT (tmp);
1914 if (spacing < FONT_SPACING_MONO)
1915 logfont->lfPitchAndFamily
1916 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
1917 else
1918 logfont->lfPitchAndFamily
1919 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
1920 }
1921
1922 /* Process EXTRA info. */
1923 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
1924 CONSP (extra); extra = XCDR (extra))
1925 {
1926 tmp = XCAR (extra);
1927 if (CONSP (tmp))
1928 {
1929 Lisp_Object key, val;
1930 key = XCAR (tmp), val = XCDR (tmp);
1931 /* Only use QCscript if charset is not provided, or is unicode
1932 and a single script is specified. This is rather crude,
1933 and is only used to narrow down the fonts returned where
1934 there is a definite match. Some scripts, such as latin, han,
1935 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1936 them. */
1937 if (EQ (key, QCscript)
1938 && logfont->lfCharSet == DEFAULT_CHARSET
1939 && SYMBOLP (val))
1940 {
1941 if (EQ (val, Qgreek))
1942 logfont->lfCharSet = GREEK_CHARSET;
1943 else if (EQ (val, Qhangul))
1944 logfont->lfCharSet = HANGUL_CHARSET;
1945 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
1946 logfont->lfCharSet = SHIFTJIS_CHARSET;
1947 else if (EQ (val, Qbopomofo))
1948 logfont->lfCharSet = CHINESEBIG5_CHARSET;
1949 /* GB 18030 supports tibetan, yi, mongolian,
1950 fonts that support it should show up if we ask for
1951 GB2312 fonts. */
1952 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
1953 || EQ (val, Qmongolian))
1954 logfont->lfCharSet = GB2312_CHARSET;
1955 else if (EQ (val, Qhebrew))
1956 logfont->lfCharSet = HEBREW_CHARSET;
1957 else if (EQ (val, Qarabic))
1958 logfont->lfCharSet = ARABIC_CHARSET;
1959 else if (EQ (val, Qthai))
1960 logfont->lfCharSet = THAI_CHARSET;
1961 }
1962 else if (EQ (key, QCantialias) && SYMBOLP (val))
1963 {
1964 logfont->lfQuality = w32_antialias_type (val);
1965 }
1966 }
1967 }
1968}
1969
1970static void
1971list_all_matching_fonts (struct font_callback_data *match_data)
1972{
1973 HDC dc;
1974 Lisp_Object families = w32font_list_family (match_data->frame);
1975 struct frame *f = XFRAME (match_data->frame);
1976
1977 dc = get_frame_dc (f);
1978
1979 while (!NILP (families))
1980 {
1981 /* Only fonts from the current locale are given localized names
1982 on Windows, so we can keep backwards compatibility with
1983 Windows 9x/ME by using non-Unicode font enumeration without
1984 sacrificing internationalization here. */
1985 char *name;
1986 Lisp_Object family = CAR (families);
1987 families = CDR (families);
1988 if (NILP (family))
1989 continue;
1990 else if (SYMBOLP (family))
1991 name = SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
1992 else
1993 continue;
1994
1995 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
1996 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
1997
1998 EnumFontFamiliesEx (dc, &match_data->pattern,
1999 (FONTENUMPROC) add_font_entity_to_list,
2000 (LPARAM) match_data, 0);
2001 }
2002
2003 release_frame_dc (f, dc);
2004}
2005
2006static Lisp_Object
2007lispy_antialias_type (BYTE type)
2008{
2009 Lisp_Object lispy;
2010
2011 switch (type)
2012 {
2013 case NONANTIALIASED_QUALITY:
2014 lispy = Qnone;
2015 break;
2016 case ANTIALIASED_QUALITY:
2017 lispy = Qstandard;
2018 break;
2019 case CLEARTYPE_QUALITY:
2020 lispy = Qsubpixel;
2021 break;
2022 case CLEARTYPE_NATURAL_QUALITY:
2023 lispy = Qnatural;
2024 break;
2025 default:
2026 lispy = Qnil;
2027 break;
2028 }
2029 return lispy;
2030}
2031
2032/* Convert antialiasing symbols to lfQuality */
2033static BYTE
2034w32_antialias_type (Lisp_Object type)
2035{
2036 if (EQ (type, Qnone))
2037 return NONANTIALIASED_QUALITY;
2038 else if (EQ (type, Qstandard))
2039 return ANTIALIASED_QUALITY;
2040 else if (EQ (type, Qsubpixel))
2041 return CLEARTYPE_QUALITY;
2042 else if (EQ (type, Qnatural))
2043 return CLEARTYPE_NATURAL_QUALITY;
2044 else
2045 return DEFAULT_QUALITY;
2046}
2047
2048/* Return a list of all the scripts that the font supports. */
2049static Lisp_Object
2050font_supported_scripts (FONTSIGNATURE * sig)
2051{
2052 DWORD * subranges = sig->fsUsb;
2053 Lisp_Object supported = Qnil;
2054
2055 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2056#define SUBRANGE(n,sym) \
2057 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2058 supported = Fcons ((sym), supported)
2059
2060 /* Match multiple subranges. SYM is set if any MASK bit is set in
2061 subranges[0 - 3]. */
2062#define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2063 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2064 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2065 supported = Fcons ((sym), supported)
2066
2067 SUBRANGE (0, Qlatin);
2068 /* The following count as latin too, ASCII should be present in these fonts,
2069 so don't need to mark them separately. */
2070 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2071 SUBRANGE (4, Qphonetic);
2072 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
2073 SUBRANGE (7, Qgreek);
2074 SUBRANGE (8, Qcoptic);
2075 SUBRANGE (9, Qcyrillic);
2076 SUBRANGE (10, Qarmenian);
2077 SUBRANGE (11, Qhebrew);
2078 /* 12: Vai. */
2079 SUBRANGE (13, Qarabic);
2080 SUBRANGE (14, Qnko);
2081 SUBRANGE (15, Qdevanagari);
2082 SUBRANGE (16, Qbengali);
2083 SUBRANGE (17, Qgurmukhi);
2084 SUBRANGE (18, Qgujarati);
2085 SUBRANGE (19, Qoriya);
2086 SUBRANGE (20, Qtamil);
2087 SUBRANGE (21, Qtelugu);
2088 SUBRANGE (22, Qkannada);
2089 SUBRANGE (23, Qmalayalam);
2090 SUBRANGE (24, Qthai);
2091 SUBRANGE (25, Qlao);
2092 SUBRANGE (26, Qgeorgian);
2093 SUBRANGE (27, Qbalinese);
2094 /* 28: Hangul Jamo. */
2095 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2096 /* 32-47: Symbols (defined below). */
2097 SUBRANGE (48, Qcjk_misc);
2098 /* Match either 49: katakana or 50: hiragana for kana. */
2099 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
2100 SUBRANGE (51, Qbopomofo);
2101 /* 52: Compatibility Jamo */
2102 SUBRANGE (53, Qphags_pa);
2103 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2104 SUBRANGE (56, Qhangul);
2105 /* 57: Surrogates. */
2106 SUBRANGE (58, Qphoenician);
2107 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
2108 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2109 SUBRANGE (59, Qkanbun); /* And this. */
2110 /* 60: Private use, 61: CJK strokes and compatibility. */
2111 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2112 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2113 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2114 /* 69: Specials. */
2115 SUBRANGE (70, Qtibetan);
2116 SUBRANGE (71, Qsyriac);
2117 SUBRANGE (72, Qthaana);
2118 SUBRANGE (73, Qsinhala);
2119 SUBRANGE (74, Qmyanmar);
2120 SUBRANGE (75, Qethiopic);
2121 SUBRANGE (76, Qcherokee);
2122 SUBRANGE (77, Qcanadian_aboriginal);
2123 SUBRANGE (78, Qogham);
2124 SUBRANGE (79, Qrunic);
2125 SUBRANGE (80, Qkhmer);
2126 SUBRANGE (81, Qmongolian);
2127 SUBRANGE (82, Qbraille);
2128 SUBRANGE (83, Qyi);
2129 SUBRANGE (84, Qbuhid);
2130 SUBRANGE (84, Qhanunoo);
2131 SUBRANGE (84, Qtagalog);
2132 SUBRANGE (84, Qtagbanwa);
2133 SUBRANGE (85, Qold_italic);
2134 SUBRANGE (86, Qgothic);
2135 SUBRANGE (87, Qdeseret);
2136 SUBRANGE (88, Qbyzantine_musical_symbol);
2137 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
2138 SUBRANGE (89, Qmathematical);
2139 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2140 SUBRANGE (93, Qlimbu);
2141 SUBRANGE (94, Qtai_le);
2142 /* 95: New Tai Le */
2143 SUBRANGE (90, Qbuginese);
2144 SUBRANGE (97, Qglagolitic);
2145 SUBRANGE (98, Qtifinagh);
2146 /* 99: Yijing Hexagrams. */
2147 SUBRANGE (100, Qsyloti_nagri);
2148 SUBRANGE (101, Qlinear_b);
2149 /* 102: Ancient Greek Numbers. */
2150 SUBRANGE (103, Qugaritic);
2151 SUBRANGE (104, Qold_persian);
2152 SUBRANGE (105, Qshavian);
2153 SUBRANGE (106, Qosmanya);
2154 SUBRANGE (107, Qcypriot);
2155 SUBRANGE (108, Qkharoshthi);
2156 /* 109: Tai Xuan Jing. */
2157 SUBRANGE (110, Qcuneiform);
2158 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2159 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2160 SUBRANGE (118, Qcham);
2161 /* 119: Ancient symbols, 120: Phaistos Disc. */
2162 /* 121: Carian, Lycian, Lydian, 122: Dominos, Mah Jong tiles. */
2163 /* 123-127: Reserved. */
2164
2165 /* There isn't really a main symbol range, so include symbol if any
2166 relevant range is set. */
2167 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2168
2169 /* Missing: Tai Viet (U+AA80-U+AADF). */
2170#undef SUBRANGE
2171#undef MASK_ANY
2172
2173 return supported;
2174}
2175
2176/* Generate a full name for a Windows font.
2177 The full name is in fcname format, with weight, slant and antialiasing
2178 specified if they are not "normal". */
2179static int
2180w32font_full_name (LOGFONT * font, Lisp_Object font_obj,
2181 int pixel_size, char *name, int nbytes)
2182{
2183 int len, height, outline;
2184 char *p;
2185 Lisp_Object antialiasing, weight = Qnil;
2186
2187 len = strlen (font->lfFaceName);
2188
2189 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2190
2191 /* Represent size of scalable fonts by point size. But use pixelsize for
2192 raster fonts to indicate that they are exactly that size. */
2193 if (outline)
2194 len += 11; /* -SIZE */
2195 else
2196 len += 21;
2197
2198 if (font->lfItalic)
2199 len += 7; /* :italic */
2200
2201 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2202 {
2203 weight = w32_to_fc_weight (font->lfWeight);
2204 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
2205 }
2206
2207 antialiasing = lispy_antialias_type (font->lfQuality);
2208 if (! NILP (antialiasing))
2209 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2210
2211 /* Check that the buffer is big enough */
2212 if (len > nbytes)
2213 return -1;
2214
2215 p = name;
2216 p += sprintf (p, "%s", font->lfFaceName);
2217
2218 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2219
2220 if (height > 0)
2221 {
2222 if (outline)
2223 {
2224 float pointsize = height * 72.0 / one_w32_display_info.resy;
2225 /* Round to nearest half point. floor is used, since round is not
2226 supported in MS library. */
2227 pointsize = floor (pointsize * 2 + 0.5) / 2;
2228 p += sprintf (p, "-%1.1f", pointsize);
2229 }
2230 else
2231 p += sprintf (p, ":pixelsize=%d", height);
2232 }
2233
2234 if (SYMBOLP (weight) && ! NILP (weight))
2235 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2236
2237 if (font->lfItalic)
2238 p += sprintf (p, ":italic");
2239
2240 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2241 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2242
2243 return (p - name);
2244}
2245
2246/* Convert a logfont and point size into a fontconfig style font name.
2247 POINTSIZE is in tenths of points.
2248 If SIZE indicates the size of buffer FCNAME, into which the font name
2249 is written. If the buffer is not large enough to contain the name,
2250 the function returns -1, otherwise it returns the number of bytes
2251 written to FCNAME. */
2252static int
2253logfont_to_fcname (LOGFONT* font, int pointsize, char *fcname, int size)
2254{
2255 int len, height;
2256 char *p = fcname;
2257 Lisp_Object weight = Qnil;
2258
2259 len = strlen (font->lfFaceName) + 2;
2260 height = pointsize / 10;
2261 while (height /= 10)
2262 len++;
2263
2264 if (pointsize % 10)
2265 len += 2;
2266
2267 if (font->lfItalic)
2268 len += 7; /* :italic */
2269 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2270 {
2271 weight = w32_to_fc_weight (font->lfWeight);
2272 len += SBYTES (SYMBOL_NAME (weight)) + 1;
2273 }
2274
2275 if (len > size)
2276 return -1;
2277
2278 p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2279 if (pointsize % 10)
2280 p += sprintf (p, ".%d", pointsize % 10);
2281
2282 if (SYMBOLP (weight) && !NILP (weight))
2283 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2284
2285 if (font->lfItalic)
2286 p += sprintf (p, ":italic");
2287
2288 return (p - fcname);
2289}
2290
2291static void
2292compute_metrics (HDC dc, struct w32font_info *w32_font, unsigned int code,
2293 struct w32_metric_cache *metrics)
2294{
2295 GLYPHMETRICS gm;
2296 MAT2 transform;
2297 unsigned int options = GGO_METRICS;
2298
2299 if (w32_font->glyph_idx)
2300 options |= GGO_GLYPH_INDEX;
2301
2302 memset (&transform, 0, sizeof (transform));
2303 transform.eM11.value = 1;
2304 transform.eM22.value = 1;
2305
2306 if (GetGlyphOutlineW (dc, code, options, &gm, 0, NULL, &transform)
2307 != GDI_ERROR)
2308 {
2309 metrics->lbearing = gm.gmptGlyphOrigin.x;
2310 metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2311 metrics->width = gm.gmCellIncX;
2312 metrics->status = W32METRIC_SUCCESS;
2313 }
2314 else
2315 metrics->status = W32METRIC_FAIL;
2316}
2317
2318DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2319 doc: /* Read a font name using a W32 font selection dialog.
2320Return fontconfig style font string corresponding to the selection.
2321
2322If FRAME is omitted or nil, it defaults to the selected frame.
2323If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2324in the font selection dialog. */)
2325 (Lisp_Object frame, Lisp_Object exclude_proportional)
2326{
2327 FRAME_PTR f = check_x_frame (frame);
2328 CHOOSEFONT cf;
2329 LOGFONT lf;
2330 TEXTMETRIC tm;
2331 HDC hdc;
2332 HANDLE oldobj;
2333 char buf[100];
2334
2335 memset (&cf, 0, sizeof (cf));
2336 memset (&lf, 0, sizeof (lf));
2337
2338 cf.lStructSize = sizeof (cf);
2339 cf.hwndOwner = FRAME_W32_WINDOW (f);
2340 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2341
2342 /* If exclude_proportional is non-nil, limit the selection to
2343 monospaced fonts. */
2344 if (!NILP (exclude_proportional))
2345 cf.Flags |= CF_FIXEDPITCHONLY;
2346
2347 cf.lpLogFont = &lf;
2348
2349 /* Initialize as much of the font details as we can from the current
2350 default font. */
2351 hdc = GetDC (FRAME_W32_WINDOW (f));
2352 oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
2353 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2354 if (GetTextMetrics (hdc, &tm))
2355 {
2356 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2357 lf.lfWeight = tm.tmWeight;
2358 lf.lfItalic = tm.tmItalic;
2359 lf.lfUnderline = tm.tmUnderlined;
2360 lf.lfStrikeOut = tm.tmStruckOut;
2361 lf.lfCharSet = tm.tmCharSet;
2362 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2363 }
2364 SelectObject (hdc, oldobj);
2365 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2366
2367 if (!ChooseFont (&cf)
2368 || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
2369 return Qnil;
2370
2371 return DECODE_SYSTEM (build_string (buf));
2372}
2373
2374static const char *const w32font_booleans [] = {
2375 NULL,
2376};
2377
2378static const char *const w32font_non_booleans [] = {
2379 ":script",
2380 ":antialias",
2381 ":style",
2382 NULL,
2383};
2384
2385static void
2386w32font_filter_properties (Lisp_Object font, Lisp_Object alist)
2387{
2388 font_filter_properties (font, alist, w32font_booleans, w32font_non_booleans);
2389}
2390
2391struct font_driver w32font_driver =
2392 {
2393 0, /* Qgdi */
2394 0, /* case insensitive */
2395 w32font_get_cache,
2396 w32font_list,
2397 w32font_match,
2398 w32font_list_family,
2399 NULL, /* free_entity */
2400 w32font_open,
2401 w32font_close,
2402 NULL, /* prepare_face */
2403 NULL, /* done_face */
2404 w32font_has_char,
2405 w32font_encode_char,
2406 w32font_text_extents,
2407 w32font_draw,
2408 NULL, /* get_bitmap */
2409 NULL, /* free_bitmap */
2410 NULL, /* get_outline */
2411 NULL, /* free_outline */
2412 NULL, /* anchor_point */
2413 NULL, /* otf_capability */
2414 NULL, /* otf_drive */
2415 NULL, /* start_for_frame */
2416 NULL, /* end_for_frame */
2417 NULL, /* shape */
2418 NULL, /* check */
2419 NULL, /* get_variation_glyphs */
2420 w32font_filter_properties,
2421 };
2422
2423
2424/* Initialize state that does not change between invocations. This is only
2425 called when Emacs is dumped. */
2426void
2427syms_of_w32font (void)
2428{
2429 DEFSYM (Qgdi, "gdi");
2430 DEFSYM (Quniscribe, "uniscribe");
2431 DEFSYM (QCformat, ":format");
2432
2433 /* Generic font families. */
2434 DEFSYM (Qmonospace, "monospace");
2435 DEFSYM (Qserif, "serif");
2436 DEFSYM (Qsansserif, "sansserif");
2437 DEFSYM (Qscript, "script");
2438 DEFSYM (Qdecorative, "decorative");
2439 /* Aliases. */
2440 DEFSYM (Qsans_serif, "sans_serif");
2441 DEFSYM (Qsans, "sans");
2442 DEFSYM (Qmono, "mono");
2443
2444 /* Fake foundries. */
2445 DEFSYM (Qraster, "raster");
2446 DEFSYM (Qoutline, "outline");
2447 DEFSYM (Qunknown, "unknown");
2448
2449 /* Antialiasing. */
2450 DEFSYM (Qstandard, "standard");
2451 DEFSYM (Qsubpixel, "subpixel");
2452 DEFSYM (Qnatural, "natural");
2453
2454 /* Languages */
2455 DEFSYM (Qzh, "zh");
2456
2457 /* Scripts */
2458 DEFSYM (Qlatin, "latin");
2459 DEFSYM (Qgreek, "greek");
2460 DEFSYM (Qcoptic, "coptic");
2461 DEFSYM (Qcyrillic, "cyrillic");
2462 DEFSYM (Qarmenian, "armenian");
2463 DEFSYM (Qhebrew, "hebrew");
2464 DEFSYM (Qarabic, "arabic");
2465 DEFSYM (Qsyriac, "syriac");
2466 DEFSYM (Qnko, "nko");
2467 DEFSYM (Qthaana, "thaana");
2468 DEFSYM (Qdevanagari, "devanagari");
2469 DEFSYM (Qbengali, "bengali");
2470 DEFSYM (Qgurmukhi, "gurmukhi");
2471 DEFSYM (Qgujarati, "gujarati");
2472 DEFSYM (Qoriya, "oriya");
2473 DEFSYM (Qtamil, "tamil");
2474 DEFSYM (Qtelugu, "telugu");
2475 DEFSYM (Qkannada, "kannada");
2476 DEFSYM (Qmalayalam, "malayalam");
2477 DEFSYM (Qsinhala, "sinhala");
2478 DEFSYM (Qthai, "thai");
2479 DEFSYM (Qlao, "lao");
2480 DEFSYM (Qtibetan, "tibetan");
2481 DEFSYM (Qmyanmar, "myanmar");
2482 DEFSYM (Qgeorgian, "georgian");
2483 DEFSYM (Qhangul, "hangul");
2484 DEFSYM (Qethiopic, "ethiopic");
2485 DEFSYM (Qcherokee, "cherokee");
2486 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2487 DEFSYM (Qogham, "ogham");
2488 DEFSYM (Qrunic, "runic");
2489 DEFSYM (Qkhmer, "khmer");
2490 DEFSYM (Qmongolian, "mongolian");
2491 DEFSYM (Qsymbol, "symbol");
2492 DEFSYM (Qbraille, "braille");
2493 DEFSYM (Qhan, "han");
2494 DEFSYM (Qideographic_description, "ideographic-description");
2495 DEFSYM (Qcjk_misc, "cjk-misc");
2496 DEFSYM (Qkana, "kana");
2497 DEFSYM (Qbopomofo, "bopomofo");
2498 DEFSYM (Qkanbun, "kanbun");
2499 DEFSYM (Qyi, "yi");
2500 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2501 DEFSYM (Qmusical_symbol, "musical-symbol");
2502 DEFSYM (Qmathematical, "mathematical");
2503 DEFSYM (Qcham, "cham");
2504 DEFSYM (Qphonetic, "phonetic");
2505 DEFSYM (Qbalinese, "balinese");
2506 DEFSYM (Qbuginese, "buginese");
2507 DEFSYM (Qbuhid, "buhid");
2508 DEFSYM (Qcuneiform, "cuneiform");
2509 DEFSYM (Qcypriot, "cypriot");
2510 DEFSYM (Qdeseret, "deseret");
2511 DEFSYM (Qglagolitic, "glagolitic");
2512 DEFSYM (Qgothic, "gothic");
2513 DEFSYM (Qhanunoo, "hanunoo");
2514 DEFSYM (Qkharoshthi, "kharoshthi");
2515 DEFSYM (Qlimbu, "limbu");
2516 DEFSYM (Qlinear_b, "linear_b");
2517 DEFSYM (Qold_italic, "old_italic");
2518 DEFSYM (Qold_persian, "old_persian");
2519 DEFSYM (Qosmanya, "osmanya");
2520 DEFSYM (Qphags_pa, "phags-pa");
2521 DEFSYM (Qphoenician, "phoenician");
2522 DEFSYM (Qshavian, "shavian");
2523 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2524 DEFSYM (Qtagalog, "tagalog");
2525 DEFSYM (Qtagbanwa, "tagbanwa");
2526 DEFSYM (Qtai_le, "tai_le");
2527 DEFSYM (Qtifinagh, "tifinagh");
2528 DEFSYM (Qugaritic, "ugaritic");
2529
2530 /* W32 font encodings. */
2531 DEFVAR_LISP ("w32-charset-info-alist",
2532 Vw32_charset_info_alist,
2533 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2534Each entry should be of the form:
2535
2536 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2537
2538where CHARSET_NAME is a string used in font names to identify the charset,
2539WINDOWS_CHARSET is a symbol that can be one of:
2540
2541 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2542 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2543 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2544 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2545 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2546 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2547 or w32-charset-oem.
2548
2549CODEPAGE should be an integer specifying the codepage that should be used
2550to display the character set, t to do no translation and output as Unicode,
2551or nil to do no translation and output as 8 bit (or multibyte on far-east
2552versions of Windows) characters. */);
2553 Vw32_charset_info_alist = Qnil;
2554
2555 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2556 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2557 DEFSYM (Qw32_charset_default, "w32-charset-default");
2558 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2559 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2560 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2561 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2562 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2563 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2564 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2565 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2566 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2567 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2568 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2569 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2570 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2571 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2572 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2573 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2574
2575 defsubr (&Sx_select_font);
2576
2577 w32font_driver.type = Qgdi;
2578 register_font_driver (&w32font_driver, NULL);
2579}
2580