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