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