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