Use correct match group (bug#8438).
[emacs.git] / src / xfont.c
blob7f7d5d25eb4d0037a877990ff3ab5f1b78c87ede
1 /* xfont.c -- X core font driver.
2 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 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 <stdlib.h>
25 #include <setjmp.h>
26 #include <X11/Xlib.h>
28 #include "lisp.h"
29 #include "dispextern.h"
30 #include "xterm.h"
31 #include "frame.h"
32 #include "blockinput.h"
33 #include "character.h"
34 #include "charset.h"
35 #include "fontset.h"
36 #include "font.h"
37 #include "ccl.h"
40 /* X core font driver. */
42 struct xfont_info
44 struct font font;
45 Display *display;
46 XFontStruct *xfont;
49 /* Prototypes of support functions. */
50 extern void x_clear_errors P_ ((Display *));
52 static XCharStruct *xfont_get_pcm P_ ((XFontStruct *, XChar2b *));
54 /* Get metrics of character CHAR2B in XFONT. Value is null if CHAR2B
55 is not contained in the font. */
57 static XCharStruct *
58 xfont_get_pcm (xfont, char2b)
59 XFontStruct *xfont;
60 XChar2b *char2b;
62 /* The result metric information. */
63 XCharStruct *pcm = NULL;
65 font_assert (xfont && char2b);
67 if (xfont->per_char != NULL)
69 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
71 /* min_char_or_byte2 specifies the linear character index
72 corresponding to the first element of the per_char array,
73 max_char_or_byte2 is the index of the last character. A
74 character with non-zero CHAR2B->byte1 is not in the font.
75 A character with byte2 less than min_char_or_byte2 or
76 greater max_char_or_byte2 is not in the font. */
77 if (char2b->byte1 == 0
78 && char2b->byte2 >= xfont->min_char_or_byte2
79 && char2b->byte2 <= xfont->max_char_or_byte2)
80 pcm = xfont->per_char + char2b->byte2 - xfont->min_char_or_byte2;
82 else
84 /* If either min_byte1 or max_byte1 are nonzero, both
85 min_char_or_byte2 and max_char_or_byte2 are less than
86 256, and the 2-byte character index values corresponding
87 to the per_char array element N (counting from 0) are:
89 byte1 = N/D + min_byte1
90 byte2 = N\D + min_char_or_byte2
92 where:
94 D = max_char_or_byte2 - min_char_or_byte2 + 1
95 / = integer division
96 \ = integer modulus */
97 if (char2b->byte1 >= xfont->min_byte1
98 && char2b->byte1 <= xfont->max_byte1
99 && char2b->byte2 >= xfont->min_char_or_byte2
100 && char2b->byte2 <= xfont->max_char_or_byte2)
101 pcm = (xfont->per_char
102 + ((xfont->max_char_or_byte2 - xfont->min_char_or_byte2 + 1)
103 * (char2b->byte1 - xfont->min_byte1))
104 + (char2b->byte2 - xfont->min_char_or_byte2));
107 else
109 /* If the per_char pointer is null, all glyphs between the first
110 and last character indexes inclusive have the same
111 information, as given by both min_bounds and max_bounds. */
112 if (char2b->byte2 >= xfont->min_char_or_byte2
113 && char2b->byte2 <= xfont->max_char_or_byte2)
114 pcm = &xfont->max_bounds;
117 return ((pcm == NULL
118 || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0))
119 ? NULL : pcm);
122 static Lisp_Object xfont_get_cache P_ ((FRAME_PTR));
123 static Lisp_Object xfont_list P_ ((Lisp_Object, Lisp_Object));
124 static Lisp_Object xfont_match P_ ((Lisp_Object, Lisp_Object));
125 static Lisp_Object xfont_list_family P_ ((Lisp_Object));
126 static Lisp_Object xfont_open P_ ((FRAME_PTR, Lisp_Object, int));
127 static void xfont_close P_ ((FRAME_PTR, struct font *));
128 static int xfont_prepare_face P_ ((FRAME_PTR, struct face *));
129 static int xfont_has_char P_ ((Lisp_Object, int));
130 static unsigned xfont_encode_char P_ ((struct font *, int));
131 static int xfont_text_extents P_ ((struct font *, unsigned *, int,
132 struct font_metrics *));
133 static int xfont_draw P_ ((struct glyph_string *, int, int, int, int, int));
134 static int xfont_check P_ ((FRAME_PTR, struct font *));
136 struct font_driver xfont_driver =
138 0, /* Qx */
139 0, /* case insensitive */
140 xfont_get_cache,
141 xfont_list,
142 xfont_match,
143 xfont_list_family,
144 NULL,
145 xfont_open,
146 xfont_close,
147 xfont_prepare_face,
148 NULL,
149 xfont_has_char,
150 xfont_encode_char,
151 xfont_text_extents,
152 xfont_draw,
153 NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
154 xfont_check,
155 NULL, /* get_variation_glyphs */
156 NULL, /* filter_properties */
159 extern Lisp_Object QCname;
161 static Lisp_Object
162 xfont_get_cache (f)
163 FRAME_PTR f;
165 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
167 return (dpyinfo->name_list_element);
170 extern Lisp_Object Vface_alternative_font_registry_alist;
172 static int
173 compare_font_names (const void *name1, const void *name2)
175 return xstrcasecmp (*(const unsigned char **) name1,
176 *(const unsigned char **) name2);
179 /* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length
180 of the decoding result. LEN is the byte length of XLFD, or -1 if
181 XLFD is NULL terminated. The caller must assure that OUTPUT is at
182 least twice (plus 1) as large as XLFD. */
184 static int
185 xfont_decode_coding_xlfd (char *xlfd, int len, char *output)
187 char *p0 = xlfd, *p1 = output;
188 int c;
190 while (*p0)
192 c = *(unsigned char *) p0++;
193 p1 += CHAR_STRING (c, p1);
194 if (--len == 0)
195 break;
197 *p1 = 0;
198 return (p1 - output);
201 /* Encode XLFD from UTF-8 to iso-8859-1 destructively, and return the
202 resulting byte length. If XLFD contains unencodable character,
203 return -1. */
205 static int
206 xfont_encode_coding_xlfd (char *xlfd)
208 const unsigned char *p0 = (unsigned char *) xlfd;
209 unsigned char *p1 = (unsigned char *) xlfd;
210 int len = 0;
212 while (*p0)
214 int c = STRING_CHAR_ADVANCE (p0);
216 if (c >= 0x100)
217 return -1;
218 *p1++ = c;
219 len++;
221 *p1 = 0;
222 return len;
225 /* Check if CHARS (cons or vector) is supported by XFONT whose
226 encoding charset is ENCODING (XFONT is NULL) or by a font whose
227 registry corresponds to ENCODING and REPERTORY.
228 Return 1 if supported, return 0 otherwise. */
230 static int
231 xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
232 struct charset *encoding, struct charset *repertory)
234 struct charset *charset = repertory ? repertory : encoding;
236 if (CONSP (chars))
238 for (; CONSP (chars); chars = XCDR (chars))
240 int c = XINT (XCAR (chars));
241 unsigned code = ENCODE_CHAR (charset, c);
242 XChar2b char2b;
244 if (code == CHARSET_INVALID_CODE (charset))
245 break;
246 if (! xfont)
247 continue;
248 if (code >= 0x10000)
249 break;
250 char2b.byte1 = code >> 8;
251 char2b.byte2 = code & 0xFF;
252 if (! xfont_get_pcm (xfont, &char2b))
253 break;
255 return (NILP (chars));
257 else if (VECTORP (chars))
259 int i;
261 for (i = ASIZE (chars) - 1; i >= 0; i--)
263 int c = XINT (AREF (chars, i));
264 unsigned code = ENCODE_CHAR (charset, c);
265 XChar2b char2b;
267 if (code == CHARSET_INVALID_CODE (charset))
268 continue;
269 if (! xfont)
270 break;
271 if (code >= 0x10000)
272 continue;
273 char2b.byte1 = code >> 8;
274 char2b.byte2 = code & 0xFF;
275 if (xfont_get_pcm (xfont, &char2b))
276 break;
278 return (i >= 0);
280 return 0;
283 /* A hash table recoding which font supports which scritps. Each key
284 is a vector of characteristic font propertis FOUNDRY to WIDTH and
285 ADDSTYLE, and each value is a list of script symbols.
287 We assume that fonts that have the same value in the above
288 properties supports the same set of characters on all displays. */
290 static Lisp_Object xfont_scripts_cache;
292 /* Re-usable vector to store characteristic font properites. */
293 static Lisp_Object xfont_scratch_props;
295 extern Lisp_Object Qlatin;
297 /* Return a list of scripts supported by the font of FONTNAME whose
298 characteristic properties are in PROPS and whose encoding charset
299 is ENCODING. A caller must call BLOCK_INPUT in advance. */
301 static Lisp_Object
302 xfont_supported_scripts (Display *display, char *fontname, Lisp_Object props,
303 struct charset *encoding)
305 Lisp_Object scripts;
307 /* Two special cases to avoid opening rather big fonts. */
308 if (EQ (AREF (props, 2), Qja))
309 return Fcons (intern ("kana"), Fcons (intern ("han"), Qnil));
310 if (EQ (AREF (props, 2), Qko))
311 return Fcons (intern ("hangul"), Qnil);
312 scripts = Fgethash (props, xfont_scripts_cache, Qt);
313 if (EQ (scripts, Qt))
315 XFontStruct *xfont;
316 Lisp_Object val;
318 scripts = Qnil;
319 xfont = XLoadQueryFont (display, fontname);
320 if (xfont)
322 if (xfont->per_char)
324 for (val = Vscript_representative_chars; CONSP (val);
325 val = XCDR (val))
326 if (CONSP (XCAR (val)) && SYMBOLP (XCAR (XCAR (val))))
328 Lisp_Object script = XCAR (XCAR (val));
329 Lisp_Object chars = XCDR (XCAR (val));
331 if (xfont_chars_supported (chars, xfont, encoding, NULL))
332 scripts = Fcons (script, scripts);
335 XFreeFont (display, xfont);
337 if (EQ (AREF (props, 3), Qiso10646_1)
338 && NILP (Fmemq (Qlatin, scripts)))
339 scripts = Fcons (Qlatin, scripts);
340 Fputhash (Fcopy_sequence (props), scripts, xfont_scripts_cache);
342 return scripts;
345 extern Lisp_Object Vscalable_fonts_allowed;
347 static Lisp_Object
348 xfont_list_pattern (Display *display, char *pattern,
349 Lisp_Object registry, Lisp_Object script)
351 Lisp_Object list = Qnil;
352 Lisp_Object chars = Qnil;
353 struct charset *encoding, *repertory = NULL;
354 int i, limit, num_fonts;
355 char **names;
356 /* Large enough to decode the longest XLFD (255 bytes). */
357 char buf[512];
359 if (! NILP (registry)
360 && font_registry_charsets (registry, &encoding, &repertory) < 0)
361 /* Unknown REGISTRY, not supported. */
362 return Qnil;
363 if (! NILP (script))
365 chars = assq_no_quit (script, Vscript_representative_chars);
366 if (NILP (chars))
367 /* We can't tell whether or not a font supports SCRIPT. */
368 return Qnil;
369 chars = XCDR (chars);
370 if (repertory)
372 if (! xfont_chars_supported (chars, NULL, encoding, repertory))
373 return Qnil;
374 script = Qnil;
378 BLOCK_INPUT;
379 x_catch_errors (display);
381 for (limit = 512; ; limit *= 2)
383 names = XListFonts (display, pattern, limit, &num_fonts);
384 if (x_had_errors_p (display))
386 /* This error is perhaps due to insufficient memory on X
387 server. Let's just ignore it. */
388 x_clear_errors (display);
389 num_fonts = 0;
390 break;
392 if (num_fonts < limit)
393 break;
394 XFreeFontNames (names);
397 if (num_fonts > 0)
399 char **indices = alloca (sizeof (char *) * num_fonts);
400 Lisp_Object *props = XVECTOR (xfont_scratch_props)->contents;
401 Lisp_Object scripts = Qnil;
403 for (i = 0; i < ASIZE (xfont_scratch_props); i++)
404 props[i] = Qnil;
405 for (i = 0; i < num_fonts; i++)
406 indices[i] = names[i];
407 qsort (indices, num_fonts, sizeof (char *), compare_font_names);
409 for (i = 0; i < num_fonts; i++)
411 Lisp_Object entity;
413 if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
414 continue;
415 entity = font_make_entity ();
416 xfont_decode_coding_xlfd (indices[i], -1, buf);
417 if (font_parse_xlfd (buf, entity) < 0)
418 continue;
419 ASET (entity, FONT_TYPE_INDEX, Qx);
420 /* Avoid auto-scaled fonts. */
421 if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
422 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
423 && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
424 && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
425 continue;
426 /* Avoid not-allowed scalable fonts. */
427 if (NILP (Vscalable_fonts_allowed))
429 int size = 0;
431 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
432 size = XINT (AREF (entity, FONT_SIZE_INDEX));
433 else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
434 size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
435 if (size == 0)
436 continue;
438 else if (CONSP (Vscalable_fonts_allowed))
440 Lisp_Object tail, elt;
442 for (tail = Vscalable_fonts_allowed; CONSP (tail);
443 tail = XCDR (tail))
445 elt = XCAR (tail);
446 if (STRINGP (elt)
447 && fast_c_string_match_ignore_case (elt, indices[i]) >= 0)
448 break;
450 if (! CONSP (tail))
451 continue;
454 /* Avoid fonts of invalid registry. */
455 if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
456 continue;
458 /* Update encoding and repertory if necessary. */
459 if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
461 registry = AREF (entity, FONT_REGISTRY_INDEX);
462 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
463 encoding = NULL;
465 if (! encoding)
466 /* Unknown REGISTRY, not supported. */
467 continue;
468 if (repertory)
470 if (NILP (script)
471 || xfont_chars_supported (chars, NULL, encoding, repertory))
472 list = Fcons (entity, list);
473 continue;
475 if (memcmp (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
476 sizeof (Lisp_Object) * 7)
477 || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
479 memcpy (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
480 sizeof (Lisp_Object) * 7);
481 props[7] = AREF (entity, FONT_SPACING_INDEX);
482 scripts = xfont_supported_scripts (display, indices[i],
483 xfont_scratch_props, encoding);
485 if (NILP (script)
486 || ! NILP (Fmemq (script, scripts)))
487 list = Fcons (entity, list);
489 XFreeFontNames (names);
492 x_uncatch_errors ();
493 UNBLOCK_INPUT;
495 FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
496 return list;
499 static Lisp_Object
500 xfont_list (frame, spec)
501 Lisp_Object frame, spec;
503 FRAME_PTR f = XFRAME (frame);
504 Display *display = FRAME_X_DISPLAY_INFO (f)->display;
505 Lisp_Object registry, list, val, extra, script;
506 int len;
507 /* Large enough to contain the longest XLFD (255 bytes) in UTF-8. */
508 char name[512];
510 extra = AREF (spec, FONT_EXTRA_INDEX);
511 if (CONSP (extra))
513 val = assq_no_quit (QCotf, extra);
514 if (! NILP (val))
515 return Qnil;
516 val = assq_no_quit (QClang, extra);
517 if (! NILP (val))
518 return Qnil;
521 registry = AREF (spec, FONT_REGISTRY_INDEX);
522 len = font_unparse_xlfd (spec, 0, name, 512);
523 if (len < 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
524 return Qnil;
526 val = assq_no_quit (QCscript, extra);
527 script = CDR (val);
528 list = xfont_list_pattern (display, name, registry, script);
529 if (NILP (list) && NILP (registry))
531 /* Try iso10646-1 */
532 char *r = name + len - 9; /* 9 == strlen (iso8859-1) */
534 if (r - name + 10 < 256) /* 10 == strlen (iso10646-1) */
536 strcpy (r, "iso10646-1");
537 list = xfont_list_pattern (display, name, Qiso10646_1, script);
540 if (NILP (list) && ! NILP (registry))
542 /* Try alternate registries. */
543 Lisp_Object alter;
545 if ((alter = Fassoc (SYMBOL_NAME (registry),
546 Vface_alternative_font_registry_alist),
547 CONSP (alter)))
549 /* Pointer to REGISTRY-ENCODING field. */
550 char *r = name + len - SBYTES (SYMBOL_NAME (registry));
552 for (alter = XCDR (alter); CONSP (alter); alter = XCDR (alter))
553 if (STRINGP (XCAR (alter))
554 && ((r - name) + SBYTES (XCAR (alter))) < 256)
556 strcpy (r, (char *) SDATA (XCAR (alter)));
557 list = xfont_list_pattern (display, name, registry, script);
558 if (! NILP (list))
559 break;
563 if (NILP (list))
565 /* Try alias. */
566 val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
567 if (CONSP (val) && STRINGP (XCDR (val)) && SBYTES (XCDR (val)) < 512)
569 bcopy (SDATA (XCDR (val)), name, SBYTES (XCDR (val)) + 1);
570 if (xfont_encode_coding_xlfd (name) < 0)
571 return Qnil;
572 list = xfont_list_pattern (display, name, registry, script);
576 return list;
579 static Lisp_Object
580 xfont_match (frame, spec)
581 Lisp_Object frame, spec;
583 FRAME_PTR f = XFRAME (frame);
584 Display *display = FRAME_X_DISPLAY_INFO (f)->display;
585 Lisp_Object extra, val, entity;
586 char name[512];
587 XFontStruct *xfont;
588 unsigned long value;
590 extra = AREF (spec, FONT_EXTRA_INDEX);
591 val = assq_no_quit (QCname, extra);
592 if (! CONSP (val) || ! STRINGP (XCDR (val)))
594 if (font_unparse_xlfd (spec, 0, name, 512) < 0)
595 return Qnil;
597 else if (SBYTES (XCDR (val)) < 512)
598 bcopy (SDATA (XCDR (val)), name, SBYTES (XCDR (val)) + 1);
599 else
600 return Qnil;
601 if (xfont_encode_coding_xlfd (name) < 0)
602 return Qnil;
604 BLOCK_INPUT;
605 entity = Qnil;
606 xfont = XLoadQueryFont (display, name);
607 if (xfont)
609 if (XGetFontProperty (xfont, XA_FONT, &value))
611 int len;
612 char *s;
614 s = (char *) XGetAtomName (display, (Atom) value);
615 len = strlen (s);
617 /* If DXPC (a Differential X Protocol Compressor)
618 Ver.3.7 is running, XGetAtomName will return null
619 string. We must avoid such a name. */
620 if (len > 0)
622 entity = font_make_entity ();
623 ASET (entity, FONT_TYPE_INDEX, Qx);
624 xfont_decode_coding_xlfd (s, -1, name);
625 if (font_parse_xlfd (name, entity) < 0)
626 entity = Qnil;
628 XFree (s);
630 XFreeFont (display, xfont);
632 UNBLOCK_INPUT;
634 FONT_ADD_LOG ("xfont-match", spec, entity);
635 return entity;
638 static Lisp_Object
639 xfont_list_family (frame)
640 Lisp_Object frame;
642 FRAME_PTR f = XFRAME (frame);
643 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
644 char **names;
645 int num_fonts, i;
646 Lisp_Object list;
647 char *last_family;
648 int last_len;
650 BLOCK_INPUT;
651 x_catch_errors (dpyinfo->display);
652 names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
653 0x8000, &num_fonts);
654 if (x_had_errors_p (dpyinfo->display))
656 /* This error is perhaps due to insufficient memory on X server.
657 Let's just ignore it. */
658 x_clear_errors (dpyinfo->display);
659 num_fonts = 0;
662 list = Qnil;
663 for (i = 0, last_len = 0; i < num_fonts; i++)
665 char *p0 = names[i], *p1, buf[512];
666 Lisp_Object family;
667 int decoded_len;
669 p0++; /* skip the leading '-' */
670 while (*p0 && *p0 != '-') p0++; /* skip foundry */
671 if (! *p0)
672 continue;
673 p1 = ++p0;
674 while (*p1 && *p1 != '-') p1++; /* find the end of family */
675 if (! *p1 || p1 == p0)
676 continue;
677 if (last_len == p1 - p0
678 && bcmp (last_family, p0, last_len) == 0)
679 continue;
680 last_len = p1 - p0;
681 last_family = p0;
683 decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
684 family = font_intern_prop (p0, decoded_len, 1);
685 if (NILP (assq_no_quit (family, list)))
686 list = Fcons (family, list);
689 XFreeFontNames (names);
690 x_uncatch_errors ();
691 UNBLOCK_INPUT;
693 return list;
696 extern Lisp_Object QCavgwidth;
698 static Lisp_Object
699 xfont_open (f, entity, pixel_size)
700 FRAME_PTR f;
701 Lisp_Object entity;
702 int pixel_size;
704 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
705 Display *display = dpyinfo->display;
706 char name[512];
707 int len;
708 unsigned long value;
709 Lisp_Object registry;
710 struct charset *encoding, *repertory;
711 Lisp_Object font_object, fullname;
712 struct font *font;
713 XFontStruct *xfont;
715 /* At first, check if we know how to encode characters for this
716 font. */
717 registry = AREF (entity, FONT_REGISTRY_INDEX);
718 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
720 FONT_ADD_LOG (" x:unknown registry", registry, Qnil);
721 return Qnil;
724 if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
725 pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
726 else if (pixel_size == 0)
728 if (FRAME_FONT (f))
729 pixel_size = FRAME_FONT (f)->pixel_size;
730 else
731 pixel_size = 14;
733 len = font_unparse_xlfd (entity, pixel_size, name, 512);
734 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
736 FONT_ADD_LOG (" x:unparse failed", entity, Qnil);
737 return Qnil;
740 BLOCK_INPUT;
741 x_catch_errors (display);
742 xfont = XLoadQueryFont (display, name);
743 if (x_had_errors_p (display))
745 /* This error is perhaps due to insufficient memory on X server.
746 Let's just ignore it. */
747 x_clear_errors (display);
748 xfont = NULL;
750 else if (! xfont)
752 /* Some version of X lists:
753 -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
754 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
755 but can open only:
756 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
758 -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
759 So, we try again with wildcards in RESX and RESY. */
760 Lisp_Object temp;
762 temp = Fcopy_font_spec (entity);
763 ASET (temp, FONT_DPI_INDEX, Qnil);
764 len = font_unparse_xlfd (temp, pixel_size, name, 512);
765 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
767 FONT_ADD_LOG (" x:unparse failed", temp, Qnil);
768 return Qnil;
770 xfont = XLoadQueryFont (display, name);
771 if (x_had_errors_p (display))
773 /* This error is perhaps due to insufficient memory on X server.
774 Let's just ignore it. */
775 x_clear_errors (display);
776 xfont = NULL;
779 fullname = Qnil;
780 /* Try to get the full name of FONT. */
781 if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
783 char *p0, *p;
784 int dashes = 0;
786 p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
787 /* Count the number of dashes in the "full name".
788 If it is too few, this isn't really the font's full name,
789 so don't use it.
790 In X11R4, the fonts did not come with their canonical names
791 stored in them. */
792 while (*p)
794 if (*p == '-')
795 dashes++;
796 p++;
799 if (dashes >= 13)
801 len = xfont_decode_coding_xlfd (p0, -1, name);
802 fullname = Fdowncase (make_string (name, len));
804 XFree (p0);
806 x_uncatch_errors ();
807 UNBLOCK_INPUT;
809 if (! xfont)
811 FONT_ADD_LOG (" x:open failed", build_string (name), Qnil);
812 return Qnil;
815 font_object = font_make_object (VECSIZE (struct xfont_info),
816 entity, pixel_size);
817 ASET (font_object, FONT_TYPE_INDEX, Qx);
818 if (STRINGP (fullname))
820 font_parse_xlfd ((char *) SDATA (fullname), font_object);
821 ASET (font_object, FONT_NAME_INDEX, fullname);
823 else
825 char buf[512];
827 len = xfont_decode_coding_xlfd (name, -1, buf);
828 ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
830 ASET (font_object, FONT_FULLNAME_INDEX, fullname);
831 ASET (font_object, FONT_FILE_INDEX, Qnil);
832 ASET (font_object, FONT_FORMAT_INDEX, Qx);
833 font = XFONT_OBJECT (font_object);
834 ((struct xfont_info *) font)->xfont = xfont;
835 ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
836 font->pixel_size = pixel_size;
837 font->driver = &xfont_driver;
838 font->encoding_charset = encoding->id;
839 font->repertory_charset = repertory ? repertory->id : -1;
840 font->ascent = xfont->ascent;
841 font->descent = xfont->descent;
842 font->height = font->ascent + font->descent;
843 font->min_width = xfont->min_bounds.width;
844 if (xfont->min_bounds.width == xfont->max_bounds.width)
846 /* Fixed width font. */
847 font->average_width = font->space_width = xfont->min_bounds.width;
849 else
851 XCharStruct *pcm;
852 XChar2b char2b;
853 Lisp_Object val;
855 char2b.byte1 = 0x00, char2b.byte2 = 0x20;
856 pcm = xfont_get_pcm (xfont, &char2b);
857 if (pcm)
858 font->space_width = pcm->width;
859 else
860 font->space_width = 0;
862 val = Ffont_get (font_object, QCavgwidth);
863 if (INTEGERP (val))
864 font->average_width = XINT (val) / 10;
865 if (font->average_width < 0)
866 font->average_width = - font->average_width;
867 if (font->average_width == 0
868 && encoding->ascii_compatible_p)
870 int width = font->space_width, n = pcm != NULL;
872 for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++)
873 if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL)
874 width += pcm->width, n++;
875 if (n > 0)
876 font->average_width = width / n;
878 if (font->average_width == 0)
879 /* No easy way other than this to get a reasonable
880 average_width. */
881 font->average_width
882 = (xfont->min_bounds.width + xfont->max_bounds.width) / 2;
885 BLOCK_INPUT;
886 font->underline_thickness
887 = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
888 ? (long) value : 0);
889 font->underline_position
890 = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
891 ? (long) value : -1);
892 font->baseline_offset
893 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
894 ? (long) value : 0);
895 font->relative_compose
896 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
897 ? (long) value : 0);
898 font->default_ascent
899 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
900 ? (long) value : 0);
901 UNBLOCK_INPUT;
903 if (NILP (fullname))
904 fullname = AREF (font_object, FONT_NAME_INDEX);
905 font->vertical_centering
906 = (STRINGP (Vvertical_centering_font_regexp)
907 && (fast_string_match_ignore_case
908 (Vvertical_centering_font_regexp, fullname) >= 0));
910 return font_object;
913 static void
914 xfont_close (f, font)
915 FRAME_PTR f;
916 struct font *font;
918 BLOCK_INPUT;
919 XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
920 UNBLOCK_INPUT;
923 static int
924 xfont_prepare_face (f, face)
925 FRAME_PTR f;
926 struct face *face;
928 BLOCK_INPUT;
929 XSetFont (FRAME_X_DISPLAY (f), face->gc,
930 ((struct xfont_info *) face->font)->xfont->fid);
931 UNBLOCK_INPUT;
933 return 0;
936 static int
937 xfont_has_char (font, c)
938 Lisp_Object font;
939 int c;
941 Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
942 struct charset *encoding;
943 struct charset *repertory = NULL;
945 if (EQ (registry, Qiso10646_1))
947 encoding = CHARSET_FROM_ID (charset_unicode);
948 /* We use a font of `ja' and `ko' adstyle only for a character
949 in JISX0208 and KSC5601 charsets respectively. */
950 if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
951 && charset_jisx0208 >= 0)
952 repertory = CHARSET_FROM_ID (charset_jisx0208);
953 else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
954 && charset_ksc5601 >= 0)
955 repertory = CHARSET_FROM_ID (charset_ksc5601);
957 else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
958 /* Unknown REGISTRY, not usable. */
959 return 0;
960 if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
961 return 1;
962 if (! repertory)
963 return -1;
964 return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
967 static unsigned
968 xfont_encode_char (font, c)
969 struct font *font;
970 int c;
972 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
973 struct charset *charset;
974 unsigned code;
975 XChar2b char2b;
977 charset = CHARSET_FROM_ID (font->encoding_charset);
978 code = ENCODE_CHAR (charset, c);
979 if (code == CHARSET_INVALID_CODE (charset))
980 return FONT_INVALID_CODE;
981 if (font->repertory_charset >= 0)
983 charset = CHARSET_FROM_ID (font->repertory_charset);
984 return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
985 ? code : FONT_INVALID_CODE);
987 char2b.byte1 = code >> 8;
988 char2b.byte2 = code & 0xFF;
989 return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
992 static int
993 xfont_text_extents (font, code, nglyphs, metrics)
994 struct font *font;
995 unsigned *code;
996 int nglyphs;
997 struct font_metrics *metrics;
999 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
1000 int width = 0;
1001 int i, first, x;
1003 if (metrics)
1004 bzero (metrics, sizeof (struct font_metrics));
1005 for (i = 0, x = 0, first = 1; i < nglyphs; i++)
1007 XChar2b char2b;
1008 static XCharStruct *pcm;
1010 if (code[i] >= 0x10000)
1011 continue;
1012 char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
1013 pcm = xfont_get_pcm (xfont, &char2b);
1014 if (! pcm)
1015 continue;
1016 if (first)
1018 if (metrics)
1020 metrics->lbearing = pcm->lbearing;
1021 metrics->rbearing = pcm->rbearing;
1022 metrics->ascent = pcm->ascent;
1023 metrics->descent = pcm->descent;
1025 first = 0;
1027 else
1029 if (metrics)
1031 if (metrics->lbearing > width + pcm->lbearing)
1032 metrics->lbearing = width + pcm->lbearing;
1033 if (metrics->rbearing < width + pcm->rbearing)
1034 metrics->rbearing = width + pcm->rbearing;
1035 if (metrics->ascent < pcm->ascent)
1036 metrics->ascent = pcm->ascent;
1037 if (metrics->descent < pcm->descent)
1038 metrics->descent = pcm->descent;
1041 width += pcm->width;
1043 if (metrics)
1044 metrics->width = width;
1045 return width;
1048 static int
1049 xfont_draw (s, from, to, x, y, with_background)
1050 struct glyph_string *s;
1051 int from, to, x, y, with_background;
1053 XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1054 int len = to - from;
1055 GC gc = s->gc;
1056 int i;
1058 if (s->gc != s->face->gc)
1060 BLOCK_INPUT;
1061 XSetFont (s->display, gc, xfont->fid);
1062 UNBLOCK_INPUT;
1065 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1067 char *str;
1068 USE_SAFE_ALLOCA;
1070 SAFE_ALLOCA (str, char *, len);
1071 for (i = 0; i < len ; i++)
1072 str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1073 BLOCK_INPUT;
1074 if (with_background > 0)
1076 if (s->padding_p)
1077 for (i = 0; i < len; i++)
1078 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1079 gc, x + i, y, str + i, 1);
1080 else
1081 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1082 gc, x, y, str, len);
1084 else
1086 if (s->padding_p)
1087 for (i = 0; i < len; i++)
1088 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1089 gc, x + i, y, str + i, 1);
1090 else
1091 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1092 gc, x, y, str, len);
1094 UNBLOCK_INPUT;
1095 SAFE_FREE ();
1096 return s->nchars;
1099 BLOCK_INPUT;
1100 if (with_background > 0)
1102 if (s->padding_p)
1103 for (i = 0; i < len; i++)
1104 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1105 gc, x + i, y, s->char2b + from + i, 1);
1106 else
1107 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1108 gc, x, y, s->char2b + from, len);
1110 else
1112 if (s->padding_p)
1113 for (i = 0; i < len; i++)
1114 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1115 gc, x + i, y, s->char2b + from + i, 1);
1116 else
1117 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1118 gc, x, y, s->char2b + from, len);
1120 UNBLOCK_INPUT;
1122 return len;
1125 static int
1126 xfont_check (f, font)
1127 FRAME_PTR f;
1128 struct font *font;
1130 struct xfont_info *xfont = (struct xfont_info *) font;
1132 return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1136 void
1137 syms_of_xfont ()
1139 staticpro (&xfont_scripts_cache);
1140 { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1141 is called fairly late, when QCtest and Qequal are known to be set. */
1142 Lisp_Object args[2];
1143 args[0] = QCtest;
1144 args[1] = Qequal;
1145 xfont_scripts_cache = Fmake_hash_table (2, args);
1147 staticpro (&xfont_scratch_props);
1148 xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
1149 xfont_driver.type = Qx;
1150 register_font_driver (&xfont_driver, NULL);
1153 /* arch-tag: 23c5f366-a5ee-44b7-a3b7-90d6da7fd749
1154 (do not change this comment) */