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
),
240 font_entity
, pixel_size
);
242 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
250 /* w32 implementation of close for font_backend.
251 Close FONT on frame F. */
253 w32font_close (f
, font
)
258 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
260 /* Delete the GDI font object. */
261 DeleteObject (w32_font
->hfont
);
263 /* Free all the cached metrics. */
264 if (w32_font
->cached_metrics
)
266 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
268 if (w32_font
->cached_metrics
[i
])
269 xfree (w32_font
->cached_metrics
[i
]);
271 xfree (w32_font
->cached_metrics
);
272 w32_font
->cached_metrics
= NULL
;
276 /* w32 implementation of has_char for font backend.
278 If FONT_ENTITY has a glyph for character C (Unicode code point),
279 return 1. If not, return 0. If a font must be opened to check
282 w32font_has_char (entity
, c
)
286 Lisp_Object supported_scripts
, extra
, script
;
289 extra
= AREF (entity
, FONT_EXTRA_INDEX
);
293 supported_scripts
= assq_no_quit (QCscript
, extra
);
294 if (!CONSP (supported_scripts
))
297 supported_scripts
= XCDR (supported_scripts
);
299 script
= CHAR_TABLE_REF (Vchar_script_table
, c
);
301 return (memq_no_quit (script
, supported_scripts
)) ? -1 : 0;
304 /* w32 implementation of encode_char for font backend.
305 Return a glyph code of FONT for characer C (Unicode code point).
306 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
308 w32font_encode_char (font
, c
)
320 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
322 /* If glyph indexing is not working for this font, just return the
323 unicode code-point. */
324 if (!w32_font
->glyph_idx
)
329 /* TODO: Encode as surrogate pair and lookup the glyph. */
330 return FONT_INVALID_CODE
;
338 bzero (&result
, sizeof (result
));
339 result
.lStructSize
= sizeof (result
);
340 result
.lpGlyphs
= out
;
343 f
= XFRAME (selected_frame
);
345 dc
= get_frame_dc (f
);
346 old_font
= SelectObject (dc
, w32_font
->hfont
);
348 /* GetCharacterPlacement is used here rather than GetGlyphIndices because
349 it is supported on Windows NT 4 and 9x/ME. But it cannot reliably report
350 missing glyphs, see below for workaround. */
351 retval
= GetCharacterPlacementW (dc
, in
, len
, 0, &result
, 0);
353 SelectObject (dc
, old_font
);
354 release_frame_dc (f
, dc
);
358 if (result
.nGlyphs
!= 1 || !result
.lpGlyphs
[0]
359 /* GetCharacterPlacementW seems to return 3, which seems to be
360 the space glyph in most/all truetype fonts, instead of 0
361 for unsupported glyphs. */
362 || (result
.lpGlyphs
[0] == 3 && !iswspace (in
[0])))
363 return FONT_INVALID_CODE
;
364 return result
.lpGlyphs
[0];
369 /* Mark this font as not supporting glyph indices. This can happen
370 on Windows9x, and maybe with non-Truetype fonts on NT etc. */
371 w32_font
->glyph_idx
= 0;
372 /* Clear metrics cache. */
373 clear_cached_metrics (w32_font
);
379 /* w32 implementation of text_extents for font backend.
380 Perform the size computation of glyphs of FONT and fillin members
381 of METRICS. The glyphs are specified by their glyph codes in
382 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
383 case just return the overall width. */
385 w32font_text_extents (font
, code
, nglyphs
, metrics
)
389 struct font_metrics
*metrics
;
392 HFONT old_font
= NULL
;
399 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
403 bzero (metrics
, sizeof (struct font_metrics
));
404 metrics
->ascent
= font
->ascent
;
405 metrics
->descent
= font
->descent
;
407 for (i
= 0; i
< nglyphs
; i
++)
409 struct w32_metric_cache
*char_metric
;
410 int block
= *(code
+ i
) / CACHE_BLOCKSIZE
;
411 int pos_in_block
= *(code
+ i
) % CACHE_BLOCKSIZE
;
413 if (block
>= w32_font
->n_cache_blocks
)
415 if (!w32_font
->cached_metrics
)
416 w32_font
->cached_metrics
417 = xmalloc ((block
+ 1)
418 * sizeof (struct w32_cached_metric
*));
420 w32_font
->cached_metrics
421 = xrealloc (w32_font
->cached_metrics
,
423 * sizeof (struct w32_cached_metric
*));
424 bzero (w32_font
->cached_metrics
+ w32_font
->n_cache_blocks
,
425 ((block
+ 1 - w32_font
->n_cache_blocks
)
426 * sizeof (struct w32_cached_metric
*)));
427 w32_font
->n_cache_blocks
= block
+ 1;
430 if (!w32_font
->cached_metrics
[block
])
432 w32_font
->cached_metrics
[block
]
433 = xmalloc (CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
434 bzero (w32_font
->cached_metrics
[block
],
435 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
438 char_metric
= w32_font
->cached_metrics
[block
] + pos_in_block
;
440 if (char_metric
->status
== W32METRIC_NO_ATTEMPT
)
444 /* TODO: Frames can come and go, and their fonts
445 outlive them. So we can't cache the frame in the
446 font structure. Use selected_frame until the API
447 is updated to pass in a frame. */
448 f
= XFRAME (selected_frame
);
450 dc
= get_frame_dc (f
);
451 old_font
= SelectObject (dc
, w32_font
->hfont
);
453 compute_metrics (dc
, w32_font
, *(code
+ i
), char_metric
);
456 if (char_metric
->status
== W32METRIC_SUCCESS
)
458 metrics
->lbearing
= min (metrics
->lbearing
,
459 metrics
->width
+ char_metric
->lbearing
);
460 metrics
->rbearing
= max (metrics
->rbearing
,
461 metrics
->width
+ char_metric
->rbearing
);
462 metrics
->width
+= char_metric
->width
;
465 /* If we couldn't get metrics for a char,
466 use alternative method. */
469 /* If we got through everything, return. */
474 /* Restore state and release DC. */
475 SelectObject (dc
, old_font
);
476 release_frame_dc (f
, dc
);
479 return metrics
->width
;
483 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
484 fallback on other methods that will at least give some of the metric
487 wcode
= alloca (nglyphs
* sizeof (WORD
));
488 for (i
= 0; i
< nglyphs
; i
++)
490 if (code
[i
] < 0x10000)
494 /* TODO: Convert to surrogate, reallocating array if needed */
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
;
562 struct w32font_info
*w32font
= (struct w32font_info
*) s
->font
;
564 options
= w32font
->glyph_idx
;
566 /* Save clip region for later restoration. */
567 GetClipRgn(s
->hdc
, orig_clip
);
569 if (s
->num_clips
> 0)
571 HRGN new_clip
= CreateRectRgnIndirect (s
->clip
);
573 if (s
->num_clips
> 1)
575 HRGN clip2
= CreateRectRgnIndirect (s
->clip
+ 1);
577 CombineRgn (new_clip
, new_clip
, clip2
, RGN_OR
);
578 DeleteObject (clip2
);
581 SelectClipRgn (s
->hdc
, new_clip
);
582 DeleteObject (new_clip
);
585 /* Using OPAQUE background mode can clear more background than expected
586 when Cleartype is used. Draw the background manually to avoid this. */
587 SetBkMode (s
->hdc
, TRANSPARENT
);
592 struct font
*font
= s
->font
;
594 brush
= CreateSolidBrush (s
->gc
->background
);
596 rect
.top
= y
- font
->ascent
;
597 rect
.right
= x
+ s
->width
;
598 rect
.bottom
= y
+ font
->descent
;
599 FillRect (s
->hdc
, &rect
, brush
);
600 DeleteObject (brush
);
605 int len
= to
- from
, i
;
607 for (i
= 0; i
< len
; i
++)
608 ExtTextOutW (s
->hdc
, x
+ i
, y
, options
, NULL
,
609 s
->char2b
+ from
+ i
, 1, NULL
);
612 ExtTextOutW (s
->hdc
, x
, y
, options
, NULL
, s
->char2b
+ from
, to
- from
, NULL
);
614 /* Restore clip region. */
615 if (s
->num_clips
> 0)
617 SelectClipRgn (s
->hdc
, orig_clip
);
621 /* w32 implementation of free_entity for font backend.
622 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
623 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
625 w32font_free_entity (Lisp_Object entity);
628 /* w32 implementation of prepare_face for font backend.
629 Optional (if FACE->extra is not used).
630 Prepare FACE for displaying characters by FONT on frame F by
631 storing some data in FACE->extra. If successful, return 0.
632 Otherwise, return -1.
634 w32font_prepare_face (FRAME_PTR f, struct face *face);
636 /* w32 implementation of done_face for font backend.
638 Done FACE for displaying characters by FACE->font on frame F.
640 w32font_done_face (FRAME_PTR f, struct face *face); */
642 /* w32 implementation of get_bitmap for font backend.
644 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
645 intended that this method is called from the other font-driver
648 w32font_get_bitmap (struct font *font, unsigned code,
649 struct font_bitmap *bitmap, int bits_per_pixel);
651 /* w32 implementation of free_bitmap for font backend.
653 Free bitmap data in BITMAP.
655 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
657 /* w32 implementation of get_outline for font backend.
659 Return an outline data for glyph-code CODE of FONT. The format
660 of the outline data depends on the font-driver.
662 w32font_get_outline (struct font *font, unsigned code);
664 /* w32 implementation of free_outline for font backend.
666 Free OUTLINE (that is obtained by the above method).
668 w32font_free_outline (struct font *font, void *outline);
670 /* w32 implementation of anchor_point for font backend.
672 Get coordinates of the INDEXth anchor point of the glyph whose
673 code is CODE. Store the coordinates in *X and *Y. Return 0 if
674 the operations was successfull. Otherwise return -1.
676 w32font_anchor_point (struct font *font, unsigned code,
677 int index, int *x, int *y);
679 /* w32 implementation of otf_capability for font backend.
681 Return a list describing which scripts/languages FONT
682 supports by which GSUB/GPOS features of OpenType tables.
684 w32font_otf_capability (struct font *font);
686 /* w32 implementation of otf_drive for font backend.
688 Apply FONT's OTF-FEATURES to the glyph string.
690 FEATURES specifies which OTF features to apply in this format:
691 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
692 See the documentation of `font-drive-otf' for the detail.
694 This method applies the specified features to the codes in the
695 elements of GSTRING-IN (between FROMth and TOth). The output
696 codes are stored in GSTRING-OUT at the IDXth element and the
699 Return the number of output codes. If none of the features are
700 applicable to the input data, return 0. If GSTRING-OUT is too
703 w32font_otf_drive (struct font *font, Lisp_Object features,
704 Lisp_Object gstring_in, int from, int to,
705 Lisp_Object gstring_out, int idx,
706 int alternate_subst);
709 /* Internal implementation of w32font_list.
710 Additional parameter opentype_only restricts the returned fonts to
711 opentype fonts, which can be used with the Uniscribe backend. */
713 w32font_list_internal (frame
, font_spec
, opentype_only
)
714 Lisp_Object frame
, font_spec
;
717 struct font_callback_data match_data
;
719 FRAME_PTR f
= XFRAME (frame
);
721 match_data
.orig_font_spec
= font_spec
;
722 match_data
.list
= Qnil
;
723 match_data
.frame
= frame
;
725 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
726 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
728 match_data
.opentype_only
= opentype_only
;
730 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
732 if (match_data
.pattern
.lfFaceName
[0] == '\0')
734 /* EnumFontFamiliesEx does not take other fields into account if
735 font name is blank, so need to use two passes. */
736 list_all_matching_fonts (&match_data
);
740 dc
= get_frame_dc (f
);
742 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
743 (FONTENUMPROC
) add_font_entity_to_list
,
744 (LPARAM
) &match_data
, 0);
745 release_frame_dc (f
, dc
);
748 return NILP (match_data
.list
) ? Qnil
: match_data
.list
;
751 /* Internal implementation of w32font_match.
752 Additional parameter opentype_only restricts the returned fonts to
753 opentype fonts, which can be used with the Uniscribe backend. */
755 w32font_match_internal (frame
, font_spec
, opentype_only
)
756 Lisp_Object frame
, font_spec
;
759 struct font_callback_data match_data
;
761 FRAME_PTR f
= XFRAME (frame
);
763 match_data
.orig_font_spec
= font_spec
;
764 match_data
.frame
= frame
;
765 match_data
.list
= Qnil
;
767 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
768 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
770 match_data
.opentype_only
= opentype_only
;
772 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
774 dc
= get_frame_dc (f
);
776 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
777 (FONTENUMPROC
) add_one_font_entity_to_list
,
778 (LPARAM
) &match_data
, 0);
779 release_frame_dc (f
, dc
);
781 return NILP (match_data
.list
) ? Qnil
: XCAR (match_data
.list
);
785 w32font_open_internal (f
, font_entity
, pixel_size
, font_object
)
787 Lisp_Object font_entity
;
789 Lisp_Object font_object
;
794 HFONT hfont
, old_font
;
795 Lisp_Object val
, extra
;
796 struct w32font_info
*w32_font
;
798 OUTLINETEXTMETRIC
* metrics
= NULL
;
800 w32_font
= (struct w32font_info
*) XFONT_OBJECT (font_object
);
801 font
= (struct font
*) w32_font
;
806 bzero (&logfont
, sizeof (logfont
));
807 fill_in_logfont (f
, &logfont
, font_entity
);
809 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
810 limitations in bitmap fonts. */
811 val
= AREF (font_entity
, FONT_FOUNDRY_INDEX
);
812 if (!EQ (val
, Qraster
))
813 logfont
.lfOutPrecision
= OUT_TT_PRECIS
;
815 size
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
819 logfont
.lfHeight
= -size
;
820 hfont
= CreateFontIndirect (&logfont
);
825 /* Get the metrics for this font. */
826 dc
= get_frame_dc (f
);
827 old_font
= SelectObject (dc
, hfont
);
829 /* Try getting the outline metrics (only works for truetype fonts). */
830 len
= GetOutlineTextMetrics (dc
, 0, NULL
);
833 metrics
= (OUTLINETEXTMETRIC
*) alloca (len
);
834 if (GetOutlineTextMetrics (dc
, len
, metrics
))
835 bcopy (&metrics
->otmTextMetrics
, &w32_font
->metrics
,
836 sizeof (TEXTMETRIC
));
840 /* If it supports outline metrics, it should support Glyph Indices. */
841 w32_font
->glyph_idx
= ETO_GLYPH_INDEX
;
846 GetTextMetrics (dc
, &w32_font
->metrics
);
847 w32_font
->glyph_idx
= 0;
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 = make_unibyte_string (name
, strlen (name
));
875 font
->props
[FONT_FULLNAME_INDEX
] =
876 make_unibyte_string (logfont
.lfFaceName
, len
);
879 font
->max_width
= w32_font
->metrics
.tmMaxCharWidth
;
880 font
->height
= w32_font
->metrics
.tmHeight
881 + w32_font
->metrics
.tmExternalLeading
;
882 font
->space_width
= font
->average_width
= w32_font
->metrics
.tmAveCharWidth
;
884 font
->vertical_centering
= 0;
885 font
->encoding_type
= 0;
886 font
->baseline_offset
= 0;
887 font
->relative_compose
= 0;
888 font
->default_ascent
= w32_font
->metrics
.tmAscent
;
889 font
->font_encoder
= NULL
;
890 font
->pixel_size
= size
;
891 font
->driver
= &w32font_driver
;
892 /* Use format cached during list, as the information we have access to
893 here is incomplete. */
894 extra
= AREF (font_entity
, FONT_EXTRA_INDEX
);
897 val
= assq_no_quit (QCformat
, extra
);
899 font
->props
[FONT_FORMAT_INDEX
] = XCDR (val
);
901 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
904 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
906 font
->props
[FONT_FILE_INDEX
] = Qnil
;
907 font
->encoding_charset
= -1;
908 font
->repertory_charset
= -1;
909 /* TODO: do we really want the minimum width here, which could be negative? */
910 font
->min_width
= font
->space_width
;
911 font
->ascent
= w32_font
->metrics
.tmAscent
;
912 font
->descent
= w32_font
->metrics
.tmDescent
;
916 font
->underline_thickness
= metrics
->otmsUnderscoreSize
;
917 font
->underline_position
= -metrics
->otmsUnderscorePosition
;
921 font
->underline_thickness
= 0;
922 font
->underline_position
= -1;
925 /* For temporary compatibility with legacy code that expects the
926 name to be usable in x-list-fonts. Eventually we expect to change
927 x-list-fonts and other places that use fonts so that this can be
928 an fcname or similar. */
929 font
->props
[FONT_NAME_INDEX
] = Ffont_xlfd_name (font_object
, Qnil
);
934 /* Callback function for EnumFontFamiliesEx.
935 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
937 add_font_name_to_list (logical_font
, physical_font
, font_type
, list_object
)
938 ENUMLOGFONTEX
*logical_font
;
939 NEWTEXTMETRICEX
*physical_font
;
943 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
946 /* Skip vertical fonts (intended only for printing) */
947 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
950 family
= font_intern_prop (logical_font
->elfLogFont
.lfFaceName
,
951 strlen (logical_font
->elfLogFont
.lfFaceName
), 1);
952 if (! memq_no_quit (family
, *list
))
953 *list
= Fcons (family
, *list
);
958 static int w32_decode_weight
P_ ((int));
959 static int w32_encode_weight
P_ ((int));
961 /* Convert an enumerated Windows font to an Emacs font entity. */
963 w32_enumfont_pattern_entity (frame
, logical_font
, physical_font
,
964 font_type
, requested_font
, backend
)
966 ENUMLOGFONTEX
*logical_font
;
967 NEWTEXTMETRICEX
*physical_font
;
969 LOGFONT
*requested_font
;
972 Lisp_Object entity
, tem
;
973 LOGFONT
*lf
= (LOGFONT
*) logical_font
;
975 DWORD full_type
= physical_font
->ntmTm
.ntmFlags
;
977 entity
= font_make_entity ();
979 ASET (entity
, FONT_TYPE_INDEX
, backend
);
980 ASET (entity
, FONT_REGISTRY_INDEX
, w32_registry (lf
->lfCharSet
, font_type
));
981 ASET (entity
, FONT_OBJLIST_INDEX
, Qnil
);
983 /* Foundry is difficult to get in readable form on Windows.
984 But Emacs crashes if it is not set, so set it to something more
985 generic. These values make xlfds compatible with Emacs 22. */
986 if (lf
->lfOutPrecision
== OUT_STRING_PRECIS
)
988 else if (lf
->lfOutPrecision
== OUT_STROKE_PRECIS
)
993 ASET (entity
, FONT_FOUNDRY_INDEX
, tem
);
995 /* Save the generic family in the extra info, as it is likely to be
996 useful to users looking for a close match. */
997 generic_type
= physical_font
->ntmTm
.tmPitchAndFamily
& 0xF0;
998 if (generic_type
== FF_DECORATIVE
)
1000 else if (generic_type
== FF_MODERN
)
1002 else if (generic_type
== FF_ROMAN
)
1004 else if (generic_type
== FF_SCRIPT
)
1006 else if (generic_type
== FF_SWISS
)
1011 ASET (entity
, FONT_ADSTYLE_INDEX
, tem
);
1013 if (physical_font
->ntmTm
.tmPitchAndFamily
& 0x01)
1014 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_PROPORTIONAL
));
1016 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_CHARCELL
));
1018 if (requested_font
->lfQuality
!= DEFAULT_QUALITY
)
1020 font_put_extra (entity
, QCantialias
,
1021 lispy_antialias_type (requested_font
->lfQuality
));
1023 ASET (entity
, FONT_FAMILY_INDEX
,
1024 font_intern_prop (lf
->lfFaceName
, strlen (lf
->lfFaceName
), 1));
1026 FONT_SET_STYLE (entity
, FONT_WEIGHT_INDEX
,
1027 make_number (w32_decode_weight (lf
->lfWeight
)));
1028 FONT_SET_STYLE (entity
, FONT_SLANT_INDEX
,
1029 make_number (lf
->lfItalic
? 200 : 100));
1030 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1032 FONT_SET_STYLE (entity
, FONT_WIDTH_INDEX
, make_number (100));
1034 if (font_type
& RASTER_FONTTYPE
)
1035 ASET (entity
, FONT_SIZE_INDEX
,
1036 make_number (physical_font
->ntmTm
.tmHeight
1037 + physical_font
->ntmTm
.tmExternalLeading
));
1039 ASET (entity
, FONT_SIZE_INDEX
, make_number (0));
1041 /* Cache unicode codepoints covered by this font, as there is no other way
1042 of getting this information easily. */
1043 if (font_type
& TRUETYPE_FONTTYPE
)
1045 tem
= font_supported_scripts (&physical_font
->ntmFontSig
);
1047 font_put_extra (entity
, QCscript
, tem
);
1050 /* This information is not fully available when opening fonts, so
1051 save it here. Only Windows 2000 and later return information
1052 about opentype and type1 fonts, so need a fallback for detecting
1053 truetype so that this information is not any worse than we could
1054 have obtained later. */
1055 if (EQ (backend
, Quniscribe
) && (full_type
& NTMFLAGS_OPENTYPE
))
1056 tem
= intern ("opentype");
1057 else if (font_type
& TRUETYPE_FONTTYPE
)
1058 tem
= intern ("truetype");
1059 else if (full_type
& NTM_PS_OPENTYPE
)
1060 tem
= intern ("postscript");
1061 else if (full_type
& NTM_TYPE1
)
1062 tem
= intern ("type1");
1063 else if (font_type
& RASTER_FONTTYPE
)
1064 tem
= intern ("w32bitmap");
1066 tem
= intern ("w32vector");
1068 font_put_extra (entity
, QCformat
, tem
);
1074 /* Convert generic families to the family portion of lfPitchAndFamily. */
1076 w32_generic_family (Lisp_Object name
)
1078 /* Generic families. */
1079 if (EQ (name
, Qmonospace
) || EQ (name
, Qmono
))
1081 else if (EQ (name
, Qsans
) || EQ (name
, Qsans_serif
) || EQ (name
, Qsansserif
))
1083 else if (EQ (name
, Qserif
))
1085 else if (EQ (name
, Qdecorative
))
1086 return FF_DECORATIVE
;
1087 else if (EQ (name
, Qscript
))
1094 logfonts_match (font
, pattern
)
1095 LOGFONT
*font
, *pattern
;
1097 /* Only check height for raster fonts. */
1098 if (pattern
->lfHeight
&& font
->lfOutPrecision
== OUT_STRING_PRECIS
1099 && font
->lfHeight
!= pattern
->lfHeight
)
1102 /* Have some flexibility with weights. */
1103 if (pattern
->lfWeight
1104 && ((font
->lfWeight
< (pattern
->lfWeight
- 150))
1105 || font
->lfWeight
> (pattern
->lfWeight
+ 150)))
1108 /* Charset and face should be OK. Italic has to be checked
1109 against the original spec, in case we don't have any preference. */
1113 /* Codepage Bitfields in FONTSIGNATURE struct. */
1114 #define CSB_JAPANESE (1 << 17)
1115 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1116 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1119 font_matches_spec (type
, font
, spec
, backend
, logfont
)
1121 NEWTEXTMETRICEX
*font
;
1123 Lisp_Object backend
;
1126 Lisp_Object extra
, val
;
1128 /* Check italic. Can't check logfonts, since it is a boolean field,
1129 so there is no difference between "non-italic" and "don't care". */
1131 int slant
= FONT_SLANT_NUMERIC (spec
);
1134 && ((slant
> 150 && !font
->ntmTm
.tmItalic
)
1135 || (slant
<= 150 && font
->ntmTm
.tmItalic
)))
1139 /* Check adstyle against generic family. */
1140 val
= AREF (spec
, FONT_ADSTYLE_INDEX
);
1143 BYTE family
= w32_generic_family (val
);
1144 if (family
!= FF_DONTCARE
1145 && family
!= (font
->ntmTm
.tmPitchAndFamily
& 0xF0))
1150 val
= AREF (spec
, FONT_SPACING_INDEX
);
1153 int spacing
= XINT (val
);
1154 int proportional
= (spacing
< FONT_SPACING_MONO
);
1156 if ((proportional
&& !(font
->ntmTm
.tmPitchAndFamily
& 0x01))
1157 || (!proportional
&& (font
->ntmTm
.tmPitchAndFamily
& 0x01)))
1161 /* Check extra parameters. */
1162 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
1163 CONSP (extra
); extra
= XCDR (extra
))
1165 Lisp_Object extra_entry
;
1166 extra_entry
= XCAR (extra
);
1167 if (CONSP (extra_entry
))
1169 Lisp_Object key
= XCAR (extra_entry
);
1171 val
= XCDR (extra_entry
);
1172 if (EQ (key
, QCscript
) && SYMBOLP (val
))
1174 /* Only truetype fonts will have information about what
1175 scripts they support. This probably means the user
1176 will have to force Emacs to use raster, postscript
1177 or atm fonts for non-ASCII text. */
1178 if (type
& TRUETYPE_FONTTYPE
)
1181 = font_supported_scripts (&font
->ntmFontSig
);
1182 if (! memq_no_quit (val
, support
))
1187 /* Return specific matches, but play it safe. Fonts
1188 that cover more than their charset would suggest
1189 are likely to be truetype or opentype fonts,
1191 if (EQ (val
, Qlatin
))
1193 /* Although every charset but symbol, thai and
1194 arabic contains the basic ASCII set of latin
1195 characters, Emacs expects much more. */
1196 if (font
->ntmTm
.tmCharSet
!= ANSI_CHARSET
)
1199 else if (EQ (val
, Qsymbol
))
1201 if (font
->ntmTm
.tmCharSet
!= SYMBOL_CHARSET
)
1204 else if (EQ (val
, Qcyrillic
))
1206 if (font
->ntmTm
.tmCharSet
!= RUSSIAN_CHARSET
)
1209 else if (EQ (val
, Qgreek
))
1211 if (font
->ntmTm
.tmCharSet
!= GREEK_CHARSET
)
1214 else if (EQ (val
, Qarabic
))
1216 if (font
->ntmTm
.tmCharSet
!= ARABIC_CHARSET
)
1219 else if (EQ (val
, Qhebrew
))
1221 if (font
->ntmTm
.tmCharSet
!= HEBREW_CHARSET
)
1224 else if (EQ (val
, Qthai
))
1226 if (font
->ntmTm
.tmCharSet
!= THAI_CHARSET
)
1229 else if (EQ (val
, Qkana
))
1231 if (font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1234 else if (EQ (val
, Qbopomofo
))
1236 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
)
1239 else if (EQ (val
, Qhangul
))
1241 if (font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1242 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
)
1245 else if (EQ (val
, Qhan
))
1247 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
1248 && font
->ntmTm
.tmCharSet
!= GB2312_CHARSET
1249 && font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1250 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
1251 && font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1255 /* Other scripts unlikely to be handled by non-truetype
1260 else if (EQ (key
, QClang
) && SYMBOLP (val
))
1262 /* Just handle the CJK languages here, as the lang
1263 parameter is used to select a font with appropriate
1264 glyphs in the cjk unified ideographs block. Other fonts
1265 support for a language can be solely determined by
1266 its character coverage. */
1269 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_JAPANESE
))
1272 else if (EQ (val
, Qko
))
1274 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_KOREAN
))
1277 else if (EQ (val
, Qzh
))
1279 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_CHINESE
))
1283 /* Any other language, we don't recognize it. Only the above
1284 currently appear in fontset.el, so it isn't worth
1285 creating a mapping table of codepages/scripts to languages
1286 or opening the font to see if there are any language tags
1287 in it that the W32 API does not expose. Fontset
1288 spec should have a fallback, as some backends do
1289 not recognize language at all. */
1292 else if (EQ (key
, QCotf
) && CONSP (val
))
1294 /* OTF features only supported by the uniscribe backend. */
1295 if (EQ (backend
, Quniscribe
))
1297 if (!uniscribe_check_otf (logfont
, val
))
1309 w32font_coverage_ok (coverage
, charset
)
1310 FONTSIGNATURE
* coverage
;
1313 DWORD subrange1
= coverage
->fsUsb
[1];
1315 #define SUBRANGE1_HAN_MASK 0x08000000
1316 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1317 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1319 if (charset
== GB2312_CHARSET
|| charset
== CHINESEBIG5_CHARSET
)
1321 return (subrange1
& SUBRANGE1_HAN_MASK
) == SUBRANGE1_HAN_MASK
;
1323 else if (charset
== SHIFTJIS_CHARSET
)
1325 return (subrange1
& SUBRANGE1_JAPANESE_MASK
) == SUBRANGE1_JAPANESE_MASK
;
1327 else if (charset
== HANGEUL_CHARSET
)
1329 return (subrange1
& SUBRANGE1_HANGEUL_MASK
) == SUBRANGE1_HANGEUL_MASK
;
1335 /* Callback function for EnumFontFamiliesEx.
1336 * Checks if a font matches everything we are trying to check agaist,
1337 * and if so, adds it to a list. Both the data we are checking against
1338 * and the list to which the fonts are added are passed in via the
1339 * lparam argument, in the form of a font_callback_data struct. */
1341 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1342 ENUMLOGFONTEX
*logical_font
;
1343 NEWTEXTMETRICEX
*physical_font
;
1347 struct font_callback_data
*match_data
1348 = (struct font_callback_data
*) lParam
;
1349 Lisp_Object backend
= match_data
->opentype_only
? Quniscribe
: Qgdi
;
1351 if ((!match_data
->opentype_only
1352 || (((physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
1353 || (font_type
& TRUETYPE_FONTTYPE
))
1354 /* For the uniscribe backend, only consider fonts that claim
1355 to cover at least some part of Unicode. */
1356 && (physical_font
->ntmFontSig
.fsUsb
[3]
1357 || physical_font
->ntmFontSig
.fsUsb
[2]
1358 || physical_font
->ntmFontSig
.fsUsb
[1]
1359 || (physical_font
->ntmFontSig
.fsUsb
[0] & 0x3fffffff))))
1360 && logfonts_match (&logical_font
->elfLogFont
, &match_data
->pattern
)
1361 && font_matches_spec (font_type
, physical_font
,
1362 match_data
->orig_font_spec
, backend
,
1363 &logical_font
->elfLogFont
)
1364 && w32font_coverage_ok (&physical_font
->ntmFontSig
,
1365 match_data
->pattern
.lfCharSet
)
1366 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1367 We limit this to raster fonts, because the test can catch some
1368 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1369 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1370 therefore get through this test. Since full names can be prefixed
1371 by a foundry, we accept raster fonts if the font name is found
1372 anywhere within the full name. */
1373 && (logical_font
->elfLogFont
.lfOutPrecision
!= OUT_STRING_PRECIS
1374 || strstr (logical_font
->elfFullName
,
1375 logical_font
->elfLogFont
.lfFaceName
)))
1378 = w32_enumfont_pattern_entity (match_data
->frame
, logical_font
,
1379 physical_font
, font_type
,
1380 &match_data
->pattern
,
1384 Lisp_Object spec_charset
= AREF (match_data
->orig_font_spec
,
1385 FONT_REGISTRY_INDEX
);
1387 /* If registry was specified as iso10646-1, only report
1388 ANSI and DEFAULT charsets, as most unicode fonts will
1389 contain one of those plus others. */
1390 if ((EQ (spec_charset
, Qiso10646_1
)
1391 || EQ (spec_charset
, Qunicode_bmp
)
1392 || EQ (spec_charset
, Qunicode_sip
))
1393 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
1394 && logical_font
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
)
1396 /* If registry was specified, but did not map to a windows
1397 charset, only report fonts that have unknown charsets.
1398 This will still report fonts that don't match, but at
1399 least it eliminates known definite mismatches. */
1400 else if (!NILP (spec_charset
)
1401 && !EQ (spec_charset
, Qiso10646_1
)
1402 && !EQ (spec_charset
, Qunicode_bmp
)
1403 && !EQ (spec_charset
, Qunicode_sip
)
1404 && match_data
->pattern
.lfCharSet
== DEFAULT_CHARSET
1405 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
)
1408 /* If registry was specified, ensure it is reported as the same. */
1409 if (!NILP (spec_charset
))
1410 ASET (entity
, FONT_REGISTRY_INDEX
, spec_charset
);
1412 match_data
->list
= Fcons (entity
, match_data
->list
);
1414 /* If no registry specified, duplicate iso8859-1 truetype fonts
1416 if (NILP (spec_charset
)
1417 && font_type
== TRUETYPE_FONTTYPE
1418 && logical_font
->elfLogFont
.lfCharSet
== ANSI_CHARSET
)
1420 Lisp_Object tem
= Fcopy_font_spec (entity
);
1421 ASET (tem
, FONT_REGISTRY_INDEX
, Qiso10646_1
);
1422 match_data
->list
= Fcons (tem
, match_data
->list
);
1429 /* Callback function for EnumFontFamiliesEx.
1430 * Terminates the search once we have a match. */
1432 add_one_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1433 ENUMLOGFONTEX
*logical_font
;
1434 NEWTEXTMETRICEX
*physical_font
;
1438 struct font_callback_data
*match_data
1439 = (struct font_callback_data
*) lParam
;
1440 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
);
1442 /* If we have a font in the list, terminate the search. */
1443 return !NILP (match_data
->list
);
1446 /* Old function to convert from x to w32 charset, from w32fns.c. */
1448 x_to_w32_charset (lpcs
)
1451 Lisp_Object this_entry
, w32_charset
;
1453 int len
= strlen (lpcs
);
1455 /* Support "*-#nnn" format for unknown charsets. */
1456 if (strncmp (lpcs
, "*-#", 3) == 0)
1457 return atoi (lpcs
+ 3);
1459 /* All Windows fonts qualify as unicode. */
1460 if (!strncmp (lpcs
, "iso10646", 8))
1461 return DEFAULT_CHARSET
;
1463 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1464 charset
= alloca (len
+ 1);
1465 strcpy (charset
, lpcs
);
1466 lpcs
= strchr (charset
, '*');
1470 /* Look through w32-charset-info-alist for the character set.
1471 Format of each entry is
1472 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1474 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
1476 if (NILP (this_entry
))
1478 /* At startup, we want iso8859-1 fonts to come up properly. */
1479 if (xstrcasecmp (charset
, "iso8859-1") == 0)
1480 return ANSI_CHARSET
;
1482 return DEFAULT_CHARSET
;
1485 w32_charset
= Fcar (Fcdr (this_entry
));
1487 /* Translate Lisp symbol to number. */
1488 if (EQ (w32_charset
, Qw32_charset_ansi
))
1489 return ANSI_CHARSET
;
1490 if (EQ (w32_charset
, Qw32_charset_symbol
))
1491 return SYMBOL_CHARSET
;
1492 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
1493 return SHIFTJIS_CHARSET
;
1494 if (EQ (w32_charset
, Qw32_charset_hangeul
))
1495 return HANGEUL_CHARSET
;
1496 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
1497 return CHINESEBIG5_CHARSET
;
1498 if (EQ (w32_charset
, Qw32_charset_gb2312
))
1499 return GB2312_CHARSET
;
1500 if (EQ (w32_charset
, Qw32_charset_oem
))
1502 if (EQ (w32_charset
, Qw32_charset_johab
))
1503 return JOHAB_CHARSET
;
1504 if (EQ (w32_charset
, Qw32_charset_easteurope
))
1505 return EASTEUROPE_CHARSET
;
1506 if (EQ (w32_charset
, Qw32_charset_turkish
))
1507 return TURKISH_CHARSET
;
1508 if (EQ (w32_charset
, Qw32_charset_baltic
))
1509 return BALTIC_CHARSET
;
1510 if (EQ (w32_charset
, Qw32_charset_russian
))
1511 return RUSSIAN_CHARSET
;
1512 if (EQ (w32_charset
, Qw32_charset_arabic
))
1513 return ARABIC_CHARSET
;
1514 if (EQ (w32_charset
, Qw32_charset_greek
))
1515 return GREEK_CHARSET
;
1516 if (EQ (w32_charset
, Qw32_charset_hebrew
))
1517 return HEBREW_CHARSET
;
1518 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
1519 return VIETNAMESE_CHARSET
;
1520 if (EQ (w32_charset
, Qw32_charset_thai
))
1521 return THAI_CHARSET
;
1522 if (EQ (w32_charset
, Qw32_charset_mac
))
1525 return DEFAULT_CHARSET
;
1529 /* Convert a Lisp font registry (symbol) to a windows charset. */
1531 registry_to_w32_charset (charset
)
1532 Lisp_Object charset
;
1534 if (EQ (charset
, Qiso10646_1
) || EQ (charset
, Qunicode_bmp
)
1535 || EQ (charset
, Qunicode_sip
))
1536 return DEFAULT_CHARSET
; /* UNICODE_CHARSET not defined in MingW32 */
1537 else if (EQ (charset
, Qiso8859_1
))
1538 return ANSI_CHARSET
;
1539 else if (SYMBOLP (charset
))
1540 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset
)));
1542 return DEFAULT_CHARSET
;
1545 /* Old function to convert from w32 to x charset, from w32fns.c. */
1547 w32_to_x_charset (fncharset
, matching
)
1551 static char buf
[32];
1552 Lisp_Object charset_type
;
1557 /* If fully specified, accept it as it is. Otherwise use a
1559 char *wildcard
= strchr (matching
, '*');
1562 else if (strchr (matching
, '-'))
1565 match_len
= strlen (matching
);
1571 /* Handle startup case of w32-charset-info-alist not
1572 being set up yet. */
1573 if (NILP (Vw32_charset_info_alist
))
1575 charset_type
= Qw32_charset_ansi
;
1577 case DEFAULT_CHARSET
:
1578 charset_type
= Qw32_charset_default
;
1580 case SYMBOL_CHARSET
:
1581 charset_type
= Qw32_charset_symbol
;
1583 case SHIFTJIS_CHARSET
:
1584 charset_type
= Qw32_charset_shiftjis
;
1586 case HANGEUL_CHARSET
:
1587 charset_type
= Qw32_charset_hangeul
;
1589 case GB2312_CHARSET
:
1590 charset_type
= Qw32_charset_gb2312
;
1592 case CHINESEBIG5_CHARSET
:
1593 charset_type
= Qw32_charset_chinesebig5
;
1596 charset_type
= Qw32_charset_oem
;
1598 case EASTEUROPE_CHARSET
:
1599 charset_type
= Qw32_charset_easteurope
;
1601 case TURKISH_CHARSET
:
1602 charset_type
= Qw32_charset_turkish
;
1604 case BALTIC_CHARSET
:
1605 charset_type
= Qw32_charset_baltic
;
1607 case RUSSIAN_CHARSET
:
1608 charset_type
= Qw32_charset_russian
;
1610 case ARABIC_CHARSET
:
1611 charset_type
= Qw32_charset_arabic
;
1614 charset_type
= Qw32_charset_greek
;
1616 case HEBREW_CHARSET
:
1617 charset_type
= Qw32_charset_hebrew
;
1619 case VIETNAMESE_CHARSET
:
1620 charset_type
= Qw32_charset_vietnamese
;
1623 charset_type
= Qw32_charset_thai
;
1626 charset_type
= Qw32_charset_mac
;
1629 charset_type
= Qw32_charset_johab
;
1633 /* Encode numerical value of unknown charset. */
1634 sprintf (buf
, "*-#%u", fncharset
);
1640 char * best_match
= NULL
;
1641 int matching_found
= 0;
1643 /* Look through w32-charset-info-alist for the character set.
1644 Prefer ISO codepages, and prefer lower numbers in the ISO
1645 range. Only return charsets for codepages which are installed.
1647 Format of each entry is
1648 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1650 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
1653 Lisp_Object w32_charset
;
1654 Lisp_Object codepage
;
1656 Lisp_Object this_entry
= XCAR (rest
);
1658 /* Skip invalid entries in alist. */
1659 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
1660 || !CONSP (XCDR (this_entry
))
1661 || !SYMBOLP (XCAR (XCDR (this_entry
))))
1664 x_charset
= SDATA (XCAR (this_entry
));
1665 w32_charset
= XCAR (XCDR (this_entry
));
1666 codepage
= XCDR (XCDR (this_entry
));
1668 /* Look for Same charset and a valid codepage (or non-int
1669 which means ignore). */
1670 if (EQ (w32_charset
, charset_type
)
1671 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
1672 || IsValidCodePage (XINT (codepage
))))
1674 /* If we don't have a match already, then this is the
1678 best_match
= x_charset
;
1679 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
1682 /* If we already found a match for MATCHING, then
1683 only consider other matches. */
1684 else if (matching_found
1685 && strnicmp (x_charset
, matching
, match_len
))
1687 /* If this matches what we want, and the best so far doesn't,
1688 then this is better. */
1689 else if (!matching_found
&& matching
1690 && !strnicmp (x_charset
, matching
, match_len
))
1692 best_match
= x_charset
;
1695 /* If this is fully specified, and the best so far isn't,
1696 then this is better. */
1697 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
1698 /* If this is an ISO codepage, and the best so far isn't,
1699 then this is better, but only if it fully specifies the
1701 || (strnicmp (best_match
, "iso", 3) != 0
1702 && strnicmp (x_charset
, "iso", 3) == 0
1703 && strchr (x_charset
, '-')))
1704 best_match
= x_charset
;
1705 /* If both are ISO8859 codepages, choose the one with the
1706 lowest number in the encoding field. */
1707 else if (strnicmp (best_match
, "iso8859-", 8) == 0
1708 && strnicmp (x_charset
, "iso8859-", 8) == 0)
1710 int best_enc
= atoi (best_match
+ 8);
1711 int this_enc
= atoi (x_charset
+ 8);
1712 if (this_enc
> 0 && this_enc
< best_enc
)
1713 best_match
= x_charset
;
1718 /* If no match, encode the numeric value. */
1721 sprintf (buf
, "*-#%u", fncharset
);
1725 strncpy (buf
, best_match
, 31);
1726 /* If the charset is not fully specified, put -0 on the end. */
1727 if (!strchr (best_match
, '-'))
1729 int pos
= strlen (best_match
);
1730 /* Charset specifiers shouldn't be very long. If it is a made
1731 up one, truncating it should not do any harm since it isn't
1732 recognized anyway. */
1735 strcpy (buf
+ pos
, "-0");
1743 w32_registry (w32_charset
, font_type
)
1749 /* If charset is defaulted, charset is unicode or unknown, depending on
1751 if (w32_charset
== DEFAULT_CHARSET
)
1752 return font_type
== TRUETYPE_FONTTYPE
? Qiso10646_1
: Qunknown
;
1754 charset
= w32_to_x_charset (w32_charset
, NULL
);
1755 return font_intern_prop (charset
, strlen(charset
), 1);
1759 w32_decode_weight (fnweight
)
1762 if (fnweight
>= FW_HEAVY
) return 210;
1763 if (fnweight
>= FW_EXTRABOLD
) return 205;
1764 if (fnweight
>= FW_BOLD
) return 200;
1765 if (fnweight
>= FW_SEMIBOLD
) return 180;
1766 if (fnweight
>= FW_NORMAL
) return 100;
1767 if (fnweight
>= FW_LIGHT
) return 50;
1768 if (fnweight
>= FW_EXTRALIGHT
) return 40;
1769 if (fnweight
> FW_THIN
) return 20;
1774 w32_encode_weight (n
)
1777 if (n
>= 210) return FW_HEAVY
;
1778 if (n
>= 205) return FW_EXTRABOLD
;
1779 if (n
>= 200) return FW_BOLD
;
1780 if (n
>= 180) return FW_SEMIBOLD
;
1781 if (n
>= 100) return FW_NORMAL
;
1782 if (n
>= 50) return FW_LIGHT
;
1783 if (n
>= 40) return FW_EXTRALIGHT
;
1784 if (n
>= 20) return FW_THIN
;
1788 /* Convert a Windows font weight into one of the weights supported
1789 by fontconfig (see font.c:font_parse_fcname). */
1791 w32_to_fc_weight (n
)
1794 if (n
>= FW_EXTRABOLD
) return intern ("black");
1795 if (n
>= FW_BOLD
) return intern ("bold");
1796 if (n
>= FW_SEMIBOLD
) return intern ("demibold");
1797 if (n
>= FW_NORMAL
) return intern ("medium");
1798 return intern ("light");
1801 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1803 fill_in_logfont (f
, logfont
, font_spec
)
1806 Lisp_Object font_spec
;
1808 Lisp_Object tmp
, extra
;
1809 int dpi
= FRAME_W32_DISPLAY_INFO (f
)->resy
;
1811 tmp
= AREF (font_spec
, FONT_DPI_INDEX
);
1816 else if (FLOATP (tmp
))
1818 dpi
= (int) (XFLOAT_DATA (tmp
) + 0.5);
1822 tmp
= AREF (font_spec
, FONT_SIZE_INDEX
);
1824 logfont
->lfHeight
= -1 * XINT (tmp
);
1825 else if (FLOATP (tmp
))
1826 logfont
->lfHeight
= (int) (-1.0 * dpi
* XFLOAT_DATA (tmp
) / 72.27 + 0.5);
1833 tmp
= AREF (font_spec
, FONT_WEIGHT_INDEX
);
1835 logfont
->lfWeight
= w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec
));
1838 tmp
= AREF (font_spec
, FONT_SLANT_INDEX
);
1841 int slant
= FONT_SLANT_NUMERIC (font_spec
);
1842 logfont
->lfItalic
= slant
> 150 ? 1 : 0;
1850 tmp
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1852 logfont
->lfCharSet
= registry_to_w32_charset (tmp
);
1854 logfont
->lfCharSet
= DEFAULT_CHARSET
;
1858 /* Clip Precision */
1861 logfont
->lfQuality
= DEFAULT_QUALITY
;
1863 /* Generic Family and Face Name */
1864 logfont
->lfPitchAndFamily
= FF_DONTCARE
| DEFAULT_PITCH
;
1866 tmp
= AREF (font_spec
, FONT_FAMILY_INDEX
);
1869 logfont
->lfPitchAndFamily
= w32_generic_family (tmp
) | DEFAULT_PITCH
;
1870 if ((logfont
->lfPitchAndFamily
& 0xF0) != FF_DONTCARE
)
1871 ; /* Font name was generic, don't fill in font name. */
1872 /* Font families are interned, but allow for strings also in case of
1874 else if (SYMBOLP (tmp
))
1875 strncpy (logfont
->lfFaceName
, SDATA (SYMBOL_NAME (tmp
)), LF_FACESIZE
);
1878 tmp
= AREF (font_spec
, FONT_ADSTYLE_INDEX
);
1881 /* Override generic family. */
1882 BYTE family
= w32_generic_family (tmp
);
1883 if (family
!= FF_DONTCARE
)
1884 logfont
->lfPitchAndFamily
= family
| DEFAULT_PITCH
;
1888 /* Set pitch based on the spacing property. */
1889 tmp
= AREF (font_spec
, FONT_SPACING_INDEX
);
1892 int spacing
= XINT (tmp
);
1893 if (spacing
< FONT_SPACING_MONO
)
1894 logfont
->lfPitchAndFamily
1895 = logfont
->lfPitchAndFamily
& 0xF0 | VARIABLE_PITCH
;
1897 logfont
->lfPitchAndFamily
1898 = logfont
->lfPitchAndFamily
& 0xF0 | FIXED_PITCH
;
1901 /* Process EXTRA info. */
1902 for (extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
1903 CONSP (extra
); extra
= XCDR (extra
))
1908 Lisp_Object key
, val
;
1909 key
= XCAR (tmp
), val
= XCDR (tmp
);
1910 /* Only use QCscript if charset is not provided, or is unicode
1911 and a single script is specified. This is rather crude,
1912 and is only used to narrow down the fonts returned where
1913 there is a definite match. Some scripts, such as latin, han,
1914 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1916 if (EQ (key
, QCscript
)
1917 && logfont
->lfCharSet
== DEFAULT_CHARSET
1920 if (EQ (val
, Qgreek
))
1921 logfont
->lfCharSet
= GREEK_CHARSET
;
1922 else if (EQ (val
, Qhangul
))
1923 logfont
->lfCharSet
= HANGUL_CHARSET
;
1924 else if (EQ (val
, Qkana
) || EQ (val
, Qkanbun
))
1925 logfont
->lfCharSet
= SHIFTJIS_CHARSET
;
1926 else if (EQ (val
, Qbopomofo
))
1927 logfont
->lfCharSet
= CHINESEBIG5_CHARSET
;
1928 /* GB 18030 supports tibetan, yi, mongolian,
1929 fonts that support it should show up if we ask for
1931 else if (EQ (val
, Qtibetan
) || EQ (val
, Qyi
)
1932 || EQ (val
, Qmongolian
))
1933 logfont
->lfCharSet
= GB2312_CHARSET
;
1934 else if (EQ (val
, Qhebrew
))
1935 logfont
->lfCharSet
= HEBREW_CHARSET
;
1936 else if (EQ (val
, Qarabic
))
1937 logfont
->lfCharSet
= ARABIC_CHARSET
;
1938 else if (EQ (val
, Qthai
))
1939 logfont
->lfCharSet
= THAI_CHARSET
;
1940 else if (EQ (val
, Qsymbol
))
1941 logfont
->lfCharSet
= SYMBOL_CHARSET
;
1943 else if (EQ (key
, QCantialias
) && SYMBOLP (val
))
1945 logfont
->lfQuality
= w32_antialias_type (val
);
1952 list_all_matching_fonts (match_data
)
1953 struct font_callback_data
*match_data
;
1956 Lisp_Object families
= w32font_list_family (match_data
->frame
);
1957 struct frame
*f
= XFRAME (match_data
->frame
);
1959 dc
= get_frame_dc (f
);
1961 while (!NILP (families
))
1963 /* TODO: Use the Unicode versions of the W32 APIs, so we can
1964 handle non-ASCII font names. */
1966 Lisp_Object family
= CAR (families
);
1967 families
= CDR (families
);
1970 else if (SYMBOLP (family
))
1971 name
= SDATA (SYMBOL_NAME (family
));
1975 strncpy (match_data
->pattern
.lfFaceName
, name
, LF_FACESIZE
);
1976 match_data
->pattern
.lfFaceName
[LF_FACESIZE
- 1] = '\0';
1978 EnumFontFamiliesEx (dc
, &match_data
->pattern
,
1979 (FONTENUMPROC
) add_font_entity_to_list
,
1980 (LPARAM
) match_data
, 0);
1983 release_frame_dc (f
, dc
);
1987 lispy_antialias_type (type
)
1994 case NONANTIALIASED_QUALITY
:
1997 case ANTIALIASED_QUALITY
:
2000 case CLEARTYPE_QUALITY
:
2003 case CLEARTYPE_NATURAL_QUALITY
:
2013 /* Convert antialiasing symbols to lfQuality */
2015 w32_antialias_type (type
)
2018 if (EQ (type
, Qnone
))
2019 return NONANTIALIASED_QUALITY
;
2020 else if (EQ (type
, Qstandard
))
2021 return ANTIALIASED_QUALITY
;
2022 else if (EQ (type
, Qsubpixel
))
2023 return CLEARTYPE_QUALITY
;
2024 else if (EQ (type
, Qnatural
))
2025 return CLEARTYPE_NATURAL_QUALITY
;
2027 return DEFAULT_QUALITY
;
2030 /* Return a list of all the scripts that the font supports. */
2032 font_supported_scripts (FONTSIGNATURE
* sig
)
2034 DWORD
* subranges
= sig
->fsUsb
;
2035 Lisp_Object supported
= Qnil
;
2037 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2038 #define SUBRANGE(n,sym) \
2039 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2040 supported = Fcons ((sym), supported)
2042 /* Match multiple subranges. SYM is set if any MASK bit is set in
2043 subranges[0 - 3]. */
2044 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2045 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2046 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2047 supported = Fcons ((sym), supported)
2049 SUBRANGE (0, Qlatin
);
2050 /* The following count as latin too, ASCII should be present in these fonts,
2051 so don't need to mark them separately. */
2052 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2053 SUBRANGE (4, Qphonetic
);
2054 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
2055 SUBRANGE (7, Qgreek
);
2056 SUBRANGE (8, Qcoptic
);
2057 SUBRANGE (9, Qcyrillic
);
2058 SUBRANGE (10, Qarmenian
);
2059 SUBRANGE (11, Qhebrew
);
2060 SUBRANGE (13, Qarabic
);
2061 SUBRANGE (14, Qnko
);
2062 SUBRANGE (15, Qdevanagari
);
2063 SUBRANGE (16, Qbengali
);
2064 SUBRANGE (17, Qgurmukhi
);
2065 SUBRANGE (18, Qgujarati
);
2066 SUBRANGE (19, Qoriya
);
2067 SUBRANGE (20, Qtamil
);
2068 SUBRANGE (21, Qtelugu
);
2069 SUBRANGE (22, Qkannada
);
2070 SUBRANGE (23, Qmalayalam
);
2071 SUBRANGE (24, Qthai
);
2072 SUBRANGE (25, Qlao
);
2073 SUBRANGE (26, Qgeorgian
);
2074 SUBRANGE (27, Qbalinese
);
2075 /* 28: Hangul Jamo. */
2076 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2077 /* 32-47: Symbols (defined below). */
2078 SUBRANGE (48, Qcjk_misc
);
2079 /* Match either 49: katakana or 50: hiragana for kana. */
2080 MASK_ANY (0, 0x00060000, 0, 0, Qkana
);
2081 SUBRANGE (51, Qbopomofo
);
2082 /* 52: Compatibility Jamo */
2083 SUBRANGE (53, Qphags_pa
);
2084 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2085 SUBRANGE (56, Qhangul
);
2086 /* 57: Surrogates. */
2087 SUBRANGE (58, Qphoenician
);
2088 SUBRANGE (59, Qhan
); /* There are others, but this is the main one. */
2089 SUBRANGE (59, Qideographic_description
); /* Windows lumps this in. */
2090 SUBRANGE (59, Qkanbun
); /* And this. */
2091 /* 60: Private use, 61: CJK strokes and compatibility. */
2092 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2093 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2094 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2096 SUBRANGE (70, Qtibetan
);
2097 SUBRANGE (71, Qsyriac
);
2098 SUBRANGE (72, Qthaana
);
2099 SUBRANGE (73, Qsinhala
);
2100 SUBRANGE (74, Qmyanmar
);
2101 SUBRANGE (75, Qethiopic
);
2102 SUBRANGE (76, Qcherokee
);
2103 SUBRANGE (77, Qcanadian_aboriginal
);
2104 SUBRANGE (78, Qogham
);
2105 SUBRANGE (79, Qrunic
);
2106 SUBRANGE (80, Qkhmer
);
2107 SUBRANGE (81, Qmongolian
);
2108 SUBRANGE (82, Qbraille
);
2110 SUBRANGE (84, Qbuhid
);
2111 SUBRANGE (84, Qhanunoo
);
2112 SUBRANGE (84, Qtagalog
);
2113 SUBRANGE (84, Qtagbanwa
);
2114 SUBRANGE (85, Qold_italic
);
2115 SUBRANGE (86, Qgothic
);
2116 SUBRANGE (87, Qdeseret
);
2117 SUBRANGE (88, Qbyzantine_musical_symbol
);
2118 SUBRANGE (88, Qmusical_symbol
); /* Windows doesn't distinguish these. */
2119 SUBRANGE (89, Qmathematical
);
2120 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2121 SUBRANGE (93, Qlimbu
);
2122 SUBRANGE (94, Qtai_le
);
2123 /* 95: New Tai Le */
2124 SUBRANGE (90, Qbuginese
);
2125 SUBRANGE (97, Qglagolitic
);
2126 SUBRANGE (98, Qtifinagh
);
2127 /* 99: Yijing Hexagrams. */
2128 SUBRANGE (100, Qsyloti_nagri
);
2129 SUBRANGE (101, Qlinear_b
);
2130 /* 102: Ancient Greek Numbers. */
2131 SUBRANGE (103, Qugaritic
);
2132 SUBRANGE (104, Qold_persian
);
2133 SUBRANGE (105, Qshavian
);
2134 SUBRANGE (106, Qosmanya
);
2135 SUBRANGE (107, Qcypriot
);
2136 SUBRANGE (108, Qkharoshthi
);
2137 /* 109: Tai Xuan Jing. */
2138 SUBRANGE (110, Qcuneiform
);
2139 /* 111: Counting Rods. */
2141 /* There isn't really a main symbol range, so include symbol if any
2142 relevant range is set. */
2143 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol
);
2145 /* Missing: Tai Viet (U+AA80) and Cham (U+AA00) . */
2152 /* Generate a full name for a Windows font.
2153 The full name is in fcname format, with weight, slant and antialiasing
2154 specified if they are not "normal". */
2156 w32font_full_name (font
, font_obj
, pixel_size
, name
, nbytes
)
2158 Lisp_Object font_obj
;
2163 int len
, height
, outline
;
2165 Lisp_Object antialiasing
, weight
= Qnil
;
2167 len
= strlen (font
->lfFaceName
);
2169 outline
= EQ (AREF (font_obj
, FONT_FOUNDRY_INDEX
), Qoutline
);
2171 /* Represent size of scalable fonts by point size. But use pixelsize for
2172 raster fonts to indicate that they are exactly that size. */
2174 len
+= 11; /* -SIZE */
2179 len
+= 7; /* :italic */
2181 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2183 weight
= w32_to_fc_weight (font
->lfWeight
);
2184 len
+= 1 + SBYTES (SYMBOL_NAME (weight
)); /* :WEIGHT */
2187 antialiasing
= lispy_antialias_type (font
->lfQuality
);
2188 if (! NILP (antialiasing
))
2189 len
+= 11 + SBYTES (SYMBOL_NAME (antialiasing
)); /* :antialias=NAME */
2191 /* Check that the buffer is big enough */
2196 p
+= sprintf (p
, "%s", font
->lfFaceName
);
2198 height
= font
->lfHeight
? eabs (font
->lfHeight
) : pixel_size
;
2204 float pointsize
= height
* 72.0 / one_w32_display_info
.resy
;
2205 /* Round to nearest half point. floor is used, since round is not
2206 supported in MS library. */
2207 pointsize
= floor (pointsize
* 2 + 0.5) / 2;
2208 p
+= sprintf (p
, "-%1.1f", pointsize
);
2211 p
+= sprintf (p
, ":pixelsize=%d", height
);
2214 if (SYMBOLP (weight
) && ! NILP (weight
))
2215 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2218 p
+= sprintf (p
, ":italic");
2220 if (SYMBOLP (antialiasing
) && ! NILP (antialiasing
))
2221 p
+= sprintf (p
, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing
)));
2226 /* Convert a logfont and point size into a fontconfig style font name.
2227 POINTSIZE is in tenths of points.
2228 If SIZE indicates the size of buffer FCNAME, into which the font name
2229 is written. If the buffer is not large enough to contain the name,
2230 the function returns -1, otherwise it returns the number of bytes
2231 written to FCNAME. */
2232 static int logfont_to_fcname(font
, pointsize
, fcname
, size
)
2240 Lisp_Object weight
= Qnil
;
2242 len
= strlen (font
->lfFaceName
) + 2;
2243 height
= pointsize
/ 10;
2244 while (height
/= 10)
2251 len
+= 7; /* :italic */
2252 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2254 weight
= w32_to_fc_weight (font
->lfWeight
);
2255 len
+= SBYTES (SYMBOL_NAME (weight
)) + 1;
2261 p
+= sprintf (p
, "%s-%d", font
->lfFaceName
, pointsize
/ 10);
2263 p
+= sprintf (p
, ".%d", pointsize
% 10);
2265 if (SYMBOLP (weight
) && !NILP (weight
))
2266 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2269 p
+= sprintf (p
, ":italic");
2271 return (p
- fcname
);
2275 compute_metrics (dc
, w32_font
, code
, metrics
)
2277 struct w32font_info
*w32_font
;
2279 struct w32_metric_cache
*metrics
;
2283 unsigned int options
= GGO_METRICS
;
2285 if (w32_font
->glyph_idx
)
2286 options
|= GGO_GLYPH_INDEX
;
2288 bzero (&transform
, sizeof (transform
));
2289 transform
.eM11
.value
= 1;
2290 transform
.eM22
.value
= 1;
2292 if (GetGlyphOutlineW (dc
, code
, options
, &gm
, 0, NULL
, &transform
)
2295 metrics
->lbearing
= gm
.gmptGlyphOrigin
.x
;
2296 metrics
->rbearing
= gm
.gmptGlyphOrigin
.x
+ gm
.gmBlackBoxX
;
2297 metrics
->width
= gm
.gmCellIncX
;
2298 metrics
->status
= W32METRIC_SUCCESS
;
2300 else if (w32_font
->glyph_idx
)
2302 /* Can't use glyph indexes after all.
2303 Avoid it in future, and clear any metrics that were based on
2305 w32_font
->glyph_idx
= 0;
2306 clear_cached_metrics (w32_font
);
2309 metrics
->status
= W32METRIC_FAIL
;
2313 clear_cached_metrics (w32_font
)
2314 struct w32font_info
*w32_font
;
2317 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
2319 if (w32_font
->cached_metrics
[i
])
2320 bzero (w32_font
->cached_metrics
[i
],
2321 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
2325 DEFUN ("x-select-font", Fx_select_font
, Sx_select_font
, 0, 2, 0,
2326 doc
: /* Read a font name using a W32 font selection dialog.
2327 Return fontconfig style font string corresponding to the selection.
2329 If FRAME is omitted or nil, it defaults to the selected frame.
2330 If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
2331 in the font selection dialog. */)
2332 (frame
, include_proportional
)
2333 Lisp_Object frame
, include_proportional
;
2335 FRAME_PTR f
= check_x_frame (frame
);
2343 bzero (&cf
, sizeof (cf
));
2344 bzero (&lf
, sizeof (lf
));
2346 cf
.lStructSize
= sizeof (cf
);
2347 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
2348 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
2350 /* Unless include_proportional is non-nil, limit the selection to
2351 monospaced fonts. */
2352 if (NILP (include_proportional
))
2353 cf
.Flags
|= CF_FIXEDPITCHONLY
;
2357 /* Initialize as much of the font details as we can from the current
2359 hdc
= GetDC (FRAME_W32_WINDOW (f
));
2360 oldobj
= SelectObject (hdc
, FONT_HANDLE (FRAME_FONT (f
)));
2361 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
2362 if (GetTextMetrics (hdc
, &tm
))
2364 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
2365 lf
.lfWeight
= tm
.tmWeight
;
2366 lf
.lfItalic
= tm
.tmItalic
;
2367 lf
.lfUnderline
= tm
.tmUnderlined
;
2368 lf
.lfStrikeOut
= tm
.tmStruckOut
;
2369 lf
.lfCharSet
= tm
.tmCharSet
;
2370 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
2372 SelectObject (hdc
, oldobj
);
2373 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
2375 if (!ChooseFont (&cf
)
2376 || logfont_to_fcname (&lf
, cf
.iPointSize
, buf
, 100) < 0)
2379 return build_string (buf
);
2382 struct font_driver w32font_driver
=
2385 0, /* case insensitive */
2389 w32font_list_family
,
2390 NULL
, /* free_entity */
2393 NULL
, /* prepare_face */
2394 NULL
, /* done_face */
2396 w32font_encode_char
,
2397 w32font_text_extents
,
2399 NULL
, /* get_bitmap */
2400 NULL
, /* free_bitmap */
2401 NULL
, /* get_outline */
2402 NULL
, /* free_outline */
2403 NULL
, /* anchor_point */
2404 NULL
, /* otf_capability */
2405 NULL
, /* otf_drive */
2406 NULL
, /* start_for_frame */
2407 NULL
, /* end_for_frame */
2412 /* Initialize state that does not change between invocations. This is only
2413 called when Emacs is dumped. */
2417 DEFSYM (Qgdi
, "gdi");
2418 DEFSYM (Quniscribe
, "uniscribe");
2419 DEFSYM (QCformat
, ":format");
2421 /* Generic font families. */
2422 DEFSYM (Qmonospace
, "monospace");
2423 DEFSYM (Qserif
, "serif");
2424 DEFSYM (Qsansserif
, "sansserif");
2425 DEFSYM (Qscript
, "script");
2426 DEFSYM (Qdecorative
, "decorative");
2428 DEFSYM (Qsans_serif
, "sans_serif");
2429 DEFSYM (Qsans
, "sans");
2430 DEFSYM (Qmono
, "mono");
2432 /* Fake foundries. */
2433 DEFSYM (Qraster
, "raster");
2434 DEFSYM (Qoutline
, "outline");
2435 DEFSYM (Qunknown
, "unknown");
2438 DEFSYM (Qstandard
, "standard");
2439 DEFSYM (Qsubpixel
, "subpixel");
2440 DEFSYM (Qnatural
, "natural");
2448 DEFSYM (Qlatin
, "latin");
2449 DEFSYM (Qgreek
, "greek");
2450 DEFSYM (Qcoptic
, "coptic");
2451 DEFSYM (Qcyrillic
, "cyrillic");
2452 DEFSYM (Qarmenian
, "armenian");
2453 DEFSYM (Qhebrew
, "hebrew");
2454 DEFSYM (Qarabic
, "arabic");
2455 DEFSYM (Qsyriac
, "syriac");
2456 DEFSYM (Qnko
, "nko");
2457 DEFSYM (Qthaana
, "thaana");
2458 DEFSYM (Qdevanagari
, "devanagari");
2459 DEFSYM (Qbengali
, "bengali");
2460 DEFSYM (Qgurmukhi
, "gurmukhi");
2461 DEFSYM (Qgujarati
, "gujarati");
2462 DEFSYM (Qoriya
, "oriya");
2463 DEFSYM (Qtamil
, "tamil");
2464 DEFSYM (Qtelugu
, "telugu");
2465 DEFSYM (Qkannada
, "kannada");
2466 DEFSYM (Qmalayalam
, "malayalam");
2467 DEFSYM (Qsinhala
, "sinhala");
2468 DEFSYM (Qthai
, "thai");
2469 DEFSYM (Qlao
, "lao");
2470 DEFSYM (Qtibetan
, "tibetan");
2471 DEFSYM (Qmyanmar
, "myanmar");
2472 DEFSYM (Qgeorgian
, "georgian");
2473 DEFSYM (Qhangul
, "hangul");
2474 DEFSYM (Qethiopic
, "ethiopic");
2475 DEFSYM (Qcherokee
, "cherokee");
2476 DEFSYM (Qcanadian_aboriginal
, "canadian-aboriginal");
2477 DEFSYM (Qogham
, "ogham");
2478 DEFSYM (Qrunic
, "runic");
2479 DEFSYM (Qkhmer
, "khmer");
2480 DEFSYM (Qmongolian
, "mongolian");
2481 DEFSYM (Qsymbol
, "symbol");
2482 DEFSYM (Qbraille
, "braille");
2483 DEFSYM (Qhan
, "han");
2484 DEFSYM (Qideographic_description
, "ideographic-description");
2485 DEFSYM (Qcjk_misc
, "cjk-misc");
2486 DEFSYM (Qkana
, "kana");
2487 DEFSYM (Qbopomofo
, "bopomofo");
2488 DEFSYM (Qkanbun
, "kanbun");
2490 DEFSYM (Qbyzantine_musical_symbol
, "byzantine-musical-symbol");
2491 DEFSYM (Qmusical_symbol
, "musical-symbol");
2492 DEFSYM (Qmathematical
, "mathematical");
2493 DEFSYM (Qphonetic
, "phonetic");
2494 DEFSYM (Qbalinese
, "balinese");
2495 DEFSYM (Qbuginese
, "buginese");
2496 DEFSYM (Qbuhid
, "buhid");
2497 DEFSYM (Qcuneiform
, "cuneiform");
2498 DEFSYM (Qcypriot
, "cypriot");
2499 DEFSYM (Qdeseret
, "deseret");
2500 DEFSYM (Qglagolitic
, "glagolitic");
2501 DEFSYM (Qgothic
, "gothic");
2502 DEFSYM (Qhanunoo
, "hanunoo");
2503 DEFSYM (Qkharoshthi
, "kharoshthi");
2504 DEFSYM (Qlimbu
, "limbu");
2505 DEFSYM (Qlinear_b
, "linear_b");
2506 DEFSYM (Qold_italic
, "old_italic");
2507 DEFSYM (Qold_persian
, "old_persian");
2508 DEFSYM (Qosmanya
, "osmanya");
2509 DEFSYM (Qphags_pa
, "phags-pa");
2510 DEFSYM (Qphoenician
, "phoenician");
2511 DEFSYM (Qshavian
, "shavian");
2512 DEFSYM (Qsyloti_nagri
, "syloti_nagri");
2513 DEFSYM (Qtagalog
, "tagalog");
2514 DEFSYM (Qtagbanwa
, "tagbanwa");
2515 DEFSYM (Qtai_le
, "tai_le");
2516 DEFSYM (Qtifinagh
, "tifinagh");
2517 DEFSYM (Qugaritic
, "ugaritic");
2519 /* W32 font encodings. */
2520 DEFVAR_LISP ("w32-charset-info-alist",
2521 &Vw32_charset_info_alist
,
2522 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
2523 Each entry should be of the form:
2525 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2527 where CHARSET_NAME is a string used in font names to identify the charset,
2528 WINDOWS_CHARSET is a symbol that can be one of:
2530 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2531 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2532 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2533 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2534 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2535 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2538 CODEPAGE should be an integer specifying the codepage that should be used
2539 to display the character set, t to do no translation and output as Unicode,
2540 or nil to do no translation and output as 8 bit (or multibyte on far-east
2541 versions of Windows) characters. */);
2542 Vw32_charset_info_alist
= Qnil
;
2544 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
2545 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
2546 DEFSYM (Qw32_charset_default
, "w32-charset-default");
2547 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
2548 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
2549 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
2550 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
2551 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
2552 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
2553 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
2554 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
2555 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
2556 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
2557 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
2558 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
2559 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
2560 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
2561 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
2562 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
2564 defsubr (&Sx_select_font
);
2566 w32font_driver
.type
= Qgdi
;
2567 register_font_driver (&w32font_driver
, NULL
);
2570 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2571 (do not change this comment) */