(c-guess-basic-syntax): Move CASE 19 to a different place, correctly to
[emacs.git] / src / xfont.c
blobf8aace3663c7eaee906d23c69d9a6b5b6e186b06
1 /* xfont.c -- X core font driver.
2 Copyright (C) 2006-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 <setjmp.h>
25 #include <X11/Xlib.h>
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"
36 #include "ccl.h"
39 /* X core font driver. */
41 struct xfont_info
43 struct font font;
44 Display *display;
45 XFontStruct *xfont;
48 /* Prototypes of support functions. */
49 extern void x_clear_errors (Display *);
51 static XCharStruct *xfont_get_pcm (XFontStruct *, XChar2b *);
53 /* Get metrics of character CHAR2B in XFONT. Value is null if CHAR2B
54 is not contained in the font. */
56 static XCharStruct *
57 xfont_get_pcm (XFontStruct *xfont, XChar2b *char2b)
59 /* The result metric information. */
60 XCharStruct *pcm = NULL;
62 font_assert (xfont && char2b);
64 if (xfont->per_char != NULL)
66 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
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;
79 else
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:
86 byte1 = N/D + min_byte1
87 byte2 = N\D + min_char_or_byte2
89 where:
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));
104 else
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;
114 return ((pcm == NULL
115 || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0))
116 ? NULL : pcm);
119 static Lisp_Object xfont_get_cache (FRAME_PTR);
120 static Lisp_Object xfont_list (Lisp_Object, Lisp_Object);
121 static Lisp_Object xfont_match (Lisp_Object, Lisp_Object);
122 static Lisp_Object xfont_list_family (Lisp_Object);
123 static Lisp_Object xfont_open (FRAME_PTR, Lisp_Object, int);
124 static void xfont_close (FRAME_PTR, struct font *);
125 static int xfont_prepare_face (FRAME_PTR, struct face *);
126 static int xfont_has_char (Lisp_Object, int);
127 static unsigned xfont_encode_char (struct font *, int);
128 static int xfont_text_extents (struct font *, unsigned *, int,
129 struct font_metrics *);
130 static int xfont_draw (struct glyph_string *, int, int, int, int, int);
131 static int xfont_check (FRAME_PTR, struct font *);
133 struct font_driver xfont_driver =
135 0, /* Qx */
136 0, /* case insensitive */
137 xfont_get_cache,
138 xfont_list,
139 xfont_match,
140 xfont_list_family,
141 NULL,
142 xfont_open,
143 xfont_close,
144 xfont_prepare_face,
145 NULL,
146 xfont_has_char,
147 xfont_encode_char,
148 xfont_text_extents,
149 xfont_draw,
150 NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
151 xfont_check,
152 NULL, /* get_variation_glyphs */
153 NULL, /* filter_properties */
156 static Lisp_Object
157 xfont_get_cache (FRAME_PTR f)
159 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
161 return (dpyinfo->name_list_element);
164 static int
165 compare_font_names (const void *name1, const void *name2)
167 return xstrcasecmp (*(const char **) name1,
168 *(const char **) name2);
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 int
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 1 if supported, return 0 otherwise. */
222 static int
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 int 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 scritps. Each key
276 is a vector of characteristic font propertis 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 properites. */
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 Fcons (intern ("kana"), Fcons (intern ("han"), Qnil));
300 if (EQ (AREF (props, 2), Qko))
301 return Fcons (intern ("hangul"), Qnil);
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 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 Lisp_Object entity;
401 if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
402 continue;
403 entity = font_make_entity ();
404 xfont_decode_coding_xlfd (indices[i], -1, buf);
405 if (font_parse_xlfd (buf, entity) < 0)
406 continue;
407 ASET (entity, FONT_TYPE_INDEX, Qx);
408 /* Avoid auto-scaled fonts. */
409 if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
410 && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
411 && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
412 && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
413 continue;
414 /* Avoid not-allowed scalable fonts. */
415 if (NILP (Vscalable_fonts_allowed))
417 int size = 0;
419 if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
420 size = XINT (AREF (entity, FONT_SIZE_INDEX));
421 else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
422 size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
423 if (size == 0)
424 continue;
426 else if (CONSP (Vscalable_fonts_allowed))
428 Lisp_Object tail, elt;
430 for (tail = Vscalable_fonts_allowed; CONSP (tail);
431 tail = XCDR (tail))
433 elt = XCAR (tail);
434 if (STRINGP (elt)
435 && fast_c_string_match_ignore_case (elt, indices[i]) >= 0)
436 break;
438 if (! CONSP (tail))
439 continue;
442 /* Avoid fonts of invalid registry. */
443 if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
444 continue;
446 /* Update encoding and repertory if necessary. */
447 if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
449 registry = AREF (entity, FONT_REGISTRY_INDEX);
450 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
451 encoding = NULL;
453 if (! encoding)
454 /* Unknown REGISTRY, not supported. */
455 continue;
456 if (repertory)
458 if (NILP (script)
459 || xfont_chars_supported (chars, NULL, encoding, repertory))
460 list = Fcons (entity, list);
461 continue;
463 if (memcmp (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
464 sizeof (Lisp_Object) * 7)
465 || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
467 memcpy (props, &(AREF (entity, FONT_FOUNDRY_INDEX)),
468 sizeof (Lisp_Object) * 7);
469 props[7] = AREF (entity, FONT_SPACING_INDEX);
470 scripts = xfont_supported_scripts (display, indices[i],
471 xfont_scratch_props, encoding);
473 if (NILP (script)
474 || ! NILP (Fmemq (script, scripts)))
475 list = Fcons (entity, list);
477 XFreeFontNames (names);
480 x_uncatch_errors ();
481 UNBLOCK_INPUT;
483 FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
484 return list;
487 static Lisp_Object
488 xfont_list (Lisp_Object frame, Lisp_Object spec)
490 FRAME_PTR f = XFRAME (frame);
491 Display *display = FRAME_X_DISPLAY_INFO (f)->display;
492 Lisp_Object registry, list, val, extra, script;
493 int len;
494 /* Large enough to contain the longest XLFD (255 bytes) in UTF-8. */
495 char name[512];
497 extra = AREF (spec, FONT_EXTRA_INDEX);
498 if (CONSP (extra))
500 val = assq_no_quit (QCotf, extra);
501 if (! NILP (val))
502 return Qnil;
503 val = assq_no_quit (QClang, extra);
504 if (! NILP (val))
505 return Qnil;
508 registry = AREF (spec, FONT_REGISTRY_INDEX);
509 len = font_unparse_xlfd (spec, 0, name, 512);
510 if (len < 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
511 return Qnil;
513 val = assq_no_quit (QCscript, extra);
514 script = CDR (val);
515 list = xfont_list_pattern (display, name, registry, script);
516 if (NILP (list) && NILP (registry))
518 /* Try iso10646-1 */
519 char *r = name + len - 9; /* 9 == strlen (iso8859-1) */
521 if (r - name + 10 < 256) /* 10 == strlen (iso10646-1) */
523 strcpy (r, "iso10646-1");
524 list = xfont_list_pattern (display, name, Qiso10646_1, script);
527 if (NILP (list) && ! NILP (registry))
529 /* Try alternate registries. */
530 Lisp_Object alter;
532 if ((alter = Fassoc (SYMBOL_NAME (registry),
533 Vface_alternative_font_registry_alist),
534 CONSP (alter)))
536 /* Pointer to REGISTRY-ENCODING field. */
537 char *r = name + len - SBYTES (SYMBOL_NAME (registry));
539 for (alter = XCDR (alter); CONSP (alter); alter = XCDR (alter))
540 if (STRINGP (XCAR (alter))
541 && ((r - name) + SBYTES (XCAR (alter))) < 256)
543 strcpy (r, SSDATA (XCAR (alter)));
544 list = xfont_list_pattern (display, name, registry, script);
545 if (! NILP (list))
546 break;
550 if (NILP (list))
552 /* Try alias. */
553 val = assq_no_quit (QCname, AREF (spec, FONT_EXTRA_INDEX));
554 if (CONSP (val) && STRINGP (XCDR (val)) && SBYTES (XCDR (val)) < 512)
556 memcpy (name, SDATA (XCDR (val)), SBYTES (XCDR (val)) + 1);
557 if (xfont_encode_coding_xlfd (name) < 0)
558 return Qnil;
559 list = xfont_list_pattern (display, name, registry, script);
563 return list;
566 static Lisp_Object
567 xfont_match (Lisp_Object frame, Lisp_Object spec)
569 FRAME_PTR f = XFRAME (frame);
570 Display *display = FRAME_X_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 int len;
598 char *s;
600 s = (char *) XGetAtomName (display, (Atom) value);
601 len = strlen (s);
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. */
606 if (len > 0)
608 entity = font_make_entity ();
609 ASET (entity, FONT_TYPE_INDEX, Qx);
610 xfont_decode_coding_xlfd (s, -1, name);
611 if (font_parse_xlfd (name, entity) < 0)
612 entity = Qnil;
614 XFree (s);
616 XFreeFont (display, xfont);
618 UNBLOCK_INPUT;
620 FONT_ADD_LOG ("xfont-match", spec, entity);
621 return entity;
624 static Lisp_Object
625 xfont_list_family (Lisp_Object frame)
627 FRAME_PTR f = XFRAME (frame);
628 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
629 char **names;
630 int num_fonts, i;
631 Lisp_Object list;
632 char *last_family;
633 int last_len;
635 BLOCK_INPUT;
636 x_catch_errors (dpyinfo->display);
637 names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
638 0x8000, &num_fonts);
639 if (x_had_errors_p (dpyinfo->display))
641 /* This error is perhaps due to insufficient memory on X server.
642 Let's just ignore it. */
643 x_clear_errors (dpyinfo->display);
644 num_fonts = 0;
647 list = Qnil;
648 for (i = 0, last_len = 0; i < num_fonts; i++)
650 char *p0 = names[i], *p1, buf[512];
651 Lisp_Object family;
652 int decoded_len;
654 p0++; /* skip the leading '-' */
655 while (*p0 && *p0 != '-') p0++; /* skip foundry */
656 if (! *p0)
657 continue;
658 p1 = ++p0;
659 while (*p1 && *p1 != '-') p1++; /* find the end of family */
660 if (! *p1 || p1 == p0)
661 continue;
662 if (last_len == p1 - p0
663 && memcmp (last_family, p0, last_len) == 0)
664 continue;
665 last_len = p1 - p0;
666 last_family = p0;
668 decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
669 family = font_intern_prop (p0, decoded_len, 1);
670 if (NILP (assq_no_quit (family, list)))
671 list = Fcons (family, list);
674 XFreeFontNames (names);
675 x_uncatch_errors ();
676 UNBLOCK_INPUT;
678 return list;
681 static Lisp_Object
682 xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
684 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
685 Display *display = dpyinfo->display;
686 char name[512];
687 int len;
688 unsigned long value;
689 Lisp_Object registry;
690 struct charset *encoding, *repertory;
691 Lisp_Object font_object, fullname;
692 struct font *font;
693 XFontStruct *xfont;
695 /* At first, check if we know how to encode characters for this
696 font. */
697 registry = AREF (entity, FONT_REGISTRY_INDEX);
698 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
700 FONT_ADD_LOG (" x:unknown registry", registry, Qnil);
701 return Qnil;
704 if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
705 pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
706 else if (pixel_size == 0)
708 if (FRAME_FONT (f))
709 pixel_size = FRAME_FONT (f)->pixel_size;
710 else
711 pixel_size = 14;
713 len = font_unparse_xlfd (entity, pixel_size, name, 512);
714 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
716 FONT_ADD_LOG (" x:unparse failed", entity, Qnil);
717 return Qnil;
720 BLOCK_INPUT;
721 x_catch_errors (display);
722 xfont = XLoadQueryFont (display, name);
723 if (x_had_errors_p (display))
725 /* This error is perhaps due to insufficient memory on X server.
726 Let's just ignore it. */
727 x_clear_errors (display);
728 xfont = NULL;
730 else if (! xfont)
732 /* Some version of X lists:
733 -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
734 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
735 but can open only:
736 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
738 -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
739 So, we try again with wildcards in RESX and RESY. */
740 Lisp_Object temp;
742 temp = Fcopy_font_spec (entity);
743 ASET (temp, FONT_DPI_INDEX, Qnil);
744 len = font_unparse_xlfd (temp, pixel_size, name, 512);
745 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
747 FONT_ADD_LOG (" x:unparse failed", temp, Qnil);
748 return Qnil;
750 xfont = XLoadQueryFont (display, name);
751 if (x_had_errors_p (display))
753 /* This error is perhaps due to insufficient memory on X server.
754 Let's just ignore it. */
755 x_clear_errors (display);
756 xfont = NULL;
759 fullname = Qnil;
760 /* Try to get the full name of FONT. */
761 if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
763 char *p0, *p;
764 int dashes = 0;
766 p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
767 /* Count the number of dashes in the "full name".
768 If it is too few, this isn't really the font's full name,
769 so don't use it.
770 In X11R4, the fonts did not come with their canonical names
771 stored in them. */
772 while (*p)
774 if (*p == '-')
775 dashes++;
776 p++;
779 if (dashes >= 13)
781 len = xfont_decode_coding_xlfd (p0, -1, name);
782 fullname = Fdowncase (make_string (name, len));
784 XFree (p0);
786 x_uncatch_errors ();
787 UNBLOCK_INPUT;
789 if (! xfont)
791 FONT_ADD_LOG (" x:open failed", build_string (name), Qnil);
792 return Qnil;
795 font_object = font_make_object (VECSIZE (struct xfont_info),
796 entity, pixel_size);
797 ASET (font_object, FONT_TYPE_INDEX, Qx);
798 if (STRINGP (fullname))
800 font_parse_xlfd (SSDATA (fullname), font_object);
801 ASET (font_object, FONT_NAME_INDEX, fullname);
803 else
805 char buf[512];
807 len = xfont_decode_coding_xlfd (name, -1, buf);
808 ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
810 ASET (font_object, FONT_FULLNAME_INDEX, fullname);
811 ASET (font_object, FONT_FILE_INDEX, Qnil);
812 ASET (font_object, FONT_FORMAT_INDEX, Qx);
813 font = XFONT_OBJECT (font_object);
814 ((struct xfont_info *) font)->xfont = xfont;
815 ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
816 font->pixel_size = pixel_size;
817 font->driver = &xfont_driver;
818 font->encoding_charset = encoding->id;
819 font->repertory_charset = repertory ? repertory->id : -1;
820 font->ascent = xfont->ascent;
821 font->descent = xfont->descent;
822 font->height = font->ascent + font->descent;
823 font->min_width = xfont->min_bounds.width;
824 if (xfont->min_bounds.width == xfont->max_bounds.width)
826 /* Fixed width font. */
827 font->average_width = font->space_width = xfont->min_bounds.width;
829 else
831 XCharStruct *pcm;
832 XChar2b char2b;
833 Lisp_Object val;
835 char2b.byte1 = 0x00, char2b.byte2 = 0x20;
836 pcm = xfont_get_pcm (xfont, &char2b);
837 if (pcm)
838 font->space_width = pcm->width;
839 else
840 font->space_width = 0;
842 val = Ffont_get (font_object, QCavgwidth);
843 if (INTEGERP (val))
844 font->average_width = XINT (val) / 10;
845 if (font->average_width < 0)
846 font->average_width = - font->average_width;
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;
865 BLOCK_INPUT;
866 font->underline_thickness
867 = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
868 ? (long) value : 0);
869 font->underline_position
870 = (XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &value)
871 ? (long) value : -1);
872 font->baseline_offset
873 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value)
874 ? (long) value : 0);
875 font->relative_compose
876 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value)
877 ? (long) value : 0);
878 font->default_ascent
879 = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
880 ? (long) value : 0);
881 UNBLOCK_INPUT;
883 if (NILP (fullname))
884 fullname = AREF (font_object, FONT_NAME_INDEX);
885 font->vertical_centering
886 = (STRINGP (Vvertical_centering_font_regexp)
887 && (fast_string_match_ignore_case
888 (Vvertical_centering_font_regexp, fullname) >= 0));
890 return font_object;
893 static void
894 xfont_close (FRAME_PTR f, struct font *font)
896 BLOCK_INPUT;
897 XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
898 UNBLOCK_INPUT;
901 static int
902 xfont_prepare_face (FRAME_PTR f, struct face *face)
904 BLOCK_INPUT;
905 XSetFont (FRAME_X_DISPLAY (f), face->gc,
906 ((struct xfont_info *) face->font)->xfont->fid);
907 UNBLOCK_INPUT;
909 return 0;
912 static int
913 xfont_has_char (Lisp_Object font, int c)
915 Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
916 struct charset *encoding;
917 struct charset *repertory = NULL;
919 if (EQ (registry, Qiso10646_1))
921 encoding = CHARSET_FROM_ID (charset_unicode);
922 /* We use a font of `ja' and `ko' adstyle only for a character
923 in JISX0208 and KSC5601 charsets respectively. */
924 if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
925 && charset_jisx0208 >= 0)
926 repertory = CHARSET_FROM_ID (charset_jisx0208);
927 else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
928 && charset_ksc5601 >= 0)
929 repertory = CHARSET_FROM_ID (charset_ksc5601);
931 else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
932 /* Unknown REGISTRY, not usable. */
933 return 0;
934 if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
935 return 1;
936 if (! repertory)
937 return -1;
938 return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
941 static unsigned
942 xfont_encode_char (struct font *font, int c)
944 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
945 struct charset *charset;
946 unsigned code;
947 XChar2b char2b;
949 charset = CHARSET_FROM_ID (font->encoding_charset);
950 code = ENCODE_CHAR (charset, c);
951 if (code == CHARSET_INVALID_CODE (charset))
952 return FONT_INVALID_CODE;
953 if (font->repertory_charset >= 0)
955 charset = CHARSET_FROM_ID (font->repertory_charset);
956 return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
957 ? code : FONT_INVALID_CODE);
959 char2b.byte1 = code >> 8;
960 char2b.byte2 = code & 0xFF;
961 return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
964 static int
965 xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
967 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
968 int width = 0;
969 int i, first, x;
971 if (metrics)
972 memset (metrics, 0, sizeof (struct font_metrics));
973 for (i = 0, x = 0, first = 1; i < nglyphs; i++)
975 XChar2b char2b;
976 static XCharStruct *pcm;
978 if (code[i] >= 0x10000)
979 continue;
980 char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
981 pcm = xfont_get_pcm (xfont, &char2b);
982 if (! pcm)
983 continue;
984 if (first)
986 if (metrics)
988 metrics->lbearing = pcm->lbearing;
989 metrics->rbearing = pcm->rbearing;
990 metrics->ascent = pcm->ascent;
991 metrics->descent = pcm->descent;
993 first = 0;
995 else
997 if (metrics)
999 if (metrics->lbearing > width + pcm->lbearing)
1000 metrics->lbearing = width + pcm->lbearing;
1001 if (metrics->rbearing < width + pcm->rbearing)
1002 metrics->rbearing = width + pcm->rbearing;
1003 if (metrics->ascent < pcm->ascent)
1004 metrics->ascent = pcm->ascent;
1005 if (metrics->descent < pcm->descent)
1006 metrics->descent = pcm->descent;
1009 width += pcm->width;
1011 if (metrics)
1012 metrics->width = width;
1013 return width;
1016 static int
1017 xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
1019 XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1020 int len = to - from;
1021 GC gc = s->gc;
1022 int i;
1024 if (s->gc != s->face->gc)
1026 BLOCK_INPUT;
1027 XSetFont (s->display, gc, xfont->fid);
1028 UNBLOCK_INPUT;
1031 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1033 char *str;
1034 USE_SAFE_ALLOCA;
1036 SAFE_ALLOCA (str, char *, len);
1037 for (i = 0; i < len ; i++)
1038 str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1039 BLOCK_INPUT;
1040 if (with_background > 0)
1042 if (s->padding_p)
1043 for (i = 0; i < len; i++)
1044 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1045 gc, x + i, y, str + i, 1);
1046 else
1047 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1048 gc, x, y, str, len);
1050 else
1052 if (s->padding_p)
1053 for (i = 0; i < len; i++)
1054 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1055 gc, x + i, y, str + i, 1);
1056 else
1057 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1058 gc, x, y, str, len);
1060 UNBLOCK_INPUT;
1061 SAFE_FREE ();
1062 return s->nchars;
1065 BLOCK_INPUT;
1066 if (with_background > 0)
1068 if (s->padding_p)
1069 for (i = 0; i < len; i++)
1070 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1071 gc, x + i, y, s->char2b + from + i, 1);
1072 else
1073 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1074 gc, x, y, s->char2b + from, len);
1076 else
1078 if (s->padding_p)
1079 for (i = 0; i < len; i++)
1080 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1081 gc, x + i, y, s->char2b + from + i, 1);
1082 else
1083 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1084 gc, x, y, s->char2b + from, len);
1086 UNBLOCK_INPUT;
1088 return len;
1091 static int
1092 xfont_check (FRAME_PTR f, struct font *font)
1094 struct xfont_info *xfont = (struct xfont_info *) font;
1096 return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1100 void
1101 syms_of_xfont (void)
1103 staticpro (&xfont_scripts_cache);
1104 { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1105 is called fairly late, when QCtest and Qequal are known to be set. */
1106 Lisp_Object args[2];
1107 args[0] = QCtest;
1108 args[1] = Qequal;
1109 xfont_scripts_cache = Fmake_hash_table (2, args);
1111 staticpro (&xfont_scratch_props);
1112 xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
1113 xfont_driver.type = Qx;
1114 register_font_driver (&xfont_driver, NULL);