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