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