HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add 2011 to FSF/AIST copyright years.
[bpt/emacs.git] / src / w32font.c
CommitLineData
f7a84cb4 1/* Font backend for the Microsoft W32 API.
5df4f04c 2 Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
f7a84cb4
JR		 3
4This file is part of GNU Emacs.
5
9ec0b715 6GNU Emacs is free software: you can redistribute it and/or modify
f7a84cb4 7it under the terms of the GNU General Public License as published by
9ec0b715
GM		 8the Free Software Foundation, either version 3 of the License, or
9(at your option) any later version.
f7a84cb4
JR		 10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
9ec0b715 17along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
f7a84cb4
JR		 18
19#include <config.h>
20#include <windows.h>
09fe06b7 21#include <math.h>
0500dcc9 22#include <ctype.h>
6fe9826d 23#include <commdlg.h>
d7306fe6 24#include <setjmp.h>
f7a84cb4
JR		 25
26#include "lisp.h"
27#include "w32term.h"
28#include "frame.h"
29#include "dispextern.h"
30#include "character.h"
31#include "charset.h"
e6df5336 32#include "coding.h"
f7a84cb4
JR		 33#include "fontset.h"
34#include "font.h"
46fd1ded 35#include "w32font.h"
f7a84cb4 36
91583281
JR		 37/* Cleartype available on Windows XP, cleartype_natural from XP SP1.
38 The latter does not try to fit cleartype smoothed fonts into the
39 same bounding box as the non-antialiased version of the font.
40 */
41#ifndef CLEARTYPE_QUALITY
42#define CLEARTYPE_QUALITY 5
43#endif
44#ifndef CLEARTYPE_NATURAL_QUALITY
45#define CLEARTYPE_NATURAL_QUALITY 6
46#endif
47
57016d37
JR		 48/* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
49 of MSVC headers. */
50#ifndef VIETNAMESE_CHARSET
51#define VIETNAMESE_CHARSET 163
52#endif
53#ifndef JOHAB_CHARSET
54#define JOHAB_CHARSET 130
55#endif
56
f7a84cb4
JR		 57extern struct font_driver w32font_driver;
58
91583281 59Lisp_Object Qgdi;
34fd2d28
JR		 60Lisp_Object Quniscribe;
61static Lisp_Object QCformat;
9e1a2995
JR		 62static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif;
63static Lisp_Object Qserif, Qscript, Qdecorative;
64static Lisp_Object Qraster, Qoutline, Qunknown;
d205d43b 65
91583281 66/* antialiasing */
5f18d119 67extern Lisp_Object QCantialias, QCotf, QClang; /* defined in font.c */
91583281
JR		 68extern Lisp_Object Qnone; /* reuse from w32fns.c */
69static Lisp_Object Qstandard, Qsubpixel, Qnatural;
70
8f112d52 71/* languages */
314d66f4 72static Lisp_Object Qzh;
8f112d52 73
d205d43b
JR		 74/* scripts */
75static Lisp_Object Qlatin, Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
76static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
77static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
78static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
79static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
80static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
81static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
82static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
83static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
174f1c74 84static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
56df6710
JR		 85/* Not defined in characters.el, but referenced in fontset.el. */
86static Lisp_Object Qbalinese, Qbuginese, Qbuhid, Qcuneiform, Qcypriot;
87static Lisp_Object Qdeseret, Qglagolitic, Qgothic, Qhanunoo, Qkharoshthi;
88static Lisp_Object Qlimbu, Qlinear_b, Qold_italic, Qold_persian, Qosmanya;
89static Lisp_Object Qphags_pa, Qphoenician, Qshavian, Qsyloti_nagri;
90static Lisp_Object Qtagalog, Qtagbanwa, Qtai_le, Qtifinagh, Qugaritic;
d205d43b 91
57016d37
JR		 92/* W32 charsets: for use in Vw32_charset_info_alist. */
93static Lisp_Object Qw32_charset_ansi, Qw32_charset_default;
94static Lisp_Object Qw32_charset_symbol, Qw32_charset_shiftjis;
95static Lisp_Object Qw32_charset_hangeul, Qw32_charset_gb2312;
96static Lisp_Object Qw32_charset_chinesebig5, Qw32_charset_oem;
97static Lisp_Object Qw32_charset_easteurope, Qw32_charset_turkish;
98static Lisp_Object Qw32_charset_baltic, Qw32_charset_russian;
99static Lisp_Object Qw32_charset_arabic, Qw32_charset_greek;
100static Lisp_Object Qw32_charset_hebrew, Qw32_charset_vietnamese;
101static Lisp_Object Qw32_charset_thai, Qw32_charset_johab, Qw32_charset_mac;
102
103/* Associative list linking character set strings to Windows codepages. */
104static Lisp_Object Vw32_charset_info_alist;
105
d205d43b
JR		 106/* Font spacing symbols - defined in font.c. */
107extern Lisp_Object Qc, Qp, Qm;
f7a84cb4 108
8f112d52 109static void fill_in_logfont P_ ((FRAME_PTR, LOGFONT *, Lisp_Object));
f7a84cb4 110
8f112d52
JR		 111static BYTE w32_antialias_type P_ ((Lisp_Object));
112static Lisp_Object lispy_antialias_type P_ ((BYTE));
91583281 113
8f112d52
JR		 114static Lisp_Object font_supported_scripts P_ ((FONTSIGNATURE *));
115static int w32font_full_name P_ ((LOGFONT *, Lisp_Object, int, char *, int));
116static void compute_metrics P_ ((HDC, struct w32font_info *, unsigned int,
117 struct w32_metric_cache *));
f7a84cb4 118
8f112d52 119static Lisp_Object w32_registry P_ ((LONG, DWORD));
f7a84cb4
JR		 120
121/* EnumFontFamiliesEx callbacks. */
122static int CALLBACK add_font_entity_to_list P_ ((ENUMLOGFONTEX *,
123 NEWTEXTMETRICEX *,
124 DWORD, LPARAM));
125static int CALLBACK add_one_font_entity_to_list P_ ((ENUMLOGFONTEX *,
126 NEWTEXTMETRICEX *,
127 DWORD, LPARAM));
128static int CALLBACK add_font_name_to_list P_ ((ENUMLOGFONTEX *,
129 NEWTEXTMETRICEX *,
130 DWORD, LPARAM));
131
d205d43b
JR		 132/* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track
133 of what we really want. */
134struct font_callback_data
135{
136 /* The logfont we are matching against. EnumFontFamiliesEx only matches
137 face name and charset, so we need to manually match everything else
138 in the callback function. */
139 LOGFONT pattern;
140 /* The original font spec or entity. */
141 Lisp_Object orig_font_spec;
142 /* The frame the font is being loaded on. */
143 Lisp_Object frame;
144 /* The list to add matches to. */
145 Lisp_Object list;
46fd1ded
JR		 146 /* Whether to match only opentype fonts. */
147 int opentype_only;
d205d43b
JR		 148};
149
150/* Handles the problem that EnumFontFamiliesEx will not return all
151 style variations if the font name is not specified. */
8f112d52 152static void list_all_matching_fonts P_ ((struct font_callback_data *));
d205d43b 153
f7a84cb4
JR		 154
155static int
156memq_no_quit (elt, list)
157 Lisp_Object elt, list;
158{
159 while (CONSP (list) && ! EQ (XCAR (list), elt))
160 list = XCDR (list);
161 return (CONSP (list));
162}
163
e6df5336
JR		 164Lisp_Object
165intern_font_name (string)
166 char * string;
167{
168 Lisp_Object obarray, tem, str;
169 int len;
170
171 str = DECODE_SYSTEM (build_string (string));
172 len = SCHARS (str);
173
174 /* The following code is copied from the function intern (in lread.c). */
175 obarray = Vobarray;
176 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
177 obarray = check_obarray (obarray);
178 tem = oblookup (obarray, SDATA (str), len, len);
179 if (SYMBOLP (tem))
180 return tem;
181 return Fintern (str, obarray);
182}
183
f7a84cb4
JR		 184/* w32 implementation of get_cache for font backend.
185 Return a cache of font-entities on FRAME. The cache must be a
186 cons whose cdr part is the actual cache area. */
46fd1ded 187Lisp_Object
a4c71909
KH		 188w32font_get_cache (f)
189 FRAME_PTR f;
f7a84cb4 190{
a4c71909 191 struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
f7a84cb4
JR		 192
193 return (dpyinfo->name_list_element);
194}
195
196/* w32 implementation of list for font backend.
197 List fonts exactly matching with FONT_SPEC on FRAME. The value
198 is a vector of font-entities. This is the sole API that
199 allocates font-entities. */
20399669
JR		 200static Lisp_Object
201w32font_list (frame, font_spec)
202 Lisp_Object frame, font_spec;
f7a84cb4 203{
07d9ba9b 204 Lisp_Object fonts = w32font_list_internal (frame, font_spec, 0);
678dca3d 205 FONT_ADD_LOG ("w32font-list", font_spec, fonts);
07d9ba9b 206 return fonts;
f7a84cb4
JR		 207}
208
209/* w32 implementation of match for font backend.
210 Return a font entity most closely matching with FONT_SPEC on
211 FRAME. The closeness is detemined by the font backend, thus
212 `face-font-selection-order' is ignored here. */
20399669
JR		 213static Lisp_Object
214w32font_match (frame, font_spec)
215 Lisp_Object frame, font_spec;
f7a84cb4 216{
07d9ba9b 217 Lisp_Object entity = w32font_match_internal (frame, font_spec, 0);
678dca3d 218 FONT_ADD_LOG ("w32font-match", font_spec, entity);
07d9ba9b 219 return entity;
f7a84cb4
JR		 220}
221
f7a84cb4
JR		 222/* w32 implementation of list_family for font backend.
223 List available families. The value is a list of family names
224 (symbols). */
20399669
JR		 225static Lisp_Object
226w32font_list_family (frame)
227 Lisp_Object frame;
f7a84cb4
JR		 228{
229 Lisp_Object list = Qnil;
230 LOGFONT font_match_pattern;
231 HDC dc;
232 FRAME_PTR f = XFRAME (frame);
233
234 bzero (&font_match_pattern, sizeof (font_match_pattern));
56df6710 235 font_match_pattern.lfCharSet = DEFAULT_CHARSET;
f7a84cb4
JR		 236
237 dc = get_frame_dc (f);
238
239 EnumFontFamiliesEx (dc, &font_match_pattern,
240 (FONTENUMPROC) add_font_name_to_list,
241 (LPARAM) &list, 0);
242 release_frame_dc (f, dc);
243
244 return list;
245}
246
247/* w32 implementation of open for font backend.
248 Open a font specified by FONT_ENTITY on frame F.
249 If the font is scalable, open it with PIXEL_SIZE. */
5f18d119 250static Lisp_Object
20399669
JR		 251w32font_open (f, font_entity, pixel_size)
252 FRAME_PTR f;
253 Lisp_Object font_entity;
254 int pixel_size;
f7a84cb4 255{
bd187c49
JR		 256 Lisp_Object font_object
257 = font_make_object (VECSIZE (struct w32font_info),
258 font_entity, pixel_size);
259 struct w32font_info *w32_font
260 = (struct w32font_info *) XFONT_OBJECT (font_object);
f7a84cb4 261
4b135503 262 ASET (font_object, FONT_TYPE_INDEX, Qgdi);
f7a84cb4 263
5f18d119 264 if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
f7a84cb4 265 {
5f18d119 266 return Qnil;
f7a84cb4
JR		 267 }
268
bd187c49
JR		 269 /* GDI backend does not use glyph indices. */
270 w32_font->glyph_idx = 0;
271
5f18d119 272 return font_object;
f7a84cb4
JR		 273}
274
275/* w32 implementation of close for font_backend.
276 Close FONT on frame F. */
46fd1ded 277void
20399669
JR		 278w32font_close (f, font)
279 FRAME_PTR f;
280 struct font *font;
f7a84cb4 281{
c35f9821 282 int i;
5f18d119 283 struct w32font_info *w32_font = (struct w32font_info *) font;
c35f9821
JR		 284
285 /* Delete the GDI font object. */
1b5defe6 286 DeleteObject (w32_font->hfont);
c35f9821
JR		 287
288 /* Free all the cached metrics. */
289 if (w32_font->cached_metrics)
290 {
291 for (i = 0; i < w32_font->n_cache_blocks; i++)
292 {
5f445726 293 xfree (w32_font->cached_metrics[i]);
c35f9821
JR		 294 }
295 xfree (w32_font->cached_metrics);
296 w32_font->cached_metrics = NULL;
297 }
f7a84cb4
JR		 298}
299
300/* w32 implementation of has_char for font backend.
301 Optional.
302 If FONT_ENTITY has a glyph for character C (Unicode code point),
303 return 1. If not, return 0. If a font must be opened to check
304 it, return -1. */
46fd1ded 305int
20399669
JR		 306w32font_has_char (entity, c)
307 Lisp_Object entity;
308 int c;
f7a84cb4 309{
e6eee6ae
JR		 310 /* We can't be certain about which characters a font will support until
311 we open it. Checking the scripts that the font supports turns out
312 to not be reliable. */
313 return -1;
314
315#if 0
d205d43b 316 Lisp_Object supported_scripts, extra, script;
f7a84cb4
JR		 317 DWORD mask;
318
01dbeb0b
JR		 319 extra = AREF (entity, FONT_EXTRA_INDEX);
320 if (!CONSP (extra))
321 return -1;
322
d205d43b 323 supported_scripts = assq_no_quit (QCscript, extra);
6a8082b5
JR		 324 /* If font doesn't claim to support any scripts, then we can't be certain
325 until we open it. */
d205d43b 326 if (!CONSP (supported_scripts))
f7a84cb4
JR		 327 return -1;
328
d205d43b 329 supported_scripts = XCDR (supported_scripts);
f7a84cb4 330
d205d43b 331 script = CHAR_TABLE_REF (Vchar_script_table, c);
f7a84cb4 332
6a8082b5
JR		 333 /* If we don't know what script the character is from, then we can't be
334 certain until we open it. Also if the font claims support for the script
335 the character is from, it may only have partial coverage, so we still
336 can't be certain until we open the font. */
337 if (NILP (script) || memq_no_quit (script, supported_scripts))
338 return -1;
339
340 /* Font reports what scripts it supports, and none of them are the script
e6eee6ae
JR		 341 the character is from. But we still can't be certain, as some fonts
342 will contain some/most/all of the characters in that script without
343 claiming support for it. */
344 return -1;
345#endif
f7a84cb4
JR		 346}
347
348/* w32 implementation of encode_char for font backend.
51e4f4a8 349 Return a glyph code of FONT for character C (Unicode code point).
bd187c49
JR		 350 If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
351
352 For speed, the gdi backend uses unicode (Emacs calls encode_char
353 far too often for it to be efficient). But we still need to detect
354 which characters are not supported by the font.
355 */
34fd2d28 356static unsigned
20399669
JR		 357w32font_encode_char (font, c)
358 struct font *font;
359 int c;
f7a84cb4 360{
bd187c49 361 struct w32font_info * w32_font = (struct w32font_info *)font;
34fd2d28 362
bd187c49
JR		 363 if (c < w32_font->metrics.tmFirstChar
364 || c > w32_font->metrics.tmLastChar)
365 return FONT_INVALID_CODE;
34fd2d28 366 else
bd187c49 367 return c;
f7a84cb4
JR		 368}
369
370/* w32 implementation of text_extents for font backend.
371 Perform the size computation of glyphs of FONT and fillin members
372 of METRICS. The glyphs are specified by their glyph codes in
78573c57 373 CODE (length NGLYPHS). Apparently metrics can be NULL, in this
f7a84cb4 374 case just return the overall width. */
46fd1ded 375int
20399669
JR		 376w32font_text_extents (font, code, nglyphs, metrics)
377 struct font *font;
378 unsigned *code;
379 int nglyphs;
380 struct font_metrics *metrics;
f7a84cb4
JR		 381{
382 int i;
2a36efcf
JR		 383 HFONT old_font = NULL;
384 HDC dc = NULL;
46fd1ded 385 struct frame * f;
f7a84cb4 386 int total_width = 0;
f31cf550 387 WORD *wcode;
d205d43b 388 SIZE size;
f7a84cb4 389
1b5defe6
JR		 390 struct w32font_info *w32_font = (struct w32font_info *) font;
391
f7a84cb4
JR		 392 if (metrics)
393 {
ba93d684 394 bzero (metrics, sizeof (struct font_metrics));
388c38f9
JR		 395 metrics->ascent = font->ascent;
396 metrics->descent = font->descent;
f7a84cb4
JR		 397
398 for (i = 0; i < nglyphs; i++)
399 {
8f112d52
JR		 400 struct w32_metric_cache *char_metric;
401 int block = *(code + i) / CACHE_BLOCKSIZE;
402 int pos_in_block = *(code + i) % CACHE_BLOCKSIZE;
403
404 if (block >= w32_font->n_cache_blocks)
405 {
406 if (!w32_font->cached_metrics)
407 w32_font->cached_metrics
408 = xmalloc ((block + 1)
9cac6313 409 * sizeof (struct w32_metric_cache *));
8f112d52
JR		 410 else
411 w32_font->cached_metrics
412 = xrealloc (w32_font->cached_metrics,
413 (block + 1)
9cac6313 414 * sizeof (struct w32_metric_cache *));
8f112d52
JR		 415 bzero (w32_font->cached_metrics + w32_font->n_cache_blocks,
416 ((block + 1 - w32_font->n_cache_blocks)
9cac6313 417 * sizeof (struct w32_metric_cache *)));
8f112d52
JR		 418 w32_font->n_cache_blocks = block + 1;
419 }
420
421 if (!w32_font->cached_metrics[block])
422 {
423 w32_font->cached_metrics[block]
9cac6313 424 = xmalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
8f112d52 425 bzero (w32_font->cached_metrics[block],
9cac6313 426 CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
8f112d52
JR		 427 }
428
429 char_metric = w32_font->cached_metrics[block] + pos_in_block;
430
431 if (char_metric->status == W32METRIC_NO_ATTEMPT)
432 {
433 if (dc == NULL)
434 {
435 /* TODO: Frames can come and go, and their fonts
436 outlive them. So we can't cache the frame in the
437 font structure. Use selected_frame until the API
438 is updated to pass in a frame. */
439 f = XFRAME (selected_frame);
9c623c85 440
2a36efcf 441 dc = get_frame_dc (f);
1b5defe6 442 old_font = SelectObject (dc, w32_font->hfont);
8f112d52
JR		 443 }
444 compute_metrics (dc, w32_font, *(code + i), char_metric);
445 }
78573c57 446
8f112d52
JR		 447 if (char_metric->status == W32METRIC_SUCCESS)
448 {
449 metrics->lbearing = min (metrics->lbearing,
450 metrics->width + char_metric->lbearing);
451 metrics->rbearing = max (metrics->rbearing,
452 metrics->width + char_metric->rbearing);
453 metrics->width += char_metric->width;
454 }
455 else
456 /* If we couldn't get metrics for a char,
457 use alternative method. */
458 break;
459 }
78573c57
JR		 460 /* If we got through everything, return. */
461 if (i == nglyphs)
462 {
2a36efcf
JR		 463 if (dc != NULL)
464 {
465 /* Restore state and release DC. */
466 SelectObject (dc, old_font);
467 release_frame_dc (f, dc);
468 }
78573c57
JR		 469
470 return metrics->width;
471 }
f7a84cb4 472 }
78573c57 473
56df6710
JR		 474 /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
475 fallback on other methods that will at least give some of the metric
476 information. */
b003e5ff 477
f31cf550
JR		 478 /* Make array big enough to hold surrogates. */
479 wcode = alloca (nglyphs * sizeof (WORD) * 2);
480 for (i = 0; i < nglyphs; i++)
481 {
482 if (code[i] < 0x10000)
483 wcode[i] = code[i];
484 else
485 {
486 DWORD surrogate = code[i] - 0x10000;
487
488 /* High surrogate: U+D800 - U+DBFF. */
489 wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
490 /* Low surrogate: U+DC00 - U+DFFF. */
491 wcode[i] = 0xDC00 + (surrogate & 0x03FF);
492 /* An extra glyph. wcode is already double the size of code to
493 cope with this. */
494 nglyphs++;
495 }
496 }
497
2a36efcf
JR		 498 if (dc == NULL)
499 {
8f112d52
JR		 500 /* TODO: Frames can come and go, and their fonts outlive
501 them. So we can't cache the frame in the font structure. Use
502 selected_frame until the API is updated to pass in a
503 frame. */
504 f = XFRAME (selected_frame);
505
2a36efcf 506 dc = get_frame_dc (f);
1b5defe6 507 old_font = SelectObject (dc, w32_font->hfont);
2a36efcf
JR		 508 }
509
d205d43b 510 if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
f7a84cb4 511 {
d205d43b 512 total_width = size.cx;
f7a84cb4
JR		 513 }
514
56df6710
JR		 515 /* On 95/98/ME, only some unicode functions are available, so fallback
516 on doing a dummy draw to find the total width. */
d205d43b 517 if (!total_width)
f7a84cb4
JR		 518 {
519 RECT rect;
5f18d119 520 rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
f7a84cb4
JR		 521 DrawTextW (dc, wcode, nglyphs, &rect,
522 DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
523 total_width = rect.right;
524 }
d205d43b 525
56df6710 526 /* Give our best estimate of the metrics, based on what we know. */
78573c57
JR		 527 if (metrics)
528 {
79ca7db1 529 metrics->width = total_width - w32_font->metrics.tmOverhang;
78573c57 530 metrics->lbearing = 0;
79ca7db1 531 metrics->rbearing = total_width;
78573c57
JR		 532 }
533
f7a84cb4
JR		 534 /* Restore state and release DC. */
535 SelectObject (dc, old_font);
46fd1ded 536 release_frame_dc (f, dc);
f7a84cb4
JR		 537
538 return total_width;
539}
540
541/* w32 implementation of draw for font backend.
542 Optional.
543 Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
544 position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
545 is nonzero, fill the background in advance. It is assured that
a74ddbda
JR		 546 WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
547
548 TODO: Currently this assumes that the colors and fonts are already
549 set in the DC. This seems to be true now, but maybe only due to
550 the old font code setting it up. It may be safer to resolve faces
551 and fonts in here and set them explicitly
552*/
553
46fd1ded 554int
20399669
JR		 555w32font_draw (s, from, to, x, y, with_background)
556 struct glyph_string *s;
557 int from, to, x, y, with_background;
f7a84cb4 558{
34fd2d28 559 UINT options;
f70eb806 560 HRGN orig_clip = NULL;
5f18d119 561 struct w32font_info *w32font = (struct w32font_info *) s->font;
34fd2d28
JR		 562
563 options = w32font->glyph_idx;
5c2c9c79 564
5c2c9c79
JR		 565 if (s->num_clips > 0)
566 {
567 HRGN new_clip = CreateRectRgnIndirect (s->clip);
568
f70eb806
JR		 569 /* Save clip region for later restoration. */
570 orig_clip = CreateRectRgn (0, 0, 0, 0);
9d4f32e8 571 if (!GetClipRgn (s->hdc, orig_clip))
f70eb806
JR		 572 {
573 DeleteObject (orig_clip);
574 orig_clip = NULL;
575 }
576
5c2c9c79
JR		 577 if (s->num_clips > 1)
578 {
579 HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
580
581 CombineRgn (new_clip, new_clip, clip2, RGN_OR);
582 DeleteObject (clip2);
583 }
584
585 SelectClipRgn (s->hdc, new_clip);
586 DeleteObject (new_clip);
587 }
f7a84cb4 588
fb3b8017
JR		 589 /* Using OPAQUE background mode can clear more background than expected
590 when Cleartype is used. Draw the background manually to avoid this. */
591 SetBkMode (s->hdc, TRANSPARENT);
f7a84cb4
JR		 592 if (with_background)
593 {
1065a502
JR		 594 HBRUSH brush;
595 RECT rect;
5f18d119 596 struct font *font = s->font;
1065a502
JR		 597
598 brush = CreateSolidBrush (s->gc->background);
599 rect.left = x;
fb3b8017 600 rect.top = y - font->ascent;
1065a502 601 rect.right = x + s->width;
fb3b8017 602 rect.bottom = y + font->descent;
1065a502 603 FillRect (s->hdc, &rect, brush);
f2b25c0e 604 DeleteObject (brush);
f7a84cb4 605 }
040fe918 606
de63f07f
KH		 607 if (s->padding_p)
608 {
609 int len = to - from, i;
610
611 for (i = 0; i < len; i++)
612 ExtTextOutW (s->hdc, x + i, y, options, NULL,
8501c48b 613 s->char2b + from + i, 1, NULL);
de63f07f
KH		 614 }
615 else
616 ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, to - from, NULL);
5c2c9c79
JR		 617
618 /* Restore clip region. */
619 if (s->num_clips > 0)
f70eb806
JR		 620 SelectClipRgn (s->hdc, orig_clip);
621
622 if (orig_clip)
623 DeleteObject (orig_clip);
f7a84cb4
JR		 624}
625
626/* w32 implementation of free_entity for font backend.
627 Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
628 Free FONT_EXTRA_INDEX field of FONT_ENTITY.
20399669
JR		 629static void
630w32font_free_entity (Lisp_Object entity);
f7a84cb4
JR		 631 */
632
633/* w32 implementation of prepare_face for font backend.
634 Optional (if FACE->extra is not used).
635 Prepare FACE for displaying characters by FONT on frame F by
636 storing some data in FACE->extra. If successful, return 0.
637 Otherwise, return -1.
20399669
JR		 638static int
639w32font_prepare_face (FRAME_PTR f, struct face *face);
f7a84cb4
JR		 640 */
641/* w32 implementation of done_face for font backend.
642 Optional.
643 Done FACE for displaying characters by FACE->font on frame F.
20399669
JR		 644static void
645w32font_done_face (FRAME_PTR f, struct face *face); */
f7a84cb4
JR		 646
647/* w32 implementation of get_bitmap for font backend.
648 Optional.
649 Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
f2b25c0e 650 intended that this method is called from the other font-driver
f7a84cb4 651 for actual drawing.
20399669
JR		 652static int
653w32font_get_bitmap (struct font *font, unsigned code,
654 struct font_bitmap *bitmap, int bits_per_pixel);
f7a84cb4
JR		 655 */
656/* w32 implementation of free_bitmap for font backend.
657 Optional.
658 Free bitmap data in BITMAP.
20399669
JR		 659static void
660w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap);
f7a84cb4
JR		 661 */
662/* w32 implementation of get_outline for font backend.
663 Optional.
664 Return an outline data for glyph-code CODE of FONT. The format
665 of the outline data depends on the font-driver.
20399669
JR		 666static void *
667w32font_get_outline (struct font *font, unsigned code);
f7a84cb4
JR		 668 */
669/* w32 implementation of free_outline for font backend.
670 Optional.
671 Free OUTLINE (that is obtained by the above method).
20399669
JR		 672static void
673w32font_free_outline (struct font *font, void *outline);
f7a84cb4
JR		 674 */
675/* w32 implementation of anchor_point for font backend.
676 Optional.
677 Get coordinates of the INDEXth anchor point of the glyph whose
678 code is CODE. Store the coordinates in *X and *Y. Return 0 if
679 the operations was successfull. Otherwise return -1.
20399669
JR		 680static int
681w32font_anchor_point (struct font *font, unsigned code,
f7a84cb4
JR		 682 int index, int *x, int *y);
683 */
684/* w32 implementation of otf_capability for font backend.
685 Optional.
686 Return a list describing which scripts/languages FONT
687 supports by which GSUB/GPOS features of OpenType tables.
20399669
JR		 688static Lisp_Object
689w32font_otf_capability (struct font *font);
f7a84cb4
JR		 690 */
691/* w32 implementation of otf_drive for font backend.
692 Optional.
693 Apply FONT's OTF-FEATURES to the glyph string.
694
695 FEATURES specifies which OTF features to apply in this format:
696 (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE)
697 See the documentation of `font-drive-otf' for the detail.
698
699 This method applies the specified features to the codes in the
700 elements of GSTRING-IN (between FROMth and TOth). The output
701 codes are stored in GSTRING-OUT at the IDXth element and the
702 following elements.
703
704 Return the number of output codes. If none of the features are
705 applicable to the input data, return 0. If GSTRING-OUT is too
706 short, return -1.
20399669
JR		 707static int
708w32font_otf_drive (struct font *font, Lisp_Object features,
709 Lisp_Object gstring_in, int from, int to,
710 Lisp_Object gstring_out, int idx,
711 int alternate_subst);
f7a84cb4
JR		 712 */
713
46fd1ded
JR		 714/* Internal implementation of w32font_list.
715 Additional parameter opentype_only restricts the returned fonts to
716 opentype fonts, which can be used with the Uniscribe backend. */
717Lisp_Object
718w32font_list_internal (frame, font_spec, opentype_only)
719 Lisp_Object frame, font_spec;
720 int opentype_only;
721{
722 struct font_callback_data match_data;
723 HDC dc;
724 FRAME_PTR f = XFRAME (frame);
725
726 match_data.orig_font_spec = font_spec;
727 match_data.list = Qnil;
728 match_data.frame = frame;
729
730 bzero (&match_data.pattern, sizeof (LOGFONT));
731 fill_in_logfont (f, &match_data.pattern, font_spec);
732
19ae3e61
JR		 733 /* If the charset is unrecognized, then we won't find a font, so don't
734 waste time looking for one. */
735 if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
736 {
737 Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
738 if (!NILP (spec_charset)
739 && !EQ (spec_charset, Qiso10646_1)
740 && !EQ (spec_charset, Qunicode_bmp)
741 && !EQ (spec_charset, Qunicode_sip)
742 && !EQ (spec_charset, Qunknown))
743 return Qnil;
744 }
745
46fd1ded
JR		 746 match_data.opentype_only = opentype_only;
747 if (opentype_only)
748 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
749
750 if (match_data.pattern.lfFaceName[0] == '\0')
751 {
752 /* EnumFontFamiliesEx does not take other fields into account if
753 font name is blank, so need to use two passes. */
754 list_all_matching_fonts (&match_data);
755 }
756 else
757 {
758 dc = get_frame_dc (f);
759
760 EnumFontFamiliesEx (dc, &match_data.pattern,
761 (FONTENUMPROC) add_font_entity_to_list,
762 (LPARAM) &match_data, 0);
763 release_frame_dc (f, dc);
764 }
765
19ae3e61 766 return match_data.list;
46fd1ded
JR		 767}
768
769/* Internal implementation of w32font_match.
770 Additional parameter opentype_only restricts the returned fonts to
771 opentype fonts, which can be used with the Uniscribe backend. */
772Lisp_Object
773w32font_match_internal (frame, font_spec, opentype_only)
774 Lisp_Object frame, font_spec;
775 int opentype_only;
776{
777 struct font_callback_data match_data;
778 HDC dc;
779 FRAME_PTR f = XFRAME (frame);
780
781 match_data.orig_font_spec = font_spec;
782 match_data.frame = frame;
783 match_data.list = Qnil;
784
785 bzero (&match_data.pattern, sizeof (LOGFONT));
786 fill_in_logfont (f, &match_data.pattern, font_spec);
787
788 match_data.opentype_only = opentype_only;
789 if (opentype_only)
790 match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
791
792 dc = get_frame_dc (f);
793
794 EnumFontFamiliesEx (dc, &match_data.pattern,
795 (FONTENUMPROC) add_one_font_entity_to_list,
796 (LPARAM) &match_data, 0);
797 release_frame_dc (f, dc);
798
799 return NILP (match_data.list) ? Qnil : XCAR (match_data.list);
800}
801
f0121ad2 802int
5f18d119 803w32font_open_internal (f, font_entity, pixel_size, font_object)
f0121ad2
JR		 804 FRAME_PTR f;
805 Lisp_Object font_entity;
806 int pixel_size;
5f18d119 807 Lisp_Object font_object;
f0121ad2 808{
5f18d119 809 int len, size, i;
f0121ad2
JR		 810 LOGFONT logfont;
811 HDC dc;
812 HFONT hfont, old_font;
813 Lisp_Object val, extra;
5f18d119
KH		 814 struct w32font_info *w32_font;
815 struct font * font;
bd187c49 816 OUTLINETEXTMETRICW* metrics = NULL;
5f18d119
KH		 817
818 w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
819 font = (struct font *) w32_font;
f0121ad2 820
f0121ad2
JR		 821 if (!font)
822 return 0;
823
824 bzero (&logfont, sizeof (logfont));
825 fill_in_logfont (f, &logfont, font_entity);
826
1519d52e
JR		 827 /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
828 limitations in bitmap fonts. */
829 val = AREF (font_entity, FONT_FOUNDRY_INDEX);
830 if (!EQ (val, Qraster))
831 logfont.lfOutPrecision = OUT_TT_PRECIS;
832
f0121ad2
JR		 833 size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
834 if (!size)
835 size = pixel_size;
836
837 logfont.lfHeight = -size;
838 hfont = CreateFontIndirect (&logfont);
839
840 if (hfont == NULL)
841 return 0;
842
f0121ad2
JR		 843 /* Get the metrics for this font. */
844 dc = get_frame_dc (f);
845 old_font = SelectObject (dc, hfont);
846
5f18d119 847 /* Try getting the outline metrics (only works for truetype fonts). */
bd187c49 848 len = GetOutlineTextMetricsW (dc, 0, NULL);
5f18d119
KH		 849 if (len)
850 {
bd187c49
JR		 851 metrics = (OUTLINETEXTMETRICW *) alloca (len);
852 if (GetOutlineTextMetricsW (dc, len, metrics))
5f18d119 853 bcopy (&metrics->otmTextMetrics, &w32_font->metrics,
bd187c49 854 sizeof (TEXTMETRICW));
5f18d119
KH		 855 else
856 metrics = NULL;
857 }
f0121ad2 858
943f2093 859 if (!metrics)
b0857706 860 GetTextMetricsW (dc, &w32_font->metrics);
b003e5ff 861
8f112d52
JR		 862 w32_font->cached_metrics = NULL;
863 w32_font->n_cache_blocks = 0;
54efdcd1 864
f0121ad2
JR		 865 SelectObject (dc, old_font);
866 release_frame_dc (f, dc);
34fd2d28 867
1b5defe6 868 w32_font->hfont = hfont;
f0121ad2 869
5ace1ec1
JR		 870 {
871 char *name;
872
873 /* We don't know how much space we need for the full name, so start with
874 96 bytes and go up in steps of 32. */
875 len = 96;
c35f9821 876 name = alloca (len);
67997c79
JR		 877 while (name && w32font_full_name (&logfont, font_entity, pixel_size,
878 name, len) < 0)
5ace1ec1 879 {
c35f9821
JR		 880 len += 32;
881 name = alloca (len);
5ace1ec1
JR		 882 }
883 if (name)
5f18d119 884 font->props[FONT_FULLNAME_INDEX]
e6df5336 885 = DECODE_SYSTEM (build_string (name));
5ace1ec1 886 else
e6df5336
JR		 887 font->props[FONT_FULLNAME_INDEX]
888 = DECODE_SYSTEM (build_string (logfont.lfFaceName));
5ace1ec1 889 }
5f18d119
KH		 890
891 font->max_width = w32_font->metrics.tmMaxCharWidth;
b003e5ff 892 /* Parts of Emacs display assume that height = ascent + descent...
9196133b 893 so height is defined later, after ascent and descent.
5f18d119 894 font->height = w32_font->metrics.tmHeight
f0121ad2 895 + w32_font->metrics.tmExternalLeading;
9196133b
JR		 896 */
897
5f18d119
KH		 898 font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
899
900 font->vertical_centering = 0;
901 font->encoding_type = 0;
902 font->baseline_offset = 0;
903 font->relative_compose = 0;
904 font->default_ascent = w32_font->metrics.tmAscent;
905 font->font_encoder = NULL;
f0121ad2
JR		 906 font->pixel_size = size;
907 font->driver = &w32font_driver;
34fd2d28
JR		 908 /* Use format cached during list, as the information we have access to
909 here is incomplete. */
910 extra = AREF (font_entity, FONT_EXTRA_INDEX);
911 if (CONSP (extra))
912 {
913 val = assq_no_quit (QCformat, extra);
914 if (CONSP (val))
5f18d119 915 font->props[FONT_FORMAT_INDEX] = XCDR (val);
34fd2d28 916 else
5f18d119 917 font->props[FONT_FORMAT_INDEX] = Qunknown;
34fd2d28
JR		 918 }
919 else
5f18d119 920 font->props[FONT_FORMAT_INDEX] = Qunknown;
34fd2d28 921
5f18d119 922 font->props[FONT_FILE_INDEX] = Qnil;
f0121ad2
JR		 923 font->encoding_charset = -1;
924 font->repertory_charset = -1;
04b65d2b 925 /* TODO: do we really want the minimum width here, which could be negative? */
5f18d119 926 font->min_width = font->space_width;
f0121ad2
JR		 927 font->ascent = w32_font->metrics.tmAscent;
928 font->descent = w32_font->metrics.tmDescent;
9196133b 929 font->height = font->ascent + font->descent;
5f18d119
KH		 930
931 if (metrics)
932 {
933 font->underline_thickness = metrics->otmsUnderscoreSize;
934 font->underline_position = -metrics->otmsUnderscorePosition;
935 }
936 else
937 {
938 font->underline_thickness = 0;
939 font->underline_position = -1;
940 }
f0121ad2 941
5f18d119
KH		 942 /* For temporary compatibility with legacy code that expects the
943 name to be usable in x-list-fonts. Eventually we expect to change
944 x-list-fonts and other places that use fonts so that this can be
945 an fcname or similar. */
a30e1957 946 font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
04b65d2b 947
f0121ad2
JR		 948 return 1;
949}
950
f7a84cb4
JR		 951/* Callback function for EnumFontFamiliesEx.
952 * Adds the name of a font to a Lisp list (passed in as the lParam arg). */
20399669
JR		 953static int CALLBACK
954add_font_name_to_list (logical_font, physical_font, font_type, list_object)
955 ENUMLOGFONTEX *logical_font;
956 NEWTEXTMETRICEX *physical_font;
957 DWORD font_type;
958 LPARAM list_object;
f7a84cb4
JR		 959{
960 Lisp_Object* list = (Lisp_Object *) list_object;
20a2b756
JR		 961 Lisp_Object family;
962
963 /* Skip vertical fonts (intended only for printing) */
964 if (logical_font->elfLogFont.lfFaceName[0] == '@')
965 return 1;
966
e6df5336 967 family = intern_font_name (logical_font->elfLogFont.lfFaceName);
f7a84cb4
JR		 968 if (! memq_no_quit (family, *list))
969 *list = Fcons (family, *list);
970
971 return 1;
972}
973
5f18d119
KH		 974static int w32_decode_weight P_ ((int));
975static int w32_encode_weight P_ ((int));
976
f7a84cb4 977/* Convert an enumerated Windows font to an Emacs font entity. */
20399669 978static Lisp_Object
91583281 979w32_enumfont_pattern_entity (frame, logical_font, physical_font,
34fd2d28 980 font_type, requested_font, backend)
d205d43b 981 Lisp_Object frame;
20399669
JR		 982 ENUMLOGFONTEX *logical_font;
983 NEWTEXTMETRICEX *physical_font;
984 DWORD font_type;
91583281 985 LOGFONT *requested_font;
34fd2d28 986 Lisp_Object backend;
f7a84cb4
JR		 987{
988 Lisp_Object entity, tem;
989 LOGFONT *lf = (LOGFONT*) logical_font;
990 BYTE generic_type;
56df6710 991 DWORD full_type = physical_font->ntmTm.ntmFlags;
f7a84cb4 992
5f18d119 993 entity = font_make_entity ();
f7a84cb4 994
34fd2d28 995 ASET (entity, FONT_TYPE_INDEX, backend);
c960bff8 996 ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
f7a84cb4
JR		 997 ASET (entity, FONT_OBJLIST_INDEX, Qnil);
998
999 /* Foundry is difficult to get in readable form on Windows.
d205d43b 1000 But Emacs crashes if it is not set, so set it to something more
9c623c85 1001 generic. These values make xlfds compatible with Emacs 22. */
d205d43b
JR		 1002 if (lf->lfOutPrecision == OUT_STRING_PRECIS)
1003 tem = Qraster;
1004 else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
1005 tem = Qoutline;
1006 else
1007 tem = Qunknown;
1008
1009 ASET (entity, FONT_FOUNDRY_INDEX, tem);
1010
1011 /* Save the generic family in the extra info, as it is likely to be
1012 useful to users looking for a close match. */
f7a84cb4
JR		 1013 generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0;
1014 if (generic_type == FF_DECORATIVE)
1015 tem = Qdecorative;
1016 else if (generic_type == FF_MODERN)
9e1a2995 1017 tem = Qmono;
f7a84cb4 1018 else if (generic_type == FF_ROMAN)
d205d43b 1019 tem = Qserif;
f7a84cb4
JR		 1020 else if (generic_type == FF_SCRIPT)
1021 tem = Qscript;
1022 else if (generic_type == FF_SWISS)
9e1a2995 1023 tem = Qsans;
f7a84cb4 1024 else
5f18d119 1025 tem = Qnil;
9e1a2995
JR		 1026
1027 ASET (entity, FONT_ADSTYLE_INDEX, tem);
f7a84cb4 1028
d205d43b 1029 if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
5f18d119 1030 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL));
d205d43b 1031 else
ed18e612 1032 ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL));
f7a84cb4 1033
91583281
JR		 1034 if (requested_font->lfQuality != DEFAULT_QUALITY)
1035 {
1036 font_put_extra (entity, QCantialias,
1037 lispy_antialias_type (requested_font->lfQuality));
1038 }
f7a84cb4 1039 ASET (entity, FONT_FAMILY_INDEX,
e6df5336 1040 intern_font_name (lf->lfFaceName));
f7a84cb4 1041
5f18d119
KH		 1042 FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
1043 make_number (w32_decode_weight (lf->lfWeight)));
1044 FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
1045 make_number (lf->lfItalic ? 200 : 100));
d205d43b
JR		 1046 /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
1047 to get it. */
5f18d119 1048 FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100));
f7a84cb4 1049
040fe918 1050 if (font_type & RASTER_FONTTYPE)
597634cb
JR		 1051 ASET (entity, FONT_SIZE_INDEX,
1052 make_number (physical_font->ntmTm.tmHeight
1053 + physical_font->ntmTm.tmExternalLeading));
040fe918
JR		 1054 else
1055 ASET (entity, FONT_SIZE_INDEX, make_number (0));
f7a84cb4
JR		 1056
1057 /* Cache unicode codepoints covered by this font, as there is no other way
1058 of getting this information easily. */
040fe918 1059 if (font_type & TRUETYPE_FONTTYPE)
f7a84cb4 1060 {
aee986fd
JR		 1061 tem = font_supported_scripts (&physical_font->ntmFontSig);
1062 if (!NILP (tem))
1063 font_put_extra (entity, QCscript, tem);
f7a84cb4 1064 }
d205d43b 1065
34fd2d28
JR		 1066 /* This information is not fully available when opening fonts, so
1067 save it here. Only Windows 2000 and later return information
1068 about opentype and type1 fonts, so need a fallback for detecting
1069 truetype so that this information is not any worse than we could
1070 have obtained later. */
56df6710
JR		 1071 if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
1072 tem = intern ("opentype");
1073 else if (font_type & TRUETYPE_FONTTYPE)
34fd2d28 1074 tem = intern ("truetype");
34fd2d28
JR		 1075 else if (full_type & NTM_PS_OPENTYPE)
1076 tem = intern ("postscript");
56df6710
JR		 1077 else if (full_type & NTM_TYPE1)
1078 tem = intern ("type1");
34fd2d28
JR		 1079 else if (font_type & RASTER_FONTTYPE)
1080 tem = intern ("w32bitmap");
1081 else
1082 tem = intern ("w32vector");
1083
1084 font_put_extra (entity, QCformat, tem);
1085
f7a84cb4
JR		 1086 return entity;
1087}
1088
d205d43b
JR		 1089
1090/* Convert generic families to the family portion of lfPitchAndFamily. */
1091BYTE
1092w32_generic_family (Lisp_Object name)
1093{
1094 /* Generic families. */
1095 if (EQ (name, Qmonospace) || EQ (name, Qmono))
1096 return FF_MODERN;
9e1a2995 1097 else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif))
d205d43b
JR		 1098 return FF_SWISS;
1099 else if (EQ (name, Qserif))
1100 return FF_ROMAN;
1101 else if (EQ (name, Qdecorative))
1102 return FF_DECORATIVE;
1103 else if (EQ (name, Qscript))
1104 return FF_SCRIPT;
1105 else
1106 return FF_DONTCARE;
1107}
1108
1109static int
1110logfonts_match (font, pattern)
1111 LOGFONT *font, *pattern;
1112{
1113 /* Only check height for raster fonts. */
1114 if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS
1115 && font->lfHeight != pattern->lfHeight)
1116 return 0;
1117
1118 /* Have some flexibility with weights. */
1119 if (pattern->lfWeight
1120 && ((font->lfWeight < (pattern->lfWeight - 150))
1121 || font->lfWeight > (pattern->lfWeight + 150)))
1122 return 0;
1123
1124 /* Charset and face should be OK. Italic has to be checked
1125 against the original spec, in case we don't have any preference. */
1126 return 1;
1127}
1128
4c100a01
JR		 1129/* Codepage Bitfields in FONTSIGNATURE struct. */
1130#define CSB_JAPANESE (1 << 17)
1131#define CSB_KOREAN ((1 << 19) | (1 << 21))
1132#define CSB_CHINESE ((1 << 18) | (1 << 20))
1133
d205d43b 1134static int
56df6710 1135font_matches_spec (type, font, spec, backend, logfont)
d205d43b
JR		 1136 DWORD type;
1137 NEWTEXTMETRICEX *font;
1138 Lisp_Object spec;
56df6710
JR		 1139 Lisp_Object backend;
1140 LOGFONT *logfont;
d205d43b
JR		 1141{
1142 Lisp_Object extra, val;
1143
1144 /* Check italic. Can't check logfonts, since it is a boolean field,
1145 so there is no difference between "non-italic" and "don't care". */
5f18d119
KH		 1146 {
1147 int slant = FONT_SLANT_NUMERIC (spec);
1148
1149 if (slant >= 0
1150 && ((slant > 150 && !font->ntmTm.tmItalic)
1151 || (slant <= 150 && font->ntmTm.tmItalic)))
1152 return 0;
1153 }
d205d43b 1154
4f2a2ee2
JR		 1155 /* Check adstyle against generic family. */
1156 val = AREF (spec, FONT_ADSTYLE_INDEX);
1157 if (!NILP (val))
1158 {
1159 BYTE family = w32_generic_family (val);
1160 if (family != FF_DONTCARE
1161 && family != (font->ntmTm.tmPitchAndFamily & 0xF0))
1162 return 0;
1163 }
1164
5f18d119
KH		 1165 /* Check spacing */
1166 val = AREF (spec, FONT_SPACING_INDEX);
1167 if (INTEGERP (val))
1168 {
1169 int spacing = XINT (val);
1170 int proportional = (spacing < FONT_SPACING_MONO);
1171
1172 if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
1173 || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
1174 return 0;
1175 }
1176
d205d43b
JR		 1177 /* Check extra parameters. */
1178 for (extra = AREF (spec, FONT_EXTRA_INDEX);
1179 CONSP (extra); extra = XCDR (extra))
1180 {
1181 Lisp_Object extra_entry;
1182 extra_entry = XCAR (extra);
1183 if (CONSP (extra_entry))
1184 {
1185 Lisp_Object key = XCAR (extra_entry);
d205d43b 1186
5f18d119
KH		 1187 val = XCDR (extra_entry);
1188 if (EQ (key, QCscript) && SYMBOLP (val))
d205d43b
JR		 1189 {
1190 /* Only truetype fonts will have information about what
1191 scripts they support. This probably means the user
1192 will have to force Emacs to use raster, postscript
1193 or atm fonts for non-ASCII text. */
1194 if (type & TRUETYPE_FONTTYPE)
1195 {
1196 Lisp_Object support
1197 = font_supported_scripts (&font->ntmFontSig);
1198 if (! memq_no_quit (val, support))
1199 return 0;
1200 }
1201 else
1202 {
1203 /* Return specific matches, but play it safe. Fonts
1204 that cover more than their charset would suggest
1205 are likely to be truetype or opentype fonts,
1206 covered above. */
1207 if (EQ (val, Qlatin))
1208 {
1209 /* Although every charset but symbol, thai and
1210 arabic contains the basic ASCII set of latin
1211 characters, Emacs expects much more. */
1212 if (font->ntmTm.tmCharSet != ANSI_CHARSET)
1213 return 0;
1214 }
1215 else if (EQ (val, Qsymbol))
1216 {
1217 if (font->ntmTm.tmCharSet != SYMBOL_CHARSET)
1218 return 0;
1219 }
1220 else if (EQ (val, Qcyrillic))
1221 {
1222 if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET)
1223 return 0;
1224 }
1225 else if (EQ (val, Qgreek))
1226 {
1227 if (font->ntmTm.tmCharSet != GREEK_CHARSET)
1228 return 0;
1229 }
1230 else if (EQ (val, Qarabic))
1231 {
1232 if (font->ntmTm.tmCharSet != ARABIC_CHARSET)
1233 return 0;
1234 }
1235 else if (EQ (val, Qhebrew))
1236 {
1237 if (font->ntmTm.tmCharSet != HEBREW_CHARSET)
1238 return 0;
1239 }
1240 else if (EQ (val, Qthai))
1241 {
1242 if (font->ntmTm.tmCharSet != THAI_CHARSET)
1243 return 0;
1244 }
1245 else if (EQ (val, Qkana))
1246 {
1247 if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1248 return 0;
1249 }
1250 else if (EQ (val, Qbopomofo))
1251 {
1252 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET)
1253 return 0;
1254 }
1255 else if (EQ (val, Qhangul))
1256 {
1257 if (font->ntmTm.tmCharSet != HANGUL_CHARSET
1258 && font->ntmTm.tmCharSet != JOHAB_CHARSET)
1259 return 0;
1260 }
1261 else if (EQ (val, Qhan))
1262 {
1263 if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET
1264 && font->ntmTm.tmCharSet != GB2312_CHARSET
1265 && font->ntmTm.tmCharSet != HANGUL_CHARSET
1266 && font->ntmTm.tmCharSet != JOHAB_CHARSET
1267 && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET)
1268 return 0;
1269 }
1270 else
56df6710
JR		 1271 /* Other scripts unlikely to be handled by non-truetype
1272 fonts. */
d205d43b
JR		 1273 return 0;
1274 }
1275 }
5f18d119 1276 else if (EQ (key, QClang) && SYMBOLP (val))
8f112d52 1277 {
4c100a01 1278 /* Just handle the CJK languages here, as the lang
8f112d52
JR		 1279 parameter is used to select a font with appropriate
1280 glyphs in the cjk unified ideographs block. Other fonts
1281 support for a language can be solely determined by
1282 its character coverage. */
1283 if (EQ (val, Qja))
1284 {
4c100a01 1285 if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
8f112d52
JR		 1286 return 0;
1287 }
1288 else if (EQ (val, Qko))
1289 {
4c100a01 1290 if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
8f112d52
JR		 1291 return 0;
1292 }
1293 else if (EQ (val, Qzh))
1294 {
4c100a01
JR		 1295 if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
1296 return 0;
8f112d52
JR		 1297 }
1298 else
4c100a01
JR		 1299 /* Any other language, we don't recognize it. Only the above
1300 currently appear in fontset.el, so it isn't worth
1301 creating a mapping table of codepages/scripts to languages
1302 or opening the font to see if there are any language tags
1303 in it that the W32 API does not expose. Fontset
8f112d52
JR		 1304 spec should have a fallback, as some backends do
1305 not recognize language at all. */
1306 return 0;
1307 }
56df6710
JR		 1308 else if (EQ (key, QCotf) && CONSP (val))
1309 {
1310 /* OTF features only supported by the uniscribe backend. */
1311 if (EQ (backend, Quniscribe))
1312 {
1313 if (!uniscribe_check_otf (logfont, val))
1314 return 0;
1315 }
1316 else
1317 return 0;
1318 }
d205d43b
JR		 1319 }
1320 }
1321 return 1;
1322}
1323
c960bff8
JR		 1324static int
1325w32font_coverage_ok (coverage, charset)
1326 FONTSIGNATURE * coverage;
1327 BYTE charset;
1328{
1329 DWORD subrange1 = coverage->fsUsb[1];
1330
1331#define SUBRANGE1_HAN_MASK 0x08000000
1332#define SUBRANGE1_HANGEUL_MASK 0x01000000
1333#define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK)
1334
1335 if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET)
1336 {
1337 return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK;
1338 }
1339 else if (charset == SHIFTJIS_CHARSET)
1340 {
1341 return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK;
1342 }
1343 else if (charset == HANGEUL_CHARSET)
1344 {
1345 return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK;
1346 }
1347
1348 return 1;
1349}
1350
b0857706
JR		 1351
1352static int
1353check_face_name (font, full_name)
1354 LOGFONT *font;
1355 char *full_name;
1356{
1357 char full_iname[LF_FULLFACESIZE+1];
1358
1359 /* Just check for names known to cause problems, since the full name
1360 can contain expanded abbreviations, prefixed foundry, postfixed
1361 style, the latter of which sometimes differs from the style indicated
1362 in the shorter name (eg Lt becomes Light or even Extra Light) */
1363
1364 /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
1365 installed, we run into problems with the Uniscribe backend which tries
1366 to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
1367 with Arial's characteristics, since that attempt to use Truetype works
1368 some places, but not others. */
c285743c 1369 if (!xstrcasecmp (font->lfFaceName, "helvetica"))
b0857706
JR		 1370 {
1371 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1372 full_iname[LF_FULLFACESIZE] = 0;
1373 _strlwr (full_iname);
c285743c 1374 return strstr ("helvetica", full_iname) != NULL;
b0857706 1375 }
631ea4fb
JR		 1376 /* Same for Helv. */
1377 if (!xstrcasecmp (font->lfFaceName, "helv"))
1378 {
1379 strncpy (full_iname, full_name, LF_FULLFACESIZE);
1380 full_iname[LF_FULLFACESIZE] = 0;
1381 _strlwr (full_iname);
1382 return strstr ("helv", full_iname) != NULL;
1383 }
c285743c
JR		 1384
1385 /* Since Times is mapped to Times New Roman, a substring
1386 match is not sufficient to filter out the bogus match. */
1387 else if (!xstrcasecmp (font->lfFaceName, "times"))
1388 return xstrcasecmp (full_name, "times") == 0;
b0857706
JR		 1389
1390 return 1;
1391}
1392
1393
f7a84cb4 1394/* Callback function for EnumFontFamiliesEx.
d205d43b
JR		 1395 * Checks if a font matches everything we are trying to check agaist,
1396 * and if so, adds it to a list. Both the data we are checking against
1397 * and the list to which the fonts are added are passed in via the
1398 * lparam argument, in the form of a font_callback_data struct. */
20399669 1399static int CALLBACK
d205d43b 1400add_font_entity_to_list (logical_font, physical_font, font_type, lParam)
20399669
JR		 1401 ENUMLOGFONTEX *logical_font;
1402 NEWTEXTMETRICEX *physical_font;
1403 DWORD font_type;
d205d43b 1404 LPARAM lParam;
f7a84cb4 1405{
d205d43b
JR		 1406 struct font_callback_data *match_data
1407 = (struct font_callback_data *) lParam;
56df6710 1408 Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
19ae3e61
JR		 1409 Lisp_Object entity;
1410
1411 int is_unicode = physical_font->ntmFontSig.fsUsb[3]
1412 || physical_font->ntmFontSig.fsUsb[2]
1413 || physical_font->ntmFontSig.fsUsb[1]
1414 || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
1415
1416 /* Skip non matching fonts. */
1417
1418 /* For uniscribe backend, consider only truetype or opentype fonts
1419 that have some unicode coverage. */
1420 if (match_data->opentype_only
1421 && ((!physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE
1422 && !(font_type & TRUETYPE_FONTTYPE))
1423 || !is_unicode))
1424 return 1;
1425
1426 /* Ensure a match. */
1427 if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
1428 || !font_matches_spec (font_type, physical_font,
1429 match_data->orig_font_spec, backend,
1430 &logical_font->elfLogFont)
1431 || !w32font_coverage_ok (&physical_font->ntmFontSig,
1432 match_data->pattern.lfCharSet))
1433 return 1;
f7a84cb4 1434
19ae3e61
JR		 1435 /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
1436 We limit this to raster fonts, because the test can catch some
1437 genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
1438 DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
1439 therefore get through this test. Since full names can be prefixed
1440 by a foundry, we accept raster fonts if the font name is found
1441 anywhere within the full name. */
1442 if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
c73abf54
JR		 1443 && !strstr (logical_font->elfFullName,
1444 logical_font->elfLogFont.lfFaceName))
b0857706
JR		 1445 /* Check for well known substitutions that mess things up in the
1446 presence of Type-1 fonts of the same name. */
631ea4fb
JR		 1447 || (!check_face_name (&logical_font->elfLogFont,
1448 logical_font->elfFullName)))
19ae3e61
JR		 1449 return 1;
1450
1451 /* Make a font entity for the font. */
1452 entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
1453 physical_font, font_type,
1454 &match_data->pattern,
1455 backend);
1456
1457 if (!NILP (entity))
d205d43b 1458 {
19ae3e61
JR		 1459 Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
1460 FONT_REGISTRY_INDEX);
1461
1462 /* iso10646-1 fonts must contain unicode mapping tables. */
1463 if (EQ (spec_charset, Qiso10646_1))
1464 {
1465 if (!is_unicode)
9d32f818 1466 return 1;
19ae3e61
JR		 1467 }
1468 /* unicode-bmp fonts must contain characters from the BMP. */
1469 else if (EQ (spec_charset, Qunicode_bmp))
1470 {
1471 if (!physical_font->ntmFontSig.fsUsb[3]
1472 && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
1473 && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
1474 && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
1475 return 1;
1476 }
1477 /* unicode-sip fonts must contain characters in unicode plane 2.
1478 so look for bit 57 (surrogates) in the Unicode subranges, plus
1479 the bits for CJK ranges that include those characters. */
1480 else if (EQ (spec_charset, Qunicode_sip))
1481 {
1482 if (!physical_font->ntmFontSig.fsUsb[1] & 0x02000000
1483 || !physical_font->ntmFontSig.fsUsb[1] & 0x28000000)
1484 return 1;
1485 }
1486
1487 /* This font matches. */
1488
1489 /* If registry was specified, ensure it is reported as the same. */
1490 if (!NILP (spec_charset))
1491 ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
1492
1493 /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
1494 fonts as unicode and skip other charsets. */
1495 else if (match_data->opentype_only)
1496 {
1497 if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
1498 || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
1499 ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
1500 else
1501 return 1;
1502 }
1503
1504 /* Add this font to the list. */
1505 match_data->list = Fcons (entity, match_data->list);
d205d43b 1506 }
f7a84cb4
JR		 1507 return 1;
1508}
1509
1510/* Callback function for EnumFontFamiliesEx.
d205d43b 1511 * Terminates the search once we have a match. */
20399669 1512static int CALLBACK
d205d43b 1513add_one_font_entity_to_list (logical_font, physical_font, font_type, lParam)
20399669
JR		 1514 ENUMLOGFONTEX *logical_font;
1515 NEWTEXTMETRICEX *physical_font;
1516 DWORD font_type;
d205d43b 1517 LPARAM lParam;
f7a84cb4 1518{
d205d43b
JR		 1519 struct font_callback_data *match_data
1520 = (struct font_callback_data *) lParam;
1521 add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
1522
1523 /* If we have a font in the list, terminate the search. */
4624b6e3 1524 return NILP (match_data->list);
f7a84cb4
JR		 1525}
1526
57016d37
JR		 1527/* Old function to convert from x to w32 charset, from w32fns.c. */
1528static LONG
1529x_to_w32_charset (lpcs)
1530 char * lpcs;
1531{
1532 Lisp_Object this_entry, w32_charset;
1533 char *charset;
1534 int len = strlen (lpcs);
1535
1536 /* Support "*-#nnn" format for unknown charsets. */
1537 if (strncmp (lpcs, "*-#", 3) == 0)
1538 return atoi (lpcs + 3);
1539
1540 /* All Windows fonts qualify as unicode. */
1541 if (!strncmp (lpcs, "iso10646", 8))
1542 return DEFAULT_CHARSET;
1543
1544 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
1545 charset = alloca (len + 1);
1546 strcpy (charset, lpcs);
1547 lpcs = strchr (charset, '*');
1548 if (lpcs)
1549 *lpcs = '\0';
1550
1551 /* Look through w32-charset-info-alist for the character set.
1552 Format of each entry is
1553 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1554 */
1555 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
1556
1557 if (NILP (this_entry))
1558 {
1559 /* At startup, we want iso8859-1 fonts to come up properly. */
1560 if (xstrcasecmp (charset, "iso8859-1") == 0)
1561 return ANSI_CHARSET;
1562 else
1563 return DEFAULT_CHARSET;
1564 }
1565
1566 w32_charset = Fcar (Fcdr (this_entry));
1567
1568 /* Translate Lisp symbol to number. */
1569 if (EQ (w32_charset, Qw32_charset_ansi))
1570 return ANSI_CHARSET;
1571 if (EQ (w32_charset, Qw32_charset_symbol))
1572 return SYMBOL_CHARSET;
1573 if (EQ (w32_charset, Qw32_charset_shiftjis))
1574 return SHIFTJIS_CHARSET;
1575 if (EQ (w32_charset, Qw32_charset_hangeul))
1576 return HANGEUL_CHARSET;
1577 if (EQ (w32_charset, Qw32_charset_chinesebig5))
1578 return CHINESEBIG5_CHARSET;
1579 if (EQ (w32_charset, Qw32_charset_gb2312))
1580 return GB2312_CHARSET;
1581 if (EQ (w32_charset, Qw32_charset_oem))
1582 return OEM_CHARSET;
1583 if (EQ (w32_charset, Qw32_charset_johab))
1584 return JOHAB_CHARSET;
1585 if (EQ (w32_charset, Qw32_charset_easteurope))
1586 return EASTEUROPE_CHARSET;
1587 if (EQ (w32_charset, Qw32_charset_turkish))
1588 return TURKISH_CHARSET;
1589 if (EQ (w32_charset, Qw32_charset_baltic))
1590 return BALTIC_CHARSET;
1591 if (EQ (w32_charset, Qw32_charset_russian))
1592 return RUSSIAN_CHARSET;
1593 if (EQ (w32_charset, Qw32_charset_arabic))
1594 return ARABIC_CHARSET;
1595 if (EQ (w32_charset, Qw32_charset_greek))
1596 return GREEK_CHARSET;
1597 if (EQ (w32_charset, Qw32_charset_hebrew))
1598 return HEBREW_CHARSET;
1599 if (EQ (w32_charset, Qw32_charset_vietnamese))
1600 return VIETNAMESE_CHARSET;
1601 if (EQ (w32_charset, Qw32_charset_thai))
1602 return THAI_CHARSET;
1603 if (EQ (w32_charset, Qw32_charset_mac))
1604 return MAC_CHARSET;
1605
1606 return DEFAULT_CHARSET;
1607}
1608
1609
f7a84cb4 1610/* Convert a Lisp font registry (symbol) to a windows charset. */
20399669
JR		 1611static LONG
1612registry_to_w32_charset (charset)
1613 Lisp_Object charset;
f7a84cb4
JR		 1614{
1615 if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp)
1616 || EQ (charset, Qunicode_sip))
1617 return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */
1618 else if (EQ (charset, Qiso8859_1))
1619 return ANSI_CHARSET;
040fe918
JR		 1620 else if (SYMBOLP (charset))
1621 return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
f7a84cb4
JR		 1622 else
1623 return DEFAULT_CHARSET;
1624}
1625
57016d37
JR		 1626/* Old function to convert from w32 to x charset, from w32fns.c. */
1627static char *
1628w32_to_x_charset (fncharset, matching)
1629 int fncharset;
1630 char *matching;
1631{
1632 static char buf[32];
1633 Lisp_Object charset_type;
1634 int match_len = 0;
1635
1636 if (matching)
1637 {
1638 /* If fully specified, accept it as it is. Otherwise use a
1639 substring match. */
1640 char *wildcard = strchr (matching, '*');
1641 if (wildcard)
1642 *wildcard = '\0';
1643 else if (strchr (matching, '-'))
1644 return matching;
1645
1646 match_len = strlen (matching);
1647 }
1648
1649 switch (fncharset)
1650 {
1651 case ANSI_CHARSET:
1652 /* Handle startup case of w32-charset-info-alist not
1653 being set up yet. */
1654 if (NILP (Vw32_charset_info_alist))
1655 return "iso8859-1";
1656 charset_type = Qw32_charset_ansi;
1657 break;
1658 case DEFAULT_CHARSET:
1659 charset_type = Qw32_charset_default;
1660 break;
1661 case SYMBOL_CHARSET:
1662 charset_type = Qw32_charset_symbol;
1663 break;
1664 case SHIFTJIS_CHARSET:
1665 charset_type = Qw32_charset_shiftjis;
1666 break;
1667 case HANGEUL_CHARSET:
1668 charset_type = Qw32_charset_hangeul;
1669 break;
1670 case GB2312_CHARSET:
1671 charset_type = Qw32_charset_gb2312;
1672 break;
1673 case CHINESEBIG5_CHARSET:
1674 charset_type = Qw32_charset_chinesebig5;
1675 break;
1676 case OEM_CHARSET:
1677 charset_type = Qw32_charset_oem;
1678 break;
1679 case EASTEUROPE_CHARSET:
1680 charset_type = Qw32_charset_easteurope;
1681 break;
1682 case TURKISH_CHARSET:
1683 charset_type = Qw32_charset_turkish;
1684 break;
1685 case BALTIC_CHARSET:
1686 charset_type = Qw32_charset_baltic;
1687 break;
1688 case RUSSIAN_CHARSET:
1689 charset_type = Qw32_charset_russian;
1690 break;
1691 case ARABIC_CHARSET:
1692 charset_type = Qw32_charset_arabic;
1693 break;
1694 case GREEK_CHARSET:
1695 charset_type = Qw32_charset_greek;
1696 break;
1697 case HEBREW_CHARSET:
1698 charset_type = Qw32_charset_hebrew;
1699 break;
1700 case VIETNAMESE_CHARSET:
1701 charset_type = Qw32_charset_vietnamese;
1702 break;
1703 case THAI_CHARSET:
1704 charset_type = Qw32_charset_thai;
1705 break;
1706 case MAC_CHARSET:
1707 charset_type = Qw32_charset_mac;
1708 break;
1709 case JOHAB_CHARSET:
1710 charset_type = Qw32_charset_johab;
1711 break;
1712
1713 default:
1714 /* Encode numerical value of unknown charset. */
1715 sprintf (buf, "*-#%u", fncharset);
1716 return buf;
1717 }
1718
1719 {
1720 Lisp_Object rest;
1721 char * best_match = NULL;
1722 int matching_found = 0;
1723
1724 /* Look through w32-charset-info-alist for the character set.
1725 Prefer ISO codepages, and prefer lower numbers in the ISO
1726 range. Only return charsets for codepages which are installed.
1727
1728 Format of each entry is
1729 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1730 */
1731 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
1732 {
1733 char * x_charset;
1734 Lisp_Object w32_charset;
1735 Lisp_Object codepage;
1736
1737 Lisp_Object this_entry = XCAR (rest);
1738
1739 /* Skip invalid entries in alist. */
1740 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
1741 || !CONSP (XCDR (this_entry))
1742 || !SYMBOLP (XCAR (XCDR (this_entry))))
1743 continue;
1744
1745 x_charset = SDATA (XCAR (this_entry));
1746 w32_charset = XCAR (XCDR (this_entry));
1747 codepage = XCDR (XCDR (this_entry));
1748
1749 /* Look for Same charset and a valid codepage (or non-int
1750 which means ignore). */
1751 if (EQ (w32_charset, charset_type)
1752 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
1753 || IsValidCodePage (XINT (codepage))))
1754 {
1755 /* If we don't have a match already, then this is the
1756 best. */
1757 if (!best_match)
1758 {
1759 best_match = x_charset;
1760 if (matching && !strnicmp (x_charset, matching, match_len))
1761 matching_found = 1;
1762 }
1763 /* If we already found a match for MATCHING, then
1764 only consider other matches. */
1765 else if (matching_found
1766 && strnicmp (x_charset, matching, match_len))
1767 continue;
1768 /* If this matches what we want, and the best so far doesn't,
1769 then this is better. */
1770 else if (!matching_found && matching
1771 && !strnicmp (x_charset, matching, match_len))
1772 {
1773 best_match = x_charset;
1774 matching_found = 1;
1775 }
1776 /* If this is fully specified, and the best so far isn't,
1777 then this is better. */
1778 else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
1779 /* If this is an ISO codepage, and the best so far isn't,
1780 then this is better, but only if it fully specifies the
1781 encoding. */
1782 || (strnicmp (best_match, "iso", 3) != 0
1783 && strnicmp (x_charset, "iso", 3) == 0
1784 && strchr (x_charset, '-')))
1785 best_match = x_charset;
1786 /* If both are ISO8859 codepages, choose the one with the
1787 lowest number in the encoding field. */
1788 else if (strnicmp (best_match, "iso8859-", 8) == 0
1789 && strnicmp (x_charset, "iso8859-", 8) == 0)
1790 {
1791 int best_enc = atoi (best_match + 8);
1792 int this_enc = atoi (x_charset + 8);
1793 if (this_enc > 0 && this_enc < best_enc)
1794 best_match = x_charset;
1795 }
1796 }
1797 }
1798
1799 /* If no match, encode the numeric value. */
1800 if (!best_match)
1801 {
1802 sprintf (buf, "*-#%u", fncharset);
1803 return buf;
1804 }
1805
1806 strncpy (buf, best_match, 31);
1807 /* If the charset is not fully specified, put -0 on the end. */
1808 if (!strchr (best_match, '-'))
1809 {
1810 int pos = strlen (best_match);
1811 /* Charset specifiers shouldn't be very long. If it is a made
1812 up one, truncating it should not do any harm since it isn't
1813 recognized anyway. */
1814 if (pos > 29)
1815 pos = 29;
1816 strcpy (buf + pos, "-0");
1817 }
1818 buf[31] = '\0';
1819 return buf;
1820 }
1821}
1822
20399669 1823static Lisp_Object
c960bff8 1824w32_registry (w32_charset, font_type)
20399669 1825 LONG w32_charset;
c960bff8 1826 DWORD font_type;
f7a84cb4 1827{
aee986fd
JR		 1828 char *charset;
1829
1830 /* If charset is defaulted, charset is unicode or unknown, depending on
1831 font type. */
c960bff8 1832 if (w32_charset == DEFAULT_CHARSET)
aee986fd 1833 return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
c960bff8 1834
aee986fd 1835 charset = w32_to_x_charset (w32_charset, NULL);
9d4f32e8 1836 return font_intern_prop (charset, strlen (charset), 1);
f7a84cb4
JR		 1837}
1838
5f18d119
KH		 1839static int
1840w32_decode_weight (fnweight)
1841 int fnweight;
1842{
1843 if (fnweight >= FW_HEAVY) return 210;
1844 if (fnweight >= FW_EXTRABOLD) return 205;
1845 if (fnweight >= FW_BOLD) return 200;
1846 if (fnweight >= FW_SEMIBOLD) return 180;
1847 if (fnweight >= FW_NORMAL) return 100;
1848 if (fnweight >= FW_LIGHT) return 50;
1849 if (fnweight >= FW_EXTRALIGHT) return 40;
9d4f32e8 1850 if (fnweight > FW_THIN) return 20;
5f18d119
KH		 1851 return 0;
1852}
1853
1854static int
1855w32_encode_weight (n)
1856 int n;
1857{
1858 if (n >= 210) return FW_HEAVY;
1859 if (n >= 205) return FW_EXTRABOLD;
1860 if (n >= 200) return FW_BOLD;
1861 if (n >= 180) return FW_SEMIBOLD;
1862 if (n >= 100) return FW_NORMAL;
1863 if (n >= 50) return FW_LIGHT;
1864 if (n >= 40) return FW_EXTRALIGHT;
9d4f32e8 1865 if (n >= 20) return FW_THIN;
5f18d119
KH		 1866 return 0;
1867}
1868
3ef8c1b4
JR		 1869/* Convert a Windows font weight into one of the weights supported
1870 by fontconfig (see font.c:font_parse_fcname). */
1871static Lisp_Object
1872w32_to_fc_weight (n)
1873 int n;
1874{
1875 if (n >= FW_EXTRABOLD) return intern ("black");
9d4f32e8
JB		 1876 if (n >= FW_BOLD) return intern ("bold");
1877 if (n >= FW_SEMIBOLD) return intern ("demibold");
1878 if (n >= FW_NORMAL) return intern ("medium");
3ef8c1b4
JR		 1879 return intern ("light");
1880}
1881
f7a84cb4 1882/* Fill in all the available details of LOGFONT from FONT_SPEC. */
20399669
JR		 1883static void
1884fill_in_logfont (f, logfont, font_spec)
1885 FRAME_PTR f;
1886 LOGFONT *logfont;
1887 Lisp_Object font_spec;
f7a84cb4 1888{
d205d43b 1889 Lisp_Object tmp, extra;
f7a84cb4
JR		 1890 int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
1891
5f18d119
KH		 1892 tmp = AREF (font_spec, FONT_DPI_INDEX);
1893 if (INTEGERP (tmp))
d205d43b 1894 {
5f18d119
KH		 1895 dpi = XINT (tmp);
1896 }
1897 else if (FLOATP (tmp))
1898 {
1899 dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
d205d43b 1900 }
f7a84cb4
JR		 1901
1902 /* Height */
1903 tmp = AREF (font_spec, FONT_SIZE_INDEX);
1904 if (INTEGERP (tmp))
040fe918 1905 logfont->lfHeight = -1 * XINT (tmp);
f7a84cb4 1906 else if (FLOATP (tmp))
d205d43b 1907 logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5);
f7a84cb4
JR		 1908
1909 /* Escapement */
1910
1911 /* Orientation */
1912
1913 /* Weight */
1914 tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
1915 if (INTEGERP (tmp))
5f18d119 1916 logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
f7a84cb4
JR		 1917
1918 /* Italic */
1919 tmp = AREF (font_spec, FONT_SLANT_INDEX);
1920 if (INTEGERP (tmp))
1921 {
5f18d119 1922 int slant = FONT_SLANT_NUMERIC (font_spec);
f7a84cb4
JR		 1923 logfont->lfItalic = slant > 150 ? 1 : 0;
1924 }
1925
1926 /* Underline */
1927
1928 /* Strikeout */
1929
1930 /* Charset */
1931 tmp = AREF (font_spec, FONT_REGISTRY_INDEX);
1932 if (! NILP (tmp))
d205d43b 1933 logfont->lfCharSet = registry_to_w32_charset (tmp);
56df6710
JR		 1934 else
1935 logfont->lfCharSet = DEFAULT_CHARSET;
f7a84cb4
JR		 1936
1937 /* Out Precision */
91583281 1938
f7a84cb4 1939 /* Clip Precision */
91583281
JR		 1940
1941 /* Quality */
040fe918
JR		 1942 logfont->lfQuality = DEFAULT_QUALITY;
1943
d205d43b
JR		 1944 /* Generic Family and Face Name */
1945 logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH;
1946
f7a84cb4 1947 tmp = AREF (font_spec, FONT_FAMILY_INDEX);
d205d43b
JR		 1948 if (! NILP (tmp))
1949 {
1950 logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH;
1951 if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE)
1952 ; /* Font name was generic, don't fill in font name. */
1953 /* Font families are interned, but allow for strings also in case of
1954 user input. */
1955 else if (SYMBOLP (tmp))
e6df5336
JR		 1956 strncpy (logfont->lfFaceName,
1957 SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
d205d43b 1958 }
f7a84cb4 1959
9e1a2995
JR		 1960 tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
1961 if (!NILP (tmp))
1962 {
1963 /* Override generic family. */
1964 BYTE family = w32_generic_family (tmp);
1965 if (family != FF_DONTCARE)
1966 logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
1967 }
1968
5f18d119
KH		 1969 /* Set pitch based on the spacing property. */
1970 tmp = AREF (font_spec, FONT_SPACING_INDEX);
1971 if (INTEGERP (tmp))
1972 {
1973 int spacing = XINT (tmp);
1974 if (spacing < FONT_SPACING_MONO)
1975 logfont->lfPitchAndFamily
1976 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
1977 else
1978 logfont->lfPitchAndFamily
1979 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
1980 }
1981
d205d43b 1982 /* Process EXTRA info. */
5f18d119
KH		 1983 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
1984 CONSP (extra); extra = XCDR (extra))
d205d43b
JR		 1985 {
1986 tmp = XCAR (extra);
1987 if (CONSP (tmp))
1988 {
1989 Lisp_Object key, val;
1990 key = XCAR (tmp), val = XCDR (tmp);
d205d43b
JR		 1991 /* Only use QCscript if charset is not provided, or is unicode
1992 and a single script is specified. This is rather crude,
1993 and is only used to narrow down the fonts returned where
1994 there is a definite match. Some scripts, such as latin, han,
1995 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1996 them. */
5f18d119 1997 if (EQ (key, QCscript)
d205d43b
JR		 1998 && logfont->lfCharSet == DEFAULT_CHARSET
1999 && SYMBOLP (val))
2000 {
2001 if (EQ (val, Qgreek))
2002 logfont->lfCharSet = GREEK_CHARSET;
2003 else if (EQ (val, Qhangul))
2004 logfont->lfCharSet = HANGUL_CHARSET;
2005 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
2006 logfont->lfCharSet = SHIFTJIS_CHARSET;
2007 else if (EQ (val, Qbopomofo))
2008 logfont->lfCharSet = CHINESEBIG5_CHARSET;
2009 /* GB 18030 supports tibetan, yi, mongolian,
2010 fonts that support it should show up if we ask for
2011 GB2312 fonts. */
2012 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
2013 || EQ (val, Qmongolian))
2014 logfont->lfCharSet = GB2312_CHARSET;
2015 else if (EQ (val, Qhebrew))
2016 logfont->lfCharSet = HEBREW_CHARSET;
2017 else if (EQ (val, Qarabic))
2018 logfont->lfCharSet = ARABIC_CHARSET;
2019 else if (EQ (val, Qthai))
2020 logfont->lfCharSet = THAI_CHARSET;
d205d43b 2021 }
91583281
JR		 2022 else if (EQ (key, QCantialias) && SYMBOLP (val))
2023 {
2024 logfont->lfQuality = w32_antialias_type (val);
2025 }
d205d43b
JR		 2026 }
2027 }
f7a84cb4
JR		 2028}
2029
20399669 2030static void
d205d43b
JR		 2031list_all_matching_fonts (match_data)
2032 struct font_callback_data *match_data;
f7a84cb4
JR		 2033{
2034 HDC dc;
d205d43b
JR		 2035 Lisp_Object families = w32font_list_family (match_data->frame);
2036 struct frame *f = XFRAME (match_data->frame);
f7a84cb4
JR		 2037
2038 dc = get_frame_dc (f);
2039
2040 while (!NILP (families))
2041 {
e6df5336
JR		 2042 /* Only fonts from the current locale are given localized names
2043 on Windows, so we can keep backwards compatibility with
2044 Windows 9x/ME by using non-Unicode font enumeration without
2045 sacrificing internationalization here. */
d205d43b 2046 char *name;
f7a84cb4
JR		 2047 Lisp_Object family = CAR (families);
2048 families = CDR (families);
d205d43b
JR		 2049 if (NILP (family))
2050 continue;
8f112d52 2051 else if (SYMBOLP (family))
e6df5336 2052 name = SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
8f112d52
JR		 2053 else
2054 continue;
d205d43b
JR		 2055
2056 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2057 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2058
2059 EnumFontFamiliesEx (dc, &match_data->pattern,
2060 (FONTENUMPROC) add_font_entity_to_list,
2061 (LPARAM) match_data, 0);
f7a84cb4
JR		 2062 }
2063
2064 release_frame_dc (f, dc);
2065}
2066
91583281
JR		 2067static Lisp_Object
2068lispy_antialias_type (type)
2069 BYTE type;
2070{
2071 Lisp_Object lispy;
2072
2073 switch (type)
2074 {
2075 case NONANTIALIASED_QUALITY:
2076 lispy = Qnone;
2077 break;
2078 case ANTIALIASED_QUALITY:
2079 lispy = Qstandard;
2080 break;
2081 case CLEARTYPE_QUALITY:
2082 lispy = Qsubpixel;
2083 break;
2084 case CLEARTYPE_NATURAL_QUALITY:
2085 lispy = Qnatural;
2086 break;
2087 default:
2088 lispy = Qnil;
2089 break;
2090 }
2091 return lispy;
2092}
2093
2094/* Convert antialiasing symbols to lfQuality */
2095static BYTE
2096w32_antialias_type (type)
2097 Lisp_Object type;
2098{
2099 if (EQ (type, Qnone))
2100 return NONANTIALIASED_QUALITY;
2101 else if (EQ (type, Qstandard))
2102 return ANTIALIASED_QUALITY;
2103 else if (EQ (type, Qsubpixel))
2104 return CLEARTYPE_QUALITY;
2105 else if (EQ (type, Qnatural))
2106 return CLEARTYPE_NATURAL_QUALITY;
2107 else
2108 return DEFAULT_QUALITY;
2109}
2110
d205d43b
JR		 2111/* Return a list of all the scripts that the font supports. */
2112static Lisp_Object
2113font_supported_scripts (FONTSIGNATURE * sig)
f7a84cb4 2114{
d205d43b
JR		 2115 DWORD * subranges = sig->fsUsb;
2116 Lisp_Object supported = Qnil;
2117
2118 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2119#define SUBRANGE(n,sym) \
2120 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2121 supported = Fcons ((sym), supported)
2122
2123 /* Match multiple subranges. SYM is set if any MASK bit is set in
2124 subranges[0 - 3]. */
2125#define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2126 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2127 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2128 supported = Fcons ((sym), supported)
2129
56df6710
JR		 2130 SUBRANGE (0, Qlatin);
2131 /* The following count as latin too, ASCII should be present in these fonts,
2132 so don't need to mark them separately. */
2133 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2134 SUBRANGE (4, Qphonetic);
2135 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
d205d43b
JR		 2136 SUBRANGE (7, Qgreek);
2137 SUBRANGE (8, Qcoptic);
2138 SUBRANGE (9, Qcyrillic);
2139 SUBRANGE (10, Qarmenian);
2140 SUBRANGE (11, Qhebrew);
174f1c74 2141 /* 12: Vai. */
d205d43b
JR		 2142 SUBRANGE (13, Qarabic);
2143 SUBRANGE (14, Qnko);
2144 SUBRANGE (15, Qdevanagari);
2145 SUBRANGE (16, Qbengali);
2146 SUBRANGE (17, Qgurmukhi);
2147 SUBRANGE (18, Qgujarati);
2148 SUBRANGE (19, Qoriya);
2149 SUBRANGE (20, Qtamil);
2150 SUBRANGE (21, Qtelugu);
2151 SUBRANGE (22, Qkannada);
2152 SUBRANGE (23, Qmalayalam);
2153 SUBRANGE (24, Qthai);
2154 SUBRANGE (25, Qlao);
2155 SUBRANGE (26, Qgeorgian);
56df6710
JR		 2156 SUBRANGE (27, Qbalinese);
2157 /* 28: Hangul Jamo. */
2158 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2159 /* 32-47: Symbols (defined below). */
d205d43b 2160 SUBRANGE (48, Qcjk_misc);
56df6710
JR		 2161 /* Match either 49: katakana or 50: hiragana for kana. */
2162 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
d205d43b 2163 SUBRANGE (51, Qbopomofo);
56df6710
JR		 2164 /* 52: Compatibility Jamo */
2165 SUBRANGE (53, Qphags_pa);
2166 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
d205d43b 2167 SUBRANGE (56, Qhangul);
56df6710
JR		 2168 /* 57: Surrogates. */
2169 SUBRANGE (58, Qphoenician);
d205d43b 2170 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
56df6710
JR		 2171 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2172 SUBRANGE (59, Qkanbun); /* And this. */
2173 /* 60: Private use, 61: CJK strokes and compatibility. */
2174 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2175 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2176 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2177 /* 69: Specials. */
d205d43b
JR		 2178 SUBRANGE (70, Qtibetan);
2179 SUBRANGE (71, Qsyriac);
2180 SUBRANGE (72, Qthaana);
2181 SUBRANGE (73, Qsinhala);
2182 SUBRANGE (74, Qmyanmar);
2183 SUBRANGE (75, Qethiopic);
2184 SUBRANGE (76, Qcherokee);
2185 SUBRANGE (77, Qcanadian_aboriginal);
2186 SUBRANGE (78, Qogham);
2187 SUBRANGE (79, Qrunic);
2188 SUBRANGE (80, Qkhmer);
2189 SUBRANGE (81, Qmongolian);
2190 SUBRANGE (82, Qbraille);
2191 SUBRANGE (83, Qyi);
56df6710
JR		 2192 SUBRANGE (84, Qbuhid);
2193 SUBRANGE (84, Qhanunoo);
2194 SUBRANGE (84, Qtagalog);
2195 SUBRANGE (84, Qtagbanwa);
2196 SUBRANGE (85, Qold_italic);
2197 SUBRANGE (86, Qgothic);
2198 SUBRANGE (87, Qdeseret);
d205d43b
JR		 2199 SUBRANGE (88, Qbyzantine_musical_symbol);
2200 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
d205d43b 2201 SUBRANGE (89, Qmathematical);
56df6710
JR		 2202 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2203 SUBRANGE (93, Qlimbu);
2204 SUBRANGE (94, Qtai_le);
2205 /* 95: New Tai Le */
2206 SUBRANGE (90, Qbuginese);
2207 SUBRANGE (97, Qglagolitic);
2208 SUBRANGE (98, Qtifinagh);
2209 /* 99: Yijing Hexagrams. */
2210 SUBRANGE (100, Qsyloti_nagri);
2211 SUBRANGE (101, Qlinear_b);
2212 /* 102: Ancient Greek Numbers. */
2213 SUBRANGE (103, Qugaritic);
2214 SUBRANGE (104, Qold_persian);
2215 SUBRANGE (105, Qshavian);
2216 SUBRANGE (106, Qosmanya);
2217 SUBRANGE (107, Qcypriot);
2218 SUBRANGE (108, Qkharoshthi);
2219 /* 109: Tai Xuan Jing. */
2220 SUBRANGE (110, Qcuneiform);
174f1c74
JR		 2221 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2222 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2223 SUBRANGE (118, Qcham);
2224 /* 119: Ancient symbols, 120: Phaistos Disc. */
2225 /* 121: Carian, Lycian, Lydian, 122: Dominos, Mah Jong tiles. */
2226 /* 123-127: Reserved. */
d205d43b
JR		 2227
2228 /* There isn't really a main symbol range, so include symbol if any
2229 relevant range is set. */
2230 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2231
174f1c74 2232 /* Missing: Tai Viet (U+AA80-U+AADF). */
d205d43b
JR		 2233#undef SUBRANGE
2234#undef MASK_ANY
2235
2236 return supported;
f7a84cb4
JR		 2237}
2238
67997c79
JR		 2239/* Generate a full name for a Windows font.
2240 The full name is in fcname format, with weight, slant and antialiasing
2241 specified if they are not "normal". */
2242static int
2243w32font_full_name (font, font_obj, pixel_size, name, nbytes)
2244 LOGFONT * font;
2245 Lisp_Object font_obj;
2246 int pixel_size;
2247 char *name;
2248 int nbytes;
2249{
a823468b 2250 int len, height, outline;
67997c79
JR		 2251 char *p;
2252 Lisp_Object antialiasing, weight = Qnil;
2253
a823468b
JR		 2254 len = strlen (font->lfFaceName);
2255
2256 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2257
2258 /* Represent size of scalable fonts by point size. But use pixelsize for
2259 raster fonts to indicate that they are exactly that size. */
2260 if (outline)
2261 len += 11; /* -SIZE */
2262 else
6fe9826d 2263 len += 21;
67997c79
JR		 2264
2265 if (font->lfItalic)
2266 len += 7; /* :italic */
2267
2268 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2269 {
3ef8c1b4
JR		 2270 weight = w32_to_fc_weight (font->lfWeight);
2271 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
67997c79
JR		 2272 }
2273
2274 antialiasing = lispy_antialias_type (font->lfQuality);
2275 if (! NILP (antialiasing))
2276 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2277
2278 /* Check that the buffer is big enough */
2279 if (len > nbytes)
2280 return -1;
2281
2282 p = name;
2283 p += sprintf (p, "%s", font->lfFaceName);
2284
a823468b
JR		 2285 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2286
2287 if (height > 0)
2288 {
2289 if (outline)
2290 {
2291 float pointsize = height * 72.0 / one_w32_display_info.resy;
7145be81
JR		 2292 /* Round to nearest half point. floor is used, since round is not
2293 supported in MS library. */
2294 pointsize = floor (pointsize * 2 + 0.5) / 2;
a823468b
JR		 2295 p += sprintf (p, "-%1.1f", pointsize);
2296 }
2297 else
2298 p += sprintf (p, ":pixelsize=%d", height);
2299 }
67997c79 2300
3ef8c1b4
JR		 2301 if (SYMBOLP (weight) && ! NILP (weight))
2302 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2303
67997c79
JR		 2304 if (font->lfItalic)
2305 p += sprintf (p, ":italic");
2306
67997c79
JR		 2307 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2308 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2309
2310 return (p - name);
2311}
f7a84cb4 2312
6fe9826d
JR		 2313/* Convert a logfont and point size into a fontconfig style font name.
2314 POINTSIZE is in tenths of points.
2315 If SIZE indicates the size of buffer FCNAME, into which the font name
2316 is written. If the buffer is not large enough to contain the name,
2317 the function returns -1, otherwise it returns the number of bytes
2318 written to FCNAME. */
9d4f32e8
JB		 2319static int
2320logfont_to_fcname (font, pointsize, fcname, size)
6fe9826d
JR		 2321 LOGFONT* font;
2322 int pointsize;
2323 char *fcname;
2324 int size;
2325{
2326 int len, height;
2327 char *p = fcname;
2328 Lisp_Object weight = Qnil;
2329
2330 len = strlen (font->lfFaceName) + 2;
2331 height = pointsize / 10;
2332 while (height /= 10)
2333 len++;
2334
2335 if (pointsize % 10)
2336 len += 2;
2337
2338 if (font->lfItalic)
2339 len += 7; /* :italic */
2340 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2341 {
3ef8c1b4
JR		 2342 weight = w32_to_fc_weight (font->lfWeight);
2343 len += SBYTES (SYMBOL_NAME (weight)) + 1;
6fe9826d
JR		 2344 }
2345
2346 if (len > size)
2347 return -1;
2348
2349 p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
2350 if (pointsize % 10)
2351 p += sprintf (p, ".%d", pointsize % 10);
2352
3ef8c1b4
JR		 2353 if (SYMBOLP (weight) && !NILP (weight))
2354 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2355
6fe9826d
JR		 2356 if (font->lfItalic)
2357 p += sprintf (p, ":italic");
2358
6fe9826d
JR		 2359 return (p - fcname);
2360}
34fd2d28 2361
9c623c85
JB		 2362static void
2363compute_metrics (dc, w32_font, code, metrics)
34fd2d28 2364 HDC dc;
54efdcd1 2365 struct w32font_info *w32_font;
8f112d52
JR		 2366 unsigned int code;
2367 struct w32_metric_cache *metrics;
34fd2d28
JR		 2368{
2369 GLYPHMETRICS gm;
2370 MAT2 transform;
8f112d52
JR		 2371 unsigned int options = GGO_METRICS;
2372
2373 if (w32_font->glyph_idx)
2374 options |= GGO_GLYPH_INDEX;
34fd2d28
JR		 2375
2376 bzero (&transform, sizeof (transform));
2377 transform.eM11.value = 1;
2378 transform.eM22.value = 1;
8f112d52
JR		 2379
2380 if (GetGlyphOutlineW (dc, code, options, &gm, 0, NULL, &transform)
2381 != GDI_ERROR)
2382 {
2383 metrics->lbearing = gm.gmptGlyphOrigin.x;
2384 metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
2385 metrics->width = gm.gmCellIncX;
2386 metrics->status = W32METRIC_SUCCESS;
2387 }
9c623c85
JB		 2388 else
2389 metrics->status = W32METRIC_FAIL;
34fd2d28
JR		 2390}
2391
6fe9826d
JR		 2392DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
2393 doc: /* Read a font name using a W32 font selection dialog.
2394Return fontconfig style font string corresponding to the selection.
2395
2396If FRAME is omitted or nil, it defaults to the selected frame.
1ada3dab 2397If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
6fe9826d 2398in the font selection dialog. */)
1ada3dab
JR		 2399 (frame, exclude_proportional)
2400 Lisp_Object frame, exclude_proportional;
6fe9826d
JR		 2401{
2402 FRAME_PTR f = check_x_frame (frame);
2403 CHOOSEFONT cf;
2404 LOGFONT lf;
2405 TEXTMETRIC tm;
2406 HDC hdc;
2407 HANDLE oldobj;
2408 char buf[100];
2409
2410 bzero (&cf, sizeof (cf));
2411 bzero (&lf, sizeof (lf));
2412
2413 cf.lStructSize = sizeof (cf);
2414 cf.hwndOwner = FRAME_W32_WINDOW (f);
2415 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
2416
1ada3dab 2417 /* If exclude_proportional is non-nil, limit the selection to
6fe9826d 2418 monospaced fonts. */
1ada3dab 2419 if (!NILP (exclude_proportional))
6fe9826d
JR		 2420 cf.Flags |= CF_FIXEDPITCHONLY;
2421
2422 cf.lpLogFont = &lf;
2423
2424 /* Initialize as much of the font details as we can from the current
2425 default font. */
2426 hdc = GetDC (FRAME_W32_WINDOW (f));
c35f9821 2427 oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
6fe9826d
JR		 2428 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
2429 if (GetTextMetrics (hdc, &tm))
2430 {
2431 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
2432 lf.lfWeight = tm.tmWeight;
2433 lf.lfItalic = tm.tmItalic;
2434 lf.lfUnderline = tm.tmUnderlined;
2435 lf.lfStrikeOut = tm.tmStruckOut;
2436 lf.lfCharSet = tm.tmCharSet;
2437 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
2438 }
2439 SelectObject (hdc, oldobj);
2440 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
2441
2442 if (!ChooseFont (&cf)
2443 || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
2444 return Qnil;
2445
e6df5336 2446 return DECODE_SYSTEM (build_string (buf));
6fe9826d
JR		 2447}
2448
9fa82824
DP		 2449static const char *w32font_booleans [] = {
2450 NULL,
2451};
2452
2453static const char *w32font_non_booleans [] = {
2454 ":script",
2455 ":antialias",
2456 ":style",
2457 NULL,
2458};
2459
2460static void
2461w32font_filter_properties (font, alist)
2462 Lisp_Object font;
2463 Lisp_Object alist;
2464{
2465 font_filter_properties (font, alist, w32font_booleans, w32font_non_booleans);
2466}
2467
f7a84cb4
JR		 2468struct font_driver w32font_driver =
2469 {
8eac0c84 2470 0, /* Qgdi */
5f18d119 2471 0, /* case insensitive */
f7a84cb4
JR		 2472 w32font_get_cache,
2473 w32font_list,
2474 w32font_match,
2475 w32font_list_family,
2476 NULL, /* free_entity */
2477 w32font_open,
2478 w32font_close,
2479 NULL, /* prepare_face */
2480 NULL, /* done_face */
2481 w32font_has_char,
2482 w32font_encode_char,
2483 w32font_text_extents,
2484 w32font_draw,
2485 NULL, /* get_bitmap */
2486 NULL, /* free_bitmap */
2487 NULL, /* get_outline */
2488 NULL, /* free_outline */
2489 NULL, /* anchor_point */
2490 NULL, /* otf_capability */
5b0c3446
JR		 2491 NULL, /* otf_drive */
2492 NULL, /* start_for_frame */
2493 NULL, /* end_for_frame */
637fa988
JD		 2494 NULL, /* shape */
2495 NULL, /* check */
2496 NULL, /* get_variation_glyphs */
9fa82824 2497 w32font_filter_properties,
f7a84cb4
JR		 2498 };
2499
f7a84cb4
JR		 2500
2501/* Initialize state that does not change between invocations. This is only
2502 called when Emacs is dumped. */
20399669
JR		 2503void
2504syms_of_w32font ()
f7a84cb4 2505{
8eac0c84 2506 DEFSYM (Qgdi, "gdi");
34fd2d28
JR		 2507 DEFSYM (Quniscribe, "uniscribe");
2508 DEFSYM (QCformat, ":format");
d205d43b
JR		 2509
2510 /* Generic font families. */
2511 DEFSYM (Qmonospace, "monospace");
2512 DEFSYM (Qserif, "serif");
9e1a2995 2513 DEFSYM (Qsansserif, "sansserif");
f7a84cb4 2514 DEFSYM (Qscript, "script");
d205d43b
JR		 2515 DEFSYM (Qdecorative, "decorative");
2516 /* Aliases. */
9e1a2995 2517 DEFSYM (Qsans_serif, "sans_serif");
d205d43b
JR		 2518 DEFSYM (Qsans, "sans");
2519 DEFSYM (Qmono, "mono");
2520
2521 /* Fake foundries. */
2522 DEFSYM (Qraster, "raster");
2523 DEFSYM (Qoutline, "outline");
f7a84cb4 2524 DEFSYM (Qunknown, "unknown");
d205d43b 2525
91583281
JR		 2526 /* Antialiasing. */
2527 DEFSYM (Qstandard, "standard");
2528 DEFSYM (Qsubpixel, "subpixel");
2529 DEFSYM (Qnatural, "natural");
d205d43b 2530
8f112d52 2531 /* Languages */
8f112d52
JR		 2532 DEFSYM (Qzh, "zh");
2533
d205d43b
JR		 2534 /* Scripts */
2535 DEFSYM (Qlatin, "latin");
2536 DEFSYM (Qgreek, "greek");
2537 DEFSYM (Qcoptic, "coptic");
2538 DEFSYM (Qcyrillic, "cyrillic");
2539 DEFSYM (Qarmenian, "armenian");
2540 DEFSYM (Qhebrew, "hebrew");
2541 DEFSYM (Qarabic, "arabic");
2542 DEFSYM (Qsyriac, "syriac");
2543 DEFSYM (Qnko, "nko");
2544 DEFSYM (Qthaana, "thaana");
2545 DEFSYM (Qdevanagari, "devanagari");
2546 DEFSYM (Qbengali, "bengali");
2547 DEFSYM (Qgurmukhi, "gurmukhi");
2548 DEFSYM (Qgujarati, "gujarati");
2549 DEFSYM (Qoriya, "oriya");
2550 DEFSYM (Qtamil, "tamil");
2551 DEFSYM (Qtelugu, "telugu");
2552 DEFSYM (Qkannada, "kannada");
2553 DEFSYM (Qmalayalam, "malayalam");
2554 DEFSYM (Qsinhala, "sinhala");
2555 DEFSYM (Qthai, "thai");
2556 DEFSYM (Qlao, "lao");
2557 DEFSYM (Qtibetan, "tibetan");
2558 DEFSYM (Qmyanmar, "myanmar");
2559 DEFSYM (Qgeorgian, "georgian");
2560 DEFSYM (Qhangul, "hangul");
2561 DEFSYM (Qethiopic, "ethiopic");
2562 DEFSYM (Qcherokee, "cherokee");
2563 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2564 DEFSYM (Qogham, "ogham");
2565 DEFSYM (Qrunic, "runic");
2566 DEFSYM (Qkhmer, "khmer");
2567 DEFSYM (Qmongolian, "mongolian");
2568 DEFSYM (Qsymbol, "symbol");
2569 DEFSYM (Qbraille, "braille");
2570 DEFSYM (Qhan, "han");
2571 DEFSYM (Qideographic_description, "ideographic-description");
2572 DEFSYM (Qcjk_misc, "cjk-misc");
2573 DEFSYM (Qkana, "kana");
2574 DEFSYM (Qbopomofo, "bopomofo");
2575 DEFSYM (Qkanbun, "kanbun");
2576 DEFSYM (Qyi, "yi");
2577 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2578 DEFSYM (Qmusical_symbol, "musical-symbol");
2579 DEFSYM (Qmathematical, "mathematical");
174f1c74 2580 DEFSYM (Qcham, "cham");
56df6710
JR		 2581 DEFSYM (Qphonetic, "phonetic");
2582 DEFSYM (Qbalinese, "balinese");
2583 DEFSYM (Qbuginese, "buginese");
2584 DEFSYM (Qbuhid, "buhid");
2585 DEFSYM (Qcuneiform, "cuneiform");
2586 DEFSYM (Qcypriot, "cypriot");
2587 DEFSYM (Qdeseret, "deseret");
2588 DEFSYM (Qglagolitic, "glagolitic");
2589 DEFSYM (Qgothic, "gothic");
2590 DEFSYM (Qhanunoo, "hanunoo");
2591 DEFSYM (Qkharoshthi, "kharoshthi");
2592 DEFSYM (Qlimbu, "limbu");
2593 DEFSYM (Qlinear_b, "linear_b");
2594 DEFSYM (Qold_italic, "old_italic");
2595 DEFSYM (Qold_persian, "old_persian");
2596 DEFSYM (Qosmanya, "osmanya");
2597 DEFSYM (Qphags_pa, "phags-pa");
2598 DEFSYM (Qphoenician, "phoenician");
2599 DEFSYM (Qshavian, "shavian");
2600 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2601 DEFSYM (Qtagalog, "tagalog");
2602 DEFSYM (Qtagbanwa, "tagbanwa");
2603 DEFSYM (Qtai_le, "tai_le");
2604 DEFSYM (Qtifinagh, "tifinagh");
2605 DEFSYM (Qugaritic, "ugaritic");
d205d43b 2606
57016d37
JR		 2607 /* W32 font encodings. */
2608 DEFVAR_LISP ("w32-charset-info-alist",
2609 &Vw32_charset_info_alist,
2610 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2611Each entry should be of the form:
2612
2613 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2614
2615where CHARSET_NAME is a string used in font names to identify the charset,
2616WINDOWS_CHARSET is a symbol that can be one of:
2617
2618 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2619 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2620 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2621 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2622 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2623 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2624 or w32-charset-oem.
2625
2626CODEPAGE should be an integer specifying the codepage that should be used
2627to display the character set, t to do no translation and output as Unicode,
2628or nil to do no translation and output as 8 bit (or multibyte on far-east
2629versions of Windows) characters. */);
2630 Vw32_charset_info_alist = Qnil;
2631
2632 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2633 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2634 DEFSYM (Qw32_charset_default, "w32-charset-default");
2635 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2636 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2637 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2638 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2639 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2640 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2641 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2642 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2643 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2644 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2645 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2646 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2647 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2648 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2649 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2650 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2651
6fe9826d
JR		 2652 defsubr (&Sx_select_font);
2653
8eac0c84 2654 w32font_driver.type = Qgdi;
f7a84cb4
JR		 2655 register_font_driver (&w32font_driver, NULL);
2656}
6d8c85b5
MB		 2657
2658/* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2659 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.