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, or (at your option)
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; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA. */
28 #include "dispextern.h"
29 #include "character.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
42 #ifndef CLEARTYPE_NATURAL_QUALITY
43 #define CLEARTYPE_NATURAL_QUALITY 6
46 extern struct font_driver w32font_driver
;
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
;
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
;
61 static Lisp_Object Qja
, Qko
, Qzh
;
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
*,
103 static int CALLBACK add_one_font_entity_to_list
P_ ((ENUMLOGFONTEX
*,
106 static int CALLBACK add_font_name_to_list
P_ ((ENUMLOGFONTEX
*,
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. */
118 /* The original font spec or entity. */
119 Lisp_Object orig_font_spec
;
120 /* The frame the font is being loaded on. */
122 /* The list to add matches to. */
124 /* Whether to match only opentype fonts. */
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 *));
137 memq_no_quit (elt
, list
)
138 Lisp_Object elt
, list
;
140 while (CONSP (list
) && ! EQ (XCAR (list
), elt
))
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. */
149 w32font_get_cache (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. */
162 w32font_list (frame
, font_spec
)
163 Lisp_Object frame
, font_spec
;
165 return w32font_list_internal (frame
, font_spec
, 0);
168 /* w32 implementation of match for font backend.
169 Return a font entity most closely matching with FONT_SPEC on
170 FRAME. The closeness is detemined by the font backend, thus
171 `face-font-selection-order' is ignored here. */
173 w32font_match (frame
, font_spec
)
174 Lisp_Object frame
, font_spec
;
176 return w32font_match_internal (frame
, font_spec
, 0);
179 /* w32 implementation of list_family for font backend.
180 List available families. The value is a list of family names
183 w32font_list_family (frame
)
186 Lisp_Object list
= Qnil
;
187 LOGFONT font_match_pattern
;
189 FRAME_PTR f
= XFRAME (frame
);
191 bzero (&font_match_pattern
, sizeof (font_match_pattern
));
192 font_match_pattern
.lfCharSet
= DEFAULT_CHARSET
;
194 dc
= get_frame_dc (f
);
196 EnumFontFamiliesEx (dc
, &font_match_pattern
,
197 (FONTENUMPROC
) add_font_name_to_list
,
199 release_frame_dc (f
, dc
);
204 /* w32 implementation of open for font backend.
205 Open a font specified by FONT_ENTITY on frame F.
206 If the font is scalable, open it with PIXEL_SIZE. */
208 w32font_open (f
, font_entity
, pixel_size
)
210 Lisp_Object font_entity
;
213 Lisp_Object font_object
;
215 font_object
= font_make_object (VECSIZE (struct w32font_info
));
217 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
225 /* w32 implementation of close for font_backend.
226 Close FONT on frame F. */
228 w32font_close (f
, font
)
232 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
234 if (w32_font
->compat_w32_font
)
236 W32FontStruct
*old_w32_font
= w32_font
->compat_w32_font
;
237 DeleteObject (old_w32_font
->hfont
);
238 xfree (old_w32_font
);
239 w32_font
->compat_w32_font
= 0;
243 /* w32 implementation of has_char for font backend.
245 If FONT_ENTITY has a glyph for character C (Unicode code point),
246 return 1. If not, return 0. If a font must be opened to check
249 w32font_has_char (entity
, c
)
253 Lisp_Object supported_scripts
, extra
, script
;
256 extra
= AREF (entity
, FONT_EXTRA_INDEX
);
260 supported_scripts
= assq_no_quit (QCscript
, extra
);
261 if (!CONSP (supported_scripts
))
264 supported_scripts
= XCDR (supported_scripts
);
266 script
= CHAR_TABLE_REF (Vchar_script_table
, c
);
268 return (memq_no_quit (script
, supported_scripts
)) ? -1 : 0;
271 /* w32 implementation of encode_char for font backend.
272 Return a glyph code of FONT for characer C (Unicode code point).
273 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
275 w32font_encode_char (font
, c
)
287 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
289 /* If glyph indexing is not working for this font, just return the
290 unicode code-point. */
291 if (!w32_font
->glyph_idx
)
296 /* TODO: Encode as surrogate pair and lookup the glyph. */
297 return FONT_INVALID_CODE
;
305 bzero (&result
, sizeof (result
));
306 result
.lStructSize
= sizeof (result
);
307 result
.lpGlyphs
= out
;
310 f
= XFRAME (selected_frame
);
312 dc
= get_frame_dc (f
);
313 old_font
= SelectObject (dc
, w32_font
->compat_w32_font
->hfont
);
315 retval
= GetCharacterPlacementW (dc
, in
, len
, 0, &result
, 0);
317 SelectObject (dc
, old_font
);
318 release_frame_dc (f
, dc
);
322 if (result
.nGlyphs
!= 1 || !result
.lpGlyphs
[0])
323 return FONT_INVALID_CODE
;
324 return result
.lpGlyphs
[0];
329 /* Mark this font as not supporting glyph indices. This can happen
330 on Windows9x, and maybe with non-Truetype fonts on NT etc. */
331 w32_font
->glyph_idx
= 0;
332 /* Clear metrics cache. */
333 clear_cached_metrics (w32_font
);
339 /* w32 implementation of text_extents for font backend.
340 Perform the size computation of glyphs of FONT and fillin members
341 of METRICS. The glyphs are specified by their glyph codes in
342 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
343 case just return the overall width. */
345 w32font_text_extents (font
, code
, nglyphs
, metrics
)
349 struct font_metrics
*metrics
;
352 HFONT old_font
= NULL
;
361 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
364 metrics
->ascent
= font
->ascent
;
365 metrics
->descent
= font
->descent
;
366 metrics
->lbearing
= 0;
368 for (i
= 0; i
< nglyphs
; i
++)
370 struct w32_metric_cache
*char_metric
;
371 int block
= *(code
+ i
) / CACHE_BLOCKSIZE
;
372 int pos_in_block
= *(code
+ i
) % CACHE_BLOCKSIZE
;
374 if (block
>= w32_font
->n_cache_blocks
)
376 if (!w32_font
->cached_metrics
)
377 w32_font
->cached_metrics
378 = xmalloc ((block
+ 1)
379 * sizeof (struct w32_cached_metric
*));
381 w32_font
->cached_metrics
382 = xrealloc (w32_font
->cached_metrics
,
384 * sizeof (struct w32_cached_metric
*));
385 bzero (w32_font
->cached_metrics
+ w32_font
->n_cache_blocks
,
386 ((block
+ 1 - w32_font
->n_cache_blocks
)
387 * sizeof (struct w32_cached_metric
*)));
388 w32_font
->n_cache_blocks
= block
+ 1;
391 if (!w32_font
->cached_metrics
[block
])
393 w32_font
->cached_metrics
[block
]
394 = xmalloc (CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
395 bzero (w32_font
->cached_metrics
[block
],
396 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
399 char_metric
= w32_font
->cached_metrics
[block
] + pos_in_block
;
401 if (char_metric
->status
== W32METRIC_NO_ATTEMPT
)
405 /* TODO: Frames can come and go, and their fonts
406 outlive them. So we can't cache the frame in the
407 font structure. Use selected_frame until the API
408 is updated to pass in a frame. */
409 f
= XFRAME (selected_frame
);
411 dc
= get_frame_dc (f
);
412 old_font
= SelectObject (dc
, FONT_COMPAT (font
)->hfont
);
414 compute_metrics (dc
, w32_font
, *(code
+ i
), char_metric
);
417 if (char_metric
->status
== W32METRIC_SUCCESS
)
419 metrics
->lbearing
= min (metrics
->lbearing
,
420 metrics
->width
+ char_metric
->lbearing
);
421 metrics
->rbearing
= max (metrics
->rbearing
,
422 metrics
->width
+ char_metric
->rbearing
);
423 metrics
->width
+= char_metric
->width
;
426 /* If we couldn't get metrics for a char,
427 use alternative method. */
430 /* If we got through everything, return. */
435 /* Restore state and release DC. */
436 SelectObject (dc
, old_font
);
437 release_frame_dc (f
, dc
);
440 return metrics
->width
;
444 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
445 fallback on other methods that will at least give some of the metric
448 wcode
= alloca (nglyphs
* sizeof (WORD
));
449 for (i
= 0; i
< nglyphs
; i
++)
451 if (code
[i
] < 0x10000)
455 /* TODO: Convert to surrogate, reallocating array if needed */
462 /* TODO: Frames can come and go, and their fonts outlive
463 them. So we can't cache the frame in the font structure. Use
464 selected_frame until the API is updated to pass in a
466 f
= XFRAME (selected_frame
);
468 dc
= get_frame_dc (f
);
469 old_font
= SelectObject (dc
, FONT_COMPAT (font
)->hfont
);
472 if (GetTextExtentPoint32W (dc
, wcode
, nglyphs
, &size
))
474 total_width
= size
.cx
;
477 /* On 95/98/ME, only some unicode functions are available, so fallback
478 on doing a dummy draw to find the total width. */
482 rect
.top
= 0; rect
.bottom
= font
->height
; rect
.left
= 0; rect
.right
= 1;
483 DrawTextW (dc
, wcode
, nglyphs
, &rect
,
484 DT_CALCRECT
| DT_NOPREFIX
| DT_SINGLELINE
);
485 total_width
= rect
.right
;
488 /* Give our best estimate of the metrics, based on what we know. */
491 metrics
->width
= total_width
;
492 metrics
->lbearing
= 0;
493 metrics
->rbearing
= total_width
494 + ((struct w32font_info
*) font
)->metrics
.tmOverhang
;
497 /* Restore state and release DC. */
498 SelectObject (dc
, old_font
);
499 release_frame_dc (f
, dc
);
504 /* w32 implementation of draw for font backend.
506 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
507 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
508 is nonzero, fill the background in advance. It is assured that
509 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
511 TODO: Currently this assumes that the colors and fonts are already
512 set in the DC. This seems to be true now, but maybe only due to
513 the old font code setting it up. It may be safer to resolve faces
514 and fonts in here and set them explicitly
518 w32font_draw (s
, from
, to
, x
, y
, with_background
)
519 struct glyph_string
*s
;
520 int from
, to
, x
, y
, with_background
;
524 struct w32font_info
*w32font
= (struct w32font_info
*) s
->font
;
526 options
= w32font
->glyph_idx
;
528 /* Save clip region for later restoration. */
529 GetClipRgn(s
->hdc
, orig_clip
);
531 if (s
->num_clips
> 0)
533 HRGN new_clip
= CreateRectRgnIndirect (s
->clip
);
535 if (s
->num_clips
> 1)
537 HRGN clip2
= CreateRectRgnIndirect (s
->clip
+ 1);
539 CombineRgn (new_clip
, new_clip
, clip2
, RGN_OR
);
540 DeleteObject (clip2
);
543 SelectClipRgn (s
->hdc
, new_clip
);
544 DeleteObject (new_clip
);
547 /* Using OPAQUE background mode can clear more background than expected
548 when Cleartype is used. Draw the background manually to avoid this. */
549 SetBkMode (s
->hdc
, TRANSPARENT
);
554 struct font
*font
= s
->font
;
556 brush
= CreateSolidBrush (s
->gc
->background
);
558 rect
.top
= y
- font
->ascent
;
559 rect
.right
= x
+ s
->width
;
560 rect
.bottom
= y
+ font
->descent
;
561 FillRect (s
->hdc
, &rect
, brush
);
562 DeleteObject (brush
);
567 int len
= to
- from
, i
;
569 for (i
= 0; i
< len
; i
++)
570 ExtTextOutW (s
->hdc
, x
+ i
, y
, options
, NULL
,
571 s
->char2b
+ from
+ i
, 1, NULL
);
574 ExtTextOutW (s
->hdc
, x
, y
, options
, NULL
, s
->char2b
+ from
, to
- from
, NULL
);
576 /* Restore clip region. */
577 if (s
->num_clips
> 0)
579 SelectClipRgn (s
->hdc
, orig_clip
);
583 /* w32 implementation of free_entity for font backend.
584 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
585 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
587 w32font_free_entity (Lisp_Object entity);
590 /* w32 implementation of prepare_face for font backend.
591 Optional (if FACE->extra is not used).
592 Prepare FACE for displaying characters by FONT on frame F by
593 storing some data in FACE->extra. If successful, return 0.
594 Otherwise, return -1.
596 w32font_prepare_face (FRAME_PTR f, struct face *face);
598 /* w32 implementation of done_face for font backend.
600 Done FACE for displaying characters by FACE->font on frame F.
602 w32font_done_face (FRAME_PTR f, struct face *face); */
604 /* w32 implementation of get_bitmap for font backend.
606 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
607 intended that this method is called from the other font-driver
610 w32font_get_bitmap (struct font *font, unsigned code,
611 struct font_bitmap *bitmap, int bits_per_pixel);
613 /* w32 implementation of free_bitmap for font backend.
615 Free bitmap data in BITMAP.
617 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
619 /* w32 implementation of get_outline for font backend.
621 Return an outline data for glyph-code CODE of FONT. The format
622 of the outline data depends on the font-driver.
624 w32font_get_outline (struct font *font, unsigned code);
626 /* w32 implementation of free_outline for font backend.
628 Free OUTLINE (that is obtained by the above method).
630 w32font_free_outline (struct font *font, void *outline);
632 /* w32 implementation of anchor_point for font backend.
634 Get coordinates of the INDEXth anchor point of the glyph whose
635 code is CODE. Store the coordinates in *X and *Y. Return 0 if
636 the operations was successfull. Otherwise return -1.
638 w32font_anchor_point (struct font *font, unsigned code,
639 int index, int *x, int *y);
641 /* w32 implementation of otf_capability for font backend.
643 Return a list describing which scripts/languages FONT
644 supports by which GSUB/GPOS features of OpenType tables.
646 w32font_otf_capability (struct font *font);
648 /* w32 implementation of otf_drive for font backend.
650 Apply FONT's OTF-FEATURES to the glyph string.
652 FEATURES specifies which OTF features to apply in this format:
653 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
654 See the documentation of `font-drive-otf' for the detail.
656 This method applies the specified features to the codes in the
657 elements of GSTRING-IN (between FROMth and TOth). The output
658 codes are stored in GSTRING-OUT at the IDXth element and the
661 Return the number of output codes. If none of the features are
662 applicable to the input data, return 0. If GSTRING-OUT is too
665 w32font_otf_drive (struct font *font, Lisp_Object features,
666 Lisp_Object gstring_in, int from, int to,
667 Lisp_Object gstring_out, int idx,
668 int alternate_subst);
671 /* Internal implementation of w32font_list.
672 Additional parameter opentype_only restricts the returned fonts to
673 opentype fonts, which can be used with the Uniscribe backend. */
675 w32font_list_internal (frame
, font_spec
, opentype_only
)
676 Lisp_Object frame
, font_spec
;
679 struct font_callback_data match_data
;
681 FRAME_PTR f
= XFRAME (frame
);
683 match_data
.orig_font_spec
= font_spec
;
684 match_data
.list
= Qnil
;
685 match_data
.frame
= frame
;
687 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
688 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
690 match_data
.opentype_only
= opentype_only
;
692 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
694 if (match_data
.pattern
.lfFaceName
[0] == '\0')
696 /* EnumFontFamiliesEx does not take other fields into account if
697 font name is blank, so need to use two passes. */
698 list_all_matching_fonts (&match_data
);
702 dc
= get_frame_dc (f
);
704 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
705 (FONTENUMPROC
) add_font_entity_to_list
,
706 (LPARAM
) &match_data
, 0);
707 release_frame_dc (f
, dc
);
710 return NILP (match_data
.list
) ? Qnil
: match_data
.list
;
713 /* Internal implementation of w32font_match.
714 Additional parameter opentype_only restricts the returned fonts to
715 opentype fonts, which can be used with the Uniscribe backend. */
717 w32font_match_internal (frame
, font_spec
, opentype_only
)
718 Lisp_Object frame
, font_spec
;
721 struct font_callback_data match_data
;
723 FRAME_PTR f
= XFRAME (frame
);
725 match_data
.orig_font_spec
= font_spec
;
726 match_data
.frame
= frame
;
727 match_data
.list
= Qnil
;
729 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
730 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
732 match_data
.opentype_only
= opentype_only
;
734 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
736 dc
= get_frame_dc (f
);
738 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
739 (FONTENUMPROC
) add_one_font_entity_to_list
,
740 (LPARAM
) &match_data
, 0);
741 release_frame_dc (f
, dc
);
743 return NILP (match_data
.list
) ? Qnil
: XCAR (match_data
.list
);
747 w32font_open_internal (f
, font_entity
, pixel_size
, font_object
)
749 Lisp_Object font_entity
;
751 Lisp_Object font_object
;
756 HFONT hfont
, old_font
;
757 Lisp_Object val
, extra
;
758 /* For backwards compatibility. */
759 W32FontStruct
*compat_w32_font
;
760 struct w32font_info
*w32_font
;
762 OUTLINETEXTMETRIC
* metrics
= NULL
;
764 w32_font
= (struct w32font_info
*) XFONT_OBJECT (font_object
);
765 font
= (struct font
*) w32_font
;
770 /* Copy from font entity. */
771 for (i
= 0; i
< FONT_ENTITY_MAX
; i
++)
772 ASET (font_object
, i
, AREF (font_entity
, i
));
773 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
775 bzero (&logfont
, sizeof (logfont
));
776 fill_in_logfont (f
, &logfont
, font_entity
);
778 size
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
782 logfont
.lfHeight
= -size
;
783 hfont
= CreateFontIndirect (&logfont
);
788 /* Get the metrics for this font. */
789 dc
= get_frame_dc (f
);
790 old_font
= SelectObject (dc
, hfont
);
792 /* Try getting the outline metrics (only works for truetype fonts). */
793 len
= GetOutlineTextMetrics (dc
, 0, NULL
);
796 metrics
= (OUTLINETEXTMETRIC
*) alloca (len
);
797 if (GetOutlineTextMetrics (dc
, len
, metrics
))
798 bcopy (&metrics
->otmTextMetrics
, &w32_font
->metrics
,
799 sizeof (TEXTMETRIC
));
804 GetTextMetrics (dc
, &w32_font
->metrics
);
806 w32_font
->glyph_idx
= ETO_GLYPH_INDEX
;
808 w32_font
->cached_metrics
= NULL
;
809 w32_font
->n_cache_blocks
= 0;
811 SelectObject (dc
, old_font
);
812 release_frame_dc (f
, dc
);
814 /* W32FontStruct - we should get rid of this, and use the w32font_info
815 struct for any W32 specific fields. font->font.font can then be hfont. */
816 w32_font
->compat_w32_font
= xmalloc (sizeof (W32FontStruct
));
817 compat_w32_font
= w32_font
->compat_w32_font
;
818 bzero (compat_w32_font
, sizeof (W32FontStruct
));
819 compat_w32_font
->font_type
= UNICODE_FONT
;
820 /* Duplicate the text metrics. */
821 bcopy (&w32_font
->metrics
, &compat_w32_font
->tm
, sizeof (TEXTMETRIC
));
822 compat_w32_font
->hfont
= hfont
;
827 /* We don't know how much space we need for the full name, so start with
828 96 bytes and go up in steps of 32. */
830 name
= xmalloc (len
);
831 while (name
&& w32font_full_name (&logfont
, font_entity
, pixel_size
,
834 char *new = xrealloc (name
, len
+= 32);
841 font
->props
[FONT_FULLNAME_INDEX
]
842 = make_unibyte_string (name
, strlen (name
));
844 font
->props
[FONT_FULLNAME_INDEX
] =
845 make_unibyte_string (logfont
.lfFaceName
, len
);
848 font
->max_width
= w32_font
->metrics
.tmMaxCharWidth
;
849 font
->height
= w32_font
->metrics
.tmHeight
850 + w32_font
->metrics
.tmExternalLeading
;
851 font
->space_width
= font
->average_width
= w32_font
->metrics
.tmAveCharWidth
;
853 font
->vertical_centering
= 0;
854 font
->encoding_type
= 0;
855 font
->baseline_offset
= 0;
856 font
->relative_compose
= 0;
857 font
->default_ascent
= w32_font
->metrics
.tmAscent
;
858 font
->font_encoder
= NULL
;
859 font
->pixel_size
= size
;
860 font
->driver
= &w32font_driver
;
861 /* Use format cached during list, as the information we have access to
862 here is incomplete. */
863 extra
= AREF (font_entity
, FONT_EXTRA_INDEX
);
866 val
= assq_no_quit (QCformat
, extra
);
868 font
->props
[FONT_FORMAT_INDEX
] = XCDR (val
);
870 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
873 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
875 font
->props
[FONT_FILE_INDEX
] = Qnil
;
876 font
->encoding_charset
= -1;
877 font
->repertory_charset
= -1;
878 /* TODO: do we really want the minimum width here, which could be negative? */
879 font
->min_width
= font
->space_width
;
880 font
->ascent
= w32_font
->metrics
.tmAscent
;
881 font
->descent
= w32_font
->metrics
.tmDescent
;
885 font
->underline_thickness
= metrics
->otmsUnderscoreSize
;
886 font
->underline_position
= -metrics
->otmsUnderscorePosition
;
890 font
->underline_thickness
= 0;
891 font
->underline_position
= -1;
894 /* max_descent is used for underlining in w32term.c. Hopefully this
895 is temporary, as we'll want to get rid of the old compatibility
897 compat_w32_font
->max_bounds
.descent
= font
->descent
;
899 /* For temporary compatibility with legacy code that expects the
900 name to be usable in x-list-fonts. Eventually we expect to change
901 x-list-fonts and other places that use fonts so that this can be
902 an fcname or similar. */
903 font
->props
[FONT_NAME_INDEX
] = Ffont_xlfd_name (font_object
);
908 /* Callback function for EnumFontFamiliesEx.
909 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
911 add_font_name_to_list (logical_font
, physical_font
, font_type
, list_object
)
912 ENUMLOGFONTEX
*logical_font
;
913 NEWTEXTMETRICEX
*physical_font
;
917 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
920 /* Skip vertical fonts (intended only for printing) */
921 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
924 family
= font_intern_prop (logical_font
->elfLogFont
.lfFaceName
,
925 strlen (logical_font
->elfLogFont
.lfFaceName
));
926 if (! memq_no_quit (family
, *list
))
927 *list
= Fcons (family
, *list
);
932 static int w32_decode_weight
P_ ((int));
933 static int w32_encode_weight
P_ ((int));
935 /* Convert an enumerated Windows font to an Emacs font entity. */
937 w32_enumfont_pattern_entity (frame
, logical_font
, physical_font
,
938 font_type
, requested_font
, backend
)
940 ENUMLOGFONTEX
*logical_font
;
941 NEWTEXTMETRICEX
*physical_font
;
943 LOGFONT
*requested_font
;
946 Lisp_Object entity
, tem
;
947 LOGFONT
*lf
= (LOGFONT
*) logical_font
;
949 DWORD full_type
= physical_font
->ntmTm
.ntmFlags
;
951 entity
= font_make_entity ();
953 ASET (entity
, FONT_TYPE_INDEX
, backend
);
954 ASET (entity
, FONT_REGISTRY_INDEX
, w32_registry (lf
->lfCharSet
, font_type
));
955 ASET (entity
, FONT_OBJLIST_INDEX
, Qnil
);
957 /* Foundry is difficult to get in readable form on Windows.
958 But Emacs crashes if it is not set, so set it to something more
959 generic. These values make xflds compatible with Emacs 22. */
960 if (lf
->lfOutPrecision
== OUT_STRING_PRECIS
)
962 else if (lf
->lfOutPrecision
== OUT_STROKE_PRECIS
)
967 ASET (entity
, FONT_FOUNDRY_INDEX
, tem
);
969 /* Save the generic family in the extra info, as it is likely to be
970 useful to users looking for a close match. */
971 generic_type
= physical_font
->ntmTm
.tmPitchAndFamily
& 0xF0;
972 if (generic_type
== FF_DECORATIVE
)
974 else if (generic_type
== FF_MODERN
)
976 else if (generic_type
== FF_ROMAN
)
978 else if (generic_type
== FF_SCRIPT
)
980 else if (generic_type
== FF_SWISS
)
985 ASET (entity
, FONT_ADSTYLE_INDEX
, tem
);
987 if (physical_font
->ntmTm
.tmPitchAndFamily
& 0x01)
988 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_PROPORTIONAL
));
990 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_MONO
));
992 if (requested_font
->lfQuality
!= DEFAULT_QUALITY
)
994 font_put_extra (entity
, QCantialias
,
995 lispy_antialias_type (requested_font
->lfQuality
));
997 ASET (entity
, FONT_FAMILY_INDEX
,
998 font_intern_prop (lf
->lfFaceName
, strlen (lf
->lfFaceName
)));
1000 FONT_SET_STYLE (entity
, FONT_WEIGHT_INDEX
,
1001 make_number (w32_decode_weight (lf
->lfWeight
)));
1002 FONT_SET_STYLE (entity
, FONT_SLANT_INDEX
,
1003 make_number (lf
->lfItalic
? 200 : 100));
1004 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1006 FONT_SET_STYLE (entity
, FONT_WIDTH_INDEX
, make_number (100));
1008 if (font_type
& RASTER_FONTTYPE
)
1009 ASET (entity
, FONT_SIZE_INDEX
, make_number (physical_font
->ntmTm
.tmHeight
));
1011 ASET (entity
, FONT_SIZE_INDEX
, make_number (0));
1013 /* Cache unicode codepoints covered by this font, as there is no other way
1014 of getting this information easily. */
1015 if (font_type
& TRUETYPE_FONTTYPE
)
1017 font_put_extra (entity
, QCscript
,
1018 font_supported_scripts (&physical_font
->ntmFontSig
));
1021 /* This information is not fully available when opening fonts, so
1022 save it here. Only Windows 2000 and later return information
1023 about opentype and type1 fonts, so need a fallback for detecting
1024 truetype so that this information is not any worse than we could
1025 have obtained later. */
1026 if (EQ (backend
, Quniscribe
) && (full_type
& NTMFLAGS_OPENTYPE
))
1027 tem
= intern ("opentype");
1028 else if (font_type
& TRUETYPE_FONTTYPE
)
1029 tem
= intern ("truetype");
1030 else if (full_type
& NTM_PS_OPENTYPE
)
1031 tem
= intern ("postscript");
1032 else if (full_type
& NTM_TYPE1
)
1033 tem
= intern ("type1");
1034 else if (font_type
& RASTER_FONTTYPE
)
1035 tem
= intern ("w32bitmap");
1037 tem
= intern ("w32vector");
1039 font_put_extra (entity
, QCformat
, tem
);
1045 /* Convert generic families to the family portion of lfPitchAndFamily. */
1047 w32_generic_family (Lisp_Object name
)
1049 /* Generic families. */
1050 if (EQ (name
, Qmonospace
) || EQ (name
, Qmono
))
1052 else if (EQ (name
, Qsans
) || EQ (name
, Qsans_serif
) || EQ (name
, Qsansserif
))
1054 else if (EQ (name
, Qserif
))
1056 else if (EQ (name
, Qdecorative
))
1057 return FF_DECORATIVE
;
1058 else if (EQ (name
, Qscript
))
1065 logfonts_match (font
, pattern
)
1066 LOGFONT
*font
, *pattern
;
1068 /* Only check height for raster fonts. */
1069 if (pattern
->lfHeight
&& font
->lfOutPrecision
== OUT_STRING_PRECIS
1070 && font
->lfHeight
!= pattern
->lfHeight
)
1073 /* Have some flexibility with weights. */
1074 if (pattern
->lfWeight
1075 && ((font
->lfWeight
< (pattern
->lfWeight
- 150))
1076 || font
->lfWeight
> (pattern
->lfWeight
+ 150)))
1079 /* Charset and face should be OK. Italic has to be checked
1080 against the original spec, in case we don't have any preference. */
1085 font_matches_spec (type
, font
, spec
, backend
, logfont
)
1087 NEWTEXTMETRICEX
*font
;
1089 Lisp_Object backend
;
1092 Lisp_Object extra
, val
;
1094 /* Check italic. Can't check logfonts, since it is a boolean field,
1095 so there is no difference between "non-italic" and "don't care". */
1097 int slant
= FONT_SLANT_NUMERIC (spec
);
1100 && ((slant
> 150 && !font
->ntmTm
.tmItalic
)
1101 || (slant
<= 150 && font
->ntmTm
.tmItalic
)))
1105 /* Check adstyle against generic family. */
1106 val
= AREF (spec
, FONT_ADSTYLE_INDEX
);
1109 BYTE family
= w32_generic_family (val
);
1110 if (family
!= FF_DONTCARE
1111 && family
!= (font
->ntmTm
.tmPitchAndFamily
& 0xF0))
1116 val
= AREF (spec
, FONT_SPACING_INDEX
);
1119 int spacing
= XINT (val
);
1120 int proportional
= (spacing
< FONT_SPACING_MONO
);
1122 if ((proportional
&& !(font
->ntmTm
.tmPitchAndFamily
& 0x01))
1123 || (!proportional
&& (font
->ntmTm
.tmPitchAndFamily
& 0x01)))
1127 /* Check extra parameters. */
1128 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
1129 CONSP (extra
); extra
= XCDR (extra
))
1131 Lisp_Object extra_entry
;
1132 extra_entry
= XCAR (extra
);
1133 if (CONSP (extra_entry
))
1135 Lisp_Object key
= XCAR (extra_entry
);
1137 val
= XCDR (extra_entry
);
1138 if (EQ (key
, QCscript
) && SYMBOLP (val
))
1140 /* Only truetype fonts will have information about what
1141 scripts they support. This probably means the user
1142 will have to force Emacs to use raster, postscript
1143 or atm fonts for non-ASCII text. */
1144 if (type
& TRUETYPE_FONTTYPE
)
1147 = font_supported_scripts (&font
->ntmFontSig
);
1148 if (! memq_no_quit (val
, support
))
1153 /* Return specific matches, but play it safe. Fonts
1154 that cover more than their charset would suggest
1155 are likely to be truetype or opentype fonts,
1157 if (EQ (val
, Qlatin
))
1159 /* Although every charset but symbol, thai and
1160 arabic contains the basic ASCII set of latin
1161 characters, Emacs expects much more. */
1162 if (font
->ntmTm
.tmCharSet
!= ANSI_CHARSET
)
1165 else if (EQ (val
, Qsymbol
))
1167 if (font
->ntmTm
.tmCharSet
!= SYMBOL_CHARSET
)
1170 else if (EQ (val
, Qcyrillic
))
1172 if (font
->ntmTm
.tmCharSet
!= RUSSIAN_CHARSET
)
1175 else if (EQ (val
, Qgreek
))
1177 if (font
->ntmTm
.tmCharSet
!= GREEK_CHARSET
)
1180 else if (EQ (val
, Qarabic
))
1182 if (font
->ntmTm
.tmCharSet
!= ARABIC_CHARSET
)
1185 else if (EQ (val
, Qhebrew
))
1187 if (font
->ntmTm
.tmCharSet
!= HEBREW_CHARSET
)
1190 else if (EQ (val
, Qthai
))
1192 if (font
->ntmTm
.tmCharSet
!= THAI_CHARSET
)
1195 else if (EQ (val
, Qkana
))
1197 if (font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1200 else if (EQ (val
, Qbopomofo
))
1202 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
)
1205 else if (EQ (val
, Qhangul
))
1207 if (font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1208 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
)
1211 else if (EQ (val
, Qhan
))
1213 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
1214 && font
->ntmTm
.tmCharSet
!= GB2312_CHARSET
1215 && font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1216 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
1217 && font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1221 /* Other scripts unlikely to be handled by non-truetype
1226 else if (EQ (key
, QClang
) && SYMBOLP (val
))
1228 /* Just handle the CJK languages here, as the language
1229 parameter is used to select a font with appropriate
1230 glyphs in the cjk unified ideographs block. Other fonts
1231 support for a language can be solely determined by
1232 its character coverage. */
1235 if (font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1238 else if (EQ (val
, Qko
))
1240 if (font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1241 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
)
1244 else if (EQ (val
, Qzh
))
1246 if (font
->ntmTm
.tmCharSet
!= GB2312_CHARSET
1247 && font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
)
1251 /* Any other language, we don't recognize it. Fontset
1252 spec should have a fallback, as some backends do
1253 not recognize language at all. */
1256 else if (EQ (key
, QCotf
) && CONSP (val
))
1258 /* OTF features only supported by the uniscribe backend. */
1259 if (EQ (backend
, Quniscribe
))
1261 if (!uniscribe_check_otf (logfont
, val
))
1273 w32font_coverage_ok (coverage
, charset
)
1274 FONTSIGNATURE
* coverage
;
1277 DWORD subrange1
= coverage
->fsUsb
[1];
1279 #define SUBRANGE1_HAN_MASK 0x08000000
1280 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1281 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1283 if (charset
== GB2312_CHARSET
|| charset
== CHINESEBIG5_CHARSET
)
1285 return (subrange1
& SUBRANGE1_HAN_MASK
) == SUBRANGE1_HAN_MASK
;
1287 else if (charset
== SHIFTJIS_CHARSET
)
1289 return (subrange1
& SUBRANGE1_JAPANESE_MASK
) == SUBRANGE1_JAPANESE_MASK
;
1291 else if (charset
== HANGEUL_CHARSET
)
1293 return (subrange1
& SUBRANGE1_HANGEUL_MASK
) == SUBRANGE1_HANGEUL_MASK
;
1299 /* Callback function for EnumFontFamiliesEx.
1300 * Checks if a font matches everything we are trying to check agaist,
1301 * and if so, adds it to a list. Both the data we are checking against
1302 * and the list to which the fonts are added are passed in via the
1303 * lparam argument, in the form of a font_callback_data struct. */
1305 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1306 ENUMLOGFONTEX
*logical_font
;
1307 NEWTEXTMETRICEX
*physical_font
;
1311 struct font_callback_data
*match_data
1312 = (struct font_callback_data
*) lParam
;
1313 Lisp_Object backend
= match_data
->opentype_only
? Quniscribe
: Qgdi
;
1315 if ((!match_data
->opentype_only
1316 || (physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
1317 || (font_type
& TRUETYPE_FONTTYPE
))
1318 && logfonts_match (&logical_font
->elfLogFont
, &match_data
->pattern
)
1319 && font_matches_spec (font_type
, physical_font
,
1320 match_data
->orig_font_spec
, backend
,
1321 &logical_font
->elfLogFont
)
1322 && w32font_coverage_ok (&physical_font
->ntmFontSig
,
1323 match_data
->pattern
.lfCharSet
)
1324 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1325 We limit this to raster fonts, because the test can catch some
1326 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1327 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1328 therefore get through this test. Since full names can be prefixed
1329 by a foundry, we accept raster fonts if the font name is found
1330 anywhere within the full name. */
1331 && (logical_font
->elfLogFont
.lfOutPrecision
!= OUT_STRING_PRECIS
1332 || strstr (logical_font
->elfFullName
,
1333 logical_font
->elfLogFont
.lfFaceName
)))
1336 = w32_enumfont_pattern_entity (match_data
->frame
, logical_font
,
1337 physical_font
, font_type
,
1338 &match_data
->pattern
,
1341 match_data
->list
= Fcons (entity
, match_data
->list
);
1346 /* Callback function for EnumFontFamiliesEx.
1347 * Terminates the search once we have a match. */
1349 add_one_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1350 ENUMLOGFONTEX
*logical_font
;
1351 NEWTEXTMETRICEX
*physical_font
;
1355 struct font_callback_data
*match_data
1356 = (struct font_callback_data
*) lParam
;
1357 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
);
1359 /* If we have a font in the list, terminate the search. */
1360 return !NILP (match_data
->list
);
1363 /* Convert a Lisp font registry (symbol) to a windows charset. */
1365 registry_to_w32_charset (charset
)
1366 Lisp_Object charset
;
1368 if (EQ (charset
, Qiso10646_1
) || EQ (charset
, Qunicode_bmp
)
1369 || EQ (charset
, Qunicode_sip
))
1370 return DEFAULT_CHARSET
; /* UNICODE_CHARSET not defined in MingW32 */
1371 else if (EQ (charset
, Qiso8859_1
))
1372 return ANSI_CHARSET
;
1373 else if (SYMBOLP (charset
))
1374 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset
)));
1376 return DEFAULT_CHARSET
;
1380 w32_registry (w32_charset
, font_type
)
1384 /* If charset is defaulted, use ANSI (unicode for truetype fonts). */
1385 if (w32_charset
== DEFAULT_CHARSET
)
1386 w32_charset
= ANSI_CHARSET
;
1388 if (font_type
== TRUETYPE_FONTTYPE
&& w32_charset
== ANSI_CHARSET
)
1392 char * charset
= w32_to_x_charset (w32_charset
, NULL
);
1393 return font_intern_prop (charset
, strlen(charset
));
1399 unsigned w32_numeric
;
1401 } w32_weight_table
[] =
1403 { FW_EXTRALIGHT
, 40 },
1407 { FW_SEMIBOLD
, 180},
1409 { FW_EXTRABOLD
, 205},
1413 w32_decode_weight (fnweight
)
1416 if (fnweight
>= FW_HEAVY
) return 210;
1417 if (fnweight
>= FW_EXTRABOLD
) return 205;
1418 if (fnweight
>= FW_BOLD
) return 200;
1419 if (fnweight
>= FW_SEMIBOLD
) return 180;
1420 if (fnweight
>= FW_NORMAL
) return 100;
1421 if (fnweight
>= FW_LIGHT
) return 50;
1422 if (fnweight
>= FW_EXTRALIGHT
) return 40;
1423 if (fnweight
> FW_THIN
) return 20;
1428 w32_encode_weight (n
)
1431 if (n
>= 210) return FW_HEAVY
;
1432 if (n
>= 205) return FW_EXTRABOLD
;
1433 if (n
>= 200) return FW_BOLD
;
1434 if (n
>= 180) return FW_SEMIBOLD
;
1435 if (n
>= 100) return FW_NORMAL
;
1436 if (n
>= 50) return FW_LIGHT
;
1437 if (n
>= 40) return FW_EXTRALIGHT
;
1438 if (n
>= 20) return FW_THIN
;
1442 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1444 fill_in_logfont (f
, logfont
, font_spec
)
1447 Lisp_Object font_spec
;
1449 Lisp_Object tmp
, extra
;
1450 int dpi
= FRAME_W32_DISPLAY_INFO (f
)->resy
;
1452 tmp
= AREF (font_spec
, FONT_DPI_INDEX
);
1457 else if (FLOATP (tmp
))
1459 dpi
= (int) (XFLOAT_DATA (tmp
) + 0.5);
1463 tmp
= AREF (font_spec
, FONT_SIZE_INDEX
);
1465 logfont
->lfHeight
= -1 * XINT (tmp
);
1466 else if (FLOATP (tmp
))
1467 logfont
->lfHeight
= (int) (-1.0 * dpi
* XFLOAT_DATA (tmp
) / 72.27 + 0.5);
1474 tmp
= AREF (font_spec
, FONT_WEIGHT_INDEX
);
1476 logfont
->lfWeight
= w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec
));
1479 tmp
= AREF (font_spec
, FONT_SLANT_INDEX
);
1482 int slant
= FONT_SLANT_NUMERIC (font_spec
);
1483 logfont
->lfItalic
= slant
> 150 ? 1 : 0;
1491 tmp
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1493 logfont
->lfCharSet
= registry_to_w32_charset (tmp
);
1495 logfont
->lfCharSet
= DEFAULT_CHARSET
;
1499 /* Clip Precision */
1502 logfont
->lfQuality
= DEFAULT_QUALITY
;
1504 /* Generic Family and Face Name */
1505 logfont
->lfPitchAndFamily
= FF_DONTCARE
| DEFAULT_PITCH
;
1507 tmp
= AREF (font_spec
, FONT_FAMILY_INDEX
);
1510 logfont
->lfPitchAndFamily
= w32_generic_family (tmp
) | DEFAULT_PITCH
;
1511 if ((logfont
->lfPitchAndFamily
& 0xF0) != FF_DONTCARE
)
1512 ; /* Font name was generic, don't fill in font name. */
1513 /* Font families are interned, but allow for strings also in case of
1515 else if (SYMBOLP (tmp
))
1516 strncpy (logfont
->lfFaceName
, SDATA (SYMBOL_NAME (tmp
)), LF_FACESIZE
);
1519 tmp
= AREF (font_spec
, FONT_ADSTYLE_INDEX
);
1522 /* Override generic family. */
1523 BYTE family
= w32_generic_family (tmp
);
1524 if (family
!= FF_DONTCARE
)
1525 logfont
->lfPitchAndFamily
= family
| DEFAULT_PITCH
;
1529 /* Set pitch based on the spacing property. */
1530 tmp
= AREF (font_spec
, FONT_SPACING_INDEX
);
1533 int spacing
= XINT (tmp
);
1534 if (spacing
< FONT_SPACING_MONO
)
1535 logfont
->lfPitchAndFamily
1536 = logfont
->lfPitchAndFamily
& 0xF0 | VARIABLE_PITCH
;
1538 logfont
->lfPitchAndFamily
1539 = logfont
->lfPitchAndFamily
& 0xF0 | FIXED_PITCH
;
1542 /* Process EXTRA info. */
1543 for (extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
1544 CONSP (extra
); extra
= XCDR (extra
))
1549 Lisp_Object key
, val
;
1550 key
= XCAR (tmp
), val
= XCDR (tmp
);
1551 /* Only use QCscript if charset is not provided, or is unicode
1552 and a single script is specified. This is rather crude,
1553 and is only used to narrow down the fonts returned where
1554 there is a definite match. Some scripts, such as latin, han,
1555 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1557 if (EQ (key
, QCscript
)
1558 && logfont
->lfCharSet
== DEFAULT_CHARSET
1561 if (EQ (val
, Qgreek
))
1562 logfont
->lfCharSet
= GREEK_CHARSET
;
1563 else if (EQ (val
, Qhangul
))
1564 logfont
->lfCharSet
= HANGUL_CHARSET
;
1565 else if (EQ (val
, Qkana
) || EQ (val
, Qkanbun
))
1566 logfont
->lfCharSet
= SHIFTJIS_CHARSET
;
1567 else if (EQ (val
, Qbopomofo
))
1568 logfont
->lfCharSet
= CHINESEBIG5_CHARSET
;
1569 /* GB 18030 supports tibetan, yi, mongolian,
1570 fonts that support it should show up if we ask for
1572 else if (EQ (val
, Qtibetan
) || EQ (val
, Qyi
)
1573 || EQ (val
, Qmongolian
))
1574 logfont
->lfCharSet
= GB2312_CHARSET
;
1575 else if (EQ (val
, Qhebrew
))
1576 logfont
->lfCharSet
= HEBREW_CHARSET
;
1577 else if (EQ (val
, Qarabic
))
1578 logfont
->lfCharSet
= ARABIC_CHARSET
;
1579 else if (EQ (val
, Qthai
))
1580 logfont
->lfCharSet
= THAI_CHARSET
;
1581 else if (EQ (val
, Qsymbol
))
1582 logfont
->lfCharSet
= SYMBOL_CHARSET
;
1584 else if (EQ (key
, QCantialias
) && SYMBOLP (val
))
1586 logfont
->lfQuality
= w32_antialias_type (val
);
1593 list_all_matching_fonts (match_data
)
1594 struct font_callback_data
*match_data
;
1597 Lisp_Object families
= w32font_list_family (match_data
->frame
);
1598 struct frame
*f
= XFRAME (match_data
->frame
);
1600 dc
= get_frame_dc (f
);
1602 while (!NILP (families
))
1604 /* TODO: Use the Unicode versions of the W32 APIs, so we can
1605 handle non-ASCII font names. */
1607 Lisp_Object family
= CAR (families
);
1608 families
= CDR (families
);
1611 else if (SYMBOLP (family
))
1612 name
= SDATA (SYMBOL_NAME (family
));
1616 strncpy (match_data
->pattern
.lfFaceName
, name
, LF_FACESIZE
);
1617 match_data
->pattern
.lfFaceName
[LF_FACESIZE
- 1] = '\0';
1619 EnumFontFamiliesEx (dc
, &match_data
->pattern
,
1620 (FONTENUMPROC
) add_font_entity_to_list
,
1621 (LPARAM
) match_data
, 0);
1624 release_frame_dc (f
, dc
);
1628 lispy_antialias_type (type
)
1635 case NONANTIALIASED_QUALITY
:
1638 case ANTIALIASED_QUALITY
:
1641 case CLEARTYPE_QUALITY
:
1644 case CLEARTYPE_NATURAL_QUALITY
:
1654 /* Convert antialiasing symbols to lfQuality */
1656 w32_antialias_type (type
)
1659 if (EQ (type
, Qnone
))
1660 return NONANTIALIASED_QUALITY
;
1661 else if (EQ (type
, Qstandard
))
1662 return ANTIALIASED_QUALITY
;
1663 else if (EQ (type
, Qsubpixel
))
1664 return CLEARTYPE_QUALITY
;
1665 else if (EQ (type
, Qnatural
))
1666 return CLEARTYPE_NATURAL_QUALITY
;
1668 return DEFAULT_QUALITY
;
1671 /* Return a list of all the scripts that the font supports. */
1673 font_supported_scripts (FONTSIGNATURE
* sig
)
1675 DWORD
* subranges
= sig
->fsUsb
;
1676 Lisp_Object supported
= Qnil
;
1678 /* Match a single subrange. SYM is set if bit N is set in subranges. */
1679 #define SUBRANGE(n,sym) \
1680 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
1681 supported = Fcons ((sym), supported)
1683 /* Match multiple subranges. SYM is set if any MASK bit is set in
1684 subranges[0 - 3]. */
1685 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
1686 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
1687 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
1688 supported = Fcons ((sym), supported)
1690 SUBRANGE (0, Qlatin
);
1691 /* The following count as latin too, ASCII should be present in these fonts,
1692 so don't need to mark them separately. */
1693 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
1694 SUBRANGE (4, Qphonetic
);
1695 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
1696 SUBRANGE (7, Qgreek
);
1697 SUBRANGE (8, Qcoptic
);
1698 SUBRANGE (9, Qcyrillic
);
1699 SUBRANGE (10, Qarmenian
);
1700 SUBRANGE (11, Qhebrew
);
1701 SUBRANGE (13, Qarabic
);
1702 SUBRANGE (14, Qnko
);
1703 SUBRANGE (15, Qdevanagari
);
1704 SUBRANGE (16, Qbengali
);
1705 SUBRANGE (17, Qgurmukhi
);
1706 SUBRANGE (18, Qgujarati
);
1707 SUBRANGE (19, Qoriya
);
1708 SUBRANGE (20, Qtamil
);
1709 SUBRANGE (21, Qtelugu
);
1710 SUBRANGE (22, Qkannada
);
1711 SUBRANGE (23, Qmalayalam
);
1712 SUBRANGE (24, Qthai
);
1713 SUBRANGE (25, Qlao
);
1714 SUBRANGE (26, Qgeorgian
);
1715 SUBRANGE (27, Qbalinese
);
1716 /* 28: Hangul Jamo. */
1717 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
1718 /* 32-47: Symbols (defined below). */
1719 SUBRANGE (48, Qcjk_misc
);
1720 /* Match either 49: katakana or 50: hiragana for kana. */
1721 MASK_ANY (0, 0x00060000, 0, 0, Qkana
);
1722 SUBRANGE (51, Qbopomofo
);
1723 /* 52: Compatibility Jamo */
1724 SUBRANGE (53, Qphags_pa
);
1725 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
1726 SUBRANGE (56, Qhangul
);
1727 /* 57: Surrogates. */
1728 SUBRANGE (58, Qphoenician
);
1729 SUBRANGE (59, Qhan
); /* There are others, but this is the main one. */
1730 SUBRANGE (59, Qideographic_description
); /* Windows lumps this in. */
1731 SUBRANGE (59, Qkanbun
); /* And this. */
1732 /* 60: Private use, 61: CJK strokes and compatibility. */
1733 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
1734 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
1735 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
1737 SUBRANGE (70, Qtibetan
);
1738 SUBRANGE (71, Qsyriac
);
1739 SUBRANGE (72, Qthaana
);
1740 SUBRANGE (73, Qsinhala
);
1741 SUBRANGE (74, Qmyanmar
);
1742 SUBRANGE (75, Qethiopic
);
1743 SUBRANGE (76, Qcherokee
);
1744 SUBRANGE (77, Qcanadian_aboriginal
);
1745 SUBRANGE (78, Qogham
);
1746 SUBRANGE (79, Qrunic
);
1747 SUBRANGE (80, Qkhmer
);
1748 SUBRANGE (81, Qmongolian
);
1749 SUBRANGE (82, Qbraille
);
1751 SUBRANGE (84, Qbuhid
);
1752 SUBRANGE (84, Qhanunoo
);
1753 SUBRANGE (84, Qtagalog
);
1754 SUBRANGE (84, Qtagbanwa
);
1755 SUBRANGE (85, Qold_italic
);
1756 SUBRANGE (86, Qgothic
);
1757 SUBRANGE (87, Qdeseret
);
1758 SUBRANGE (88, Qbyzantine_musical_symbol
);
1759 SUBRANGE (88, Qmusical_symbol
); /* Windows doesn't distinguish these. */
1760 SUBRANGE (89, Qmathematical
);
1761 /* 90: Private use, 91: Variation selectors, 92: Tags. */
1762 SUBRANGE (93, Qlimbu
);
1763 SUBRANGE (94, Qtai_le
);
1764 /* 95: New Tai Le */
1765 SUBRANGE (90, Qbuginese
);
1766 SUBRANGE (97, Qglagolitic
);
1767 SUBRANGE (98, Qtifinagh
);
1768 /* 99: Yijing Hexagrams. */
1769 SUBRANGE (100, Qsyloti_nagri
);
1770 SUBRANGE (101, Qlinear_b
);
1771 /* 102: Ancient Greek Numbers. */
1772 SUBRANGE (103, Qugaritic
);
1773 SUBRANGE (104, Qold_persian
);
1774 SUBRANGE (105, Qshavian
);
1775 SUBRANGE (106, Qosmanya
);
1776 SUBRANGE (107, Qcypriot
);
1777 SUBRANGE (108, Qkharoshthi
);
1778 /* 109: Tai Xuan Jing. */
1779 SUBRANGE (110, Qcuneiform
);
1780 /* 111: Counting Rods. */
1782 /* There isn't really a main symbol range, so include symbol if any
1783 relevant range is set. */
1784 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol
);
1786 /* Missing: Tai Viet (U+AA80) and Cham (U+AA00) . */
1793 /* Generate a full name for a Windows font.
1794 The full name is in fcname format, with weight, slant and antialiasing
1795 specified if they are not "normal". */
1797 w32font_full_name (font
, font_obj
, pixel_size
, name
, nbytes
)
1799 Lisp_Object font_obj
;
1804 int len
, height
, outline
;
1806 Lisp_Object antialiasing
, weight
= Qnil
;
1808 len
= strlen (font
->lfFaceName
);
1810 outline
= EQ (AREF (font_obj
, FONT_FOUNDRY_INDEX
), Qoutline
);
1812 /* Represent size of scalable fonts by point size. But use pixelsize for
1813 raster fonts to indicate that they are exactly that size. */
1815 len
+= 11; /* -SIZE */
1817 len
= strlen (font
->lfFaceName
) + 21;
1820 len
+= 7; /* :italic */
1822 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
1824 weight
= FONT_WEIGHT_SYMBOLIC (font_obj
);
1825 len
+= 8 + SBYTES (SYMBOL_NAME (weight
)); /* :weight=NAME */
1828 antialiasing
= lispy_antialias_type (font
->lfQuality
);
1829 if (! NILP (antialiasing
))
1830 len
+= 11 + SBYTES (SYMBOL_NAME (antialiasing
)); /* :antialias=NAME */
1832 /* Check that the buffer is big enough */
1837 p
+= sprintf (p
, "%s", font
->lfFaceName
);
1839 height
= font
->lfHeight
? eabs (font
->lfHeight
) : pixel_size
;
1845 float pointsize
= height
* 72.0 / one_w32_display_info
.resy
;
1846 /* Round to nearest half point. floor is used, since round is not
1847 supported in MS library. */
1848 pointsize
= floor (pointsize
* 2 + 0.5) / 2;
1849 p
+= sprintf (p
, "-%1.1f", pointsize
);
1852 p
+= sprintf (p
, ":pixelsize=%d", height
);
1856 p
+= sprintf (p
, ":italic");
1858 if (SYMBOLP (weight
) && ! NILP (weight
))
1859 p
+= sprintf (p
, ":weight=%s", SDATA (SYMBOL_NAME (weight
)));
1861 if (SYMBOLP (antialiasing
) && ! NILP (antialiasing
))
1862 p
+= sprintf (p
, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing
)));
1868 static void compute_metrics (dc
, w32_font
, code
, metrics
)
1870 struct w32font_info
*w32_font
;
1872 struct w32_metric_cache
*metrics
;
1876 unsigned int options
= GGO_METRICS
;
1878 if (w32_font
->glyph_idx
)
1879 options
|= GGO_GLYPH_INDEX
;
1881 bzero (&transform
, sizeof (transform
));
1882 transform
.eM11
.value
= 1;
1883 transform
.eM22
.value
= 1;
1885 if (GetGlyphOutlineW (dc
, code
, options
, &gm
, 0, NULL
, &transform
)
1888 metrics
->lbearing
= gm
.gmptGlyphOrigin
.x
;
1889 metrics
->rbearing
= gm
.gmptGlyphOrigin
.x
+ gm
.gmBlackBoxX
;
1890 metrics
->width
= gm
.gmCellIncX
;
1891 metrics
->status
= W32METRIC_SUCCESS
;
1895 if (w32_font
->glyph_idx
)
1897 /* Can't use glyph indexes after all.
1898 Avoid it in future, and clear any metrics that were based on
1900 w32_font
->glyph_idx
= 0;
1901 clear_cached_metrics (w32_font
);
1903 metrics
->status
= W32METRIC_FAIL
;
1908 clear_cached_metrics (w32_font
)
1909 struct w32font_info
*w32_font
;
1912 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
1914 if (w32_font
->cached_metrics
[i
])
1915 bzero (w32_font
->cached_metrics
[i
],
1916 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
1920 struct font_driver w32font_driver
=
1923 0, /* case insensitive */
1927 w32font_list_family
,
1928 NULL
, /* free_entity */
1931 NULL
, /* prepare_face */
1932 NULL
, /* done_face */
1934 w32font_encode_char
,
1935 w32font_text_extents
,
1937 NULL
, /* get_bitmap */
1938 NULL
, /* free_bitmap */
1939 NULL
, /* get_outline */
1940 NULL
, /* free_outline */
1941 NULL
, /* anchor_point */
1942 NULL
, /* otf_capability */
1943 NULL
, /* otf_drive */
1944 NULL
, /* start_for_frame */
1945 NULL
, /* end_for_frame */
1950 /* Initialize state that does not change between invocations. This is only
1951 called when Emacs is dumped. */
1955 DEFSYM (Qgdi
, "gdi");
1956 DEFSYM (Quniscribe
, "uniscribe");
1957 DEFSYM (QCformat
, ":format");
1959 /* Generic font families. */
1960 DEFSYM (Qmonospace
, "monospace");
1961 DEFSYM (Qserif
, "serif");
1962 DEFSYM (Qsansserif
, "sansserif");
1963 DEFSYM (Qscript
, "script");
1964 DEFSYM (Qdecorative
, "decorative");
1966 DEFSYM (Qsans_serif
, "sans_serif");
1967 DEFSYM (Qsans
, "sans");
1968 DEFSYM (Qmono
, "mono");
1970 /* Fake foundries. */
1971 DEFSYM (Qraster
, "raster");
1972 DEFSYM (Qoutline
, "outline");
1973 DEFSYM (Qunknown
, "unknown");
1976 DEFSYM (Qstandard
, "standard");
1977 DEFSYM (Qsubpixel
, "subpixel");
1978 DEFSYM (Qnatural
, "natural");
1986 DEFSYM (Qlatin
, "latin");
1987 DEFSYM (Qgreek
, "greek");
1988 DEFSYM (Qcoptic
, "coptic");
1989 DEFSYM (Qcyrillic
, "cyrillic");
1990 DEFSYM (Qarmenian
, "armenian");
1991 DEFSYM (Qhebrew
, "hebrew");
1992 DEFSYM (Qarabic
, "arabic");
1993 DEFSYM (Qsyriac
, "syriac");
1994 DEFSYM (Qnko
, "nko");
1995 DEFSYM (Qthaana
, "thaana");
1996 DEFSYM (Qdevanagari
, "devanagari");
1997 DEFSYM (Qbengali
, "bengali");
1998 DEFSYM (Qgurmukhi
, "gurmukhi");
1999 DEFSYM (Qgujarati
, "gujarati");
2000 DEFSYM (Qoriya
, "oriya");
2001 DEFSYM (Qtamil
, "tamil");
2002 DEFSYM (Qtelugu
, "telugu");
2003 DEFSYM (Qkannada
, "kannada");
2004 DEFSYM (Qmalayalam
, "malayalam");
2005 DEFSYM (Qsinhala
, "sinhala");
2006 DEFSYM (Qthai
, "thai");
2007 DEFSYM (Qlao
, "lao");
2008 DEFSYM (Qtibetan
, "tibetan");
2009 DEFSYM (Qmyanmar
, "myanmar");
2010 DEFSYM (Qgeorgian
, "georgian");
2011 DEFSYM (Qhangul
, "hangul");
2012 DEFSYM (Qethiopic
, "ethiopic");
2013 DEFSYM (Qcherokee
, "cherokee");
2014 DEFSYM (Qcanadian_aboriginal
, "canadian-aboriginal");
2015 DEFSYM (Qogham
, "ogham");
2016 DEFSYM (Qrunic
, "runic");
2017 DEFSYM (Qkhmer
, "khmer");
2018 DEFSYM (Qmongolian
, "mongolian");
2019 DEFSYM (Qsymbol
, "symbol");
2020 DEFSYM (Qbraille
, "braille");
2021 DEFSYM (Qhan
, "han");
2022 DEFSYM (Qideographic_description
, "ideographic-description");
2023 DEFSYM (Qcjk_misc
, "cjk-misc");
2024 DEFSYM (Qkana
, "kana");
2025 DEFSYM (Qbopomofo
, "bopomofo");
2026 DEFSYM (Qkanbun
, "kanbun");
2028 DEFSYM (Qbyzantine_musical_symbol
, "byzantine-musical-symbol");
2029 DEFSYM (Qmusical_symbol
, "musical-symbol");
2030 DEFSYM (Qmathematical
, "mathematical");
2031 DEFSYM (Qphonetic
, "phonetic");
2032 DEFSYM (Qbalinese
, "balinese");
2033 DEFSYM (Qbuginese
, "buginese");
2034 DEFSYM (Qbuhid
, "buhid");
2035 DEFSYM (Qcuneiform
, "cuneiform");
2036 DEFSYM (Qcypriot
, "cypriot");
2037 DEFSYM (Qdeseret
, "deseret");
2038 DEFSYM (Qglagolitic
, "glagolitic");
2039 DEFSYM (Qgothic
, "gothic");
2040 DEFSYM (Qhanunoo
, "hanunoo");
2041 DEFSYM (Qkharoshthi
, "kharoshthi");
2042 DEFSYM (Qlimbu
, "limbu");
2043 DEFSYM (Qlinear_b
, "linear_b");
2044 DEFSYM (Qold_italic
, "old_italic");
2045 DEFSYM (Qold_persian
, "old_persian");
2046 DEFSYM (Qosmanya
, "osmanya");
2047 DEFSYM (Qphags_pa
, "phags-pa");
2048 DEFSYM (Qphoenician
, "phoenician");
2049 DEFSYM (Qshavian
, "shavian");
2050 DEFSYM (Qsyloti_nagri
, "syloti_nagri");
2051 DEFSYM (Qtagalog
, "tagalog");
2052 DEFSYM (Qtagbanwa
, "tagbanwa");
2053 DEFSYM (Qtai_le
, "tai_le");
2054 DEFSYM (Qtifinagh
, "tifinagh");
2055 DEFSYM (Qugaritic
, "ugaritic");
2057 w32font_driver
.type
= Qgdi
;
2058 register_font_driver (&w32font_driver
, NULL
);
2061 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2062 (do not change this comment) */