HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Handle system default font and changing font parameters.
[bpt/emacs.git] / src / w32font.c
CommitLineData
f7a84cb4 1/* Font backend for the Microsoft W32 API.
76b6f707 2 Copyright (C) 2007, 2008, 2009 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.
349 Return a glyph code of FONT for characer 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);
571 if (!GetClipRgn(s->hdc, orig_clip))
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);
4cb35b63 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;
1850 if (fnweight > FW_THIN) return 20;
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;
1865 if (n >= 20) return FW_THIN;
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");
1876 if (n >= FW_BOLD) return intern ("bold");
1877 if (n >= FW_SEMIBOLD) return intern ("demibold");
1878 if (n >= FW_NORMAL) return intern ("medium");
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
9c623c85 1969
5f18d119
KH		 1970 /* Set pitch based on the spacing property. */
1971 tmp = AREF (font_spec, FONT_SPACING_INDEX);
1972 if (INTEGERP (tmp))
1973 {
1974 int spacing = XINT (tmp);
1975 if (spacing < FONT_SPACING_MONO)
1976 logfont->lfPitchAndFamily
1977 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
1978 else
1979 logfont->lfPitchAndFamily
1980 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
1981 }
1982
d205d43b 1983 /* Process EXTRA info. */
5f18d119
KH		 1984 for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
1985 CONSP (extra); extra = XCDR (extra))
d205d43b
JR		 1986 {
1987 tmp = XCAR (extra);
1988 if (CONSP (tmp))
1989 {
1990 Lisp_Object key, val;
1991 key = XCAR (tmp), val = XCDR (tmp);
d205d43b
JR		 1992 /* Only use QCscript if charset is not provided, or is unicode
1993 and a single script is specified. This is rather crude,
1994 and is only used to narrow down the fonts returned where
1995 there is a definite match. Some scripts, such as latin, han,
1996 cjk-misc match multiple lfCharSet values, so we can't pre-filter
1997 them. */
5f18d119 1998 if (EQ (key, QCscript)
d205d43b
JR		 1999 && logfont->lfCharSet == DEFAULT_CHARSET
2000 && SYMBOLP (val))
2001 {
2002 if (EQ (val, Qgreek))
2003 logfont->lfCharSet = GREEK_CHARSET;
2004 else if (EQ (val, Qhangul))
2005 logfont->lfCharSet = HANGUL_CHARSET;
2006 else if (EQ (val, Qkana) || EQ (val, Qkanbun))
2007 logfont->lfCharSet = SHIFTJIS_CHARSET;
2008 else if (EQ (val, Qbopomofo))
2009 logfont->lfCharSet = CHINESEBIG5_CHARSET;
2010 /* GB 18030 supports tibetan, yi, mongolian,
2011 fonts that support it should show up if we ask for
2012 GB2312 fonts. */
2013 else if (EQ (val, Qtibetan) || EQ (val, Qyi)
2014 || EQ (val, Qmongolian))
2015 logfont->lfCharSet = GB2312_CHARSET;
2016 else if (EQ (val, Qhebrew))
2017 logfont->lfCharSet = HEBREW_CHARSET;
2018 else if (EQ (val, Qarabic))
2019 logfont->lfCharSet = ARABIC_CHARSET;
2020 else if (EQ (val, Qthai))
2021 logfont->lfCharSet = THAI_CHARSET;
d205d43b 2022 }
91583281
JR		 2023 else if (EQ (key, QCantialias) && SYMBOLP (val))
2024 {
2025 logfont->lfQuality = w32_antialias_type (val);
2026 }
d205d43b
JR		 2027 }
2028 }
f7a84cb4
JR		 2029}
2030
20399669 2031static void
d205d43b
JR		 2032list_all_matching_fonts (match_data)
2033 struct font_callback_data *match_data;
f7a84cb4
JR		 2034{
2035 HDC dc;
d205d43b
JR		 2036 Lisp_Object families = w32font_list_family (match_data->frame);
2037 struct frame *f = XFRAME (match_data->frame);
f7a84cb4
JR		 2038
2039 dc = get_frame_dc (f);
2040
2041 while (!NILP (families))
2042 {
e6df5336
JR		 2043 /* Only fonts from the current locale are given localized names
2044 on Windows, so we can keep backwards compatibility with
2045 Windows 9x/ME by using non-Unicode font enumeration without
2046 sacrificing internationalization here. */
d205d43b 2047 char *name;
f7a84cb4
JR		 2048 Lisp_Object family = CAR (families);
2049 families = CDR (families);
d205d43b
JR		 2050 if (NILP (family))
2051 continue;
8f112d52 2052 else if (SYMBOLP (family))
e6df5336 2053 name = SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
8f112d52
JR		 2054 else
2055 continue;
d205d43b
JR		 2056
2057 strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
2058 match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
2059
2060 EnumFontFamiliesEx (dc, &match_data->pattern,
2061 (FONTENUMPROC) add_font_entity_to_list,
2062 (LPARAM) match_data, 0);
f7a84cb4
JR		 2063 }
2064
2065 release_frame_dc (f, dc);
2066}
2067
91583281
JR		 2068static Lisp_Object
2069lispy_antialias_type (type)
2070 BYTE type;
2071{
2072 Lisp_Object lispy;
2073
2074 switch (type)
2075 {
2076 case NONANTIALIASED_QUALITY:
2077 lispy = Qnone;
2078 break;
2079 case ANTIALIASED_QUALITY:
2080 lispy = Qstandard;
2081 break;
2082 case CLEARTYPE_QUALITY:
2083 lispy = Qsubpixel;
2084 break;
2085 case CLEARTYPE_NATURAL_QUALITY:
2086 lispy = Qnatural;
2087 break;
2088 default:
2089 lispy = Qnil;
2090 break;
2091 }
2092 return lispy;
2093}
2094
2095/* Convert antialiasing symbols to lfQuality */
2096static BYTE
2097w32_antialias_type (type)
2098 Lisp_Object type;
2099{
2100 if (EQ (type, Qnone))
2101 return NONANTIALIASED_QUALITY;
2102 else if (EQ (type, Qstandard))
2103 return ANTIALIASED_QUALITY;
2104 else if (EQ (type, Qsubpixel))
2105 return CLEARTYPE_QUALITY;
2106 else if (EQ (type, Qnatural))
2107 return CLEARTYPE_NATURAL_QUALITY;
2108 else
2109 return DEFAULT_QUALITY;
2110}
2111
d205d43b
JR		 2112/* Return a list of all the scripts that the font supports. */
2113static Lisp_Object
2114font_supported_scripts (FONTSIGNATURE * sig)
f7a84cb4 2115{
d205d43b
JR		 2116 DWORD * subranges = sig->fsUsb;
2117 Lisp_Object supported = Qnil;
2118
2119 /* Match a single subrange. SYM is set if bit N is set in subranges. */
2120#define SUBRANGE(n,sym) \
2121 if (subranges[(n) / 32] & (1 << ((n) % 32))) \
2122 supported = Fcons ((sym), supported)
2123
2124 /* Match multiple subranges. SYM is set if any MASK bit is set in
2125 subranges[0 - 3]. */
2126#define MASK_ANY(mask0,mask1,mask2,mask3,sym) \
2127 if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \
2128 || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \
2129 supported = Fcons ((sym), supported)
2130
56df6710
JR		 2131 SUBRANGE (0, Qlatin);
2132 /* The following count as latin too, ASCII should be present in these fonts,
2133 so don't need to mark them separately. */
2134 /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
2135 SUBRANGE (4, Qphonetic);
2136 /* 5: Spacing and tone modifiers, 6: Combining Diacriticals. */
d205d43b
JR		 2137 SUBRANGE (7, Qgreek);
2138 SUBRANGE (8, Qcoptic);
2139 SUBRANGE (9, Qcyrillic);
2140 SUBRANGE (10, Qarmenian);
2141 SUBRANGE (11, Qhebrew);
174f1c74 2142 /* 12: Vai. */
d205d43b
JR		 2143 SUBRANGE (13, Qarabic);
2144 SUBRANGE (14, Qnko);
2145 SUBRANGE (15, Qdevanagari);
2146 SUBRANGE (16, Qbengali);
2147 SUBRANGE (17, Qgurmukhi);
2148 SUBRANGE (18, Qgujarati);
2149 SUBRANGE (19, Qoriya);
2150 SUBRANGE (20, Qtamil);
2151 SUBRANGE (21, Qtelugu);
2152 SUBRANGE (22, Qkannada);
2153 SUBRANGE (23, Qmalayalam);
2154 SUBRANGE (24, Qthai);
2155 SUBRANGE (25, Qlao);
2156 SUBRANGE (26, Qgeorgian);
56df6710
JR		 2157 SUBRANGE (27, Qbalinese);
2158 /* 28: Hangul Jamo. */
2159 /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
2160 /* 32-47: Symbols (defined below). */
d205d43b 2161 SUBRANGE (48, Qcjk_misc);
56df6710
JR		 2162 /* Match either 49: katakana or 50: hiragana for kana. */
2163 MASK_ANY (0, 0x00060000, 0, 0, Qkana);
d205d43b 2164 SUBRANGE (51, Qbopomofo);
56df6710
JR		 2165 /* 52: Compatibility Jamo */
2166 SUBRANGE (53, Qphags_pa);
2167 /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */
d205d43b 2168 SUBRANGE (56, Qhangul);
56df6710
JR		 2169 /* 57: Surrogates. */
2170 SUBRANGE (58, Qphoenician);
d205d43b 2171 SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
56df6710
JR		 2172 SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
2173 SUBRANGE (59, Qkanbun); /* And this. */
2174 /* 60: Private use, 61: CJK strokes and compatibility. */
2175 /* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
2176 /* 64: Combining half marks, 65: Vertical and CJK compatibility. */
2177 /* 66: Small forms, 67: Arabic Presentation B, 68: Half and Full width. */
2178 /* 69: Specials. */
d205d43b
JR		 2179 SUBRANGE (70, Qtibetan);
2180 SUBRANGE (71, Qsyriac);
2181 SUBRANGE (72, Qthaana);
2182 SUBRANGE (73, Qsinhala);
2183 SUBRANGE (74, Qmyanmar);
2184 SUBRANGE (75, Qethiopic);
2185 SUBRANGE (76, Qcherokee);
2186 SUBRANGE (77, Qcanadian_aboriginal);
2187 SUBRANGE (78, Qogham);
2188 SUBRANGE (79, Qrunic);
2189 SUBRANGE (80, Qkhmer);
2190 SUBRANGE (81, Qmongolian);
2191 SUBRANGE (82, Qbraille);
2192 SUBRANGE (83, Qyi);
56df6710
JR		 2193 SUBRANGE (84, Qbuhid);
2194 SUBRANGE (84, Qhanunoo);
2195 SUBRANGE (84, Qtagalog);
2196 SUBRANGE (84, Qtagbanwa);
2197 SUBRANGE (85, Qold_italic);
2198 SUBRANGE (86, Qgothic);
2199 SUBRANGE (87, Qdeseret);
d205d43b
JR		 2200 SUBRANGE (88, Qbyzantine_musical_symbol);
2201 SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
d205d43b 2202 SUBRANGE (89, Qmathematical);
56df6710
JR		 2203 /* 90: Private use, 91: Variation selectors, 92: Tags. */
2204 SUBRANGE (93, Qlimbu);
2205 SUBRANGE (94, Qtai_le);
2206 /* 95: New Tai Le */
2207 SUBRANGE (90, Qbuginese);
2208 SUBRANGE (97, Qglagolitic);
2209 SUBRANGE (98, Qtifinagh);
2210 /* 99: Yijing Hexagrams. */
2211 SUBRANGE (100, Qsyloti_nagri);
2212 SUBRANGE (101, Qlinear_b);
2213 /* 102: Ancient Greek Numbers. */
2214 SUBRANGE (103, Qugaritic);
2215 SUBRANGE (104, Qold_persian);
2216 SUBRANGE (105, Qshavian);
2217 SUBRANGE (106, Qosmanya);
2218 SUBRANGE (107, Qcypriot);
2219 SUBRANGE (108, Qkharoshthi);
2220 /* 109: Tai Xuan Jing. */
2221 SUBRANGE (110, Qcuneiform);
174f1c74
JR		 2222 /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
2223 /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
2224 SUBRANGE (118, Qcham);
2225 /* 119: Ancient symbols, 120: Phaistos Disc. */
2226 /* 121: Carian, Lycian, Lydian, 122: Dominos, Mah Jong tiles. */
2227 /* 123-127: Reserved. */
d205d43b
JR		 2228
2229 /* There isn't really a main symbol range, so include symbol if any
2230 relevant range is set. */
2231 MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
2232
174f1c74 2233 /* Missing: Tai Viet (U+AA80-U+AADF). */
d205d43b
JR		 2234#undef SUBRANGE
2235#undef MASK_ANY
2236
2237 return supported;
f7a84cb4
JR		 2238}
2239
67997c79
JR		 2240/* Generate a full name for a Windows font.
2241 The full name is in fcname format, with weight, slant and antialiasing
2242 specified if they are not "normal". */
2243static int
2244w32font_full_name (font, font_obj, pixel_size, name, nbytes)
2245 LOGFONT * font;
2246 Lisp_Object font_obj;
2247 int pixel_size;
2248 char *name;
2249 int nbytes;
2250{
a823468b 2251 int len, height, outline;
67997c79
JR		 2252 char *p;
2253 Lisp_Object antialiasing, weight = Qnil;
2254
a823468b
JR		 2255 len = strlen (font->lfFaceName);
2256
2257 outline = EQ (AREF (font_obj, FONT_FOUNDRY_INDEX), Qoutline);
2258
2259 /* Represent size of scalable fonts by point size. But use pixelsize for
2260 raster fonts to indicate that they are exactly that size. */
2261 if (outline)
2262 len += 11; /* -SIZE */
2263 else
6fe9826d 2264 len += 21;
67997c79
JR		 2265
2266 if (font->lfItalic)
2267 len += 7; /* :italic */
2268
2269 if (font->lfWeight && font->lfWeight != FW_NORMAL)
2270 {
3ef8c1b4
JR		 2271 weight = w32_to_fc_weight (font->lfWeight);
2272 len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
67997c79
JR		 2273 }
2274
2275 antialiasing = lispy_antialias_type (font->lfQuality);
2276 if (! NILP (antialiasing))
2277 len += 11 + SBYTES (SYMBOL_NAME (antialiasing)); /* :antialias=NAME */
2278
2279 /* Check that the buffer is big enough */
2280 if (len > nbytes)
2281 return -1;
2282
2283 p = name;
2284 p += sprintf (p, "%s", font->lfFaceName);
2285
a823468b
JR		 2286 height = font->lfHeight ? eabs (font->lfHeight) : pixel_size;
2287
2288 if (height > 0)
2289 {
2290 if (outline)
2291 {
2292 float pointsize = height * 72.0 / one_w32_display_info.resy;
7145be81
JR		 2293 /* Round to nearest half point. floor is used, since round is not
2294 supported in MS library. */
2295 pointsize = floor (pointsize * 2 + 0.5) / 2;
a823468b
JR		 2296 p += sprintf (p, "-%1.1f", pointsize);
2297 }
2298 else
2299 p += sprintf (p, ":pixelsize=%d", height);
2300 }
67997c79 2301
3ef8c1b4
JR		 2302 if (SYMBOLP (weight) && ! NILP (weight))
2303 p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
2304
67997c79
JR		 2305 if (font->lfItalic)
2306 p += sprintf (p, ":italic");
2307
67997c79
JR		 2308 if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
2309 p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
2310
2311 return (p - name);
2312}
f7a84cb4 2313
6fe9826d
JR		 2314/* Convert a logfont and point size into a fontconfig style font name.
2315 POINTSIZE is in tenths of points.
2316 If SIZE indicates the size of buffer FCNAME, into which the font name
2317 is written. If the buffer is not large enough to contain the name,
2318 the function returns -1, otherwise it returns the number of bytes
2319 written to FCNAME. */
2320static int logfont_to_fcname(font, pointsize, fcname, size)
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
f7a84cb4
JR		 2449struct font_driver w32font_driver =
2450 {
8eac0c84 2451 0, /* Qgdi */
5f18d119 2452 0, /* case insensitive */
f7a84cb4
JR		 2453 w32font_get_cache,
2454 w32font_list,
2455 w32font_match,
2456 w32font_list_family,
2457 NULL, /* free_entity */
2458 w32font_open,
2459 w32font_close,
2460 NULL, /* prepare_face */
2461 NULL, /* done_face */
2462 w32font_has_char,
2463 w32font_encode_char,
2464 w32font_text_extents,
2465 w32font_draw,
2466 NULL, /* get_bitmap */
2467 NULL, /* free_bitmap */
2468 NULL, /* get_outline */
2469 NULL, /* free_outline */
2470 NULL, /* anchor_point */
2471 NULL, /* otf_capability */
5b0c3446
JR		 2472 NULL, /* otf_drive */
2473 NULL, /* start_for_frame */
2474 NULL, /* end_for_frame */
637fa988
JD		 2475 NULL, /* shape */
2476 NULL, /* check */
2477 NULL, /* get_variation_glyphs */
2478 NULL, /* filter_properties */
f7a84cb4
JR		 2479 };
2480
f7a84cb4
JR		 2481
2482/* Initialize state that does not change between invocations. This is only
2483 called when Emacs is dumped. */
20399669
JR		 2484void
2485syms_of_w32font ()
f7a84cb4 2486{
8eac0c84 2487 DEFSYM (Qgdi, "gdi");
34fd2d28
JR		 2488 DEFSYM (Quniscribe, "uniscribe");
2489 DEFSYM (QCformat, ":format");
d205d43b
JR		 2490
2491 /* Generic font families. */
2492 DEFSYM (Qmonospace, "monospace");
2493 DEFSYM (Qserif, "serif");
9e1a2995 2494 DEFSYM (Qsansserif, "sansserif");
f7a84cb4 2495 DEFSYM (Qscript, "script");
d205d43b
JR		 2496 DEFSYM (Qdecorative, "decorative");
2497 /* Aliases. */
9e1a2995 2498 DEFSYM (Qsans_serif, "sans_serif");
d205d43b
JR		 2499 DEFSYM (Qsans, "sans");
2500 DEFSYM (Qmono, "mono");
2501
2502 /* Fake foundries. */
2503 DEFSYM (Qraster, "raster");
2504 DEFSYM (Qoutline, "outline");
f7a84cb4 2505 DEFSYM (Qunknown, "unknown");
d205d43b 2506
91583281
JR		 2507 /* Antialiasing. */
2508 DEFSYM (Qstandard, "standard");
2509 DEFSYM (Qsubpixel, "subpixel");
2510 DEFSYM (Qnatural, "natural");
d205d43b 2511
8f112d52 2512 /* Languages */
8f112d52
JR		 2513 DEFSYM (Qzh, "zh");
2514
d205d43b
JR		 2515 /* Scripts */
2516 DEFSYM (Qlatin, "latin");
2517 DEFSYM (Qgreek, "greek");
2518 DEFSYM (Qcoptic, "coptic");
2519 DEFSYM (Qcyrillic, "cyrillic");
2520 DEFSYM (Qarmenian, "armenian");
2521 DEFSYM (Qhebrew, "hebrew");
2522 DEFSYM (Qarabic, "arabic");
2523 DEFSYM (Qsyriac, "syriac");
2524 DEFSYM (Qnko, "nko");
2525 DEFSYM (Qthaana, "thaana");
2526 DEFSYM (Qdevanagari, "devanagari");
2527 DEFSYM (Qbengali, "bengali");
2528 DEFSYM (Qgurmukhi, "gurmukhi");
2529 DEFSYM (Qgujarati, "gujarati");
2530 DEFSYM (Qoriya, "oriya");
2531 DEFSYM (Qtamil, "tamil");
2532 DEFSYM (Qtelugu, "telugu");
2533 DEFSYM (Qkannada, "kannada");
2534 DEFSYM (Qmalayalam, "malayalam");
2535 DEFSYM (Qsinhala, "sinhala");
2536 DEFSYM (Qthai, "thai");
2537 DEFSYM (Qlao, "lao");
2538 DEFSYM (Qtibetan, "tibetan");
2539 DEFSYM (Qmyanmar, "myanmar");
2540 DEFSYM (Qgeorgian, "georgian");
2541 DEFSYM (Qhangul, "hangul");
2542 DEFSYM (Qethiopic, "ethiopic");
2543 DEFSYM (Qcherokee, "cherokee");
2544 DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal");
2545 DEFSYM (Qogham, "ogham");
2546 DEFSYM (Qrunic, "runic");
2547 DEFSYM (Qkhmer, "khmer");
2548 DEFSYM (Qmongolian, "mongolian");
2549 DEFSYM (Qsymbol, "symbol");
2550 DEFSYM (Qbraille, "braille");
2551 DEFSYM (Qhan, "han");
2552 DEFSYM (Qideographic_description, "ideographic-description");
2553 DEFSYM (Qcjk_misc, "cjk-misc");
2554 DEFSYM (Qkana, "kana");
2555 DEFSYM (Qbopomofo, "bopomofo");
2556 DEFSYM (Qkanbun, "kanbun");
2557 DEFSYM (Qyi, "yi");
2558 DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
2559 DEFSYM (Qmusical_symbol, "musical-symbol");
2560 DEFSYM (Qmathematical, "mathematical");
174f1c74 2561 DEFSYM (Qcham, "cham");
56df6710
JR		 2562 DEFSYM (Qphonetic, "phonetic");
2563 DEFSYM (Qbalinese, "balinese");
2564 DEFSYM (Qbuginese, "buginese");
2565 DEFSYM (Qbuhid, "buhid");
2566 DEFSYM (Qcuneiform, "cuneiform");
2567 DEFSYM (Qcypriot, "cypriot");
2568 DEFSYM (Qdeseret, "deseret");
2569 DEFSYM (Qglagolitic, "glagolitic");
2570 DEFSYM (Qgothic, "gothic");
2571 DEFSYM (Qhanunoo, "hanunoo");
2572 DEFSYM (Qkharoshthi, "kharoshthi");
2573 DEFSYM (Qlimbu, "limbu");
2574 DEFSYM (Qlinear_b, "linear_b");
2575 DEFSYM (Qold_italic, "old_italic");
2576 DEFSYM (Qold_persian, "old_persian");
2577 DEFSYM (Qosmanya, "osmanya");
2578 DEFSYM (Qphags_pa, "phags-pa");
2579 DEFSYM (Qphoenician, "phoenician");
2580 DEFSYM (Qshavian, "shavian");
2581 DEFSYM (Qsyloti_nagri, "syloti_nagri");
2582 DEFSYM (Qtagalog, "tagalog");
2583 DEFSYM (Qtagbanwa, "tagbanwa");
2584 DEFSYM (Qtai_le, "tai_le");
2585 DEFSYM (Qtifinagh, "tifinagh");
2586 DEFSYM (Qugaritic, "ugaritic");
d205d43b 2587
57016d37
JR		 2588 /* W32 font encodings. */
2589 DEFVAR_LISP ("w32-charset-info-alist",
2590 &Vw32_charset_info_alist,
2591 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
2592Each entry should be of the form:
2593
2594 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
2595
2596where CHARSET_NAME is a string used in font names to identify the charset,
2597WINDOWS_CHARSET is a symbol that can be one of:
2598
2599 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
2600 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
2601 w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
2602 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
2603 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
2604 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
2605 or w32-charset-oem.
2606
2607CODEPAGE should be an integer specifying the codepage that should be used
2608to display the character set, t to do no translation and output as Unicode,
2609or nil to do no translation and output as 8 bit (or multibyte on far-east
2610versions of Windows) characters. */);
2611 Vw32_charset_info_alist = Qnil;
2612
2613 DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
2614 DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
2615 DEFSYM (Qw32_charset_default, "w32-charset-default");
2616 DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
2617 DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
2618 DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
2619 DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
2620 DEFSYM (Qw32_charset_oem, "w32-charset-oem");
2621 DEFSYM (Qw32_charset_johab, "w32-charset-johab");
2622 DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
2623 DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
2624 DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
2625 DEFSYM (Qw32_charset_russian, "w32-charset-russian");
2626 DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
2627 DEFSYM (Qw32_charset_greek, "w32-charset-greek");
2628 DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
2629 DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
2630 DEFSYM (Qw32_charset_thai, "w32-charset-thai");
2631 DEFSYM (Qw32_charset_mac, "w32-charset-mac");
2632
6fe9826d
JR		 2633 defsubr (&Sx_select_font);
2634
8eac0c84 2635 w32font_driver.type = Qgdi;
f7a84cb4
JR		 2636 register_font_driver (&w32font_driver, NULL);
2637}
6d8c85b5
MB		 2638
2639/* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
2640 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.