* lisp/image.el (image-multi-frame-p): Fix thinko
[emacs.git] / src / xfont.c
blob525f00031c5b371eb4ea7ca4ccc048431bc4e132
1 /* xfont.c -- X core font driver.
2 Copyright (C) 2006-2014 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <stdio.h>
24 #include <X11/Xlib.h>
26 #include "lisp.h"
27 #include "dispextern.h"
28 #include "xterm.h"
29 #include "frame.h"
30 #include "blockinput.h"
31 #include "character.h"
32 #include "charset.h"
33 #include "fontset.h"
34 #include "font.h"
35 #include "ccl.h"
38 /* X core font driver. */
40 struct xfont_info
42 struct font font;
43 Display *display;
44 XFontStruct *xfont;
45 unsigned x_display_id;
48 /* Prototypes of support functions. */
50 static XCharStruct *xfont_get_pcm (XFontStruct *, XChar2b *);
52 /* Get metrics of character CHAR2B in XFONT. Value is null if CHAR2B
53 is not contained in the font. */
55 static XCharStruct *
56 xfont_get_pcm (XFontStruct *xfont, XChar2b *char2b)
58 /* The result metric information. */
59 XCharStruct *pcm = NULL;
61 eassert (xfont && char2b);
63 if (xfont->per_char != NULL)
65 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
67 /* min_char_or_byte2 specifies the linear character index
68 corresponding to the first element of the per_char array,
69 max_char_or_byte2 is the index of the last character. A
70 character with non-zero CHAR2B->byte1 is not in the font.
71 A character with byte2 less than min_char_or_byte2 or
72 greater max_char_or_byte2 is not in the font. */
73 if (char2b->byte1 == 0
74 && char2b->byte2 >= xfont->min_char_or_byte2
75 && char2b->byte2 <= xfont->max_char_or_byte2)
76 pcm = xfont->per_char + char2b->byte2 - xfont->min_char_or_byte2;
78 else
80 /* If either min_byte1 or max_byte1 are nonzero, both
81 min_char_or_byte2 and max_char_or_byte2 are less than
82 256, and the 2-byte character index values corresponding
83 to the per_char array element N (counting from 0) are:
85 byte1 = N/D + min_byte1
86 byte2 = N\D + min_char_or_byte2
88 where:
90 D = max_char_or_byte2 - min_char_or_byte2 + 1
91 / = integer division
92 \ = integer modulus */
93 if (char2b->byte1 >= xfont->min_byte1
94 && char2b->byte1 <= xfont->max_byte1
95 && char2b->byte2 >= xfont->min_char_or_byte2
96 && char2b->byte2 <= xfont->max_char_or_byte2)
97 pcm = (xfont->per_char
98 + ((xfont->max_char_or_byte2 - xfont->min_char_or_byte2 + 1)
99 * (char2b->byte1 - xfont->min_byte1))
100 + (char2b->byte2 - xfont->min_char_or_byte2));
103 else
105 /* If the per_char pointer is null, all glyphs between the first
106 and last character indexes inclusive have the same
107 information, as given by both min_bounds and max_bounds. */
108 if (char2b->byte2 >= xfont->min_char_or_byte2
109 && char2b->byte2 <= xfont->max_char_or_byte2)
110 pcm = &xfont->max_bounds;
113 return ((pcm == NULL
114 || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0))
115 ? NULL : pcm);
118 static Lisp_Object xfont_get_cache (struct frame *);
119 static Lisp_Object xfont_list (struct frame *, Lisp_Object);
120 static Lisp_Object xfont_match (struct frame *, Lisp_Object);
121 static Lisp_Object xfont_list_family (struct frame *);
122 static Lisp_Object xfont_open (struct frame *, Lisp_Object, int);
123 static void xfont_close (struct font *);
124 static int xfont_prepare_face (struct frame *, struct face *);
125 static int xfont_has_char (Lisp_Object, int);
126 static unsigned xfont_encode_char (struct font *, int);
127 static int xfont_text_extents (struct font *, unsigned *, int,
128 struct font_metrics *);
129 static int xfont_draw (struct glyph_string *, int, int, int, int, bool);
130 static int xfont_check (struct frame *, struct font *);
132 struct font_driver xfont_driver =
134 LISP_INITIALLY_ZERO, /* Qx */
135 0, /* case insensitive */
136 xfont_get_cache,
137 xfont_list,
138 xfont_match,
139 xfont_list_family,
140 NULL,
141 xfont_open,
142 xfont_close,
143 xfont_prepare_face,
144 NULL,
145 xfont_has_char,
146 xfont_encode_char,
147 xfont_text_extents,
148 xfont_draw,
149 NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
150 xfont_check,
151 NULL, /* get_variation_glyphs */
152 NULL, /* filter_properties */
155 static Lisp_Object
156 xfont_get_cache (struct frame *f)
158 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
160 return (dpyinfo->name_list_element);
163 static int
164 compare_font_names (const void *name1, const void *name2)
166 char *const *n1 = name1;
167 char *const *n2 = name2;
168 return xstrcasecmp (*n1, *n2);
171 /* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length
172 of the decoding result. LEN is the byte length of XLFD, or -1 if
173 XLFD is NULL terminated. The caller must assure that OUTPUT is at
174 least twice (plus 1) as large as XLFD. */
176 static ptrdiff_t
177 xfont_decode_coding_xlfd (char *xlfd, int len, char *output)
179 char *p0 = xlfd, *p1 = output;
180 int c;
182 while (*p0)
184 c = *(unsigned char *) p0++;
185 p1 += CHAR_STRING (c, (unsigned char *) p1);
186 if (--len == 0)
187 break;
189 *p1 = 0;
190 return (p1 - output);
193 /* Encode XLFD from UTF-8 to iso-8859-1 destructively, and return the
194 resulting byte length. If XLFD contains unencodable character,
195 return -1. */
197 static int
198 xfont_encode_coding_xlfd (char *xlfd)
200 const unsigned char *p0 = (unsigned char *) xlfd;
201 unsigned char *p1 = (unsigned char *) xlfd;
202 int len = 0;
204 while (*p0)
206 int c = STRING_CHAR_ADVANCE (p0);
208 if (c >= 0x100)
209 return -1;
210 *p1++ = c;
211 len++;
213 *p1 = 0;
214 return len;
217 /* Check if CHARS (cons or vector) is supported by XFONT whose
218 encoding charset is ENCODING (XFONT is NULL) or by a font whose
219 registry corresponds to ENCODING and REPERTORY.
220 Return true if supported. */
222 static bool
223 xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
224 struct charset *encoding, struct charset *repertory)
226 struct charset *charset = repertory ? repertory : encoding;
228 if (CONSP (chars))
230 for (; CONSP (chars); chars = XCDR (chars))
232 int c = XINT (XCAR (chars));
233 unsigned code = ENCODE_CHAR (charset, c);
234 XChar2b char2b;
236 if (code == CHARSET_INVALID_CODE (charset))
237 break;
238 if (! xfont)
239 continue;
240 if (code >= 0x10000)
241 break;
242 char2b.byte1 = code >> 8;
243 char2b.byte2 = code & 0xFF;
244 if (! xfont_get_pcm (xfont, &char2b))
245 break;
247 return (NILP (chars));
249 else if (VECTORP (chars))
251 ptrdiff_t i;
253 for (i = ASIZE (chars) - 1; i >= 0; i--)
255 int c = XINT (AREF (chars, i));
256 unsigned code = ENCODE_CHAR (charset, c);
257 XChar2b char2b;
259 if (code == CHARSET_INVALID_CODE (charset))
260 continue;
261 if (! xfont)
262 break;
263 if (code >= 0x10000)
264 continue;
265 char2b.byte1 = code >> 8;
266 char2b.byte2 = code & 0xFF;
267 if (xfont_get_pcm (xfont, &char2b))
268 break;
270 return (i >= 0);
272 return 0;
275 /* A hash table recoding which font supports which scripts. Each key
276 is a vector of characteristic font properties FOUNDRY to WIDTH and
277 ADDSTYLE, and each value is a list of script symbols.
279 We assume that fonts that have the same value in the above
280 properties supports the same set of characters on all displays. */
282 static Lisp_Object xfont_scripts_cache;
284 /* Re-usable vector to store characteristic font properties. */
285 static Lisp_Object xfont_scratch_props;
287 /* Return a list of scripts supported by the font of FONTNAME whose
288 characteristic properties are in PROPS and whose encoding charset
289 is ENCODING. A caller must call BLOCK_INPUT in advance. */
291 static Lisp_Object
292 xfont_supported_scripts (Display *display, char *fontname, Lisp_Object props,
293 struct charset *encoding)
295 Lisp_Object scripts;
297 /* Two special cases to avoid opening rather big fonts. */
298 if (EQ (AREF (props, 2), Qja))
299 return list2 (intern ("kana"), intern ("han"));
300 if (EQ (AREF (props, 2), Qko))
301 return list1 (intern ("hangul"));
302 scripts = Fgethash (props, xfont_scripts_cache, Qt);
303 if (EQ (scripts, Qt))
305 XFontStruct *xfont;
306 Lisp_Object val;
308 scripts = Qnil;
309 xfont = XLoadQueryFont (display, fontname);
310 if (xfont)
312 if (xfont->per_char)
314 for (val = Vscript_representative_chars; CONSP (val);
315 val = XCDR (val))
316 if (CONSP (XCAR (val)) && SYMBOLP (XCAR (XCAR (val))))
318 Lisp_Object script = XCAR (XCAR (val));
319 Lisp_Object chars = XCDR (XCAR (val));
321 if (xfont_chars_supported (chars, xfont, encoding, NULL))
322 scripts = Fcons (script, scripts);
325 XFreeFont (display, xfont);
327 if (EQ (AREF (props, 3), Qiso10646_1)
328 && NILP (Fmemq (Qlatin, scripts)))
329 scripts = Fcons (Qlatin, scripts);
330 Fputhash (Fcopy_sequence (props), scripts, xfont_scripts_cache);
332 return scripts;
335 static Lisp_Object
336 xfont_list_pattern (Display *display, const char *pattern,
337 Lisp_Object registry, Lisp_Object script)
339 Lisp_Object list = Qnil;
340 Lisp_Object chars = Qnil;
341 struct charset *encoding, *repertory = NULL;
342 int i, limit, num_fonts;
343 char **names;
344 /* Large enough to decode the longest XLFD (255 bytes). */
345 char buf[512];
347 if (! NILP (registry)
348 && font_registry_charsets (registry, &encoding, &repertory) < 0)
349 /* Unknown REGISTRY, not supported. */
350 return Qnil;
351 if (! NILP (script))
353 chars = assq_no_quit (script, Vscript_representative_chars);
354 if (NILP (chars))
355 /* We can't tell whether or not a font supports SCRIPT. */
356 return Qnil;
357 chars = XCDR (chars);
358 if (repertory)
360 if (! xfont_chars_supported (chars, NULL, encoding, repertory))
361 return Qnil;
362 script = Qnil;
366 block_input ();
367 x_catch_errors (display);
369 for (limit = 512; ; limit *= 2)
371 names = XListFonts (display, pattern, limit, &num_fonts);
372 if (x_had_errors_p (display))
374 /* This error is perhaps due to insufficient memory on X
375 server. Let's just ignore it. */
376 x_clear_errors (display);
377 num_fonts = 0;
378 break;
380 if (num_fonts < limit)
381 break;
382 XFreeFontNames (names);
385 if (num_fonts > 0)
387 char **indices = alloca (sizeof (char *) * num_fonts);
388 Lisp_Object *props = XVECTOR (xfont_scratch_props)->contents;
389 Lisp_Object scripts = Qnil;
391 for (i = 0; i < ASIZE (xfont_scratch_props); i++)
392 ASET (xfont_scratch_props, i, Qnil);
393 for (i = 0; i < num_fonts; i++)
394 indices[i] = names[i];
395 qsort (indices, num_fonts, sizeof (char *), compare_font_names);
397 for (i = 0; i < num_fonts; i++)
399 ptrdiff_t len;
400 Lisp_Object entity;
402 if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
403 continue;
404 entity = font_make_entity ();
405 len = xfont_decode_coding_xlfd (indices[i], -1, buf);
406 if (font_parse_xlfd (buf, len, entity) < 0)
407 continue;
408 ASET (entity, FONT_TYPE_INDEX, Qx);
409 /* Avoid auto-scaled fonts. */
410 if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
411 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
412 && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
413 && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
414 continue;
415 /* Avoid not-allowed scalable fonts. */
416 if (NILP (Vscalable_fonts_allowed))
418 int size = 0;
420 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
421 size = XINT (AREF (entity, FONT_SIZE_INDEX));
422 else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
423 size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
424 if (size == 0)
425 continue;
427 else if (CONSP (Vscalable_fonts_allowed))
429 Lisp_Object tail, elt;
431 for (tail = Vscalable_fonts_allowed; CONSP (tail);
432 tail = XCDR (tail))
434 elt = XCAR (tail);
435 if (STRINGP (elt)
436 && fast_c_string_match_ignore_case (elt, indices[i],
437 len) >= 0)
438 break;
440 if (! CONSP (tail))
441 continue;
444 /* Avoid fonts of invalid registry. */
445 if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
446 continue;
448 /* Update encoding and repertory if necessary. */
449 if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
451 registry = AREF (entity, FONT_REGISTRY_INDEX);
452 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
453 encoding = NULL;
455 if (! encoding)
456 /* Unknown REGISTRY, not supported. */
457 continue;
458 if (repertory)
460 if (NILP (script)
461 || xfont_chars_supported (chars, NULL, encoding, repertory))
462 list = Fcons (entity, list);
463 continue;
465 if (memcmp (props, aref_addr (entity, FONT_FOUNDRY_INDEX),
466 word_size * 7)
467 || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
469 vcopy (xfont_scratch_props, 0,
470 aref_addr (entity, FONT_FOUNDRY_INDEX), 7);
471 ASET (xfont_scratch_props, 7, AREF (entity, FONT_SPACING_INDEX));
472 scripts = xfont_supported_scripts (display, indices[i],
473 xfont_scratch_props, encoding);
475 if (NILP (script)
476 || ! NILP (Fmemq (script, scripts)))
477 list = Fcons (entity, list);
479 XFreeFontNames (names);
482 x_uncatch_errors ();
483 unblock_input ();
485 FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
486 return list;
489 static Lisp_Object
490 xfont_list (struct frame *f, Lisp_Object spec)
492 Display *display = FRAME_DISPLAY_INFO (f)->display;
493 Lisp_Object registry, list, val, extra, script;
494 int len;
495 /* Large enough to contain the longest XLFD (255 bytes) in UTF-8. */
496 char name[512];
498 extra = AREF (spec, FONT_EXTRA_INDEX);
499 if (CONSP (extra))
501 val = assq_no_quit (QCotf, extra);
502 if (! NILP (val))
503 return Qnil;
504 val = assq_no_quit (QClang, extra);
505 if (! NILP (val))
506 return Qnil;
509 registry = AREF (spec, FONT_REGISTRY_INDEX);
510 len = font_unparse_xlfd (spec, 0, name, 512);
511 if (len < 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
512 return Qnil;
514 val = assq_no_quit (QCscript, extra);
515 script = CDR (val);
516 list = xfont_list_pattern (display, name, registry, script);
517 if (NILP (list) && NILP (registry))
519 /* Try iso10646-1 */
520 char *r = name + len - 9; /* 9 == strlen (iso8859-1) */
522 if (r - name + 10 < 256) /* 10 == strlen (iso10646-1) */
524 strcpy (r, "iso10646-1");
525 list = xfont_list_pattern (display, name, Qiso10646_1, script);
528 if (NILP (list) && ! NILP (registry))
530 /* Try alternate registries. */
531 Lisp_Object alter;
533 if ((alter = Fassoc (SYMBOL_NAME (registry),
534 Vface_alternative_font_registry_alist),
535 CONSP (alter)))
537 /* Pointer to REGISTRY-ENCODING field. */
538 char *r = name + len - SBYTES (SYMBOL_NAME (registry));
540 for (alter = XCDR (alter); CONSP (alter); alter = XCDR (alter))
541 if (STRINGP (XCAR (alter))
542 && ((r - name) + SBYTES (XCAR (alter))) < 256)
544 strcpy (r, SSDATA (XCAR (alter)));
545 list = xfont_list_pattern (display, name, registry, script);
546 if (! NILP (list))
547 break;
551 if (NILP (list))
553 /* Try alias. */
554 val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
555 if (CONSP (val) && STRINGP (XCDR (val)) && SBYTES (XCDR (val)) < 512)
557 memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
558 if (xfont_encode_coding_xlfd (name) < 0)
559 return Qnil;
560 list = xfont_list_pattern (display, name, registry, script);
564 return list;
567 static Lisp_Object
568 xfont_match (struct frame *f, Lisp_Object spec)
570 Display *display = FRAME_DISPLAY_INFO (f)->display;
571 Lisp_Object extra, val, entity;
572 char name[512];
573 XFontStruct *xfont;
574 unsigned long value;
576 extra = AREF (spec, FONT_EXTRA_INDEX);
577 val = assq_no_quit (QCname, extra);
578 if (! CONSP (val) || ! STRINGP (XCDR (val)))
580 if (font_unparse_xlfd (spec, 0, name, 512) < 0)
581 return Qnil;
583 else if (SBYTES (XCDR (val)) < 512)
584 memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
585 else
586 return Qnil;
587 if (xfont_encode_coding_xlfd (name) < 0)
588 return Qnil;
590 block_input ();
591 entity = Qnil;
592 xfont = XLoadQueryFont (display, name);
593 if (xfont)
595 if (XGetFontProperty (xfont, XA_FONT, &value))
597 char *s = XGetAtomName (display, (Atom) value);
599 /* If DXPC (a Differential X Protocol Compressor)
600 Ver.3.7 is running, XGetAtomName will return null
601 string. We must avoid such a name. */
602 if (*s)
604 ptrdiff_t len;
605 entity = font_make_entity ();
606 ASET (entity, FONT_TYPE_INDEX, Qx);
607 len = xfont_decode_coding_xlfd (s, -1, name);
608 if (font_parse_xlfd (name, len, entity) < 0)
609 entity = Qnil;
611 XFree (s);
613 XFreeFont (display, xfont);
615 unblock_input ();
617 FONT_ADD_LOG ("xfont-match", spec, entity);
618 return entity;
621 static Lisp_Object
622 xfont_list_family (struct frame *f)
624 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
625 char **names;
626 int num_fonts, i;
627 Lisp_Object list;
628 char *last_family IF_LINT (= 0);
629 int last_len;
631 block_input ();
632 x_catch_errors (dpyinfo->display);
633 names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
634 0x8000, &num_fonts);
635 if (x_had_errors_p (dpyinfo->display))
637 /* This error is perhaps due to insufficient memory on X server.
638 Let's just ignore it. */
639 x_clear_errors (dpyinfo->display);
640 num_fonts = 0;
643 list = Qnil;
644 for (i = 0, last_len = 0; i < num_fonts; i++)
646 char *p0 = names[i], *p1, buf[512];
647 Lisp_Object family;
648 int decoded_len;
650 p0++; /* skip the leading '-' */
651 while (*p0 && *p0 != '-') p0++; /* skip foundry */
652 if (! *p0)
653 continue;
654 p1 = ++p0;
655 while (*p1 && *p1 != '-') p1++; /* find the end of family */
656 if (! *p1 || p1 == p0)
657 continue;
658 if (last_len == p1 - p0
659 && memcmp (last_family, p0, last_len) == 0)
660 continue;
661 last_len = p1 - p0;
662 last_family = p0;
664 decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
665 family = font_intern_prop (p0, decoded_len, 1);
666 if (NILP (assq_no_quit (family, list)))
667 list = Fcons (family, list);
670 XFreeFontNames (names);
671 x_uncatch_errors ();
672 unblock_input ();
674 return list;
677 static Lisp_Object
678 xfont_open (struct frame *f, Lisp_Object entity, int pixel_size)
680 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
681 Display *display = dpyinfo->display;
682 char name[512];
683 int len;
684 unsigned long value;
685 Lisp_Object registry;
686 struct charset *encoding, *repertory;
687 Lisp_Object font_object, fullname;
688 struct font *font;
689 XFontStruct *xfont;
691 /* At first, check if we know how to encode characters for this
692 font. */
693 registry = AREF (entity, FONT_REGISTRY_INDEX);
694 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
696 FONT_ADD_LOG (" x:unknown registry", registry, Qnil);
697 return Qnil;
700 if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
701 pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
702 else if (pixel_size == 0)
704 if (FRAME_FONT (f))
705 pixel_size = FRAME_FONT (f)->pixel_size;
706 else
707 pixel_size = 14;
709 len = font_unparse_xlfd (entity, pixel_size, name, 512);
710 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
712 FONT_ADD_LOG (" x:unparse failed", entity, Qnil);
713 return Qnil;
716 block_input ();
717 x_catch_errors (display);
718 xfont = XLoadQueryFont (display, name);
719 if (x_had_errors_p (display))
721 /* This error is perhaps due to insufficient memory on X server.
722 Let's just ignore it. */
723 x_clear_errors (display);
724 xfont = NULL;
726 else if (! xfont)
728 /* Some version of X lists:
729 -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
730 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
731 but can open only:
732 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
734 -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
735 So, we try again with wildcards in RESX and RESY. */
736 Lisp_Object temp;
738 temp = copy_font_spec (entity);
739 ASET (temp, FONT_DPI_INDEX, Qnil);
740 len = font_unparse_xlfd (temp, pixel_size, name, 512);
741 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
743 FONT_ADD_LOG (" x:unparse failed", temp, Qnil);
744 return Qnil;
746 xfont = XLoadQueryFont (display, name);
747 if (x_had_errors_p (display))
749 /* This error is perhaps due to insufficient memory on X server.
750 Let's just ignore it. */
751 x_clear_errors (display);
752 xfont = NULL;
755 fullname = Qnil;
756 /* Try to get the full name of FONT. */
757 if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
759 char *p0, *p;
760 int dashes = 0;
762 p0 = p = XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
763 /* Count the number of dashes in the "full name".
764 If it is too few, this isn't really the font's full name,
765 so don't use it.
766 In X11R4, the fonts did not come with their canonical names
767 stored in them. */
768 while (*p)
770 if (*p == '-')
771 dashes++;
772 p++;
775 if (dashes >= 13)
777 len = xfont_decode_coding_xlfd (p0, -1, name);
778 fullname = Fdowncase (make_string (name, len));
780 XFree (p0);
782 x_uncatch_errors ();
783 unblock_input ();
785 if (! xfont)
787 FONT_ADD_LOG (" x:open failed", build_string (name), Qnil);
788 return Qnil;
791 font_object = font_make_object (VECSIZE (struct xfont_info),
792 entity, pixel_size);
793 ASET (font_object, FONT_TYPE_INDEX, Qx);
794 if (STRINGP (fullname))
796 font_parse_xlfd (SSDATA (fullname), SBYTES (fullname), font_object);
797 ASET (font_object, FONT_NAME_INDEX, fullname);
799 else
801 char buf[512];
803 len = xfont_decode_coding_xlfd (name, -1, buf);
804 ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
806 ASET (font_object, FONT_FULLNAME_INDEX, fullname);
807 ASET (font_object, FONT_FILE_INDEX, Qnil);
808 ASET (font_object, FONT_FORMAT_INDEX, Qx);
809 font = XFONT_OBJECT (font_object);
810 ((struct xfont_info *) font)->xfont = xfont;
811 ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
812 ((struct xfont_info *) font)->x_display_id = FRAME_DISPLAY_INFO (f)->x_id;
813 font->pixel_size = pixel_size;
814 font->driver = &xfont_driver;
815 font->encoding_charset = encoding->id;
816 font->repertory_charset = repertory ? repertory->id : -1;
817 font->ascent = xfont->ascent;
818 font->descent = xfont->descent;
819 font->height = font->ascent + font->descent;
820 font->min_width = xfont->min_bounds.width;
821 font->max_width = xfont->max_bounds.width;
822 if (xfont->min_bounds.width == xfont->max_bounds.width)
824 /* Fixed width font. */
825 font->average_width = font->space_width = xfont->min_bounds.width;
827 else
829 XCharStruct *pcm;
830 XChar2b char2b;
831 Lisp_Object val;
833 char2b.byte1 = 0x00, char2b.byte2 = 0x20;
834 pcm = xfont_get_pcm (xfont, &char2b);
835 if (pcm)
836 font->space_width = pcm->width;
837 else
838 font->space_width = 0;
840 val = Ffont_get (font_object, QCavgwidth);
841 if (INTEGERP (val))
842 font->average_width = XINT (val) / 10;
843 if (font->average_width < 0)
844 font->average_width = - font->average_width;
845 else
847 if (font->average_width == 0
848 && encoding->ascii_compatible_p)
850 int width = font->space_width, n = pcm != NULL;
852 for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
853 if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
854 width += pcm->width, n++;
855 if (n > 0)
856 font->average_width = width / n;
858 if (font->average_width == 0)
859 /* No easy way other than this to get a reasonable
860 average_width. */
861 font->average_width
862 = (xfont->min_bounds.width + xfont->max_bounds.width) / 2;
866 block_input ();
867 font->underline_thickness
868 = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
869 ? (long) value : 0);
870 font->underline_position
871 = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
872 ? (long) value : -1);
873 font->baseline_offset
874 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
875 ? (long) value : 0);
876 font->relative_compose
877 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
878 ? (long) value : 0);
879 font->default_ascent
880 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
881 ? (long) value : 0);
882 unblock_input ();
884 if (NILP (fullname))
885 fullname = AREF (font_object, FONT_NAME_INDEX);
886 font->vertical_centering
887 = (STRINGP (Vvertical_centering_font_regexp)
888 && (fast_string_match_ignore_case
889 (Vvertical_centering_font_regexp, fullname) >= 0));
891 return font_object;
894 static void
895 xfont_close (struct font *font)
897 struct x_display_info *xdi;
898 struct xfont_info *xfi = (struct xfont_info *) font;
900 /* This function may be called from GC when X connection is gone
901 (Bug#16093), and an attempt to free font resources on invalid
902 display may lead to X protocol errors or segfaults. Moreover,
903 the memory referenced by 'Display *' pointer may be reused for
904 the logically different X connection after the previous display
905 connection was closed. That's why we also check whether font's
906 ID matches the one recorded in x_display_info for this display.
907 See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16069. */
908 if (xfi->xfont
909 && ((xdi = x_display_info_for_display (xfi->display))
910 && xfi->x_display_id == xdi->x_id))
912 block_input ();
913 XFreeFont (xfi->display, xfi->xfont);
914 unblock_input ();
915 xfi->xfont = NULL;
919 static int
920 xfont_prepare_face (struct frame *f, struct face *face)
922 block_input ();
923 XSetFont (FRAME_X_DISPLAY (f), face->gc,
924 ((struct xfont_info *) face->font)->xfont->fid);
925 unblock_input ();
927 return 0;
930 static int
931 xfont_has_char (Lisp_Object font, int c)
933 Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
934 struct charset *encoding;
935 struct charset *repertory = NULL;
937 if (EQ (registry, Qiso10646_1))
939 encoding = CHARSET_FROM_ID (charset_unicode);
940 /* We use a font of `ja' and `ko' adstyle only for a character
941 in JISX0208 and KSC5601 charsets respectively. */
942 if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
943 && charset_jisx0208 >= 0)
944 repertory = CHARSET_FROM_ID (charset_jisx0208);
945 else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
946 && charset_ksc5601 >= 0)
947 repertory = CHARSET_FROM_ID (charset_ksc5601);
949 else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
950 /* Unknown REGISTRY, not usable. */
951 return 0;
952 if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
953 return 1;
954 if (! repertory)
955 return -1;
956 return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
959 static unsigned
960 xfont_encode_char (struct font *font, int c)
962 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
963 struct charset *charset;
964 unsigned code;
965 XChar2b char2b;
967 charset = CHARSET_FROM_ID (font->encoding_charset);
968 code = ENCODE_CHAR (charset, c);
969 if (code == CHARSET_INVALID_CODE (charset))
970 return FONT_INVALID_CODE;
971 if (font->repertory_charset >= 0)
973 charset = CHARSET_FROM_ID (font->repertory_charset);
974 return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
975 ? code : FONT_INVALID_CODE);
977 char2b.byte1 = code >> 8;
978 char2b.byte2 = code & 0xFF;
979 return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
982 static int
983 xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
985 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
986 int width = 0;
987 int i, first;
989 if (metrics)
990 memset (metrics, 0, sizeof (struct font_metrics));
991 for (i = 0, first = 1; i < nglyphs; i++)
993 XChar2b char2b;
994 static XCharStruct *pcm;
996 if (code[i] >= 0x10000)
997 continue;
998 char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
999 pcm = xfont_get_pcm (xfont, &char2b);
1000 if (! pcm)
1001 continue;
1002 if (first)
1004 if (metrics)
1006 metrics->lbearing = pcm->lbearing;
1007 metrics->rbearing = pcm->rbearing;
1008 metrics->ascent = pcm->ascent;
1009 metrics->descent = pcm->descent;
1011 first = 0;
1013 else
1015 if (metrics)
1017 if (metrics->lbearing > width + pcm->lbearing)
1018 metrics->lbearing = width + pcm->lbearing;
1019 if (metrics->rbearing < width + pcm->rbearing)
1020 metrics->rbearing = width + pcm->rbearing;
1021 if (metrics->ascent < pcm->ascent)
1022 metrics->ascent = pcm->ascent;
1023 if (metrics->descent < pcm->descent)
1024 metrics->descent = pcm->descent;
1027 width += pcm->width;
1029 if (metrics)
1030 metrics->width = width;
1031 return width;
1034 static int
1035 xfont_draw (struct glyph_string *s, int from, int to, int x, int y,
1036 bool with_background)
1038 XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1039 int len = to - from;
1040 GC gc = s->gc;
1041 int i;
1043 if (s->gc != s->face->gc)
1045 block_input ();
1046 XSetFont (s->display, gc, xfont->fid);
1047 unblock_input ();
1050 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1052 USE_SAFE_ALLOCA;
1053 char *str = SAFE_ALLOCA (len);
1054 for (i = 0; i < len ; i++)
1055 str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1056 block_input ();
1057 if (with_background)
1059 if (s->padding_p)
1060 for (i = 0; i < len; i++)
1061 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1062 gc, x + i, y, str + i, 1);
1063 else
1064 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1065 gc, x, y, str, len);
1067 else
1069 if (s->padding_p)
1070 for (i = 0; i < len; i++)
1071 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1072 gc, x + i, y, str + i, 1);
1073 else
1074 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1075 gc, x, y, str, len);
1077 unblock_input ();
1078 SAFE_FREE ();
1079 return s->nchars;
1082 block_input ();
1083 if (with_background)
1085 if (s->padding_p)
1086 for (i = 0; i < len; i++)
1087 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1088 gc, x + i, y, s->char2b + from + i, 1);
1089 else
1090 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1091 gc, x, y, s->char2b + from, len);
1093 else
1095 if (s->padding_p)
1096 for (i = 0; i < len; i++)
1097 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1098 gc, x + i, y, s->char2b + from + i, 1);
1099 else
1100 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1101 gc, x, y, s->char2b + from, len);
1103 unblock_input ();
1105 return len;
1108 static int
1109 xfont_check (struct frame *f, struct font *font)
1111 struct xfont_info *xfont = (struct xfont_info *) font;
1113 return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1117 void
1118 syms_of_xfont (void)
1120 staticpro (&xfont_scripts_cache);
1121 { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1122 is called fairly late, when QCtest and Qequal are known to be set. */
1123 Lisp_Object args[2];
1124 args[0] = QCtest;
1125 args[1] = Qequal;
1126 xfont_scripts_cache = Fmake_hash_table (2, args);
1128 staticpro (&xfont_scratch_props);
1129 xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
1130 xfont_driver.type = Qx;
1131 register_font_driver (&xfont_driver, NULL);