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/>. */
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 /* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
48 #ifndef VIETNAMESE_CHARSET
49 #define VIETNAMESE_CHARSET 163
52 #define JOHAB_CHARSET 130
55 extern struct font_driver w32font_driver
;
58 Lisp_Object Quniscribe
;
59 static Lisp_Object QCformat
;
60 static Lisp_Object Qmonospace
, Qsansserif
, Qmono
, Qsans
, Qsans_serif
;
61 static Lisp_Object Qserif
, Qscript
, Qdecorative
;
62 static Lisp_Object Qraster
, Qoutline
, Qunknown
;
65 extern Lisp_Object QCantialias
, QCotf
, QClang
; /* defined in font.c */
66 extern Lisp_Object Qnone
; /* reuse from w32fns.c */
67 static Lisp_Object Qstandard
, Qsubpixel
, Qnatural
;
70 static Lisp_Object Qja
, Qko
, Qzh
;
73 static Lisp_Object Qlatin
, Qgreek
, Qcoptic
, Qcyrillic
, Qarmenian
, Qhebrew
;
74 static Lisp_Object Qarabic
, Qsyriac
, Qnko
, Qthaana
, Qdevanagari
, Qbengali
;
75 static Lisp_Object Qgurmukhi
, Qgujarati
, Qoriya
, Qtamil
, Qtelugu
;
76 static Lisp_Object Qkannada
, Qmalayalam
, Qsinhala
, Qthai
, Qlao
;
77 static Lisp_Object Qtibetan
, Qmyanmar
, Qgeorgian
, Qhangul
, Qethiopic
;
78 static Lisp_Object Qcherokee
, Qcanadian_aboriginal
, Qogham
, Qrunic
;
79 static Lisp_Object Qkhmer
, Qmongolian
, Qsymbol
, Qbraille
, Qhan
;
80 static Lisp_Object Qideographic_description
, Qcjk_misc
, Qkana
, Qbopomofo
;
81 static Lisp_Object Qkanbun
, Qyi
, Qbyzantine_musical_symbol
;
82 static Lisp_Object Qmusical_symbol
, Qmathematical
, Qcham
, Qphonetic
;
83 /* Not defined in characters.el, but referenced in fontset.el. */
84 static Lisp_Object Qbalinese
, Qbuginese
, Qbuhid
, Qcuneiform
, Qcypriot
;
85 static Lisp_Object Qdeseret
, Qglagolitic
, Qgothic
, Qhanunoo
, Qkharoshthi
;
86 static Lisp_Object Qlimbu
, Qlinear_b
, Qold_italic
, Qold_persian
, Qosmanya
;
87 static Lisp_Object Qphags_pa
, Qphoenician
, Qshavian
, Qsyloti_nagri
;
88 static Lisp_Object Qtagalog
, Qtagbanwa
, Qtai_le
, Qtifinagh
, Qugaritic
;
90 /* W32 charsets: for use in Vw32_charset_info_alist. */
91 static Lisp_Object Qw32_charset_ansi
, Qw32_charset_default
;
92 static Lisp_Object Qw32_charset_symbol
, Qw32_charset_shiftjis
;
93 static Lisp_Object Qw32_charset_hangeul
, Qw32_charset_gb2312
;
94 static Lisp_Object Qw32_charset_chinesebig5
, Qw32_charset_oem
;
95 static Lisp_Object Qw32_charset_easteurope
, Qw32_charset_turkish
;
96 static Lisp_Object Qw32_charset_baltic
, Qw32_charset_russian
;
97 static Lisp_Object Qw32_charset_arabic
, Qw32_charset_greek
;
98 static Lisp_Object Qw32_charset_hebrew
, Qw32_charset_vietnamese
;
99 static Lisp_Object Qw32_charset_thai
, Qw32_charset_johab
, Qw32_charset_mac
;
101 /* Associative list linking character set strings to Windows codepages. */
102 static Lisp_Object Vw32_charset_info_alist
;
104 /* Font spacing symbols - defined in font.c. */
105 extern Lisp_Object Qc
, Qp
, Qm
;
107 static void fill_in_logfont
P_ ((FRAME_PTR
, LOGFONT
*, Lisp_Object
));
109 static BYTE w32_antialias_type
P_ ((Lisp_Object
));
110 static Lisp_Object lispy_antialias_type
P_ ((BYTE
));
112 static Lisp_Object font_supported_scripts
P_ ((FONTSIGNATURE
*));
113 static int w32font_full_name
P_ ((LOGFONT
*, Lisp_Object
, int, char *, int));
114 static void compute_metrics
P_ ((HDC
, struct w32font_info
*, unsigned int,
115 struct w32_metric_cache
*));
116 static void clear_cached_metrics
P_ ((struct w32font_info
*));
118 static Lisp_Object w32_registry
P_ ((LONG
, DWORD
));
120 /* EnumFontFamiliesEx callbacks. */
121 static int CALLBACK add_font_entity_to_list
P_ ((ENUMLOGFONTEX
*,
124 static int CALLBACK add_one_font_entity_to_list
P_ ((ENUMLOGFONTEX
*,
127 static int CALLBACK add_font_name_to_list
P_ ((ENUMLOGFONTEX
*,
131 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
132 of what we really want. */
133 struct font_callback_data
135 /* The logfont we are matching against. EnumFontFamiliesEx only matches
136 face name and charset, so we need to manually match everything else
137 in the callback function. */
139 /* The original font spec or entity. */
140 Lisp_Object orig_font_spec
;
141 /* The frame the font is being loaded on. */
143 /* The list to add matches to. */
145 /* Whether to match only opentype fonts. */
149 /* Handles the problem that EnumFontFamiliesEx will not return all
150 style variations if the font name is not specified. */
151 static void list_all_matching_fonts
P_ ((struct font_callback_data
*));
155 memq_no_quit (elt
, list
)
156 Lisp_Object elt
, list
;
158 while (CONSP (list
) && ! EQ (XCAR (list
), elt
))
160 return (CONSP (list
));
163 /* w32 implementation of get_cache for font backend.
164 Return a cache of font-entities on FRAME. The cache must be a
165 cons whose cdr part is the actual cache area. */
167 w32font_get_cache (f
)
170 struct w32_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
172 return (dpyinfo
->name_list_element
);
175 /* w32 implementation of list for font backend.
176 List fonts exactly matching with FONT_SPEC on FRAME. The value
177 is a vector of font-entities. This is the sole API that
178 allocates font-entities. */
180 w32font_list (frame
, font_spec
)
181 Lisp_Object frame
, font_spec
;
183 Lisp_Object fonts
= w32font_list_internal (frame
, font_spec
, 0);
184 font_add_log ("w32font-list", font_spec
, fonts
);
188 /* w32 implementation of match for font backend.
189 Return a font entity most closely matching with FONT_SPEC on
190 FRAME. The closeness is detemined by the font backend, thus
191 `face-font-selection-order' is ignored here. */
193 w32font_match (frame
, font_spec
)
194 Lisp_Object frame
, font_spec
;
196 Lisp_Object entity
= w32font_match_internal (frame
, font_spec
, 0);
197 font_add_log ("w32font-match", font_spec
, entity
);
201 /* w32 implementation of list_family for font backend.
202 List available families. The value is a list of family names
205 w32font_list_family (frame
)
208 Lisp_Object list
= Qnil
;
209 LOGFONT font_match_pattern
;
211 FRAME_PTR f
= XFRAME (frame
);
213 bzero (&font_match_pattern
, sizeof (font_match_pattern
));
214 font_match_pattern
.lfCharSet
= DEFAULT_CHARSET
;
216 dc
= get_frame_dc (f
);
218 EnumFontFamiliesEx (dc
, &font_match_pattern
,
219 (FONTENUMPROC
) add_font_name_to_list
,
221 release_frame_dc (f
, dc
);
226 /* w32 implementation of open for font backend.
227 Open a font specified by FONT_ENTITY on frame F.
228 If the font is scalable, open it with PIXEL_SIZE. */
230 w32font_open (f
, font_entity
, pixel_size
)
232 Lisp_Object font_entity
;
235 Lisp_Object font_object
236 = font_make_object (VECSIZE (struct w32font_info
),
237 font_entity
, pixel_size
);
238 struct w32font_info
*w32_font
239 = (struct w32font_info
*) XFONT_OBJECT (font_object
);
241 ASET (font_object
, FONT_TYPE_INDEX
, Qgdi
);
243 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
248 /* GDI backend does not use glyph indices. */
249 w32_font
->glyph_idx
= 0;
254 /* w32 implementation of close for font_backend.
255 Close FONT on frame F. */
257 w32font_close (f
, font
)
262 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
264 /* Delete the GDI font object. */
265 DeleteObject (w32_font
->hfont
);
267 /* Free all the cached metrics. */
268 if (w32_font
->cached_metrics
)
270 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
272 if (w32_font
->cached_metrics
[i
])
273 xfree (w32_font
->cached_metrics
[i
]);
275 xfree (w32_font
->cached_metrics
);
276 w32_font
->cached_metrics
= NULL
;
280 /* w32 implementation of has_char for font backend.
282 If FONT_ENTITY has a glyph for character C (Unicode code point),
283 return 1. If not, return 0. If a font must be opened to check
286 w32font_has_char (entity
, c
)
290 Lisp_Object supported_scripts
, extra
, script
;
293 extra
= AREF (entity
, FONT_EXTRA_INDEX
);
297 supported_scripts
= assq_no_quit (QCscript
, extra
);
298 /* If font doesn't claim to support any scripts, then we can't be certain
300 if (!CONSP (supported_scripts
))
303 supported_scripts
= XCDR (supported_scripts
);
305 script
= CHAR_TABLE_REF (Vchar_script_table
, c
);
307 /* If we don't know what script the character is from, then we can't be
308 certain until we open it. Also if the font claims support for the script
309 the character is from, it may only have partial coverage, so we still
310 can't be certain until we open the font. */
311 if (NILP (script
) || memq_no_quit (script
, supported_scripts
))
314 /* Font reports what scripts it supports, and none of them are the script
315 the character is from, so it is a definite no. */
319 /* w32 implementation of encode_char for font backend.
320 Return a glyph code of FONT for characer C (Unicode code point).
321 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
323 For speed, the gdi backend uses unicode (Emacs calls encode_char
324 far too often for it to be efficient). But we still need to detect
325 which characters are not supported by the font.
328 w32font_encode_char (font
, c
)
332 struct w32font_info
* w32_font
= (struct w32font_info
*)font
;
334 if (c
< w32_font
->metrics
.tmFirstChar
335 || c
> w32_font
->metrics
.tmLastChar
)
336 return FONT_INVALID_CODE
;
341 /* w32 implementation of text_extents for font backend.
342 Perform the size computation of glyphs of FONT and fillin members
343 of METRICS. The glyphs are specified by their glyph codes in
344 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
345 case just return the overall width. */
347 w32font_text_extents (font
, code
, nglyphs
, metrics
)
351 struct font_metrics
*metrics
;
354 HFONT old_font
= NULL
;
361 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
365 bzero (metrics
, sizeof (struct font_metrics
));
366 metrics
->ascent
= font
->ascent
;
367 metrics
->descent
= font
->descent
;
369 for (i
= 0; i
< nglyphs
; i
++)
371 struct w32_metric_cache
*char_metric
;
372 int block
= *(code
+ i
) / CACHE_BLOCKSIZE
;
373 int pos_in_block
= *(code
+ i
) % CACHE_BLOCKSIZE
;
375 if (block
>= w32_font
->n_cache_blocks
)
377 if (!w32_font
->cached_metrics
)
378 w32_font
->cached_metrics
379 = xmalloc ((block
+ 1)
380 * sizeof (struct w32_metric_cache
*));
382 w32_font
->cached_metrics
383 = xrealloc (w32_font
->cached_metrics
,
385 * sizeof (struct w32_metric_cache
*));
386 bzero (w32_font
->cached_metrics
+ w32_font
->n_cache_blocks
,
387 ((block
+ 1 - w32_font
->n_cache_blocks
)
388 * sizeof (struct w32_metric_cache
*)));
389 w32_font
->n_cache_blocks
= block
+ 1;
392 if (!w32_font
->cached_metrics
[block
])
394 w32_font
->cached_metrics
[block
]
395 = xmalloc (CACHE_BLOCKSIZE
* sizeof (struct w32_metric_cache
));
396 bzero (w32_font
->cached_metrics
[block
],
397 CACHE_BLOCKSIZE
* sizeof (struct w32_metric_cache
));
400 char_metric
= w32_font
->cached_metrics
[block
] + pos_in_block
;
402 if (char_metric
->status
== W32METRIC_NO_ATTEMPT
)
406 /* TODO: Frames can come and go, and their fonts
407 outlive them. So we can't cache the frame in the
408 font structure. Use selected_frame until the API
409 is updated to pass in a frame. */
410 f
= XFRAME (selected_frame
);
412 dc
= get_frame_dc (f
);
413 old_font
= SelectObject (dc
, w32_font
->hfont
);
415 compute_metrics (dc
, w32_font
, *(code
+ i
), char_metric
);
418 if (char_metric
->status
== W32METRIC_SUCCESS
)
420 metrics
->lbearing
= min (metrics
->lbearing
,
421 metrics
->width
+ char_metric
->lbearing
);
422 metrics
->rbearing
= max (metrics
->rbearing
,
423 metrics
->width
+ char_metric
->rbearing
);
424 metrics
->width
+= char_metric
->width
;
427 /* If we couldn't get metrics for a char,
428 use alternative method. */
431 /* If we got through everything, return. */
436 /* Restore state and release DC. */
437 SelectObject (dc
, old_font
);
438 release_frame_dc (f
, dc
);
441 return metrics
->width
;
445 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
446 fallback on other methods that will at least give some of the metric
449 /* Make array big enough to hold surrogates. */
450 wcode
= alloca (nglyphs
* sizeof (WORD
) * 2);
451 for (i
= 0; i
< nglyphs
; i
++)
453 if (code
[i
] < 0x10000)
457 DWORD surrogate
= code
[i
] - 0x10000;
459 /* High surrogate: U+D800 - U+DBFF. */
460 wcode
[i
++] = 0xD800 + ((surrogate
>> 10) & 0x03FF);
461 /* Low surrogate: U+DC00 - U+DFFF. */
462 wcode
[i
] = 0xDC00 + (surrogate
& 0x03FF);
463 /* An extra glyph. wcode is already double the size of code to
471 /* TODO: Frames can come and go, and their fonts outlive
472 them. So we can't cache the frame in the font structure. Use
473 selected_frame until the API is updated to pass in a
475 f
= XFRAME (selected_frame
);
477 dc
= get_frame_dc (f
);
478 old_font
= SelectObject (dc
, w32_font
->hfont
);
481 if (GetTextExtentPoint32W (dc
, wcode
, nglyphs
, &size
))
483 total_width
= size
.cx
;
486 /* On 95/98/ME, only some unicode functions are available, so fallback
487 on doing a dummy draw to find the total width. */
491 rect
.top
= 0; rect
.bottom
= font
->height
; rect
.left
= 0; rect
.right
= 1;
492 DrawTextW (dc
, wcode
, nglyphs
, &rect
,
493 DT_CALCRECT
| DT_NOPREFIX
| DT_SINGLELINE
);
494 total_width
= rect
.right
;
497 /* Give our best estimate of the metrics, based on what we know. */
500 metrics
->width
= total_width
- w32_font
->metrics
.tmOverhang
;
501 metrics
->lbearing
= 0;
502 metrics
->rbearing
= total_width
;
505 /* Restore state and release DC. */
506 SelectObject (dc
, old_font
);
507 release_frame_dc (f
, dc
);
512 /* w32 implementation of draw for font backend.
514 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
515 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
516 is nonzero, fill the background in advance. It is assured that
517 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
519 TODO: Currently this assumes that the colors and fonts are already
520 set in the DC. This seems to be true now, but maybe only due to
521 the old font code setting it up. It may be safer to resolve faces
522 and fonts in here and set them explicitly
526 w32font_draw (s
, from
, to
, x
, y
, with_background
)
527 struct glyph_string
*s
;
528 int from
, to
, x
, y
, with_background
;
531 HRGN orig_clip
= NULL
;
532 struct w32font_info
*w32font
= (struct w32font_info
*) s
->font
;
534 options
= w32font
->glyph_idx
;
536 if (s
->num_clips
> 0)
538 HRGN new_clip
= CreateRectRgnIndirect (s
->clip
);
540 /* Save clip region for later restoration. */
541 orig_clip
= CreateRectRgn (0, 0, 0, 0);
542 if (!GetClipRgn(s
->hdc
, orig_clip
))
544 DeleteObject (orig_clip
);
548 if (s
->num_clips
> 1)
550 HRGN clip2
= CreateRectRgnIndirect (s
->clip
+ 1);
552 CombineRgn (new_clip
, new_clip
, clip2
, RGN_OR
);
553 DeleteObject (clip2
);
556 SelectClipRgn (s
->hdc
, new_clip
);
557 DeleteObject (new_clip
);
560 /* Using OPAQUE background mode can clear more background than expected
561 when Cleartype is used. Draw the background manually to avoid this. */
562 SetBkMode (s
->hdc
, TRANSPARENT
);
567 struct font
*font
= s
->font
;
569 brush
= CreateSolidBrush (s
->gc
->background
);
571 rect
.top
= y
- font
->ascent
;
572 rect
.right
= x
+ s
->width
;
573 rect
.bottom
= y
+ font
->descent
;
574 FillRect (s
->hdc
, &rect
, brush
);
575 DeleteObject (brush
);
580 int len
= to
- from
, i
;
582 for (i
= 0; i
< len
; i
++)
583 ExtTextOutW (s
->hdc
, x
+ i
, y
, options
, NULL
,
584 s
->char2b
+ from
+ i
, 1, NULL
);
587 ExtTextOutW (s
->hdc
, x
, y
, options
, NULL
, s
->char2b
+ from
, to
- from
, NULL
);
589 /* Restore clip region. */
590 if (s
->num_clips
> 0)
591 SelectClipRgn (s
->hdc
, orig_clip
);
594 DeleteObject (orig_clip
);
597 /* w32 implementation of free_entity for font backend.
598 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
599 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
601 w32font_free_entity (Lisp_Object entity);
604 /* w32 implementation of prepare_face for font backend.
605 Optional (if FACE->extra is not used).
606 Prepare FACE for displaying characters by FONT on frame F by
607 storing some data in FACE->extra. If successful, return 0.
608 Otherwise, return -1.
610 w32font_prepare_face (FRAME_PTR f, struct face *face);
612 /* w32 implementation of done_face for font backend.
614 Done FACE for displaying characters by FACE->font on frame F.
616 w32font_done_face (FRAME_PTR f, struct face *face); */
618 /* w32 implementation of get_bitmap for font backend.
620 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
621 intended that this method is called from the other font-driver
624 w32font_get_bitmap (struct font *font, unsigned code,
625 struct font_bitmap *bitmap, int bits_per_pixel);
627 /* w32 implementation of free_bitmap for font backend.
629 Free bitmap data in BITMAP.
631 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
633 /* w32 implementation of get_outline for font backend.
635 Return an outline data for glyph-code CODE of FONT. The format
636 of the outline data depends on the font-driver.
638 w32font_get_outline (struct font *font, unsigned code);
640 /* w32 implementation of free_outline for font backend.
642 Free OUTLINE (that is obtained by the above method).
644 w32font_free_outline (struct font *font, void *outline);
646 /* w32 implementation of anchor_point for font backend.
648 Get coordinates of the INDEXth anchor point of the glyph whose
649 code is CODE. Store the coordinates in *X and *Y. Return 0 if
650 the operations was successfull. Otherwise return -1.
652 w32font_anchor_point (struct font *font, unsigned code,
653 int index, int *x, int *y);
655 /* w32 implementation of otf_capability for font backend.
657 Return a list describing which scripts/languages FONT
658 supports by which GSUB/GPOS features of OpenType tables.
660 w32font_otf_capability (struct font *font);
662 /* w32 implementation of otf_drive for font backend.
664 Apply FONT's OTF-FEATURES to the glyph string.
666 FEATURES specifies which OTF features to apply in this format:
667 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
668 See the documentation of `font-drive-otf' for the detail.
670 This method applies the specified features to the codes in the
671 elements of GSTRING-IN (between FROMth and TOth). The output
672 codes are stored in GSTRING-OUT at the IDXth element and the
675 Return the number of output codes. If none of the features are
676 applicable to the input data, return 0. If GSTRING-OUT is too
679 w32font_otf_drive (struct font *font, Lisp_Object features,
680 Lisp_Object gstring_in, int from, int to,
681 Lisp_Object gstring_out, int idx,
682 int alternate_subst);
685 /* Internal implementation of w32font_list.
686 Additional parameter opentype_only restricts the returned fonts to
687 opentype fonts, which can be used with the Uniscribe backend. */
689 w32font_list_internal (frame
, font_spec
, opentype_only
)
690 Lisp_Object frame
, font_spec
;
693 struct font_callback_data match_data
;
695 FRAME_PTR f
= XFRAME (frame
);
697 match_data
.orig_font_spec
= font_spec
;
698 match_data
.list
= Qnil
;
699 match_data
.frame
= frame
;
701 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
702 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
704 match_data
.opentype_only
= opentype_only
;
706 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
708 if (match_data
.pattern
.lfFaceName
[0] == '\0')
710 /* EnumFontFamiliesEx does not take other fields into account if
711 font name is blank, so need to use two passes. */
712 list_all_matching_fonts (&match_data
);
716 dc
= get_frame_dc (f
);
718 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
719 (FONTENUMPROC
) add_font_entity_to_list
,
720 (LPARAM
) &match_data
, 0);
721 release_frame_dc (f
, dc
);
724 return NILP (match_data
.list
) ? Qnil
: match_data
.list
;
727 /* Internal implementation of w32font_match.
728 Additional parameter opentype_only restricts the returned fonts to
729 opentype fonts, which can be used with the Uniscribe backend. */
731 w32font_match_internal (frame
, font_spec
, opentype_only
)
732 Lisp_Object frame
, font_spec
;
735 struct font_callback_data match_data
;
737 FRAME_PTR f
= XFRAME (frame
);
739 match_data
.orig_font_spec
= font_spec
;
740 match_data
.frame
= frame
;
741 match_data
.list
= Qnil
;
743 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
744 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
746 match_data
.opentype_only
= opentype_only
;
748 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
750 dc
= get_frame_dc (f
);
752 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
753 (FONTENUMPROC
) add_one_font_entity_to_list
,
754 (LPARAM
) &match_data
, 0);
755 release_frame_dc (f
, dc
);
757 return NILP (match_data
.list
) ? Qnil
: XCAR (match_data
.list
);
761 w32font_open_internal (f
, font_entity
, pixel_size
, font_object
)
763 Lisp_Object font_entity
;
765 Lisp_Object font_object
;
770 HFONT hfont
, old_font
;
771 Lisp_Object val
, extra
;
772 struct w32font_info
*w32_font
;
774 OUTLINETEXTMETRICW
* metrics
= NULL
;
776 w32_font
= (struct w32font_info
*) XFONT_OBJECT (font_object
);
777 font
= (struct font
*) w32_font
;
782 bzero (&logfont
, sizeof (logfont
));
783 fill_in_logfont (f
, &logfont
, font_entity
);
785 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
786 limitations in bitmap fonts. */
787 val
= AREF (font_entity
, FONT_FOUNDRY_INDEX
);
788 if (!EQ (val
, Qraster
))
789 logfont
.lfOutPrecision
= OUT_TT_PRECIS
;
791 size
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
795 logfont
.lfHeight
= -size
;
796 hfont
= CreateFontIndirect (&logfont
);
801 /* Get the metrics for this font. */
802 dc
= get_frame_dc (f
);
803 old_font
= SelectObject (dc
, hfont
);
805 /* Try getting the outline metrics (only works for truetype fonts). */
806 len
= GetOutlineTextMetricsW (dc
, 0, NULL
);
809 metrics
= (OUTLINETEXTMETRICW
*) alloca (len
);
810 if (GetOutlineTextMetricsW (dc
, len
, metrics
))
811 bcopy (&metrics
->otmTextMetrics
, &w32_font
->metrics
,
812 sizeof (TEXTMETRICW
));
818 GetTextMetricsW (dc
, &w32_font
->metrics
);
820 w32_font
->cached_metrics
= NULL
;
821 w32_font
->n_cache_blocks
= 0;
823 SelectObject (dc
, old_font
);
824 release_frame_dc (f
, dc
);
826 w32_font
->hfont
= hfont
;
831 /* We don't know how much space we need for the full name, so start with
832 96 bytes and go up in steps of 32. */
835 while (name
&& w32font_full_name (&logfont
, font_entity
, pixel_size
,
842 font
->props
[FONT_FULLNAME_INDEX
]
843 = make_unibyte_string (name
, strlen (name
));
845 font
->props
[FONT_FULLNAME_INDEX
] =
846 make_unibyte_string (logfont
.lfFaceName
, len
);
849 font
->max_width
= w32_font
->metrics
.tmMaxCharWidth
;
850 /* Parts of Emacs display assume that height = ascent + descent...
851 so height is defined later, after ascent and descent.
852 font->height = w32_font->metrics.tmHeight
853 + w32_font->metrics.tmExternalLeading;
856 font
->space_width
= font
->average_width
= w32_font
->metrics
.tmAveCharWidth
;
858 font
->vertical_centering
= 0;
859 font
->encoding_type
= 0;
860 font
->baseline_offset
= 0;
861 font
->relative_compose
= 0;
862 font
->default_ascent
= w32_font
->metrics
.tmAscent
;
863 font
->font_encoder
= NULL
;
864 font
->pixel_size
= size
;
865 font
->driver
= &w32font_driver
;
866 /* Use format cached during list, as the information we have access to
867 here is incomplete. */
868 extra
= AREF (font_entity
, FONT_EXTRA_INDEX
);
871 val
= assq_no_quit (QCformat
, extra
);
873 font
->props
[FONT_FORMAT_INDEX
] = XCDR (val
);
875 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
878 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
880 font
->props
[FONT_FILE_INDEX
] = Qnil
;
881 font
->encoding_charset
= -1;
882 font
->repertory_charset
= -1;
883 /* TODO: do we really want the minimum width here, which could be negative? */
884 font
->min_width
= font
->space_width
;
885 font
->ascent
= w32_font
->metrics
.tmAscent
;
886 font
->descent
= w32_font
->metrics
.tmDescent
;
887 font
->height
= font
->ascent
+ font
->descent
;
891 font
->underline_thickness
= metrics
->otmsUnderscoreSize
;
892 font
->underline_position
= -metrics
->otmsUnderscorePosition
;
896 font
->underline_thickness
= 0;
897 font
->underline_position
= -1;
900 /* For temporary compatibility with legacy code that expects the
901 name to be usable in x-list-fonts. Eventually we expect to change
902 x-list-fonts and other places that use fonts so that this can be
903 an fcname or similar. */
904 font
->props
[FONT_NAME_INDEX
] = Ffont_xlfd_name (font_object
, Qnil
);
909 /* Callback function for EnumFontFamiliesEx.
910 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
912 add_font_name_to_list (logical_font
, physical_font
, font_type
, list_object
)
913 ENUMLOGFONTEX
*logical_font
;
914 NEWTEXTMETRICEX
*physical_font
;
918 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
921 /* Skip vertical fonts (intended only for printing) */
922 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
925 family
= font_intern_prop (logical_font
->elfLogFont
.lfFaceName
,
926 strlen (logical_font
->elfLogFont
.lfFaceName
), 1);
927 if (! memq_no_quit (family
, *list
))
928 *list
= Fcons (family
, *list
);
933 static int w32_decode_weight
P_ ((int));
934 static int w32_encode_weight
P_ ((int));
936 /* Convert an enumerated Windows font to an Emacs font entity. */
938 w32_enumfont_pattern_entity (frame
, logical_font
, physical_font
,
939 font_type
, requested_font
, backend
)
941 ENUMLOGFONTEX
*logical_font
;
942 NEWTEXTMETRICEX
*physical_font
;
944 LOGFONT
*requested_font
;
947 Lisp_Object entity
, tem
;
948 LOGFONT
*lf
= (LOGFONT
*) logical_font
;
950 DWORD full_type
= physical_font
->ntmTm
.ntmFlags
;
952 entity
= font_make_entity ();
954 ASET (entity
, FONT_TYPE_INDEX
, backend
);
955 ASET (entity
, FONT_REGISTRY_INDEX
, w32_registry (lf
->lfCharSet
, font_type
));
956 ASET (entity
, FONT_OBJLIST_INDEX
, Qnil
);
958 /* Foundry is difficult to get in readable form on Windows.
959 But Emacs crashes if it is not set, so set it to something more
960 generic. These values make xlfds compatible with Emacs 22. */
961 if (lf
->lfOutPrecision
== OUT_STRING_PRECIS
)
963 else if (lf
->lfOutPrecision
== OUT_STROKE_PRECIS
)
968 ASET (entity
, FONT_FOUNDRY_INDEX
, tem
);
970 /* Save the generic family in the extra info, as it is likely to be
971 useful to users looking for a close match. */
972 generic_type
= physical_font
->ntmTm
.tmPitchAndFamily
& 0xF0;
973 if (generic_type
== FF_DECORATIVE
)
975 else if (generic_type
== FF_MODERN
)
977 else if (generic_type
== FF_ROMAN
)
979 else if (generic_type
== FF_SCRIPT
)
981 else if (generic_type
== FF_SWISS
)
986 ASET (entity
, FONT_ADSTYLE_INDEX
, tem
);
988 if (physical_font
->ntmTm
.tmPitchAndFamily
& 0x01)
989 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_PROPORTIONAL
));
991 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_CHARCELL
));
993 if (requested_font
->lfQuality
!= DEFAULT_QUALITY
)
995 font_put_extra (entity
, QCantialias
,
996 lispy_antialias_type (requested_font
->lfQuality
));
998 ASET (entity
, FONT_FAMILY_INDEX
,
999 font_intern_prop (lf
->lfFaceName
, strlen (lf
->lfFaceName
), 1));
1001 FONT_SET_STYLE (entity
, FONT_WEIGHT_INDEX
,
1002 make_number (w32_decode_weight (lf
->lfWeight
)));
1003 FONT_SET_STYLE (entity
, FONT_SLANT_INDEX
,
1004 make_number (lf
->lfItalic
? 200 : 100));
1005 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1007 FONT_SET_STYLE (entity
, FONT_WIDTH_INDEX
, make_number (100));
1009 if (font_type
& RASTER_FONTTYPE
)
1010 ASET (entity
, FONT_SIZE_INDEX
,
1011 make_number (physical_font
->ntmTm
.tmHeight
1012 + physical_font
->ntmTm
.tmExternalLeading
));
1014 ASET (entity
, FONT_SIZE_INDEX
, make_number (0));
1016 /* Cache unicode codepoints covered by this font, as there is no other way
1017 of getting this information easily. */
1018 if (font_type
& TRUETYPE_FONTTYPE
)
1020 tem
= font_supported_scripts (&physical_font
->ntmFontSig
);
1022 font_put_extra (entity
, QCscript
, tem
);
1025 /* This information is not fully available when opening fonts, so
1026 save it here. Only Windows 2000 and later return information
1027 about opentype and type1 fonts, so need a fallback for detecting
1028 truetype so that this information is not any worse than we could
1029 have obtained later. */
1030 if (EQ (backend
, Quniscribe
) && (full_type
& NTMFLAGS_OPENTYPE
))
1031 tem
= intern ("opentype");
1032 else if (font_type
& TRUETYPE_FONTTYPE
)
1033 tem
= intern ("truetype");
1034 else if (full_type
& NTM_PS_OPENTYPE
)
1035 tem
= intern ("postscript");
1036 else if (full_type
& NTM_TYPE1
)
1037 tem
= intern ("type1");
1038 else if (font_type
& RASTER_FONTTYPE
)
1039 tem
= intern ("w32bitmap");
1041 tem
= intern ("w32vector");
1043 font_put_extra (entity
, QCformat
, tem
);
1049 /* Convert generic families to the family portion of lfPitchAndFamily. */
1051 w32_generic_family (Lisp_Object name
)
1053 /* Generic families. */
1054 if (EQ (name
, Qmonospace
) || EQ (name
, Qmono
))
1056 else if (EQ (name
, Qsans
) || EQ (name
, Qsans_serif
) || EQ (name
, Qsansserif
))
1058 else if (EQ (name
, Qserif
))
1060 else if (EQ (name
, Qdecorative
))
1061 return FF_DECORATIVE
;
1062 else if (EQ (name
, Qscript
))
1069 logfonts_match (font
, pattern
)
1070 LOGFONT
*font
, *pattern
;
1072 /* Only check height for raster fonts. */
1073 if (pattern
->lfHeight
&& font
->lfOutPrecision
== OUT_STRING_PRECIS
1074 && font
->lfHeight
!= pattern
->lfHeight
)
1077 /* Have some flexibility with weights. */
1078 if (pattern
->lfWeight
1079 && ((font
->lfWeight
< (pattern
->lfWeight
- 150))
1080 || font
->lfWeight
> (pattern
->lfWeight
+ 150)))
1083 /* Charset and face should be OK. Italic has to be checked
1084 against the original spec, in case we don't have any preference. */
1088 /* Codepage Bitfields in FONTSIGNATURE struct. */
1089 #define CSB_JAPANESE (1 << 17)
1090 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1091 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1094 font_matches_spec (type
, font
, spec
, backend
, logfont
)
1096 NEWTEXTMETRICEX
*font
;
1098 Lisp_Object backend
;
1101 Lisp_Object extra
, val
;
1103 /* Check italic. Can't check logfonts, since it is a boolean field,
1104 so there is no difference between "non-italic" and "don't care". */
1106 int slant
= FONT_SLANT_NUMERIC (spec
);
1109 && ((slant
> 150 && !font
->ntmTm
.tmItalic
)
1110 || (slant
<= 150 && font
->ntmTm
.tmItalic
)))
1114 /* Check adstyle against generic family. */
1115 val
= AREF (spec
, FONT_ADSTYLE_INDEX
);
1118 BYTE family
= w32_generic_family (val
);
1119 if (family
!= FF_DONTCARE
1120 && family
!= (font
->ntmTm
.tmPitchAndFamily
& 0xF0))
1125 val
= AREF (spec
, FONT_SPACING_INDEX
);
1128 int spacing
= XINT (val
);
1129 int proportional
= (spacing
< FONT_SPACING_MONO
);
1131 if ((proportional
&& !(font
->ntmTm
.tmPitchAndFamily
& 0x01))
1132 || (!proportional
&& (font
->ntmTm
.tmPitchAndFamily
& 0x01)))
1136 /* Check extra parameters. */
1137 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
1138 CONSP (extra
); extra
= XCDR (extra
))
1140 Lisp_Object extra_entry
;
1141 extra_entry
= XCAR (extra
);
1142 if (CONSP (extra_entry
))
1144 Lisp_Object key
= XCAR (extra_entry
);
1146 val
= XCDR (extra_entry
);
1147 if (EQ (key
, QCscript
) && SYMBOLP (val
))
1149 /* Only truetype fonts will have information about what
1150 scripts they support. This probably means the user
1151 will have to force Emacs to use raster, postscript
1152 or atm fonts for non-ASCII text. */
1153 if (type
& TRUETYPE_FONTTYPE
)
1156 = font_supported_scripts (&font
->ntmFontSig
);
1157 if (! memq_no_quit (val
, support
))
1162 /* Return specific matches, but play it safe. Fonts
1163 that cover more than their charset would suggest
1164 are likely to be truetype or opentype fonts,
1166 if (EQ (val
, Qlatin
))
1168 /* Although every charset but symbol, thai and
1169 arabic contains the basic ASCII set of latin
1170 characters, Emacs expects much more. */
1171 if (font
->ntmTm
.tmCharSet
!= ANSI_CHARSET
)
1174 else if (EQ (val
, Qsymbol
))
1176 if (font
->ntmTm
.tmCharSet
!= SYMBOL_CHARSET
)
1179 else if (EQ (val
, Qcyrillic
))
1181 if (font
->ntmTm
.tmCharSet
!= RUSSIAN_CHARSET
)
1184 else if (EQ (val
, Qgreek
))
1186 if (font
->ntmTm
.tmCharSet
!= GREEK_CHARSET
)
1189 else if (EQ (val
, Qarabic
))
1191 if (font
->ntmTm
.tmCharSet
!= ARABIC_CHARSET
)
1194 else if (EQ (val
, Qhebrew
))
1196 if (font
->ntmTm
.tmCharSet
!= HEBREW_CHARSET
)
1199 else if (EQ (val
, Qthai
))
1201 if (font
->ntmTm
.tmCharSet
!= THAI_CHARSET
)
1204 else if (EQ (val
, Qkana
))
1206 if (font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1209 else if (EQ (val
, Qbopomofo
))
1211 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
)
1214 else if (EQ (val
, Qhangul
))
1216 if (font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1217 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
)
1220 else if (EQ (val
, Qhan
))
1222 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
1223 && font
->ntmTm
.tmCharSet
!= GB2312_CHARSET
1224 && font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1225 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
1226 && font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1230 /* Other scripts unlikely to be handled by non-truetype
1235 else if (EQ (key
, QClang
) && SYMBOLP (val
))
1237 /* Just handle the CJK languages here, as the lang
1238 parameter is used to select a font with appropriate
1239 glyphs in the cjk unified ideographs block. Other fonts
1240 support for a language can be solely determined by
1241 its character coverage. */
1244 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_JAPANESE
))
1247 else if (EQ (val
, Qko
))
1249 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_KOREAN
))
1252 else if (EQ (val
, Qzh
))
1254 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_CHINESE
))
1258 /* Any other language, we don't recognize it. Only the above
1259 currently appear in fontset.el, so it isn't worth
1260 creating a mapping table of codepages/scripts to languages
1261 or opening the font to see if there are any language tags
1262 in it that the W32 API does not expose. Fontset
1263 spec should have a fallback, as some backends do
1264 not recognize language at all. */
1267 else if (EQ (key
, QCotf
) && CONSP (val
))
1269 /* OTF features only supported by the uniscribe backend. */
1270 if (EQ (backend
, Quniscribe
))
1272 if (!uniscribe_check_otf (logfont
, val
))
1284 w32font_coverage_ok (coverage
, charset
)
1285 FONTSIGNATURE
* coverage
;
1288 DWORD subrange1
= coverage
->fsUsb
[1];
1290 #define SUBRANGE1_HAN_MASK 0x08000000
1291 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1292 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1294 if (charset
== GB2312_CHARSET
|| charset
== CHINESEBIG5_CHARSET
)
1296 return (subrange1
& SUBRANGE1_HAN_MASK
) == SUBRANGE1_HAN_MASK
;
1298 else if (charset
== SHIFTJIS_CHARSET
)
1300 return (subrange1
& SUBRANGE1_JAPANESE_MASK
) == SUBRANGE1_JAPANESE_MASK
;
1302 else if (charset
== HANGEUL_CHARSET
)
1304 return (subrange1
& SUBRANGE1_HANGEUL_MASK
) == SUBRANGE1_HANGEUL_MASK
;
1312 check_face_name (font
, full_name
)
1316 char full_iname
[LF_FULLFACESIZE
+1];
1318 /* Just check for names known to cause problems, since the full name
1319 can contain expanded abbreviations, prefixed foundry, postfixed
1320 style, the latter of which sometimes differs from the style indicated
1321 in the shorter name (eg Lt becomes Light or even Extra Light) */
1323 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1324 installed, we run into problems with the Uniscribe backend which tries
1325 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1326 with Arial's characteristics, since that attempt to use Truetype works
1327 some places, but not others. */
1328 if (!xstrcasecmp (font
->lfFaceName
, "helvetica"))
1330 strncpy (full_iname
, full_name
, LF_FULLFACESIZE
);
1331 full_iname
[LF_FULLFACESIZE
] = 0;
1332 _strlwr (full_iname
);
1333 return strstr ("helvetica", full_iname
) != NULL
;
1336 /* Since Times is mapped to Times New Roman, a substring
1337 match is not sufficient to filter out the bogus match. */
1338 else if (!xstrcasecmp (font
->lfFaceName
, "times"))
1339 return xstrcasecmp (full_name
, "times") == 0;
1345 /* Callback function for EnumFontFamiliesEx.
1346 * Checks if a font matches everything we are trying to check agaist,
1347 * and if so, adds it to a list. Both the data we are checking against
1348 * and the list to which the fonts are added are passed in via the
1349 * lparam argument, in the form of a font_callback_data struct. */
1351 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1352 ENUMLOGFONTEX
*logical_font
;
1353 NEWTEXTMETRICEX
*physical_font
;
1357 struct font_callback_data
*match_data
1358 = (struct font_callback_data
*) lParam
;
1359 Lisp_Object backend
= match_data
->opentype_only
? Quniscribe
: Qgdi
;
1361 if ((!match_data
->opentype_only
1362 || (((physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
1363 || (font_type
& TRUETYPE_FONTTYPE
))
1364 /* For the uniscribe backend, only consider fonts that claim
1365 to cover at least some part of Unicode. */
1366 && (physical_font
->ntmFontSig
.fsUsb
[3]
1367 || physical_font
->ntmFontSig
.fsUsb
[2]
1368 || physical_font
->ntmFontSig
.fsUsb
[1]
1369 || (physical_font
->ntmFontSig
.fsUsb
[0] & 0x3fffffff))))
1370 && logfonts_match (&logical_font
->elfLogFont
, &match_data
->pattern
)
1371 && font_matches_spec (font_type
, physical_font
,
1372 match_data
->orig_font_spec
, backend
,
1373 &logical_font
->elfLogFont
)
1374 && w32font_coverage_ok (&physical_font
->ntmFontSig
,
1375 match_data
->pattern
.lfCharSet
)
1376 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1377 We limit this to raster fonts, because the test can catch some
1378 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1379 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1380 therefore get through this test. Since full names can be prefixed
1381 by a foundry, we accept raster fonts if the font name is found
1382 anywhere within the full name. */
1383 && (logical_font
->elfLogFont
.lfOutPrecision
!= OUT_STRING_PRECIS
1384 || strstr (logical_font
->elfFullName
,
1385 logical_font
->elfLogFont
.lfFaceName
))
1386 /* Check for well known substitutions that mess things up in the
1387 presence of Type-1 fonts of the same name. */
1388 && (match_data
->pattern
.lfFaceName
[0]
1389 && check_face_name (&logical_font
->elfLogFont
,
1390 logical_font
->elfFullName
)))
1393 = w32_enumfont_pattern_entity (match_data
->frame
, logical_font
,
1394 physical_font
, font_type
,
1395 &match_data
->pattern
,
1399 Lisp_Object spec_charset
= AREF (match_data
->orig_font_spec
,
1400 FONT_REGISTRY_INDEX
);
1402 /* If registry was specified as iso10646-1, only report
1403 ANSI and DEFAULT charsets, as most unicode fonts will
1404 contain one of those plus others. */
1405 if ((EQ (spec_charset
, Qiso10646_1
)
1406 || EQ (spec_charset
, Qunicode_bmp
))
1407 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
1408 && logical_font
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
)
1410 /* unicode-sip fonts must contain characters beyond the BMP. */
1411 else if (EQ (spec_charset
, Qunicode_sip
)
1412 && !(physical_font
->ntmFontSig
.fsUsb
[1] & 0x02000000))
1414 /* If registry was specified, but did not map to a windows
1415 charset, only report fonts that have unknown charsets.
1416 This will still report fonts that don't match, but at
1417 least it eliminates known definite mismatches. */
1418 else if (!NILP (spec_charset
)
1419 && !EQ (spec_charset
, Qiso10646_1
)
1420 && !EQ (spec_charset
, Qunicode_bmp
)
1421 && !EQ (spec_charset
, Qunicode_sip
)
1422 && match_data
->pattern
.lfCharSet
== DEFAULT_CHARSET
1423 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
)
1426 /* If registry was specified, ensure it is reported as the same. */
1427 if (!NILP (spec_charset
))
1428 ASET (entity
, FONT_REGISTRY_INDEX
, spec_charset
);
1430 match_data
->list
= Fcons (entity
, match_data
->list
);
1432 /* If no registry specified, duplicate iso8859-1 truetype fonts
1434 if (NILP (spec_charset
)
1435 && font_type
== TRUETYPE_FONTTYPE
1436 && logical_font
->elfLogFont
.lfCharSet
== ANSI_CHARSET
)
1438 Lisp_Object tem
= Fcopy_font_spec (entity
);
1439 ASET (tem
, FONT_REGISTRY_INDEX
, Qiso10646_1
);
1440 match_data
->list
= Fcons (tem
, match_data
->list
);
1447 /* Callback function for EnumFontFamiliesEx.
1448 * Terminates the search once we have a match. */
1450 add_one_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1451 ENUMLOGFONTEX
*logical_font
;
1452 NEWTEXTMETRICEX
*physical_font
;
1456 struct font_callback_data
*match_data
1457 = (struct font_callback_data
*) lParam
;
1458 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
);
1460 /* If we have a font in the list, terminate the search. */
1461 return !NILP (match_data
->list
);
1464 /* Old function to convert from x to w32 charset, from w32fns.c. */
1466 x_to_w32_charset (lpcs
)
1469 Lisp_Object this_entry
, w32_charset
;
1471 int len
= strlen (lpcs
);
1473 /* Support "*-#nnn" format for unknown charsets. */
1474 if (strncmp (lpcs
, "*-#", 3) == 0)
1475 return atoi (lpcs
+ 3);
1477 /* All Windows fonts qualify as unicode. */
1478 if (!strncmp (lpcs
, "iso10646", 8))
1479 return DEFAULT_CHARSET
;
1481 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1482 charset
= alloca (len
+ 1);
1483 strcpy (charset
, lpcs
);
1484 lpcs
= strchr (charset
, '*');
1488 /* Look through w32-charset-info-alist for the character set.
1489 Format of each entry is
1490 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1492 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
1494 if (NILP (this_entry
))
1496 /* At startup, we want iso8859-1 fonts to come up properly. */
1497 if (xstrcasecmp (charset
, "iso8859-1") == 0)
1498 return ANSI_CHARSET
;
1500 return DEFAULT_CHARSET
;
1503 w32_charset
= Fcar (Fcdr (this_entry
));
1505 /* Translate Lisp symbol to number. */
1506 if (EQ (w32_charset
, Qw32_charset_ansi
))
1507 return ANSI_CHARSET
;
1508 if (EQ (w32_charset
, Qw32_charset_symbol
))
1509 return SYMBOL_CHARSET
;
1510 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
1511 return SHIFTJIS_CHARSET
;
1512 if (EQ (w32_charset
, Qw32_charset_hangeul
))
1513 return HANGEUL_CHARSET
;
1514 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
1515 return CHINESEBIG5_CHARSET
;
1516 if (EQ (w32_charset
, Qw32_charset_gb2312
))
1517 return GB2312_CHARSET
;
1518 if (EQ (w32_charset
, Qw32_charset_oem
))
1520 if (EQ (w32_charset
, Qw32_charset_johab
))
1521 return JOHAB_CHARSET
;
1522 if (EQ (w32_charset
, Qw32_charset_easteurope
))
1523 return EASTEUROPE_CHARSET
;
1524 if (EQ (w32_charset
, Qw32_charset_turkish
))
1525 return TURKISH_CHARSET
;
1526 if (EQ (w32_charset
, Qw32_charset_baltic
))
1527 return BALTIC_CHARSET
;
1528 if (EQ (w32_charset
, Qw32_charset_russian
))
1529 return RUSSIAN_CHARSET
;
1530 if (EQ (w32_charset
, Qw32_charset_arabic
))
1531 return ARABIC_CHARSET
;
1532 if (EQ (w32_charset
, Qw32_charset_greek
))
1533 return GREEK_CHARSET
;
1534 if (EQ (w32_charset
, Qw32_charset_hebrew
))
1535 return HEBREW_CHARSET
;
1536 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
1537 return VIETNAMESE_CHARSET
;
1538 if (EQ (w32_charset
, Qw32_charset_thai
))
1539 return THAI_CHARSET
;
1540 if (EQ (w32_charset
, Qw32_charset_mac
))
1543 return DEFAULT_CHARSET
;
1547 /* Convert a Lisp font registry (symbol) to a windows charset. */
1549 registry_to_w32_charset (charset
)
1550 Lisp_Object charset
;
1552 if (EQ (charset
, Qiso10646_1
) || EQ (charset
, Qunicode_bmp
)
1553 || EQ (charset
, Qunicode_sip
))
1554 return DEFAULT_CHARSET
; /* UNICODE_CHARSET not defined in MingW32 */
1555 else if (EQ (charset
, Qiso8859_1
))
1556 return ANSI_CHARSET
;
1557 else if (SYMBOLP (charset
))
1558 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset
)));
1560 return DEFAULT_CHARSET
;
1563 /* Old function to convert from w32 to x charset, from w32fns.c. */
1565 w32_to_x_charset (fncharset
, matching
)
1569 static char buf
[32];
1570 Lisp_Object charset_type
;
1575 /* If fully specified, accept it as it is. Otherwise use a
1577 char *wildcard
= strchr (matching
, '*');
1580 else if (strchr (matching
, '-'))
1583 match_len
= strlen (matching
);
1589 /* Handle startup case of w32-charset-info-alist not
1590 being set up yet. */
1591 if (NILP (Vw32_charset_info_alist
))
1593 charset_type
= Qw32_charset_ansi
;
1595 case DEFAULT_CHARSET
:
1596 charset_type
= Qw32_charset_default
;
1598 case SYMBOL_CHARSET
:
1599 charset_type
= Qw32_charset_symbol
;
1601 case SHIFTJIS_CHARSET
:
1602 charset_type
= Qw32_charset_shiftjis
;
1604 case HANGEUL_CHARSET
:
1605 charset_type
= Qw32_charset_hangeul
;
1607 case GB2312_CHARSET
:
1608 charset_type
= Qw32_charset_gb2312
;
1610 case CHINESEBIG5_CHARSET
:
1611 charset_type
= Qw32_charset_chinesebig5
;
1614 charset_type
= Qw32_charset_oem
;
1616 case EASTEUROPE_CHARSET
:
1617 charset_type
= Qw32_charset_easteurope
;
1619 case TURKISH_CHARSET
:
1620 charset_type
= Qw32_charset_turkish
;
1622 case BALTIC_CHARSET
:
1623 charset_type
= Qw32_charset_baltic
;
1625 case RUSSIAN_CHARSET
:
1626 charset_type
= Qw32_charset_russian
;
1628 case ARABIC_CHARSET
:
1629 charset_type
= Qw32_charset_arabic
;
1632 charset_type
= Qw32_charset_greek
;
1634 case HEBREW_CHARSET
:
1635 charset_type
= Qw32_charset_hebrew
;
1637 case VIETNAMESE_CHARSET
:
1638 charset_type
= Qw32_charset_vietnamese
;
1641 charset_type
= Qw32_charset_thai
;
1644 charset_type
= Qw32_charset_mac
;
1647 charset_type
= Qw32_charset_johab
;
1651 /* Encode numerical value of unknown charset. */
1652 sprintf (buf
, "*-#%u", fncharset
);
1658 char * best_match
= NULL
;
1659 int matching_found
= 0;
1661 /* Look through w32-charset-info-alist for the character set.
1662 Prefer ISO codepages, and prefer lower numbers in the ISO
1663 range. Only return charsets for codepages which are installed.
1665 Format of each entry is
1666 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1668 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
1671 Lisp_Object w32_charset
;
1672 Lisp_Object codepage
;
1674 Lisp_Object this_entry
= XCAR (rest
);
1676 /* Skip invalid entries in alist. */
1677 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
1678 || !CONSP (XCDR (this_entry
))
1679 || !SYMBOLP (XCAR (XCDR (this_entry
))))
1682 x_charset
= SDATA (XCAR (this_entry
));
1683 w32_charset
= XCAR (XCDR (this_entry
));
1684 codepage
= XCDR (XCDR (this_entry
));
1686 /* Look for Same charset and a valid codepage (or non-int
1687 which means ignore). */
1688 if (EQ (w32_charset
, charset_type
)
1689 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
1690 || IsValidCodePage (XINT (codepage
))))
1692 /* If we don't have a match already, then this is the
1696 best_match
= x_charset
;
1697 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
1700 /* If we already found a match for MATCHING, then
1701 only consider other matches. */
1702 else if (matching_found
1703 && strnicmp (x_charset
, matching
, match_len
))
1705 /* If this matches what we want, and the best so far doesn't,
1706 then this is better. */
1707 else if (!matching_found
&& matching
1708 && !strnicmp (x_charset
, matching
, match_len
))
1710 best_match
= x_charset
;
1713 /* If this is fully specified, and the best so far isn't,
1714 then this is better. */
1715 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
1716 /* If this is an ISO codepage, and the best so far isn't,
1717 then this is better, but only if it fully specifies the
1719 || (strnicmp (best_match
, "iso", 3) != 0
1720 && strnicmp (x_charset
, "iso", 3) == 0
1721 && strchr (x_charset
, '-')))
1722 best_match
= x_charset
;
1723 /* If both are ISO8859 codepages, choose the one with the
1724 lowest number in the encoding field. */
1725 else if (strnicmp (best_match
, "iso8859-", 8) == 0
1726 && strnicmp (x_charset
, "iso8859-", 8) == 0)
1728 int best_enc
= atoi (best_match
+ 8);
1729 int this_enc
= atoi (x_charset
+ 8);
1730 if (this_enc
> 0 && this_enc
< best_enc
)
1731 best_match
= x_charset
;
1736 /* If no match, encode the numeric value. */
1739 sprintf (buf
, "*-#%u", fncharset
);
1743 strncpy (buf
, best_match
, 31);
1744 /* If the charset is not fully specified, put -0 on the end. */
1745 if (!strchr (best_match
, '-'))
1747 int pos
= strlen (best_match
);
1748 /* Charset specifiers shouldn't be very long. If it is a made
1749 up one, truncating it should not do any harm since it isn't
1750 recognized anyway. */
1753 strcpy (buf
+ pos
, "-0");
1761 w32_registry (w32_charset
, font_type
)
1767 /* If charset is defaulted, charset is unicode or unknown, depending on
1769 if (w32_charset
== DEFAULT_CHARSET
)
1770 return font_type
== TRUETYPE_FONTTYPE
? Qiso10646_1
: Qunknown
;
1772 charset
= w32_to_x_charset (w32_charset
, NULL
);
1773 return font_intern_prop (charset
, strlen(charset
), 1);
1777 w32_decode_weight (fnweight
)
1780 if (fnweight
>= FW_HEAVY
) return 210;
1781 if (fnweight
>= FW_EXTRABOLD
) return 205;
1782 if (fnweight
>= FW_BOLD
) return 200;
1783 if (fnweight
>= FW_SEMIBOLD
) return 180;
1784 if (fnweight
>= FW_NORMAL
) return 100;
1785 if (fnweight
>= FW_LIGHT
) return 50;
1786 if (fnweight
>= FW_EXTRALIGHT
) return 40;
1787 if (fnweight
> FW_THIN
) return 20;
1792 w32_encode_weight (n
)
1795 if (n
>= 210) return FW_HEAVY
;
1796 if (n
>= 205) return FW_EXTRABOLD
;
1797 if (n
>= 200) return FW_BOLD
;
1798 if (n
>= 180) return FW_SEMIBOLD
;
1799 if (n
>= 100) return FW_NORMAL
;
1800 if (n
>= 50) return FW_LIGHT
;
1801 if (n
>= 40) return FW_EXTRALIGHT
;
1802 if (n
>= 20) return FW_THIN
;
1806 /* Convert a Windows font weight into one of the weights supported
1807 by fontconfig (see font.c:font_parse_fcname). */
1809 w32_to_fc_weight (n
)
1812 if (n
>= FW_EXTRABOLD
) return intern ("black");
1813 if (n
>= FW_BOLD
) return intern ("bold");
1814 if (n
>= FW_SEMIBOLD
) return intern ("demibold");
1815 if (n
>= FW_NORMAL
) return intern ("medium");
1816 return intern ("light");
1819 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1821 fill_in_logfont (f
, logfont
, font_spec
)
1824 Lisp_Object font_spec
;
1826 Lisp_Object tmp
, extra
;
1827 int dpi
= FRAME_W32_DISPLAY_INFO (f
)->resy
;
1829 tmp
= AREF (font_spec
, FONT_DPI_INDEX
);
1834 else if (FLOATP (tmp
))
1836 dpi
= (int) (XFLOAT_DATA (tmp
) + 0.5);
1840 tmp
= AREF (font_spec
, FONT_SIZE_INDEX
);
1842 logfont
->lfHeight
= -1 * XINT (tmp
);
1843 else if (FLOATP (tmp
))
1844 logfont
->lfHeight
= (int) (-1.0 * dpi
* XFLOAT_DATA (tmp
) / 72.27 + 0.5);
1851 tmp
= AREF (font_spec
, FONT_WEIGHT_INDEX
);
1853 logfont
->lfWeight
= w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec
));
1856 tmp
= AREF (font_spec
, FONT_SLANT_INDEX
);
1859 int slant
= FONT_SLANT_NUMERIC (font_spec
);
1860 logfont
->lfItalic
= slant
> 150 ? 1 : 0;
1868 tmp
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1870 logfont
->lfCharSet
= registry_to_w32_charset (tmp
);
1872 logfont
->lfCharSet
= DEFAULT_CHARSET
;
1876 /* Clip Precision */
1879 logfont
->lfQuality
= DEFAULT_QUALITY
;
1881 /* Generic Family and Face Name */
1882 logfont
->lfPitchAndFamily
= FF_DONTCARE
| DEFAULT_PITCH
;
1884 tmp
= AREF (font_spec
, FONT_FAMILY_INDEX
);
1887 logfont
->lfPitchAndFamily
= w32_generic_family (tmp
) | DEFAULT_PITCH
;
1888 if ((logfont
->lfPitchAndFamily
& 0xF0) != FF_DONTCARE
)
1889 ; /* Font name was generic, don't fill in font name. */
1890 /* Font families are interned, but allow for strings also in case of
1892 else if (SYMBOLP (tmp
))
1893 strncpy (logfont
->lfFaceName
, SDATA (SYMBOL_NAME (tmp
)), LF_FACESIZE
);
1896 tmp
= AREF (font_spec
, FONT_ADSTYLE_INDEX
);
1899 /* Override generic family. */
1900 BYTE family
= w32_generic_family (tmp
);
1901 if (family
!= FF_DONTCARE
)
1902 logfont
->lfPitchAndFamily
= family
| DEFAULT_PITCH
;
1906 /* Set pitch based on the spacing property. */
1907 tmp
= AREF (font_spec
, FONT_SPACING_INDEX
);
1910 int spacing
= XINT (tmp
);
1911 if (spacing
< FONT_SPACING_MONO
)
1912 logfont
->lfPitchAndFamily
1913 = logfont
->lfPitchAndFamily
& 0xF0 | VARIABLE_PITCH
;
1915 logfont
->lfPitchAndFamily
1916 = logfont
->lfPitchAndFamily
& 0xF0 | FIXED_PITCH
;
1919 /* Process EXTRA info. */
1920 for (extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
1921 CONSP (extra
); extra
= XCDR (extra
))
1926 Lisp_Object key
, val
;
1927 key
= XCAR (tmp
), val
= XCDR (tmp
);
1928 /* Only use QCscript if charset is not provided, or is unicode
1929 and a single script is specified. This is rather crude,
1930 and is only used to narrow down the fonts returned where
1931 there is a definite match. Some scripts, such as latin, han,
1932 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1934 if (EQ (key
, QCscript
)
1935 && logfont
->lfCharSet
== DEFAULT_CHARSET
1938 if (EQ (val
, Qgreek
))
1939 logfont
->lfCharSet
= GREEK_CHARSET
;
1940 else if (EQ (val
, Qhangul
))
1941 logfont
->lfCharSet
= HANGUL_CHARSET
;
1942 else if (EQ (val
, Qkana
) || EQ (val
, Qkanbun
))
1943 logfont
->lfCharSet
= SHIFTJIS_CHARSET
;
1944 else if (EQ (val
, Qbopomofo
))
1945 logfont
->lfCharSet
= CHINESEBIG5_CHARSET
;
1946 /* GB 18030 supports tibetan, yi, mongolian,
1947 fonts that support it should show up if we ask for
1949 else if (EQ (val
, Qtibetan
) || EQ (val
, Qyi
)
1950 || EQ (val
, Qmongolian
))
1951 logfont
->lfCharSet
= GB2312_CHARSET
;
1952 else if (EQ (val
, Qhebrew
))
1953 logfont
->lfCharSet
= HEBREW_CHARSET
;
1954 else if (EQ (val
, Qarabic
))
1955 logfont
->lfCharSet
= ARABIC_CHARSET
;
1956 else if (EQ (val
, Qthai
))
1957 logfont
->lfCharSet
= THAI_CHARSET
;
1958 else if (EQ (val
, Qsymbol
))
1959 logfont
->lfCharSet
= SYMBOL_CHARSET
;
1961 else if (EQ (key
, QCantialias
) && SYMBOLP (val
))
1963 logfont
->lfQuality
= w32_antialias_type (val
);
1970 list_all_matching_fonts (match_data
)
1971 struct font_callback_data
*match_data
;
1974 Lisp_Object families
= w32font_list_family (match_data
->frame
);
1975 struct frame
*f
= XFRAME (match_data
->frame
);
1977 dc
= get_frame_dc (f
);
1979 while (!NILP (families
))
1981 /* TODO: Use the Unicode versions of the W32 APIs, so we can
1982 handle non-ASCII font names. */
1984 Lisp_Object family
= CAR (families
);
1985 families
= CDR (families
);
1988 else if (SYMBOLP (family
))
1989 name
= SDATA (SYMBOL_NAME (family
));
1993 strncpy (match_data
->pattern
.lfFaceName
, name
, LF_FACESIZE
);
1994 match_data
->pattern
.lfFaceName
[LF_FACESIZE
- 1] = '\0';
1996 EnumFontFamiliesEx (dc
, &match_data
->pattern
,
1997 (FONTENUMPROC
) add_font_entity_to_list
,
1998 (LPARAM
) match_data
, 0);
2001 release_frame_dc (f
, dc
);
2005 lispy_antialias_type (type
)
2012 case NONANTIALIASED_QUALITY
:
2015 case ANTIALIASED_QUALITY
:
2018 case CLEARTYPE_QUALITY
:
2021 case CLEARTYPE_NATURAL_QUALITY
:
2031 /* Convert antialiasing symbols to lfQuality */
2033 w32_antialias_type (type
)
2036 if (EQ (type
, Qnone
))
2037 return NONANTIALIASED_QUALITY
;
2038 else if (EQ (type
, Qstandard
))
2039 return ANTIALIASED_QUALITY
;
2040 else if (EQ (type
, Qsubpixel
))
2041 return CLEARTYPE_QUALITY
;
2042 else if (EQ (type
, Qnatural
))
2043 return CLEARTYPE_NATURAL_QUALITY
;
2045 return DEFAULT_QUALITY
;
2048 /* Return a list of all the scripts that the font supports. */
2050 font_supported_scripts (FONTSIGNATURE
* sig
)
2052 DWORD
* subranges
= sig
->fsUsb
;
2053 Lisp_Object supported
= Qnil
;
2055 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2056 #define SUBRANGE(n,sym) \
2057 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2058 supported = Fcons ((sym), supported)
2060 /* Match multiple subranges. SYM is set if any MASK bit is set in
2061 subranges[0 - 3]. */
2062 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2063 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2064 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2065 supported = Fcons ((sym), supported)
2067 SUBRANGE (0, Qlatin
);
2068 /* The following count as latin too, ASCII should be present in these fonts,
2069 so don't need to mark them separately. */
2070 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2071 SUBRANGE (4, Qphonetic
);
2072 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
2073 SUBRANGE (7, Qgreek
);
2074 SUBRANGE (8, Qcoptic
);
2075 SUBRANGE (9, Qcyrillic
);
2076 SUBRANGE (10, Qarmenian
);
2077 SUBRANGE (11, Qhebrew
);
2079 SUBRANGE (13, Qarabic
);
2080 SUBRANGE (14, Qnko
);
2081 SUBRANGE (15, Qdevanagari
);
2082 SUBRANGE (16, Qbengali
);
2083 SUBRANGE (17, Qgurmukhi
);
2084 SUBRANGE (18, Qgujarati
);
2085 SUBRANGE (19, Qoriya
);
2086 SUBRANGE (20, Qtamil
);
2087 SUBRANGE (21, Qtelugu
);
2088 SUBRANGE (22, Qkannada
);
2089 SUBRANGE (23, Qmalayalam
);
2090 SUBRANGE (24, Qthai
);
2091 SUBRANGE (25, Qlao
);
2092 SUBRANGE (26, Qgeorgian
);
2093 SUBRANGE (27, Qbalinese
);
2094 /* 28: Hangul Jamo. */
2095 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2096 /* 32-47: Symbols (defined below). */
2097 SUBRANGE (48, Qcjk_misc
);
2098 /* Match either 49: katakana or 50: hiragana for kana. */
2099 MASK_ANY (0, 0x00060000, 0, 0, Qkana
);
2100 SUBRANGE (51, Qbopomofo
);
2101 /* 52: Compatibility Jamo */
2102 SUBRANGE (53, Qphags_pa
);
2103 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2104 SUBRANGE (56, Qhangul
);
2105 /* 57: Surrogates. */
2106 SUBRANGE (58, Qphoenician
);
2107 SUBRANGE (59, Qhan
); /* There are others, but this is the main one. */
2108 SUBRANGE (59, Qideographic_description
); /* Windows lumps this in. */
2109 SUBRANGE (59, Qkanbun
); /* And this. */
2110 /* 60: Private use, 61: CJK strokes and compatibility. */
2111 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2112 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2113 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2115 SUBRANGE (70, Qtibetan
);
2116 SUBRANGE (71, Qsyriac
);
2117 SUBRANGE (72, Qthaana
);
2118 SUBRANGE (73, Qsinhala
);
2119 SUBRANGE (74, Qmyanmar
);
2120 SUBRANGE (75, Qethiopic
);
2121 SUBRANGE (76, Qcherokee
);
2122 SUBRANGE (77, Qcanadian_aboriginal
);
2123 SUBRANGE (78, Qogham
);
2124 SUBRANGE (79, Qrunic
);
2125 SUBRANGE (80, Qkhmer
);
2126 SUBRANGE (81, Qmongolian
);
2127 SUBRANGE (82, Qbraille
);
2129 SUBRANGE (84, Qbuhid
);
2130 SUBRANGE (84, Qhanunoo
);
2131 SUBRANGE (84, Qtagalog
);
2132 SUBRANGE (84, Qtagbanwa
);
2133 SUBRANGE (85, Qold_italic
);
2134 SUBRANGE (86, Qgothic
);
2135 SUBRANGE (87, Qdeseret
);
2136 SUBRANGE (88, Qbyzantine_musical_symbol
);
2137 SUBRANGE (88, Qmusical_symbol
); /* Windows doesn't distinguish these. */
2138 SUBRANGE (89, Qmathematical
);
2139 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2140 SUBRANGE (93, Qlimbu
);
2141 SUBRANGE (94, Qtai_le
);
2142 /* 95: New Tai Le */
2143 SUBRANGE (90, Qbuginese
);
2144 SUBRANGE (97, Qglagolitic
);
2145 SUBRANGE (98, Qtifinagh
);
2146 /* 99: Yijing Hexagrams. */
2147 SUBRANGE (100, Qsyloti_nagri
);
2148 SUBRANGE (101, Qlinear_b
);
2149 /* 102: Ancient Greek Numbers. */
2150 SUBRANGE (103, Qugaritic
);
2151 SUBRANGE (104, Qold_persian
);
2152 SUBRANGE (105, Qshavian
);
2153 SUBRANGE (106, Qosmanya
);
2154 SUBRANGE (107, Qcypriot
);
2155 SUBRANGE (108, Qkharoshthi
);
2156 /* 109: Tai Xuan Jing. */
2157 SUBRANGE (110, Qcuneiform
);
2158 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2159 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2160 SUBRANGE (118, Qcham
);
2161 /* 119: Ancient symbols, 120: Phaistos Disc. */
2162 /* 121: Carian, Lycian, Lydian, 122: Dominos, Mah Jong tiles. */
2163 /* 123-127: Reserved. */
2165 /* There isn't really a main symbol range, so include symbol if any
2166 relevant range is set. */
2167 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol
);
2169 /* Missing: Tai Viet (U+AA80-U+AADF). */
2176 /* Generate a full name for a Windows font.
2177 The full name is in fcname format, with weight, slant and antialiasing
2178 specified if they are not "normal". */
2180 w32font_full_name (font
, font_obj
, pixel_size
, name
, nbytes
)
2182 Lisp_Object font_obj
;
2187 int len
, height
, outline
;
2189 Lisp_Object antialiasing
, weight
= Qnil
;
2191 len
= strlen (font
->lfFaceName
);
2193 outline
= EQ (AREF (font_obj
, FONT_FOUNDRY_INDEX
), Qoutline
);
2195 /* Represent size of scalable fonts by point size. But use pixelsize for
2196 raster fonts to indicate that they are exactly that size. */
2198 len
+= 11; /* -SIZE */
2203 len
+= 7; /* :italic */
2205 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2207 weight
= w32_to_fc_weight (font
->lfWeight
);
2208 len
+= 1 + SBYTES (SYMBOL_NAME (weight
)); /* :WEIGHT */
2211 antialiasing
= lispy_antialias_type (font
->lfQuality
);
2212 if (! NILP (antialiasing
))
2213 len
+= 11 + SBYTES (SYMBOL_NAME (antialiasing
)); /* :antialias=NAME */
2215 /* Check that the buffer is big enough */
2220 p
+= sprintf (p
, "%s", font
->lfFaceName
);
2222 height
= font
->lfHeight
? eabs (font
->lfHeight
) : pixel_size
;
2228 float pointsize
= height
* 72.0 / one_w32_display_info
.resy
;
2229 /* Round to nearest half point. floor is used, since round is not
2230 supported in MS library. */
2231 pointsize
= floor (pointsize
* 2 + 0.5) / 2;
2232 p
+= sprintf (p
, "-%1.1f", pointsize
);
2235 p
+= sprintf (p
, ":pixelsize=%d", height
);
2238 if (SYMBOLP (weight
) && ! NILP (weight
))
2239 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2242 p
+= sprintf (p
, ":italic");
2244 if (SYMBOLP (antialiasing
) && ! NILP (antialiasing
))
2245 p
+= sprintf (p
, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing
)));
2250 /* Convert a logfont and point size into a fontconfig style font name.
2251 POINTSIZE is in tenths of points.
2252 If SIZE indicates the size of buffer FCNAME, into which the font name
2253 is written. If the buffer is not large enough to contain the name,
2254 the function returns -1, otherwise it returns the number of bytes
2255 written to FCNAME. */
2256 static int logfont_to_fcname(font
, pointsize
, fcname
, size
)
2264 Lisp_Object weight
= Qnil
;
2266 len
= strlen (font
->lfFaceName
) + 2;
2267 height
= pointsize
/ 10;
2268 while (height
/= 10)
2275 len
+= 7; /* :italic */
2276 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2278 weight
= w32_to_fc_weight (font
->lfWeight
);
2279 len
+= SBYTES (SYMBOL_NAME (weight
)) + 1;
2285 p
+= sprintf (p
, "%s-%d", font
->lfFaceName
, pointsize
/ 10);
2287 p
+= sprintf (p
, ".%d", pointsize
% 10);
2289 if (SYMBOLP (weight
) && !NILP (weight
))
2290 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2293 p
+= sprintf (p
, ":italic");
2295 return (p
- fcname
);
2299 compute_metrics (dc
, w32_font
, code
, metrics
)
2301 struct w32font_info
*w32_font
;
2303 struct w32_metric_cache
*metrics
;
2307 unsigned int options
= GGO_METRICS
;
2309 if (w32_font
->glyph_idx
)
2310 options
|= GGO_GLYPH_INDEX
;
2312 bzero (&transform
, sizeof (transform
));
2313 transform
.eM11
.value
= 1;
2314 transform
.eM22
.value
= 1;
2316 if (GetGlyphOutlineW (dc
, code
, options
, &gm
, 0, NULL
, &transform
)
2319 metrics
->lbearing
= gm
.gmptGlyphOrigin
.x
;
2320 metrics
->rbearing
= gm
.gmptGlyphOrigin
.x
+ gm
.gmBlackBoxX
;
2321 metrics
->width
= gm
.gmCellIncX
;
2322 metrics
->status
= W32METRIC_SUCCESS
;
2325 metrics
->status
= W32METRIC_FAIL
;
2329 clear_cached_metrics (w32_font
)
2330 struct w32font_info
*w32_font
;
2333 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
2335 if (w32_font
->cached_metrics
[i
])
2336 bzero (w32_font
->cached_metrics
[i
],
2337 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
2341 DEFUN ("x-select-font", Fx_select_font
, Sx_select_font
, 0, 2, 0,
2342 doc
: /* Read a font name using a W32 font selection dialog.
2343 Return fontconfig style font string corresponding to the selection.
2345 If FRAME is omitted or nil, it defaults to the selected frame.
2346 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2347 in the font selection dialog. */)
2348 (frame
, exclude_proportional
)
2349 Lisp_Object frame
, exclude_proportional
;
2351 FRAME_PTR f
= check_x_frame (frame
);
2359 bzero (&cf
, sizeof (cf
));
2360 bzero (&lf
, sizeof (lf
));
2362 cf
.lStructSize
= sizeof (cf
);
2363 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
2364 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
2366 /* If exclude_proportional is non-nil, limit the selection to
2367 monospaced fonts. */
2368 if (!NILP (exclude_proportional
))
2369 cf
.Flags
|= CF_FIXEDPITCHONLY
;
2373 /* Initialize as much of the font details as we can from the current
2375 hdc
= GetDC (FRAME_W32_WINDOW (f
));
2376 oldobj
= SelectObject (hdc
, FONT_HANDLE (FRAME_FONT (f
)));
2377 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
2378 if (GetTextMetrics (hdc
, &tm
))
2380 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
2381 lf
.lfWeight
= tm
.tmWeight
;
2382 lf
.lfItalic
= tm
.tmItalic
;
2383 lf
.lfUnderline
= tm
.tmUnderlined
;
2384 lf
.lfStrikeOut
= tm
.tmStruckOut
;
2385 lf
.lfCharSet
= tm
.tmCharSet
;
2386 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
2388 SelectObject (hdc
, oldobj
);
2389 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
2391 if (!ChooseFont (&cf
)
2392 || logfont_to_fcname (&lf
, cf
.iPointSize
, buf
, 100) < 0)
2395 return build_string (buf
);
2398 struct font_driver w32font_driver
=
2401 0, /* case insensitive */
2405 w32font_list_family
,
2406 NULL
, /* free_entity */
2409 NULL
, /* prepare_face */
2410 NULL
, /* done_face */
2412 w32font_encode_char
,
2413 w32font_text_extents
,
2415 NULL
, /* get_bitmap */
2416 NULL
, /* free_bitmap */
2417 NULL
, /* get_outline */
2418 NULL
, /* free_outline */
2419 NULL
, /* anchor_point */
2420 NULL
, /* otf_capability */
2421 NULL
, /* otf_drive */
2422 NULL
, /* start_for_frame */
2423 NULL
, /* end_for_frame */
2428 /* Initialize state that does not change between invocations. This is only
2429 called when Emacs is dumped. */
2433 DEFSYM (Qgdi
, "gdi");
2434 DEFSYM (Quniscribe
, "uniscribe");
2435 DEFSYM (QCformat
, ":format");
2437 /* Generic font families. */
2438 DEFSYM (Qmonospace
, "monospace");
2439 DEFSYM (Qserif
, "serif");
2440 DEFSYM (Qsansserif
, "sansserif");
2441 DEFSYM (Qscript
, "script");
2442 DEFSYM (Qdecorative
, "decorative");
2444 DEFSYM (Qsans_serif
, "sans_serif");
2445 DEFSYM (Qsans
, "sans");
2446 DEFSYM (Qmono
, "mono");
2448 /* Fake foundries. */
2449 DEFSYM (Qraster
, "raster");
2450 DEFSYM (Qoutline
, "outline");
2451 DEFSYM (Qunknown
, "unknown");
2454 DEFSYM (Qstandard
, "standard");
2455 DEFSYM (Qsubpixel
, "subpixel");
2456 DEFSYM (Qnatural
, "natural");
2464 DEFSYM (Qlatin
, "latin");
2465 DEFSYM (Qgreek
, "greek");
2466 DEFSYM (Qcoptic
, "coptic");
2467 DEFSYM (Qcyrillic
, "cyrillic");
2468 DEFSYM (Qarmenian
, "armenian");
2469 DEFSYM (Qhebrew
, "hebrew");
2470 DEFSYM (Qarabic
, "arabic");
2471 DEFSYM (Qsyriac
, "syriac");
2472 DEFSYM (Qnko
, "nko");
2473 DEFSYM (Qthaana
, "thaana");
2474 DEFSYM (Qdevanagari
, "devanagari");
2475 DEFSYM (Qbengali
, "bengali");
2476 DEFSYM (Qgurmukhi
, "gurmukhi");
2477 DEFSYM (Qgujarati
, "gujarati");
2478 DEFSYM (Qoriya
, "oriya");
2479 DEFSYM (Qtamil
, "tamil");
2480 DEFSYM (Qtelugu
, "telugu");
2481 DEFSYM (Qkannada
, "kannada");
2482 DEFSYM (Qmalayalam
, "malayalam");
2483 DEFSYM (Qsinhala
, "sinhala");
2484 DEFSYM (Qthai
, "thai");
2485 DEFSYM (Qlao
, "lao");
2486 DEFSYM (Qtibetan
, "tibetan");
2487 DEFSYM (Qmyanmar
, "myanmar");
2488 DEFSYM (Qgeorgian
, "georgian");
2489 DEFSYM (Qhangul
, "hangul");
2490 DEFSYM (Qethiopic
, "ethiopic");
2491 DEFSYM (Qcherokee
, "cherokee");
2492 DEFSYM (Qcanadian_aboriginal
, "canadian-aboriginal");
2493 DEFSYM (Qogham
, "ogham");
2494 DEFSYM (Qrunic
, "runic");
2495 DEFSYM (Qkhmer
, "khmer");
2496 DEFSYM (Qmongolian
, "mongolian");
2497 DEFSYM (Qsymbol
, "symbol");
2498 DEFSYM (Qbraille
, "braille");
2499 DEFSYM (Qhan
, "han");
2500 DEFSYM (Qideographic_description
, "ideographic-description");
2501 DEFSYM (Qcjk_misc
, "cjk-misc");
2502 DEFSYM (Qkana
, "kana");
2503 DEFSYM (Qbopomofo
, "bopomofo");
2504 DEFSYM (Qkanbun
, "kanbun");
2506 DEFSYM (Qbyzantine_musical_symbol
, "byzantine-musical-symbol");
2507 DEFSYM (Qmusical_symbol
, "musical-symbol");
2508 DEFSYM (Qmathematical
, "mathematical");
2509 DEFSYM (Qcham
, "cham");
2510 DEFSYM (Qphonetic
, "phonetic");
2511 DEFSYM (Qbalinese
, "balinese");
2512 DEFSYM (Qbuginese
, "buginese");
2513 DEFSYM (Qbuhid
, "buhid");
2514 DEFSYM (Qcuneiform
, "cuneiform");
2515 DEFSYM (Qcypriot
, "cypriot");
2516 DEFSYM (Qdeseret
, "deseret");
2517 DEFSYM (Qglagolitic
, "glagolitic");
2518 DEFSYM (Qgothic
, "gothic");
2519 DEFSYM (Qhanunoo
, "hanunoo");
2520 DEFSYM (Qkharoshthi
, "kharoshthi");
2521 DEFSYM (Qlimbu
, "limbu");
2522 DEFSYM (Qlinear_b
, "linear_b");
2523 DEFSYM (Qold_italic
, "old_italic");
2524 DEFSYM (Qold_persian
, "old_persian");
2525 DEFSYM (Qosmanya
, "osmanya");
2526 DEFSYM (Qphags_pa
, "phags-pa");
2527 DEFSYM (Qphoenician
, "phoenician");
2528 DEFSYM (Qshavian
, "shavian");
2529 DEFSYM (Qsyloti_nagri
, "syloti_nagri");
2530 DEFSYM (Qtagalog
, "tagalog");
2531 DEFSYM (Qtagbanwa
, "tagbanwa");
2532 DEFSYM (Qtai_le
, "tai_le");
2533 DEFSYM (Qtifinagh
, "tifinagh");
2534 DEFSYM (Qugaritic
, "ugaritic");
2536 /* W32 font encodings. */
2537 DEFVAR_LISP ("w32-charset-info-alist",
2538 &Vw32_charset_info_alist
,
2539 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
2540 Each entry should be of the form:
2542 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2544 where CHARSET_NAME is a string used in font names to identify the charset,
2545 WINDOWS_CHARSET is a symbol that can be one of:
2547 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2548 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2549 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2550 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2551 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2552 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2555 CODEPAGE should be an integer specifying the codepage that should be used
2556 to display the character set, t to do no translation and output as Unicode,
2557 or nil to do no translation and output as 8 bit (or multibyte on far-east
2558 versions of Windows) characters. */);
2559 Vw32_charset_info_alist
= Qnil
;
2561 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
2562 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
2563 DEFSYM (Qw32_charset_default
, "w32-charset-default");
2564 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
2565 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
2566 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
2567 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
2568 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
2569 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
2570 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
2571 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
2572 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
2573 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
2574 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
2575 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
2576 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
2577 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
2578 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
2579 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
2581 defsubr (&Sx_select_font
);
2583 w32font_driver
.type
= Qgdi
;
2584 register_font_driver (&w32font_driver
, NULL
);
2587 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2588 (do not change this comment) */