Don't ignore .arch-inventory.
[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
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
7e14d905 8the Free Software Foundation; either version 3, or (at your option)
f7a84cb4
JR
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19Boston, MA 02110-1301, USA. */
20
21#include <config.h>
22#include <windows.h>
23
24#include "lisp.h"
25#include "w32term.h"
26#include "frame.h"
27#include "dispextern.h"
28#include "character.h"
29#include "charset.h"
30#include "fontset.h"
31#include "font.h"
46fd1ded 32#include "w32font.h"
f7a84cb4 33
91583281
JR
34/* Cleartype available on Windows XP, cleartype_natural from XP SP1.
35 The latter does not try to fit cleartype smoothed fonts into the
36 same bounding box as the non-antialiased version of the font.
37 */
38#ifndef CLEARTYPE_QUALITY
39#define CLEARTYPE_QUALITY 5
40#endif
41#ifndef CLEARTYPE_NATURAL_QUALITY
42#define CLEARTYPE_NATURAL_QUALITY 6
43#endif
44
f7a84cb4
JR
45extern struct font_driver w32font_driver;
46
91583281 47Lisp_Object Qgdi;
9e1a2995
JR
48static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif;
49static Lisp_Object Qserif, Qscript, Qdecorative;
50static Lisp_Object Qraster, Qoutline, Qunknown;
d205d43b 51
91583281
JR
52/* antialiasing */
53extern Lisp_Object QCantialias; /* defined in font.c */
54extern Lisp_Object Qnone; /* reuse from w32fns.c */
55static Lisp_Object Qstandard, Qsubpixel, Qnatural;
56
d205d43b
JR
57/* scripts */
58static Lisp_Object Qlatin, Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
59static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
60static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
61static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
62static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
63static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
64static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
65static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
66static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
67static Lisp_Object Qmusical_symbol, Qmathematical;
68
69/* Font spacing symbols - defined in font.c. */
70extern Lisp_Object Qc, Qp, Qm;
f7a84cb4
JR
71
72static void fill_in_logfont P_ ((FRAME_PTR f, LOGFONT *logfont,
73 Lisp_Object font_spec));
74
91583281
JR
75static BYTE w32_antialias_type P_ ((Lisp_Object type));
76static Lisp_Object lispy_antialias_type P_ ((BYTE type));
77
d205d43b 78static Lisp_Object font_supported_scripts P_ ((FONTSIGNATURE * sig));
f7a84cb4
JR
79
80/* From old font code in w32fns.c */
81char * w32_to_x_charset P_ ((int charset, char * matching));
82
83static Lisp_Object w32_registry P_ ((LONG w32_charset));
84
85/* EnumFontFamiliesEx callbacks. */
86static int CALLBACK add_font_entity_to_list P_ ((ENUMLOGFONTEX *,
87 NEWTEXTMETRICEX *,
88 DWORD, LPARAM));
89static int CALLBACK add_one_font_entity_to_list P_ ((ENUMLOGFONTEX *,
90 NEWTEXTMETRICEX *,
91 DWORD, LPARAM));
92static int CALLBACK add_font_name_to_list P_ ((ENUMLOGFONTEX *,
93 NEWTEXTMETRICEX *,
94 DWORD, LPARAM));
95
d205d43b
JR
96/* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
97 of what we really want. */
98struct font_callback_data
99{
100 /* The logfont we are matching against. EnumFontFamiliesEx only matches
101 face name and charset, so we need to manually match everything else
102 in the callback function. */
103 LOGFONT pattern;
104 /* The original font spec or entity. */
105 Lisp_Object orig_font_spec;
106 /* The frame the font is being loaded on. */
107 Lisp_Object frame;
108 /* The list to add matches to. */
109 Lisp_Object list;
46fd1ded
JR
110 /* Whether to match only opentype fonts. */
111 int opentype_only;
d205d43b
JR
112};
113
114/* Handles the problem that EnumFontFamiliesEx will not return all
115 style variations if the font name is not specified. */
a74ddbda 116static void list_all_matching_fonts P_ ((struct font_callback_data *match));
d205d43b
JR
117
118
f7a84cb4
JR
119/* MingW headers only define this when _WIN32_WINNT >= 0x0500, but we
120 target older versions. */
a74ddbda 121#ifndef GGI_MARK_NONEXISTING_GLYPHS
f7a84cb4 122#define GGI_MARK_NONEXISTING_GLYPHS 1
a74ddbda 123#endif
f7a84cb4
JR
124
125static int
126memq_no_quit (elt, list)
127 Lisp_Object elt, list;
128{
129 while (CONSP (list) && ! EQ (XCAR (list), elt))
130 list = XCDR (list);
131 return (CONSP (list));
132}
133
134/* w32 implementation of get_cache for font backend.
135 Return a cache of font-entities on FRAME. The cache must be a
136 cons whose cdr part is the actual cache area. */
46fd1ded 137Lisp_Object
a4c71909
KH
138w32font_get_cache (f)
139 FRAME_PTR f;
f7a84cb4 140{
a4c71909 141 struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
f7a84cb4
JR
142
143 return (dpyinfo->name_list_element);
144}
145
146/* w32 implementation of list for font backend.
147 List fonts exactly matching with FONT_SPEC on FRAME. The value
148 is a vector of font-entities. This is the sole API that
149 allocates font-entities. */
20399669
JR
150static Lisp_Object
151w32font_list (frame, font_spec)
152 Lisp_Object frame, font_spec;
f7a84cb4 153{
46fd1ded 154 return w32font_list_internal (frame, font_spec, 0);
f7a84cb4
JR
155}
156
157/* w32 implementation of match for font backend.
158 Return a font entity most closely matching with FONT_SPEC on
159 FRAME. The closeness is detemined by the font backend, thus
160 `face-font-selection-order' is ignored here. */
20399669
JR
161static Lisp_Object
162w32font_match (frame, font_spec)
163 Lisp_Object frame, font_spec;
f7a84cb4 164{
46fd1ded 165 return w32font_match_internal (frame, font_spec, 0);
f7a84cb4
JR
166}
167
f7a84cb4
JR
168/* w32 implementation of list_family for font backend.
169 List available families. The value is a list of family names
170 (symbols). */
20399669
JR
171static Lisp_Object
172w32font_list_family (frame)
173 Lisp_Object frame;
f7a84cb4
JR
174{
175 Lisp_Object list = Qnil;
176 LOGFONT font_match_pattern;
177 HDC dc;
178 FRAME_PTR f = XFRAME (frame);
179
180 bzero (&font_match_pattern, sizeof (font_match_pattern));
181
182 dc = get_frame_dc (f);
183
184 EnumFontFamiliesEx (dc, &font_match_pattern,
185 (FONTENUMPROC) add_font_name_to_list,
186 (LPARAM) &list, 0);
187 release_frame_dc (f, dc);
188
189 return list;
190}
191
192/* w32 implementation of open for font backend.
193 Open a font specified by FONT_ENTITY on frame F.
194 If the font is scalable, open it with PIXEL_SIZE. */
f0121ad2 195static struct font *
20399669
JR
196w32font_open (f, font_entity, pixel_size)
197 FRAME_PTR f;
198 Lisp_Object font_entity;
199 int pixel_size;
f7a84cb4 200{
f7a84cb4
JR
201 struct w32font_info *w32_font = xmalloc (sizeof (struct w32font_info));
202
f0121ad2 203 if (w32_font == NULL)
f7a84cb4
JR
204 return NULL;
205
f0121ad2 206 if (!w32font_open_internal (f, font_entity, pixel_size, w32_font))
f7a84cb4
JR
207 {
208 xfree (w32_font);
209 return NULL;
210 }
211
f0121ad2 212 return (struct font *) w32_font;
f7a84cb4
JR
213}
214
215/* w32 implementation of close for font_backend.
216 Close FONT on frame F. */
46fd1ded 217void
20399669
JR
218w32font_close (f, font)
219 FRAME_PTR f;
220 struct font *font;
f7a84cb4
JR
221{
222 if (font->font.font)
223 {
224 W32FontStruct *old_w32_font = (W32FontStruct *)font->font.font;
e9a15283 225 DeleteObject (old_w32_font->hfont);
f7a84cb4
JR
226 xfree (old_w32_font);
227 font->font.font = 0;
228 }
229
5ace1ec1
JR
230 if (font->font.full_name && font->font.full_name != font->font.name)
231 xfree (font->font.full_name);
232
f7a84cb4
JR
233 if (font->font.name)
234 xfree (font->font.name);
5ace1ec1 235
f7a84cb4
JR
236 xfree (font);
237}
238
239/* w32 implementation of has_char for font backend.
240 Optional.
241 If FONT_ENTITY has a glyph for character C (Unicode code point),
242 return 1. If not, return 0. If a font must be opened to check
243 it, return -1. */
46fd1ded 244int
20399669
JR
245w32font_has_char (entity, c)
246 Lisp_Object entity;
247 int c;
f7a84cb4 248{
d205d43b 249 Lisp_Object supported_scripts, extra, script;
f7a84cb4
JR
250 DWORD mask;
251
01dbeb0b
JR
252 extra = AREF (entity, FONT_EXTRA_INDEX);
253 if (!CONSP (extra))
254 return -1;
255
d205d43b
JR
256 supported_scripts = assq_no_quit (QCscript, extra);
257 if (!CONSP (supported_scripts))
f7a84cb4
JR
258 return -1;
259
d205d43b 260 supported_scripts = XCDR (supported_scripts);
f7a84cb4 261
d205d43b 262 script = CHAR_TABLE_REF (Vchar_script_table, c);
f7a84cb4 263
d205d43b 264 return (memq_no_quit (script, supported_scripts)) ? 1 : 0;
f7a84cb4
JR
265}
266
267/* w32 implementation of encode_char for font backend.
268 Return a glyph code of FONT for characer C (Unicode code point).
269 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
46fd1ded 270unsigned
20399669
JR
271w32font_encode_char (font, c)
272 struct font *font;
273 int c;
f7a84cb4 274{
d205d43b
JR
275 /* Avoid unneccesary conversion - all the Win32 APIs will take a unicode
276 character. */
f7a84cb4
JR
277 return c;
278}
279
280/* w32 implementation of text_extents for font backend.
281 Perform the size computation of glyphs of FONT and fillin members
282 of METRICS. The glyphs are specified by their glyph codes in
78573c57 283 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
f7a84cb4 284 case just return the overall width. */
46fd1ded 285int
20399669
JR
286w32font_text_extents (font, code, nglyphs, metrics)
287 struct font *font;
288 unsigned *code;
289 int nglyphs;
290 struct font_metrics *metrics;
f7a84cb4
JR
291{
292 int i;
293 HFONT old_font;
46fd1ded
JR
294 HDC dc;
295 struct frame * f;
f7a84cb4 296 int total_width = 0;
f7a84cb4 297 WORD *wcode = alloca(nglyphs * sizeof (WORD));
d205d43b 298 SIZE size;
f7a84cb4 299
859a9fdf
JR
300#if 0
301 /* Frames can come and go, and their fonts outlive them. This is
302 particularly troublesome with tooltip frames, and causes crashes. */
46fd1ded 303 f = ((struct w32font_info *)font)->owning_frame;
859a9fdf 304#else
9e1a2995 305 f = XFRAME (selected_frame);
859a9fdf
JR
306#endif
307
46fd1ded 308 dc = get_frame_dc (f);
f7a84cb4
JR
309 old_font = SelectObject (dc, ((W32FontStruct *)(font->font.font))->hfont);
310
311 if (metrics)
312 {
313 GLYPHMETRICS gm;
d205d43b 314 MAT2 transform;
d205d43b
JR
315
316 /* Set transform to the identity matrix. */
317 bzero (&transform, sizeof (transform));
318 transform.eM11.value = 1;
319 transform.eM22.value = 1;
78573c57
JR
320 metrics->width = 0;
321 metrics->ascent = 0;
322 metrics->descent = 0;
f7a84cb4
JR
323
324 for (i = 0; i < nglyphs; i++)
325 {
78573c57 326 if (GetGlyphOutlineW (dc, *(code + i), GGO_METRICS, &gm, 0,
d205d43b 327 NULL, &transform) != GDI_ERROR)
f7a84cb4 328 {
78573c57
JR
329 int new_val = metrics->width + gm.gmBlackBoxX
330 + gm.gmptGlyphOrigin.x;
331
332 metrics->rbearing = max (metrics->rbearing, new_val);
333 metrics->width += gm.gmCellIncX;
334 new_val = -gm.gmptGlyphOrigin.y;
335 metrics->ascent = max (metrics->ascent, new_val);
336 new_val = gm.gmBlackBoxY + gm.gmptGlyphOrigin.y;
337 metrics->descent = max (metrics->descent, new_val);
1065a502 338 }
f7a84cb4
JR
339 else
340 {
78573c57
JR
341 /* Rely on an estimate based on the overall font metrics. */
342 break;
f7a84cb4
JR
343 }
344 }
78573c57
JR
345
346 /* If we got through everything, return. */
347 if (i == nglyphs)
348 {
349 /* Restore state and release DC. */
350 SelectObject (dc, old_font);
46fd1ded 351 release_frame_dc (f, dc);
78573c57
JR
352
353 return metrics->width;
354 }
f7a84cb4 355 }
78573c57
JR
356
357 for (i = 0; i < nglyphs; i++)
f7a84cb4 358 {
78573c57
JR
359 if (code[i] < 0x10000)
360 wcode[i] = code[i];
361 else
362 {
363 /* TODO: Convert to surrogate, reallocating array if needed */
364 wcode[i] = 0xffff;
365 }
f7a84cb4
JR
366 }
367
d205d43b 368 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
f7a84cb4 369 {
d205d43b 370 total_width = size.cx;
f7a84cb4
JR
371 }
372
d205d43b 373 if (!total_width)
f7a84cb4
JR
374 {
375 RECT rect;
376 rect.top = 0; rect.bottom = font->font.height; rect.left = 0; rect.right = 1;
377 DrawTextW (dc, wcode, nglyphs, &rect,
378 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
379 total_width = rect.right;
380 }
d205d43b 381
78573c57
JR
382 if (metrics)
383 {
384 metrics->width = total_width;
385 metrics->ascent = font->ascent;
386 metrics->descent = font->descent;
387 metrics->lbearing = 0;
388 metrics->rbearing = total_width
389 + ((struct w32font_info *) font)->metrics.tmOverhang;
390 }
391
f7a84cb4
JR
392 /* Restore state and release DC. */
393 SelectObject (dc, old_font);
46fd1ded 394 release_frame_dc (f, dc);
f7a84cb4
JR
395
396 return total_width;
397}
398
399/* w32 implementation of draw for font backend.
400 Optional.
401 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
402 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
403 is nonzero, fill the background in advance. It is assured that
a74ddbda
JR
404 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
405
406 TODO: Currently this assumes that the colors and fonts are already
407 set in the DC. This seems to be true now, but maybe only due to
408 the old font code setting it up. It may be safer to resolve faces
409 and fonts in here and set them explicitly
410*/
411
46fd1ded 412int
20399669
JR
413w32font_draw (s, from, to, x, y, with_background)
414 struct glyph_string *s;
415 int from, to, x, y, with_background;
f7a84cb4
JR
416{
417 UINT options = 0;
5c2c9c79
JR
418 HRGN orig_clip;
419
420 /* Save clip region for later restoration. */
421 GetClipRgn(s->hdc, orig_clip);
422
423 if (s->num_clips > 0)
424 {
425 HRGN new_clip = CreateRectRgnIndirect (s->clip);
426
427 if (s->num_clips > 1)
428 {
429 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
430
431 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
432 DeleteObject (clip2);
433 }
434
435 SelectClipRgn (s->hdc, new_clip);
436 DeleteObject (new_clip);
437 }
f7a84cb4 438
fb3b8017
JR
439 /* Using OPAQUE background mode can clear more background than expected
440 when Cleartype is used. Draw the background manually to avoid this. */
441 SetBkMode (s->hdc, TRANSPARENT);
f7a84cb4
JR
442 if (with_background)
443 {
1065a502
JR
444 HBRUSH brush;
445 RECT rect;
fb3b8017 446 struct font *font = (struct font *) s->face->font_info;
1065a502
JR
447
448 brush = CreateSolidBrush (s->gc->background);
449 rect.left = x;
fb3b8017 450 rect.top = y - font->ascent;
1065a502 451 rect.right = x + s->width;
fb3b8017 452 rect.bottom = y + font->descent;
1065a502 453 FillRect (s->hdc, &rect, brush);
f2b25c0e 454 DeleteObject (brush);
f7a84cb4 455 }
040fe918
JR
456
457 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, to - from, NULL);
5c2c9c79
JR
458
459 /* Restore clip region. */
460 if (s->num_clips > 0)
461 {
462 SelectClipRgn (s->hdc, orig_clip);
463 }
f7a84cb4
JR
464}
465
466/* w32 implementation of free_entity for font backend.
467 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
468 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
20399669
JR
469static void
470w32font_free_entity (Lisp_Object entity);
f7a84cb4
JR
471 */
472
473/* w32 implementation of prepare_face for font backend.
474 Optional (if FACE->extra is not used).
475 Prepare FACE for displaying characters by FONT on frame F by
476 storing some data in FACE->extra. If successful, return 0.
477 Otherwise, return -1.
20399669
JR
478static int
479w32font_prepare_face (FRAME_PTR f, struct face *face);
f7a84cb4
JR
480 */
481/* w32 implementation of done_face for font backend.
482 Optional.
483 Done FACE for displaying characters by FACE->font on frame F.
20399669
JR
484static void
485w32font_done_face (FRAME_PTR f, struct face *face); */
f7a84cb4
JR
486
487/* w32 implementation of get_bitmap for font backend.
488 Optional.
489 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
f2b25c0e 490 intended that this method is called from the other font-driver
f7a84cb4 491 for actual drawing.
20399669
JR
492static int
493w32font_get_bitmap (struct font *font, unsigned code,
494 struct font_bitmap *bitmap, int bits_per_pixel);
f7a84cb4
JR
495 */
496/* w32 implementation of free_bitmap for font backend.
497 Optional.
498 Free bitmap data in BITMAP.
20399669
JR
499static void
500w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
f7a84cb4
JR
501 */
502/* w32 implementation of get_outline for font backend.
503 Optional.
504 Return an outline data for glyph-code CODE of FONT. The format
505 of the outline data depends on the font-driver.
20399669
JR
506static void *
507w32font_get_outline (struct font *font, unsigned code);
f7a84cb4
JR
508 */
509/* w32 implementation of free_outline for font backend.
510 Optional.
511 Free OUTLINE (that is obtained by the above method).
20399669
JR
512static void
513w32font_free_outline (struct font *font, void *outline);
f7a84cb4
JR
514 */
515/* w32 implementation of anchor_point for font backend.
516 Optional.
517 Get coordinates of the INDEXth anchor point of the glyph whose
518 code is CODE. Store the coordinates in *X and *Y. Return 0 if
519 the operations was successfull. Otherwise return -1.
20399669
JR
520static int
521w32font_anchor_point (struct font *font, unsigned code,
f7a84cb4
JR
522 int index, int *x, int *y);
523 */
524/* w32 implementation of otf_capability for font backend.
525 Optional.
526 Return a list describing which scripts/languages FONT
527 supports by which GSUB/GPOS features of OpenType tables.
20399669
JR
528static Lisp_Object
529w32font_otf_capability (struct font *font);
f7a84cb4
JR
530 */
531/* w32 implementation of otf_drive for font backend.
532 Optional.
533 Apply FONT's OTF-FEATURES to the glyph string.
534
535 FEATURES specifies which OTF features to apply in this format:
536 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
537 See the documentation of `font-drive-otf' for the detail.
538
539 This method applies the specified features to the codes in the
540 elements of GSTRING-IN (between FROMth and TOth). The output
541 codes are stored in GSTRING-OUT at the IDXth element and the
542 following elements.
543
544 Return the number of output codes. If none of the features are
545 applicable to the input data, return 0. If GSTRING-OUT is too
546 short, return -1.
20399669
JR
547static int
548w32font_otf_drive (struct font *font, Lisp_Object features,
549 Lisp_Object gstring_in, int from, int to,
550 Lisp_Object gstring_out, int idx,
551 int alternate_subst);
f7a84cb4
JR
552 */
553
46fd1ded
JR
554/* Internal implementation of w32font_list.
555 Additional parameter opentype_only restricts the returned fonts to
556 opentype fonts, which can be used with the Uniscribe backend. */
557Lisp_Object
558w32font_list_internal (frame, font_spec, opentype_only)
559 Lisp_Object frame, font_spec;
560 int opentype_only;
561{
562 struct font_callback_data match_data;
563 HDC dc;
564 FRAME_PTR f = XFRAME (frame);
565
566 match_data.orig_font_spec = font_spec;
567 match_data.list = Qnil;
568 match_data.frame = frame;
569
570 bzero (&match_data.pattern, sizeof (LOGFONT));
571 fill_in_logfont (f, &match_data.pattern, font_spec);
572
573 match_data.opentype_only = opentype_only;
574 if (opentype_only)
575 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
576
577 if (match_data.pattern.lfFaceName[0] == '\0')
578 {
579 /* EnumFontFamiliesEx does not take other fields into account if
580 font name is blank, so need to use two passes. */
581 list_all_matching_fonts (&match_data);
582 }
583 else
584 {
585 dc = get_frame_dc (f);
586
587 EnumFontFamiliesEx (dc, &match_data.pattern,
588 (FONTENUMPROC) add_font_entity_to_list,
589 (LPARAM) &match_data, 0);
590 release_frame_dc (f, dc);
591 }
592
593 return NILP (match_data.list) ? null_vector : Fvconcat (1, &match_data.list);
594}
595
596/* Internal implementation of w32font_match.
597 Additional parameter opentype_only restricts the returned fonts to
598 opentype fonts, which can be used with the Uniscribe backend. */
599Lisp_Object
600w32font_match_internal (frame, font_spec, opentype_only)
601 Lisp_Object frame, font_spec;
602 int opentype_only;
603{
604 struct font_callback_data match_data;
605 HDC dc;
606 FRAME_PTR f = XFRAME (frame);
607
608 match_data.orig_font_spec = font_spec;
609 match_data.frame = frame;
610 match_data.list = Qnil;
611
612 bzero (&match_data.pattern, sizeof (LOGFONT));
613 fill_in_logfont (f, &match_data.pattern, font_spec);
614
615 match_data.opentype_only = opentype_only;
616 if (opentype_only)
617 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
618
619 dc = get_frame_dc (f);
620
621 EnumFontFamiliesEx (dc, &match_data.pattern,
622 (FONTENUMPROC) add_one_font_entity_to_list,
623 (LPARAM) &match_data, 0);
624 release_frame_dc (f, dc);
625
626 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
627}
628
f0121ad2
JR
629int
630w32font_open_internal (f, font_entity, pixel_size, w32_font)
631 FRAME_PTR f;
632 Lisp_Object font_entity;
633 int pixel_size;
634 struct w32font_info *w32_font;
635{
636 int len, size;
637 LOGFONT logfont;
638 HDC dc;
639 HFONT hfont, old_font;
640 Lisp_Object val, extra;
641 /* For backwards compatibility. */
642 W32FontStruct *compat_w32_font;
643
644 struct font * font = (struct font *) w32_font;
645 if (!font)
646 return 0;
647
648 bzero (&logfont, sizeof (logfont));
649 fill_in_logfont (f, &logfont, font_entity);
650
651 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
652 if (!size)
653 size = pixel_size;
654
655 logfont.lfHeight = -size;
656 hfont = CreateFontIndirect (&logfont);
657
658 if (hfont == NULL)
659 return 0;
660
661 w32_font->owning_frame = f;
662
663 /* Get the metrics for this font. */
664 dc = get_frame_dc (f);
665 old_font = SelectObject (dc, hfont);
666
667 GetTextMetrics (dc, &w32_font->metrics);
668
669 SelectObject (dc, old_font);
670 release_frame_dc (f, dc);
671 /* W32FontStruct - we should get rid of this, and use the w32font_info
672 struct for any W32 specific fields. font->font.font can then be hfont. */
673 font->font.font = xmalloc (sizeof (W32FontStruct));
674 compat_w32_font = (W32FontStruct *) font->font.font;
675 bzero (compat_w32_font, sizeof (W32FontStruct));
676 compat_w32_font->font_type = UNICODE_FONT;
677 /* Duplicate the text metrics. */
678 bcopy (&w32_font->metrics, &compat_w32_font->tm, sizeof (TEXTMETRIC));
679 compat_w32_font->hfont = hfont;
680
681 len = strlen (logfont.lfFaceName);
682 font->font.name = (char *) xmalloc (len + 1);
683 bcopy (logfont.lfFaceName, font->font.name, len);
684 font->font.name[len] = '\0';
5ace1ec1
JR
685
686 {
687 char *name;
688
689 /* We don't know how much space we need for the full name, so start with
690 96 bytes and go up in steps of 32. */
691 len = 96;
692 name = malloc (len);
693 while (name && font_unparse_fcname (font_entity, pixel_size, name, len) < 0)
694 {
695 char *new = realloc (name, len += 32);
696
697 if (! new)
698 free (name);
699 name = new;
700 }
701 if (name)
702 font->font.full_name = name;
703 else
704 font->font.full_name = font->font.name;
705 }
f0121ad2
JR
706 font->font.charset = 0;
707 font->font.codepage = 0;
708 font->font.size = w32_font->metrics.tmMaxCharWidth;
709 font->font.height = w32_font->metrics.tmHeight
710 + w32_font->metrics.tmExternalLeading;
711 font->font.space_width = font->font.average_width
712 = w32_font->metrics.tmAveCharWidth;
713
714 font->font.vertical_centering = 0;
715 font->font.encoding_type = 0;
716 font->font.baseline_offset = 0;
717 font->font.relative_compose = 0;
718 font->font.default_ascent = w32_font->metrics.tmAscent;
719 font->font.font_encoder = NULL;
720 font->entity = font_entity;
721 font->pixel_size = size;
722 font->driver = &w32font_driver;
723 font->format = Qgdi;
724 font->file_name = NULL;
725 font->encoding_charset = -1;
726 font->repertory_charset = -1;
727 font->min_width = 0;
728 font->ascent = w32_font->metrics.tmAscent;
729 font->descent = w32_font->metrics.tmDescent;
730 font->scalable = w32_font->metrics.tmPitchAndFamily & TMPF_VECTOR;
731
732 return 1;
733}
734
f7a84cb4
JR
735/* Callback function for EnumFontFamiliesEx.
736 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
20399669
JR
737static int CALLBACK
738add_font_name_to_list (logical_font, physical_font, font_type, list_object)
739 ENUMLOGFONTEX *logical_font;
740 NEWTEXTMETRICEX *physical_font;
741 DWORD font_type;
742 LPARAM list_object;
f7a84cb4
JR
743{
744 Lisp_Object* list = (Lisp_Object *) list_object;
20a2b756
JR
745 Lisp_Object family;
746
747 /* Skip vertical fonts (intended only for printing) */
748 if (logical_font->elfLogFont.lfFaceName[0] == '@')
749 return 1;
750
751 family = intern_downcase (logical_font->elfLogFont.lfFaceName,
752 strlen (logical_font->elfLogFont.lfFaceName));
f7a84cb4
JR
753 if (! memq_no_quit (family, *list))
754 *list = Fcons (family, *list);
755
756 return 1;
757}
758
759/* Convert an enumerated Windows font to an Emacs font entity. */
20399669 760static Lisp_Object
91583281
JR
761w32_enumfont_pattern_entity (frame, logical_font, physical_font,
762 font_type, requested_font)
d205d43b 763 Lisp_Object frame;
20399669
JR
764 ENUMLOGFONTEX *logical_font;
765 NEWTEXTMETRICEX *physical_font;
766 DWORD font_type;
91583281 767 LOGFONT *requested_font;
f7a84cb4
JR
768{
769 Lisp_Object entity, tem;
770 LOGFONT *lf = (LOGFONT*) logical_font;
771 BYTE generic_type;
772
d205d43b 773 entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil);
f7a84cb4 774
8eac0c84 775 ASET (entity, FONT_TYPE_INDEX, Qgdi);
d205d43b 776 ASET (entity, FONT_FRAME_INDEX, frame);
f7a84cb4
JR
777 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet));
778 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
779
780 /* Foundry is difficult to get in readable form on Windows.
d205d43b
JR
781 But Emacs crashes if it is not set, so set it to something more
782 generic. Thes values make xflds compatible with Emacs 22. */
783 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
784 tem = Qraster;
785 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
786 tem = Qoutline;
787 else
788 tem = Qunknown;
789
790 ASET (entity, FONT_FOUNDRY_INDEX, tem);
791
792 /* Save the generic family in the extra info, as it is likely to be
793 useful to users looking for a close match. */
f7a84cb4
JR
794 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
795 if (generic_type == FF_DECORATIVE)
796 tem = Qdecorative;
797 else if (generic_type == FF_MODERN)
9e1a2995 798 tem = Qmono;
f7a84cb4 799 else if (generic_type == FF_ROMAN)
d205d43b 800 tem = Qserif;
f7a84cb4
JR
801 else if (generic_type == FF_SCRIPT)
802 tem = Qscript;
803 else if (generic_type == FF_SWISS)
9e1a2995 804 tem = Qsans;
f7a84cb4 805 else
9e1a2995
JR
806 tem = null_string;
807
808 ASET (entity, FONT_ADSTYLE_INDEX, tem);
f7a84cb4 809
d205d43b
JR
810 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
811 font_put_extra (entity, QCspacing, make_number (FONT_SPACING_PROPORTIONAL));
812 else
813 font_put_extra (entity, QCspacing, make_number (FONT_SPACING_MONO));
f7a84cb4 814
91583281
JR
815 if (requested_font->lfQuality != DEFAULT_QUALITY)
816 {
817 font_put_extra (entity, QCantialias,
818 lispy_antialias_type (requested_font->lfQuality));
819 }
f7a84cb4
JR
820 ASET (entity, FONT_FAMILY_INDEX,
821 intern_downcase (lf->lfFaceName, strlen (lf->lfFaceName)));
822
823 ASET (entity, FONT_WEIGHT_INDEX, make_number (lf->lfWeight));
824 ASET (entity, FONT_SLANT_INDEX, make_number (lf->lfItalic ? 200 : 100));
d205d43b
JR
825 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
826 to get it. */
827 ASET (entity, FONT_WIDTH_INDEX, make_number (100));
f7a84cb4 828
040fe918
JR
829 if (font_type & RASTER_FONTTYPE)
830 ASET (entity, FONT_SIZE_INDEX, make_number (physical_font->ntmTm.tmHeight));
831 else
832 ASET (entity, FONT_SIZE_INDEX, make_number (0));
f7a84cb4
JR
833
834 /* Cache unicode codepoints covered by this font, as there is no other way
835 of getting this information easily. */
040fe918 836 if (font_type & TRUETYPE_FONTTYPE)
f7a84cb4 837 {
d205d43b
JR
838 font_put_extra (entity, QCscript,
839 font_supported_scripts (&physical_font->ntmFontSig));
f7a84cb4 840 }
d205d43b 841
f7a84cb4
JR
842 return entity;
843}
844
d205d43b
JR
845
846/* Convert generic families to the family portion of lfPitchAndFamily. */
847BYTE
848w32_generic_family (Lisp_Object name)
849{
850 /* Generic families. */
851 if (EQ (name, Qmonospace) || EQ (name, Qmono))
852 return FF_MODERN;
9e1a2995 853 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
d205d43b
JR
854 return FF_SWISS;
855 else if (EQ (name, Qserif))
856 return FF_ROMAN;
857 else if (EQ (name, Qdecorative))
858 return FF_DECORATIVE;
859 else if (EQ (name, Qscript))
860 return FF_SCRIPT;
861 else
862 return FF_DONTCARE;
863}
864
865static int
866logfonts_match (font, pattern)
867 LOGFONT *font, *pattern;
868{
869 /* Only check height for raster fonts. */
870 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
871 && font->lfHeight != pattern->lfHeight)
872 return 0;
873
874 /* Have some flexibility with weights. */
875 if (pattern->lfWeight
876 && ((font->lfWeight < (pattern->lfWeight - 150))
877 || font->lfWeight > (pattern->lfWeight + 150)))
878 return 0;
879
880 /* Charset and face should be OK. Italic has to be checked
881 against the original spec, in case we don't have any preference. */
882 return 1;
883}
884
885static int
886font_matches_spec (type, font, spec)
887 DWORD type;
888 NEWTEXTMETRICEX *font;
889 Lisp_Object spec;
890{
891 Lisp_Object extra, val;
892
893 /* Check italic. Can't check logfonts, since it is a boolean field,
894 so there is no difference between "non-italic" and "don't care". */
895 val = AREF (spec, FONT_SLANT_INDEX);
896 if (INTEGERP (val))
897 {
898 int slant = XINT (val);
899 if ((slant > 150 && !font->ntmTm.tmItalic)
900 || (slant <= 150 && font->ntmTm.tmItalic))
d205d43b 901 return 0;
d205d43b
JR
902 }
903
4f2a2ee2
JR
904 /* Check adstyle against generic family. */
905 val = AREF (spec, FONT_ADSTYLE_INDEX);
906 if (!NILP (val))
907 {
908 BYTE family = w32_generic_family (val);
909 if (family != FF_DONTCARE
910 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
911 return 0;
912 }
913
d205d43b
JR
914 /* Check extra parameters. */
915 for (extra = AREF (spec, FONT_EXTRA_INDEX);
916 CONSP (extra); extra = XCDR (extra))
917 {
918 Lisp_Object extra_entry;
919 extra_entry = XCAR (extra);
920 if (CONSP (extra_entry))
921 {
922 Lisp_Object key = XCAR (extra_entry);
923 val = XCDR (extra_entry);
9e1a2995 924 if (EQ (key, QCspacing))
d205d43b
JR
925 {
926 int proportional;
927 if (INTEGERP (val))
928 {
929 int spacing = XINT (val);
930 proportional = (spacing < FONT_SPACING_MONO);
931 }
932 else if (EQ (val, Qp))
933 proportional = 1;
934 else if (EQ (val, Qc) || EQ (val, Qm))
935 proportional = 0;
936 else
937 return 0; /* Bad font spec. */
938
939 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
940 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
941 return 0;
942 }
943 else if (EQ (key, QCscript) && SYMBOLP (val))
944 {
945 /* Only truetype fonts will have information about what
946 scripts they support. This probably means the user
947 will have to force Emacs to use raster, postscript
948 or atm fonts for non-ASCII text. */
949 if (type & TRUETYPE_FONTTYPE)
950 {
951 Lisp_Object support
952 = font_supported_scripts (&font->ntmFontSig);
953 if (! memq_no_quit (val, support))
954 return 0;
955 }
956 else
957 {
958 /* Return specific matches, but play it safe. Fonts
959 that cover more than their charset would suggest
960 are likely to be truetype or opentype fonts,
961 covered above. */
962 if (EQ (val, Qlatin))
963 {
964 /* Although every charset but symbol, thai and
965 arabic contains the basic ASCII set of latin
966 characters, Emacs expects much more. */
967 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
968 return 0;
969 }
970 else if (EQ (val, Qsymbol))
971 {
972 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
973 return 0;
974 }
975 else if (EQ (val, Qcyrillic))
976 {
977 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
978 return 0;
979 }
980 else if (EQ (val, Qgreek))
981 {
982 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
983 return 0;
984 }
985 else if (EQ (val, Qarabic))
986 {
987 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
988 return 0;
989 }
990 else if (EQ (val, Qhebrew))
991 {
992 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
993 return 0;
994 }
995 else if (EQ (val, Qthai))
996 {
997 if (font->ntmTm.tmCharSet != THAI_CHARSET)
998 return 0;
999 }
1000 else if (EQ (val, Qkana))
1001 {
1002 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1003 return 0;
1004 }
1005 else if (EQ (val, Qbopomofo))
1006 {
1007 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1008 return 0;
1009 }
1010 else if (EQ (val, Qhangul))
1011 {
1012 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1013 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1014 return 0;
1015 }
1016 else if (EQ (val, Qhan))
1017 {
1018 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1019 && font->ntmTm.tmCharSet != GB2312_CHARSET
1020 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1021 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1022 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1023 return 0;
1024 }
1025 else
1026 /* Other scripts unlikely to be handled. */
1027 return 0;
1028 }
1029 }
1030 }
1031 }
1032 return 1;
1033}
1034
f7a84cb4 1035/* Callback function for EnumFontFamiliesEx.
d205d43b
JR
1036 * Checks if a font matches everything we are trying to check agaist,
1037 * and if so, adds it to a list. Both the data we are checking against
1038 * and the list to which the fonts are added are passed in via the
1039 * lparam argument, in the form of a font_callback_data struct. */
20399669 1040static int CALLBACK
d205d43b 1041add_font_entity_to_list (logical_font, physical_font, font_type, lParam)
20399669
JR
1042 ENUMLOGFONTEX *logical_font;
1043 NEWTEXTMETRICEX *physical_font;
1044 DWORD font_type;
d205d43b 1045 LPARAM lParam;
f7a84cb4 1046{
d205d43b
JR
1047 struct font_callback_data *match_data
1048 = (struct font_callback_data *) lParam;
f7a84cb4 1049
46fd1ded
JR
1050 if ((!match_data->opentype_only
1051 || (physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE))
1052 && logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
d205d43b 1053 && font_matches_spec (font_type, physical_font,
4f2a2ee2
JR
1054 match_data->orig_font_spec)
1055 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1056 We limit this to raster fonts, because the test can catch some
1057 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1058 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1059 therefore get through this test. Since full names can be prefixed
1060 by a foundry, we accept raster fonts if the font name is found
1061 anywhere within the full name. */
1062 && (logical_font->elfLogFont.lfOutPrecision != OUT_STRING_PRECIS
1063 || strstr (logical_font->elfFullName,
1064 logical_font->elfLogFont.lfFaceName)))
d205d43b
JR
1065 {
1066 Lisp_Object entity
1067 = w32_enumfont_pattern_entity (match_data->frame, logical_font,
91583281
JR
1068 physical_font, font_type,
1069 &match_data->pattern);
d205d43b
JR
1070 if (!NILP (entity))
1071 match_data->list = Fcons (entity, match_data->list);
1072 }
f7a84cb4
JR
1073 return 1;
1074}
1075
1076/* Callback function for EnumFontFamiliesEx.
d205d43b 1077 * Terminates the search once we have a match. */
20399669 1078static int CALLBACK
d205d43b 1079add_one_font_entity_to_list (logical_font, physical_font, font_type, lParam)
20399669
JR
1080 ENUMLOGFONTEX *logical_font;
1081 NEWTEXTMETRICEX *physical_font;
1082 DWORD font_type;
d205d43b 1083 LPARAM lParam;
f7a84cb4 1084{
d205d43b
JR
1085 struct font_callback_data *match_data
1086 = (struct font_callback_data *) lParam;
1087 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1088
1089 /* If we have a font in the list, terminate the search. */
1090 return !NILP (match_data->list);
f7a84cb4
JR
1091}
1092
1093/* Convert a Lisp font registry (symbol) to a windows charset. */
20399669
JR
1094static LONG
1095registry_to_w32_charset (charset)
1096 Lisp_Object charset;
f7a84cb4
JR
1097{
1098 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1099 || EQ (charset, Qunicode_sip))
1100 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1101 else if (EQ (charset, Qiso8859_1))
1102 return ANSI_CHARSET;
040fe918
JR
1103 else if (SYMBOLP (charset))
1104 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
f7a84cb4
JR
1105 else if (STRINGP (charset))
1106 return x_to_w32_charset (SDATA (charset));
1107 else
1108 return DEFAULT_CHARSET;
1109}
1110
20399669
JR
1111static Lisp_Object
1112w32_registry (w32_charset)
1113 LONG w32_charset;
f7a84cb4
JR
1114{
1115 if (w32_charset == ANSI_CHARSET)
d205d43b 1116 return Qiso10646_1;
f7a84cb4 1117 else
040fe918
JR
1118 {
1119 char * charset = w32_to_x_charset (w32_charset, NULL);
1120 return intern_downcase (charset, strlen(charset));
1121 }
f7a84cb4
JR
1122}
1123
f7a84cb4 1124/* Fill in all the available details of LOGFONT from FONT_SPEC. */
20399669
JR
1125static void
1126fill_in_logfont (f, logfont, font_spec)
1127 FRAME_PTR f;
1128 LOGFONT *logfont;
1129 Lisp_Object font_spec;
f7a84cb4 1130{
d205d43b 1131 Lisp_Object tmp, extra;
f7a84cb4
JR
1132 int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
1133
d205d43b
JR
1134 extra = AREF (font_spec, FONT_EXTRA_INDEX);
1135 /* Allow user to override dpi settings. */
1136 if (CONSP (extra))
1137 {
1138 tmp = assq_no_quit (QCdpi, extra);
1139 if (CONSP (tmp) && INTEGERP (XCDR (tmp)))
1140 {
1141 dpi = XINT (XCDR (tmp));
1142 }
1143 else if (CONSP (tmp) && FLOATP (XCDR (tmp)))
1144 {
1145 dpi = (int) (XFLOAT_DATA (XCDR (tmp)) + 0.5);
1146 }
1147 }
f7a84cb4
JR
1148
1149 /* Height */
1150 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1151 if (INTEGERP (tmp))
040fe918 1152 logfont->lfHeight = -1 * XINT (tmp);
f7a84cb4 1153 else if (FLOATP (tmp))
d205d43b 1154 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
f7a84cb4
JR
1155
1156 /* Escapement */
1157
1158 /* Orientation */
1159
1160 /* Weight */
1161 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1162 if (INTEGERP (tmp))
1163 logfont->lfWeight = XINT (tmp);
1164
1165 /* Italic */
1166 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1167 if (INTEGERP (tmp))
1168 {
1169 int slant = XINT (tmp);
1170 logfont->lfItalic = slant > 150 ? 1 : 0;
1171 }
1172
1173 /* Underline */
1174
1175 /* Strikeout */
1176
1177 /* Charset */
1178 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
1179 if (! NILP (tmp))
d205d43b 1180 logfont->lfCharSet = registry_to_w32_charset (tmp);
f7a84cb4
JR
1181
1182 /* Out Precision */
91583281 1183
f7a84cb4 1184 /* Clip Precision */
91583281
JR
1185
1186 /* Quality */
040fe918
JR
1187 logfont->lfQuality = DEFAULT_QUALITY;
1188
d205d43b
JR
1189 /* Generic Family and Face Name */
1190 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
1191
f7a84cb4 1192 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
d205d43b
JR
1193 if (! NILP (tmp))
1194 {
1195 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
1196 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
1197 ; /* Font name was generic, don't fill in font name. */
1198 /* Font families are interned, but allow for strings also in case of
1199 user input. */
1200 else if (SYMBOLP (tmp))
1201 strncpy (logfont->lfFaceName, SDATA (SYMBOL_NAME (tmp)), LF_FACESIZE);
1202 else if (STRINGP (tmp))
1203 strncpy (logfont->lfFaceName, SDATA (tmp), LF_FACESIZE);
1204 }
f7a84cb4 1205
9e1a2995
JR
1206 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
1207 if (!NILP (tmp))
1208 {
1209 /* Override generic family. */
1210 BYTE family = w32_generic_family (tmp);
1211 if (family != FF_DONTCARE)
1212 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
1213 }
1214
d205d43b
JR
1215 /* Process EXTRA info. */
1216 for ( ; CONSP (extra); extra = XCDR (extra))
1217 {
1218 tmp = XCAR (extra);
1219 if (CONSP (tmp))
1220 {
1221 Lisp_Object key, val;
1222 key = XCAR (tmp), val = XCDR (tmp);
9e1a2995 1223 if (EQ (key, QCspacing))
d205d43b
JR
1224 {
1225 /* Set pitch based on the spacing property. */
1226 if (INTEGERP (val))
1227 {
1228 int spacing = XINT (val);
1229 if (spacing < FONT_SPACING_MONO)
1230 logfont->lfPitchAndFamily
1231 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
1232 else
1233 logfont->lfPitchAndFamily
1234 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
1235 }
1236 else if (EQ (val, Qp))
1237 logfont->lfPitchAndFamily
1238 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
1239 else if (EQ (val, Qc) || EQ (val, Qm))
1240 logfont->lfPitchAndFamily
1241 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
1242 }
1243 /* Only use QCscript if charset is not provided, or is unicode
1244 and a single script is specified. This is rather crude,
1245 and is only used to narrow down the fonts returned where
1246 there is a definite match. Some scripts, such as latin, han,
1247 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1248 them. */
1249 else if (EQ (key, QCscript)
1250 && logfont->lfCharSet == DEFAULT_CHARSET
1251 && SYMBOLP (val))
1252 {
1253 if (EQ (val, Qgreek))
1254 logfont->lfCharSet = GREEK_CHARSET;
1255 else if (EQ (val, Qhangul))
1256 logfont->lfCharSet = HANGUL_CHARSET;
1257 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
1258 logfont->lfCharSet = SHIFTJIS_CHARSET;
1259 else if (EQ (val, Qbopomofo))
1260 logfont->lfCharSet = CHINESEBIG5_CHARSET;
1261 /* GB 18030 supports tibetan, yi, mongolian,
1262 fonts that support it should show up if we ask for
1263 GB2312 fonts. */
1264 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
1265 || EQ (val, Qmongolian))
1266 logfont->lfCharSet = GB2312_CHARSET;
1267 else if (EQ (val, Qhebrew))
1268 logfont->lfCharSet = HEBREW_CHARSET;
1269 else if (EQ (val, Qarabic))
1270 logfont->lfCharSet = ARABIC_CHARSET;
1271 else if (EQ (val, Qthai))
1272 logfont->lfCharSet = THAI_CHARSET;
1273 else if (EQ (val, Qsymbol))
1274 logfont->lfCharSet = SYMBOL_CHARSET;
1275 }
91583281
JR
1276 else if (EQ (key, QCantialias) && SYMBOLP (val))
1277 {
1278 logfont->lfQuality = w32_antialias_type (val);
1279 }
d205d43b
JR
1280 }
1281 }
f7a84cb4
JR
1282}
1283
20399669 1284static void
d205d43b
JR
1285list_all_matching_fonts (match_data)
1286 struct font_callback_data *match_data;
f7a84cb4
JR
1287{
1288 HDC dc;
d205d43b
JR
1289 Lisp_Object families = w32font_list_family (match_data->frame);
1290 struct frame *f = XFRAME (match_data->frame);
f7a84cb4
JR
1291
1292 dc = get_frame_dc (f);
1293
1294 while (!NILP (families))
1295 {
d205d43b
JR
1296 /* TODO: Use the Unicode versions of the W32 APIs, so we can
1297 handle non-ASCII font names. */
1298 char *name;
f7a84cb4
JR
1299 Lisp_Object family = CAR (families);
1300 families = CDR (families);
d205d43b
JR
1301 if (NILP (family))
1302 continue;
1303 else if (STRINGP (family))
1304 name = SDATA (family);
1305 else
1306 name = SDATA (SYMBOL_NAME (family));
1307
1308 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
1309 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
1310
1311 EnumFontFamiliesEx (dc, &match_data->pattern,
1312 (FONTENUMPROC) add_font_entity_to_list,
1313 (LPARAM) match_data, 0);
f7a84cb4
JR
1314 }
1315
1316 release_frame_dc (f, dc);
1317}
1318
91583281
JR
1319static Lisp_Object
1320lispy_antialias_type (type)
1321 BYTE type;
1322{
1323 Lisp_Object lispy;
1324
1325 switch (type)
1326 {
1327 case NONANTIALIASED_QUALITY:
1328 lispy = Qnone;
1329 break;
1330 case ANTIALIASED_QUALITY:
1331 lispy = Qstandard;
1332 break;
1333 case CLEARTYPE_QUALITY:
1334 lispy = Qsubpixel;
1335 break;
1336 case CLEARTYPE_NATURAL_QUALITY:
1337 lispy = Qnatural;
1338 break;
1339 default:
1340 lispy = Qnil;
1341 break;
1342 }
1343 return lispy;
1344}
1345
1346/* Convert antialiasing symbols to lfQuality */
1347static BYTE
1348w32_antialias_type (type)
1349 Lisp_Object type;
1350{
1351 if (EQ (type, Qnone))
1352 return NONANTIALIASED_QUALITY;
1353 else if (EQ (type, Qstandard))
1354 return ANTIALIASED_QUALITY;
1355 else if (EQ (type, Qsubpixel))
1356 return CLEARTYPE_QUALITY;
1357 else if (EQ (type, Qnatural))
1358 return CLEARTYPE_NATURAL_QUALITY;
1359 else
1360 return DEFAULT_QUALITY;
1361}
1362
d205d43b
JR
1363/* Return a list of all the scripts that the font supports. */
1364static Lisp_Object
1365font_supported_scripts (FONTSIGNATURE * sig)
f7a84cb4 1366{
d205d43b
JR
1367 DWORD * subranges = sig->fsUsb;
1368 Lisp_Object supported = Qnil;
1369
1370 /* Match a single subrange. SYM is set if bit N is set in subranges. */
1371#define SUBRANGE(n,sym) \
1372 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
1373 supported = Fcons ((sym), supported)
1374
1375 /* Match multiple subranges. SYM is set if any MASK bit is set in
1376 subranges[0 - 3]. */
1377#define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
1378 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
1379 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
1380 supported = Fcons ((sym), supported)
1381
1382 SUBRANGE (0, Qlatin); /* There are many others... */
1383
1384 SUBRANGE (7, Qgreek);
1385 SUBRANGE (8, Qcoptic);
1386 SUBRANGE (9, Qcyrillic);
1387 SUBRANGE (10, Qarmenian);
1388 SUBRANGE (11, Qhebrew);
1389 SUBRANGE (13, Qarabic);
1390 SUBRANGE (14, Qnko);
1391 SUBRANGE (15, Qdevanagari);
1392 SUBRANGE (16, Qbengali);
1393 SUBRANGE (17, Qgurmukhi);
1394 SUBRANGE (18, Qgujarati);
1395 SUBRANGE (19, Qoriya);
1396 SUBRANGE (20, Qtamil);
1397 SUBRANGE (21, Qtelugu);
1398 SUBRANGE (22, Qkannada);
1399 SUBRANGE (23, Qmalayalam);
1400 SUBRANGE (24, Qthai);
1401 SUBRANGE (25, Qlao);
1402 SUBRANGE (26, Qgeorgian);
1403
1404 SUBRANGE (48, Qcjk_misc);
1405 SUBRANGE (51, Qbopomofo);
1406 SUBRANGE (54, Qkanbun); /* Is this right? */
1407 SUBRANGE (56, Qhangul);
1408
1409 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
1410 SUBRANGE (59, Qideographic_description); /* Windows lumps this in */
1411
1412 SUBRANGE (70, Qtibetan);
1413 SUBRANGE (71, Qsyriac);
1414 SUBRANGE (72, Qthaana);
1415 SUBRANGE (73, Qsinhala);
1416 SUBRANGE (74, Qmyanmar);
1417 SUBRANGE (75, Qethiopic);
1418 SUBRANGE (76, Qcherokee);
1419 SUBRANGE (77, Qcanadian_aboriginal);
1420 SUBRANGE (78, Qogham);
1421 SUBRANGE (79, Qrunic);
1422 SUBRANGE (80, Qkhmer);
1423 SUBRANGE (81, Qmongolian);
1424 SUBRANGE (82, Qbraille);
1425 SUBRANGE (83, Qyi);
1426
1427 SUBRANGE (88, Qbyzantine_musical_symbol);
1428 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
1429
1430 SUBRANGE (89, Qmathematical);
1431
1432 /* Match either katakana or hiragana for kana. */
1433 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
1434
1435 /* There isn't really a main symbol range, so include symbol if any
1436 relevant range is set. */
1437 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
1438
1439#undef SUBRANGE
1440#undef MASK_ANY
1441
1442 return supported;
f7a84cb4
JR
1443}
1444
1445
1446struct font_driver w32font_driver =
1447 {
8eac0c84 1448 0, /* Qgdi */
f7a84cb4
JR
1449 w32font_get_cache,
1450 w32font_list,
1451 w32font_match,
1452 w32font_list_family,
1453 NULL, /* free_entity */
1454 w32font_open,
1455 w32font_close,
1456 NULL, /* prepare_face */
1457 NULL, /* done_face */
1458 w32font_has_char,
1459 w32font_encode_char,
1460 w32font_text_extents,
1461 w32font_draw,
1462 NULL, /* get_bitmap */
1463 NULL, /* free_bitmap */
1464 NULL, /* get_outline */
1465 NULL, /* free_outline */
1466 NULL, /* anchor_point */
1467 NULL, /* otf_capability */
5b0c3446
JR
1468 NULL, /* otf_drive */
1469 NULL, /* start_for_frame */
1470 NULL, /* end_for_frame */
1471 NULL /* shape */
f7a84cb4
JR
1472 };
1473
f7a84cb4
JR
1474
1475/* Initialize state that does not change between invocations. This is only
1476 called when Emacs is dumped. */
20399669
JR
1477void
1478syms_of_w32font ()
f7a84cb4 1479{
8eac0c84 1480 DEFSYM (Qgdi, "gdi");
d205d43b
JR
1481
1482 /* Generic font families. */
1483 DEFSYM (Qmonospace, "monospace");
1484 DEFSYM (Qserif, "serif");
9e1a2995 1485 DEFSYM (Qsansserif, "sansserif");
f7a84cb4 1486 DEFSYM (Qscript, "script");
d205d43b
JR
1487 DEFSYM (Qdecorative, "decorative");
1488 /* Aliases. */
9e1a2995 1489 DEFSYM (Qsans_serif, "sans_serif");
d205d43b
JR
1490 DEFSYM (Qsans, "sans");
1491 DEFSYM (Qmono, "mono");
1492
1493 /* Fake foundries. */
1494 DEFSYM (Qraster, "raster");
1495 DEFSYM (Qoutline, "outline");
f7a84cb4 1496 DEFSYM (Qunknown, "unknown");
d205d43b 1497
91583281
JR
1498 /* Antialiasing. */
1499 DEFSYM (Qstandard, "standard");
1500 DEFSYM (Qsubpixel, "subpixel");
1501 DEFSYM (Qnatural, "natural");
d205d43b
JR
1502
1503 /* Scripts */
1504 DEFSYM (Qlatin, "latin");
1505 DEFSYM (Qgreek, "greek");
1506 DEFSYM (Qcoptic, "coptic");
1507 DEFSYM (Qcyrillic, "cyrillic");
1508 DEFSYM (Qarmenian, "armenian");
1509 DEFSYM (Qhebrew, "hebrew");
1510 DEFSYM (Qarabic, "arabic");
1511 DEFSYM (Qsyriac, "syriac");
1512 DEFSYM (Qnko, "nko");
1513 DEFSYM (Qthaana, "thaana");
1514 DEFSYM (Qdevanagari, "devanagari");
1515 DEFSYM (Qbengali, "bengali");
1516 DEFSYM (Qgurmukhi, "gurmukhi");
1517 DEFSYM (Qgujarati, "gujarati");
1518 DEFSYM (Qoriya, "oriya");
1519 DEFSYM (Qtamil, "tamil");
1520 DEFSYM (Qtelugu, "telugu");
1521 DEFSYM (Qkannada, "kannada");
1522 DEFSYM (Qmalayalam, "malayalam");
1523 DEFSYM (Qsinhala, "sinhala");
1524 DEFSYM (Qthai, "thai");
1525 DEFSYM (Qlao, "lao");
1526 DEFSYM (Qtibetan, "tibetan");
1527 DEFSYM (Qmyanmar, "myanmar");
1528 DEFSYM (Qgeorgian, "georgian");
1529 DEFSYM (Qhangul, "hangul");
1530 DEFSYM (Qethiopic, "ethiopic");
1531 DEFSYM (Qcherokee, "cherokee");
1532 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
1533 DEFSYM (Qogham, "ogham");
1534 DEFSYM (Qrunic, "runic");
1535 DEFSYM (Qkhmer, "khmer");
1536 DEFSYM (Qmongolian, "mongolian");
1537 DEFSYM (Qsymbol, "symbol");
1538 DEFSYM (Qbraille, "braille");
1539 DEFSYM (Qhan, "han");
1540 DEFSYM (Qideographic_description, "ideographic-description");
1541 DEFSYM (Qcjk_misc, "cjk-misc");
1542 DEFSYM (Qkana, "kana");
1543 DEFSYM (Qbopomofo, "bopomofo");
1544 DEFSYM (Qkanbun, "kanbun");
1545 DEFSYM (Qyi, "yi");
1546 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
1547 DEFSYM (Qmusical_symbol, "musical-symbol");
1548 DEFSYM (Qmathematical, "mathematical");
1549
8eac0c84 1550 w32font_driver.type = Qgdi;
f7a84cb4
JR
1551 register_font_driver (&w32font_driver, NULL);
1552}
6d8c85b5
MB
1553
1554/* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
1555 (do not change this comment) */