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
);
241 ASET (font_object
, FONT_TYPE_INDEX
, Qgdi
);
243 if (!w32font_open_internal (f
, font_entity
, pixel_size
, font_object
))
251 /* w32 implementation of close for font_backend.
252 Close FONT on frame F. */
254 w32font_close (f
, font
)
259 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
261 /* Delete the GDI font object. */
262 DeleteObject (w32_font
->hfont
);
264 /* Free all the cached metrics. */
265 if (w32_font
->cached_metrics
)
267 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
269 if (w32_font
->cached_metrics
[i
])
270 xfree (w32_font
->cached_metrics
[i
]);
272 xfree (w32_font
->cached_metrics
);
273 w32_font
->cached_metrics
= NULL
;
277 /* w32 implementation of has_char for font backend.
279 If FONT_ENTITY has a glyph for character C (Unicode code point),
280 return 1. If not, return 0. If a font must be opened to check
283 w32font_has_char (entity
, c
)
287 Lisp_Object supported_scripts
, extra
, script
;
290 extra
= AREF (entity
, FONT_EXTRA_INDEX
);
294 supported_scripts
= assq_no_quit (QCscript
, extra
);
295 if (!CONSP (supported_scripts
))
298 supported_scripts
= XCDR (supported_scripts
);
300 script
= CHAR_TABLE_REF (Vchar_script_table
, c
);
302 return (memq_no_quit (script
, supported_scripts
)) ? -1 : 0;
305 /* w32 implementation of encode_char for font backend.
306 Return a glyph code of FONT for characer C (Unicode code point).
307 If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */
309 w32font_encode_char (font
, c
)
321 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
323 /* If glyph indexing is not working for this font, just return the
324 unicode code-point. */
325 if (!w32_font
->glyph_idx
)
330 /* TODO: Encode as surrogate pair and lookup the glyph. */
331 return FONT_INVALID_CODE
;
339 bzero (&result
, sizeof (result
));
340 result
.lStructSize
= sizeof (result
);
341 result
.lpGlyphs
= out
;
344 f
= XFRAME (selected_frame
);
346 dc
= get_frame_dc (f
);
347 old_font
= SelectObject (dc
, w32_font
->hfont
);
349 /* GetCharacterPlacement is used here rather than GetGlyphIndices because
350 it is supported on Windows NT 4 and 9x/ME. But it cannot reliably report
351 missing glyphs, see below for workaround. */
352 retval
= GetCharacterPlacementW (dc
, in
, len
, 0, &result
, 0);
354 SelectObject (dc
, old_font
);
355 release_frame_dc (f
, dc
);
359 if (result
.nGlyphs
!= 1 || !result
.lpGlyphs
[0]
360 /* GetCharacterPlacementW seems to return 3, which seems to be
361 the space glyph in most/all truetype fonts, instead of 0
362 for unsupported glyphs. */
363 || (result
.lpGlyphs
[0] == 3 && !iswspace (in
[0])))
364 return FONT_INVALID_CODE
;
365 return result
.lpGlyphs
[0];
370 /* Mark this font as not supporting glyph indices. This can happen
371 on Windows9x, and maybe with non-Truetype fonts on NT etc. */
372 w32_font
->glyph_idx
= 0;
373 /* Clear metrics cache. */
374 clear_cached_metrics (w32_font
);
380 /* w32 implementation of text_extents for font backend.
381 Perform the size computation of glyphs of FONT and fillin members
382 of METRICS. The glyphs are specified by their glyph codes in
383 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
384 case just return the overall width. */
386 w32font_text_extents (font
, code
, nglyphs
, metrics
)
390 struct font_metrics
*metrics
;
393 HFONT old_font
= NULL
;
400 struct w32font_info
*w32_font
= (struct w32font_info
*) font
;
404 bzero (metrics
, sizeof (struct font_metrics
));
405 metrics
->ascent
= font
->ascent
;
406 metrics
->descent
= font
->descent
;
408 for (i
= 0; i
< nglyphs
; i
++)
410 struct w32_metric_cache
*char_metric
;
411 int block
= *(code
+ i
) / CACHE_BLOCKSIZE
;
412 int pos_in_block
= *(code
+ i
) % CACHE_BLOCKSIZE
;
414 if (block
>= w32_font
->n_cache_blocks
)
416 if (!w32_font
->cached_metrics
)
417 w32_font
->cached_metrics
418 = xmalloc ((block
+ 1)
419 * sizeof (struct w32_cached_metric
*));
421 w32_font
->cached_metrics
422 = xrealloc (w32_font
->cached_metrics
,
424 * sizeof (struct w32_cached_metric
*));
425 bzero (w32_font
->cached_metrics
+ w32_font
->n_cache_blocks
,
426 ((block
+ 1 - w32_font
->n_cache_blocks
)
427 * sizeof (struct w32_cached_metric
*)));
428 w32_font
->n_cache_blocks
= block
+ 1;
431 if (!w32_font
->cached_metrics
[block
])
433 w32_font
->cached_metrics
[block
]
434 = xmalloc (CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
435 bzero (w32_font
->cached_metrics
[block
],
436 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
439 char_metric
= w32_font
->cached_metrics
[block
] + pos_in_block
;
441 if (char_metric
->status
== W32METRIC_NO_ATTEMPT
)
445 /* TODO: Frames can come and go, and their fonts
446 outlive them. So we can't cache the frame in the
447 font structure. Use selected_frame until the API
448 is updated to pass in a frame. */
449 f
= XFRAME (selected_frame
);
451 dc
= get_frame_dc (f
);
452 old_font
= SelectObject (dc
, w32_font
->hfont
);
454 compute_metrics (dc
, w32_font
, *(code
+ i
), char_metric
);
457 if (char_metric
->status
== W32METRIC_SUCCESS
)
459 metrics
->lbearing
= min (metrics
->lbearing
,
460 metrics
->width
+ char_metric
->lbearing
);
461 metrics
->rbearing
= max (metrics
->rbearing
,
462 metrics
->width
+ char_metric
->rbearing
);
463 metrics
->width
+= char_metric
->width
;
466 /* If we couldn't get metrics for a char,
467 use alternative method. */
470 /* If we got through everything, return. */
475 /* Restore state and release DC. */
476 SelectObject (dc
, old_font
);
477 release_frame_dc (f
, dc
);
480 return metrics
->width
;
484 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
485 fallback on other methods that will at least give some of the metric
488 wcode
= alloca (nglyphs
* sizeof (WORD
));
489 for (i
= 0; i
< nglyphs
; i
++)
491 if (code
[i
] < 0x10000)
495 /* TODO: Convert to surrogate, reallocating array if needed */
502 /* TODO: Frames can come and go, and their fonts outlive
503 them. So we can't cache the frame in the font structure. Use
504 selected_frame until the API is updated to pass in a
506 f
= XFRAME (selected_frame
);
508 dc
= get_frame_dc (f
);
509 old_font
= SelectObject (dc
, w32_font
->hfont
);
512 if (GetTextExtentPoint32W (dc
, wcode
, nglyphs
, &size
))
514 total_width
= size
.cx
;
517 /* On 95/98/ME, only some unicode functions are available, so fallback
518 on doing a dummy draw to find the total width. */
522 rect
.top
= 0; rect
.bottom
= font
->height
; rect
.left
= 0; rect
.right
= 1;
523 DrawTextW (dc
, wcode
, nglyphs
, &rect
,
524 DT_CALCRECT
| DT_NOPREFIX
| DT_SINGLELINE
);
525 total_width
= rect
.right
;
528 /* Give our best estimate of the metrics, based on what we know. */
531 metrics
->width
= total_width
- w32_font
->metrics
.tmOverhang
;
532 metrics
->lbearing
= 0;
533 metrics
->rbearing
= total_width
;
536 /* Restore state and release DC. */
537 SelectObject (dc
, old_font
);
538 release_frame_dc (f
, dc
);
543 /* w32 implementation of draw for font backend.
545 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
546 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
547 is nonzero, fill the background in advance. It is assured that
548 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
550 TODO: Currently this assumes that the colors and fonts are already
551 set in the DC. This seems to be true now, but maybe only due to
552 the old font code setting it up. It may be safer to resolve faces
553 and fonts in here and set them explicitly
557 w32font_draw (s
, from
, to
, x
, y
, with_background
)
558 struct glyph_string
*s
;
559 int from
, to
, x
, y
, with_background
;
563 struct w32font_info
*w32font
= (struct w32font_info
*) s
->font
;
565 options
= w32font
->glyph_idx
;
567 /* Save clip region for later restoration. */
568 GetClipRgn(s
->hdc
, orig_clip
);
570 if (s
->num_clips
> 0)
572 HRGN new_clip
= CreateRectRgnIndirect (s
->clip
);
574 if (s
->num_clips
> 1)
576 HRGN clip2
= CreateRectRgnIndirect (s
->clip
+ 1);
578 CombineRgn (new_clip
, new_clip
, clip2
, RGN_OR
);
579 DeleteObject (clip2
);
582 SelectClipRgn (s
->hdc
, new_clip
);
583 DeleteObject (new_clip
);
586 /* Using OPAQUE background mode can clear more background than expected
587 when Cleartype is used. Draw the background manually to avoid this. */
588 SetBkMode (s
->hdc
, TRANSPARENT
);
593 struct font
*font
= s
->font
;
595 brush
= CreateSolidBrush (s
->gc
->background
);
597 rect
.top
= y
- font
->ascent
;
598 rect
.right
= x
+ s
->width
;
599 rect
.bottom
= y
+ font
->descent
;
600 FillRect (s
->hdc
, &rect
, brush
);
601 DeleteObject (brush
);
606 int len
= to
- from
, i
;
608 for (i
= 0; i
< len
; i
++)
609 ExtTextOutW (s
->hdc
, x
+ i
, y
, options
, NULL
,
610 s
->char2b
+ from
+ i
, 1, NULL
);
613 ExtTextOutW (s
->hdc
, x
, y
, options
, NULL
, s
->char2b
+ from
, to
- from
, NULL
);
615 /* Restore clip region. */
616 if (s
->num_clips
> 0)
618 SelectClipRgn (s
->hdc
, orig_clip
);
622 /* w32 implementation of free_entity for font backend.
623 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
624 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
626 w32font_free_entity (Lisp_Object entity);
629 /* w32 implementation of prepare_face for font backend.
630 Optional (if FACE->extra is not used).
631 Prepare FACE for displaying characters by FONT on frame F by
632 storing some data in FACE->extra. If successful, return 0.
633 Otherwise, return -1.
635 w32font_prepare_face (FRAME_PTR f, struct face *face);
637 /* w32 implementation of done_face for font backend.
639 Done FACE for displaying characters by FACE->font on frame F.
641 w32font_done_face (FRAME_PTR f, struct face *face); */
643 /* w32 implementation of get_bitmap for font backend.
645 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
646 intended that this method is called from the other font-driver
649 w32font_get_bitmap (struct font *font, unsigned code,
650 struct font_bitmap *bitmap, int bits_per_pixel);
652 /* w32 implementation of free_bitmap for font backend.
654 Free bitmap data in BITMAP.
656 w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
658 /* w32 implementation of get_outline for font backend.
660 Return an outline data for glyph-code CODE of FONT. The format
661 of the outline data depends on the font-driver.
663 w32font_get_outline (struct font *font, unsigned code);
665 /* w32 implementation of free_outline for font backend.
667 Free OUTLINE (that is obtained by the above method).
669 w32font_free_outline (struct font *font, void *outline);
671 /* w32 implementation of anchor_point for font backend.
673 Get coordinates of the INDEXth anchor point of the glyph whose
674 code is CODE. Store the coordinates in *X and *Y. Return 0 if
675 the operations was successfull. Otherwise return -1.
677 w32font_anchor_point (struct font *font, unsigned code,
678 int index, int *x, int *y);
680 /* w32 implementation of otf_capability for font backend.
682 Return a list describing which scripts/languages FONT
683 supports by which GSUB/GPOS features of OpenType tables.
685 w32font_otf_capability (struct font *font);
687 /* w32 implementation of otf_drive for font backend.
689 Apply FONT's OTF-FEATURES to the glyph string.
691 FEATURES specifies which OTF features to apply in this format:
692 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
693 See the documentation of `font-drive-otf' for the detail.
695 This method applies the specified features to the codes in the
696 elements of GSTRING-IN (between FROMth and TOth). The output
697 codes are stored in GSTRING-OUT at the IDXth element and the
700 Return the number of output codes. If none of the features are
701 applicable to the input data, return 0. If GSTRING-OUT is too
704 w32font_otf_drive (struct font *font, Lisp_Object features,
705 Lisp_Object gstring_in, int from, int to,
706 Lisp_Object gstring_out, int idx,
707 int alternate_subst);
710 /* Internal implementation of w32font_list.
711 Additional parameter opentype_only restricts the returned fonts to
712 opentype fonts, which can be used with the Uniscribe backend. */
714 w32font_list_internal (frame
, font_spec
, opentype_only
)
715 Lisp_Object frame
, font_spec
;
718 struct font_callback_data match_data
;
720 FRAME_PTR f
= XFRAME (frame
);
722 match_data
.orig_font_spec
= font_spec
;
723 match_data
.list
= Qnil
;
724 match_data
.frame
= frame
;
726 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
727 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
729 match_data
.opentype_only
= opentype_only
;
731 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
733 if (match_data
.pattern
.lfFaceName
[0] == '\0')
735 /* EnumFontFamiliesEx does not take other fields into account if
736 font name is blank, so need to use two passes. */
737 list_all_matching_fonts (&match_data
);
741 dc
= get_frame_dc (f
);
743 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
744 (FONTENUMPROC
) add_font_entity_to_list
,
745 (LPARAM
) &match_data
, 0);
746 release_frame_dc (f
, dc
);
749 return NILP (match_data
.list
) ? Qnil
: match_data
.list
;
752 /* Internal implementation of w32font_match.
753 Additional parameter opentype_only restricts the returned fonts to
754 opentype fonts, which can be used with the Uniscribe backend. */
756 w32font_match_internal (frame
, font_spec
, opentype_only
)
757 Lisp_Object frame
, font_spec
;
760 struct font_callback_data match_data
;
762 FRAME_PTR f
= XFRAME (frame
);
764 match_data
.orig_font_spec
= font_spec
;
765 match_data
.frame
= frame
;
766 match_data
.list
= Qnil
;
768 bzero (&match_data
.pattern
, sizeof (LOGFONT
));
769 fill_in_logfont (f
, &match_data
.pattern
, font_spec
);
771 match_data
.opentype_only
= opentype_only
;
773 match_data
.pattern
.lfOutPrecision
= OUT_OUTLINE_PRECIS
;
775 dc
= get_frame_dc (f
);
777 EnumFontFamiliesEx (dc
, &match_data
.pattern
,
778 (FONTENUMPROC
) add_one_font_entity_to_list
,
779 (LPARAM
) &match_data
, 0);
780 release_frame_dc (f
, dc
);
782 return NILP (match_data
.list
) ? Qnil
: XCAR (match_data
.list
);
786 w32font_open_internal (f
, font_entity
, pixel_size
, font_object
)
788 Lisp_Object font_entity
;
790 Lisp_Object font_object
;
795 HFONT hfont
, old_font
;
796 Lisp_Object val
, extra
;
797 struct w32font_info
*w32_font
;
799 OUTLINETEXTMETRIC
* metrics
= NULL
;
801 w32_font
= (struct w32font_info
*) XFONT_OBJECT (font_object
);
802 font
= (struct font
*) w32_font
;
807 bzero (&logfont
, sizeof (logfont
));
808 fill_in_logfont (f
, &logfont
, font_entity
);
810 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
811 limitations in bitmap fonts. */
812 val
= AREF (font_entity
, FONT_FOUNDRY_INDEX
);
813 if (!EQ (val
, Qraster
))
814 logfont
.lfOutPrecision
= OUT_TT_PRECIS
;
816 size
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
820 logfont
.lfHeight
= -size
;
821 hfont
= CreateFontIndirect (&logfont
);
826 /* Get the metrics for this font. */
827 dc
= get_frame_dc (f
);
828 old_font
= SelectObject (dc
, hfont
);
830 /* Try getting the outline metrics (only works for truetype fonts). */
831 len
= GetOutlineTextMetrics (dc
, 0, NULL
);
834 metrics
= (OUTLINETEXTMETRIC
*) alloca (len
);
835 if (GetOutlineTextMetrics (dc
, len
, metrics
))
836 bcopy (&metrics
->otmTextMetrics
, &w32_font
->metrics
,
837 sizeof (TEXTMETRIC
));
841 /* If it supports outline metrics, it should support Glyph Indices. */
842 w32_font
->glyph_idx
= ETO_GLYPH_INDEX
;
847 GetTextMetrics (dc
, &w32_font
->metrics
);
848 w32_font
->glyph_idx
= 0;
851 w32_font
->cached_metrics
= NULL
;
852 w32_font
->n_cache_blocks
= 0;
854 SelectObject (dc
, old_font
);
855 release_frame_dc (f
, dc
);
857 w32_font
->hfont
= hfont
;
862 /* We don't know how much space we need for the full name, so start with
863 96 bytes and go up in steps of 32. */
866 while (name
&& w32font_full_name (&logfont
, font_entity
, pixel_size
,
873 font
->props
[FONT_FULLNAME_INDEX
]
874 = make_unibyte_string (name
, strlen (name
));
876 font
->props
[FONT_FULLNAME_INDEX
] =
877 make_unibyte_string (logfont
.lfFaceName
, len
);
880 font
->max_width
= w32_font
->metrics
.tmMaxCharWidth
;
881 font
->height
= w32_font
->metrics
.tmHeight
882 + w32_font
->metrics
.tmExternalLeading
;
883 font
->space_width
= font
->average_width
= w32_font
->metrics
.tmAveCharWidth
;
885 font
->vertical_centering
= 0;
886 font
->encoding_type
= 0;
887 font
->baseline_offset
= 0;
888 font
->relative_compose
= 0;
889 font
->default_ascent
= w32_font
->metrics
.tmAscent
;
890 font
->font_encoder
= NULL
;
891 font
->pixel_size
= size
;
892 font
->driver
= &w32font_driver
;
893 /* Use format cached during list, as the information we have access to
894 here is incomplete. */
895 extra
= AREF (font_entity
, FONT_EXTRA_INDEX
);
898 val
= assq_no_quit (QCformat
, extra
);
900 font
->props
[FONT_FORMAT_INDEX
] = XCDR (val
);
902 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
905 font
->props
[FONT_FORMAT_INDEX
] = Qunknown
;
907 font
->props
[FONT_FILE_INDEX
] = Qnil
;
908 font
->encoding_charset
= -1;
909 font
->repertory_charset
= -1;
910 /* TODO: do we really want the minimum width here, which could be negative? */
911 font
->min_width
= font
->space_width
;
912 font
->ascent
= w32_font
->metrics
.tmAscent
;
913 font
->descent
= w32_font
->metrics
.tmDescent
;
917 font
->underline_thickness
= metrics
->otmsUnderscoreSize
;
918 font
->underline_position
= -metrics
->otmsUnderscorePosition
;
922 font
->underline_thickness
= 0;
923 font
->underline_position
= -1;
926 /* For temporary compatibility with legacy code that expects the
927 name to be usable in x-list-fonts. Eventually we expect to change
928 x-list-fonts and other places that use fonts so that this can be
929 an fcname or similar. */
930 font
->props
[FONT_NAME_INDEX
] = Ffont_xlfd_name (font_object
, Qnil
);
935 /* Callback function for EnumFontFamiliesEx.
936 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
938 add_font_name_to_list (logical_font
, physical_font
, font_type
, list_object
)
939 ENUMLOGFONTEX
*logical_font
;
940 NEWTEXTMETRICEX
*physical_font
;
944 Lisp_Object
* list
= (Lisp_Object
*) list_object
;
947 /* Skip vertical fonts (intended only for printing) */
948 if (logical_font
->elfLogFont
.lfFaceName
[0] == '@')
951 family
= font_intern_prop (logical_font
->elfLogFont
.lfFaceName
,
952 strlen (logical_font
->elfLogFont
.lfFaceName
), 1);
953 if (! memq_no_quit (family
, *list
))
954 *list
= Fcons (family
, *list
);
959 static int w32_decode_weight
P_ ((int));
960 static int w32_encode_weight
P_ ((int));
962 /* Convert an enumerated Windows font to an Emacs font entity. */
964 w32_enumfont_pattern_entity (frame
, logical_font
, physical_font
,
965 font_type
, requested_font
, backend
)
967 ENUMLOGFONTEX
*logical_font
;
968 NEWTEXTMETRICEX
*physical_font
;
970 LOGFONT
*requested_font
;
973 Lisp_Object entity
, tem
;
974 LOGFONT
*lf
= (LOGFONT
*) logical_font
;
976 DWORD full_type
= physical_font
->ntmTm
.ntmFlags
;
978 entity
= font_make_entity ();
980 ASET (entity
, FONT_TYPE_INDEX
, backend
);
981 ASET (entity
, FONT_REGISTRY_INDEX
, w32_registry (lf
->lfCharSet
, font_type
));
982 ASET (entity
, FONT_OBJLIST_INDEX
, Qnil
);
984 /* Foundry is difficult to get in readable form on Windows.
985 But Emacs crashes if it is not set, so set it to something more
986 generic. These values make xlfds compatible with Emacs 22. */
987 if (lf
->lfOutPrecision
== OUT_STRING_PRECIS
)
989 else if (lf
->lfOutPrecision
== OUT_STROKE_PRECIS
)
994 ASET (entity
, FONT_FOUNDRY_INDEX
, tem
);
996 /* Save the generic family in the extra info, as it is likely to be
997 useful to users looking for a close match. */
998 generic_type
= physical_font
->ntmTm
.tmPitchAndFamily
& 0xF0;
999 if (generic_type
== FF_DECORATIVE
)
1001 else if (generic_type
== FF_MODERN
)
1003 else if (generic_type
== FF_ROMAN
)
1005 else if (generic_type
== FF_SCRIPT
)
1007 else if (generic_type
== FF_SWISS
)
1012 ASET (entity
, FONT_ADSTYLE_INDEX
, tem
);
1014 if (physical_font
->ntmTm
.tmPitchAndFamily
& 0x01)
1015 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_PROPORTIONAL
));
1017 ASET (entity
, FONT_SPACING_INDEX
, make_number (FONT_SPACING_CHARCELL
));
1019 if (requested_font
->lfQuality
!= DEFAULT_QUALITY
)
1021 font_put_extra (entity
, QCantialias
,
1022 lispy_antialias_type (requested_font
->lfQuality
));
1024 ASET (entity
, FONT_FAMILY_INDEX
,
1025 font_intern_prop (lf
->lfFaceName
, strlen (lf
->lfFaceName
), 1));
1027 FONT_SET_STYLE (entity
, FONT_WEIGHT_INDEX
,
1028 make_number (w32_decode_weight (lf
->lfWeight
)));
1029 FONT_SET_STYLE (entity
, FONT_SLANT_INDEX
,
1030 make_number (lf
->lfItalic
? 200 : 100));
1031 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1033 FONT_SET_STYLE (entity
, FONT_WIDTH_INDEX
, make_number (100));
1035 if (font_type
& RASTER_FONTTYPE
)
1036 ASET (entity
, FONT_SIZE_INDEX
,
1037 make_number (physical_font
->ntmTm
.tmHeight
1038 + physical_font
->ntmTm
.tmExternalLeading
));
1040 ASET (entity
, FONT_SIZE_INDEX
, make_number (0));
1042 /* Cache unicode codepoints covered by this font, as there is no other way
1043 of getting this information easily. */
1044 if (font_type
& TRUETYPE_FONTTYPE
)
1046 tem
= font_supported_scripts (&physical_font
->ntmFontSig
);
1048 font_put_extra (entity
, QCscript
, tem
);
1051 /* This information is not fully available when opening fonts, so
1052 save it here. Only Windows 2000 and later return information
1053 about opentype and type1 fonts, so need a fallback for detecting
1054 truetype so that this information is not any worse than we could
1055 have obtained later. */
1056 if (EQ (backend
, Quniscribe
) && (full_type
& NTMFLAGS_OPENTYPE
))
1057 tem
= intern ("opentype");
1058 else if (font_type
& TRUETYPE_FONTTYPE
)
1059 tem
= intern ("truetype");
1060 else if (full_type
& NTM_PS_OPENTYPE
)
1061 tem
= intern ("postscript");
1062 else if (full_type
& NTM_TYPE1
)
1063 tem
= intern ("type1");
1064 else if (font_type
& RASTER_FONTTYPE
)
1065 tem
= intern ("w32bitmap");
1067 tem
= intern ("w32vector");
1069 font_put_extra (entity
, QCformat
, tem
);
1075 /* Convert generic families to the family portion of lfPitchAndFamily. */
1077 w32_generic_family (Lisp_Object name
)
1079 /* Generic families. */
1080 if (EQ (name
, Qmonospace
) || EQ (name
, Qmono
))
1082 else if (EQ (name
, Qsans
) || EQ (name
, Qsans_serif
) || EQ (name
, Qsansserif
))
1084 else if (EQ (name
, Qserif
))
1086 else if (EQ (name
, Qdecorative
))
1087 return FF_DECORATIVE
;
1088 else if (EQ (name
, Qscript
))
1095 logfonts_match (font
, pattern
)
1096 LOGFONT
*font
, *pattern
;
1098 /* Only check height for raster fonts. */
1099 if (pattern
->lfHeight
&& font
->lfOutPrecision
== OUT_STRING_PRECIS
1100 && font
->lfHeight
!= pattern
->lfHeight
)
1103 /* Have some flexibility with weights. */
1104 if (pattern
->lfWeight
1105 && ((font
->lfWeight
< (pattern
->lfWeight
- 150))
1106 || font
->lfWeight
> (pattern
->lfWeight
+ 150)))
1109 /* Charset and face should be OK. Italic has to be checked
1110 against the original spec, in case we don't have any preference. */
1114 /* Codepage Bitfields in FONTSIGNATURE struct. */
1115 #define CSB_JAPANESE (1 << 17)
1116 #define CSB_KOREAN ((1 << 19) | (1 << 21))
1117 #define CSB_CHINESE ((1 << 18) | (1 << 20))
1120 font_matches_spec (type
, font
, spec
, backend
, logfont
)
1122 NEWTEXTMETRICEX
*font
;
1124 Lisp_Object backend
;
1127 Lisp_Object extra
, val
;
1129 /* Check italic. Can't check logfonts, since it is a boolean field,
1130 so there is no difference between "non-italic" and "don't care". */
1132 int slant
= FONT_SLANT_NUMERIC (spec
);
1135 && ((slant
> 150 && !font
->ntmTm
.tmItalic
)
1136 || (slant
<= 150 && font
->ntmTm
.tmItalic
)))
1140 /* Check adstyle against generic family. */
1141 val
= AREF (spec
, FONT_ADSTYLE_INDEX
);
1144 BYTE family
= w32_generic_family (val
);
1145 if (family
!= FF_DONTCARE
1146 && family
!= (font
->ntmTm
.tmPitchAndFamily
& 0xF0))
1151 val
= AREF (spec
, FONT_SPACING_INDEX
);
1154 int spacing
= XINT (val
);
1155 int proportional
= (spacing
< FONT_SPACING_MONO
);
1157 if ((proportional
&& !(font
->ntmTm
.tmPitchAndFamily
& 0x01))
1158 || (!proportional
&& (font
->ntmTm
.tmPitchAndFamily
& 0x01)))
1162 /* Check extra parameters. */
1163 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
1164 CONSP (extra
); extra
= XCDR (extra
))
1166 Lisp_Object extra_entry
;
1167 extra_entry
= XCAR (extra
);
1168 if (CONSP (extra_entry
))
1170 Lisp_Object key
= XCAR (extra_entry
);
1172 val
= XCDR (extra_entry
);
1173 if (EQ (key
, QCscript
) && SYMBOLP (val
))
1175 /* Only truetype fonts will have information about what
1176 scripts they support. This probably means the user
1177 will have to force Emacs to use raster, postscript
1178 or atm fonts for non-ASCII text. */
1179 if (type
& TRUETYPE_FONTTYPE
)
1182 = font_supported_scripts (&font
->ntmFontSig
);
1183 if (! memq_no_quit (val
, support
))
1188 /* Return specific matches, but play it safe. Fonts
1189 that cover more than their charset would suggest
1190 are likely to be truetype or opentype fonts,
1192 if (EQ (val
, Qlatin
))
1194 /* Although every charset but symbol, thai and
1195 arabic contains the basic ASCII set of latin
1196 characters, Emacs expects much more. */
1197 if (font
->ntmTm
.tmCharSet
!= ANSI_CHARSET
)
1200 else if (EQ (val
, Qsymbol
))
1202 if (font
->ntmTm
.tmCharSet
!= SYMBOL_CHARSET
)
1205 else if (EQ (val
, Qcyrillic
))
1207 if (font
->ntmTm
.tmCharSet
!= RUSSIAN_CHARSET
)
1210 else if (EQ (val
, Qgreek
))
1212 if (font
->ntmTm
.tmCharSet
!= GREEK_CHARSET
)
1215 else if (EQ (val
, Qarabic
))
1217 if (font
->ntmTm
.tmCharSet
!= ARABIC_CHARSET
)
1220 else if (EQ (val
, Qhebrew
))
1222 if (font
->ntmTm
.tmCharSet
!= HEBREW_CHARSET
)
1225 else if (EQ (val
, Qthai
))
1227 if (font
->ntmTm
.tmCharSet
!= THAI_CHARSET
)
1230 else if (EQ (val
, Qkana
))
1232 if (font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1235 else if (EQ (val
, Qbopomofo
))
1237 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
)
1240 else if (EQ (val
, Qhangul
))
1242 if (font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1243 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
)
1246 else if (EQ (val
, Qhan
))
1248 if (font
->ntmTm
.tmCharSet
!= CHINESEBIG5_CHARSET
1249 && font
->ntmTm
.tmCharSet
!= GB2312_CHARSET
1250 && font
->ntmTm
.tmCharSet
!= HANGUL_CHARSET
1251 && font
->ntmTm
.tmCharSet
!= JOHAB_CHARSET
1252 && font
->ntmTm
.tmCharSet
!= SHIFTJIS_CHARSET
)
1256 /* Other scripts unlikely to be handled by non-truetype
1261 else if (EQ (key
, QClang
) && SYMBOLP (val
))
1263 /* Just handle the CJK languages here, as the lang
1264 parameter is used to select a font with appropriate
1265 glyphs in the cjk unified ideographs block. Other fonts
1266 support for a language can be solely determined by
1267 its character coverage. */
1270 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_JAPANESE
))
1273 else if (EQ (val
, Qko
))
1275 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_KOREAN
))
1278 else if (EQ (val
, Qzh
))
1280 if (!(font
->ntmFontSig
.fsCsb
[0] & CSB_CHINESE
))
1284 /* Any other language, we don't recognize it. Only the above
1285 currently appear in fontset.el, so it isn't worth
1286 creating a mapping table of codepages/scripts to languages
1287 or opening the font to see if there are any language tags
1288 in it that the W32 API does not expose. Fontset
1289 spec should have a fallback, as some backends do
1290 not recognize language at all. */
1293 else if (EQ (key
, QCotf
) && CONSP (val
))
1295 /* OTF features only supported by the uniscribe backend. */
1296 if (EQ (backend
, Quniscribe
))
1298 if (!uniscribe_check_otf (logfont
, val
))
1310 w32font_coverage_ok (coverage
, charset
)
1311 FONTSIGNATURE
* coverage
;
1314 DWORD subrange1
= coverage
->fsUsb
[1];
1316 #define SUBRANGE1_HAN_MASK 0x08000000
1317 #define SUBRANGE1_HANGEUL_MASK 0x01000000
1318 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1320 if (charset
== GB2312_CHARSET
|| charset
== CHINESEBIG5_CHARSET
)
1322 return (subrange1
& SUBRANGE1_HAN_MASK
) == SUBRANGE1_HAN_MASK
;
1324 else if (charset
== SHIFTJIS_CHARSET
)
1326 return (subrange1
& SUBRANGE1_JAPANESE_MASK
) == SUBRANGE1_JAPANESE_MASK
;
1328 else if (charset
== HANGEUL_CHARSET
)
1330 return (subrange1
& SUBRANGE1_HANGEUL_MASK
) == SUBRANGE1_HANGEUL_MASK
;
1336 /* Callback function for EnumFontFamiliesEx.
1337 * Checks if a font matches everything we are trying to check agaist,
1338 * and if so, adds it to a list. Both the data we are checking against
1339 * and the list to which the fonts are added are passed in via the
1340 * lparam argument, in the form of a font_callback_data struct. */
1342 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1343 ENUMLOGFONTEX
*logical_font
;
1344 NEWTEXTMETRICEX
*physical_font
;
1348 struct font_callback_data
*match_data
1349 = (struct font_callback_data
*) lParam
;
1350 Lisp_Object backend
= match_data
->opentype_only
? Quniscribe
: Qgdi
;
1352 if ((!match_data
->opentype_only
1353 || (((physical_font
->ntmTm
.ntmFlags
& NTMFLAGS_OPENTYPE
)
1354 || (font_type
& TRUETYPE_FONTTYPE
))
1355 /* For the uniscribe backend, only consider fonts that claim
1356 to cover at least some part of Unicode. */
1357 && (physical_font
->ntmFontSig
.fsUsb
[3]
1358 || physical_font
->ntmFontSig
.fsUsb
[2]
1359 || physical_font
->ntmFontSig
.fsUsb
[1]
1360 || (physical_font
->ntmFontSig
.fsUsb
[0] & 0x3fffffff))))
1361 && logfonts_match (&logical_font
->elfLogFont
, &match_data
->pattern
)
1362 && font_matches_spec (font_type
, physical_font
,
1363 match_data
->orig_font_spec
, backend
,
1364 &logical_font
->elfLogFont
)
1365 && w32font_coverage_ok (&physical_font
->ntmFontSig
,
1366 match_data
->pattern
.lfCharSet
)
1367 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1368 We limit this to raster fonts, because the test can catch some
1369 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1370 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1371 therefore get through this test. Since full names can be prefixed
1372 by a foundry, we accept raster fonts if the font name is found
1373 anywhere within the full name. */
1374 && (logical_font
->elfLogFont
.lfOutPrecision
!= OUT_STRING_PRECIS
1375 || strstr (logical_font
->elfFullName
,
1376 logical_font
->elfLogFont
.lfFaceName
)))
1379 = w32_enumfont_pattern_entity (match_data
->frame
, logical_font
,
1380 physical_font
, font_type
,
1381 &match_data
->pattern
,
1385 Lisp_Object spec_charset
= AREF (match_data
->orig_font_spec
,
1386 FONT_REGISTRY_INDEX
);
1388 /* If registry was specified as iso10646-1, only report
1389 ANSI and DEFAULT charsets, as most unicode fonts will
1390 contain one of those plus others. */
1391 if ((EQ (spec_charset
, Qiso10646_1
)
1392 || EQ (spec_charset
, Qunicode_bmp
)
1393 || EQ (spec_charset
, Qunicode_sip
))
1394 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
1395 && logical_font
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
)
1397 /* If registry was specified, but did not map to a windows
1398 charset, only report fonts that have unknown charsets.
1399 This will still report fonts that don't match, but at
1400 least it eliminates known definite mismatches. */
1401 else if (!NILP (spec_charset
)
1402 && !EQ (spec_charset
, Qiso10646_1
)
1403 && !EQ (spec_charset
, Qunicode_bmp
)
1404 && !EQ (spec_charset
, Qunicode_sip
)
1405 && match_data
->pattern
.lfCharSet
== DEFAULT_CHARSET
1406 && logical_font
->elfLogFont
.lfCharSet
!= DEFAULT_CHARSET
)
1409 /* If registry was specified, ensure it is reported as the same. */
1410 if (!NILP (spec_charset
))
1411 ASET (entity
, FONT_REGISTRY_INDEX
, spec_charset
);
1413 match_data
->list
= Fcons (entity
, match_data
->list
);
1415 /* If no registry specified, duplicate iso8859-1 truetype fonts
1417 if (NILP (spec_charset
)
1418 && font_type
== TRUETYPE_FONTTYPE
1419 && logical_font
->elfLogFont
.lfCharSet
== ANSI_CHARSET
)
1421 Lisp_Object tem
= Fcopy_font_spec (entity
);
1422 ASET (tem
, FONT_REGISTRY_INDEX
, Qiso10646_1
);
1423 match_data
->list
= Fcons (tem
, match_data
->list
);
1430 /* Callback function for EnumFontFamiliesEx.
1431 * Terminates the search once we have a match. */
1433 add_one_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
)
1434 ENUMLOGFONTEX
*logical_font
;
1435 NEWTEXTMETRICEX
*physical_font
;
1439 struct font_callback_data
*match_data
1440 = (struct font_callback_data
*) lParam
;
1441 add_font_entity_to_list (logical_font
, physical_font
, font_type
, lParam
);
1443 /* If we have a font in the list, terminate the search. */
1444 return !NILP (match_data
->list
);
1447 /* Old function to convert from x to w32 charset, from w32fns.c. */
1449 x_to_w32_charset (lpcs
)
1452 Lisp_Object this_entry
, w32_charset
;
1454 int len
= strlen (lpcs
);
1456 /* Support "*-#nnn" format for unknown charsets. */
1457 if (strncmp (lpcs
, "*-#", 3) == 0)
1458 return atoi (lpcs
+ 3);
1460 /* All Windows fonts qualify as unicode. */
1461 if (!strncmp (lpcs
, "iso10646", 8))
1462 return DEFAULT_CHARSET
;
1464 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1465 charset
= alloca (len
+ 1);
1466 strcpy (charset
, lpcs
);
1467 lpcs
= strchr (charset
, '*');
1471 /* Look through w32-charset-info-alist for the character set.
1472 Format of each entry is
1473 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1475 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
1477 if (NILP (this_entry
))
1479 /* At startup, we want iso8859-1 fonts to come up properly. */
1480 if (xstrcasecmp (charset
, "iso8859-1") == 0)
1481 return ANSI_CHARSET
;
1483 return DEFAULT_CHARSET
;
1486 w32_charset
= Fcar (Fcdr (this_entry
));
1488 /* Translate Lisp symbol to number. */
1489 if (EQ (w32_charset
, Qw32_charset_ansi
))
1490 return ANSI_CHARSET
;
1491 if (EQ (w32_charset
, Qw32_charset_symbol
))
1492 return SYMBOL_CHARSET
;
1493 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
1494 return SHIFTJIS_CHARSET
;
1495 if (EQ (w32_charset
, Qw32_charset_hangeul
))
1496 return HANGEUL_CHARSET
;
1497 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
1498 return CHINESEBIG5_CHARSET
;
1499 if (EQ (w32_charset
, Qw32_charset_gb2312
))
1500 return GB2312_CHARSET
;
1501 if (EQ (w32_charset
, Qw32_charset_oem
))
1503 if (EQ (w32_charset
, Qw32_charset_johab
))
1504 return JOHAB_CHARSET
;
1505 if (EQ (w32_charset
, Qw32_charset_easteurope
))
1506 return EASTEUROPE_CHARSET
;
1507 if (EQ (w32_charset
, Qw32_charset_turkish
))
1508 return TURKISH_CHARSET
;
1509 if (EQ (w32_charset
, Qw32_charset_baltic
))
1510 return BALTIC_CHARSET
;
1511 if (EQ (w32_charset
, Qw32_charset_russian
))
1512 return RUSSIAN_CHARSET
;
1513 if (EQ (w32_charset
, Qw32_charset_arabic
))
1514 return ARABIC_CHARSET
;
1515 if (EQ (w32_charset
, Qw32_charset_greek
))
1516 return GREEK_CHARSET
;
1517 if (EQ (w32_charset
, Qw32_charset_hebrew
))
1518 return HEBREW_CHARSET
;
1519 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
1520 return VIETNAMESE_CHARSET
;
1521 if (EQ (w32_charset
, Qw32_charset_thai
))
1522 return THAI_CHARSET
;
1523 if (EQ (w32_charset
, Qw32_charset_mac
))
1526 return DEFAULT_CHARSET
;
1530 /* Convert a Lisp font registry (symbol) to a windows charset. */
1532 registry_to_w32_charset (charset
)
1533 Lisp_Object charset
;
1535 if (EQ (charset
, Qiso10646_1
) || EQ (charset
, Qunicode_bmp
)
1536 || EQ (charset
, Qunicode_sip
))
1537 return DEFAULT_CHARSET
; /* UNICODE_CHARSET not defined in MingW32 */
1538 else if (EQ (charset
, Qiso8859_1
))
1539 return ANSI_CHARSET
;
1540 else if (SYMBOLP (charset
))
1541 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset
)));
1543 return DEFAULT_CHARSET
;
1546 /* Old function to convert from w32 to x charset, from w32fns.c. */
1548 w32_to_x_charset (fncharset
, matching
)
1552 static char buf
[32];
1553 Lisp_Object charset_type
;
1558 /* If fully specified, accept it as it is. Otherwise use a
1560 char *wildcard
= strchr (matching
, '*');
1563 else if (strchr (matching
, '-'))
1566 match_len
= strlen (matching
);
1572 /* Handle startup case of w32-charset-info-alist not
1573 being set up yet. */
1574 if (NILP (Vw32_charset_info_alist
))
1576 charset_type
= Qw32_charset_ansi
;
1578 case DEFAULT_CHARSET
:
1579 charset_type
= Qw32_charset_default
;
1581 case SYMBOL_CHARSET
:
1582 charset_type
= Qw32_charset_symbol
;
1584 case SHIFTJIS_CHARSET
:
1585 charset_type
= Qw32_charset_shiftjis
;
1587 case HANGEUL_CHARSET
:
1588 charset_type
= Qw32_charset_hangeul
;
1590 case GB2312_CHARSET
:
1591 charset_type
= Qw32_charset_gb2312
;
1593 case CHINESEBIG5_CHARSET
:
1594 charset_type
= Qw32_charset_chinesebig5
;
1597 charset_type
= Qw32_charset_oem
;
1599 case EASTEUROPE_CHARSET
:
1600 charset_type
= Qw32_charset_easteurope
;
1602 case TURKISH_CHARSET
:
1603 charset_type
= Qw32_charset_turkish
;
1605 case BALTIC_CHARSET
:
1606 charset_type
= Qw32_charset_baltic
;
1608 case RUSSIAN_CHARSET
:
1609 charset_type
= Qw32_charset_russian
;
1611 case ARABIC_CHARSET
:
1612 charset_type
= Qw32_charset_arabic
;
1615 charset_type
= Qw32_charset_greek
;
1617 case HEBREW_CHARSET
:
1618 charset_type
= Qw32_charset_hebrew
;
1620 case VIETNAMESE_CHARSET
:
1621 charset_type
= Qw32_charset_vietnamese
;
1624 charset_type
= Qw32_charset_thai
;
1627 charset_type
= Qw32_charset_mac
;
1630 charset_type
= Qw32_charset_johab
;
1634 /* Encode numerical value of unknown charset. */
1635 sprintf (buf
, "*-#%u", fncharset
);
1641 char * best_match
= NULL
;
1642 int matching_found
= 0;
1644 /* Look through w32-charset-info-alist for the character set.
1645 Prefer ISO codepages, and prefer lower numbers in the ISO
1646 range. Only return charsets for codepages which are installed.
1648 Format of each entry is
1649 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1651 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
1654 Lisp_Object w32_charset
;
1655 Lisp_Object codepage
;
1657 Lisp_Object this_entry
= XCAR (rest
);
1659 /* Skip invalid entries in alist. */
1660 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
1661 || !CONSP (XCDR (this_entry
))
1662 || !SYMBOLP (XCAR (XCDR (this_entry
))))
1665 x_charset
= SDATA (XCAR (this_entry
));
1666 w32_charset
= XCAR (XCDR (this_entry
));
1667 codepage
= XCDR (XCDR (this_entry
));
1669 /* Look for Same charset and a valid codepage (or non-int
1670 which means ignore). */
1671 if (EQ (w32_charset
, charset_type
)
1672 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
1673 || IsValidCodePage (XINT (codepage
))))
1675 /* If we don't have a match already, then this is the
1679 best_match
= x_charset
;
1680 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
1683 /* If we already found a match for MATCHING, then
1684 only consider other matches. */
1685 else if (matching_found
1686 && strnicmp (x_charset
, matching
, match_len
))
1688 /* If this matches what we want, and the best so far doesn't,
1689 then this is better. */
1690 else if (!matching_found
&& matching
1691 && !strnicmp (x_charset
, matching
, match_len
))
1693 best_match
= x_charset
;
1696 /* If this is fully specified, and the best so far isn't,
1697 then this is better. */
1698 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
1699 /* If this is an ISO codepage, and the best so far isn't,
1700 then this is better, but only if it fully specifies the
1702 || (strnicmp (best_match
, "iso", 3) != 0
1703 && strnicmp (x_charset
, "iso", 3) == 0
1704 && strchr (x_charset
, '-')))
1705 best_match
= x_charset
;
1706 /* If both are ISO8859 codepages, choose the one with the
1707 lowest number in the encoding field. */
1708 else if (strnicmp (best_match
, "iso8859-", 8) == 0
1709 && strnicmp (x_charset
, "iso8859-", 8) == 0)
1711 int best_enc
= atoi (best_match
+ 8);
1712 int this_enc
= atoi (x_charset
+ 8);
1713 if (this_enc
> 0 && this_enc
< best_enc
)
1714 best_match
= x_charset
;
1719 /* If no match, encode the numeric value. */
1722 sprintf (buf
, "*-#%u", fncharset
);
1726 strncpy (buf
, best_match
, 31);
1727 /* If the charset is not fully specified, put -0 on the end. */
1728 if (!strchr (best_match
, '-'))
1730 int pos
= strlen (best_match
);
1731 /* Charset specifiers shouldn't be very long. If it is a made
1732 up one, truncating it should not do any harm since it isn't
1733 recognized anyway. */
1736 strcpy (buf
+ pos
, "-0");
1744 w32_registry (w32_charset
, font_type
)
1750 /* If charset is defaulted, charset is unicode or unknown, depending on
1752 if (w32_charset
== DEFAULT_CHARSET
)
1753 return font_type
== TRUETYPE_FONTTYPE
? Qiso10646_1
: Qunknown
;
1755 charset
= w32_to_x_charset (w32_charset
, NULL
);
1756 return font_intern_prop (charset
, strlen(charset
), 1);
1760 w32_decode_weight (fnweight
)
1763 if (fnweight
>= FW_HEAVY
) return 210;
1764 if (fnweight
>= FW_EXTRABOLD
) return 205;
1765 if (fnweight
>= FW_BOLD
) return 200;
1766 if (fnweight
>= FW_SEMIBOLD
) return 180;
1767 if (fnweight
>= FW_NORMAL
) return 100;
1768 if (fnweight
>= FW_LIGHT
) return 50;
1769 if (fnweight
>= FW_EXTRALIGHT
) return 40;
1770 if (fnweight
> FW_THIN
) return 20;
1775 w32_encode_weight (n
)
1778 if (n
>= 210) return FW_HEAVY
;
1779 if (n
>= 205) return FW_EXTRABOLD
;
1780 if (n
>= 200) return FW_BOLD
;
1781 if (n
>= 180) return FW_SEMIBOLD
;
1782 if (n
>= 100) return FW_NORMAL
;
1783 if (n
>= 50) return FW_LIGHT
;
1784 if (n
>= 40) return FW_EXTRALIGHT
;
1785 if (n
>= 20) return FW_THIN
;
1789 /* Convert a Windows font weight into one of the weights supported
1790 by fontconfig (see font.c:font_parse_fcname). */
1792 w32_to_fc_weight (n
)
1795 if (n
>= FW_EXTRABOLD
) return intern ("black");
1796 if (n
>= FW_BOLD
) return intern ("bold");
1797 if (n
>= FW_SEMIBOLD
) return intern ("demibold");
1798 if (n
>= FW_NORMAL
) return intern ("medium");
1799 return intern ("light");
1802 /* Fill in all the available details of LOGFONT from FONT_SPEC. */
1804 fill_in_logfont (f
, logfont
, font_spec
)
1807 Lisp_Object font_spec
;
1809 Lisp_Object tmp
, extra
;
1810 int dpi
= FRAME_W32_DISPLAY_INFO (f
)->resy
;
1812 tmp
= AREF (font_spec
, FONT_DPI_INDEX
);
1817 else if (FLOATP (tmp
))
1819 dpi
= (int) (XFLOAT_DATA (tmp
) + 0.5);
1823 tmp
= AREF (font_spec
, FONT_SIZE_INDEX
);
1825 logfont
->lfHeight
= -1 * XINT (tmp
);
1826 else if (FLOATP (tmp
))
1827 logfont
->lfHeight
= (int) (-1.0 * dpi
* XFLOAT_DATA (tmp
) / 72.27 + 0.5);
1834 tmp
= AREF (font_spec
, FONT_WEIGHT_INDEX
);
1836 logfont
->lfWeight
= w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec
));
1839 tmp
= AREF (font_spec
, FONT_SLANT_INDEX
);
1842 int slant
= FONT_SLANT_NUMERIC (font_spec
);
1843 logfont
->lfItalic
= slant
> 150 ? 1 : 0;
1851 tmp
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1853 logfont
->lfCharSet
= registry_to_w32_charset (tmp
);
1855 logfont
->lfCharSet
= DEFAULT_CHARSET
;
1859 /* Clip Precision */
1862 logfont
->lfQuality
= DEFAULT_QUALITY
;
1864 /* Generic Family and Face Name */
1865 logfont
->lfPitchAndFamily
= FF_DONTCARE
| DEFAULT_PITCH
;
1867 tmp
= AREF (font_spec
, FONT_FAMILY_INDEX
);
1870 logfont
->lfPitchAndFamily
= w32_generic_family (tmp
) | DEFAULT_PITCH
;
1871 if ((logfont
->lfPitchAndFamily
& 0xF0) != FF_DONTCARE
)
1872 ; /* Font name was generic, don't fill in font name. */
1873 /* Font families are interned, but allow for strings also in case of
1875 else if (SYMBOLP (tmp
))
1876 strncpy (logfont
->lfFaceName
, SDATA (SYMBOL_NAME (tmp
)), LF_FACESIZE
);
1879 tmp
= AREF (font_spec
, FONT_ADSTYLE_INDEX
);
1882 /* Override generic family. */
1883 BYTE family
= w32_generic_family (tmp
);
1884 if (family
!= FF_DONTCARE
)
1885 logfont
->lfPitchAndFamily
= family
| DEFAULT_PITCH
;
1889 /* Set pitch based on the spacing property. */
1890 tmp
= AREF (font_spec
, FONT_SPACING_INDEX
);
1893 int spacing
= XINT (tmp
);
1894 if (spacing
< FONT_SPACING_MONO
)
1895 logfont
->lfPitchAndFamily
1896 = logfont
->lfPitchAndFamily
& 0xF0 | VARIABLE_PITCH
;
1898 logfont
->lfPitchAndFamily
1899 = logfont
->lfPitchAndFamily
& 0xF0 | FIXED_PITCH
;
1902 /* Process EXTRA info. */
1903 for (extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
1904 CONSP (extra
); extra
= XCDR (extra
))
1909 Lisp_Object key
, val
;
1910 key
= XCAR (tmp
), val
= XCDR (tmp
);
1911 /* Only use QCscript if charset is not provided, or is unicode
1912 and a single script is specified. This is rather crude,
1913 and is only used to narrow down the fonts returned where
1914 there is a definite match. Some scripts, such as latin, han,
1915 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1917 if (EQ (key
, QCscript
)
1918 && logfont
->lfCharSet
== DEFAULT_CHARSET
1921 if (EQ (val
, Qgreek
))
1922 logfont
->lfCharSet
= GREEK_CHARSET
;
1923 else if (EQ (val
, Qhangul
))
1924 logfont
->lfCharSet
= HANGUL_CHARSET
;
1925 else if (EQ (val
, Qkana
) || EQ (val
, Qkanbun
))
1926 logfont
->lfCharSet
= SHIFTJIS_CHARSET
;
1927 else if (EQ (val
, Qbopomofo
))
1928 logfont
->lfCharSet
= CHINESEBIG5_CHARSET
;
1929 /* GB 18030 supports tibetan, yi, mongolian,
1930 fonts that support it should show up if we ask for
1932 else if (EQ (val
, Qtibetan
) || EQ (val
, Qyi
)
1933 || EQ (val
, Qmongolian
))
1934 logfont
->lfCharSet
= GB2312_CHARSET
;
1935 else if (EQ (val
, Qhebrew
))
1936 logfont
->lfCharSet
= HEBREW_CHARSET
;
1937 else if (EQ (val
, Qarabic
))
1938 logfont
->lfCharSet
= ARABIC_CHARSET
;
1939 else if (EQ (val
, Qthai
))
1940 logfont
->lfCharSet
= THAI_CHARSET
;
1941 else if (EQ (val
, Qsymbol
))
1942 logfont
->lfCharSet
= SYMBOL_CHARSET
;
1944 else if (EQ (key
, QCantialias
) && SYMBOLP (val
))
1946 logfont
->lfQuality
= w32_antialias_type (val
);
1953 list_all_matching_fonts (match_data
)
1954 struct font_callback_data
*match_data
;
1957 Lisp_Object families
= w32font_list_family (match_data
->frame
);
1958 struct frame
*f
= XFRAME (match_data
->frame
);
1960 dc
= get_frame_dc (f
);
1962 while (!NILP (families
))
1964 /* TODO: Use the Unicode versions of the W32 APIs, so we can
1965 handle non-ASCII font names. */
1967 Lisp_Object family
= CAR (families
);
1968 families
= CDR (families
);
1971 else if (SYMBOLP (family
))
1972 name
= SDATA (SYMBOL_NAME (family
));
1976 strncpy (match_data
->pattern
.lfFaceName
, name
, LF_FACESIZE
);
1977 match_data
->pattern
.lfFaceName
[LF_FACESIZE
- 1] = '\0';
1979 EnumFontFamiliesEx (dc
, &match_data
->pattern
,
1980 (FONTENUMPROC
) add_font_entity_to_list
,
1981 (LPARAM
) match_data
, 0);
1984 release_frame_dc (f
, dc
);
1988 lispy_antialias_type (type
)
1995 case NONANTIALIASED_QUALITY
:
1998 case ANTIALIASED_QUALITY
:
2001 case CLEARTYPE_QUALITY
:
2004 case CLEARTYPE_NATURAL_QUALITY
:
2014 /* Convert antialiasing symbols to lfQuality */
2016 w32_antialias_type (type
)
2019 if (EQ (type
, Qnone
))
2020 return NONANTIALIASED_QUALITY
;
2021 else if (EQ (type
, Qstandard
))
2022 return ANTIALIASED_QUALITY
;
2023 else if (EQ (type
, Qsubpixel
))
2024 return CLEARTYPE_QUALITY
;
2025 else if (EQ (type
, Qnatural
))
2026 return CLEARTYPE_NATURAL_QUALITY
;
2028 return DEFAULT_QUALITY
;
2031 /* Return a list of all the scripts that the font supports. */
2033 font_supported_scripts (FONTSIGNATURE
* sig
)
2035 DWORD
* subranges
= sig
->fsUsb
;
2036 Lisp_Object supported
= Qnil
;
2038 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2039 #define SUBRANGE(n,sym) \
2040 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2041 supported = Fcons ((sym), supported)
2043 /* Match multiple subranges. SYM is set if any MASK bit is set in
2044 subranges[0 - 3]. */
2045 #define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2046 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2047 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2048 supported = Fcons ((sym), supported)
2050 SUBRANGE (0, Qlatin
);
2051 /* The following count as latin too, ASCII should be present in these fonts,
2052 so don't need to mark them separately. */
2053 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2054 SUBRANGE (4, Qphonetic
);
2055 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
2056 SUBRANGE (7, Qgreek
);
2057 SUBRANGE (8, Qcoptic
);
2058 SUBRANGE (9, Qcyrillic
);
2059 SUBRANGE (10, Qarmenian
);
2060 SUBRANGE (11, Qhebrew
);
2061 SUBRANGE (13, Qarabic
);
2062 SUBRANGE (14, Qnko
);
2063 SUBRANGE (15, Qdevanagari
);
2064 SUBRANGE (16, Qbengali
);
2065 SUBRANGE (17, Qgurmukhi
);
2066 SUBRANGE (18, Qgujarati
);
2067 SUBRANGE (19, Qoriya
);
2068 SUBRANGE (20, Qtamil
);
2069 SUBRANGE (21, Qtelugu
);
2070 SUBRANGE (22, Qkannada
);
2071 SUBRANGE (23, Qmalayalam
);
2072 SUBRANGE (24, Qthai
);
2073 SUBRANGE (25, Qlao
);
2074 SUBRANGE (26, Qgeorgian
);
2075 SUBRANGE (27, Qbalinese
);
2076 /* 28: Hangul Jamo. */
2077 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2078 /* 32-47: Symbols (defined below). */
2079 SUBRANGE (48, Qcjk_misc
);
2080 /* Match either 49: katakana or 50: hiragana for kana. */
2081 MASK_ANY (0, 0x00060000, 0, 0, Qkana
);
2082 SUBRANGE (51, Qbopomofo
);
2083 /* 52: Compatibility Jamo */
2084 SUBRANGE (53, Qphags_pa
);
2085 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
2086 SUBRANGE (56, Qhangul
);
2087 /* 57: Surrogates. */
2088 SUBRANGE (58, Qphoenician
);
2089 SUBRANGE (59, Qhan
); /* There are others, but this is the main one. */
2090 SUBRANGE (59, Qideographic_description
); /* Windows lumps this in. */
2091 SUBRANGE (59, Qkanbun
); /* And this. */
2092 /* 60: Private use, 61: CJK strokes and compatibility. */
2093 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2094 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2095 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2097 SUBRANGE (70, Qtibetan
);
2098 SUBRANGE (71, Qsyriac
);
2099 SUBRANGE (72, Qthaana
);
2100 SUBRANGE (73, Qsinhala
);
2101 SUBRANGE (74, Qmyanmar
);
2102 SUBRANGE (75, Qethiopic
);
2103 SUBRANGE (76, Qcherokee
);
2104 SUBRANGE (77, Qcanadian_aboriginal
);
2105 SUBRANGE (78, Qogham
);
2106 SUBRANGE (79, Qrunic
);
2107 SUBRANGE (80, Qkhmer
);
2108 SUBRANGE (81, Qmongolian
);
2109 SUBRANGE (82, Qbraille
);
2111 SUBRANGE (84, Qbuhid
);
2112 SUBRANGE (84, Qhanunoo
);
2113 SUBRANGE (84, Qtagalog
);
2114 SUBRANGE (84, Qtagbanwa
);
2115 SUBRANGE (85, Qold_italic
);
2116 SUBRANGE (86, Qgothic
);
2117 SUBRANGE (87, Qdeseret
);
2118 SUBRANGE (88, Qbyzantine_musical_symbol
);
2119 SUBRANGE (88, Qmusical_symbol
); /* Windows doesn't distinguish these. */
2120 SUBRANGE (89, Qmathematical
);
2121 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2122 SUBRANGE (93, Qlimbu
);
2123 SUBRANGE (94, Qtai_le
);
2124 /* 95: New Tai Le */
2125 SUBRANGE (90, Qbuginese
);
2126 SUBRANGE (97, Qglagolitic
);
2127 SUBRANGE (98, Qtifinagh
);
2128 /* 99: Yijing Hexagrams. */
2129 SUBRANGE (100, Qsyloti_nagri
);
2130 SUBRANGE (101, Qlinear_b
);
2131 /* 102: Ancient Greek Numbers. */
2132 SUBRANGE (103, Qugaritic
);
2133 SUBRANGE (104, Qold_persian
);
2134 SUBRANGE (105, Qshavian
);
2135 SUBRANGE (106, Qosmanya
);
2136 SUBRANGE (107, Qcypriot
);
2137 SUBRANGE (108, Qkharoshthi
);
2138 /* 109: Tai Xuan Jing. */
2139 SUBRANGE (110, Qcuneiform
);
2140 /* 111: Counting Rods. */
2142 /* There isn't really a main symbol range, so include symbol if any
2143 relevant range is set. */
2144 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol
);
2146 /* Missing: Tai Viet (U+AA80) and Cham (U+AA00) . */
2153 /* Generate a full name for a Windows font.
2154 The full name is in fcname format, with weight, slant and antialiasing
2155 specified if they are not "normal". */
2157 w32font_full_name (font
, font_obj
, pixel_size
, name
, nbytes
)
2159 Lisp_Object font_obj
;
2164 int len
, height
, outline
;
2166 Lisp_Object antialiasing
, weight
= Qnil
;
2168 len
= strlen (font
->lfFaceName
);
2170 outline
= EQ (AREF (font_obj
, FONT_FOUNDRY_INDEX
), Qoutline
);
2172 /* Represent size of scalable fonts by point size. But use pixelsize for
2173 raster fonts to indicate that they are exactly that size. */
2175 len
+= 11; /* -SIZE */
2180 len
+= 7; /* :italic */
2182 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2184 weight
= w32_to_fc_weight (font
->lfWeight
);
2185 len
+= 1 + SBYTES (SYMBOL_NAME (weight
)); /* :WEIGHT */
2188 antialiasing
= lispy_antialias_type (font
->lfQuality
);
2189 if (! NILP (antialiasing
))
2190 len
+= 11 + SBYTES (SYMBOL_NAME (antialiasing
)); /* :antialias=NAME */
2192 /* Check that the buffer is big enough */
2197 p
+= sprintf (p
, "%s", font
->lfFaceName
);
2199 height
= font
->lfHeight
? eabs (font
->lfHeight
) : pixel_size
;
2205 float pointsize
= height
* 72.0 / one_w32_display_info
.resy
;
2206 /* Round to nearest half point. floor is used, since round is not
2207 supported in MS library. */
2208 pointsize
= floor (pointsize
* 2 + 0.5) / 2;
2209 p
+= sprintf (p
, "-%1.1f", pointsize
);
2212 p
+= sprintf (p
, ":pixelsize=%d", height
);
2215 if (SYMBOLP (weight
) && ! NILP (weight
))
2216 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2219 p
+= sprintf (p
, ":italic");
2221 if (SYMBOLP (antialiasing
) && ! NILP (antialiasing
))
2222 p
+= sprintf (p
, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing
)));
2227 /* Convert a logfont and point size into a fontconfig style font name.
2228 POINTSIZE is in tenths of points.
2229 If SIZE indicates the size of buffer FCNAME, into which the font name
2230 is written. If the buffer is not large enough to contain the name,
2231 the function returns -1, otherwise it returns the number of bytes
2232 written to FCNAME. */
2233 static int logfont_to_fcname(font
, pointsize
, fcname
, size
)
2241 Lisp_Object weight
= Qnil
;
2243 len
= strlen (font
->lfFaceName
) + 2;
2244 height
= pointsize
/ 10;
2245 while (height
/= 10)
2252 len
+= 7; /* :italic */
2253 if (font
->lfWeight
&& font
->lfWeight
!= FW_NORMAL
)
2255 weight
= w32_to_fc_weight (font
->lfWeight
);
2256 len
+= SBYTES (SYMBOL_NAME (weight
)) + 1;
2262 p
+= sprintf (p
, "%s-%d", font
->lfFaceName
, pointsize
/ 10);
2264 p
+= sprintf (p
, ".%d", pointsize
% 10);
2266 if (SYMBOLP (weight
) && !NILP (weight
))
2267 p
+= sprintf (p
, ":%s", SDATA (SYMBOL_NAME (weight
)));
2270 p
+= sprintf (p
, ":italic");
2272 return (p
- fcname
);
2276 compute_metrics (dc
, w32_font
, code
, metrics
)
2278 struct w32font_info
*w32_font
;
2280 struct w32_metric_cache
*metrics
;
2284 unsigned int options
= GGO_METRICS
;
2286 if (w32_font
->glyph_idx
)
2287 options
|= GGO_GLYPH_INDEX
;
2289 bzero (&transform
, sizeof (transform
));
2290 transform
.eM11
.value
= 1;
2291 transform
.eM22
.value
= 1;
2293 if (GetGlyphOutlineW (dc
, code
, options
, &gm
, 0, NULL
, &transform
)
2296 metrics
->lbearing
= gm
.gmptGlyphOrigin
.x
;
2297 metrics
->rbearing
= gm
.gmptGlyphOrigin
.x
+ gm
.gmBlackBoxX
;
2298 metrics
->width
= gm
.gmCellIncX
;
2299 metrics
->status
= W32METRIC_SUCCESS
;
2301 else if (w32_font
->glyph_idx
)
2303 /* Can't use glyph indexes after all.
2304 Avoid it in future, and clear any metrics that were based on
2306 w32_font
->glyph_idx
= 0;
2307 clear_cached_metrics (w32_font
);
2310 metrics
->status
= W32METRIC_FAIL
;
2314 clear_cached_metrics (w32_font
)
2315 struct w32font_info
*w32_font
;
2318 for (i
= 0; i
< w32_font
->n_cache_blocks
; i
++)
2320 if (w32_font
->cached_metrics
[i
])
2321 bzero (w32_font
->cached_metrics
[i
],
2322 CACHE_BLOCKSIZE
* sizeof (struct font_metrics
));
2326 DEFUN ("x-select-font", Fx_select_font
, Sx_select_font
, 0, 2, 0,
2327 doc
: /* Read a font name using a W32 font selection dialog.
2328 Return fontconfig style font string corresponding to the selection.
2330 If FRAME is omitted or nil, it defaults to the selected frame.
2331 If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
2332 in the font selection dialog. */)
2333 (frame
, include_proportional
)
2334 Lisp_Object frame
, include_proportional
;
2336 FRAME_PTR f
= check_x_frame (frame
);
2344 bzero (&cf
, sizeof (cf
));
2345 bzero (&lf
, sizeof (lf
));
2347 cf
.lStructSize
= sizeof (cf
);
2348 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
2349 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
2351 /* Unless include_proportional is non-nil, limit the selection to
2352 monospaced fonts. */
2353 if (NILP (include_proportional
))
2354 cf
.Flags
|= CF_FIXEDPITCHONLY
;
2358 /* Initialize as much of the font details as we can from the current
2360 hdc
= GetDC (FRAME_W32_WINDOW (f
));
2361 oldobj
= SelectObject (hdc
, FONT_HANDLE (FRAME_FONT (f
)));
2362 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
2363 if (GetTextMetrics (hdc
, &tm
))
2365 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
2366 lf
.lfWeight
= tm
.tmWeight
;
2367 lf
.lfItalic
= tm
.tmItalic
;
2368 lf
.lfUnderline
= tm
.tmUnderlined
;
2369 lf
.lfStrikeOut
= tm
.tmStruckOut
;
2370 lf
.lfCharSet
= tm
.tmCharSet
;
2371 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
2373 SelectObject (hdc
, oldobj
);
2374 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
2376 if (!ChooseFont (&cf
)
2377 || logfont_to_fcname (&lf
, cf
.iPointSize
, buf
, 100) < 0)
2380 return build_string (buf
);
2383 struct font_driver w32font_driver
=
2386 0, /* case insensitive */
2390 w32font_list_family
,
2391 NULL
, /* free_entity */
2394 NULL
, /* prepare_face */
2395 NULL
, /* done_face */
2397 w32font_encode_char
,
2398 w32font_text_extents
,
2400 NULL
, /* get_bitmap */
2401 NULL
, /* free_bitmap */
2402 NULL
, /* get_outline */
2403 NULL
, /* free_outline */
2404 NULL
, /* anchor_point */
2405 NULL
, /* otf_capability */
2406 NULL
, /* otf_drive */
2407 NULL
, /* start_for_frame */
2408 NULL
, /* end_for_frame */
2413 /* Initialize state that does not change between invocations. This is only
2414 called when Emacs is dumped. */
2418 DEFSYM (Qgdi
, "gdi");
2419 DEFSYM (Quniscribe
, "uniscribe");
2420 DEFSYM (QCformat
, ":format");
2422 /* Generic font families. */
2423 DEFSYM (Qmonospace
, "monospace");
2424 DEFSYM (Qserif
, "serif");
2425 DEFSYM (Qsansserif
, "sansserif");
2426 DEFSYM (Qscript
, "script");
2427 DEFSYM (Qdecorative
, "decorative");
2429 DEFSYM (Qsans_serif
, "sans_serif");
2430 DEFSYM (Qsans
, "sans");
2431 DEFSYM (Qmono
, "mono");
2433 /* Fake foundries. */
2434 DEFSYM (Qraster
, "raster");
2435 DEFSYM (Qoutline
, "outline");
2436 DEFSYM (Qunknown
, "unknown");
2439 DEFSYM (Qstandard
, "standard");
2440 DEFSYM (Qsubpixel
, "subpixel");
2441 DEFSYM (Qnatural
, "natural");
2449 DEFSYM (Qlatin
, "latin");
2450 DEFSYM (Qgreek
, "greek");
2451 DEFSYM (Qcoptic
, "coptic");
2452 DEFSYM (Qcyrillic
, "cyrillic");
2453 DEFSYM (Qarmenian
, "armenian");
2454 DEFSYM (Qhebrew
, "hebrew");
2455 DEFSYM (Qarabic
, "arabic");
2456 DEFSYM (Qsyriac
, "syriac");
2457 DEFSYM (Qnko
, "nko");
2458 DEFSYM (Qthaana
, "thaana");
2459 DEFSYM (Qdevanagari
, "devanagari");
2460 DEFSYM (Qbengali
, "bengali");
2461 DEFSYM (Qgurmukhi
, "gurmukhi");
2462 DEFSYM (Qgujarati
, "gujarati");
2463 DEFSYM (Qoriya
, "oriya");
2464 DEFSYM (Qtamil
, "tamil");
2465 DEFSYM (Qtelugu
, "telugu");
2466 DEFSYM (Qkannada
, "kannada");
2467 DEFSYM (Qmalayalam
, "malayalam");
2468 DEFSYM (Qsinhala
, "sinhala");
2469 DEFSYM (Qthai
, "thai");
2470 DEFSYM (Qlao
, "lao");
2471 DEFSYM (Qtibetan
, "tibetan");
2472 DEFSYM (Qmyanmar
, "myanmar");
2473 DEFSYM (Qgeorgian
, "georgian");
2474 DEFSYM (Qhangul
, "hangul");
2475 DEFSYM (Qethiopic
, "ethiopic");
2476 DEFSYM (Qcherokee
, "cherokee");
2477 DEFSYM (Qcanadian_aboriginal
, "canadian-aboriginal");
2478 DEFSYM (Qogham
, "ogham");
2479 DEFSYM (Qrunic
, "runic");
2480 DEFSYM (Qkhmer
, "khmer");
2481 DEFSYM (Qmongolian
, "mongolian");
2482 DEFSYM (Qsymbol
, "symbol");
2483 DEFSYM (Qbraille
, "braille");
2484 DEFSYM (Qhan
, "han");
2485 DEFSYM (Qideographic_description
, "ideographic-description");
2486 DEFSYM (Qcjk_misc
, "cjk-misc");
2487 DEFSYM (Qkana
, "kana");
2488 DEFSYM (Qbopomofo
, "bopomofo");
2489 DEFSYM (Qkanbun
, "kanbun");
2491 DEFSYM (Qbyzantine_musical_symbol
, "byzantine-musical-symbol");
2492 DEFSYM (Qmusical_symbol
, "musical-symbol");
2493 DEFSYM (Qmathematical
, "mathematical");
2494 DEFSYM (Qphonetic
, "phonetic");
2495 DEFSYM (Qbalinese
, "balinese");
2496 DEFSYM (Qbuginese
, "buginese");
2497 DEFSYM (Qbuhid
, "buhid");
2498 DEFSYM (Qcuneiform
, "cuneiform");
2499 DEFSYM (Qcypriot
, "cypriot");
2500 DEFSYM (Qdeseret
, "deseret");
2501 DEFSYM (Qglagolitic
, "glagolitic");
2502 DEFSYM (Qgothic
, "gothic");
2503 DEFSYM (Qhanunoo
, "hanunoo");
2504 DEFSYM (Qkharoshthi
, "kharoshthi");
2505 DEFSYM (Qlimbu
, "limbu");
2506 DEFSYM (Qlinear_b
, "linear_b");
2507 DEFSYM (Qold_italic
, "old_italic");
2508 DEFSYM (Qold_persian
, "old_persian");
2509 DEFSYM (Qosmanya
, "osmanya");
2510 DEFSYM (Qphags_pa
, "phags-pa");
2511 DEFSYM (Qphoenician
, "phoenician");
2512 DEFSYM (Qshavian
, "shavian");
2513 DEFSYM (Qsyloti_nagri
, "syloti_nagri");
2514 DEFSYM (Qtagalog
, "tagalog");
2515 DEFSYM (Qtagbanwa
, "tagbanwa");
2516 DEFSYM (Qtai_le
, "tai_le");
2517 DEFSYM (Qtifinagh
, "tifinagh");
2518 DEFSYM (Qugaritic
, "ugaritic");
2520 /* W32 font encodings. */
2521 DEFVAR_LISP ("w32-charset-info-alist",
2522 &Vw32_charset_info_alist
,
2523 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
2524 Each entry should be of the form:
2526 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2528 where CHARSET_NAME is a string used in font names to identify the charset,
2529 WINDOWS_CHARSET is a symbol that can be one of:
2531 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2532 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2533 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2534 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2535 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2536 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2539 CODEPAGE should be an integer specifying the codepage that should be used
2540 to display the character set, t to do no translation and output as Unicode,
2541 or nil to do no translation and output as 8 bit (or multibyte on far-east
2542 versions of Windows) characters. */);
2543 Vw32_charset_info_alist
= Qnil
;
2545 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
2546 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
2547 DEFSYM (Qw32_charset_default
, "w32-charset-default");
2548 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
2549 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
2550 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
2551 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
2552 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
2553 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
2554 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
2555 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
2556 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
2557 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
2558 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
2559 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
2560 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
2561 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
2562 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
2563 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
2565 defsubr (&Sx_select_font
);
2567 w32font_driver
.type
= Qgdi
;
2568 register_font_driver (&w32font_driver
, NULL
);
2571 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2572 (do not change this comment) */