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