Avoid calls to strlen in font processing functions.
[bpt/emacs.git] / src / xfont.c
CommitLineData
c2f5bfd6 1/* xfont.c -- X core font driver.
acaf905b 2 Copyright (C) 2006-2012 Free Software Foundation, Inc.
5df4f04c 3 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
c2f5bfd6
KH
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
6
7This file is part of GNU Emacs.
8
9ec0b715 9GNU Emacs is free software: you can redistribute it and/or modify
c2f5bfd6 10it under the terms of the GNU General Public License as published by
9ec0b715
GM
11the Free Software Foundation, either version 3 of the License, or
12(at your option) any later version.
c2f5bfd6
KH
13
14GNU Emacs is distributed in the hope that it will be useful,
15but WITHOUT ANY WARRANTY; without even the implied warranty of
16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17GNU General Public License for more details.
18
19You should have received a copy of the GNU General Public License
9ec0b715 20along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
c2f5bfd6
KH
21
22#include <config.h>
23#include <stdio.h>
d7306fe6 24#include <setjmp.h>
c2f5bfd6
KH
25#include <X11/Xlib.h>
26
27#include "lisp.h"
28#include "dispextern.h"
29#include "xterm.h"
30#include "frame.h"
31#include "blockinput.h"
32#include "character.h"
33#include "charset.h"
34#include "fontset.h"
35#include "font.h"
f0c55750 36#include "ccl.h"
c2f5bfd6
KH
37
38\f
39/* X core font driver. */
40
f0c55750
KH
41struct xfont_info
42{
43 struct font font;
44 Display *display;
45 XFontStruct *xfont;
46};
47
c2f5bfd6 48/* Prototypes of support functions. */
f57e2426 49extern void x_clear_errors (Display *);
c2f5bfd6 50
f57e2426 51static XCharStruct *xfont_get_pcm (XFontStruct *, XChar2b *);
c2f5bfd6
KH
52
53/* Get metrics of character CHAR2B in XFONT. Value is null if CHAR2B
54 is not contained in the font. */
55
56static XCharStruct *
971de7fb 57xfont_get_pcm (XFontStruct *xfont, XChar2b *char2b)
c2f5bfd6
KH
58{
59 /* The result metric information. */
60 XCharStruct *pcm = NULL;
61
960d80b9 62 font_assert (xfont && char2b);
c2f5bfd6
KH
63
64 if (xfont->per_char != NULL)
65 {
66 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
67 {
68 /* min_char_or_byte2 specifies the linear character index
69 corresponding to the first element of the per_char array,
70 max_char_or_byte2 is the index of the last character. A
71 character with non-zero CHAR2B->byte1 is not in the font.
72 A character with byte2 less than min_char_or_byte2 or
73 greater max_char_or_byte2 is not in the font. */
74 if (char2b->byte1 == 0
75 && char2b->byte2 >= xfont->min_char_or_byte2
76 && char2b->byte2 <= xfont->max_char_or_byte2)
77 pcm = xfont->per_char + char2b->byte2 - xfont->min_char_or_byte2;
78 }
79 else
80 {
81 /* If either min_byte1 or max_byte1 are nonzero, both
82 min_char_or_byte2 and max_char_or_byte2 are less than
83 256, and the 2-byte character index values corresponding
84 to the per_char array element N (counting from 0) are:
85
86 byte1 = N/D + min_byte1
87 byte2 = N\D + min_char_or_byte2
88
89 where:
90
91 D = max_char_or_byte2 - min_char_or_byte2 + 1
92 / = integer division
93 \ = integer modulus */
94 if (char2b->byte1 >= xfont->min_byte1
95 && char2b->byte1 <= xfont->max_byte1
96 && char2b->byte2 >= xfont->min_char_or_byte2
97 && char2b->byte2 <= xfont->max_char_or_byte2)
98 pcm = (xfont->per_char
99 + ((xfont->max_char_or_byte2 - xfont->min_char_or_byte2 + 1)
100 * (char2b->byte1 - xfont->min_byte1))
101 + (char2b->byte2 - xfont->min_char_or_byte2));
102 }
103 }
104 else
105 {
106 /* If the per_char pointer is null, all glyphs between the first
107 and last character indexes inclusive have the same
108 information, as given by both min_bounds and max_bounds. */
109 if (char2b->byte2 >= xfont->min_char_or_byte2
110 && char2b->byte2 <= xfont->max_char_or_byte2)
111 pcm = &xfont->max_bounds;
112 }
113
114 return ((pcm == NULL
115 || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0))
116 ? NULL : pcm);
117}
118
f57e2426
J
119static Lisp_Object xfont_get_cache (FRAME_PTR);
120static Lisp_Object xfont_list (Lisp_Object, Lisp_Object);
121static Lisp_Object xfont_match (Lisp_Object, Lisp_Object);
122static Lisp_Object xfont_list_family (Lisp_Object);
123static Lisp_Object xfont_open (FRAME_PTR, Lisp_Object, int);
124static void xfont_close (FRAME_PTR, struct font *);
125static int xfont_prepare_face (FRAME_PTR, struct face *);
126static int xfont_has_char (Lisp_Object, int);
127static unsigned xfont_encode_char (struct font *, int);
128static int xfont_text_extents (struct font *, unsigned *, int,
129 struct font_metrics *);
130static int xfont_draw (struct glyph_string *, int, int, int, int, int);
131static int xfont_check (FRAME_PTR, struct font *);
c2f5bfd6
KH
132
133struct font_driver xfont_driver =
134 {
bfe3e0a2 135 LISP_INITIALLY_ZERO, /* Qx */
f0c55750 136 0, /* case insensitive */
c2f5bfd6 137 xfont_get_cache,
c2f5bfd6 138 xfont_list,
6e34c9c1 139 xfont_match,
c2f5bfd6
KH
140 xfont_list_family,
141 NULL,
142 xfont_open,
143 xfont_close,
144 xfont_prepare_face,
f0c55750 145 NULL,
c2f5bfd6
KH
146 xfont_has_char,
147 xfont_encode_char,
148 xfont_text_extents,
f0c55750
KH
149 xfont_draw,
150 NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
637fa988
JD
151 xfont_check,
152 NULL, /* get_variation_glyphs */
153 NULL, /* filter_properties */
c2f5bfd6
KH
154 };
155
c2f5bfd6 156static Lisp_Object
971de7fb 157xfont_get_cache (FRAME_PTR f)
c2f5bfd6 158{
feb2737b 159 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
c2f5bfd6
KH
160
161 return (dpyinfo->name_list_element);
162}
163
f0c55750
KH
164static int
165compare_font_names (const void *name1, const void *name2)
166{
fd573f31
PE
167 char *const *n1 = name1;
168 char *const *n2 = name2;
169 return xstrcasecmp (*n1, *n2);
f0c55750
KH
170}
171
6a705b23
KH
172/* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length
173 of the decoding result. LEN is the byte length of XLFD, or -1 if
174 XLFD is NULL terminated. The caller must assure that OUTPUT is at
175 least twice (plus 1) as large as XLFD. */
176
984e7f30 177static ptrdiff_t
6a705b23
KH
178xfont_decode_coding_xlfd (char *xlfd, int len, char *output)
179{
180 char *p0 = xlfd, *p1 = output;
181 int c;
8510724d 182
6a705b23
KH
183 while (*p0)
184 {
185 c = *(unsigned char *) p0++;
efe0234f 186 p1 += CHAR_STRING (c, (unsigned char *) p1);
6a705b23
KH
187 if (--len == 0)
188 break;
189 }
190 *p1 = 0;
191 return (p1 - output);
192}
193
194/* Encode XLFD from UTF-8 to iso-8859-1 destructively, and return the
195 resulting byte length. If XLFD contains unencodable character,
196 return -1. */
197
198static int
199xfont_encode_coding_xlfd (char *xlfd)
200{
201 const unsigned char *p0 = (unsigned char *) xlfd;
202 unsigned char *p1 = (unsigned char *) xlfd;
203 int len = 0;
8510724d 204
6a705b23
KH
205 while (*p0)
206 {
207 int c = STRING_CHAR_ADVANCE (p0);
208
209 if (c >= 0x100)
210 return -1;
211 *p1++ = c;
212 len++;
213 }
214 *p1 = 0;
215 return len;
216}
217
5a189ffa
KH
218/* Check if CHARS (cons or vector) is supported by XFONT whose
219 encoding charset is ENCODING (XFONT is NULL) or by a font whose
220 registry corresponds to ENCODING and REPERTORY.
221 Return 1 if supported, return 0 otherwise. */
222
223static int
224xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
225 struct charset *encoding, struct charset *repertory)
226{
227 struct charset *charset = repertory ? repertory : encoding;
228
229 if (CONSP (chars))
230 {
231 for (; CONSP (chars); chars = XCDR (chars))
232 {
233 int c = XINT (XCAR (chars));
234 unsigned code = ENCODE_CHAR (charset, c);
235 XChar2b char2b;
236
237 if (code == CHARSET_INVALID_CODE (charset))
238 break;
239 if (! xfont)
240 continue;
241 if (code >= 0x10000)
242 break;
243 char2b.byte1 = code >> 8;
244 char2b.byte2 = code & 0xFF;
245 if (! xfont_get_pcm (xfont, &char2b))
246 break;
247 }
248 return (NILP (chars));
249 }
250 else if (VECTORP (chars))
251 {
d311d28c 252 ptrdiff_t i;
5a189ffa
KH
253
254 for (i = ASIZE (chars) - 1; i >= 0; i--)
255 {
256 int c = XINT (AREF (chars, i));
257 unsigned code = ENCODE_CHAR (charset, c);
258 XChar2b char2b;
259
260 if (code == CHARSET_INVALID_CODE (charset))
261 continue;
262 if (! xfont)
263 break;
264 if (code >= 0x10000)
265 continue;
266 char2b.byte1 = code >> 8;
267 char2b.byte2 = code & 0xFF;
268 if (xfont_get_pcm (xfont, &char2b))
269 break;
270 }
271 return (i >= 0);
272 }
273 return 0;
274}
275
0b381c7e
JB
276/* A hash table recoding which font supports which scripts. Each key
277 is a vector of characteristic font properties FOUNDRY to WIDTH and
5a189ffa
KH
278 ADDSTYLE, and each value is a list of script symbols.
279
280 We assume that fonts that have the same value in the above
281 properties supports the same set of characters on all displays. */
282
283static Lisp_Object xfont_scripts_cache;
284
0b381c7e 285/* Re-usable vector to store characteristic font properties. */
5a189ffa
KH
286static Lisp_Object xfont_scratch_props;
287
5a189ffa
KH
288/* Return a list of scripts supported by the font of FONTNAME whose
289 characteristic properties are in PROPS and whose encoding charset
290 is ENCODING. A caller must call BLOCK_INPUT in advance. */
92f19280
KH
291
292static Lisp_Object
5a189ffa
KH
293xfont_supported_scripts (Display *display, char *fontname, Lisp_Object props,
294 struct charset *encoding)
295{
296 Lisp_Object scripts;
297
298 /* Two special cases to avoid opening rather big fonts. */
299 if (EQ (AREF (props, 2), Qja))
300 return Fcons (intern ("kana"), Fcons (intern ("han"), Qnil));
301 if (EQ (AREF (props, 2), Qko))
302 return Fcons (intern ("hangul"), Qnil);
303 scripts = Fgethash (props, xfont_scripts_cache, Qt);
304 if (EQ (scripts, Qt))
305 {
306 XFontStruct *xfont;
307 Lisp_Object val;
308
309 scripts = Qnil;
310 xfont = XLoadQueryFont (display, fontname);
311 if (xfont)
312 {
313 if (xfont->per_char)
314 {
315 for (val = Vscript_representative_chars; CONSP (val);
316 val = XCDR (val))
317 if (CONSP (XCAR (val)) && SYMBOLP (XCAR (XCAR (val))))
318 {
319 Lisp_Object script = XCAR (XCAR (val));
320 Lisp_Object chars = XCDR (XCAR (val));
321
322 if (xfont_chars_supported (chars, xfont, encoding, NULL))
323 scripts = Fcons (script, scripts);
324 }
325 }
326 XFreeFont (display, xfont);
327 }
328 if (EQ (AREF (props, 3), Qiso10646_1)
329 && NILP (Fmemq (Qlatin, scripts)))
330 scripts = Fcons (Qlatin, scripts);
331 Fputhash (Fcopy_sequence (props), scripts, xfont_scripts_cache);
332 }
333 return scripts;
334}
335
5a189ffa 336static Lisp_Object
675e2c69 337xfont_list_pattern (Display *display, const char *pattern,
5a189ffa 338 Lisp_Object registry, Lisp_Object script)
c2f5bfd6 339{
6c4aeab6 340 Lisp_Object list = Qnil;
5a189ffa
KH
341 Lisp_Object chars = Qnil;
342 struct charset *encoding, *repertory = NULL;
6c4aeab6
KH
343 int i, limit, num_fonts;
344 char **names;
6a705b23
KH
345 /* Large enough to decode the longest XLFD (255 bytes). */
346 char buf[512];
c2f5bfd6 347
5a189ffa
KH
348 if (! NILP (registry)
349 && font_registry_charsets (registry, &encoding, &repertory) < 0)
350 /* Unknown REGISTRY, not supported. */
351 return Qnil;
352 if (! NILP (script))
353 {
354 chars = assq_no_quit (script, Vscript_representative_chars);
355 if (NILP (chars))
356 /* We can't tell whether or not a font supports SCRIPT. */
357 return Qnil;
358 chars = XCDR (chars);
359 if (repertory)
360 {
361 if (! xfont_chars_supported (chars, NULL, encoding, repertory))
362 return Qnil;
363 script = Qnil;
364 }
365 }
51b59d79 366
c2f5bfd6 367 BLOCK_INPUT;
6c4aeab6 368 x_catch_errors (display);
c2f5bfd6 369
6c4aeab6 370 for (limit = 512; ; limit *= 2)
c2f5bfd6 371 {
6c4aeab6
KH
372 names = XListFonts (display, pattern, limit, &num_fonts);
373 if (x_had_errors_p (display))
c2f5bfd6
KH
374 {
375 /* This error is perhaps due to insufficient memory on X
376 server. Let's just ignore it. */
6c4aeab6
KH
377 x_clear_errors (display);
378 num_fonts = 0;
379 break;
c2f5bfd6 380 }
6c4aeab6
KH
381 if (num_fonts < limit)
382 break;
383 XFreeFontNames (names);
384 }
385
f0c55750 386 if (num_fonts > 0)
6c4aeab6 387 {
f0c55750 388 char **indices = alloca (sizeof (char *) * num_fonts);
46306a17 389 Lisp_Object *props = XVECTOR (xfont_scratch_props)->contents;
5a189ffa 390 Lisp_Object scripts = Qnil;
6c4aeab6 391
46306a17
SM
392 for (i = 0; i < ASIZE (xfont_scratch_props); i++)
393 props[i] = Qnil;
f0c55750
KH
394 for (i = 0; i < num_fonts; i++)
395 indices[i] = names[i];
396 qsort (indices, num_fonts, sizeof (char *), compare_font_names);
6c4aeab6 397
f0c55750 398 for (i = 0; i < num_fonts; i++)
c2f5bfd6 399 {
984e7f30 400 ptrdiff_t len;
f0c55750 401 Lisp_Object entity;
6c4aeab6 402
05131107 403 if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
6c4aeab6 404 continue;
f0c55750 405 entity = font_make_entity ();
984e7f30
DA
406 len = xfont_decode_coding_xlfd (indices[i], -1, buf);
407 if (font_parse_xlfd (buf, len, entity) < 0)
4fa58085 408 continue;
5a189ffa
KH
409 ASET (entity, FONT_TYPE_INDEX, Qx);
410 /* Avoid auto-scaled fonts. */
4fa58085
KH
411 if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
412 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
413 && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
5a189ffa
KH
414 && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
415 continue;
416 /* Avoid not-allowed scalable fonts. */
417 if (NILP (Vscalable_fonts_allowed))
c2f5bfd6 418 {
4fa58085
KH
419 int size = 0;
420
421 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
422 size = XINT (AREF (entity, FONT_SIZE_INDEX));
423 else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
424 size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
425 if (size == 0)
6c4aeab6 426 continue;
5a189ffa
KH
427 }
428 else if (CONSP (Vscalable_fonts_allowed))
429 {
430 Lisp_Object tail, elt;
431
432 for (tail = Vscalable_fonts_allowed; CONSP (tail);
433 tail = XCDR (tail))
f0c55750 434 {
5a189ffa
KH
435 elt = XCAR (tail);
436 if (STRINGP (elt)
437 && fast_c_string_match_ignore_case (elt, indices[i]) >= 0)
438 break;
f0c55750 439 }
5a189ffa
KH
440 if (! CONSP (tail))
441 continue;
c2f5bfd6 442 }
f0c55750 443
4fa58085
KH
444 /* Avoid fonts of invalid registry. */
445 if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
446 continue;
447
5a189ffa
KH
448 /* Update encoding and repertory if necessary. */
449 if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
450 {
451 registry = AREF (entity, FONT_REGISTRY_INDEX);
452 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
453 encoding = NULL;
454 }
455 if (! encoding)
456 /* Unknown REGISTRY, not supported. */
457 continue;
458 if (repertory)
459 {
460 if (NILP (script)
461 || xfont_chars_supported (chars, NULL, encoding, repertory))
462 list = Fcons (entity, list);
463 continue;
464 }
465 if (memcmp (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
466 sizeof (Lisp_Object) * 7)
467 || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
468 {
469 memcpy (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
470 sizeof (Lisp_Object) * 7);
471 props[7] = AREF (entity, FONT_SPACING_INDEX);
472 scripts = xfont_supported_scripts (display, indices[i],
473 xfont_scratch_props, encoding);
474 }
475 if (NILP (script)
476 || ! NILP (Fmemq (script, scripts)))
f0c55750 477 list = Fcons (entity, list);
c2f5bfd6 478 }
019e13ef 479 XFreeFontNames (names);
c2f5bfd6
KH
480 }
481
482 x_uncatch_errors ();
483 UNBLOCK_INPUT;
484
678dca3d 485 FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
6c4aeab6
KH
486 return list;
487}
c2f5bfd6 488
6c4aeab6 489static Lisp_Object
971de7fb 490xfont_list (Lisp_Object frame, Lisp_Object spec)
6c4aeab6
KH
491{
492 FRAME_PTR f = XFRAME (frame);
493 Display *display = FRAME_X_DISPLAY_INFO (f)->display;
5a189ffa 494 Lisp_Object registry, list, val, extra, script;
6c4aeab6 495 int len;
6a705b23
KH
496 /* Large enough to contain the longest XLFD (255 bytes) in UTF-8. */
497 char name[512];
8510724d 498
6c4aeab6 499 extra = AREF (spec, FONT_EXTRA_INDEX);
6c4aeab6 500 if (CONSP (extra))
c2f5bfd6 501 {
6c4aeab6 502 val = assq_no_quit (QCotf, extra);
6c4aeab6 503 if (! NILP (val))
f0c55750
KH
504 return Qnil;
505 val = assq_no_quit (QClang, extra);
6c4aeab6 506 if (! NILP (val))
f0c55750 507 return Qnil;
c2f5bfd6 508 }
398dbf26 509
f0c55750 510 registry = AREF (spec, FONT_REGISTRY_INDEX);
6a705b23
KH
511 len = font_unparse_xlfd (spec, 0, name, 512);
512 if (len < 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
f0c55750 513 return Qnil;
5a189ffa
KH
514
515 val = assq_no_quit (QCscript, extra);
516 script = CDR (val);
517 list = xfont_list_pattern (display, name, registry, script);
f0c55750 518 if (NILP (list) && NILP (registry))
c2f5bfd6 519 {
f0c55750
KH
520 /* Try iso10646-1 */
521 char *r = name + len - 9; /* 9 == strlen (iso8859-1) */
522
523 if (r - name + 10 < 256) /* 10 == strlen (iso10646-1) */
6c4aeab6 524 {
f0c55750 525 strcpy (r, "iso10646-1");
5a189ffa 526 list = xfont_list_pattern (display, name, Qiso10646_1, script);
f0c55750
KH
527 }
528 }
529 if (NILP (list) && ! NILP (registry))
530 {
37470f4d 531 /* Try alternate registries. */
f0c55750 532 Lisp_Object alter;
6c4aeab6 533
f0c55750
KH
534 if ((alter = Fassoc (SYMBOL_NAME (registry),
535 Vface_alternative_font_registry_alist),
536 CONSP (alter)))
537 {
538 /* Pointer to REGISTRY-ENCODING field. */
539 char *r = name + len - SBYTES (SYMBOL_NAME (registry));
540
541 for (alter = XCDR (alter); CONSP (alter); alter = XCDR (alter))
542 if (STRINGP (XCAR (alter))
543 && ((r - name) + SBYTES (XCAR (alter))) < 256)
544 {
51b59d79 545 strcpy (r, SSDATA (XCAR (alter)));
5a189ffa 546 list = xfont_list_pattern (display, name, registry, script);
f0c55750
KH
547 if (! NILP (list))
548 break;
549 }
6c4aeab6 550 }
c2f5bfd6 551 }
37470f4d
KH
552 if (NILP (list))
553 {
554 /* Try alias. */
555 val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
6a705b23
KH
556 if (CONSP (val) && STRINGP (XCDR (val)) && SBYTES (XCDR (val)) < 512)
557 {
72af86bd 558 memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
6a705b23
KH
559 if (xfont_encode_coding_xlfd (name) < 0)
560 return Qnil;
5a189ffa 561 list = xfont_list_pattern (display, name, registry, script);
6a705b23 562 }
37470f4d 563 }
398dbf26 564
f0c55750 565 return list;
c2f5bfd6
KH
566}
567
6e34c9c1 568static Lisp_Object
971de7fb 569xfont_match (Lisp_Object frame, Lisp_Object spec)
6e34c9c1
KH
570{
571 FRAME_PTR f = XFRAME (frame);
572 Display *display = FRAME_X_DISPLAY_INFO (f)->display;
573 Lisp_Object extra, val, entity;
6a705b23 574 char name[512];
6e34c9c1
KH
575 XFontStruct *xfont;
576 unsigned long value;
577
578 extra = AREF (spec, FONT_EXTRA_INDEX);
579 val = assq_no_quit (QCname, extra);
580 if (! CONSP (val) || ! STRINGP (XCDR (val)))
f0c55750 581 {
6a705b23 582 if (font_unparse_xlfd (spec, 0, name, 512) < 0)
f0c55750 583 return Qnil;
f0c55750 584 }
6a705b23 585 else if (SBYTES (XCDR (val)) < 512)
72af86bd 586 memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
f0c55750 587 else
6a705b23
KH
588 return Qnil;
589 if (xfont_encode_coding_xlfd (name) < 0)
590 return Qnil;
6e34c9c1 591
9c6d1df5 592 BLOCK_INPUT;
6e34c9c1 593 entity = Qnil;
6e34c9c1
KH
594 xfont = XLoadQueryFont (display, name);
595 if (xfont)
596 {
597 if (XGetFontProperty (xfont, XA_FONT, &value))
598 {
6a705b23 599 char *s;
6e34c9c1 600
6a705b23 601 s = (char *) XGetAtomName (display, (Atom) value);
6e34c9c1
KH
602
603 /* If DXPC (a Differential X Protocol Compressor)
604 Ver.3.7 is running, XGetAtomName will return null
605 string. We must avoid such a name. */
7de51af5 606 if (*s)
6e34c9c1 607 {
984e7f30 608 ptrdiff_t len;
f0c55750 609 entity = font_make_entity ();
6e34c9c1 610 ASET (entity, FONT_TYPE_INDEX, Qx);
984e7f30
DA
611 len = xfont_decode_coding_xlfd (s, -1, name);
612 if (font_parse_xlfd (name, len, entity) < 0)
6e34c9c1
KH
613 entity = Qnil;
614 }
6a705b23 615 XFree (s);
6e34c9c1
KH
616 }
617 XFreeFont (display, xfont);
618 }
9c6d1df5 619 UNBLOCK_INPUT;
6e34c9c1 620
678dca3d 621 FONT_ADD_LOG ("xfont-match", spec, entity);
6e34c9c1
KH
622 return entity;
623}
624
c2f5bfd6 625static Lisp_Object
971de7fb 626xfont_list_family (Lisp_Object frame)
c2f5bfd6
KH
627{
628 FRAME_PTR f = XFRAME (frame);
629 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
630 char **names;
631 int num_fonts, i;
632 Lisp_Object list;
e2be39f6 633 char *last_family IF_LINT (= 0);
c2f5bfd6
KH
634 int last_len;
635
636 BLOCK_INPUT;
637 x_catch_errors (dpyinfo->display);
638 names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
639 0x8000, &num_fonts);
640 if (x_had_errors_p (dpyinfo->display))
641 {
642 /* This error is perhaps due to insufficient memory on X server.
643 Let's just ignore it. */
644 x_clear_errors (dpyinfo->display);
645 num_fonts = 0;
646 }
647
648 list = Qnil;
649 for (i = 0, last_len = 0; i < num_fonts; i++)
650 {
6a705b23 651 char *p0 = names[i], *p1, buf[512];
c2f5bfd6 652 Lisp_Object family;
6a705b23 653 int decoded_len;
c2f5bfd6
KH
654
655 p0++; /* skip the leading '-' */
656 while (*p0 && *p0 != '-') p0++; /* skip foundry */
657 if (! *p0)
658 continue;
659 p1 = ++p0;
660 while (*p1 && *p1 != '-') p1++; /* find the end of family */
661 if (! *p1 || p1 == p0)
662 continue;
663 if (last_len == p1 - p0
72af86bd 664 && memcmp (last_family, p0, last_len) == 0)
c2f5bfd6
KH
665 continue;
666 last_len = p1 - p0;
667 last_family = p0;
6a705b23
KH
668
669 decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
670 family = font_intern_prop (p0, decoded_len, 1);
29428bb8 671 if (NILP (assq_no_quit (family, list)))
c2f5bfd6
KH
672 list = Fcons (family, list);
673 }
674
675 XFreeFontNames (names);
676 x_uncatch_errors ();
677 UNBLOCK_INPUT;
678
679 return list;
680}
681
f0c55750 682static Lisp_Object
971de7fb 683xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
c2f5bfd6
KH
684{
685 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
686 Display *display = dpyinfo->display;
6a705b23 687 char name[512];
c2f5bfd6
KH
688 int len;
689 unsigned long value;
690 Lisp_Object registry;
691 struct charset *encoding, *repertory;
f0c55750 692 Lisp_Object font_object, fullname;
c2f5bfd6
KH
693 struct font *font;
694 XFontStruct *xfont;
695
696 /* At first, check if we know how to encode characters for this
697 font. */
698 registry = AREF (entity, FONT_REGISTRY_INDEX);
a9822ae8 699 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
c8e0e16d 700 {
678dca3d 701 FONT_ADD_LOG (" x:unknown registry", registry, Qnil);
c8e0e16d
KH
702 return Qnil;
703 }
c2f5bfd6
KH
704
705 if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
706 pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
f0c55750
KH
707 else if (pixel_size == 0)
708 {
709 if (FRAME_FONT (f))
710 pixel_size = FRAME_FONT (f)->pixel_size;
711 else
712 pixel_size = 14;
713 }
6a705b23
KH
714 len = font_unparse_xlfd (entity, pixel_size, name, 512);
715 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
c8e0e16d 716 {
678dca3d 717 FONT_ADD_LOG (" x:unparse failed", entity, Qnil);
c8e0e16d
KH
718 return Qnil;
719 }
c2f5bfd6
KH
720
721 BLOCK_INPUT;
722 x_catch_errors (display);
723 xfont = XLoadQueryFont (display, name);
724 if (x_had_errors_p (display))
725 {
726 /* This error is perhaps due to insufficient memory on X server.
727 Let's just ignore it. */
728 x_clear_errors (display);
729 xfont = NULL;
730 }
2f73901f
KH
731 else if (! xfont)
732 {
733 /* Some version of X lists:
734 -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
735 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
736 but can open only:
737 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
738 and
739 -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
740 So, we try again with wildcards in RESX and RESY. */
741 Lisp_Object temp;
742
92470028 743 temp = copy_font_spec (entity);
2f73901f 744 ASET (temp, FONT_DPI_INDEX, Qnil);
6a705b23
KH
745 len = font_unparse_xlfd (temp, pixel_size, name, 512);
746 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
2f73901f 747 {
678dca3d 748 FONT_ADD_LOG (" x:unparse failed", temp, Qnil);
2f73901f
KH
749 return Qnil;
750 }
751 xfont = XLoadQueryFont (display, name);
752 if (x_had_errors_p (display))
753 {
754 /* This error is perhaps due to insufficient memory on X server.
755 Let's just ignore it. */
756 x_clear_errors (display);
757 xfont = NULL;
758 }
759 }
f0c55750
KH
760 fullname = Qnil;
761 /* Try to get the full name of FONT. */
762 if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
763 {
764 char *p0, *p;
765 int dashes = 0;
766
8510724d 767 p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
f0c55750
KH
768 /* Count the number of dashes in the "full name".
769 If it is too few, this isn't really the font's full name,
770 so don't use it.
771 In X11R4, the fonts did not come with their canonical names
772 stored in them. */
773 while (*p)
774 {
775 if (*p == '-')
776 dashes++;
777 p++;
778 }
779
780 if (dashes >= 13)
6a705b23
KH
781 {
782 len = xfont_decode_coding_xlfd (p0, -1, name);
783 fullname = Fdowncase (make_string (name, len));
784 }
f0c55750
KH
785 XFree (p0);
786 }
c2f5bfd6
KH
787 x_uncatch_errors ();
788 UNBLOCK_INPUT;
789
790 if (! xfont)
c8e0e16d 791 {
678dca3d 792 FONT_ADD_LOG (" x:open failed", build_string (name), Qnil);
c8e0e16d
KH
793 return Qnil;
794 }
f0c55750 795
947eecfb
KH
796 font_object = font_make_object (VECSIZE (struct xfont_info),
797 entity, pixel_size);
f0c55750
KH
798 ASET (font_object, FONT_TYPE_INDEX, Qx);
799 if (STRINGP (fullname))
6a705b23 800 {
984e7f30 801 font_parse_xlfd (SSDATA (fullname), SBYTES (fullname), font_object);
6a705b23
KH
802 ASET (font_object, FONT_NAME_INDEX, fullname);
803 }
f0c55750 804 else
6a705b23
KH
805 {
806 char buf[512];
807
808 len = xfont_decode_coding_xlfd (name, -1, buf);
809 ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
810 }
f0c55750
KH
811 ASET (font_object, FONT_FULLNAME_INDEX, fullname);
812 ASET (font_object, FONT_FILE_INDEX, Qnil);
813 ASET (font_object, FONT_FORMAT_INDEX, Qx);
814 font = XFONT_OBJECT (font_object);
815 ((struct xfont_info *) font)->xfont = xfont;
816 ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
c2f5bfd6
KH
817 font->pixel_size = pixel_size;
818 font->driver = &xfont_driver;
c2f5bfd6 819 font->encoding_charset = encoding->id;
1886668d 820 font->repertory_charset = repertory ? repertory->id : -1;
c2f5bfd6
KH
821 font->ascent = xfont->ascent;
822 font->descent = xfont->descent;
f0c55750
KH
823 font->height = font->ascent + font->descent;
824 font->min_width = xfont->min_bounds.width;
c2f5bfd6
KH
825 if (xfont->min_bounds.width == xfont->max_bounds.width)
826 {
827 /* Fixed width font. */
f0c55750 828 font->average_width = font->space_width = xfont->min_bounds.width;
c2f5bfd6
KH
829 }
830 else
831 {
c2f5bfd6 832 XCharStruct *pcm;
f0c55750
KH
833 XChar2b char2b;
834 Lisp_Object val;
c2f5bfd6
KH
835
836 char2b.byte1 = 0x00, char2b.byte2 = 0x20;
837 pcm = xfont_get_pcm (xfont, &char2b);
838 if (pcm)
f0c55750 839 font->space_width = pcm->width;
c2f5bfd6 840 else
f0c55750
KH
841 font->space_width = 0;
842
843 val = Ffont_get (font_object, QCavgwidth);
844 if (INTEGERP (val))
18acb5ad 845 font->average_width = XINT (val) / 10;
f0c55750
KH
846 if (font->average_width < 0)
847 font->average_width = - font->average_width;
625a3eb1 848 else
c2f5bfd6 849 {
625a3eb1
PE
850 if (font->average_width == 0
851 && encoding->ascii_compatible_p)
852 {
853 int width = font->space_width, n = pcm != NULL;
c2f5bfd6 854
625a3eb1
PE
855 for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
856 if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
857 width += pcm->width, n++;
858 if (n > 0)
859 font->average_width = width / n;
860 }
861 if (font->average_width == 0)
862 /* No easy way other than this to get a reasonable
863 average_width. */
864 font->average_width
865 = (xfont->min_bounds.width + xfont->max_bounds.width) / 2;
c2f5bfd6 866 }
c2f5bfd6 867 }
c2f5bfd6 868
f0c55750
KH
869 BLOCK_INPUT;
870 font->underline_thickness
871 = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
872 ? (long) value : 0);
873 font->underline_position
874 = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
875 ? (long) value : -1);
876 font->baseline_offset
c2f5bfd6
KH
877 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
878 ? (long) value : 0);
f0c55750 879 font->relative_compose
c2f5bfd6
KH
880 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
881 ? (long) value : 0);
f0c55750 882 font->default_ascent
c2f5bfd6
KH
883 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
884 ? (long) value : 0);
c2f5bfd6
KH
885 UNBLOCK_INPUT;
886
f0c55750
KH
887 if (NILP (fullname))
888 fullname = AREF (font_object, FONT_NAME_INDEX);
634c4da0
KH
889 font->vertical_centering
890 = (STRINGP (Vvertical_centering_font_regexp)
891 && (fast_string_match_ignore_case
892 (Vvertical_centering_font_regexp, fullname) >= 0));
c2f5bfd6 893
f0c55750 894 return font_object;
c2f5bfd6
KH
895}
896
897static void
971de7fb 898xfont_close (FRAME_PTR f, struct font *font)
c2f5bfd6
KH
899{
900 BLOCK_INPUT;
f0c55750 901 XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
c2f5bfd6 902 UNBLOCK_INPUT;
c2f5bfd6
KH
903}
904
905static int
971de7fb 906xfont_prepare_face (FRAME_PTR f, struct face *face)
c2f5bfd6
KH
907{
908 BLOCK_INPUT;
f0c55750
KH
909 XSetFont (FRAME_X_DISPLAY (f), face->gc,
910 ((struct xfont_info *) face->font)->xfont->fid);
c2f5bfd6
KH
911 UNBLOCK_INPUT;
912
913 return 0;
914}
915
c2f5bfd6 916static int
971de7fb 917xfont_has_char (Lisp_Object font, int c)
c2f5bfd6 918{
bd0af90d 919 Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
d156542d 920 struct charset *encoding;
bd0af90d 921 struct charset *repertory = NULL;
c2f5bfd6 922
bd0af90d
KH
923 if (EQ (registry, Qiso10646_1))
924 {
5a189ffa 925 encoding = CHARSET_FROM_ID (charset_unicode);
bd0af90d
KH
926 /* We use a font of `ja' and `ko' adstyle only for a character
927 in JISX0208 and KSC5601 charsets respectively. */
928 if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
929 && charset_jisx0208 >= 0)
5a189ffa 930 repertory = CHARSET_FROM_ID (charset_jisx0208);
bd0af90d
KH
931 else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
932 && charset_ksc5601 >= 0)
5a189ffa 933 repertory = CHARSET_FROM_ID (charset_ksc5601);
bd0af90d
KH
934 }
935 else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
936 /* Unknown REGISTRY, not usable. */
937 return 0;
d156542d
KH
938 if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
939 return 1;
c2f5bfd6
KH
940 if (! repertory)
941 return -1;
942 return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
943}
944
945static unsigned
971de7fb 946xfont_encode_char (struct font *font, int c)
c2f5bfd6 947{
f0c55750 948 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
c2f5bfd6
KH
949 struct charset *charset;
950 unsigned code;
951 XChar2b char2b;
952
953 charset = CHARSET_FROM_ID (font->encoding_charset);
954 code = ENCODE_CHAR (charset, c);
955 if (code == CHARSET_INVALID_CODE (charset))
21138cff 956 return FONT_INVALID_CODE;
1886668d 957 if (font->repertory_charset >= 0)
c2f5bfd6 958 {
1886668d 959 charset = CHARSET_FROM_ID (font->repertory_charset);
c2f5bfd6 960 return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
21138cff 961 ? code : FONT_INVALID_CODE);
c2f5bfd6 962 }
88649c62
KH
963 char2b.byte1 = code >> 8;
964 char2b.byte2 = code & 0xFF;
f0c55750 965 return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
c2f5bfd6
KH
966}
967
968static int
971de7fb 969xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
c2f5bfd6 970{
f0c55750 971 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
c2f5bfd6 972 int width = 0;
bc7b6697 973 int i, first;
c2f5bfd6
KH
974
975 if (metrics)
72af86bd 976 memset (metrics, 0, sizeof (struct font_metrics));
bc7b6697 977 for (i = 0, first = 1; i < nglyphs; i++)
c2f5bfd6
KH
978 {
979 XChar2b char2b;
980 static XCharStruct *pcm;
981
982 if (code[i] >= 0x10000)
983 continue;
984 char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
f0c55750 985 pcm = xfont_get_pcm (xfont, &char2b);
c2f5bfd6
KH
986 if (! pcm)
987 continue;
41fa3e2c
KH
988 if (first)
989 {
990 if (metrics)
991 {
992 metrics->lbearing = pcm->lbearing;
993 metrics->rbearing = pcm->rbearing;
994 metrics->ascent = pcm->ascent;
995 metrics->descent = pcm->descent;
996 }
997 first = 0;
998 }
999 else
1000 {
1001 if (metrics)
1002 {
1003 if (metrics->lbearing > width + pcm->lbearing)
1004 metrics->lbearing = width + pcm->lbearing;
1005 if (metrics->rbearing < width + pcm->rbearing)
1006 metrics->rbearing = width + pcm->rbearing;
1007 if (metrics->ascent < pcm->ascent)
1008 metrics->ascent = pcm->ascent;
1009 if (metrics->descent < pcm->descent)
1010 metrics->descent = pcm->descent;
1011 }
1012 }
c2f5bfd6
KH
1013 width += pcm->width;
1014 }
1015 if (metrics)
1016 metrics->width = width;
1017 return width;
1018}
1019
1020static int
971de7fb 1021xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
c2f5bfd6 1022{
f0c55750 1023 XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
c2f5bfd6 1024 int len = to - from;
6e34c9c1 1025 GC gc = s->gc;
298fd5b1 1026 int i;
6e34c9c1 1027
f0c55750 1028 if (s->gc != s->face->gc)
6e34c9c1 1029 {
d45fefc7 1030 BLOCK_INPUT;
f0c55750 1031 XSetFont (s->display, gc, xfont->fid);
d45fefc7 1032 UNBLOCK_INPUT;
6e34c9c1 1033 }
c2f5bfd6
KH
1034
1035 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1036 {
1037 char *str;
c2f5bfd6
KH
1038 USE_SAFE_ALLOCA;
1039
1040 SAFE_ALLOCA (str, char *, len);
1041 for (i = 0; i < len ; i++)
1042 str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
d45fefc7 1043 BLOCK_INPUT;
c2f5bfd6 1044 if (with_background > 0)
298fd5b1
KH
1045 {
1046 if (s->padding_p)
1047 for (i = 0; i < len; i++)
1048 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1049 gc, x + i, y, str + i, 1);
1050 else
1051 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1052 gc, x, y, str, len);
1053 }
c2f5bfd6 1054 else
298fd5b1
KH
1055 {
1056 if (s->padding_p)
1057 for (i = 0; i < len; i++)
1058 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1059 gc, x + i, y, str + i, 1);
1060 else
1061 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1062 gc, x, y, str, len);
1063 }
d45fefc7 1064 UNBLOCK_INPUT;
c2f5bfd6
KH
1065 SAFE_FREE ();
1066 return s->nchars;
1067 }
1068
d45fefc7 1069 BLOCK_INPUT;
c2f5bfd6 1070 if (with_background > 0)
298fd5b1
KH
1071 {
1072 if (s->padding_p)
1073 for (i = 0; i < len; i++)
1074 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1075 gc, x + i, y, s->char2b + from + i, 1);
1076 else
1077 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1078 gc, x, y, s->char2b + from, len);
1079 }
c2f5bfd6 1080 else
298fd5b1
KH
1081 {
1082 if (s->padding_p)
1083 for (i = 0; i < len; i++)
1084 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1085 gc, x + i, y, s->char2b + from + i, 1);
1086 else
1087 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1088 gc, x, y, s->char2b + from, len);
1089 }
d45fefc7 1090 UNBLOCK_INPUT;
c2f5bfd6
KH
1091
1092 return len;
1093}
1094
f0c55750 1095static int
971de7fb 1096xfont_check (FRAME_PTR f, struct font *font)
f0c55750
KH
1097{
1098 struct xfont_info *xfont = (struct xfont_info *) font;
1099
1100 return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1101}
1102
c2f5bfd6
KH
1103\f
1104void
971de7fb 1105syms_of_xfont (void)
c2f5bfd6 1106{
5a189ffa 1107 staticpro (&xfont_scripts_cache);
46306a17
SM
1108 { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1109 is called fairly late, when QCtest and Qequal are known to be set. */
1110 Lisp_Object args[2];
1111 args[0] = QCtest;
1112 args[1] = Qequal;
1113 xfont_scripts_cache = Fmake_hash_table (2, args);
1114 }
5a189ffa 1115 staticpro (&xfont_scratch_props);
46306a17 1116 xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
c2f5bfd6
KH
1117 xfont_driver.type = Qx;
1118 register_font_driver (&xfont_driver, NULL);
1119}