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