1 /* Font backend for the Microsoft W32 API.
2 Copyright (C) 2007, 2008, 2009 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"
36 /* Cleartype available on Windows XP, cleartype_natural from XP SP1.
37 The latter does not try to fit cleartype smoothed fonts into the
38 same bounding box as the non-antialiased version of the font.
40 #ifndef CLEARTYPE_QUALITY
41 #define CLEARTYPE_QUALITY 5
43 #ifndef CLEARTYPE_NATURAL_QUALITY
44 #define CLEARTYPE_NATURAL_QUALITY 6
47 /* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
49 #ifndef VIETNAMESE_CHARSET
50 #define VIETNAMESE_CHARSET 163
53 #define JOHAB_CHARSET 130
56 extern struct font_driver w32font_driver
;
59 Lisp_Object Quniscribe
;
60 static Lisp_Object QCformat
;
61 static Lisp_Object Qmonospace
, Qsansserif
, Qmono
, Qsans
, Qsans_serif
;
62 static Lisp_Object Qserif
, Qscript
, Qdecorative
;
63 static Lisp_Object Qraster
, Qoutline
, Qunknown
;
66 extern Lisp_Object QCantialias
, QCotf
, QClang
; /* defined in font.c */
67 extern Lisp_Object Qnone
; /* reuse from w32fns.c */
68 static Lisp_Object Qstandard
, Qsubpixel
, Qnatural
;
71 static Lisp_Object Qja
, Qko
, Qzh
;
74 static Lisp_Object Qlatin
, Qgreek
, Qcoptic
, Qcyrillic
, Qarmenian
, Qhebrew
;
75 static Lisp_Object Qarabic
, Qsyriac
, Qnko
, Qthaana
, Qdevanagari
, Qbengali
;
76 static Lisp_Object Qgurmukhi
, Qgujarati
, Qoriya
, Qtamil
, Qtelugu
;
77 static Lisp_Object Qkannada
, Qmalayalam
, Qsinhala
, Qthai
, Qlao
;
78 static Lisp_Object Qtibetan
, Qmyanmar
, Qgeorgian
, Qhangul
, Qethiopic
;
79 static Lisp_Object Qcherokee
, Qcanadian_aboriginal
, Qogham
, Qrunic
;
80 static Lisp_Object Qkhmer
, Qmongolian
, Qsymbol
, Qbraille
, Qhan
;
81 static Lisp_Object Qideographic_description
, Qcjk_misc
, Qkana
, Qbopomofo
;
82 static Lisp_Object Qkanbun
, Qyi
, Qbyzantine_musical_symbol
;
83 static Lisp_Object Qmusical_symbol
, Qmathematical
, Qcham
, Qphonetic
;
84 /* Not defined in characters.el, but referenced in fontset.el. */
85 static Lisp_Object Qbalinese
, Qbuginese
, Qbuhid
, Qcuneiform
, Qcypriot
;
86 static Lisp_Object Qdeseret
, Qglagolitic
, Qgothic
, Qhanunoo
, Qkharoshthi
;
87 static Lisp_Object Qlimbu
, Qlinear_b
, Qold_italic
, Qold_persian
, Qosmanya
;
88 static Lisp_Object Qphags_pa
, Qphoenician
, Qshavian
, Qsyloti_nagri
;
89 static Lisp_Object Qtagalog
, Qtagbanwa
, Qtai_le
, Qtifinagh
, Qugaritic
;
91 /* W32 charsets: for use in Vw32_charset_info_alist. */
92 static Lisp_Object Qw32_charset_ansi
, Qw32_charset_default
;
93 static Lisp_Object Qw32_charset_symbol
, Qw32_charset_shiftjis
;
94 static Lisp_Object Qw32_charset_hangeul
, Qw32_charset_gb2312
;
95 static Lisp_Object Qw32_charset_chinesebig5
, Qw32_charset_oem
;
96 static Lisp_Object Qw32_charset_easteurope
, Qw32_charset_turkish
;
97 static Lisp_Object Qw32_charset_baltic
, Qw32_charset_russian
;
98 static Lisp_Object Qw32_charset_arabic
, Qw32_charset_greek
;
99 static Lisp_Object Qw32_charset_hebrew
, Qw32_charset_vietnamese
;
100 static Lisp_Object Qw32_charset_thai
, Qw32_charset_johab
, Qw32_charset_mac
;
102 /* Associative list linking character set strings to Windows codepages. */
103 static Lisp_Object Vw32_charset_info_alist
;
105 /* Font spacing symbols - defined in font.c. */
106 extern Lisp_Object Qc
, Qp
, Qm
;
108 static void fill_in_logfont
P_ ((FRAME_PTR
, LOGFONT
*, Lisp_Object
));
110 static BYTE w32_antialias_type
P_ ((Lisp_Object
));
111 static Lisp_Object lispy_antialias_type
P_ ((BYTE
));
113 static Lisp_Object font_supported_scripts
P_ ((FONTSIGNATURE
*));
114 static int w32font_full_name
P_ ((LOGFONT
*, Lisp_Object
, int, char *, int));
115 static void compute_metrics
P_ ((HDC
, struct w32font_info
*, unsigned int,
116 struct w32_metric_cache
*));
117 static void clear_cached_metrics
P_ ((struct w32font_info
*));
119 static Lisp_Object w32_registry
P_ ((LONG
, DWORD
));
121 /* EnumFontFamiliesEx callbacks. */
122 static int CALLBACK add_font_entity_to_list
P_ ((ENUMLOGFONTEX
*,
125 static int CALLBACK add_one_font_entity_to_list
P_ ((ENUMLOGFONTEX
*,
128 static int CALLBACK add_font_name_to_list
P_ ((ENUMLOGFONTEX
*,
132 /* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
133 of what we really want. */
134 struct font_callback_data
136 /* The logfont we are matching against. EnumFontFamiliesEx only matches
137 face name and charset, so we need to manually match everything else
138 in the callback function. */
140 /* The original font spec or entity. */
141 Lisp_Object orig_font_spec
;
142 /* The frame the font is being loaded on. */
144 /* The list to add matches to. */
146 /* Whether to match only opentype fonts. */
150 /* Handles the problem that EnumFontFamiliesEx will not return all
151 style variations if the font name is not specified. */
152 static void list_all_matching_fonts
P_ ((struct font_callback_data
*));
156 memq_no_quit (elt
, list
)
157 Lisp_Object elt
, list
;
159 while (CONSP (list
) && ! EQ (XCAR (list
), elt
))
161 return (CONSP (list
));
165 intern_font_name (string
)
168 Lisp_Object obarray
, tem
, str
;
171 str
= DECODE_SYSTEM (build_string (string
));
174 /* The following code is copied from the function intern (in lread.c). */
176 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
177 obarray
= check_obarray (obarray
);
178 tem
= oblookup (obarray
, SDATA (str
), len
, len
);
181 return Fintern (str
, obarray
);
184 /* w32 implementation of get_cache for font backend.
185 Return a cache of font-entities on FRAME. The cache must be a
186 cons whose cdr part is the actual cache area. */
188 w32font_get_cache (f
)
191 struct w32_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
193 return (dpyinfo
->name_list_element
);
196 /* w32 implementation of list for font backend.
197 List fonts exactly matching with FONT_SPEC on FRAME. The value
198 is a vector of font-entities. This is the sole API that
199 allocates font-entities. */
201 w32font_list (frame
, font_spec
)
202 Lisp_Object frame
, font_spec
;
204 Lisp_Object fonts
= w32font_list_internal (frame
, font_spec
, 0);
205 font_add_log ("w32font-list", font_spec
, fonts
);
209 /* w32 implementation of match for font backend.
210 Return a font entity most closely matching with FONT_SPEC on
211 FRAME. The closeness is detemined by the font backend, thus
212 `face-font-selection-order' is ignored here. */
214 w32font_match (frame
, font_spec
)
215 Lisp_Object frame
, font_spec
;
217 Lisp_Object entity
= w32font_match_internal (frame
, font_spec
, 0);
218 font_add_log ("w32font-match", font_spec
, entity
);
222 /* w32 implementation of list_family for font backend.
223 List available families. The value is a list of family names
226 w32font_list_family (frame
)
229 Lisp_Object list
= Qnil
;
230 LOGFONT font_match_pattern
;
232 FRAME_PTR f
= XFRAME (frame
);
234 bzero (&font_match_pattern
, sizeof (font_match_pattern
));
235 font_match_pattern
.lfCharSet
= DEFAULT_CHARSET
;
237 dc
= get_frame_dc (f
);
239 EnumFontFamiliesEx (dc
, &font_match_pattern
,
240 (FONTENUMPROC
) add_font_name_to_list
,
242 release_frame_dc (f
, dc
);
247 /* w32 implementation of open for font backend.
248 Open a font specified by FONT_ENTITY on frame F.
249 If the font is scalable, open it with PIXEL_SIZE. */
251 w32font_open (f
, font_entity
, pixel_size
)
253 Lisp_Object font_entity
;
256 Lisp_Object font_object
257 = font_make_object (VECSIZE (struct w32font_info
),
258 font_entity
, pixel_size
);
259 struct w32font_info
*w32_font
260 = (struct w32font_info
*) XFONT_OBJECT (font_object
);
262 ASET (font_object
, FONT_TYPE_INDEX
, Qgdi
);
264 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
269 /* GDI backend does not use glyph indices. */
270 w32_font
->glyph_idx
= 0;
275 /* w32 implementation of close for font_backend.
276 Close FONT on frame F. */
278 w32font_close (f
, font
)
283 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
285 /* Delete the GDI font object. */
286 DeleteObject (w32_font
->hfont
);
288 /* Free all the cached metrics. */
289 if (w32_font
->cached_metrics
)
291 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
293 if (w32_font
->cached_metrics
[i
])
294 xfree (w32_font
->cached_metrics
[i
]);
296 xfree (w32_font
->cached_metrics
);
297 w32_font
->cached_metrics
= NULL
;
301 /* w32 implementation of has_char for font backend.
303 If FONT_ENTITY has a glyph for character C (Unicode code point),
304 return 1. If not, return 0. If a font must be opened to check
307 w32font_has_char (entity
, c
)
311 /* We can't be certain about which characters a font will support until
312 we open it. Checking the scripts that the font supports turns out
313 to not be reliable. */
317 Lisp_Object supported_scripts
, extra
, script
;
320 extra
= AREF (entity
, FONT_EXTRA_INDEX
);
324 supported_scripts
= assq_no_quit (QCscript
, extra
);
325 /* If font doesn't claim to support any scripts, then we can't be certain
327 if (!CONSP (supported_scripts
))
330 supported_scripts
= XCDR (supported_scripts
);
332 script
= CHAR_TABLE_REF (Vchar_script_table
, c
);
334 /* If we don't know what script the character is from, then we can't be
335 certain until we open it. Also if the font claims support for the script
336 the character is from, it may only have partial coverage, so we still
337 can't be certain until we open the font. */
338 if (NILP (script
) || memq_no_quit (script
, supported_scripts
))
341 /* Font reports what scripts it supports, and none of them are the script
342 the character is from. But we still can't be certain, as some fonts
343 will contain some/most/all of the characters in that script without
344 claiming support for it. */
349 /* w32 implementation of encode_char for font backend.
350 Return a glyph code of FONT for characer C (Unicode code point).
351 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
353 For speed, the gdi backend uses unicode (Emacs calls encode_char
354 far too often for it to be efficient). But we still need to detect
355 which characters are not supported by the font.
358 w32font_encode_char (font
, c
)
362 struct w32font_info
* w32_font
= (struct w32font_info
*)font
;
364 if (c
< w32_font
->metrics
.tmFirstChar
365 || c
> w32_font
->metrics
.tmLastChar
)
366 return FONT_INVALID_CODE
;
371 /* w32 implementation of text_extents for font backend.
372 Perform the size computation of glyphs of FONT and fillin members
373 of METRICS. The glyphs are specified by their glyph codes in
374 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
375 case just return the overall width. */
377 w32font_text_extents (font
, code
, nglyphs
, metrics
)
381 struct font_metrics
*metrics
;
384 HFONT old_font
= NULL
;
391 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
395 bzero (metrics
, sizeof (struct font_metrics
));
396 metrics
->ascent
= font
->ascent
;
397 metrics
->descent
= font
->descent
;
399 for (i
= 0; i
< nglyphs
; i
++)
401 struct w32_metric_cache
*char_metric
;
402 int block
= *(code
+ i
) / CACHE_BLOCKSIZE
;
403 int pos_in_block
= *(code
+ i
) % CACHE_BLOCKSIZE
;
405 if (block
>= w32_font
->n_cache_blocks
)
407 if (!w32_font
->cached_metrics
)
408 w32_font
->cached_metrics
409 = xmalloc ((block
+ 1)
410 * sizeof (struct w32_metric_cache
*));
412 w32_font
->cached_metrics
413 = xrealloc (w32_font
->cached_metrics
,
415 * sizeof (struct w32_metric_cache
*));
416 bzero (w32_font
->cached_metrics
+ w32_font
->n_cache_blocks
,
417 ((block
+ 1 - w32_font
->n_cache_blocks
)
418 * sizeof (struct w32_metric_cache
*)));
419 w32_font
->n_cache_blocks
= block
+ 1;
422 if (!w32_font
->cached_metrics
[block
])
424 w32_font
->cached_metrics
[block
]
425 = xmalloc (CACHE_BLOCKSIZE
* sizeof (struct w32_metric_cache
));
426 bzero (w32_font
->cached_metrics
[block
],
427 CACHE_BLOCKSIZE
* sizeof (struct w32_metric_cache
));
430 char_metric
= w32_font
->cached_metrics
[block
] + pos_in_block
;
432 if (char_metric
->status
== W32METRIC_NO_ATTEMPT
)
436 /* TODO: Frames can come and go, and their fonts
437 outlive them. So we can't cache the frame in the
438 font structure. Use selected_frame until the API
439 is updated to pass in a frame. */
440 f
= XFRAME (selected_frame
);
442 dc
= get_frame_dc (f
);
443 old_font
= SelectObject (dc
, w32_font
->hfont
);
445 compute_metrics (dc
, w32_font
, *(code
+ i
), char_metric
);
448 if (char_metric
->status
== W32METRIC_SUCCESS
)
450 metrics
->lbearing
= min (metrics
->lbearing
,
451 metrics
->width
+ char_metric
->lbearing
);
452 metrics
->rbearing
= max (metrics
->rbearing
,
453 metrics
->width
+ char_metric
->rbearing
);
454 metrics
->width
+= char_metric
->width
;
457 /* If we couldn't get metrics for a char,
458 use alternative method. */
461 /* If we got through everything, return. */
466 /* Restore state and release DC. */
467 SelectObject (dc
, old_font
);
468 release_frame_dc (f
, dc
);
471 return metrics
->width
;
475 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
476 fallback on other methods that will at least give some of the metric
479 /* Make array big enough to hold surrogates. */
480 wcode
= alloca (nglyphs
* sizeof (WORD
) * 2);
481 for (i
= 0; i
< nglyphs
; i
++)
483 if (code
[i
] < 0x10000)
487 DWORD surrogate
= code
[i
] - 0x10000;
489 /* High surrogate: U+D800 - U+DBFF. */
490 wcode
[i
++] = 0xD800 + ((surrogate
>> 10) & 0x03FF);
491 /* Low surrogate: U+DC00 - U+DFFF. */
492 wcode
[i
] = 0xDC00 + (surrogate
& 0x03FF);
493 /* An extra glyph. wcode is already double the size of code to
501 /* TODO: Frames can come and go, and their fonts outlive
502 them. So we can't cache the frame in the font structure. Use
503 selected_frame until the API is updated to pass in a
505 f
= XFRAME (selected_frame
);
507 dc
= get_frame_dc (f
);
508 old_font
= SelectObject (dc
, w32_font
->hfont
);
511 if (GetTextExtentPoint32W (dc
, wcode
, nglyphs
, &size
))
513 total_width
= size
.cx
;
516 /* On 95/98/ME, only some unicode functions are available, so fallback
517 on doing a dummy draw to find the total width. */
521 rect
.top
= 0; rect
.bottom
= font
->height
; rect
.left
= 0; rect
.right
= 1;
522 DrawTextW (dc
, wcode
, nglyphs
, &rect
,
523 DT_CALCRECT
| DT_NOPREFIX
| DT_SINGLELINE
);
524 total_width
= rect
.right
;
527 /* Give our best estimate of the metrics, based on what we know. */
530 metrics
->width
= total_width
- w32_font
->metrics
.tmOverhang
;
531 metrics
->lbearing
= 0;
532 metrics
->rbearing
= total_width
;
535 /* Restore state and release DC. */
536 SelectObject (dc
, old_font
);
537 release_frame_dc (f
, dc
);
542 /* w32 implementation of draw for font backend.
544 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
545 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
546 is nonzero, fill the background in advance. It is assured that
547 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
549 TODO: Currently this assumes that the colors and fonts are already
550 set in the DC. This seems to be true now, but maybe only due to
551 the old font code setting it up. It may be safer to resolve faces
552 and fonts in here and set them explicitly
556 w32font_draw (s
, from
, to
, x
, y
, with_background
)
557 struct glyph_string
*s
;
558 int from
, to
, x
, y
, with_background
;
561 HRGN orig_clip
= NULL
;
562 struct w32font_info
*w32font
= (struct w32font_info
*) s
->font
;
564 options
= w32font
->glyph_idx
;
566 if (s
->num_clips
> 0)
568 HRGN new_clip
= CreateRectRgnIndirect (s
->clip
);
570 /* Save clip region for later restoration. */
571 orig_clip
= CreateRectRgn (0, 0, 0, 0);
572 if (!GetClipRgn(s
->hdc
, orig_clip
))
574 DeleteObject (orig_clip
);
578 if (s
->num_clips
> 1)
580 HRGN clip2
= CreateRectRgnIndirect (s
->clip
+ 1);
582 CombineRgn (new_clip
, new_clip
, clip2
, RGN_OR
);
583 DeleteObject (clip2
);
586 SelectClipRgn (s
->hdc
, new_clip
);
587 DeleteObject (new_clip
);
590 /* Using OPAQUE background mode can clear more background than expected
591 when Cleartype is used. Draw the background manually to avoid this. */
592 SetBkMode (s
->hdc
, TRANSPARENT
);
597 struct font
*font
= s
->font
;
599 brush
= CreateSolidBrush (s
->gc
->background
);
601 rect
.top
= y
- font
->ascent
;
602 rect
.right
= x
+ s
->width
;
603 rect
.bottom
= y
+ font
->descent
;
604 FillRect (s
->hdc
, &rect
, brush
);
605 DeleteObject (brush
);
610 int len
= to
- from
, i
;
612 for (i
= 0; i
< len
; i
++)
613 ExtTextOutW (s
->hdc
, x
+ i
, y
, options
, NULL
,
614 s
->char2b
+ from
+ i
, 1, NULL
);
617 ExtTextOutW (s
->hdc
, x
, y
, options
, NULL
, s
->char2b
+ from
, to
- from
, NULL
);
619 /* Restore clip region. */
620 if (s
->num_clips
> 0)
621 SelectClipRgn (s
->hdc
, orig_clip
);
624 DeleteObject (orig_clip
);
627 /* w32 implementation of free_entity for font backend.
628 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
629 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
631 w32font_free_entity (Lisp_Object entity);
634 /* w32 implementation of prepare_face for font backend.
635 Optional (if FACE->extra is not used).
636 Prepare FACE for displaying characters by FONT on frame F by
637 storing some data in FACE->extra. If successful, return 0.
638 Otherwise, return -1.
640 w32font_prepare_face (FRAME_PTR f, struct face *face);
642 /* w32 implementation of done_face for font backend.
644 Done FACE for displaying characters by FACE->font on frame F.
646 w32font_done_face (FRAME_PTR f, struct face *face); */
648 /* w32 implementation of get_bitmap for font backend.
650 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
651 intended that this method is called from the other font-driver
654 w32font_get_bitmap (struct font *font, unsigned code,
655 struct font_bitmap *bitmap, int bits_per_pixel);
657 /* w32 implementation of free_bitmap for font backend.
659 Free bitmap data in BITMAP.
661 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
663 /* w32 implementation of get_outline for font backend.
665 Return an outline data for glyph-code CODE of FONT. The format
666 of the outline data depends on the font-driver.
668 w32font_get_outline (struct font *font, unsigned code);
670 /* w32 implementation of free_outline for font backend.
672 Free OUTLINE (that is obtained by the above method).
674 w32font_free_outline (struct font *font, void *outline);
676 /* w32 implementation of anchor_point for font backend.
678 Get coordinates of the INDEXth anchor point of the glyph whose
679 code is CODE. Store the coordinates in *X and *Y. Return 0 if
680 the operations was successfull. Otherwise return -1.
682 w32font_anchor_point (struct font *font, unsigned code,
683 int index, int *x, int *y);
685 /* w32 implementation of otf_capability for font backend.
687 Return a list describing which scripts/languages FONT
688 supports by which GSUB/GPOS features of OpenType tables.
690 w32font_otf_capability (struct font *font);
692 /* w32 implementation of otf_drive for font backend.
694 Apply FONT's OTF-FEATURES to the glyph string.
696 FEATURES specifies which OTF features to apply in this format:
697 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
698 See the documentation of `font-drive-otf' for the detail.
700 This method applies the specified features to the codes in the
701 elements of GSTRING-IN (between FROMth and TOth). The output
702 codes are stored in GSTRING-OUT at the IDXth element and the
705 Return the number of output codes. If none of the features are
706 applicable to the input data, return 0. If GSTRING-OUT is too
709 w32font_otf_drive (struct font *font, Lisp_Object features,
710 Lisp_Object gstring_in, int from, int to,
711 Lisp_Object gstring_out, int idx,
712 int alternate_subst);
715 /* Internal implementation of w32font_list.
716 Additional parameter opentype_only restricts the returned fonts to
717 opentype fonts, which can be used with the Uniscribe backend. */
719 w32font_list_internal (frame
, font_spec
, opentype_only
)
720 Lisp_Object frame
, font_spec
;
723 struct font_callback_data match_data
;
725 FRAME_PTR f
= XFRAME (frame
);
727 match_data
.orig_font_spec
= font_spec
;
728 match_data
.list
= Qnil
;
729 match_data
.frame
= frame
;
731 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
732 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
734 match_data
.opentype_only
= opentype_only
;
736 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
738 if (match_data
.pattern
.lfFaceName
[0] == '\0')
740 /* EnumFontFamiliesEx does not take other fields into account if
741 font name is blank, so need to use two passes. */
742 list_all_matching_fonts (&match_data
);
746 dc
= get_frame_dc (f
);
748 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
749 (FONTENUMPROC
) add_font_entity_to_list
,
750 (LPARAM
) &match_data
, 0);
751 release_frame_dc (f
, dc
);
754 return NILP (match_data
.list
) ? Qnil
: match_data
.list
;
757 /* Internal implementation of w32font_match.
758 Additional parameter opentype_only restricts the returned fonts to
759 opentype fonts, which can be used with the Uniscribe backend. */
761 w32font_match_internal (frame
, font_spec
, opentype_only
)
762 Lisp_Object frame
, font_spec
;
765 struct font_callback_data match_data
;
767 FRAME_PTR f
= XFRAME (frame
);
769 match_data
.orig_font_spec
= font_spec
;
770 match_data
.frame
= frame
;
771 match_data
.list
= Qnil
;
773 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
774 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
776 match_data
.opentype_only
= opentype_only
;
778 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
780 dc
= get_frame_dc (f
);
782 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
783 (FONTENUMPROC
) add_one_font_entity_to_list
,
784 (LPARAM
) &match_data
, 0);
785 release_frame_dc (f
, dc
);
787 return NILP (match_data
.list
) ? Qnil
: XCAR (match_data
.list
);
791 w32font_open_internal (f
, font_entity
, pixel_size
, font_object
)
793 Lisp_Object font_entity
;
795 Lisp_Object font_object
;
800 HFONT hfont
, old_font
;
801 Lisp_Object val
, extra
;
802 struct w32font_info
*w32_font
;
804 OUTLINETEXTMETRICW
* metrics
= NULL
;
806 w32_font
= (struct w32font_info
*) XFONT_OBJECT (font_object
);
807 font
= (struct font
*) w32_font
;
812 bzero (&logfont
, sizeof (logfont
));
813 fill_in_logfont (f
, &logfont
, font_entity
);
815 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
816 limitations in bitmap fonts. */
817 val
= AREF (font_entity
, FONT_FOUNDRY_INDEX
);
818 if (!EQ (val
, Qraster
))
819 logfont
.lfOutPrecision
= OUT_TT_PRECIS
;
821 size
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
825 logfont
.lfHeight
= -size
;
826 hfont
= CreateFontIndirect (&logfont
);
831 /* Get the metrics for this font. */
832 dc
= get_frame_dc (f
);
833 old_font
= SelectObject (dc
, hfont
);
835 /* Try getting the outline metrics (only works for truetype fonts). */
836 len
= GetOutlineTextMetricsW (dc
, 0, NULL
);
839 metrics
= (OUTLINETEXTMETRICW
*) alloca (len
);
840 if (GetOutlineTextMetricsW (dc
, len
, metrics
))
841 bcopy (&metrics
->otmTextMetrics
, &w32_font
->metrics
,
842 sizeof (TEXTMETRICW
));
848 GetTextMetricsW (dc
, &w32_font
->metrics
);
850 w32_font
->cached_metrics
= NULL
;
851 w32_font
->n_cache_blocks
= 0;
853 SelectObject (dc
, old_font
);
854 release_frame_dc (f
, dc
);
856 w32_font
->hfont
= hfont
;
861 /* We don't know how much space we need for the full name, so start with
862 96 bytes and go up in steps of 32. */
865 while (name
&& w32font_full_name (&logfont
, font_entity
, pixel_size
,
872 font
->props
[FONT_FULLNAME_INDEX
]
873 = DECODE_SYSTEM (build_string (name
));
875 font
->props
[FONT_FULLNAME_INDEX
]
876 = DECODE_SYSTEM (build_string (logfont
.lfFaceName
));
879 font
->max_width
= w32_font
->metrics
.tmMaxCharWidth
;
880 /* Parts of Emacs display assume that height = ascent + descent...
881 so height is defined later, after ascent and descent.
882 font->height = w32_font->metrics.tmHeight
883 + w32_font->metrics.tmExternalLeading;
886 font
->space_width
= font
->average_width
= w32_font
->metrics
.tmAveCharWidth
;
888 font
->vertical_centering
= 0;
889 font
->encoding_type
= 0;
890 font
->baseline_offset
= 0;
891 font
->relative_compose
= 0;
892 font
->default_ascent
= w32_font
->metrics
.tmAscent
;
893 font
->font_encoder
= NULL
;
894 font
->pixel_size
= size
;
895 font
->driver
= &w32font_driver
;
896 /* Use format cached during list, as the information we have access to
897 here is incomplete. */
898 extra
= AREF (font_entity
, FONT_EXTRA_INDEX
);
901 val
= assq_no_quit (QCformat
, extra
);
903 font
->props
[FONT_FORMAT_INDEX
] = XCDR (val
);
905 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
908 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
910 font
->props
[FONT_FILE_INDEX
] = Qnil
;
911 font
->encoding_charset
= -1;
912 font
->repertory_charset
= -1;
913 /* TODO: do we really want the minimum width here, which could be negative? */
914 font
->min_width
= font
->space_width
;
915 font
->ascent
= w32_font
->metrics
.tmAscent
;
916 font
->descent
= w32_font
->metrics
.tmDescent
;
917 font
->height
= font
->ascent
+ font
->descent
;
921 font
->underline_thickness
= metrics
->otmsUnderscoreSize
;
922 font
->underline_position
= -metrics
->otmsUnderscorePosition
;
926 font
->underline_thickness
= 0;
927 font
->underline_position
= -1;
930 /* For temporary compatibility with legacy code that expects the
931 name to be usable in x-list-fonts. Eventually we expect to change
932 x-list-fonts and other places that use fonts so that this can be
933 an fcname or similar. */
934 font
->props
[FONT_NAME_INDEX
] = Ffont_xlfd_name (font_object
, Qnil
);
939 /* Callback function for EnumFontFamiliesEx.
940 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
942 add_font_name_to_list (logical_font
, physical_font
, font_type
, list_object
)
943 ENUMLOGFONTEX
*logical_font
;
944 NEWTEXTMETRICEX
*physical_font
;
948 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
951 /* Skip vertical fonts (intended only for printing) */
952 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
955 family
= intern_font_name (logical_font
->elfLogFont
.lfFaceName
);
956 if (! memq_no_quit (family
, *list
))
957 *list
= Fcons (family
, *list
);
962 static int w32_decode_weight
P_ ((int));
963 static int w32_encode_weight
P_ ((int));
965 /* Convert an enumerated Windows font to an Emacs font entity. */
967 w32_enumfont_pattern_entity (frame
, logical_font
, physical_font
,
968 font_type
, requested_font
, backend
)
970 ENUMLOGFONTEX
*logical_font
;
971 NEWTEXTMETRICEX
*physical_font
;
973 LOGFONT
*requested_font
;
976 Lisp_Object entity
, tem
;
977 LOGFONT
*lf
= (LOGFONT
*) logical_font
;
979 DWORD full_type
= physical_font
->ntmTm
.ntmFlags
;
981 entity
= font_make_entity ();
983 ASET (entity
, FONT_TYPE_INDEX
, backend
);
984 ASET (entity
, FONT_REGISTRY_INDEX
, w32_registry (lf
->lfCharSet
, font_type
));
985 ASET (entity
, FONT_OBJLIST_INDEX
, Qnil
);
987 /* Foundry is difficult to get in readable form on Windows.
988 But Emacs crashes if it is not set, so set it to something more
989 generic. These values make xlfds compatible with Emacs 22. */
990 if (lf
->lfOutPrecision
== OUT_STRING_PRECIS
)
992 else if (lf
->lfOutPrecision
== OUT_STROKE_PRECIS
)
997 ASET (entity
, FONT_FOUNDRY_INDEX
, tem
);
999 /* Save the generic family in the extra info, as it is likely to be
1000 useful to users looking for a close match. */
1001 generic_type
= physical_font
->ntmTm
.tmPitchAndFamily
& 0xF0;
1002 if (generic_type
== FF_DECORATIVE
)
1004 else if (generic_type
== FF_MODERN
)
1006 else if (generic_type
== FF_ROMAN
)
1008 else if (generic_type
== FF_SCRIPT
)
1010 else if (generic_type
== FF_SWISS
)
1015 ASET (entity
, FONT_ADSTYLE_INDEX
, tem
);
1017 if (physical_font
->ntmTm
.tmPitchAndFamily
& 0x01)
1018 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_PROPORTIONAL
));
1020 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_CHARCELL
));
1022 if (requested_font
->lfQuality
!= DEFAULT_QUALITY
)
1024 font_put_extra (entity
, QCantialias
,
1025 lispy_antialias_type (requested_font
->lfQuality
));
1027 ASET (entity
, FONT_FAMILY_INDEX
,
1028 intern_font_name (lf
->lfFaceName
));
1030 FONT_SET_STYLE (entity
, FONT_WEIGHT_INDEX
,
1031 make_number (w32_decode_weight (lf
->lfWeight
)));
1032 FONT_SET_STYLE (entity
, FONT_SLANT_INDEX
,
1033 make_number (lf
->lfItalic
? 200 : 100));
1034 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1036 FONT_SET_STYLE (entity
, FONT_WIDTH_INDEX
, make_number (100));
1038 if (font_type
& RASTER_FONTTYPE
)
1039 ASET (entity
, FONT_SIZE_INDEX
,
1040 make_number (physical_font
->ntmTm
.tmHeight
1041 + physical_font
->ntmTm
.tmExternalLeading
));
1043 ASET (entity
, FONT_SIZE_INDEX
, make_number (0));
1045 /* Cache unicode codepoints covered by this font, as there is no other way
1046 of getting this information easily. */
1047 if (font_type
& TRUETYPE_FONTTYPE
)
1049 tem
= font_supported_scripts (&physical_font
->ntmFontSig
);
1051 font_put_extra (entity
, QCscript
, tem
);
1054 /* This information is not fully available when opening fonts, so
1055 save it here. Only Windows 2000 and later return information
1056 about opentype and type1 fonts, so need a fallback for detecting
1057 truetype so that this information is not any worse than we could
1058 have obtained later. */
1059 if (EQ (backend
, Quniscribe
) && (full_type
& NTMFLAGS_OPENTYPE
))
1060 tem
= intern ("opentype");
1061 else if (font_type
& TRUETYPE_FONTTYPE
)
1062 tem
= intern ("truetype");
1063 else if (full_type
& NTM_PS_OPENTYPE
)
1064 tem
= intern ("postscript");
1065 else if (full_type
& NTM_TYPE1
)
1066 tem
= intern ("type1");
1067 else if (font_type
& RASTER_FONTTYPE
)
1068 tem
= intern ("w32bitmap");
1070 tem
= intern ("w32vector");
1072 font_put_extra (entity
, QCformat
, tem
);
1078 /* Convert generic families to the family portion of lfPitchAndFamily. */
1080 w32_generic_family (Lisp_Object name
)
1082 /* Generic families. */
1083 if (EQ (name
, Qmonospace
) || EQ (name
, Qmono
))
1085 else if (EQ (name
, Qsans
) || EQ (name
, Qsans_serif
) || EQ (name
, Qsansserif
))
1087 else if (EQ (name
, Qserif
))
1089 else if (EQ (name
, Qdecorative
))
1090 return FF_DECORATIVE
;
1091 else if (EQ (name
, Qscript
))
1098 logfonts_match (font
, pattern
)
1099 LOGFONT
*font
, *pattern
;
1101 /* Only check height for raster fonts. */
1102 if (pattern
->lfHeight
&& font
->lfOutPrecision
== OUT_STRING_PRECIS
1103 && font
->lfHeight
!= pattern
->lfHeight
)
1106 /* Have some flexibility with weights. */
1107 if (pattern
->lfWeight
1108 && ((font
->lfWeight
< (pattern
->lfWeight
- 150))
1109 || font
->lfWeight
> (pattern
->lfWeight
+ 150)))
1112 /* Charset and face should be OK. Italic has to be checked
1113 against the original spec, in case we don't have any preference. */
1117 /* Codepage Bitfields in FONTSIGNATURE struct. */
1118 #define CSB_JAPANESE (1 << 17)
1119 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1120 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1123 font_matches_spec (type
, font
, spec
, backend
, logfont
)
1125 NEWTEXTMETRICEX
*font
;
1127 Lisp_Object backend
;
1130 Lisp_Object extra
, val
;
1132 /* Check italic. Can't check logfonts, since it is a boolean field,
1133 so there is no difference between "non-italic" and "don't care". */
1135 int slant
= FONT_SLANT_NUMERIC (spec
);
1138 && ((slant
> 150 && !font
->ntmTm
.tmItalic
)
1139 || (slant
<= 150 && font
->ntmTm
.tmItalic
)))
1143 /* Check adstyle against generic family. */
1144 val
= AREF (spec
, FONT_ADSTYLE_INDEX
);
1147 BYTE family
= w32_generic_family (val
);
1148 if (family
!= FF_DONTCARE
1149 && family
!= (font
->ntmTm
.tmPitchAndFamily
& 0xF0))
1154 val
= AREF (spec
, FONT_SPACING_INDEX
);
1157 int spacing
= XINT (val
);
1158 int proportional
= (spacing
< FONT_SPACING_MONO
);
1160 if ((proportional
&& !(font
->ntmTm
.tmPitchAndFamily
& 0x01))
1161 || (!proportional
&& (font
->ntmTm
.tmPitchAndFamily
& 0x01)))
1165 /* Check extra parameters. */
1166 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
1167 CONSP (extra
); extra
= XCDR (extra
))
1169 Lisp_Object extra_entry
;
1170 extra_entry
= XCAR (extra
);
1171 if (CONSP (extra_entry
))
1173 Lisp_Object key
= XCAR (extra_entry
);
1175 val
= XCDR (extra_entry
);
1176 if (EQ (key
, QCscript
) && SYMBOLP (val
))
1178 /* Only truetype fonts will have information about what
1179 scripts they support. This probably means the user
1180 will have to force Emacs to use raster, postscript
1181 or atm fonts for non-ASCII text. */
1182 if (type
& TRUETYPE_FONTTYPE
)
1185 = font_supported_scripts (&font
->ntmFontSig
);
1186 if (! memq_no_quit (val
, support
))
1191 /* Return specific matches, but play it safe. Fonts
1192 that cover more than their charset would suggest
1193 are likely to be truetype or opentype fonts,
1195 if (EQ (val
, Qlatin
))
1197 /* Although every charset but symbol, thai and
1198 arabic contains the basic ASCII set of latin
1199 characters, Emacs expects much more. */
1200 if (font
->ntmTm
.tmCharSet
!= ANSI_CHARSET
)
1203 else if (EQ (val
, Qsymbol
))
1205 if (font
->ntmTm
.tmCharSet
!= SYMBOL_CHARSET
)
1208 else if (EQ (val
, Qcyrillic
))
1210 if (font
->ntmTm
.tmCharSet
!= RUSSIAN_CHARSET
)
1213 else if (EQ (val
, Qgreek
))
1215 if (font
->ntmTm
.tmCharSet
!= GREEK_CHARSET
)
1218 else if (EQ (val
, Qarabic
))
1220 if (font
->ntmTm
.tmCharSet
!= ARABIC_CHARSET
)
1223 else if (EQ (val
, Qhebrew
))
1225 if (font
->ntmTm
.tmCharSet
!= HEBREW_CHARSET
)
1228 else if (EQ (val
, Qthai
))
1230 if (font
->ntmTm
.tmCharSet
!= THAI_CHARSET
)
1233 else if (EQ (val
, Qkana
))
1235 if (font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1238 else if (EQ (val
, Qbopomofo
))
1240 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
)
1243 else if (EQ (val
, Qhangul
))
1245 if (font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1246 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
)
1249 else if (EQ (val
, Qhan
))
1251 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
1252 && font
->ntmTm
.tmCharSet
!= GB2312_CHARSET
1253 && font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1254 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
1255 && font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1259 /* Other scripts unlikely to be handled by non-truetype
1264 else if (EQ (key
, QClang
) && SYMBOLP (val
))
1266 /* Just handle the CJK languages here, as the lang
1267 parameter is used to select a font with appropriate
1268 glyphs in the cjk unified ideographs block. Other fonts
1269 support for a language can be solely determined by
1270 its character coverage. */
1273 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_JAPANESE
))
1276 else if (EQ (val
, Qko
))
1278 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_KOREAN
))
1281 else if (EQ (val
, Qzh
))
1283 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_CHINESE
))
1287 /* Any other language, we don't recognize it. Only the above
1288 currently appear in fontset.el, so it isn't worth
1289 creating a mapping table of codepages/scripts to languages
1290 or opening the font to see if there are any language tags
1291 in it that the W32 API does not expose. Fontset
1292 spec should have a fallback, as some backends do
1293 not recognize language at all. */
1296 else if (EQ (key
, QCotf
) && CONSP (val
))
1298 /* OTF features only supported by the uniscribe backend. */
1299 if (EQ (backend
, Quniscribe
))
1301 if (!uniscribe_check_otf (logfont
, val
))
1313 w32font_coverage_ok (coverage
, charset
)
1314 FONTSIGNATURE
* coverage
;
1317 DWORD subrange1
= coverage
->fsUsb
[1];
1319 #define SUBRANGE1_HAN_MASK 0x08000000
1320 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1321 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1323 if (charset
== GB2312_CHARSET
|| charset
== CHINESEBIG5_CHARSET
)
1325 return (subrange1
& SUBRANGE1_HAN_MASK
) == SUBRANGE1_HAN_MASK
;
1327 else if (charset
== SHIFTJIS_CHARSET
)
1329 return (subrange1
& SUBRANGE1_JAPANESE_MASK
) == SUBRANGE1_JAPANESE_MASK
;
1331 else if (charset
== HANGEUL_CHARSET
)
1333 return (subrange1
& SUBRANGE1_HANGEUL_MASK
) == SUBRANGE1_HANGEUL_MASK
;
1341 check_face_name (font
, full_name
)
1345 char full_iname
[LF_FULLFACESIZE
+1];
1347 /* Just check for names known to cause problems, since the full name
1348 can contain expanded abbreviations, prefixed foundry, postfixed
1349 style, the latter of which sometimes differs from the style indicated
1350 in the shorter name (eg Lt becomes Light or even Extra Light) */
1352 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1353 installed, we run into problems with the Uniscribe backend which tries
1354 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1355 with Arial's characteristics, since that attempt to use Truetype works
1356 some places, but not others. */
1357 if (!xstrcasecmp (font
->lfFaceName
, "helvetica"))
1359 strncpy (full_iname
, full_name
, LF_FULLFACESIZE
);
1360 full_iname
[LF_FULLFACESIZE
] = 0;
1361 _strlwr (full_iname
);
1362 return strstr ("helvetica", full_iname
) != NULL
;
1365 /* Since Times is mapped to Times New Roman, a substring
1366 match is not sufficient to filter out the bogus match. */
1367 else if (!xstrcasecmp (font
->lfFaceName
, "times"))
1368 return xstrcasecmp (full_name
, "times") == 0;
1374 /* Callback function for EnumFontFamiliesEx.
1375 * Checks if a font matches everything we are trying to check agaist,
1376 * and if so, adds it to a list. Both the data we are checking against
1377 * and the list to which the fonts are added are passed in via the
1378 * lparam argument, in the form of a font_callback_data struct. */
1380 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1381 ENUMLOGFONTEX
*logical_font
;
1382 NEWTEXTMETRICEX
*physical_font
;
1386 struct font_callback_data
*match_data
1387 = (struct font_callback_data
*) lParam
;
1388 Lisp_Object backend
= match_data
->opentype_only
? Quniscribe
: Qgdi
;
1390 if ((!match_data
->opentype_only
1391 || (((physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
1392 || (font_type
& TRUETYPE_FONTTYPE
))
1393 /* For the uniscribe backend, only consider fonts that claim
1394 to cover at least some part of Unicode. */
1395 && (physical_font
->ntmFontSig
.fsUsb
[3]
1396 || physical_font
->ntmFontSig
.fsUsb
[2]
1397 || physical_font
->ntmFontSig
.fsUsb
[1]
1398 || (physical_font
->ntmFontSig
.fsUsb
[0] & 0x3fffffff))))
1399 && logfonts_match (&logical_font
->elfLogFont
, &match_data
->pattern
)
1400 && font_matches_spec (font_type
, physical_font
,
1401 match_data
->orig_font_spec
, backend
,
1402 &logical_font
->elfLogFont
)
1403 && w32font_coverage_ok (&physical_font
->ntmFontSig
,
1404 match_data
->pattern
.lfCharSet
)
1405 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1406 We limit this to raster fonts, because the test can catch some
1407 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1408 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1409 therefore get through this test. Since full names can be prefixed
1410 by a foundry, we accept raster fonts if the font name is found
1411 anywhere within the full name. */
1412 && (logical_font
->elfLogFont
.lfOutPrecision
!= OUT_STRING_PRECIS
1413 || strstr (logical_font
->elfFullName
,
1414 logical_font
->elfLogFont
.lfFaceName
))
1415 /* Check for well known substitutions that mess things up in the
1416 presence of Type-1 fonts of the same name. */
1417 && (match_data
->pattern
.lfFaceName
[0]
1418 && check_face_name (&logical_font
->elfLogFont
,
1419 logical_font
->elfFullName
)))
1422 = w32_enumfont_pattern_entity (match_data
->frame
, logical_font
,
1423 physical_font
, font_type
,
1424 &match_data
->pattern
,
1428 Lisp_Object spec_charset
= AREF (match_data
->orig_font_spec
,
1429 FONT_REGISTRY_INDEX
);
1431 /* If registry was specified as iso10646-1, only report
1432 ANSI and DEFAULT charsets, as most unicode fonts will
1433 contain one of those plus others. */
1434 if ((EQ (spec_charset
, Qiso10646_1
)
1435 || EQ (spec_charset
, Qunicode_bmp
))
1436 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
1437 && logical_font
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
)
1439 /* unicode-sip fonts must contain characters beyond the BMP,
1440 so look for bit 57 (surrogates) in the Unicode subranges. */
1441 else if (EQ (spec_charset
, Qunicode_sip
)
1442 && (!(physical_font
->ntmFontSig
.fsUsb
[1] & 0x02000000)
1443 || !(physical_font
->ntmFontSig
.fsUsb
[1] & 0x28000000)))
1445 /* If registry was specified, but did not map to a windows
1446 charset, don't report any fonts. */
1447 else if (!NILP (spec_charset
)
1448 && !EQ (spec_charset
, Qiso10646_1
)
1449 && !EQ (spec_charset
, Qunicode_bmp
)
1450 && !EQ (spec_charset
, Qunicode_sip
)
1451 && match_data
->pattern
.lfCharSet
== DEFAULT_CHARSET
)
1454 /* If registry was specified, ensure it is reported as the same. */
1455 if (!NILP (spec_charset
))
1456 ASET (entity
, FONT_REGISTRY_INDEX
, spec_charset
);
1458 match_data
->list
= Fcons (entity
, match_data
->list
);
1460 /* If no registry specified, duplicate iso8859-1 truetype fonts
1462 if (NILP (spec_charset
)
1463 && font_type
== TRUETYPE_FONTTYPE
1464 && logical_font
->elfLogFont
.lfCharSet
== ANSI_CHARSET
)
1466 Lisp_Object tem
= Fcopy_font_spec (entity
);
1467 ASET (tem
, FONT_REGISTRY_INDEX
, Qiso10646_1
);
1468 match_data
->list
= Fcons (tem
, match_data
->list
);
1475 /* Callback function for EnumFontFamiliesEx.
1476 * Terminates the search once we have a match. */
1478 add_one_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1479 ENUMLOGFONTEX
*logical_font
;
1480 NEWTEXTMETRICEX
*physical_font
;
1484 struct font_callback_data
*match_data
1485 = (struct font_callback_data
*) lParam
;
1486 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
);
1488 /* If we have a font in the list, terminate the search. */
1489 return NILP (match_data
->list
);
1492 /* Old function to convert from x to w32 charset, from w32fns.c. */
1494 x_to_w32_charset (lpcs
)
1497 Lisp_Object this_entry
, w32_charset
;
1499 int len
= strlen (lpcs
);
1501 /* Support "*-#nnn" format for unknown charsets. */
1502 if (strncmp (lpcs
, "*-#", 3) == 0)
1503 return atoi (lpcs
+ 3);
1505 /* All Windows fonts qualify as unicode. */
1506 if (!strncmp (lpcs
, "iso10646", 8))
1507 return DEFAULT_CHARSET
;
1509 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1510 charset
= alloca (len
+ 1);
1511 strcpy (charset
, lpcs
);
1512 lpcs
= strchr (charset
, '*');
1516 /* Look through w32-charset-info-alist for the character set.
1517 Format of each entry is
1518 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1520 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
1522 if (NILP (this_entry
))
1524 /* At startup, we want iso8859-1 fonts to come up properly. */
1525 if (xstrcasecmp (charset
, "iso8859-1") == 0)
1526 return ANSI_CHARSET
;
1528 return DEFAULT_CHARSET
;
1531 w32_charset
= Fcar (Fcdr (this_entry
));
1533 /* Translate Lisp symbol to number. */
1534 if (EQ (w32_charset
, Qw32_charset_ansi
))
1535 return ANSI_CHARSET
;
1536 if (EQ (w32_charset
, Qw32_charset_symbol
))
1537 return SYMBOL_CHARSET
;
1538 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
1539 return SHIFTJIS_CHARSET
;
1540 if (EQ (w32_charset
, Qw32_charset_hangeul
))
1541 return HANGEUL_CHARSET
;
1542 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
1543 return CHINESEBIG5_CHARSET
;
1544 if (EQ (w32_charset
, Qw32_charset_gb2312
))
1545 return GB2312_CHARSET
;
1546 if (EQ (w32_charset
, Qw32_charset_oem
))
1548 if (EQ (w32_charset
, Qw32_charset_johab
))
1549 return JOHAB_CHARSET
;
1550 if (EQ (w32_charset
, Qw32_charset_easteurope
))
1551 return EASTEUROPE_CHARSET
;
1552 if (EQ (w32_charset
, Qw32_charset_turkish
))
1553 return TURKISH_CHARSET
;
1554 if (EQ (w32_charset
, Qw32_charset_baltic
))
1555 return BALTIC_CHARSET
;
1556 if (EQ (w32_charset
, Qw32_charset_russian
))
1557 return RUSSIAN_CHARSET
;
1558 if (EQ (w32_charset
, Qw32_charset_arabic
))
1559 return ARABIC_CHARSET
;
1560 if (EQ (w32_charset
, Qw32_charset_greek
))
1561 return GREEK_CHARSET
;
1562 if (EQ (w32_charset
, Qw32_charset_hebrew
))
1563 return HEBREW_CHARSET
;
1564 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
1565 return VIETNAMESE_CHARSET
;
1566 if (EQ (w32_charset
, Qw32_charset_thai
))
1567 return THAI_CHARSET
;
1568 if (EQ (w32_charset
, Qw32_charset_mac
))
1571 return DEFAULT_CHARSET
;
1575 /* Convert a Lisp font registry (symbol) to a windows charset. */
1577 registry_to_w32_charset (charset
)
1578 Lisp_Object charset
;
1580 if (EQ (charset
, Qiso10646_1
) || EQ (charset
, Qunicode_bmp
)
1581 || EQ (charset
, Qunicode_sip
))
1582 return DEFAULT_CHARSET
; /* UNICODE_CHARSET not defined in MingW32 */
1583 else if (EQ (charset
, Qiso8859_1
))
1584 return ANSI_CHARSET
;
1585 else if (SYMBOLP (charset
))
1586 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset
)));
1588 return DEFAULT_CHARSET
;
1591 /* Old function to convert from w32 to x charset, from w32fns.c. */
1593 w32_to_x_charset (fncharset
, matching
)
1597 static char buf
[32];
1598 Lisp_Object charset_type
;
1603 /* If fully specified, accept it as it is. Otherwise use a
1605 char *wildcard
= strchr (matching
, '*');
1608 else if (strchr (matching
, '-'))
1611 match_len
= strlen (matching
);
1617 /* Handle startup case of w32-charset-info-alist not
1618 being set up yet. */
1619 if (NILP (Vw32_charset_info_alist
))
1621 charset_type
= Qw32_charset_ansi
;
1623 case DEFAULT_CHARSET
:
1624 charset_type
= Qw32_charset_default
;
1626 case SYMBOL_CHARSET
:
1627 charset_type
= Qw32_charset_symbol
;
1629 case SHIFTJIS_CHARSET
:
1630 charset_type
= Qw32_charset_shiftjis
;
1632 case HANGEUL_CHARSET
:
1633 charset_type
= Qw32_charset_hangeul
;
1635 case GB2312_CHARSET
:
1636 charset_type
= Qw32_charset_gb2312
;
1638 case CHINESEBIG5_CHARSET
:
1639 charset_type
= Qw32_charset_chinesebig5
;
1642 charset_type
= Qw32_charset_oem
;
1644 case EASTEUROPE_CHARSET
:
1645 charset_type
= Qw32_charset_easteurope
;
1647 case TURKISH_CHARSET
:
1648 charset_type
= Qw32_charset_turkish
;
1650 case BALTIC_CHARSET
:
1651 charset_type
= Qw32_charset_baltic
;
1653 case RUSSIAN_CHARSET
:
1654 charset_type
= Qw32_charset_russian
;
1656 case ARABIC_CHARSET
:
1657 charset_type
= Qw32_charset_arabic
;
1660 charset_type
= Qw32_charset_greek
;
1662 case HEBREW_CHARSET
:
1663 charset_type
= Qw32_charset_hebrew
;
1665 case VIETNAMESE_CHARSET
:
1666 charset_type
= Qw32_charset_vietnamese
;
1669 charset_type
= Qw32_charset_thai
;
1672 charset_type
= Qw32_charset_mac
;
1675 charset_type
= Qw32_charset_johab
;
1679 /* Encode numerical value of unknown charset. */
1680 sprintf (buf
, "*-#%u", fncharset
);
1686 char * best_match
= NULL
;
1687 int matching_found
= 0;
1689 /* Look through w32-charset-info-alist for the character set.
1690 Prefer ISO codepages, and prefer lower numbers in the ISO
1691 range. Only return charsets for codepages which are installed.
1693 Format of each entry is
1694 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1696 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
1699 Lisp_Object w32_charset
;
1700 Lisp_Object codepage
;
1702 Lisp_Object this_entry
= XCAR (rest
);
1704 /* Skip invalid entries in alist. */
1705 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
1706 || !CONSP (XCDR (this_entry
))
1707 || !SYMBOLP (XCAR (XCDR (this_entry
))))
1710 x_charset
= SDATA (XCAR (this_entry
));
1711 w32_charset
= XCAR (XCDR (this_entry
));
1712 codepage
= XCDR (XCDR (this_entry
));
1714 /* Look for Same charset and a valid codepage (or non-int
1715 which means ignore). */
1716 if (EQ (w32_charset
, charset_type
)
1717 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
1718 || IsValidCodePage (XINT (codepage
))))
1720 /* If we don't have a match already, then this is the
1724 best_match
= x_charset
;
1725 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
1728 /* If we already found a match for MATCHING, then
1729 only consider other matches. */
1730 else if (matching_found
1731 && strnicmp (x_charset
, matching
, match_len
))
1733 /* If this matches what we want, and the best so far doesn't,
1734 then this is better. */
1735 else if (!matching_found
&& matching
1736 && !strnicmp (x_charset
, matching
, match_len
))
1738 best_match
= x_charset
;
1741 /* If this is fully specified, and the best so far isn't,
1742 then this is better. */
1743 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
1744 /* If this is an ISO codepage, and the best so far isn't,
1745 then this is better, but only if it fully specifies the
1747 || (strnicmp (best_match
, "iso", 3) != 0
1748 && strnicmp (x_charset
, "iso", 3) == 0
1749 && strchr (x_charset
, '-')))
1750 best_match
= x_charset
;
1751 /* If both are ISO8859 codepages, choose the one with the
1752 lowest number in the encoding field. */
1753 else if (strnicmp (best_match
, "iso8859-", 8) == 0
1754 && strnicmp (x_charset
, "iso8859-", 8) == 0)
1756 int best_enc
= atoi (best_match
+ 8);
1757 int this_enc
= atoi (x_charset
+ 8);
1758 if (this_enc
> 0 && this_enc
< best_enc
)
1759 best_match
= x_charset
;
1764 /* If no match, encode the numeric value. */
1767 sprintf (buf
, "*-#%u", fncharset
);
1771 strncpy (buf
, best_match
, 31);
1772 /* If the charset is not fully specified, put -0 on the end. */
1773 if (!strchr (best_match
, '-'))
1775 int pos
= strlen (best_match
);
1776 /* Charset specifiers shouldn't be very long. If it is a made
1777 up one, truncating it should not do any harm since it isn't
1778 recognized anyway. */
1781 strcpy (buf
+ pos
, "-0");
1789 w32_registry (w32_charset
, font_type
)
1795 /* If charset is defaulted, charset is unicode or unknown, depending on
1797 if (w32_charset
== DEFAULT_CHARSET
)
1798 return font_type
== TRUETYPE_FONTTYPE
? Qiso10646_1
: Qunknown
;
1800 charset
= w32_to_x_charset (w32_charset
, NULL
);
1801 return font_intern_prop (charset
, strlen(charset
), 1);
1805 w32_decode_weight (fnweight
)
1808 if (fnweight
>= FW_HEAVY
) return 210;
1809 if (fnweight
>= FW_EXTRABOLD
) return 205;
1810 if (fnweight
>= FW_BOLD
) return 200;
1811 if (fnweight
>= FW_SEMIBOLD
) return 180;
1812 if (fnweight
>= FW_NORMAL
) return 100;
1813 if (fnweight
>= FW_LIGHT
) return 50;
1814 if (fnweight
>= FW_EXTRALIGHT
) return 40;
1815 if (fnweight
> FW_THIN
) return 20;
1820 w32_encode_weight (n
)
1823 if (n
>= 210) return FW_HEAVY
;
1824 if (n
>= 205) return FW_EXTRABOLD
;
1825 if (n
>= 200) return FW_BOLD
;
1826 if (n
>= 180) return FW_SEMIBOLD
;
1827 if (n
>= 100) return FW_NORMAL
;
1828 if (n
>= 50) return FW_LIGHT
;
1829 if (n
>= 40) return FW_EXTRALIGHT
;
1830 if (n
>= 20) return FW_THIN
;
1834 /* Convert a Windows font weight into one of the weights supported
1835 by fontconfig (see font.c:font_parse_fcname). */
1837 w32_to_fc_weight (n
)
1840 if (n
>= FW_EXTRABOLD
) return intern ("black");
1841 if (n
>= FW_BOLD
) return intern ("bold");
1842 if (n
>= FW_SEMIBOLD
) return intern ("demibold");
1843 if (n
>= FW_NORMAL
) return intern ("medium");
1844 return intern ("light");
1847 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1849 fill_in_logfont (f
, logfont
, font_spec
)
1852 Lisp_Object font_spec
;
1854 Lisp_Object tmp
, extra
;
1855 int dpi
= FRAME_W32_DISPLAY_INFO (f
)->resy
;
1857 tmp
= AREF (font_spec
, FONT_DPI_INDEX
);
1862 else if (FLOATP (tmp
))
1864 dpi
= (int) (XFLOAT_DATA (tmp
) + 0.5);
1868 tmp
= AREF (font_spec
, FONT_SIZE_INDEX
);
1870 logfont
->lfHeight
= -1 * XINT (tmp
);
1871 else if (FLOATP (tmp
))
1872 logfont
->lfHeight
= (int) (-1.0 * dpi
* XFLOAT_DATA (tmp
) / 72.27 + 0.5);
1879 tmp
= AREF (font_spec
, FONT_WEIGHT_INDEX
);
1881 logfont
->lfWeight
= w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec
));
1884 tmp
= AREF (font_spec
, FONT_SLANT_INDEX
);
1887 int slant
= FONT_SLANT_NUMERIC (font_spec
);
1888 logfont
->lfItalic
= slant
> 150 ? 1 : 0;
1896 tmp
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1898 logfont
->lfCharSet
= registry_to_w32_charset (tmp
);
1900 logfont
->lfCharSet
= DEFAULT_CHARSET
;
1904 /* Clip Precision */
1907 logfont
->lfQuality
= DEFAULT_QUALITY
;
1909 /* Generic Family and Face Name */
1910 logfont
->lfPitchAndFamily
= FF_DONTCARE
| DEFAULT_PITCH
;
1912 tmp
= AREF (font_spec
, FONT_FAMILY_INDEX
);
1915 logfont
->lfPitchAndFamily
= w32_generic_family (tmp
) | DEFAULT_PITCH
;
1916 if ((logfont
->lfPitchAndFamily
& 0xF0) != FF_DONTCARE
)
1917 ; /* Font name was generic, don't fill in font name. */
1918 /* Font families are interned, but allow for strings also in case of
1920 else if (SYMBOLP (tmp
))
1921 strncpy (logfont
->lfFaceName
,
1922 SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp
))), LF_FACESIZE
);
1925 tmp
= AREF (font_spec
, FONT_ADSTYLE_INDEX
);
1928 /* Override generic family. */
1929 BYTE family
= w32_generic_family (tmp
);
1930 if (family
!= FF_DONTCARE
)
1931 logfont
->lfPitchAndFamily
= family
| DEFAULT_PITCH
;
1935 /* Set pitch based on the spacing property. */
1936 tmp
= AREF (font_spec
, FONT_SPACING_INDEX
);
1939 int spacing
= XINT (tmp
);
1940 if (spacing
< FONT_SPACING_MONO
)
1941 logfont
->lfPitchAndFamily
1942 = logfont
->lfPitchAndFamily
& 0xF0 | VARIABLE_PITCH
;
1944 logfont
->lfPitchAndFamily
1945 = logfont
->lfPitchAndFamily
& 0xF0 | FIXED_PITCH
;
1948 /* Process EXTRA info. */
1949 for (extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
1950 CONSP (extra
); extra
= XCDR (extra
))
1955 Lisp_Object key
, val
;
1956 key
= XCAR (tmp
), val
= XCDR (tmp
);
1957 /* Only use QCscript if charset is not provided, or is unicode
1958 and a single script is specified. This is rather crude,
1959 and is only used to narrow down the fonts returned where
1960 there is a definite match. Some scripts, such as latin, han,
1961 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1963 if (EQ (key
, QCscript
)
1964 && logfont
->lfCharSet
== DEFAULT_CHARSET
1967 if (EQ (val
, Qgreek
))
1968 logfont
->lfCharSet
= GREEK_CHARSET
;
1969 else if (EQ (val
, Qhangul
))
1970 logfont
->lfCharSet
= HANGUL_CHARSET
;
1971 else if (EQ (val
, Qkana
) || EQ (val
, Qkanbun
))
1972 logfont
->lfCharSet
= SHIFTJIS_CHARSET
;
1973 else if (EQ (val
, Qbopomofo
))
1974 logfont
->lfCharSet
= CHINESEBIG5_CHARSET
;
1975 /* GB 18030 supports tibetan, yi, mongolian,
1976 fonts that support it should show up if we ask for
1978 else if (EQ (val
, Qtibetan
) || EQ (val
, Qyi
)
1979 || EQ (val
, Qmongolian
))
1980 logfont
->lfCharSet
= GB2312_CHARSET
;
1981 else if (EQ (val
, Qhebrew
))
1982 logfont
->lfCharSet
= HEBREW_CHARSET
;
1983 else if (EQ (val
, Qarabic
))
1984 logfont
->lfCharSet
= ARABIC_CHARSET
;
1985 else if (EQ (val
, Qthai
))
1986 logfont
->lfCharSet
= THAI_CHARSET
;
1988 else if (EQ (key
, QCantialias
) && SYMBOLP (val
))
1990 logfont
->lfQuality
= w32_antialias_type (val
);
1997 list_all_matching_fonts (match_data
)
1998 struct font_callback_data
*match_data
;
2001 Lisp_Object families
= w32font_list_family (match_data
->frame
);
2002 struct frame
*f
= XFRAME (match_data
->frame
);
2004 dc
= get_frame_dc (f
);
2006 while (!NILP (families
))
2008 /* Only fonts from the current locale are given localized names
2009 on Windows, so we can keep backwards compatibility with
2010 Windows 9x/ME by using non-Unicode font enumeration without
2011 sacrificing internationalization here. */
2013 Lisp_Object family
= CAR (families
);
2014 families
= CDR (families
);
2017 else if (SYMBOLP (family
))
2018 name
= SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family
)));
2022 strncpy (match_data
->pattern
.lfFaceName
, name
, LF_FACESIZE
);
2023 match_data
->pattern
.lfFaceName
[LF_FACESIZE
- 1] = '\0';
2025 EnumFontFamiliesEx (dc
, &match_data
->pattern
,
2026 (FONTENUMPROC
) add_font_entity_to_list
,
2027 (LPARAM
) match_data
, 0);
2030 release_frame_dc (f
, dc
);
2034 lispy_antialias_type (type
)
2041 case NONANTIALIASED_QUALITY
:
2044 case ANTIALIASED_QUALITY
:
2047 case CLEARTYPE_QUALITY
:
2050 case CLEARTYPE_NATURAL_QUALITY
:
2060 /* Convert antialiasing symbols to lfQuality */
2062 w32_antialias_type (type
)
2065 if (EQ (type
, Qnone
))
2066 return NONANTIALIASED_QUALITY
;
2067 else if (EQ (type
, Qstandard
))
2068 return ANTIALIASED_QUALITY
;
2069 else if (EQ (type
, Qsubpixel
))
2070 return CLEARTYPE_QUALITY
;
2071 else if (EQ (type
, Qnatural
))
2072 return CLEARTYPE_NATURAL_QUALITY
;
2074 return DEFAULT_QUALITY
;
2077 /* Return a list of all the scripts that the font supports. */
2079 font_supported_scripts (FONTSIGNATURE
* sig
)
2081 DWORD
* subranges
= sig
->fsUsb
;
2082 Lisp_Object supported
= Qnil
;
2084 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2085 #define SUBRANGE(n,sym) \
2086 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2087 supported = Fcons ((sym), supported)
2089 /* Match multiple subranges. SYM is set if any MASK bit is set in
2090 subranges[0 - 3]. */
2091 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2092 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2093 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2094 supported = Fcons ((sym), supported)
2096 SUBRANGE (0, Qlatin
);
2097 /* The following count as latin too, ASCII should be present in these fonts,
2098 so don't need to mark them separately. */
2099 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2100 SUBRANGE (4, Qphonetic
);
2101 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
2102 SUBRANGE (7, Qgreek
);
2103 SUBRANGE (8, Qcoptic
);
2104 SUBRANGE (9, Qcyrillic
);
2105 SUBRANGE (10, Qarmenian
);
2106 SUBRANGE (11, Qhebrew
);
2108 SUBRANGE (13, Qarabic
);
2109 SUBRANGE (14, Qnko
);
2110 SUBRANGE (15, Qdevanagari
);
2111 SUBRANGE (16, Qbengali
);
2112 SUBRANGE (17, Qgurmukhi
);
2113 SUBRANGE (18, Qgujarati
);
2114 SUBRANGE (19, Qoriya
);
2115 SUBRANGE (20, Qtamil
);
2116 SUBRANGE (21, Qtelugu
);
2117 SUBRANGE (22, Qkannada
);
2118 SUBRANGE (23, Qmalayalam
);
2119 SUBRANGE (24, Qthai
);
2120 SUBRANGE (25, Qlao
);
2121 SUBRANGE (26, Qgeorgian
);
2122 SUBRANGE (27, Qbalinese
);
2123 /* 28: Hangul Jamo. */
2124 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2125 /* 32-47: Symbols (defined below). */
2126 SUBRANGE (48, Qcjk_misc
);
2127 /* Match either 49: katakana or 50: hiragana for kana. */
2128 MASK_ANY (0, 0x00060000, 0, 0, Qkana
);
2129 SUBRANGE (51, Qbopomofo
);
2130 /* 52: Compatibility Jamo */
2131 SUBRANGE (53, Qphags_pa
);
2132 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2133 SUBRANGE (56, Qhangul
);
2134 /* 57: Surrogates. */
2135 SUBRANGE (58, Qphoenician
);
2136 SUBRANGE (59, Qhan
); /* There are others, but this is the main one. */
2137 SUBRANGE (59, Qideographic_description
); /* Windows lumps this in. */
2138 SUBRANGE (59, Qkanbun
); /* And this. */
2139 /* 60: Private use, 61: CJK strokes and compatibility. */
2140 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2141 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2142 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2144 SUBRANGE (70, Qtibetan
);
2145 SUBRANGE (71, Qsyriac
);
2146 SUBRANGE (72, Qthaana
);
2147 SUBRANGE (73, Qsinhala
);
2148 SUBRANGE (74, Qmyanmar
);
2149 SUBRANGE (75, Qethiopic
);
2150 SUBRANGE (76, Qcherokee
);
2151 SUBRANGE (77, Qcanadian_aboriginal
);
2152 SUBRANGE (78, Qogham
);
2153 SUBRANGE (79, Qrunic
);
2154 SUBRANGE (80, Qkhmer
);
2155 SUBRANGE (81, Qmongolian
);
2156 SUBRANGE (82, Qbraille
);
2158 SUBRANGE (84, Qbuhid
);
2159 SUBRANGE (84, Qhanunoo
);
2160 SUBRANGE (84, Qtagalog
);
2161 SUBRANGE (84, Qtagbanwa
);
2162 SUBRANGE (85, Qold_italic
);
2163 SUBRANGE (86, Qgothic
);
2164 SUBRANGE (87, Qdeseret
);
2165 SUBRANGE (88, Qbyzantine_musical_symbol
);
2166 SUBRANGE (88, Qmusical_symbol
); /* Windows doesn't distinguish these. */
2167 SUBRANGE (89, Qmathematical
);
2168 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2169 SUBRANGE (93, Qlimbu
);
2170 SUBRANGE (94, Qtai_le
);
2171 /* 95: New Tai Le */
2172 SUBRANGE (90, Qbuginese
);
2173 SUBRANGE (97, Qglagolitic
);
2174 SUBRANGE (98, Qtifinagh
);
2175 /* 99: Yijing Hexagrams. */
2176 SUBRANGE (100, Qsyloti_nagri
);
2177 SUBRANGE (101, Qlinear_b
);
2178 /* 102: Ancient Greek Numbers. */
2179 SUBRANGE (103, Qugaritic
);
2180 SUBRANGE (104, Qold_persian
);
2181 SUBRANGE (105, Qshavian
);
2182 SUBRANGE (106, Qosmanya
);
2183 SUBRANGE (107, Qcypriot
);
2184 SUBRANGE (108, Qkharoshthi
);
2185 /* 109: Tai Xuan Jing. */
2186 SUBRANGE (110, Qcuneiform
);
2187 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2188 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2189 SUBRANGE (118, Qcham
);
2190 /* 119: Ancient symbols, 120: Phaistos Disc. */
2191 /* 121: Carian, Lycian, Lydian, 122: Dominos, Mah Jong tiles. */
2192 /* 123-127: Reserved. */
2194 /* There isn't really a main symbol range, so include symbol if any
2195 relevant range is set. */
2196 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol
);
2198 /* Missing: Tai Viet (U+AA80-U+AADF). */
2205 /* Generate a full name for a Windows font.
2206 The full name is in fcname format, with weight, slant and antialiasing
2207 specified if they are not "normal". */
2209 w32font_full_name (font
, font_obj
, pixel_size
, name
, nbytes
)
2211 Lisp_Object font_obj
;
2216 int len
, height
, outline
;
2218 Lisp_Object antialiasing
, weight
= Qnil
;
2220 len
= strlen (font
->lfFaceName
);
2222 outline
= EQ (AREF (font_obj
, FONT_FOUNDRY_INDEX
), Qoutline
);
2224 /* Represent size of scalable fonts by point size. But use pixelsize for
2225 raster fonts to indicate that they are exactly that size. */
2227 len
+= 11; /* -SIZE */
2232 len
+= 7; /* :italic */
2234 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2236 weight
= w32_to_fc_weight (font
->lfWeight
);
2237 len
+= 1 + SBYTES (SYMBOL_NAME (weight
)); /* :WEIGHT */
2240 antialiasing
= lispy_antialias_type (font
->lfQuality
);
2241 if (! NILP (antialiasing
))
2242 len
+= 11 + SBYTES (SYMBOL_NAME (antialiasing
)); /* :antialias=NAME */
2244 /* Check that the buffer is big enough */
2249 p
+= sprintf (p
, "%s", font
->lfFaceName
);
2251 height
= font
->lfHeight
? eabs (font
->lfHeight
) : pixel_size
;
2257 float pointsize
= height
* 72.0 / one_w32_display_info
.resy
;
2258 /* Round to nearest half point. floor is used, since round is not
2259 supported in MS library. */
2260 pointsize
= floor (pointsize
* 2 + 0.5) / 2;
2261 p
+= sprintf (p
, "-%1.1f", pointsize
);
2264 p
+= sprintf (p
, ":pixelsize=%d", height
);
2267 if (SYMBOLP (weight
) && ! NILP (weight
))
2268 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2271 p
+= sprintf (p
, ":italic");
2273 if (SYMBOLP (antialiasing
) && ! NILP (antialiasing
))
2274 p
+= sprintf (p
, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing
)));
2279 /* Convert a logfont and point size into a fontconfig style font name.
2280 POINTSIZE is in tenths of points.
2281 If SIZE indicates the size of buffer FCNAME, into which the font name
2282 is written. If the buffer is not large enough to contain the name,
2283 the function returns -1, otherwise it returns the number of bytes
2284 written to FCNAME. */
2285 static int logfont_to_fcname(font
, pointsize
, fcname
, size
)
2293 Lisp_Object weight
= Qnil
;
2295 len
= strlen (font
->lfFaceName
) + 2;
2296 height
= pointsize
/ 10;
2297 while (height
/= 10)
2304 len
+= 7; /* :italic */
2305 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2307 weight
= w32_to_fc_weight (font
->lfWeight
);
2308 len
+= SBYTES (SYMBOL_NAME (weight
)) + 1;
2314 p
+= sprintf (p
, "%s-%d", font
->lfFaceName
, pointsize
/ 10);
2316 p
+= sprintf (p
, ".%d", pointsize
% 10);
2318 if (SYMBOLP (weight
) && !NILP (weight
))
2319 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2322 p
+= sprintf (p
, ":italic");
2324 return (p
- fcname
);
2328 compute_metrics (dc
, w32_font
, code
, metrics
)
2330 struct w32font_info
*w32_font
;
2332 struct w32_metric_cache
*metrics
;
2336 unsigned int options
= GGO_METRICS
;
2338 if (w32_font
->glyph_idx
)
2339 options
|= GGO_GLYPH_INDEX
;
2341 bzero (&transform
, sizeof (transform
));
2342 transform
.eM11
.value
= 1;
2343 transform
.eM22
.value
= 1;
2345 if (GetGlyphOutlineW (dc
, code
, options
, &gm
, 0, NULL
, &transform
)
2348 metrics
->lbearing
= gm
.gmptGlyphOrigin
.x
;
2349 metrics
->rbearing
= gm
.gmptGlyphOrigin
.x
+ gm
.gmBlackBoxX
;
2350 metrics
->width
= gm
.gmCellIncX
;
2351 metrics
->status
= W32METRIC_SUCCESS
;
2354 metrics
->status
= W32METRIC_FAIL
;
2358 clear_cached_metrics (w32_font
)
2359 struct w32font_info
*w32_font
;
2362 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
2364 if (w32_font
->cached_metrics
[i
])
2365 bzero (w32_font
->cached_metrics
[i
],
2366 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
2370 DEFUN ("x-select-font", Fx_select_font
, Sx_select_font
, 0, 2, 0,
2371 doc
: /* Read a font name using a W32 font selection dialog.
2372 Return fontconfig style font string corresponding to the selection.
2374 If FRAME is omitted or nil, it defaults to the selected frame.
2375 If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
2376 in the font selection dialog. */)
2377 (frame
, exclude_proportional
)
2378 Lisp_Object frame
, exclude_proportional
;
2380 FRAME_PTR f
= check_x_frame (frame
);
2388 bzero (&cf
, sizeof (cf
));
2389 bzero (&lf
, sizeof (lf
));
2391 cf
.lStructSize
= sizeof (cf
);
2392 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
2393 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
2395 /* If exclude_proportional is non-nil, limit the selection to
2396 monospaced fonts. */
2397 if (!NILP (exclude_proportional
))
2398 cf
.Flags
|= CF_FIXEDPITCHONLY
;
2402 /* Initialize as much of the font details as we can from the current
2404 hdc
= GetDC (FRAME_W32_WINDOW (f
));
2405 oldobj
= SelectObject (hdc
, FONT_HANDLE (FRAME_FONT (f
)));
2406 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
2407 if (GetTextMetrics (hdc
, &tm
))
2409 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
2410 lf
.lfWeight
= tm
.tmWeight
;
2411 lf
.lfItalic
= tm
.tmItalic
;
2412 lf
.lfUnderline
= tm
.tmUnderlined
;
2413 lf
.lfStrikeOut
= tm
.tmStruckOut
;
2414 lf
.lfCharSet
= tm
.tmCharSet
;
2415 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
2417 SelectObject (hdc
, oldobj
);
2418 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
2420 if (!ChooseFont (&cf
)
2421 || logfont_to_fcname (&lf
, cf
.iPointSize
, buf
, 100) < 0)
2424 return DECODE_SYSTEM (build_string (buf
));
2427 struct font_driver w32font_driver
=
2430 0, /* case insensitive */
2434 w32font_list_family
,
2435 NULL
, /* free_entity */
2438 NULL
, /* prepare_face */
2439 NULL
, /* done_face */
2441 w32font_encode_char
,
2442 w32font_text_extents
,
2444 NULL
, /* get_bitmap */
2445 NULL
, /* free_bitmap */
2446 NULL
, /* get_outline */
2447 NULL
, /* free_outline */
2448 NULL
, /* anchor_point */
2449 NULL
, /* otf_capability */
2450 NULL
, /* otf_drive */
2451 NULL
, /* start_for_frame */
2452 NULL
, /* end_for_frame */
2457 /* Initialize state that does not change between invocations. This is only
2458 called when Emacs is dumped. */
2462 DEFSYM (Qgdi
, "gdi");
2463 DEFSYM (Quniscribe
, "uniscribe");
2464 DEFSYM (QCformat
, ":format");
2466 /* Generic font families. */
2467 DEFSYM (Qmonospace
, "monospace");
2468 DEFSYM (Qserif
, "serif");
2469 DEFSYM (Qsansserif
, "sansserif");
2470 DEFSYM (Qscript
, "script");
2471 DEFSYM (Qdecorative
, "decorative");
2473 DEFSYM (Qsans_serif
, "sans_serif");
2474 DEFSYM (Qsans
, "sans");
2475 DEFSYM (Qmono
, "mono");
2477 /* Fake foundries. */
2478 DEFSYM (Qraster
, "raster");
2479 DEFSYM (Qoutline
, "outline");
2480 DEFSYM (Qunknown
, "unknown");
2483 DEFSYM (Qstandard
, "standard");
2484 DEFSYM (Qsubpixel
, "subpixel");
2485 DEFSYM (Qnatural
, "natural");
2493 DEFSYM (Qlatin
, "latin");
2494 DEFSYM (Qgreek
, "greek");
2495 DEFSYM (Qcoptic
, "coptic");
2496 DEFSYM (Qcyrillic
, "cyrillic");
2497 DEFSYM (Qarmenian
, "armenian");
2498 DEFSYM (Qhebrew
, "hebrew");
2499 DEFSYM (Qarabic
, "arabic");
2500 DEFSYM (Qsyriac
, "syriac");
2501 DEFSYM (Qnko
, "nko");
2502 DEFSYM (Qthaana
, "thaana");
2503 DEFSYM (Qdevanagari
, "devanagari");
2504 DEFSYM (Qbengali
, "bengali");
2505 DEFSYM (Qgurmukhi
, "gurmukhi");
2506 DEFSYM (Qgujarati
, "gujarati");
2507 DEFSYM (Qoriya
, "oriya");
2508 DEFSYM (Qtamil
, "tamil");
2509 DEFSYM (Qtelugu
, "telugu");
2510 DEFSYM (Qkannada
, "kannada");
2511 DEFSYM (Qmalayalam
, "malayalam");
2512 DEFSYM (Qsinhala
, "sinhala");
2513 DEFSYM (Qthai
, "thai");
2514 DEFSYM (Qlao
, "lao");
2515 DEFSYM (Qtibetan
, "tibetan");
2516 DEFSYM (Qmyanmar
, "myanmar");
2517 DEFSYM (Qgeorgian
, "georgian");
2518 DEFSYM (Qhangul
, "hangul");
2519 DEFSYM (Qethiopic
, "ethiopic");
2520 DEFSYM (Qcherokee
, "cherokee");
2521 DEFSYM (Qcanadian_aboriginal
, "canadian-aboriginal");
2522 DEFSYM (Qogham
, "ogham");
2523 DEFSYM (Qrunic
, "runic");
2524 DEFSYM (Qkhmer
, "khmer");
2525 DEFSYM (Qmongolian
, "mongolian");
2526 DEFSYM (Qsymbol
, "symbol");
2527 DEFSYM (Qbraille
, "braille");
2528 DEFSYM (Qhan
, "han");
2529 DEFSYM (Qideographic_description
, "ideographic-description");
2530 DEFSYM (Qcjk_misc
, "cjk-misc");
2531 DEFSYM (Qkana
, "kana");
2532 DEFSYM (Qbopomofo
, "bopomofo");
2533 DEFSYM (Qkanbun
, "kanbun");
2535 DEFSYM (Qbyzantine_musical_symbol
, "byzantine-musical-symbol");
2536 DEFSYM (Qmusical_symbol
, "musical-symbol");
2537 DEFSYM (Qmathematical
, "mathematical");
2538 DEFSYM (Qcham
, "cham");
2539 DEFSYM (Qphonetic
, "phonetic");
2540 DEFSYM (Qbalinese
, "balinese");
2541 DEFSYM (Qbuginese
, "buginese");
2542 DEFSYM (Qbuhid
, "buhid");
2543 DEFSYM (Qcuneiform
, "cuneiform");
2544 DEFSYM (Qcypriot
, "cypriot");
2545 DEFSYM (Qdeseret
, "deseret");
2546 DEFSYM (Qglagolitic
, "glagolitic");
2547 DEFSYM (Qgothic
, "gothic");
2548 DEFSYM (Qhanunoo
, "hanunoo");
2549 DEFSYM (Qkharoshthi
, "kharoshthi");
2550 DEFSYM (Qlimbu
, "limbu");
2551 DEFSYM (Qlinear_b
, "linear_b");
2552 DEFSYM (Qold_italic
, "old_italic");
2553 DEFSYM (Qold_persian
, "old_persian");
2554 DEFSYM (Qosmanya
, "osmanya");
2555 DEFSYM (Qphags_pa
, "phags-pa");
2556 DEFSYM (Qphoenician
, "phoenician");
2557 DEFSYM (Qshavian
, "shavian");
2558 DEFSYM (Qsyloti_nagri
, "syloti_nagri");
2559 DEFSYM (Qtagalog
, "tagalog");
2560 DEFSYM (Qtagbanwa
, "tagbanwa");
2561 DEFSYM (Qtai_le
, "tai_le");
2562 DEFSYM (Qtifinagh
, "tifinagh");
2563 DEFSYM (Qugaritic
, "ugaritic");
2565 /* W32 font encodings. */
2566 DEFVAR_LISP ("w32-charset-info-alist",
2567 &Vw32_charset_info_alist
,
2568 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
2569 Each entry should be of the form:
2571 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2573 where CHARSET_NAME is a string used in font names to identify the charset,
2574 WINDOWS_CHARSET is a symbol that can be one of:
2576 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2577 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2578 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2579 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2580 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2581 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2584 CODEPAGE should be an integer specifying the codepage that should be used
2585 to display the character set, t to do no translation and output as Unicode,
2586 or nil to do no translation and output as 8 bit (or multibyte on far-east
2587 versions of Windows) characters. */);
2588 Vw32_charset_info_alist
= Qnil
;
2590 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
2591 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
2592 DEFSYM (Qw32_charset_default
, "w32-charset-default");
2593 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
2594 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
2595 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
2596 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
2597 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
2598 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
2599 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
2600 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
2601 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
2602 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
2603 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
2604 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
2605 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
2606 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
2607 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
2608 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
2610 defsubr (&Sx_select_font
);
2612 w32font_driver
.type
= Qgdi
;
2613 register_font_driver (&w32font_driver
, NULL
);
2616 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2617 (do not change this comment) */