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