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