Auto-commit of generated files.
[emacs.git] / src / xfont.c
blob25bb8a94fd9585f4973310bd938daaf75cfc41cc
1 /* xfont.c -- X core font driver.
2 Copyright (C) 2006-2012 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 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 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 char *s;
599 s = (char *) XGetAtomName (display, (Atom) value);
601 /* If DXPC (a Differential X Protocol Compressor)
602 Ver.3.7 is running, XGetAtomName will return null
603 string. We must avoid such a name. */
604 if (*s)
606 entity = font_make_entity ();
607 ASET (entity, FONT_TYPE_INDEX, Qx);
608 xfont_decode_coding_xlfd (s, -1, name);
609 if (font_parse_xlfd (name, entity) < 0)
610 entity = Qnil;
612 XFree (s);
614 XFreeFont (display, xfont);
616 UNBLOCK_INPUT;
618 FONT_ADD_LOG ("xfont-match", spec, entity);
619 return entity;
622 static Lisp_Object
623 xfont_list_family (Lisp_Object frame)
625 FRAME_PTR f = XFRAME (frame);
626 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
627 char **names;
628 int num_fonts, i;
629 Lisp_Object list;
630 char *last_family IF_LINT (= 0);
631 int last_len;
633 BLOCK_INPUT;
634 x_catch_errors (dpyinfo->display);
635 names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
636 0x8000, &num_fonts);
637 if (x_had_errors_p (dpyinfo->display))
639 /* This error is perhaps due to insufficient memory on X server.
640 Let's just ignore it. */
641 x_clear_errors (dpyinfo->display);
642 num_fonts = 0;
645 list = Qnil;
646 for (i = 0, last_len = 0; i < num_fonts; i++)
648 char *p0 = names[i], *p1, buf[512];
649 Lisp_Object family;
650 int decoded_len;
652 p0++; /* skip the leading '-' */
653 while (*p0 && *p0 != '-') p0++; /* skip foundry */
654 if (! *p0)
655 continue;
656 p1 = ++p0;
657 while (*p1 && *p1 != '-') p1++; /* find the end of family */
658 if (! *p1 || p1 == p0)
659 continue;
660 if (last_len == p1 - p0
661 && memcmp (last_family, p0, last_len) == 0)
662 continue;
663 last_len = p1 - p0;
664 last_family = p0;
666 decoded_len = xfont_decode_coding_xlfd (p0, last_len, buf);
667 family = font_intern_prop (p0, decoded_len, 1);
668 if (NILP (assq_no_quit (family, list)))
669 list = Fcons (family, list);
672 XFreeFontNames (names);
673 x_uncatch_errors ();
674 UNBLOCK_INPUT;
676 return list;
679 static Lisp_Object
680 xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size)
682 Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
683 Display *display = dpyinfo->display;
684 char name[512];
685 int len;
686 unsigned long value;
687 Lisp_Object registry;
688 struct charset *encoding, *repertory;
689 Lisp_Object font_object, fullname;
690 struct font *font;
691 XFontStruct *xfont;
693 /* At first, check if we know how to encode characters for this
694 font. */
695 registry = AREF (entity, FONT_REGISTRY_INDEX);
696 if (font_registry_charsets (registry, &encoding, &repertory) < 0)
698 FONT_ADD_LOG (" x:unknown registry", registry, Qnil);
699 return Qnil;
702 if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0)
703 pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX));
704 else if (pixel_size == 0)
706 if (FRAME_FONT (f))
707 pixel_size = FRAME_FONT (f)->pixel_size;
708 else
709 pixel_size = 14;
711 len = font_unparse_xlfd (entity, pixel_size, name, 512);
712 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
714 FONT_ADD_LOG (" x:unparse failed", entity, Qnil);
715 return Qnil;
718 BLOCK_INPUT;
719 x_catch_errors (display);
720 xfont = XLoadQueryFont (display, name);
721 if (x_had_errors_p (display))
723 /* This error is perhaps due to insufficient memory on X server.
724 Let's just ignore it. */
725 x_clear_errors (display);
726 xfont = NULL;
728 else if (! xfont)
730 /* Some version of X lists:
731 -misc-fixed-medium-r-normal--20-*-75-75-c-100-iso8859-1
732 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
733 but can open only:
734 -misc-fixed-medium-r-normal--20-*-100-100-c-100-iso8859-1
736 -misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1
737 So, we try again with wildcards in RESX and RESY. */
738 Lisp_Object temp;
740 temp = copy_font_spec (entity);
741 ASET (temp, FONT_DPI_INDEX, Qnil);
742 len = font_unparse_xlfd (temp, pixel_size, name, 512);
743 if (len <= 0 || (len = xfont_encode_coding_xlfd (name)) < 0)
745 FONT_ADD_LOG (" x:unparse failed", temp, Qnil);
746 return Qnil;
748 xfont = XLoadQueryFont (display, name);
749 if (x_had_errors_p (display))
751 /* This error is perhaps due to insufficient memory on X server.
752 Let's just ignore it. */
753 x_clear_errors (display);
754 xfont = NULL;
757 fullname = Qnil;
758 /* Try to get the full name of FONT. */
759 if (xfont && XGetFontProperty (xfont, XA_FONT, &value))
761 char *p0, *p;
762 int dashes = 0;
764 p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);
765 /* Count the number of dashes in the "full name".
766 If it is too few, this isn't really the font's full name,
767 so don't use it.
768 In X11R4, the fonts did not come with their canonical names
769 stored in them. */
770 while (*p)
772 if (*p == '-')
773 dashes++;
774 p++;
777 if (dashes >= 13)
779 len = xfont_decode_coding_xlfd (p0, -1, name);
780 fullname = Fdowncase (make_string (name, len));
782 XFree (p0);
784 x_uncatch_errors ();
785 UNBLOCK_INPUT;
787 if (! xfont)
789 FONT_ADD_LOG (" x:open failed", build_string (name), Qnil);
790 return Qnil;
793 font_object = font_make_object (VECSIZE (struct xfont_info),
794 entity, pixel_size);
795 ASET (font_object, FONT_TYPE_INDEX, Qx);
796 if (STRINGP (fullname))
798 font_parse_xlfd (SSDATA (fullname), font_object);
799 ASET (font_object, FONT_NAME_INDEX, fullname);
801 else
803 char buf[512];
805 len = xfont_decode_coding_xlfd (name, -1, buf);
806 ASET (font_object, FONT_NAME_INDEX, make_string (buf, len));
808 ASET (font_object, FONT_FULLNAME_INDEX, fullname);
809 ASET (font_object, FONT_FILE_INDEX, Qnil);
810 ASET (font_object, FONT_FORMAT_INDEX, Qx);
811 font = XFONT_OBJECT (font_object);
812 ((struct xfont_info *) font)->xfont = xfont;
813 ((struct xfont_info *) font)->display = FRAME_X_DISPLAY (f);
814 font->pixel_size = pixel_size;
815 font->driver = &xfont_driver;
816 font->encoding_charset = encoding->id;
817 font->repertory_charset = repertory ? repertory->id : -1;
818 font->ascent = xfont->ascent;
819 font->descent = xfont->descent;
820 font->height = font->ascent + font->descent;
821 font->min_width = xfont->min_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 (FRAME_PTR f, struct font *font)
897 BLOCK_INPUT;
898 XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
899 UNBLOCK_INPUT;
902 static int
903 xfont_prepare_face (FRAME_PTR f, struct face *face)
905 BLOCK_INPUT;
906 XSetFont (FRAME_X_DISPLAY (f), face->gc,
907 ((struct xfont_info *) face->font)->xfont->fid);
908 UNBLOCK_INPUT;
910 return 0;
913 static int
914 xfont_has_char (Lisp_Object font, int c)
916 Lisp_Object registry = AREF (font, FONT_REGISTRY_INDEX);
917 struct charset *encoding;
918 struct charset *repertory = NULL;
920 if (EQ (registry, Qiso10646_1))
922 encoding = CHARSET_FROM_ID (charset_unicode);
923 /* We use a font of `ja' and `ko' adstyle only for a character
924 in JISX0208 and KSC5601 charsets respectively. */
925 if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qja)
926 && charset_jisx0208 >= 0)
927 repertory = CHARSET_FROM_ID (charset_jisx0208);
928 else if (EQ (AREF (font, FONT_ADSTYLE_INDEX), Qko)
929 && charset_ksc5601 >= 0)
930 repertory = CHARSET_FROM_ID (charset_ksc5601);
932 else if (font_registry_charsets (registry, &encoding, &repertory) < 0)
933 /* Unknown REGISTRY, not usable. */
934 return 0;
935 if (ASCII_CHAR_P (c) && encoding->ascii_compatible_p)
936 return 1;
937 if (! repertory)
938 return -1;
939 return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory));
942 static unsigned
943 xfont_encode_char (struct font *font, int c)
945 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
946 struct charset *charset;
947 unsigned code;
948 XChar2b char2b;
950 charset = CHARSET_FROM_ID (font->encoding_charset);
951 code = ENCODE_CHAR (charset, c);
952 if (code == CHARSET_INVALID_CODE (charset))
953 return FONT_INVALID_CODE;
954 if (font->repertory_charset >= 0)
956 charset = CHARSET_FROM_ID (font->repertory_charset);
957 return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset)
958 ? code : FONT_INVALID_CODE);
960 char2b.byte1 = code >> 8;
961 char2b.byte2 = code & 0xFF;
962 return (xfont_get_pcm (xfont, &char2b) ? code : FONT_INVALID_CODE);
965 static int
966 xfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics)
968 XFontStruct *xfont = ((struct xfont_info *) font)->xfont;
969 int width = 0;
970 int i, first;
972 if (metrics)
973 memset (metrics, 0, sizeof (struct font_metrics));
974 for (i = 0, first = 1; i < nglyphs; i++)
976 XChar2b char2b;
977 static XCharStruct *pcm;
979 if (code[i] >= 0x10000)
980 continue;
981 char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF;
982 pcm = xfont_get_pcm (xfont, &char2b);
983 if (! pcm)
984 continue;
985 if (first)
987 if (metrics)
989 metrics->lbearing = pcm->lbearing;
990 metrics->rbearing = pcm->rbearing;
991 metrics->ascent = pcm->ascent;
992 metrics->descent = pcm->descent;
994 first = 0;
996 else
998 if (metrics)
1000 if (metrics->lbearing > width + pcm->lbearing)
1001 metrics->lbearing = width + pcm->lbearing;
1002 if (metrics->rbearing < width + pcm->rbearing)
1003 metrics->rbearing = width + pcm->rbearing;
1004 if (metrics->ascent < pcm->ascent)
1005 metrics->ascent = pcm->ascent;
1006 if (metrics->descent < pcm->descent)
1007 metrics->descent = pcm->descent;
1010 width += pcm->width;
1012 if (metrics)
1013 metrics->width = width;
1014 return width;
1017 static int
1018 xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
1020 XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
1021 int len = to - from;
1022 GC gc = s->gc;
1023 int i;
1025 if (s->gc != s->face->gc)
1027 BLOCK_INPUT;
1028 XSetFont (s->display, gc, xfont->fid);
1029 UNBLOCK_INPUT;
1032 if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0)
1034 char *str;
1035 USE_SAFE_ALLOCA;
1037 SAFE_ALLOCA (str, char *, len);
1038 for (i = 0; i < len ; i++)
1039 str[i] = XCHAR2B_BYTE2 (s->char2b + from + i);
1040 BLOCK_INPUT;
1041 if (with_background > 0)
1043 if (s->padding_p)
1044 for (i = 0; i < len; i++)
1045 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1046 gc, x + i, y, str + i, 1);
1047 else
1048 XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1049 gc, x, y, str, len);
1051 else
1053 if (s->padding_p)
1054 for (i = 0; i < len; i++)
1055 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1056 gc, x + i, y, str + i, 1);
1057 else
1058 XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1059 gc, x, y, str, len);
1061 UNBLOCK_INPUT;
1062 SAFE_FREE ();
1063 return s->nchars;
1066 BLOCK_INPUT;
1067 if (with_background > 0)
1069 if (s->padding_p)
1070 for (i = 0; i < len; i++)
1071 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1072 gc, x + i, y, s->char2b + from + i, 1);
1073 else
1074 XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1075 gc, x, y, s->char2b + from, len);
1077 else
1079 if (s->padding_p)
1080 for (i = 0; i < len; i++)
1081 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1082 gc, x + i, y, s->char2b + from + i, 1);
1083 else
1084 XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
1085 gc, x, y, s->char2b + from, len);
1087 UNBLOCK_INPUT;
1089 return len;
1092 static int
1093 xfont_check (FRAME_PTR f, struct font *font)
1095 struct xfont_info *xfont = (struct xfont_info *) font;
1097 return (FRAME_X_DISPLAY (f) == xfont->display ? 0 : -1);
1101 void
1102 syms_of_xfont (void)
1104 staticpro (&xfont_scripts_cache);
1105 { /* Here we rely on the fact that syms_of_xfont (via syms_of_font)
1106 is called fairly late, when QCtest and Qequal are known to be set. */
1107 Lisp_Object args[2];
1108 args[0] = QCtest;
1109 args[1] = Qequal;
1110 xfont_scripts_cache = Fmake_hash_table (2, args);
1112 staticpro (&xfont_scratch_props);
1113 xfont_scratch_props = Fmake_vector (make_number (8), Qnil);
1114 xfont_driver.type = Qx;
1115 register_font_driver (&xfont_driver, NULL);