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
;
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
;
89 /* Only defined here, but useful for distinguishing IPA capable fonts. */
90 static Lisp_Object Qphonetic
;
92 /* W32 charsets: for use in Vw32_charset_info_alist. */
93 static Lisp_Object Qw32_charset_ansi
, Qw32_charset_default
;
94 static Lisp_Object Qw32_charset_symbol
, Qw32_charset_shiftjis
;
95 static Lisp_Object Qw32_charset_hangeul
, Qw32_charset_gb2312
;
96 static Lisp_Object Qw32_charset_chinesebig5
, Qw32_charset_oem
;
97 static Lisp_Object Qw32_charset_easteurope
, Qw32_charset_turkish
;
98 static Lisp_Object Qw32_charset_baltic
, Qw32_charset_russian
;
99 static Lisp_Object Qw32_charset_arabic
, Qw32_charset_greek
;
100 static Lisp_Object Qw32_charset_hebrew
, Qw32_charset_vietnamese
;
101 static Lisp_Object Qw32_charset_thai
, Qw32_charset_johab
, Qw32_charset_mac
;
103 /* Associative list linking character set strings to Windows codepages. */
104 static Lisp_Object Vw32_charset_info_alist
;
106 /* Font spacing symbols - defined in font.c. */
107 extern Lisp_Object Qc
, Qp
, Qm
;
109 static void fill_in_logfont
P_ ((FRAME_PTR
, LOGFONT
*, Lisp_Object
));
111 static BYTE w32_antialias_type
P_ ((Lisp_Object
));
112 static Lisp_Object lispy_antialias_type
P_ ((BYTE
));
114 static Lisp_Object font_supported_scripts
P_ ((FONTSIGNATURE
*));
115 static int w32font_full_name
P_ ((LOGFONT
*, Lisp_Object
, int, char *, int));
116 static void compute_metrics
P_ ((HDC
, struct w32font_info
*, unsigned int,
117 struct w32_metric_cache
*));
118 static void clear_cached_metrics
P_ ((struct w32font_info
*));
120 static Lisp_Object w32_registry
P_ ((LONG
, DWORD
));
122 /* EnumFontFamiliesEx callbacks. */
123 static int CALLBACK add_font_entity_to_list
P_ ((ENUMLOGFONTEX
*,
126 static int CALLBACK add_one_font_entity_to_list
P_ ((ENUMLOGFONTEX
*,
129 static int CALLBACK add_font_name_to_list
P_ ((ENUMLOGFONTEX
*,
133 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
134 of what we really want. */
135 struct font_callback_data
137 /* The logfont we are matching against. EnumFontFamiliesEx only matches
138 face name and charset, so we need to manually match everything else
139 in the callback function. */
141 /* The original font spec or entity. */
142 Lisp_Object orig_font_spec
;
143 /* The frame the font is being loaded on. */
145 /* The list to add matches to. */
147 /* Whether to match only opentype fonts. */
151 /* Handles the problem that EnumFontFamiliesEx will not return all
152 style variations if the font name is not specified. */
153 static void list_all_matching_fonts
P_ ((struct font_callback_data
*));
157 memq_no_quit (elt
, list
)
158 Lisp_Object elt
, list
;
160 while (CONSP (list
) && ! EQ (XCAR (list
), elt
))
162 return (CONSP (list
));
165 /* w32 implementation of get_cache for font backend.
166 Return a cache of font-entities on FRAME. The cache must be a
167 cons whose cdr part is the actual cache area. */
169 w32font_get_cache (f
)
172 struct w32_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
174 return (dpyinfo
->name_list_element
);
177 /* w32 implementation of list for font backend.
178 List fonts exactly matching with FONT_SPEC on FRAME. The value
179 is a vector of font-entities. This is the sole API that
180 allocates font-entities. */
182 w32font_list (frame
, font_spec
)
183 Lisp_Object frame
, font_spec
;
185 Lisp_Object fonts
= w32font_list_internal (frame
, font_spec
, 0);
186 font_add_log ("w32font-list", font_spec
, fonts
);
190 /* w32 implementation of match for font backend.
191 Return a font entity most closely matching with FONT_SPEC on
192 FRAME. The closeness is detemined by the font backend, thus
193 `face-font-selection-order' is ignored here. */
195 w32font_match (frame
, font_spec
)
196 Lisp_Object frame
, font_spec
;
198 Lisp_Object entity
= w32font_match_internal (frame
, font_spec
, 0);
199 font_add_log ("w32font-match", font_spec
, entity
);
203 /* w32 implementation of list_family for font backend.
204 List available families. The value is a list of family names
207 w32font_list_family (frame
)
210 Lisp_Object list
= Qnil
;
211 LOGFONT font_match_pattern
;
213 FRAME_PTR f
= XFRAME (frame
);
215 bzero (&font_match_pattern
, sizeof (font_match_pattern
));
216 font_match_pattern
.lfCharSet
= DEFAULT_CHARSET
;
218 dc
= get_frame_dc (f
);
220 EnumFontFamiliesEx (dc
, &font_match_pattern
,
221 (FONTENUMPROC
) add_font_name_to_list
,
223 release_frame_dc (f
, dc
);
228 /* w32 implementation of open for font backend.
229 Open a font specified by FONT_ENTITY on frame F.
230 If the font is scalable, open it with PIXEL_SIZE. */
232 w32font_open (f
, font_entity
, pixel_size
)
234 Lisp_Object font_entity
;
237 Lisp_Object font_object
238 = font_make_object (VECSIZE (struct w32font_info
),
239 font_entity
, pixel_size
);
240 struct w32font_info
*w32_font
241 = (struct w32font_info
*) XFONT_OBJECT (font_object
);
243 ASET (font_object
, FONT_TYPE_INDEX
, Qgdi
);
245 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
250 /* GDI backend does not use glyph indices. */
251 w32_font
->glyph_idx
= 0;
256 /* w32 implementation of close for font_backend.
257 Close FONT on frame F. */
259 w32font_close (f
, font
)
264 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
266 /* Delete the GDI font object. */
267 DeleteObject (w32_font
->hfont
);
269 /* Free all the cached metrics. */
270 if (w32_font
->cached_metrics
)
272 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
274 if (w32_font
->cached_metrics
[i
])
275 xfree (w32_font
->cached_metrics
[i
]);
277 xfree (w32_font
->cached_metrics
);
278 w32_font
->cached_metrics
= NULL
;
282 /* w32 implementation of has_char for font backend.
284 If FONT_ENTITY has a glyph for character C (Unicode code point),
285 return 1. If not, return 0. If a font must be opened to check
288 w32font_has_char (entity
, c
)
292 Lisp_Object supported_scripts
, extra
, script
;
295 extra
= AREF (entity
, FONT_EXTRA_INDEX
);
299 supported_scripts
= assq_no_quit (QCscript
, extra
);
300 /* If font doesn't claim to support any scripts, then we can't be certain
302 if (!CONSP (supported_scripts
))
305 supported_scripts
= XCDR (supported_scripts
);
307 script
= CHAR_TABLE_REF (Vchar_script_table
, c
);
309 /* If we don't know what script the character is from, then we can't be
310 certain until we open it. Also if the font claims support for the script
311 the character is from, it may only have partial coverage, so we still
312 can't be certain until we open the font. */
313 if (NILP (script
) || memq_no_quit (script
, supported_scripts
))
316 /* Font reports what scripts it supports, and none of them are the script
317 the character is from, so it is a definite no. */
321 /* w32 implementation of encode_char for font backend.
322 Return a glyph code of FONT for characer C (Unicode code point).
323 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
325 For speed, the gdi backend uses unicode (Emacs calls encode_char
326 far too often for it to be efficient). But we still need to detect
327 which characters are not supported by the font.
330 w32font_encode_char (font
, c
)
334 struct w32font_info
* w32_font
= (struct w32font_info
*)font
;
336 if (c
< w32_font
->metrics
.tmFirstChar
337 || c
> w32_font
->metrics
.tmLastChar
)
338 return FONT_INVALID_CODE
;
343 /* w32 implementation of text_extents for font backend.
344 Perform the size computation of glyphs of FONT and fillin members
345 of METRICS. The glyphs are specified by their glyph codes in
346 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
347 case just return the overall width. */
349 w32font_text_extents (font
, code
, nglyphs
, metrics
)
353 struct font_metrics
*metrics
;
356 HFONT old_font
= NULL
;
363 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
367 bzero (metrics
, sizeof (struct font_metrics
));
368 metrics
->ascent
= font
->ascent
;
369 metrics
->descent
= font
->descent
;
371 for (i
= 0; i
< nglyphs
; i
++)
373 struct w32_metric_cache
*char_metric
;
374 int block
= *(code
+ i
) / CACHE_BLOCKSIZE
;
375 int pos_in_block
= *(code
+ i
) % CACHE_BLOCKSIZE
;
377 if (block
>= w32_font
->n_cache_blocks
)
379 if (!w32_font
->cached_metrics
)
380 w32_font
->cached_metrics
381 = xmalloc ((block
+ 1)
382 * sizeof (struct w32_metric_cache
*));
384 w32_font
->cached_metrics
385 = xrealloc (w32_font
->cached_metrics
,
387 * sizeof (struct w32_metric_cache
*));
388 bzero (w32_font
->cached_metrics
+ w32_font
->n_cache_blocks
,
389 ((block
+ 1 - w32_font
->n_cache_blocks
)
390 * sizeof (struct w32_metric_cache
*)));
391 w32_font
->n_cache_blocks
= block
+ 1;
394 if (!w32_font
->cached_metrics
[block
])
396 w32_font
->cached_metrics
[block
]
397 = xmalloc (CACHE_BLOCKSIZE
* sizeof (struct w32_metric_cache
));
398 bzero (w32_font
->cached_metrics
[block
],
399 CACHE_BLOCKSIZE
* sizeof (struct w32_metric_cache
));
402 char_metric
= w32_font
->cached_metrics
[block
] + pos_in_block
;
404 if (char_metric
->status
== W32METRIC_NO_ATTEMPT
)
408 /* TODO: Frames can come and go, and their fonts
409 outlive them. So we can't cache the frame in the
410 font structure. Use selected_frame until the API
411 is updated to pass in a frame. */
412 f
= XFRAME (selected_frame
);
414 dc
= get_frame_dc (f
);
415 old_font
= SelectObject (dc
, w32_font
->hfont
);
417 compute_metrics (dc
, w32_font
, *(code
+ i
), char_metric
);
420 if (char_metric
->status
== W32METRIC_SUCCESS
)
422 metrics
->lbearing
= min (metrics
->lbearing
,
423 metrics
->width
+ char_metric
->lbearing
);
424 metrics
->rbearing
= max (metrics
->rbearing
,
425 metrics
->width
+ char_metric
->rbearing
);
426 metrics
->width
+= char_metric
->width
;
429 /* If we couldn't get metrics for a char,
430 use alternative method. */
433 /* If we got through everything, return. */
438 /* Restore state and release DC. */
439 SelectObject (dc
, old_font
);
440 release_frame_dc (f
, dc
);
443 return metrics
->width
;
447 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
448 fallback on other methods that will at least give some of the metric
451 /* Make array big enough to hold surrogates. */
452 wcode
= alloca (nglyphs
* sizeof (WORD
) * 2);
453 for (i
= 0; i
< nglyphs
; i
++)
455 if (code
[i
] < 0x10000)
459 DWORD surrogate
= code
[i
] - 0x10000;
461 /* High surrogate: U+D800 - U+DBFF. */
462 wcode
[i
++] = 0xD800 + ((surrogate
>> 10) & 0x03FF);
463 /* Low surrogate: U+DC00 - U+DFFF. */
464 wcode
[i
] = 0xDC00 + (surrogate
& 0x03FF);
465 /* An extra glyph. wcode is already double the size of code to
473 /* TODO: Frames can come and go, and their fonts outlive
474 them. So we can't cache the frame in the font structure. Use
475 selected_frame until the API is updated to pass in a
477 f
= XFRAME (selected_frame
);
479 dc
= get_frame_dc (f
);
480 old_font
= SelectObject (dc
, w32_font
->hfont
);
483 if (GetTextExtentPoint32W (dc
, wcode
, nglyphs
, &size
))
485 total_width
= size
.cx
;
488 /* On 95/98/ME, only some unicode functions are available, so fallback
489 on doing a dummy draw to find the total width. */
493 rect
.top
= 0; rect
.bottom
= font
->height
; rect
.left
= 0; rect
.right
= 1;
494 DrawTextW (dc
, wcode
, nglyphs
, &rect
,
495 DT_CALCRECT
| DT_NOPREFIX
| DT_SINGLELINE
);
496 total_width
= rect
.right
;
499 /* Give our best estimate of the metrics, based on what we know. */
502 metrics
->width
= total_width
- w32_font
->metrics
.tmOverhang
;
503 metrics
->lbearing
= 0;
504 metrics
->rbearing
= total_width
;
507 /* Restore state and release DC. */
508 SelectObject (dc
, old_font
);
509 release_frame_dc (f
, dc
);
514 /* w32 implementation of draw for font backend.
516 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
517 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
518 is nonzero, fill the background in advance. It is assured that
519 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
521 TODO: Currently this assumes that the colors and fonts are already
522 set in the DC. This seems to be true now, but maybe only due to
523 the old font code setting it up. It may be safer to resolve faces
524 and fonts in here and set them explicitly
528 w32font_draw (s
, from
, to
, x
, y
, with_background
)
529 struct glyph_string
*s
;
530 int from
, to
, x
, y
, with_background
;
534 struct w32font_info
*w32font
= (struct w32font_info
*) s
->font
;
536 options
= w32font
->glyph_idx
;
538 /* Save clip region for later restoration. */
539 GetClipRgn(s
->hdc
, orig_clip
);
541 if (s
->num_clips
> 0)
543 HRGN new_clip
= CreateRectRgnIndirect (s
->clip
);
545 if (s
->num_clips
> 1)
547 HRGN clip2
= CreateRectRgnIndirect (s
->clip
+ 1);
549 CombineRgn (new_clip
, new_clip
, clip2
, RGN_OR
);
550 DeleteObject (clip2
);
553 SelectClipRgn (s
->hdc
, new_clip
);
554 DeleteObject (new_clip
);
557 /* Using OPAQUE background mode can clear more background than expected
558 when Cleartype is used. Draw the background manually to avoid this. */
559 SetBkMode (s
->hdc
, TRANSPARENT
);
564 struct font
*font
= s
->font
;
566 brush
= CreateSolidBrush (s
->gc
->background
);
568 rect
.top
= y
- font
->ascent
;
569 rect
.right
= x
+ s
->width
;
570 rect
.bottom
= y
+ font
->descent
;
571 FillRect (s
->hdc
, &rect
, brush
);
572 DeleteObject (brush
);
577 int len
= to
- from
, i
;
579 for (i
= 0; i
< len
; i
++)
580 ExtTextOutW (s
->hdc
, x
+ i
, y
, options
, NULL
,
581 s
->char2b
+ from
+ i
, 1, NULL
);
584 ExtTextOutW (s
->hdc
, x
, y
, options
, NULL
, s
->char2b
+ from
, to
- from
, NULL
);
586 /* Restore clip region. */
587 if (s
->num_clips
> 0)
589 SelectClipRgn (s
->hdc
, orig_clip
);
593 /* w32 implementation of free_entity for font backend.
594 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
595 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
597 w32font_free_entity (Lisp_Object entity);
600 /* w32 implementation of prepare_face for font backend.
601 Optional (if FACE->extra is not used).
602 Prepare FACE for displaying characters by FONT on frame F by
603 storing some data in FACE->extra. If successful, return 0.
604 Otherwise, return -1.
606 w32font_prepare_face (FRAME_PTR f, struct face *face);
608 /* w32 implementation of done_face for font backend.
610 Done FACE for displaying characters by FACE->font on frame F.
612 w32font_done_face (FRAME_PTR f, struct face *face); */
614 /* w32 implementation of get_bitmap for font backend.
616 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
617 intended that this method is called from the other font-driver
620 w32font_get_bitmap (struct font *font, unsigned code,
621 struct font_bitmap *bitmap, int bits_per_pixel);
623 /* w32 implementation of free_bitmap for font backend.
625 Free bitmap data in BITMAP.
627 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
629 /* w32 implementation of get_outline for font backend.
631 Return an outline data for glyph-code CODE of FONT. The format
632 of the outline data depends on the font-driver.
634 w32font_get_outline (struct font *font, unsigned code);
636 /* w32 implementation of free_outline for font backend.
638 Free OUTLINE (that is obtained by the above method).
640 w32font_free_outline (struct font *font, void *outline);
642 /* w32 implementation of anchor_point for font backend.
644 Get coordinates of the INDEXth anchor point of the glyph whose
645 code is CODE. Store the coordinates in *X and *Y. Return 0 if
646 the operations was successfull. Otherwise return -1.
648 w32font_anchor_point (struct font *font, unsigned code,
649 int index, int *x, int *y);
651 /* w32 implementation of otf_capability for font backend.
653 Return a list describing which scripts/languages FONT
654 supports by which GSUB/GPOS features of OpenType tables.
656 w32font_otf_capability (struct font *font);
658 /* w32 implementation of otf_drive for font backend.
660 Apply FONT's OTF-FEATURES to the glyph string.
662 FEATURES specifies which OTF features to apply in this format:
663 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
664 See the documentation of `font-drive-otf' for the detail.
666 This method applies the specified features to the codes in the
667 elements of GSTRING-IN (between FROMth and TOth). The output
668 codes are stored in GSTRING-OUT at the IDXth element and the
671 Return the number of output codes. If none of the features are
672 applicable to the input data, return 0. If GSTRING-OUT is too
675 w32font_otf_drive (struct font *font, Lisp_Object features,
676 Lisp_Object gstring_in, int from, int to,
677 Lisp_Object gstring_out, int idx,
678 int alternate_subst);
681 /* Internal implementation of w32font_list.
682 Additional parameter opentype_only restricts the returned fonts to
683 opentype fonts, which can be used with the Uniscribe backend. */
685 w32font_list_internal (frame
, font_spec
, opentype_only
)
686 Lisp_Object frame
, font_spec
;
689 struct font_callback_data match_data
;
691 FRAME_PTR f
= XFRAME (frame
);
693 match_data
.orig_font_spec
= font_spec
;
694 match_data
.list
= Qnil
;
695 match_data
.frame
= frame
;
697 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
698 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
700 match_data
.opentype_only
= opentype_only
;
702 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
704 if (match_data
.pattern
.lfFaceName
[0] == '\0')
706 /* EnumFontFamiliesEx does not take other fields into account if
707 font name is blank, so need to use two passes. */
708 list_all_matching_fonts (&match_data
);
712 dc
= get_frame_dc (f
);
714 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
715 (FONTENUMPROC
) add_font_entity_to_list
,
716 (LPARAM
) &match_data
, 0);
717 release_frame_dc (f
, dc
);
720 return NILP (match_data
.list
) ? Qnil
: match_data
.list
;
723 /* Internal implementation of w32font_match.
724 Additional parameter opentype_only restricts the returned fonts to
725 opentype fonts, which can be used with the Uniscribe backend. */
727 w32font_match_internal (frame
, font_spec
, opentype_only
)
728 Lisp_Object frame
, font_spec
;
731 struct font_callback_data match_data
;
733 FRAME_PTR f
= XFRAME (frame
);
735 match_data
.orig_font_spec
= font_spec
;
736 match_data
.frame
= frame
;
737 match_data
.list
= Qnil
;
739 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
740 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
742 match_data
.opentype_only
= opentype_only
;
744 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
746 dc
= get_frame_dc (f
);
748 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
749 (FONTENUMPROC
) add_one_font_entity_to_list
,
750 (LPARAM
) &match_data
, 0);
751 release_frame_dc (f
, dc
);
753 return NILP (match_data
.list
) ? Qnil
: XCAR (match_data
.list
);
757 w32font_open_internal (f
, font_entity
, pixel_size
, font_object
)
759 Lisp_Object font_entity
;
761 Lisp_Object font_object
;
766 HFONT hfont
, old_font
;
767 Lisp_Object val
, extra
;
768 struct w32font_info
*w32_font
;
770 OUTLINETEXTMETRICW
* metrics
= NULL
;
772 w32_font
= (struct w32font_info
*) XFONT_OBJECT (font_object
);
773 font
= (struct font
*) w32_font
;
778 bzero (&logfont
, sizeof (logfont
));
779 fill_in_logfont (f
, &logfont
, font_entity
);
781 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
782 limitations in bitmap fonts. */
783 val
= AREF (font_entity
, FONT_FOUNDRY_INDEX
);
784 if (!EQ (val
, Qraster
))
785 logfont
.lfOutPrecision
= OUT_TT_PRECIS
;
787 size
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
791 logfont
.lfHeight
= -size
;
792 hfont
= CreateFontIndirect (&logfont
);
797 /* Get the metrics for this font. */
798 dc
= get_frame_dc (f
);
799 old_font
= SelectObject (dc
, hfont
);
801 /* Try getting the outline metrics (only works for truetype fonts). */
802 len
= GetOutlineTextMetricsW (dc
, 0, NULL
);
805 metrics
= (OUTLINETEXTMETRICW
*) alloca (len
);
806 if (GetOutlineTextMetricsW (dc
, len
, metrics
))
807 bcopy (&metrics
->otmTextMetrics
, &w32_font
->metrics
,
808 sizeof (TEXTMETRICW
));
814 GetTextMetricsW (dc
, &w32_font
->metrics
);
816 w32_font
->cached_metrics
= NULL
;
817 w32_font
->n_cache_blocks
= 0;
819 SelectObject (dc
, old_font
);
820 release_frame_dc (f
, dc
);
822 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. */
831 while (name
&& w32font_full_name (&logfont
, font_entity
, pixel_size
,
838 font
->props
[FONT_FULLNAME_INDEX
]
839 = make_unibyte_string (name
, strlen (name
));
841 font
->props
[FONT_FULLNAME_INDEX
] =
842 make_unibyte_string (logfont
.lfFaceName
, len
);
845 font
->max_width
= w32_font
->metrics
.tmMaxCharWidth
;
846 /* Parts of Emacs display assume that height = ascent + descent...
847 so height is defined later, after ascent and descent.
848 font->height = w32_font->metrics.tmHeight
849 + w32_font->metrics.tmExternalLeading;
852 font
->space_width
= font
->average_width
= w32_font
->metrics
.tmAveCharWidth
;
854 font
->vertical_centering
= 0;
855 font
->encoding_type
= 0;
856 font
->baseline_offset
= 0;
857 font
->relative_compose
= 0;
858 font
->default_ascent
= w32_font
->metrics
.tmAscent
;
859 font
->font_encoder
= NULL
;
860 font
->pixel_size
= size
;
861 font
->driver
= &w32font_driver
;
862 /* Use format cached during list, as the information we have access to
863 here is incomplete. */
864 extra
= AREF (font_entity
, FONT_EXTRA_INDEX
);
867 val
= assq_no_quit (QCformat
, extra
);
869 font
->props
[FONT_FORMAT_INDEX
] = XCDR (val
);
871 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
874 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
876 font
->props
[FONT_FILE_INDEX
] = Qnil
;
877 font
->encoding_charset
= -1;
878 font
->repertory_charset
= -1;
879 /* TODO: do we really want the minimum width here, which could be negative? */
880 font
->min_width
= font
->space_width
;
881 font
->ascent
= w32_font
->metrics
.tmAscent
;
882 font
->descent
= w32_font
->metrics
.tmDescent
;
883 font
->height
= font
->ascent
+ font
->descent
;
887 font
->underline_thickness
= metrics
->otmsUnderscoreSize
;
888 font
->underline_position
= -metrics
->otmsUnderscorePosition
;
892 font
->underline_thickness
= 0;
893 font
->underline_position
= -1;
896 /* For temporary compatibility with legacy code that expects the
897 name to be usable in x-list-fonts. Eventually we expect to change
898 x-list-fonts and other places that use fonts so that this can be
899 an fcname or similar. */
900 font
->props
[FONT_NAME_INDEX
] = Ffont_xlfd_name (font_object
, Qnil
);
905 /* Callback function for EnumFontFamiliesEx.
906 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
908 add_font_name_to_list (logical_font
, physical_font
, font_type
, list_object
)
909 ENUMLOGFONTEX
*logical_font
;
910 NEWTEXTMETRICEX
*physical_font
;
914 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
917 /* Skip vertical fonts (intended only for printing) */
918 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
921 family
= font_intern_prop (logical_font
->elfLogFont
.lfFaceName
,
922 strlen (logical_font
->elfLogFont
.lfFaceName
), 1);
923 if (! memq_no_quit (family
, *list
))
924 *list
= Fcons (family
, *list
);
929 static int w32_decode_weight
P_ ((int));
930 static int w32_encode_weight
P_ ((int));
932 /* Convert an enumerated Windows font to an Emacs font entity. */
934 w32_enumfont_pattern_entity (frame
, logical_font
, physical_font
,
935 font_type
, requested_font
, backend
)
937 ENUMLOGFONTEX
*logical_font
;
938 NEWTEXTMETRICEX
*physical_font
;
940 LOGFONT
*requested_font
;
943 Lisp_Object entity
, tem
;
944 LOGFONT
*lf
= (LOGFONT
*) logical_font
;
946 DWORD full_type
= physical_font
->ntmTm
.ntmFlags
;
948 entity
= font_make_entity ();
950 ASET (entity
, FONT_TYPE_INDEX
, backend
);
951 ASET (entity
, FONT_REGISTRY_INDEX
, w32_registry (lf
->lfCharSet
, font_type
));
952 ASET (entity
, FONT_OBJLIST_INDEX
, Qnil
);
954 /* Foundry is difficult to get in readable form on Windows.
955 But Emacs crashes if it is not set, so set it to something more
956 generic. These values make xlfds compatible with Emacs 22. */
957 if (lf
->lfOutPrecision
== OUT_STRING_PRECIS
)
959 else if (lf
->lfOutPrecision
== OUT_STROKE_PRECIS
)
964 ASET (entity
, FONT_FOUNDRY_INDEX
, tem
);
966 /* Save the generic family in the extra info, as it is likely to be
967 useful to users looking for a close match. */
968 generic_type
= physical_font
->ntmTm
.tmPitchAndFamily
& 0xF0;
969 if (generic_type
== FF_DECORATIVE
)
971 else if (generic_type
== FF_MODERN
)
973 else if (generic_type
== FF_ROMAN
)
975 else if (generic_type
== FF_SCRIPT
)
977 else if (generic_type
== FF_SWISS
)
982 ASET (entity
, FONT_ADSTYLE_INDEX
, tem
);
984 if (physical_font
->ntmTm
.tmPitchAndFamily
& 0x01)
985 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_PROPORTIONAL
));
987 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_CHARCELL
));
989 if (requested_font
->lfQuality
!= DEFAULT_QUALITY
)
991 font_put_extra (entity
, QCantialias
,
992 lispy_antialias_type (requested_font
->lfQuality
));
994 ASET (entity
, FONT_FAMILY_INDEX
,
995 font_intern_prop (lf
->lfFaceName
, strlen (lf
->lfFaceName
), 1));
997 FONT_SET_STYLE (entity
, FONT_WEIGHT_INDEX
,
998 make_number (w32_decode_weight (lf
->lfWeight
)));
999 FONT_SET_STYLE (entity
, FONT_SLANT_INDEX
,
1000 make_number (lf
->lfItalic
? 200 : 100));
1001 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1003 FONT_SET_STYLE (entity
, FONT_WIDTH_INDEX
, make_number (100));
1005 if (font_type
& RASTER_FONTTYPE
)
1006 ASET (entity
, FONT_SIZE_INDEX
,
1007 make_number (physical_font
->ntmTm
.tmHeight
1008 + physical_font
->ntmTm
.tmExternalLeading
));
1010 ASET (entity
, FONT_SIZE_INDEX
, make_number (0));
1012 /* Cache unicode codepoints covered by this font, as there is no other way
1013 of getting this information easily. */
1014 if (font_type
& TRUETYPE_FONTTYPE
)
1016 tem
= font_supported_scripts (&physical_font
->ntmFontSig
);
1018 font_put_extra (entity
, QCscript
, tem
);
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. */
1084 /* Codepage Bitfields in FONTSIGNATURE struct. */
1085 #define CSB_JAPANESE (1 << 17)
1086 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1087 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1090 font_matches_spec (type
, font
, spec
, backend
, logfont
)
1092 NEWTEXTMETRICEX
*font
;
1094 Lisp_Object backend
;
1097 Lisp_Object extra
, val
;
1099 /* Check italic. Can't check logfonts, since it is a boolean field,
1100 so there is no difference between "non-italic" and "don't care". */
1102 int slant
= FONT_SLANT_NUMERIC (spec
);
1105 && ((slant
> 150 && !font
->ntmTm
.tmItalic
)
1106 || (slant
<= 150 && font
->ntmTm
.tmItalic
)))
1110 /* Check adstyle against generic family. */
1111 val
= AREF (spec
, FONT_ADSTYLE_INDEX
);
1114 BYTE family
= w32_generic_family (val
);
1115 if (family
!= FF_DONTCARE
1116 && family
!= (font
->ntmTm
.tmPitchAndFamily
& 0xF0))
1121 val
= AREF (spec
, FONT_SPACING_INDEX
);
1124 int spacing
= XINT (val
);
1125 int proportional
= (spacing
< FONT_SPACING_MONO
);
1127 if ((proportional
&& !(font
->ntmTm
.tmPitchAndFamily
& 0x01))
1128 || (!proportional
&& (font
->ntmTm
.tmPitchAndFamily
& 0x01)))
1132 /* Check extra parameters. */
1133 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
1134 CONSP (extra
); extra
= XCDR (extra
))
1136 Lisp_Object extra_entry
;
1137 extra_entry
= XCAR (extra
);
1138 if (CONSP (extra_entry
))
1140 Lisp_Object key
= XCAR (extra_entry
);
1142 val
= XCDR (extra_entry
);
1143 if (EQ (key
, QCscript
) && SYMBOLP (val
))
1145 /* Only truetype fonts will have information about what
1146 scripts they support. This probably means the user
1147 will have to force Emacs to use raster, postscript
1148 or atm fonts for non-ASCII text. */
1149 if (type
& TRUETYPE_FONTTYPE
)
1152 = font_supported_scripts (&font
->ntmFontSig
);
1153 if (! memq_no_quit (val
, support
))
1158 /* Return specific matches, but play it safe. Fonts
1159 that cover more than their charset would suggest
1160 are likely to be truetype or opentype fonts,
1162 if (EQ (val
, Qlatin
))
1164 /* Although every charset but symbol, thai and
1165 arabic contains the basic ASCII set of latin
1166 characters, Emacs expects much more. */
1167 if (font
->ntmTm
.tmCharSet
!= ANSI_CHARSET
)
1170 else if (EQ (val
, Qsymbol
))
1172 if (font
->ntmTm
.tmCharSet
!= SYMBOL_CHARSET
)
1175 else if (EQ (val
, Qcyrillic
))
1177 if (font
->ntmTm
.tmCharSet
!= RUSSIAN_CHARSET
)
1180 else if (EQ (val
, Qgreek
))
1182 if (font
->ntmTm
.tmCharSet
!= GREEK_CHARSET
)
1185 else if (EQ (val
, Qarabic
))
1187 if (font
->ntmTm
.tmCharSet
!= ARABIC_CHARSET
)
1190 else if (EQ (val
, Qhebrew
))
1192 if (font
->ntmTm
.tmCharSet
!= HEBREW_CHARSET
)
1195 else if (EQ (val
, Qthai
))
1197 if (font
->ntmTm
.tmCharSet
!= THAI_CHARSET
)
1200 else if (EQ (val
, Qkana
))
1202 if (font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1205 else if (EQ (val
, Qbopomofo
))
1207 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
)
1210 else if (EQ (val
, Qhangul
))
1212 if (font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1213 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
)
1216 else if (EQ (val
, Qhan
))
1218 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
1219 && font
->ntmTm
.tmCharSet
!= GB2312_CHARSET
1220 && font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1221 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
1222 && font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1226 /* Other scripts unlikely to be handled by non-truetype
1231 else if (EQ (key
, QClang
) && SYMBOLP (val
))
1233 /* Just handle the CJK languages here, as the lang
1234 parameter is used to select a font with appropriate
1235 glyphs in the cjk unified ideographs block. Other fonts
1236 support for a language can be solely determined by
1237 its character coverage. */
1240 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_JAPANESE
))
1243 else if (EQ (val
, Qko
))
1245 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_KOREAN
))
1248 else if (EQ (val
, Qzh
))
1250 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_CHINESE
))
1254 /* Any other language, we don't recognize it. Only the above
1255 currently appear in fontset.el, so it isn't worth
1256 creating a mapping table of codepages/scripts to languages
1257 or opening the font to see if there are any language tags
1258 in it that the W32 API does not expose. Fontset
1259 spec should have a fallback, as some backends do
1260 not recognize language at all. */
1263 else if (EQ (key
, QCotf
) && CONSP (val
))
1265 /* OTF features only supported by the uniscribe backend. */
1266 if (EQ (backend
, Quniscribe
))
1268 if (!uniscribe_check_otf (logfont
, val
))
1280 w32font_coverage_ok (coverage
, charset
)
1281 FONTSIGNATURE
* coverage
;
1284 DWORD subrange1
= coverage
->fsUsb
[1];
1286 #define SUBRANGE1_HAN_MASK 0x08000000
1287 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1288 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1290 if (charset
== GB2312_CHARSET
|| charset
== CHINESEBIG5_CHARSET
)
1292 return (subrange1
& SUBRANGE1_HAN_MASK
) == SUBRANGE1_HAN_MASK
;
1294 else if (charset
== SHIFTJIS_CHARSET
)
1296 return (subrange1
& SUBRANGE1_JAPANESE_MASK
) == SUBRANGE1_JAPANESE_MASK
;
1298 else if (charset
== HANGEUL_CHARSET
)
1300 return (subrange1
& SUBRANGE1_HANGEUL_MASK
) == SUBRANGE1_HANGEUL_MASK
;
1308 check_face_name (font
, full_name
)
1312 char full_iname
[LF_FULLFACESIZE
+1];
1314 /* Just check for names known to cause problems, since the full name
1315 can contain expanded abbreviations, prefixed foundry, postfixed
1316 style, the latter of which sometimes differs from the style indicated
1317 in the shorter name (eg Lt becomes Light or even Extra Light) */
1319 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1320 installed, we run into problems with the Uniscribe backend which tries
1321 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1322 with Arial's characteristics, since that attempt to use Truetype works
1323 some places, but not others. */
1324 if (!xstrcasecmp (font
->lfFaceName
, "helvetica"))
1326 strncpy (full_iname
, full_name
, LF_FULLFACESIZE
);
1327 full_iname
[LF_FULLFACESIZE
] = 0;
1328 _strlwr (full_iname
);
1329 return strstr ("helvetica", full_iname
) != NULL
;
1332 /* Since Times is mapped to Times New Roman, a substring
1333 match is not sufficient to filter out the bogus match. */
1334 else if (!xstrcasecmp (font
->lfFaceName
, "times"))
1335 return xstrcasecmp (full_name
, "times") == 0;
1341 /* Callback function for EnumFontFamiliesEx.
1342 * Checks if a font matches everything we are trying to check agaist,
1343 * and if so, adds it to a list. Both the data we are checking against
1344 * and the list to which the fonts are added are passed in via the
1345 * lparam argument, in the form of a font_callback_data struct. */
1347 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1348 ENUMLOGFONTEX
*logical_font
;
1349 NEWTEXTMETRICEX
*physical_font
;
1353 struct font_callback_data
*match_data
1354 = (struct font_callback_data
*) lParam
;
1355 Lisp_Object backend
= match_data
->opentype_only
? Quniscribe
: Qgdi
;
1357 if ((!match_data
->opentype_only
1358 || (((physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
1359 || (font_type
& TRUETYPE_FONTTYPE
))
1360 /* For the uniscribe backend, only consider fonts that claim
1361 to cover at least some part of Unicode. */
1362 && (physical_font
->ntmFontSig
.fsUsb
[3]
1363 || physical_font
->ntmFontSig
.fsUsb
[2]
1364 || physical_font
->ntmFontSig
.fsUsb
[1]
1365 || (physical_font
->ntmFontSig
.fsUsb
[0] & 0x3fffffff))))
1366 && logfonts_match (&logical_font
->elfLogFont
, &match_data
->pattern
)
1367 && font_matches_spec (font_type
, physical_font
,
1368 match_data
->orig_font_spec
, backend
,
1369 &logical_font
->elfLogFont
)
1370 && w32font_coverage_ok (&physical_font
->ntmFontSig
,
1371 match_data
->pattern
.lfCharSet
)
1372 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1373 We limit this to raster fonts, because the test can catch some
1374 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1375 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1376 therefore get through this test. Since full names can be prefixed
1377 by a foundry, we accept raster fonts if the font name is found
1378 anywhere within the full name. */
1379 && (logical_font
->elfLogFont
.lfOutPrecision
!= OUT_STRING_PRECIS
1380 || strstr (logical_font
->elfFullName
,
1381 logical_font
->elfLogFont
.lfFaceName
))
1382 /* Check for well known substitutions that mess things up in the
1383 presence of Type-1 fonts of the same name. */
1384 && (match_data
->pattern
.lfFaceName
[0]
1385 && check_face_name (logical_font
, logical_font
->elfFullName
)))
1388 = w32_enumfont_pattern_entity (match_data
->frame
, logical_font
,
1389 physical_font
, font_type
,
1390 &match_data
->pattern
,
1394 Lisp_Object spec_charset
= AREF (match_data
->orig_font_spec
,
1395 FONT_REGISTRY_INDEX
);
1397 /* If registry was specified as iso10646-1, only report
1398 ANSI and DEFAULT charsets, as most unicode fonts will
1399 contain one of those plus others. */
1400 if ((EQ (spec_charset
, Qiso10646_1
)
1401 || EQ (spec_charset
, Qunicode_bmp
)
1402 || EQ (spec_charset
, Qunicode_sip
))
1403 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
1404 && logical_font
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
)
1406 /* If registry was specified, but did not map to a windows
1407 charset, only report fonts that have unknown charsets.
1408 This will still report fonts that don't match, but at
1409 least it eliminates known definite mismatches. */
1410 else if (!NILP (spec_charset
)
1411 && !EQ (spec_charset
, Qiso10646_1
)
1412 && !EQ (spec_charset
, Qunicode_bmp
)
1413 && !EQ (spec_charset
, Qunicode_sip
)
1414 && match_data
->pattern
.lfCharSet
== DEFAULT_CHARSET
1415 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
)
1418 /* If registry was specified, ensure it is reported as the same. */
1419 if (!NILP (spec_charset
))
1420 ASET (entity
, FONT_REGISTRY_INDEX
, spec_charset
);
1422 match_data
->list
= Fcons (entity
, match_data
->list
);
1424 /* If no registry specified, duplicate iso8859-1 truetype fonts
1426 if (NILP (spec_charset
)
1427 && font_type
== TRUETYPE_FONTTYPE
1428 && logical_font
->elfLogFont
.lfCharSet
== ANSI_CHARSET
)
1430 Lisp_Object tem
= Fcopy_font_spec (entity
);
1431 ASET (tem
, FONT_REGISTRY_INDEX
, Qiso10646_1
);
1432 match_data
->list
= Fcons (tem
, match_data
->list
);
1439 /* Callback function for EnumFontFamiliesEx.
1440 * Terminates the search once we have a match. */
1442 add_one_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1443 ENUMLOGFONTEX
*logical_font
;
1444 NEWTEXTMETRICEX
*physical_font
;
1448 struct font_callback_data
*match_data
1449 = (struct font_callback_data
*) lParam
;
1450 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
);
1452 /* If we have a font in the list, terminate the search. */
1453 return !NILP (match_data
->list
);
1456 /* Old function to convert from x to w32 charset, from w32fns.c. */
1458 x_to_w32_charset (lpcs
)
1461 Lisp_Object this_entry
, w32_charset
;
1463 int len
= strlen (lpcs
);
1465 /* Support "*-#nnn" format for unknown charsets. */
1466 if (strncmp (lpcs
, "*-#", 3) == 0)
1467 return atoi (lpcs
+ 3);
1469 /* All Windows fonts qualify as unicode. */
1470 if (!strncmp (lpcs
, "iso10646", 8))
1471 return DEFAULT_CHARSET
;
1473 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1474 charset
= alloca (len
+ 1);
1475 strcpy (charset
, lpcs
);
1476 lpcs
= strchr (charset
, '*');
1480 /* Look through w32-charset-info-alist for the character set.
1481 Format of each entry is
1482 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1484 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
1486 if (NILP (this_entry
))
1488 /* At startup, we want iso8859-1 fonts to come up properly. */
1489 if (xstrcasecmp (charset
, "iso8859-1") == 0)
1490 return ANSI_CHARSET
;
1492 return DEFAULT_CHARSET
;
1495 w32_charset
= Fcar (Fcdr (this_entry
));
1497 /* Translate Lisp symbol to number. */
1498 if (EQ (w32_charset
, Qw32_charset_ansi
))
1499 return ANSI_CHARSET
;
1500 if (EQ (w32_charset
, Qw32_charset_symbol
))
1501 return SYMBOL_CHARSET
;
1502 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
1503 return SHIFTJIS_CHARSET
;
1504 if (EQ (w32_charset
, Qw32_charset_hangeul
))
1505 return HANGEUL_CHARSET
;
1506 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
1507 return CHINESEBIG5_CHARSET
;
1508 if (EQ (w32_charset
, Qw32_charset_gb2312
))
1509 return GB2312_CHARSET
;
1510 if (EQ (w32_charset
, Qw32_charset_oem
))
1512 if (EQ (w32_charset
, Qw32_charset_johab
))
1513 return JOHAB_CHARSET
;
1514 if (EQ (w32_charset
, Qw32_charset_easteurope
))
1515 return EASTEUROPE_CHARSET
;
1516 if (EQ (w32_charset
, Qw32_charset_turkish
))
1517 return TURKISH_CHARSET
;
1518 if (EQ (w32_charset
, Qw32_charset_baltic
))
1519 return BALTIC_CHARSET
;
1520 if (EQ (w32_charset
, Qw32_charset_russian
))
1521 return RUSSIAN_CHARSET
;
1522 if (EQ (w32_charset
, Qw32_charset_arabic
))
1523 return ARABIC_CHARSET
;
1524 if (EQ (w32_charset
, Qw32_charset_greek
))
1525 return GREEK_CHARSET
;
1526 if (EQ (w32_charset
, Qw32_charset_hebrew
))
1527 return HEBREW_CHARSET
;
1528 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
1529 return VIETNAMESE_CHARSET
;
1530 if (EQ (w32_charset
, Qw32_charset_thai
))
1531 return THAI_CHARSET
;
1532 if (EQ (w32_charset
, Qw32_charset_mac
))
1535 return DEFAULT_CHARSET
;
1539 /* Convert a Lisp font registry (symbol) to a windows charset. */
1541 registry_to_w32_charset (charset
)
1542 Lisp_Object charset
;
1544 if (EQ (charset
, Qiso10646_1
) || EQ (charset
, Qunicode_bmp
)
1545 || EQ (charset
, Qunicode_sip
))
1546 return DEFAULT_CHARSET
; /* UNICODE_CHARSET not defined in MingW32 */
1547 else if (EQ (charset
, Qiso8859_1
))
1548 return ANSI_CHARSET
;
1549 else if (SYMBOLP (charset
))
1550 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset
)));
1552 return DEFAULT_CHARSET
;
1555 /* Old function to convert from w32 to x charset, from w32fns.c. */
1557 w32_to_x_charset (fncharset
, matching
)
1561 static char buf
[32];
1562 Lisp_Object charset_type
;
1567 /* If fully specified, accept it as it is. Otherwise use a
1569 char *wildcard
= strchr (matching
, '*');
1572 else if (strchr (matching
, '-'))
1575 match_len
= strlen (matching
);
1581 /* Handle startup case of w32-charset-info-alist not
1582 being set up yet. */
1583 if (NILP (Vw32_charset_info_alist
))
1585 charset_type
= Qw32_charset_ansi
;
1587 case DEFAULT_CHARSET
:
1588 charset_type
= Qw32_charset_default
;
1590 case SYMBOL_CHARSET
:
1591 charset_type
= Qw32_charset_symbol
;
1593 case SHIFTJIS_CHARSET
:
1594 charset_type
= Qw32_charset_shiftjis
;
1596 case HANGEUL_CHARSET
:
1597 charset_type
= Qw32_charset_hangeul
;
1599 case GB2312_CHARSET
:
1600 charset_type
= Qw32_charset_gb2312
;
1602 case CHINESEBIG5_CHARSET
:
1603 charset_type
= Qw32_charset_chinesebig5
;
1606 charset_type
= Qw32_charset_oem
;
1608 case EASTEUROPE_CHARSET
:
1609 charset_type
= Qw32_charset_easteurope
;
1611 case TURKISH_CHARSET
:
1612 charset_type
= Qw32_charset_turkish
;
1614 case BALTIC_CHARSET
:
1615 charset_type
= Qw32_charset_baltic
;
1617 case RUSSIAN_CHARSET
:
1618 charset_type
= Qw32_charset_russian
;
1620 case ARABIC_CHARSET
:
1621 charset_type
= Qw32_charset_arabic
;
1624 charset_type
= Qw32_charset_greek
;
1626 case HEBREW_CHARSET
:
1627 charset_type
= Qw32_charset_hebrew
;
1629 case VIETNAMESE_CHARSET
:
1630 charset_type
= Qw32_charset_vietnamese
;
1633 charset_type
= Qw32_charset_thai
;
1636 charset_type
= Qw32_charset_mac
;
1639 charset_type
= Qw32_charset_johab
;
1643 /* Encode numerical value of unknown charset. */
1644 sprintf (buf
, "*-#%u", fncharset
);
1650 char * best_match
= NULL
;
1651 int matching_found
= 0;
1653 /* Look through w32-charset-info-alist for the character set.
1654 Prefer ISO codepages, and prefer lower numbers in the ISO
1655 range. Only return charsets for codepages which are installed.
1657 Format of each entry is
1658 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1660 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
1663 Lisp_Object w32_charset
;
1664 Lisp_Object codepage
;
1666 Lisp_Object this_entry
= XCAR (rest
);
1668 /* Skip invalid entries in alist. */
1669 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
1670 || !CONSP (XCDR (this_entry
))
1671 || !SYMBOLP (XCAR (XCDR (this_entry
))))
1674 x_charset
= SDATA (XCAR (this_entry
));
1675 w32_charset
= XCAR (XCDR (this_entry
));
1676 codepage
= XCDR (XCDR (this_entry
));
1678 /* Look for Same charset and a valid codepage (or non-int
1679 which means ignore). */
1680 if (EQ (w32_charset
, charset_type
)
1681 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
1682 || IsValidCodePage (XINT (codepage
))))
1684 /* If we don't have a match already, then this is the
1688 best_match
= x_charset
;
1689 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
1692 /* If we already found a match for MATCHING, then
1693 only consider other matches. */
1694 else if (matching_found
1695 && strnicmp (x_charset
, matching
, match_len
))
1697 /* If this matches what we want, and the best so far doesn't,
1698 then this is better. */
1699 else if (!matching_found
&& matching
1700 && !strnicmp (x_charset
, matching
, match_len
))
1702 best_match
= x_charset
;
1705 /* If this is fully specified, and the best so far isn't,
1706 then this is better. */
1707 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
1708 /* If this is an ISO codepage, and the best so far isn't,
1709 then this is better, but only if it fully specifies the
1711 || (strnicmp (best_match
, "iso", 3) != 0
1712 && strnicmp (x_charset
, "iso", 3) == 0
1713 && strchr (x_charset
, '-')))
1714 best_match
= x_charset
;
1715 /* If both are ISO8859 codepages, choose the one with the
1716 lowest number in the encoding field. */
1717 else if (strnicmp (best_match
, "iso8859-", 8) == 0
1718 && strnicmp (x_charset
, "iso8859-", 8) == 0)
1720 int best_enc
= atoi (best_match
+ 8);
1721 int this_enc
= atoi (x_charset
+ 8);
1722 if (this_enc
> 0 && this_enc
< best_enc
)
1723 best_match
= x_charset
;
1728 /* If no match, encode the numeric value. */
1731 sprintf (buf
, "*-#%u", fncharset
);
1735 strncpy (buf
, best_match
, 31);
1736 /* If the charset is not fully specified, put -0 on the end. */
1737 if (!strchr (best_match
, '-'))
1739 int pos
= strlen (best_match
);
1740 /* Charset specifiers shouldn't be very long. If it is a made
1741 up one, truncating it should not do any harm since it isn't
1742 recognized anyway. */
1745 strcpy (buf
+ pos
, "-0");
1753 w32_registry (w32_charset
, font_type
)
1759 /* If charset is defaulted, charset is unicode or unknown, depending on
1761 if (w32_charset
== DEFAULT_CHARSET
)
1762 return font_type
== TRUETYPE_FONTTYPE
? Qiso10646_1
: Qunknown
;
1764 charset
= w32_to_x_charset (w32_charset
, NULL
);
1765 return font_intern_prop (charset
, strlen(charset
), 1);
1769 w32_decode_weight (fnweight
)
1772 if (fnweight
>= FW_HEAVY
) return 210;
1773 if (fnweight
>= FW_EXTRABOLD
) return 205;
1774 if (fnweight
>= FW_BOLD
) return 200;
1775 if (fnweight
>= FW_SEMIBOLD
) return 180;
1776 if (fnweight
>= FW_NORMAL
) return 100;
1777 if (fnweight
>= FW_LIGHT
) return 50;
1778 if (fnweight
>= FW_EXTRALIGHT
) return 40;
1779 if (fnweight
> FW_THIN
) return 20;
1784 w32_encode_weight (n
)
1787 if (n
>= 210) return FW_HEAVY
;
1788 if (n
>= 205) return FW_EXTRABOLD
;
1789 if (n
>= 200) return FW_BOLD
;
1790 if (n
>= 180) return FW_SEMIBOLD
;
1791 if (n
>= 100) return FW_NORMAL
;
1792 if (n
>= 50) return FW_LIGHT
;
1793 if (n
>= 40) return FW_EXTRALIGHT
;
1794 if (n
>= 20) return FW_THIN
;
1798 /* Convert a Windows font weight into one of the weights supported
1799 by fontconfig (see font.c:font_parse_fcname). */
1801 w32_to_fc_weight (n
)
1804 if (n
>= FW_EXTRABOLD
) return intern ("black");
1805 if (n
>= FW_BOLD
) return intern ("bold");
1806 if (n
>= FW_SEMIBOLD
) return intern ("demibold");
1807 if (n
>= FW_NORMAL
) return intern ("medium");
1808 return intern ("light");
1811 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1813 fill_in_logfont (f
, logfont
, font_spec
)
1816 Lisp_Object font_spec
;
1818 Lisp_Object tmp
, extra
;
1819 int dpi
= FRAME_W32_DISPLAY_INFO (f
)->resy
;
1821 tmp
= AREF (font_spec
, FONT_DPI_INDEX
);
1826 else if (FLOATP (tmp
))
1828 dpi
= (int) (XFLOAT_DATA (tmp
) + 0.5);
1832 tmp
= AREF (font_spec
, FONT_SIZE_INDEX
);
1834 logfont
->lfHeight
= -1 * XINT (tmp
);
1835 else if (FLOATP (tmp
))
1836 logfont
->lfHeight
= (int) (-1.0 * dpi
* XFLOAT_DATA (tmp
) / 72.27 + 0.5);
1843 tmp
= AREF (font_spec
, FONT_WEIGHT_INDEX
);
1845 logfont
->lfWeight
= w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec
));
1848 tmp
= AREF (font_spec
, FONT_SLANT_INDEX
);
1851 int slant
= FONT_SLANT_NUMERIC (font_spec
);
1852 logfont
->lfItalic
= slant
> 150 ? 1 : 0;
1860 tmp
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1862 logfont
->lfCharSet
= registry_to_w32_charset (tmp
);
1864 logfont
->lfCharSet
= DEFAULT_CHARSET
;
1868 /* Clip Precision */
1871 logfont
->lfQuality
= DEFAULT_QUALITY
;
1873 /* Generic Family and Face Name */
1874 logfont
->lfPitchAndFamily
= FF_DONTCARE
| DEFAULT_PITCH
;
1876 tmp
= AREF (font_spec
, FONT_FAMILY_INDEX
);
1879 logfont
->lfPitchAndFamily
= w32_generic_family (tmp
) | DEFAULT_PITCH
;
1880 if ((logfont
->lfPitchAndFamily
& 0xF0) != FF_DONTCARE
)
1881 ; /* Font name was generic, don't fill in font name. */
1882 /* Font families are interned, but allow for strings also in case of
1884 else if (SYMBOLP (tmp
))
1885 strncpy (logfont
->lfFaceName
, SDATA (SYMBOL_NAME (tmp
)), LF_FACESIZE
);
1888 tmp
= AREF (font_spec
, FONT_ADSTYLE_INDEX
);
1891 /* Override generic family. */
1892 BYTE family
= w32_generic_family (tmp
);
1893 if (family
!= FF_DONTCARE
)
1894 logfont
->lfPitchAndFamily
= family
| DEFAULT_PITCH
;
1898 /* Set pitch based on the spacing property. */
1899 tmp
= AREF (font_spec
, FONT_SPACING_INDEX
);
1902 int spacing
= XINT (tmp
);
1903 if (spacing
< FONT_SPACING_MONO
)
1904 logfont
->lfPitchAndFamily
1905 = logfont
->lfPitchAndFamily
& 0xF0 | VARIABLE_PITCH
;
1907 logfont
->lfPitchAndFamily
1908 = logfont
->lfPitchAndFamily
& 0xF0 | FIXED_PITCH
;
1911 /* Process EXTRA info. */
1912 for (extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
1913 CONSP (extra
); extra
= XCDR (extra
))
1918 Lisp_Object key
, val
;
1919 key
= XCAR (tmp
), val
= XCDR (tmp
);
1920 /* Only use QCscript if charset is not provided, or is unicode
1921 and a single script is specified. This is rather crude,
1922 and is only used to narrow down the fonts returned where
1923 there is a definite match. Some scripts, such as latin, han,
1924 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1926 if (EQ (key
, QCscript
)
1927 && logfont
->lfCharSet
== DEFAULT_CHARSET
1930 if (EQ (val
, Qgreek
))
1931 logfont
->lfCharSet
= GREEK_CHARSET
;
1932 else if (EQ (val
, Qhangul
))
1933 logfont
->lfCharSet
= HANGUL_CHARSET
;
1934 else if (EQ (val
, Qkana
) || EQ (val
, Qkanbun
))
1935 logfont
->lfCharSet
= SHIFTJIS_CHARSET
;
1936 else if (EQ (val
, Qbopomofo
))
1937 logfont
->lfCharSet
= CHINESEBIG5_CHARSET
;
1938 /* GB 18030 supports tibetan, yi, mongolian,
1939 fonts that support it should show up if we ask for
1941 else if (EQ (val
, Qtibetan
) || EQ (val
, Qyi
)
1942 || EQ (val
, Qmongolian
))
1943 logfont
->lfCharSet
= GB2312_CHARSET
;
1944 else if (EQ (val
, Qhebrew
))
1945 logfont
->lfCharSet
= HEBREW_CHARSET
;
1946 else if (EQ (val
, Qarabic
))
1947 logfont
->lfCharSet
= ARABIC_CHARSET
;
1948 else if (EQ (val
, Qthai
))
1949 logfont
->lfCharSet
= THAI_CHARSET
;
1950 else if (EQ (val
, Qsymbol
))
1951 logfont
->lfCharSet
= SYMBOL_CHARSET
;
1953 else if (EQ (key
, QCantialias
) && SYMBOLP (val
))
1955 logfont
->lfQuality
= w32_antialias_type (val
);
1962 list_all_matching_fonts (match_data
)
1963 struct font_callback_data
*match_data
;
1966 Lisp_Object families
= w32font_list_family (match_data
->frame
);
1967 struct frame
*f
= XFRAME (match_data
->frame
);
1969 dc
= get_frame_dc (f
);
1971 while (!NILP (families
))
1973 /* TODO: Use the Unicode versions of the W32 APIs, so we can
1974 handle non-ASCII font names. */
1976 Lisp_Object family
= CAR (families
);
1977 families
= CDR (families
);
1980 else if (SYMBOLP (family
))
1981 name
= SDATA (SYMBOL_NAME (family
));
1985 strncpy (match_data
->pattern
.lfFaceName
, name
, LF_FACESIZE
);
1986 match_data
->pattern
.lfFaceName
[LF_FACESIZE
- 1] = '\0';
1988 EnumFontFamiliesEx (dc
, &match_data
->pattern
,
1989 (FONTENUMPROC
) add_font_entity_to_list
,
1990 (LPARAM
) match_data
, 0);
1993 release_frame_dc (f
, dc
);
1997 lispy_antialias_type (type
)
2004 case NONANTIALIASED_QUALITY
:
2007 case ANTIALIASED_QUALITY
:
2010 case CLEARTYPE_QUALITY
:
2013 case CLEARTYPE_NATURAL_QUALITY
:
2023 /* Convert antialiasing symbols to lfQuality */
2025 w32_antialias_type (type
)
2028 if (EQ (type
, Qnone
))
2029 return NONANTIALIASED_QUALITY
;
2030 else if (EQ (type
, Qstandard
))
2031 return ANTIALIASED_QUALITY
;
2032 else if (EQ (type
, Qsubpixel
))
2033 return CLEARTYPE_QUALITY
;
2034 else if (EQ (type
, Qnatural
))
2035 return CLEARTYPE_NATURAL_QUALITY
;
2037 return DEFAULT_QUALITY
;
2040 /* Return a list of all the scripts that the font supports. */
2042 font_supported_scripts (FONTSIGNATURE
* sig
)
2044 DWORD
* subranges
= sig
->fsUsb
;
2045 Lisp_Object supported
= Qnil
;
2047 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2048 #define SUBRANGE(n,sym) \
2049 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2050 supported = Fcons ((sym), supported)
2052 /* Match multiple subranges. SYM is set if any MASK bit is set in
2053 subranges[0 - 3]. */
2054 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2055 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2056 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2057 supported = Fcons ((sym), supported)
2059 SUBRANGE (0, Qlatin
);
2060 /* The following count as latin too, ASCII should be present in these fonts,
2061 so don't need to mark them separately. */
2062 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2063 SUBRANGE (4, Qphonetic
);
2064 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
2065 SUBRANGE (7, Qgreek
);
2066 SUBRANGE (8, Qcoptic
);
2067 SUBRANGE (9, Qcyrillic
);
2068 SUBRANGE (10, Qarmenian
);
2069 SUBRANGE (11, Qhebrew
);
2070 SUBRANGE (13, Qarabic
);
2071 SUBRANGE (14, Qnko
);
2072 SUBRANGE (15, Qdevanagari
);
2073 SUBRANGE (16, Qbengali
);
2074 SUBRANGE (17, Qgurmukhi
);
2075 SUBRANGE (18, Qgujarati
);
2076 SUBRANGE (19, Qoriya
);
2077 SUBRANGE (20, Qtamil
);
2078 SUBRANGE (21, Qtelugu
);
2079 SUBRANGE (22, Qkannada
);
2080 SUBRANGE (23, Qmalayalam
);
2081 SUBRANGE (24, Qthai
);
2082 SUBRANGE (25, Qlao
);
2083 SUBRANGE (26, Qgeorgian
);
2084 SUBRANGE (27, Qbalinese
);
2085 /* 28: Hangul Jamo. */
2086 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2087 /* 32-47: Symbols (defined below). */
2088 SUBRANGE (48, Qcjk_misc
);
2089 /* Match either 49: katakana or 50: hiragana for kana. */
2090 MASK_ANY (0, 0x00060000, 0, 0, Qkana
);
2091 SUBRANGE (51, Qbopomofo
);
2092 /* 52: Compatibility Jamo */
2093 SUBRANGE (53, Qphags_pa
);
2094 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2095 SUBRANGE (56, Qhangul
);
2096 /* 57: Surrogates. */
2097 SUBRANGE (58, Qphoenician
);
2098 SUBRANGE (59, Qhan
); /* There are others, but this is the main one. */
2099 SUBRANGE (59, Qideographic_description
); /* Windows lumps this in. */
2100 SUBRANGE (59, Qkanbun
); /* And this. */
2101 /* 60: Private use, 61: CJK strokes and compatibility. */
2102 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2103 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2104 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2106 SUBRANGE (70, Qtibetan
);
2107 SUBRANGE (71, Qsyriac
);
2108 SUBRANGE (72, Qthaana
);
2109 SUBRANGE (73, Qsinhala
);
2110 SUBRANGE (74, Qmyanmar
);
2111 SUBRANGE (75, Qethiopic
);
2112 SUBRANGE (76, Qcherokee
);
2113 SUBRANGE (77, Qcanadian_aboriginal
);
2114 SUBRANGE (78, Qogham
);
2115 SUBRANGE (79, Qrunic
);
2116 SUBRANGE (80, Qkhmer
);
2117 SUBRANGE (81, Qmongolian
);
2118 SUBRANGE (82, Qbraille
);
2120 SUBRANGE (84, Qbuhid
);
2121 SUBRANGE (84, Qhanunoo
);
2122 SUBRANGE (84, Qtagalog
);
2123 SUBRANGE (84, Qtagbanwa
);
2124 SUBRANGE (85, Qold_italic
);
2125 SUBRANGE (86, Qgothic
);
2126 SUBRANGE (87, Qdeseret
);
2127 SUBRANGE (88, Qbyzantine_musical_symbol
);
2128 SUBRANGE (88, Qmusical_symbol
); /* Windows doesn't distinguish these. */
2129 SUBRANGE (89, Qmathematical
);
2130 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2131 SUBRANGE (93, Qlimbu
);
2132 SUBRANGE (94, Qtai_le
);
2133 /* 95: New Tai Le */
2134 SUBRANGE (90, Qbuginese
);
2135 SUBRANGE (97, Qglagolitic
);
2136 SUBRANGE (98, Qtifinagh
);
2137 /* 99: Yijing Hexagrams. */
2138 SUBRANGE (100, Qsyloti_nagri
);
2139 SUBRANGE (101, Qlinear_b
);
2140 /* 102: Ancient Greek Numbers. */
2141 SUBRANGE (103, Qugaritic
);
2142 SUBRANGE (104, Qold_persian
);
2143 SUBRANGE (105, Qshavian
);
2144 SUBRANGE (106, Qosmanya
);
2145 SUBRANGE (107, Qcypriot
);
2146 SUBRANGE (108, Qkharoshthi
);
2147 /* 109: Tai Xuan Jing. */
2148 SUBRANGE (110, Qcuneiform
);
2149 /* 111: Counting Rods. */
2151 /* There isn't really a main symbol range, so include symbol if any
2152 relevant range is set. */
2153 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol
);
2155 /* Missing: Tai Viet (U+AA80) and Cham (U+AA00) . */
2162 /* Generate a full name for a Windows font.
2163 The full name is in fcname format, with weight, slant and antialiasing
2164 specified if they are not "normal". */
2166 w32font_full_name (font
, font_obj
, pixel_size
, name
, nbytes
)
2168 Lisp_Object font_obj
;
2173 int len
, height
, outline
;
2175 Lisp_Object antialiasing
, weight
= Qnil
;
2177 len
= strlen (font
->lfFaceName
);
2179 outline
= EQ (AREF (font_obj
, FONT_FOUNDRY_INDEX
), Qoutline
);
2181 /* Represent size of scalable fonts by point size. But use pixelsize for
2182 raster fonts to indicate that they are exactly that size. */
2184 len
+= 11; /* -SIZE */
2189 len
+= 7; /* :italic */
2191 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2193 weight
= w32_to_fc_weight (font
->lfWeight
);
2194 len
+= 1 + SBYTES (SYMBOL_NAME (weight
)); /* :WEIGHT */
2197 antialiasing
= lispy_antialias_type (font
->lfQuality
);
2198 if (! NILP (antialiasing
))
2199 len
+= 11 + SBYTES (SYMBOL_NAME (antialiasing
)); /* :antialias=NAME */
2201 /* Check that the buffer is big enough */
2206 p
+= sprintf (p
, "%s", font
->lfFaceName
);
2208 height
= font
->lfHeight
? eabs (font
->lfHeight
) : pixel_size
;
2214 float pointsize
= height
* 72.0 / one_w32_display_info
.resy
;
2215 /* Round to nearest half point. floor is used, since round is not
2216 supported in MS library. */
2217 pointsize
= floor (pointsize
* 2 + 0.5) / 2;
2218 p
+= sprintf (p
, "-%1.1f", pointsize
);
2221 p
+= sprintf (p
, ":pixelsize=%d", height
);
2224 if (SYMBOLP (weight
) && ! NILP (weight
))
2225 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2228 p
+= sprintf (p
, ":italic");
2230 if (SYMBOLP (antialiasing
) && ! NILP (antialiasing
))
2231 p
+= sprintf (p
, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing
)));
2236 /* Convert a logfont and point size into a fontconfig style font name.
2237 POINTSIZE is in tenths of points.
2238 If SIZE indicates the size of buffer FCNAME, into which the font name
2239 is written. If the buffer is not large enough to contain the name,
2240 the function returns -1, otherwise it returns the number of bytes
2241 written to FCNAME. */
2242 static int logfont_to_fcname(font
, pointsize
, fcname
, size
)
2250 Lisp_Object weight
= Qnil
;
2252 len
= strlen (font
->lfFaceName
) + 2;
2253 height
= pointsize
/ 10;
2254 while (height
/= 10)
2261 len
+= 7; /* :italic */
2262 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2264 weight
= w32_to_fc_weight (font
->lfWeight
);
2265 len
+= SBYTES (SYMBOL_NAME (weight
)) + 1;
2271 p
+= sprintf (p
, "%s-%d", font
->lfFaceName
, pointsize
/ 10);
2273 p
+= sprintf (p
, ".%d", pointsize
% 10);
2275 if (SYMBOLP (weight
) && !NILP (weight
))
2276 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2279 p
+= sprintf (p
, ":italic");
2281 return (p
- fcname
);
2285 compute_metrics (dc
, w32_font
, code
, metrics
)
2287 struct w32font_info
*w32_font
;
2289 struct w32_metric_cache
*metrics
;
2293 unsigned int options
= GGO_METRICS
;
2295 if (w32_font
->glyph_idx
)
2296 options
|= GGO_GLYPH_INDEX
;
2298 bzero (&transform
, sizeof (transform
));
2299 transform
.eM11
.value
= 1;
2300 transform
.eM22
.value
= 1;
2302 if (GetGlyphOutlineW (dc
, code
, options
, &gm
, 0, NULL
, &transform
)
2305 metrics
->lbearing
= gm
.gmptGlyphOrigin
.x
;
2306 metrics
->rbearing
= gm
.gmptGlyphOrigin
.x
+ gm
.gmBlackBoxX
;
2307 metrics
->width
= gm
.gmCellIncX
;
2308 metrics
->status
= W32METRIC_SUCCESS
;
2311 metrics
->status
= W32METRIC_FAIL
;
2315 clear_cached_metrics (w32_font
)
2316 struct w32font_info
*w32_font
;
2319 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
2321 if (w32_font
->cached_metrics
[i
])
2322 bzero (w32_font
->cached_metrics
[i
],
2323 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
2327 DEFUN ("x-select-font", Fx_select_font
, Sx_select_font
, 0, 2, 0,
2328 doc
: /* Read a font name using a W32 font selection dialog.
2329 Return fontconfig style font string corresponding to the selection.
2331 If FRAME is omitted or nil, it defaults to the selected frame.
2332 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2333 in the font selection dialog. */)
2334 (frame
, exclude_proportional
)
2335 Lisp_Object frame
, exclude_proportional
;
2337 FRAME_PTR f
= check_x_frame (frame
);
2345 bzero (&cf
, sizeof (cf
));
2346 bzero (&lf
, sizeof (lf
));
2348 cf
.lStructSize
= sizeof (cf
);
2349 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
2350 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
2352 /* If exclude_proportional is non-nil, limit the selection to
2353 monospaced fonts. */
2354 if (!NILP (exclude_proportional
))
2355 cf
.Flags
|= CF_FIXEDPITCHONLY
;
2359 /* Initialize as much of the font details as we can from the current
2361 hdc
= GetDC (FRAME_W32_WINDOW (f
));
2362 oldobj
= SelectObject (hdc
, FONT_HANDLE (FRAME_FONT (f
)));
2363 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
2364 if (GetTextMetrics (hdc
, &tm
))
2366 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
2367 lf
.lfWeight
= tm
.tmWeight
;
2368 lf
.lfItalic
= tm
.tmItalic
;
2369 lf
.lfUnderline
= tm
.tmUnderlined
;
2370 lf
.lfStrikeOut
= tm
.tmStruckOut
;
2371 lf
.lfCharSet
= tm
.tmCharSet
;
2372 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
2374 SelectObject (hdc
, oldobj
);
2375 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
2377 if (!ChooseFont (&cf
)
2378 || logfont_to_fcname (&lf
, cf
.iPointSize
, buf
, 100) < 0)
2381 return build_string (buf
);
2384 struct font_driver w32font_driver
=
2387 0, /* case insensitive */
2391 w32font_list_family
,
2392 NULL
, /* free_entity */
2395 NULL
, /* prepare_face */
2396 NULL
, /* done_face */
2398 w32font_encode_char
,
2399 w32font_text_extents
,
2401 NULL
, /* get_bitmap */
2402 NULL
, /* free_bitmap */
2403 NULL
, /* get_outline */
2404 NULL
, /* free_outline */
2405 NULL
, /* anchor_point */
2406 NULL
, /* otf_capability */
2407 NULL
, /* otf_drive */
2408 NULL
, /* start_for_frame */
2409 NULL
, /* end_for_frame */
2414 /* Initialize state that does not change between invocations. This is only
2415 called when Emacs is dumped. */
2419 DEFSYM (Qgdi
, "gdi");
2420 DEFSYM (Quniscribe
, "uniscribe");
2421 DEFSYM (QCformat
, ":format");
2423 /* Generic font families. */
2424 DEFSYM (Qmonospace
, "monospace");
2425 DEFSYM (Qserif
, "serif");
2426 DEFSYM (Qsansserif
, "sansserif");
2427 DEFSYM (Qscript
, "script");
2428 DEFSYM (Qdecorative
, "decorative");
2430 DEFSYM (Qsans_serif
, "sans_serif");
2431 DEFSYM (Qsans
, "sans");
2432 DEFSYM (Qmono
, "mono");
2434 /* Fake foundries. */
2435 DEFSYM (Qraster
, "raster");
2436 DEFSYM (Qoutline
, "outline");
2437 DEFSYM (Qunknown
, "unknown");
2440 DEFSYM (Qstandard
, "standard");
2441 DEFSYM (Qsubpixel
, "subpixel");
2442 DEFSYM (Qnatural
, "natural");
2450 DEFSYM (Qlatin
, "latin");
2451 DEFSYM (Qgreek
, "greek");
2452 DEFSYM (Qcoptic
, "coptic");
2453 DEFSYM (Qcyrillic
, "cyrillic");
2454 DEFSYM (Qarmenian
, "armenian");
2455 DEFSYM (Qhebrew
, "hebrew");
2456 DEFSYM (Qarabic
, "arabic");
2457 DEFSYM (Qsyriac
, "syriac");
2458 DEFSYM (Qnko
, "nko");
2459 DEFSYM (Qthaana
, "thaana");
2460 DEFSYM (Qdevanagari
, "devanagari");
2461 DEFSYM (Qbengali
, "bengali");
2462 DEFSYM (Qgurmukhi
, "gurmukhi");
2463 DEFSYM (Qgujarati
, "gujarati");
2464 DEFSYM (Qoriya
, "oriya");
2465 DEFSYM (Qtamil
, "tamil");
2466 DEFSYM (Qtelugu
, "telugu");
2467 DEFSYM (Qkannada
, "kannada");
2468 DEFSYM (Qmalayalam
, "malayalam");
2469 DEFSYM (Qsinhala
, "sinhala");
2470 DEFSYM (Qthai
, "thai");
2471 DEFSYM (Qlao
, "lao");
2472 DEFSYM (Qtibetan
, "tibetan");
2473 DEFSYM (Qmyanmar
, "myanmar");
2474 DEFSYM (Qgeorgian
, "georgian");
2475 DEFSYM (Qhangul
, "hangul");
2476 DEFSYM (Qethiopic
, "ethiopic");
2477 DEFSYM (Qcherokee
, "cherokee");
2478 DEFSYM (Qcanadian_aboriginal
, "canadian-aboriginal");
2479 DEFSYM (Qogham
, "ogham");
2480 DEFSYM (Qrunic
, "runic");
2481 DEFSYM (Qkhmer
, "khmer");
2482 DEFSYM (Qmongolian
, "mongolian");
2483 DEFSYM (Qsymbol
, "symbol");
2484 DEFSYM (Qbraille
, "braille");
2485 DEFSYM (Qhan
, "han");
2486 DEFSYM (Qideographic_description
, "ideographic-description");
2487 DEFSYM (Qcjk_misc
, "cjk-misc");
2488 DEFSYM (Qkana
, "kana");
2489 DEFSYM (Qbopomofo
, "bopomofo");
2490 DEFSYM (Qkanbun
, "kanbun");
2492 DEFSYM (Qbyzantine_musical_symbol
, "byzantine-musical-symbol");
2493 DEFSYM (Qmusical_symbol
, "musical-symbol");
2494 DEFSYM (Qmathematical
, "mathematical");
2495 DEFSYM (Qphonetic
, "phonetic");
2496 DEFSYM (Qbalinese
, "balinese");
2497 DEFSYM (Qbuginese
, "buginese");
2498 DEFSYM (Qbuhid
, "buhid");
2499 DEFSYM (Qcuneiform
, "cuneiform");
2500 DEFSYM (Qcypriot
, "cypriot");
2501 DEFSYM (Qdeseret
, "deseret");
2502 DEFSYM (Qglagolitic
, "glagolitic");
2503 DEFSYM (Qgothic
, "gothic");
2504 DEFSYM (Qhanunoo
, "hanunoo");
2505 DEFSYM (Qkharoshthi
, "kharoshthi");
2506 DEFSYM (Qlimbu
, "limbu");
2507 DEFSYM (Qlinear_b
, "linear_b");
2508 DEFSYM (Qold_italic
, "old_italic");
2509 DEFSYM (Qold_persian
, "old_persian");
2510 DEFSYM (Qosmanya
, "osmanya");
2511 DEFSYM (Qphags_pa
, "phags-pa");
2512 DEFSYM (Qphoenician
, "phoenician");
2513 DEFSYM (Qshavian
, "shavian");
2514 DEFSYM (Qsyloti_nagri
, "syloti_nagri");
2515 DEFSYM (Qtagalog
, "tagalog");
2516 DEFSYM (Qtagbanwa
, "tagbanwa");
2517 DEFSYM (Qtai_le
, "tai_le");
2518 DEFSYM (Qtifinagh
, "tifinagh");
2519 DEFSYM (Qugaritic
, "ugaritic");
2521 /* W32 font encodings. */
2522 DEFVAR_LISP ("w32-charset-info-alist",
2523 &Vw32_charset_info_alist
,
2524 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
2525 Each entry should be of the form:
2527 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2529 where CHARSET_NAME is a string used in font names to identify the charset,
2530 WINDOWS_CHARSET is a symbol that can be one of:
2532 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2533 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2534 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2535 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2536 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2537 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2540 CODEPAGE should be an integer specifying the codepage that should be used
2541 to display the character set, t to do no translation and output as Unicode,
2542 or nil to do no translation and output as 8 bit (or multibyte on far-east
2543 versions of Windows) characters. */);
2544 Vw32_charset_info_alist
= Qnil
;
2546 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
2547 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
2548 DEFSYM (Qw32_charset_default
, "w32-charset-default");
2549 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
2550 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
2551 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
2552 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
2553 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
2554 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
2555 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
2556 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
2557 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
2558 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
2559 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
2560 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
2561 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
2562 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
2563 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
2564 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
2566 defsubr (&Sx_select_font
);
2568 w32font_driver
.type
= Qgdi
;
2569 register_font_driver (&w32font_driver
, NULL
);
2572 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2573 (do not change this comment) */