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
;
239 font_object
= font_make_object (VECSIZE (struct w32font_info
));
241 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
249 /* w32 implementation of close for font_backend.
250 Close FONT on frame F. */
252 w32font_close (f
, font
)
257 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
259 /* Delete the GDI font object. */
260 DeleteObject (w32_font
->hfont
);
262 /* Free all the cached metrics. */
263 if (w32_font
->cached_metrics
)
265 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
267 if (w32_font
->cached_metrics
[i
])
268 xfree (w32_font
->cached_metrics
[i
]);
270 xfree (w32_font
->cached_metrics
);
271 w32_font
->cached_metrics
= NULL
;
275 /* w32 implementation of has_char for font backend.
277 If FONT_ENTITY has a glyph for character C (Unicode code point),
278 return 1. If not, return 0. If a font must be opened to check
281 w32font_has_char (entity
, c
)
285 Lisp_Object supported_scripts
, extra
, script
;
288 extra
= AREF (entity
, FONT_EXTRA_INDEX
);
292 supported_scripts
= assq_no_quit (QCscript
, extra
);
293 if (!CONSP (supported_scripts
))
296 supported_scripts
= XCDR (supported_scripts
);
298 script
= CHAR_TABLE_REF (Vchar_script_table
, c
);
300 return (memq_no_quit (script
, supported_scripts
)) ? -1 : 0;
303 /* w32 implementation of encode_char for font backend.
304 Return a glyph code of FONT for characer C (Unicode code point).
305 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
307 w32font_encode_char (font
, c
)
319 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
321 /* If glyph indexing is not working for this font, just return the
322 unicode code-point. */
323 if (!w32_font
->glyph_idx
)
328 /* TODO: Encode as surrogate pair and lookup the glyph. */
329 return FONT_INVALID_CODE
;
337 bzero (&result
, sizeof (result
));
338 result
.lStructSize
= sizeof (result
);
339 result
.lpGlyphs
= out
;
342 f
= XFRAME (selected_frame
);
344 dc
= get_frame_dc (f
);
345 old_font
= SelectObject (dc
, w32_font
->hfont
);
347 /* GetCharacterPlacement is used here rather than GetGlyphIndices because
348 it is supported on Windows NT 4 and 9x/ME. But it cannot reliably report
349 missing glyphs, see below for workaround. */
350 retval
= GetCharacterPlacementW (dc
, in
, len
, 0, &result
, 0);
352 SelectObject (dc
, old_font
);
353 release_frame_dc (f
, dc
);
357 if (result
.nGlyphs
!= 1 || !result
.lpGlyphs
[0]
358 /* GetCharacterPlacementW seems to return 3, which seems to be
359 the space glyph in most/all truetype fonts, instead of 0
360 for unsupported glyphs. */
361 || (result
.lpGlyphs
[0] == 3 && !iswspace (in
[0])))
362 return FONT_INVALID_CODE
;
363 return result
.lpGlyphs
[0];
368 /* Mark this font as not supporting glyph indices. This can happen
369 on Windows9x, and maybe with non-Truetype fonts on NT etc. */
370 w32_font
->glyph_idx
= 0;
371 /* Clear metrics cache. */
372 clear_cached_metrics (w32_font
);
378 /* w32 implementation of text_extents for font backend.
379 Perform the size computation of glyphs of FONT and fillin members
380 of METRICS. The glyphs are specified by their glyph codes in
381 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
382 case just return the overall width. */
384 w32font_text_extents (font
, code
, nglyphs
, metrics
)
388 struct font_metrics
*metrics
;
391 HFONT old_font
= NULL
;
398 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
402 bzero (metrics
, sizeof (struct font_metrics
));
403 metrics
->ascent
= font
->ascent
;
404 metrics
->descent
= font
->descent
;
406 for (i
= 0; i
< nglyphs
; i
++)
408 struct w32_metric_cache
*char_metric
;
409 int block
= *(code
+ i
) / CACHE_BLOCKSIZE
;
410 int pos_in_block
= *(code
+ i
) % CACHE_BLOCKSIZE
;
412 if (block
>= w32_font
->n_cache_blocks
)
414 if (!w32_font
->cached_metrics
)
415 w32_font
->cached_metrics
416 = xmalloc ((block
+ 1)
417 * sizeof (struct w32_cached_metric
*));
419 w32_font
->cached_metrics
420 = xrealloc (w32_font
->cached_metrics
,
422 * sizeof (struct w32_cached_metric
*));
423 bzero (w32_font
->cached_metrics
+ w32_font
->n_cache_blocks
,
424 ((block
+ 1 - w32_font
->n_cache_blocks
)
425 * sizeof (struct w32_cached_metric
*)));
426 w32_font
->n_cache_blocks
= block
+ 1;
429 if (!w32_font
->cached_metrics
[block
])
431 w32_font
->cached_metrics
[block
]
432 = xmalloc (CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
433 bzero (w32_font
->cached_metrics
[block
],
434 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
437 char_metric
= w32_font
->cached_metrics
[block
] + pos_in_block
;
439 if (char_metric
->status
== W32METRIC_NO_ATTEMPT
)
443 /* TODO: Frames can come and go, and their fonts
444 outlive them. So we can't cache the frame in the
445 font structure. Use selected_frame until the API
446 is updated to pass in a frame. */
447 f
= XFRAME (selected_frame
);
449 dc
= get_frame_dc (f
);
450 old_font
= SelectObject (dc
, w32_font
->hfont
);
452 compute_metrics (dc
, w32_font
, *(code
+ i
), char_metric
);
455 if (char_metric
->status
== W32METRIC_SUCCESS
)
457 metrics
->lbearing
= min (metrics
->lbearing
,
458 metrics
->width
+ char_metric
->lbearing
);
459 metrics
->rbearing
= max (metrics
->rbearing
,
460 metrics
->width
+ char_metric
->rbearing
);
461 metrics
->width
+= char_metric
->width
;
464 /* If we couldn't get metrics for a char,
465 use alternative method. */
468 /* If we got through everything, return. */
473 /* Restore state and release DC. */
474 SelectObject (dc
, old_font
);
475 release_frame_dc (f
, dc
);
478 return metrics
->width
;
482 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
483 fallback on other methods that will at least give some of the metric
486 wcode
= alloca (nglyphs
* sizeof (WORD
));
487 for (i
= 0; i
< nglyphs
; i
++)
489 if (code
[i
] < 0x10000)
493 /* TODO: Convert to surrogate, reallocating array if needed */
500 /* TODO: Frames can come and go, and their fonts outlive
501 them. So we can't cache the frame in the font structure. Use
502 selected_frame until the API is updated to pass in a
504 f
= XFRAME (selected_frame
);
506 dc
= get_frame_dc (f
);
507 old_font
= SelectObject (dc
, w32_font
->hfont
);
510 if (GetTextExtentPoint32W (dc
, wcode
, nglyphs
, &size
))
512 total_width
= size
.cx
;
515 /* On 95/98/ME, only some unicode functions are available, so fallback
516 on doing a dummy draw to find the total width. */
520 rect
.top
= 0; rect
.bottom
= font
->height
; rect
.left
= 0; rect
.right
= 1;
521 DrawTextW (dc
, wcode
, nglyphs
, &rect
,
522 DT_CALCRECT
| DT_NOPREFIX
| DT_SINGLELINE
);
523 total_width
= rect
.right
;
526 /* Give our best estimate of the metrics, based on what we know. */
529 metrics
->width
= total_width
;
530 metrics
->lbearing
= 0;
531 metrics
->rbearing
= total_width
+ w32_font
->metrics
.tmOverhang
;
534 /* Restore state and release DC. */
535 SelectObject (dc
, old_font
);
536 release_frame_dc (f
, dc
);
541 /* w32 implementation of draw for font backend.
543 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
544 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
545 is nonzero, fill the background in advance. It is assured that
546 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
548 TODO: Currently this assumes that the colors and fonts are already
549 set in the DC. This seems to be true now, but maybe only due to
550 the old font code setting it up. It may be safer to resolve faces
551 and fonts in here and set them explicitly
555 w32font_draw (s
, from
, to
, x
, y
, with_background
)
556 struct glyph_string
*s
;
557 int from
, to
, x
, y
, with_background
;
561 struct w32font_info
*w32font
= (struct w32font_info
*) s
->font
;
563 options
= w32font
->glyph_idx
;
565 /* Save clip region for later restoration. */
566 GetClipRgn(s
->hdc
, orig_clip
);
568 if (s
->num_clips
> 0)
570 HRGN new_clip
= CreateRectRgnIndirect (s
->clip
);
572 if (s
->num_clips
> 1)
574 HRGN clip2
= CreateRectRgnIndirect (s
->clip
+ 1);
576 CombineRgn (new_clip
, new_clip
, clip2
, RGN_OR
);
577 DeleteObject (clip2
);
580 SelectClipRgn (s
->hdc
, new_clip
);
581 DeleteObject (new_clip
);
584 /* Using OPAQUE background mode can clear more background than expected
585 when Cleartype is used. Draw the background manually to avoid this. */
586 SetBkMode (s
->hdc
, TRANSPARENT
);
591 struct font
*font
= s
->font
;
593 brush
= CreateSolidBrush (s
->gc
->background
);
595 rect
.top
= y
- font
->ascent
;
596 rect
.right
= x
+ s
->width
;
597 rect
.bottom
= y
+ font
->descent
;
598 FillRect (s
->hdc
, &rect
, brush
);
599 DeleteObject (brush
);
604 int len
= to
- from
, i
;
606 for (i
= 0; i
< len
; i
++)
607 ExtTextOutW (s
->hdc
, x
+ i
, y
, options
, NULL
,
608 s
->char2b
+ from
+ i
, 1, NULL
);
611 ExtTextOutW (s
->hdc
, x
, y
, options
, NULL
, s
->char2b
+ from
, to
- from
, NULL
);
613 /* Restore clip region. */
614 if (s
->num_clips
> 0)
616 SelectClipRgn (s
->hdc
, orig_clip
);
620 /* w32 implementation of free_entity for font backend.
621 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
622 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
624 w32font_free_entity (Lisp_Object entity);
627 /* w32 implementation of prepare_face for font backend.
628 Optional (if FACE->extra is not used).
629 Prepare FACE for displaying characters by FONT on frame F by
630 storing some data in FACE->extra. If successful, return 0.
631 Otherwise, return -1.
633 w32font_prepare_face (FRAME_PTR f, struct face *face);
635 /* w32 implementation of done_face for font backend.
637 Done FACE for displaying characters by FACE->font on frame F.
639 w32font_done_face (FRAME_PTR f, struct face *face); */
641 /* w32 implementation of get_bitmap for font backend.
643 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
644 intended that this method is called from the other font-driver
647 w32font_get_bitmap (struct font *font, unsigned code,
648 struct font_bitmap *bitmap, int bits_per_pixel);
650 /* w32 implementation of free_bitmap for font backend.
652 Free bitmap data in BITMAP.
654 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
656 /* w32 implementation of get_outline for font backend.
658 Return an outline data for glyph-code CODE of FONT. The format
659 of the outline data depends on the font-driver.
661 w32font_get_outline (struct font *font, unsigned code);
663 /* w32 implementation of free_outline for font backend.
665 Free OUTLINE (that is obtained by the above method).
667 w32font_free_outline (struct font *font, void *outline);
669 /* w32 implementation of anchor_point for font backend.
671 Get coordinates of the INDEXth anchor point of the glyph whose
672 code is CODE. Store the coordinates in *X and *Y. Return 0 if
673 the operations was successfull. Otherwise return -1.
675 w32font_anchor_point (struct font *font, unsigned code,
676 int index, int *x, int *y);
678 /* w32 implementation of otf_capability for font backend.
680 Return a list describing which scripts/languages FONT
681 supports by which GSUB/GPOS features of OpenType tables.
683 w32font_otf_capability (struct font *font);
685 /* w32 implementation of otf_drive for font backend.
687 Apply FONT's OTF-FEATURES to the glyph string.
689 FEATURES specifies which OTF features to apply in this format:
690 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
691 See the documentation of `font-drive-otf' for the detail.
693 This method applies the specified features to the codes in the
694 elements of GSTRING-IN (between FROMth and TOth). The output
695 codes are stored in GSTRING-OUT at the IDXth element and the
698 Return the number of output codes. If none of the features are
699 applicable to the input data, return 0. If GSTRING-OUT is too
702 w32font_otf_drive (struct font *font, Lisp_Object features,
703 Lisp_Object gstring_in, int from, int to,
704 Lisp_Object gstring_out, int idx,
705 int alternate_subst);
708 /* Internal implementation of w32font_list.
709 Additional parameter opentype_only restricts the returned fonts to
710 opentype fonts, which can be used with the Uniscribe backend. */
712 w32font_list_internal (frame
, font_spec
, opentype_only
)
713 Lisp_Object frame
, font_spec
;
716 struct font_callback_data match_data
;
718 FRAME_PTR f
= XFRAME (frame
);
720 match_data
.orig_font_spec
= font_spec
;
721 match_data
.list
= Qnil
;
722 match_data
.frame
= frame
;
724 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
725 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
727 match_data
.opentype_only
= opentype_only
;
729 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
731 if (match_data
.pattern
.lfFaceName
[0] == '\0')
733 /* EnumFontFamiliesEx does not take other fields into account if
734 font name is blank, so need to use two passes. */
735 list_all_matching_fonts (&match_data
);
739 dc
= get_frame_dc (f
);
741 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
742 (FONTENUMPROC
) add_font_entity_to_list
,
743 (LPARAM
) &match_data
, 0);
744 release_frame_dc (f
, dc
);
747 return NILP (match_data
.list
) ? Qnil
: match_data
.list
;
750 /* Internal implementation of w32font_match.
751 Additional parameter opentype_only restricts the returned fonts to
752 opentype fonts, which can be used with the Uniscribe backend. */
754 w32font_match_internal (frame
, font_spec
, opentype_only
)
755 Lisp_Object frame
, font_spec
;
758 struct font_callback_data match_data
;
760 FRAME_PTR f
= XFRAME (frame
);
762 match_data
.orig_font_spec
= font_spec
;
763 match_data
.frame
= frame
;
764 match_data
.list
= Qnil
;
766 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
767 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
769 match_data
.opentype_only
= opentype_only
;
771 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
773 dc
= get_frame_dc (f
);
775 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
776 (FONTENUMPROC
) add_one_font_entity_to_list
,
777 (LPARAM
) &match_data
, 0);
778 release_frame_dc (f
, dc
);
780 return NILP (match_data
.list
) ? Qnil
: XCAR (match_data
.list
);
784 w32font_open_internal (f
, font_entity
, pixel_size
, font_object
)
786 Lisp_Object font_entity
;
788 Lisp_Object font_object
;
793 HFONT hfont
, old_font
;
794 Lisp_Object val
, extra
;
795 struct w32font_info
*w32_font
;
797 OUTLINETEXTMETRIC
* metrics
= NULL
;
799 w32_font
= (struct w32font_info
*) XFONT_OBJECT (font_object
);
800 font
= (struct font
*) w32_font
;
805 /* Copy from font entity. */
806 for (i
= 0; i
< FONT_ENTITY_MAX
; i
++)
807 ASET (font_object
, i
, AREF (font_entity
, i
));
808 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
810 bzero (&logfont
, sizeof (logfont
));
811 fill_in_logfont (f
, &logfont
, font_entity
);
813 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
814 limitations in bitmap fonts. */
815 val
= AREF (font_entity
, FONT_FOUNDRY_INDEX
);
816 if (!EQ (val
, Qraster
))
817 logfont
.lfOutPrecision
= OUT_TT_PRECIS
;
819 size
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
823 logfont
.lfHeight
= -size
;
824 hfont
= CreateFontIndirect (&logfont
);
829 /* Get the metrics for this font. */
830 dc
= get_frame_dc (f
);
831 old_font
= SelectObject (dc
, hfont
);
833 /* Try getting the outline metrics (only works for truetype fonts). */
834 len
= GetOutlineTextMetrics (dc
, 0, NULL
);
837 metrics
= (OUTLINETEXTMETRIC
*) alloca (len
);
838 if (GetOutlineTextMetrics (dc
, len
, metrics
))
839 bcopy (&metrics
->otmTextMetrics
, &w32_font
->metrics
,
840 sizeof (TEXTMETRIC
));
844 /* If it supports outline metrics, it should support Glyph Indices. */
845 w32_font
->glyph_idx
= ETO_GLYPH_INDEX
;
850 GetTextMetrics (dc
, &w32_font
->metrics
);
851 w32_font
->glyph_idx
= 0;
854 w32_font
->cached_metrics
= NULL
;
855 w32_font
->n_cache_blocks
= 0;
857 SelectObject (dc
, old_font
);
858 release_frame_dc (f
, dc
);
860 w32_font
->hfont
= hfont
;
865 /* We don't know how much space we need for the full name, so start with
866 96 bytes and go up in steps of 32. */
869 while (name
&& w32font_full_name (&logfont
, font_entity
, pixel_size
,
876 font
->props
[FONT_FULLNAME_INDEX
]
877 = make_unibyte_string (name
, strlen (name
));
879 font
->props
[FONT_FULLNAME_INDEX
] =
880 make_unibyte_string (logfont
.lfFaceName
, len
);
883 font
->max_width
= w32_font
->metrics
.tmMaxCharWidth
;
884 font
->height
= w32_font
->metrics
.tmHeight
885 + 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
;
920 font
->underline_thickness
= metrics
->otmsUnderscoreSize
;
921 font
->underline_position
= -metrics
->otmsUnderscorePosition
;
925 font
->underline_thickness
= 0;
926 font
->underline_position
= -1;
929 /* For temporary compatibility with legacy code that expects the
930 name to be usable in x-list-fonts. Eventually we expect to change
931 x-list-fonts and other places that use fonts so that this can be
932 an fcname or similar. */
933 font
->props
[FONT_NAME_INDEX
] = Ffont_xlfd_name (font_object
, Qnil
);
938 /* Callback function for EnumFontFamiliesEx.
939 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
941 add_font_name_to_list (logical_font
, physical_font
, font_type
, list_object
)
942 ENUMLOGFONTEX
*logical_font
;
943 NEWTEXTMETRICEX
*physical_font
;
947 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
950 /* Skip vertical fonts (intended only for printing) */
951 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
954 family
= font_intern_prop (logical_font
->elfLogFont
.lfFaceName
,
955 strlen (logical_font
->elfLogFont
.lfFaceName
), 1);
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 font_intern_prop (lf
->lfFaceName
, strlen (lf
->lfFaceName
), 1));
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
, make_number (physical_font
->ntmTm
.tmHeight
));
1041 ASET (entity
, FONT_SIZE_INDEX
, make_number (0));
1043 /* Cache unicode codepoints covered by this font, as there is no other way
1044 of getting this information easily. */
1045 if (font_type
& TRUETYPE_FONTTYPE
)
1047 tem
= font_supported_scripts (&physical_font
->ntmFontSig
);
1049 font_put_extra (entity
, QCscript
, tem
);
1052 /* This information is not fully available when opening fonts, so
1053 save it here. Only Windows 2000 and later return information
1054 about opentype and type1 fonts, so need a fallback for detecting
1055 truetype so that this information is not any worse than we could
1056 have obtained later. */
1057 if (EQ (backend
, Quniscribe
) && (full_type
& NTMFLAGS_OPENTYPE
))
1058 tem
= intern ("opentype");
1059 else if (font_type
& TRUETYPE_FONTTYPE
)
1060 tem
= intern ("truetype");
1061 else if (full_type
& NTM_PS_OPENTYPE
)
1062 tem
= intern ("postscript");
1063 else if (full_type
& NTM_TYPE1
)
1064 tem
= intern ("type1");
1065 else if (font_type
& RASTER_FONTTYPE
)
1066 tem
= intern ("w32bitmap");
1068 tem
= intern ("w32vector");
1070 font_put_extra (entity
, QCformat
, tem
);
1076 /* Convert generic families to the family portion of lfPitchAndFamily. */
1078 w32_generic_family (Lisp_Object name
)
1080 /* Generic families. */
1081 if (EQ (name
, Qmonospace
) || EQ (name
, Qmono
))
1083 else if (EQ (name
, Qsans
) || EQ (name
, Qsans_serif
) || EQ (name
, Qsansserif
))
1085 else if (EQ (name
, Qserif
))
1087 else if (EQ (name
, Qdecorative
))
1088 return FF_DECORATIVE
;
1089 else if (EQ (name
, Qscript
))
1096 logfonts_match (font
, pattern
)
1097 LOGFONT
*font
, *pattern
;
1099 /* Only check height for raster fonts. */
1100 if (pattern
->lfHeight
&& font
->lfOutPrecision
== OUT_STRING_PRECIS
1101 && font
->lfHeight
!= pattern
->lfHeight
)
1104 /* Have some flexibility with weights. */
1105 if (pattern
->lfWeight
1106 && ((font
->lfWeight
< (pattern
->lfWeight
- 150))
1107 || font
->lfWeight
> (pattern
->lfWeight
+ 150)))
1110 /* Charset and face should be OK. Italic has to be checked
1111 against the original spec, in case we don't have any preference. */
1115 /* Codepage Bitfields in FONTSIGNATURE struct. */
1116 #define CSB_JAPANESE (1 << 17)
1117 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1118 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1121 font_matches_spec (type
, font
, spec
, backend
, logfont
)
1123 NEWTEXTMETRICEX
*font
;
1125 Lisp_Object backend
;
1128 Lisp_Object extra
, val
;
1130 /* Check italic. Can't check logfonts, since it is a boolean field,
1131 so there is no difference between "non-italic" and "don't care". */
1133 int slant
= FONT_SLANT_NUMERIC (spec
);
1136 && ((slant
> 150 && !font
->ntmTm
.tmItalic
)
1137 || (slant
<= 150 && font
->ntmTm
.tmItalic
)))
1141 /* Check adstyle against generic family. */
1142 val
= AREF (spec
, FONT_ADSTYLE_INDEX
);
1145 BYTE family
= w32_generic_family (val
);
1146 if (family
!= FF_DONTCARE
1147 && family
!= (font
->ntmTm
.tmPitchAndFamily
& 0xF0))
1152 val
= AREF (spec
, FONT_SPACING_INDEX
);
1155 int spacing
= XINT (val
);
1156 int proportional
= (spacing
< FONT_SPACING_MONO
);
1158 if ((proportional
&& !(font
->ntmTm
.tmPitchAndFamily
& 0x01))
1159 || (!proportional
&& (font
->ntmTm
.tmPitchAndFamily
& 0x01)))
1163 /* Check extra parameters. */
1164 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
1165 CONSP (extra
); extra
= XCDR (extra
))
1167 Lisp_Object extra_entry
;
1168 extra_entry
= XCAR (extra
);
1169 if (CONSP (extra_entry
))
1171 Lisp_Object key
= XCAR (extra_entry
);
1173 val
= XCDR (extra_entry
);
1174 if (EQ (key
, QCscript
) && SYMBOLP (val
))
1176 /* Only truetype fonts will have information about what
1177 scripts they support. This probably means the user
1178 will have to force Emacs to use raster, postscript
1179 or atm fonts for non-ASCII text. */
1180 if (type
& TRUETYPE_FONTTYPE
)
1183 = font_supported_scripts (&font
->ntmFontSig
);
1184 if (! memq_no_quit (val
, support
))
1189 /* Return specific matches, but play it safe. Fonts
1190 that cover more than their charset would suggest
1191 are likely to be truetype or opentype fonts,
1193 if (EQ (val
, Qlatin
))
1195 /* Although every charset but symbol, thai and
1196 arabic contains the basic ASCII set of latin
1197 characters, Emacs expects much more. */
1198 if (font
->ntmTm
.tmCharSet
!= ANSI_CHARSET
)
1201 else if (EQ (val
, Qsymbol
))
1203 if (font
->ntmTm
.tmCharSet
!= SYMBOL_CHARSET
)
1206 else if (EQ (val
, Qcyrillic
))
1208 if (font
->ntmTm
.tmCharSet
!= RUSSIAN_CHARSET
)
1211 else if (EQ (val
, Qgreek
))
1213 if (font
->ntmTm
.tmCharSet
!= GREEK_CHARSET
)
1216 else if (EQ (val
, Qarabic
))
1218 if (font
->ntmTm
.tmCharSet
!= ARABIC_CHARSET
)
1221 else if (EQ (val
, Qhebrew
))
1223 if (font
->ntmTm
.tmCharSet
!= HEBREW_CHARSET
)
1226 else if (EQ (val
, Qthai
))
1228 if (font
->ntmTm
.tmCharSet
!= THAI_CHARSET
)
1231 else if (EQ (val
, Qkana
))
1233 if (font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1236 else if (EQ (val
, Qbopomofo
))
1238 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
)
1241 else if (EQ (val
, Qhangul
))
1243 if (font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1244 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
)
1247 else if (EQ (val
, Qhan
))
1249 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
1250 && font
->ntmTm
.tmCharSet
!= GB2312_CHARSET
1251 && font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1252 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
1253 && font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1257 /* Other scripts unlikely to be handled by non-truetype
1262 else if (EQ (key
, QClang
) && SYMBOLP (val
))
1264 /* Just handle the CJK languages here, as the lang
1265 parameter is used to select a font with appropriate
1266 glyphs in the cjk unified ideographs block. Other fonts
1267 support for a language can be solely determined by
1268 its character coverage. */
1271 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_JAPANESE
))
1274 else if (EQ (val
, Qko
))
1276 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_KOREAN
))
1279 else if (EQ (val
, Qzh
))
1281 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_CHINESE
))
1285 /* Any other language, we don't recognize it. Only the above
1286 currently appear in fontset.el, so it isn't worth
1287 creating a mapping table of codepages/scripts to languages
1288 or opening the font to see if there are any language tags
1289 in it that the W32 API does not expose. Fontset
1290 spec should have a fallback, as some backends do
1291 not recognize language at all. */
1294 else if (EQ (key
, QCotf
) && CONSP (val
))
1296 /* OTF features only supported by the uniscribe backend. */
1297 if (EQ (backend
, Quniscribe
))
1299 if (!uniscribe_check_otf (logfont
, val
))
1311 w32font_coverage_ok (coverage
, charset
)
1312 FONTSIGNATURE
* coverage
;
1315 DWORD subrange1
= coverage
->fsUsb
[1];
1317 #define SUBRANGE1_HAN_MASK 0x08000000
1318 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1319 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1321 if (charset
== GB2312_CHARSET
|| charset
== CHINESEBIG5_CHARSET
)
1323 return (subrange1
& SUBRANGE1_HAN_MASK
) == SUBRANGE1_HAN_MASK
;
1325 else if (charset
== SHIFTJIS_CHARSET
)
1327 return (subrange1
& SUBRANGE1_JAPANESE_MASK
) == SUBRANGE1_JAPANESE_MASK
;
1329 else if (charset
== HANGEUL_CHARSET
)
1331 return (subrange1
& SUBRANGE1_HANGEUL_MASK
) == SUBRANGE1_HANGEUL_MASK
;
1337 /* Callback function for EnumFontFamiliesEx.
1338 * Checks if a font matches everything we are trying to check agaist,
1339 * and if so, adds it to a list. Both the data we are checking against
1340 * and the list to which the fonts are added are passed in via the
1341 * lparam argument, in the form of a font_callback_data struct. */
1343 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1344 ENUMLOGFONTEX
*logical_font
;
1345 NEWTEXTMETRICEX
*physical_font
;
1349 struct font_callback_data
*match_data
1350 = (struct font_callback_data
*) lParam
;
1351 Lisp_Object backend
= match_data
->opentype_only
? Quniscribe
: Qgdi
;
1353 if ((!match_data
->opentype_only
1354 || (((physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
1355 || (font_type
& TRUETYPE_FONTTYPE
))
1356 /* For the uniscribe backend, only consider fonts that claim
1357 to cover at least some part of Unicode. */
1358 && (physical_font
->ntmFontSig
.fsUsb
[3]
1359 || physical_font
->ntmFontSig
.fsUsb
[2]
1360 || physical_font
->ntmFontSig
.fsUsb
[1]
1361 || (physical_font
->ntmFontSig
.fsUsb
[0] & 0x3fffffff))))
1362 && logfonts_match (&logical_font
->elfLogFont
, &match_data
->pattern
)
1363 && font_matches_spec (font_type
, physical_font
,
1364 match_data
->orig_font_spec
, backend
,
1365 &logical_font
->elfLogFont
)
1366 && w32font_coverage_ok (&physical_font
->ntmFontSig
,
1367 match_data
->pattern
.lfCharSet
)
1368 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1369 We limit this to raster fonts, because the test can catch some
1370 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1371 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1372 therefore get through this test. Since full names can be prefixed
1373 by a foundry, we accept raster fonts if the font name is found
1374 anywhere within the full name. */
1375 && (logical_font
->elfLogFont
.lfOutPrecision
!= OUT_STRING_PRECIS
1376 || strstr (logical_font
->elfFullName
,
1377 logical_font
->elfLogFont
.lfFaceName
)))
1380 = w32_enumfont_pattern_entity (match_data
->frame
, logical_font
,
1381 physical_font
, font_type
,
1382 &match_data
->pattern
,
1386 Lisp_Object spec_charset
= AREF (match_data
->orig_font_spec
,
1387 FONT_REGISTRY_INDEX
);
1389 /* If registry was specified as iso10646-1, only report
1390 ANSI and DEFAULT charsets, as most unicode fonts will
1391 contain one of those plus others. */
1392 if ((EQ (spec_charset
, Qiso10646_1
)
1393 || EQ (spec_charset
, Qunicode_bmp
)
1394 || EQ (spec_charset
, Qunicode_sip
))
1395 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
1396 && logical_font
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
)
1398 /* If registry was specified, but did not map to a windows
1399 charset, only report fonts that have unknown charsets.
1400 This will still report fonts that don't match, but at
1401 least it eliminates known definite mismatches. */
1402 else if (!NILP (spec_charset
)
1403 && !EQ (spec_charset
, Qiso10646_1
)
1404 && !EQ (spec_charset
, Qunicode_bmp
)
1405 && !EQ (spec_charset
, Qunicode_sip
)
1406 && match_data
->pattern
.lfCharSet
== DEFAULT_CHARSET
1407 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
)
1410 /* If registry was specified, ensure it is reported as the same. */
1411 if (!NILP (spec_charset
))
1412 ASET (entity
, FONT_REGISTRY_INDEX
, spec_charset
);
1414 match_data
->list
= Fcons (entity
, match_data
->list
);
1416 /* If no registry specified, duplicate iso8859-1 truetype fonts
1418 if (NILP (spec_charset
)
1419 && font_type
== TRUETYPE_FONTTYPE
1420 && logical_font
->elfLogFont
.lfCharSet
== ANSI_CHARSET
)
1422 Lisp_Object tem
= Fcopy_font_spec (entity
);
1423 ASET (tem
, FONT_REGISTRY_INDEX
, Qiso10646_1
);
1424 match_data
->list
= Fcons (tem
, match_data
->list
);
1431 /* Callback function for EnumFontFamiliesEx.
1432 * Terminates the search once we have a match. */
1434 add_one_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1435 ENUMLOGFONTEX
*logical_font
;
1436 NEWTEXTMETRICEX
*physical_font
;
1440 struct font_callback_data
*match_data
1441 = (struct font_callback_data
*) lParam
;
1442 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
);
1444 /* If we have a font in the list, terminate the search. */
1445 return !NILP (match_data
->list
);
1448 /* Old function to convert from x to w32 charset, from w32fns.c. */
1450 x_to_w32_charset (lpcs
)
1453 Lisp_Object this_entry
, w32_charset
;
1455 int len
= strlen (lpcs
);
1457 /* Support "*-#nnn" format for unknown charsets. */
1458 if (strncmp (lpcs
, "*-#", 3) == 0)
1459 return atoi (lpcs
+ 3);
1461 /* All Windows fonts qualify as unicode. */
1462 if (!strncmp (lpcs
, "iso10646", 8))
1463 return DEFAULT_CHARSET
;
1465 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1466 charset
= alloca (len
+ 1);
1467 strcpy (charset
, lpcs
);
1468 lpcs
= strchr (charset
, '*');
1472 /* Look through w32-charset-info-alist for the character set.
1473 Format of each entry is
1474 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1476 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
1478 if (NILP (this_entry
))
1480 /* At startup, we want iso8859-1 fonts to come up properly. */
1481 if (xstrcasecmp (charset
, "iso8859-1") == 0)
1482 return ANSI_CHARSET
;
1484 return DEFAULT_CHARSET
;
1487 w32_charset
= Fcar (Fcdr (this_entry
));
1489 /* Translate Lisp symbol to number. */
1490 if (EQ (w32_charset
, Qw32_charset_ansi
))
1491 return ANSI_CHARSET
;
1492 if (EQ (w32_charset
, Qw32_charset_symbol
))
1493 return SYMBOL_CHARSET
;
1494 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
1495 return SHIFTJIS_CHARSET
;
1496 if (EQ (w32_charset
, Qw32_charset_hangeul
))
1497 return HANGEUL_CHARSET
;
1498 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
1499 return CHINESEBIG5_CHARSET
;
1500 if (EQ (w32_charset
, Qw32_charset_gb2312
))
1501 return GB2312_CHARSET
;
1502 if (EQ (w32_charset
, Qw32_charset_oem
))
1504 if (EQ (w32_charset
, Qw32_charset_johab
))
1505 return JOHAB_CHARSET
;
1506 if (EQ (w32_charset
, Qw32_charset_easteurope
))
1507 return EASTEUROPE_CHARSET
;
1508 if (EQ (w32_charset
, Qw32_charset_turkish
))
1509 return TURKISH_CHARSET
;
1510 if (EQ (w32_charset
, Qw32_charset_baltic
))
1511 return BALTIC_CHARSET
;
1512 if (EQ (w32_charset
, Qw32_charset_russian
))
1513 return RUSSIAN_CHARSET
;
1514 if (EQ (w32_charset
, Qw32_charset_arabic
))
1515 return ARABIC_CHARSET
;
1516 if (EQ (w32_charset
, Qw32_charset_greek
))
1517 return GREEK_CHARSET
;
1518 if (EQ (w32_charset
, Qw32_charset_hebrew
))
1519 return HEBREW_CHARSET
;
1520 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
1521 return VIETNAMESE_CHARSET
;
1522 if (EQ (w32_charset
, Qw32_charset_thai
))
1523 return THAI_CHARSET
;
1524 if (EQ (w32_charset
, Qw32_charset_mac
))
1527 return DEFAULT_CHARSET
;
1531 /* Convert a Lisp font registry (symbol) to a windows charset. */
1533 registry_to_w32_charset (charset
)
1534 Lisp_Object charset
;
1536 if (EQ (charset
, Qiso10646_1
) || EQ (charset
, Qunicode_bmp
)
1537 || EQ (charset
, Qunicode_sip
))
1538 return DEFAULT_CHARSET
; /* UNICODE_CHARSET not defined in MingW32 */
1539 else if (EQ (charset
, Qiso8859_1
))
1540 return ANSI_CHARSET
;
1541 else if (SYMBOLP (charset
))
1542 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset
)));
1544 return DEFAULT_CHARSET
;
1547 /* Old function to convert from w32 to x charset, from w32fns.c. */
1549 w32_to_x_charset (fncharset
, matching
)
1553 static char buf
[32];
1554 Lisp_Object charset_type
;
1559 /* If fully specified, accept it as it is. Otherwise use a
1561 char *wildcard
= strchr (matching
, '*');
1564 else if (strchr (matching
, '-'))
1567 match_len
= strlen (matching
);
1573 /* Handle startup case of w32-charset-info-alist not
1574 being set up yet. */
1575 if (NILP (Vw32_charset_info_alist
))
1577 charset_type
= Qw32_charset_ansi
;
1579 case DEFAULT_CHARSET
:
1580 charset_type
= Qw32_charset_default
;
1582 case SYMBOL_CHARSET
:
1583 charset_type
= Qw32_charset_symbol
;
1585 case SHIFTJIS_CHARSET
:
1586 charset_type
= Qw32_charset_shiftjis
;
1588 case HANGEUL_CHARSET
:
1589 charset_type
= Qw32_charset_hangeul
;
1591 case GB2312_CHARSET
:
1592 charset_type
= Qw32_charset_gb2312
;
1594 case CHINESEBIG5_CHARSET
:
1595 charset_type
= Qw32_charset_chinesebig5
;
1598 charset_type
= Qw32_charset_oem
;
1600 case EASTEUROPE_CHARSET
:
1601 charset_type
= Qw32_charset_easteurope
;
1603 case TURKISH_CHARSET
:
1604 charset_type
= Qw32_charset_turkish
;
1606 case BALTIC_CHARSET
:
1607 charset_type
= Qw32_charset_baltic
;
1609 case RUSSIAN_CHARSET
:
1610 charset_type
= Qw32_charset_russian
;
1612 case ARABIC_CHARSET
:
1613 charset_type
= Qw32_charset_arabic
;
1616 charset_type
= Qw32_charset_greek
;
1618 case HEBREW_CHARSET
:
1619 charset_type
= Qw32_charset_hebrew
;
1621 case VIETNAMESE_CHARSET
:
1622 charset_type
= Qw32_charset_vietnamese
;
1625 charset_type
= Qw32_charset_thai
;
1628 charset_type
= Qw32_charset_mac
;
1631 charset_type
= Qw32_charset_johab
;
1635 /* Encode numerical value of unknown charset. */
1636 sprintf (buf
, "*-#%u", fncharset
);
1642 char * best_match
= NULL
;
1643 int matching_found
= 0;
1645 /* Look through w32-charset-info-alist for the character set.
1646 Prefer ISO codepages, and prefer lower numbers in the ISO
1647 range. Only return charsets for codepages which are installed.
1649 Format of each entry is
1650 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1652 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
1655 Lisp_Object w32_charset
;
1656 Lisp_Object codepage
;
1658 Lisp_Object this_entry
= XCAR (rest
);
1660 /* Skip invalid entries in alist. */
1661 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
1662 || !CONSP (XCDR (this_entry
))
1663 || !SYMBOLP (XCAR (XCDR (this_entry
))))
1666 x_charset
= SDATA (XCAR (this_entry
));
1667 w32_charset
= XCAR (XCDR (this_entry
));
1668 codepage
= XCDR (XCDR (this_entry
));
1670 /* Look for Same charset and a valid codepage (or non-int
1671 which means ignore). */
1672 if (EQ (w32_charset
, charset_type
)
1673 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
1674 || IsValidCodePage (XINT (codepage
))))
1676 /* If we don't have a match already, then this is the
1680 best_match
= x_charset
;
1681 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
1684 /* If we already found a match for MATCHING, then
1685 only consider other matches. */
1686 else if (matching_found
1687 && strnicmp (x_charset
, matching
, match_len
))
1689 /* If this matches what we want, and the best so far doesn't,
1690 then this is better. */
1691 else if (!matching_found
&& matching
1692 && !strnicmp (x_charset
, matching
, match_len
))
1694 best_match
= x_charset
;
1697 /* If this is fully specified, and the best so far isn't,
1698 then this is better. */
1699 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
1700 /* If this is an ISO codepage, and the best so far isn't,
1701 then this is better, but only if it fully specifies the
1703 || (strnicmp (best_match
, "iso", 3) != 0
1704 && strnicmp (x_charset
, "iso", 3) == 0
1705 && strchr (x_charset
, '-')))
1706 best_match
= x_charset
;
1707 /* If both are ISO8859 codepages, choose the one with the
1708 lowest number in the encoding field. */
1709 else if (strnicmp (best_match
, "iso8859-", 8) == 0
1710 && strnicmp (x_charset
, "iso8859-", 8) == 0)
1712 int best_enc
= atoi (best_match
+ 8);
1713 int this_enc
= atoi (x_charset
+ 8);
1714 if (this_enc
> 0 && this_enc
< best_enc
)
1715 best_match
= x_charset
;
1720 /* If no match, encode the numeric value. */
1723 sprintf (buf
, "*-#%u", fncharset
);
1727 strncpy (buf
, best_match
, 31);
1728 /* If the charset is not fully specified, put -0 on the end. */
1729 if (!strchr (best_match
, '-'))
1731 int pos
= strlen (best_match
);
1732 /* Charset specifiers shouldn't be very long. If it is a made
1733 up one, truncating it should not do any harm since it isn't
1734 recognized anyway. */
1737 strcpy (buf
+ pos
, "-0");
1745 w32_registry (w32_charset
, font_type
)
1751 /* If charset is defaulted, charset is unicode or unknown, depending on
1753 if (w32_charset
== DEFAULT_CHARSET
)
1754 return font_type
== TRUETYPE_FONTTYPE
? Qiso10646_1
: Qunknown
;
1756 charset
= w32_to_x_charset (w32_charset
, NULL
);
1757 return font_intern_prop (charset
, strlen(charset
), 1);
1761 w32_decode_weight (fnweight
)
1764 if (fnweight
>= FW_HEAVY
) return 210;
1765 if (fnweight
>= FW_EXTRABOLD
) return 205;
1766 if (fnweight
>= FW_BOLD
) return 200;
1767 if (fnweight
>= FW_SEMIBOLD
) return 180;
1768 if (fnweight
>= FW_NORMAL
) return 100;
1769 if (fnweight
>= FW_LIGHT
) return 50;
1770 if (fnweight
>= FW_EXTRALIGHT
) return 40;
1771 if (fnweight
> FW_THIN
) return 20;
1776 w32_encode_weight (n
)
1779 if (n
>= 210) return FW_HEAVY
;
1780 if (n
>= 205) return FW_EXTRABOLD
;
1781 if (n
>= 200) return FW_BOLD
;
1782 if (n
>= 180) return FW_SEMIBOLD
;
1783 if (n
>= 100) return FW_NORMAL
;
1784 if (n
>= 50) return FW_LIGHT
;
1785 if (n
>= 40) return FW_EXTRALIGHT
;
1786 if (n
>= 20) return FW_THIN
;
1790 /* Convert a Windows font weight into one of the weights supported
1791 by fontconfig (see font.c:font_parse_fcname). */
1793 w32_to_fc_weight (n
)
1796 if (n
>= FW_EXTRABOLD
) return intern ("black");
1797 if (n
>= FW_BOLD
) return intern ("bold");
1798 if (n
>= FW_SEMIBOLD
) return intern ("demibold");
1799 if (n
>= FW_NORMAL
) return intern ("medium");
1800 return intern ("light");
1803 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1805 fill_in_logfont (f
, logfont
, font_spec
)
1808 Lisp_Object font_spec
;
1810 Lisp_Object tmp
, extra
;
1811 int dpi
= FRAME_W32_DISPLAY_INFO (f
)->resy
;
1813 tmp
= AREF (font_spec
, FONT_DPI_INDEX
);
1818 else if (FLOATP (tmp
))
1820 dpi
= (int) (XFLOAT_DATA (tmp
) + 0.5);
1824 tmp
= AREF (font_spec
, FONT_SIZE_INDEX
);
1826 logfont
->lfHeight
= -1 * XINT (tmp
);
1827 else if (FLOATP (tmp
))
1828 logfont
->lfHeight
= (int) (-1.0 * dpi
* XFLOAT_DATA (tmp
) / 72.27 + 0.5);
1835 tmp
= AREF (font_spec
, FONT_WEIGHT_INDEX
);
1837 logfont
->lfWeight
= w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec
));
1840 tmp
= AREF (font_spec
, FONT_SLANT_INDEX
);
1843 int slant
= FONT_SLANT_NUMERIC (font_spec
);
1844 logfont
->lfItalic
= slant
> 150 ? 1 : 0;
1852 tmp
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1854 logfont
->lfCharSet
= registry_to_w32_charset (tmp
);
1856 logfont
->lfCharSet
= DEFAULT_CHARSET
;
1860 /* Clip Precision */
1863 logfont
->lfQuality
= DEFAULT_QUALITY
;
1865 /* Generic Family and Face Name */
1866 logfont
->lfPitchAndFamily
= FF_DONTCARE
| DEFAULT_PITCH
;
1868 tmp
= AREF (font_spec
, FONT_FAMILY_INDEX
);
1871 logfont
->lfPitchAndFamily
= w32_generic_family (tmp
) | DEFAULT_PITCH
;
1872 if ((logfont
->lfPitchAndFamily
& 0xF0) != FF_DONTCARE
)
1873 ; /* Font name was generic, don't fill in font name. */
1874 /* Font families are interned, but allow for strings also in case of
1876 else if (SYMBOLP (tmp
))
1877 strncpy (logfont
->lfFaceName
, SDATA (SYMBOL_NAME (tmp
)), LF_FACESIZE
);
1880 tmp
= AREF (font_spec
, FONT_ADSTYLE_INDEX
);
1883 /* Override generic family. */
1884 BYTE family
= w32_generic_family (tmp
);
1885 if (family
!= FF_DONTCARE
)
1886 logfont
->lfPitchAndFamily
= family
| DEFAULT_PITCH
;
1890 /* Set pitch based on the spacing property. */
1891 tmp
= AREF (font_spec
, FONT_SPACING_INDEX
);
1894 int spacing
= XINT (tmp
);
1895 if (spacing
< FONT_SPACING_MONO
)
1896 logfont
->lfPitchAndFamily
1897 = logfont
->lfPitchAndFamily
& 0xF0 | VARIABLE_PITCH
;
1899 logfont
->lfPitchAndFamily
1900 = logfont
->lfPitchAndFamily
& 0xF0 | FIXED_PITCH
;
1903 /* Process EXTRA info. */
1904 for (extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
1905 CONSP (extra
); extra
= XCDR (extra
))
1910 Lisp_Object key
, val
;
1911 key
= XCAR (tmp
), val
= XCDR (tmp
);
1912 /* Only use QCscript if charset is not provided, or is unicode
1913 and a single script is specified. This is rather crude,
1914 and is only used to narrow down the fonts returned where
1915 there is a definite match. Some scripts, such as latin, han,
1916 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1918 if (EQ (key
, QCscript
)
1919 && logfont
->lfCharSet
== DEFAULT_CHARSET
1922 if (EQ (val
, Qgreek
))
1923 logfont
->lfCharSet
= GREEK_CHARSET
;
1924 else if (EQ (val
, Qhangul
))
1925 logfont
->lfCharSet
= HANGUL_CHARSET
;
1926 else if (EQ (val
, Qkana
) || EQ (val
, Qkanbun
))
1927 logfont
->lfCharSet
= SHIFTJIS_CHARSET
;
1928 else if (EQ (val
, Qbopomofo
))
1929 logfont
->lfCharSet
= CHINESEBIG5_CHARSET
;
1930 /* GB 18030 supports tibetan, yi, mongolian,
1931 fonts that support it should show up if we ask for
1933 else if (EQ (val
, Qtibetan
) || EQ (val
, Qyi
)
1934 || EQ (val
, Qmongolian
))
1935 logfont
->lfCharSet
= GB2312_CHARSET
;
1936 else if (EQ (val
, Qhebrew
))
1937 logfont
->lfCharSet
= HEBREW_CHARSET
;
1938 else if (EQ (val
, Qarabic
))
1939 logfont
->lfCharSet
= ARABIC_CHARSET
;
1940 else if (EQ (val
, Qthai
))
1941 logfont
->lfCharSet
= THAI_CHARSET
;
1942 else if (EQ (val
, Qsymbol
))
1943 logfont
->lfCharSet
= SYMBOL_CHARSET
;
1945 else if (EQ (key
, QCantialias
) && SYMBOLP (val
))
1947 logfont
->lfQuality
= w32_antialias_type (val
);
1954 list_all_matching_fonts (match_data
)
1955 struct font_callback_data
*match_data
;
1958 Lisp_Object families
= w32font_list_family (match_data
->frame
);
1959 struct frame
*f
= XFRAME (match_data
->frame
);
1961 dc
= get_frame_dc (f
);
1963 while (!NILP (families
))
1965 /* TODO: Use the Unicode versions of the W32 APIs, so we can
1966 handle non-ASCII font names. */
1968 Lisp_Object family
= CAR (families
);
1969 families
= CDR (families
);
1972 else if (SYMBOLP (family
))
1973 name
= SDATA (SYMBOL_NAME (family
));
1977 strncpy (match_data
->pattern
.lfFaceName
, name
, LF_FACESIZE
);
1978 match_data
->pattern
.lfFaceName
[LF_FACESIZE
- 1] = '\0';
1980 EnumFontFamiliesEx (dc
, &match_data
->pattern
,
1981 (FONTENUMPROC
) add_font_entity_to_list
,
1982 (LPARAM
) match_data
, 0);
1985 release_frame_dc (f
, dc
);
1989 lispy_antialias_type (type
)
1996 case NONANTIALIASED_QUALITY
:
1999 case ANTIALIASED_QUALITY
:
2002 case CLEARTYPE_QUALITY
:
2005 case CLEARTYPE_NATURAL_QUALITY
:
2015 /* Convert antialiasing symbols to lfQuality */
2017 w32_antialias_type (type
)
2020 if (EQ (type
, Qnone
))
2021 return NONANTIALIASED_QUALITY
;
2022 else if (EQ (type
, Qstandard
))
2023 return ANTIALIASED_QUALITY
;
2024 else if (EQ (type
, Qsubpixel
))
2025 return CLEARTYPE_QUALITY
;
2026 else if (EQ (type
, Qnatural
))
2027 return CLEARTYPE_NATURAL_QUALITY
;
2029 return DEFAULT_QUALITY
;
2032 /* Return a list of all the scripts that the font supports. */
2034 font_supported_scripts (FONTSIGNATURE
* sig
)
2036 DWORD
* subranges
= sig
->fsUsb
;
2037 Lisp_Object supported
= Qnil
;
2039 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2040 #define SUBRANGE(n,sym) \
2041 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2042 supported = Fcons ((sym), supported)
2044 /* Match multiple subranges. SYM is set if any MASK bit is set in
2045 subranges[0 - 3]. */
2046 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2047 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2048 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2049 supported = Fcons ((sym), supported)
2051 SUBRANGE (0, Qlatin
);
2052 /* The following count as latin too, ASCII should be present in these fonts,
2053 so don't need to mark them separately. */
2054 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2055 SUBRANGE (4, Qphonetic
);
2056 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
2057 SUBRANGE (7, Qgreek
);
2058 SUBRANGE (8, Qcoptic
);
2059 SUBRANGE (9, Qcyrillic
);
2060 SUBRANGE (10, Qarmenian
);
2061 SUBRANGE (11, Qhebrew
);
2062 SUBRANGE (13, Qarabic
);
2063 SUBRANGE (14, Qnko
);
2064 SUBRANGE (15, Qdevanagari
);
2065 SUBRANGE (16, Qbengali
);
2066 SUBRANGE (17, Qgurmukhi
);
2067 SUBRANGE (18, Qgujarati
);
2068 SUBRANGE (19, Qoriya
);
2069 SUBRANGE (20, Qtamil
);
2070 SUBRANGE (21, Qtelugu
);
2071 SUBRANGE (22, Qkannada
);
2072 SUBRANGE (23, Qmalayalam
);
2073 SUBRANGE (24, Qthai
);
2074 SUBRANGE (25, Qlao
);
2075 SUBRANGE (26, Qgeorgian
);
2076 SUBRANGE (27, Qbalinese
);
2077 /* 28: Hangul Jamo. */
2078 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2079 /* 32-47: Symbols (defined below). */
2080 SUBRANGE (48, Qcjk_misc
);
2081 /* Match either 49: katakana or 50: hiragana for kana. */
2082 MASK_ANY (0, 0x00060000, 0, 0, Qkana
);
2083 SUBRANGE (51, Qbopomofo
);
2084 /* 52: Compatibility Jamo */
2085 SUBRANGE (53, Qphags_pa
);
2086 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2087 SUBRANGE (56, Qhangul
);
2088 /* 57: Surrogates. */
2089 SUBRANGE (58, Qphoenician
);
2090 SUBRANGE (59, Qhan
); /* There are others, but this is the main one. */
2091 SUBRANGE (59, Qideographic_description
); /* Windows lumps this in. */
2092 SUBRANGE (59, Qkanbun
); /* And this. */
2093 /* 60: Private use, 61: CJK strokes and compatibility. */
2094 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2095 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2096 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2098 SUBRANGE (70, Qtibetan
);
2099 SUBRANGE (71, Qsyriac
);
2100 SUBRANGE (72, Qthaana
);
2101 SUBRANGE (73, Qsinhala
);
2102 SUBRANGE (74, Qmyanmar
);
2103 SUBRANGE (75, Qethiopic
);
2104 SUBRANGE (76, Qcherokee
);
2105 SUBRANGE (77, Qcanadian_aboriginal
);
2106 SUBRANGE (78, Qogham
);
2107 SUBRANGE (79, Qrunic
);
2108 SUBRANGE (80, Qkhmer
);
2109 SUBRANGE (81, Qmongolian
);
2110 SUBRANGE (82, Qbraille
);
2112 SUBRANGE (84, Qbuhid
);
2113 SUBRANGE (84, Qhanunoo
);
2114 SUBRANGE (84, Qtagalog
);
2115 SUBRANGE (84, Qtagbanwa
);
2116 SUBRANGE (85, Qold_italic
);
2117 SUBRANGE (86, Qgothic
);
2118 SUBRANGE (87, Qdeseret
);
2119 SUBRANGE (88, Qbyzantine_musical_symbol
);
2120 SUBRANGE (88, Qmusical_symbol
); /* Windows doesn't distinguish these. */
2121 SUBRANGE (89, Qmathematical
);
2122 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2123 SUBRANGE (93, Qlimbu
);
2124 SUBRANGE (94, Qtai_le
);
2125 /* 95: New Tai Le */
2126 SUBRANGE (90, Qbuginese
);
2127 SUBRANGE (97, Qglagolitic
);
2128 SUBRANGE (98, Qtifinagh
);
2129 /* 99: Yijing Hexagrams. */
2130 SUBRANGE (100, Qsyloti_nagri
);
2131 SUBRANGE (101, Qlinear_b
);
2132 /* 102: Ancient Greek Numbers. */
2133 SUBRANGE (103, Qugaritic
);
2134 SUBRANGE (104, Qold_persian
);
2135 SUBRANGE (105, Qshavian
);
2136 SUBRANGE (106, Qosmanya
);
2137 SUBRANGE (107, Qcypriot
);
2138 SUBRANGE (108, Qkharoshthi
);
2139 /* 109: Tai Xuan Jing. */
2140 SUBRANGE (110, Qcuneiform
);
2141 /* 111: Counting Rods. */
2143 /* There isn't really a main symbol range, so include symbol if any
2144 relevant range is set. */
2145 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol
);
2147 /* Missing: Tai Viet (U+AA80) and Cham (U+AA00) . */
2154 /* Generate a full name for a Windows font.
2155 The full name is in fcname format, with weight, slant and antialiasing
2156 specified if they are not "normal". */
2158 w32font_full_name (font
, font_obj
, pixel_size
, name
, nbytes
)
2160 Lisp_Object font_obj
;
2165 int len
, height
, outline
;
2167 Lisp_Object antialiasing
, weight
= Qnil
;
2169 len
= strlen (font
->lfFaceName
);
2171 outline
= EQ (AREF (font_obj
, FONT_FOUNDRY_INDEX
), Qoutline
);
2173 /* Represent size of scalable fonts by point size. But use pixelsize for
2174 raster fonts to indicate that they are exactly that size. */
2176 len
+= 11; /* -SIZE */
2181 len
+= 7; /* :italic */
2183 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2185 weight
= w32_to_fc_weight (font
->lfWeight
);
2186 len
+= 1 + SBYTES (SYMBOL_NAME (weight
)); /* :WEIGHT */
2189 antialiasing
= lispy_antialias_type (font
->lfQuality
);
2190 if (! NILP (antialiasing
))
2191 len
+= 11 + SBYTES (SYMBOL_NAME (antialiasing
)); /* :antialias=NAME */
2193 /* Check that the buffer is big enough */
2198 p
+= sprintf (p
, "%s", font
->lfFaceName
);
2200 height
= font
->lfHeight
? eabs (font
->lfHeight
) : pixel_size
;
2206 float pointsize
= height
* 72.0 / one_w32_display_info
.resy
;
2207 /* Round to nearest half point. floor is used, since round is not
2208 supported in MS library. */
2209 pointsize
= floor (pointsize
* 2 + 0.5) / 2;
2210 p
+= sprintf (p
, "-%1.1f", pointsize
);
2213 p
+= sprintf (p
, ":pixelsize=%d", height
);
2216 if (SYMBOLP (weight
) && ! NILP (weight
))
2217 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2220 p
+= sprintf (p
, ":italic");
2222 if (SYMBOLP (antialiasing
) && ! NILP (antialiasing
))
2223 p
+= sprintf (p
, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing
)));
2228 /* Convert a logfont and point size into a fontconfig style font name.
2229 POINTSIZE is in tenths of points.
2230 If SIZE indicates the size of buffer FCNAME, into which the font name
2231 is written. If the buffer is not large enough to contain the name,
2232 the function returns -1, otherwise it returns the number of bytes
2233 written to FCNAME. */
2234 static int logfont_to_fcname(font
, pointsize
, fcname
, size
)
2242 Lisp_Object weight
= Qnil
;
2244 len
= strlen (font
->lfFaceName
) + 2;
2245 height
= pointsize
/ 10;
2246 while (height
/= 10)
2253 len
+= 7; /* :italic */
2254 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2256 weight
= w32_to_fc_weight (font
->lfWeight
);
2257 len
+= SBYTES (SYMBOL_NAME (weight
)) + 1;
2263 p
+= sprintf (p
, "%s-%d", font
->lfFaceName
, pointsize
/ 10);
2265 p
+= sprintf (p
, ".%d", pointsize
% 10);
2267 if (SYMBOLP (weight
) && !NILP (weight
))
2268 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2271 p
+= sprintf (p
, ":italic");
2273 return (p
- fcname
);
2277 compute_metrics (dc
, w32_font
, code
, metrics
)
2279 struct w32font_info
*w32_font
;
2281 struct w32_metric_cache
*metrics
;
2285 unsigned int options
= GGO_METRICS
;
2287 if (w32_font
->glyph_idx
)
2288 options
|= GGO_GLYPH_INDEX
;
2290 bzero (&transform
, sizeof (transform
));
2291 transform
.eM11
.value
= 1;
2292 transform
.eM22
.value
= 1;
2294 if (GetGlyphOutlineW (dc
, code
, options
, &gm
, 0, NULL
, &transform
)
2297 metrics
->lbearing
= gm
.gmptGlyphOrigin
.x
;
2298 metrics
->rbearing
= gm
.gmptGlyphOrigin
.x
+ gm
.gmBlackBoxX
;
2299 metrics
->width
= gm
.gmCellIncX
;
2300 metrics
->status
= W32METRIC_SUCCESS
;
2302 else if (w32_font
->glyph_idx
)
2304 /* Can't use glyph indexes after all.
2305 Avoid it in future, and clear any metrics that were based on
2307 w32_font
->glyph_idx
= 0;
2308 clear_cached_metrics (w32_font
);
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 INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
2333 in the font selection dialog. */)
2334 (frame
, include_proportional
)
2335 Lisp_Object frame
, include_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 /* Unless include_proportional is non-nil, limit the selection to
2353 monospaced fonts. */
2354 if (NILP (include_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) */