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