1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
26
27
28
29 #include <config.h>
30 #include <stdio.h>
31 #include <setjmp.h>
32
33 #include "lisp.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "character.h"
37 #include "charset.h"
38 #include "ccl.h"
39 #include "keyboard.h"
40 #include "frame.h"
41 #include "dispextern.h"
42 #include "intervals.h"
43 #include "fontset.h"
44 #include "window.h"
45 #ifdef HAVE_X_WINDOWS
46 #include "xterm.h"
47 #endif
48 #ifdef WINDOWSNT
49 #include "w32term.h"
50 #endif
51 #ifdef HAVE_NS
52 #include "nsterm.h"
53 #endif
54 #include "termhooks.h"
55
56 #include "font.h"
57
58 #undef xassert
59 #ifdef FONTSET_DEBUG
60 #define xassert(X) do {if (!(X)) abort ();} while (0)
61 #undef INLINE
62 #define INLINE
63 #else
64 #define xassert(X) (void) 0
65 #endif
66
67 EXFUN (Fclear_face_cache, 1);
68
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
177
178
179
180 extern Lisp_Object Qfont;
181 static Lisp_Object Qfontset;
182 static Lisp_Object Qfontset_info;
183 static Lisp_Object Qprepend, Qappend;
184 Lisp_Object Qlatin;
185
186
187 static Lisp_Object Vfontset_table;
188
189 190
191 static int next_fontset_id;
192
193 194
195 static Lisp_Object Vdefault_fontset;
196
197 Lisp_Object Vfont_encoding_charset_alist;
198 Lisp_Object Vuse_default_ascent;
199 Lisp_Object Vignore_relative_composition;
200 Lisp_Object Valternate_fontname_alist;
201 Lisp_Object Vfontset_alias_alist;
202 Lisp_Object Vvertical_centering_font_regexp;
203 Lisp_Object Votf_script_alist;
204
205
206 void (*check_window_system_func) P_ ((void));
207
208
209
210 static Lisp_Object fontset_add P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
211 Lisp_Object));
212 static Lisp_Object fontset_find_font P_ ((Lisp_Object, int, struct face *,
213 int, int));
214 static void reorder_font_vector P_ ((Lisp_Object, struct font *));
215 static Lisp_Object fontset_font P_ ((Lisp_Object, int, struct face *, int));
216 static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
217 static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
218 static void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object,
219 Lisp_Object));
220 Lisp_Object find_font_encoding P_ ((Lisp_Object));
221
222 static void set_fontset_font P_ ((Lisp_Object, Lisp_Object));
223
224 #ifdef FONTSET_DEBUG
225
226
227
228 static int
229 fontset_id_valid_p (id)
230 int id;
231 {
232 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
233 }
234
235 #endif
236
237
238
239
240
241
242 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
243
244
245 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
246
247
248 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
249 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
250 #define FONTSET_SPEC(fontset) XCHAR_TABLE (fontset)->extras[5]
251
252
253 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
254 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
255 #define FONTSET_OBJLIST(fontset) XCHAR_TABLE (fontset)->extras[4]
256 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
257 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
258 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
259
260
261 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
262
263 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
264
265
266
267 #define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
268 do { \
269 (font_def) = Fmake_vector (make_number (3), (font_spec)); \
270 ASET ((font_def), 1, encoding); \
271 ASET ((font_def), 2, repertory); \
272 } while (0)
273
274 #define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
275 #define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
276 #define FONT_DEF_REPERTORY(font_def) AREF (font_def, 2)
277
278 #define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
279 #define RFONT_DEF_SET_FACE(rfont_def, face_id) \
280 ASET ((rfont_def), 0, make_number (face_id))
281 #define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
282 #define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
283 #define RFONT_DEF_REPERTORY(rfont_def) FONT_DEF_REPERTORY (AREF (rfont_def, 1))
284 #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
285 #define RFONT_DEF_SET_OBJECT(rfont_def, object) \
286 ASET ((rfont_def), 2, (object))
287 #define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3))
288 #define RFONT_DEF_SET_SCORE(rfont_def, score) \
289 ASET ((rfont_def), 3, make_number (score))
290 #define RFONT_DEF_NEW(rfont_def, font_def) \
291 do { \
292 (rfont_def) = Fmake_vector (make_number (4), Qnil); \
293 ASET ((rfont_def), 1, (font_def)); \
294 RFONT_DEF_SET_SCORE ((rfont_def), 0); \
295 } while (0)
296
297
298 299 300 301
302
303 #define FONTSET_REF(fontset, c) \
304 (EQ (fontset, Vdefault_fontset) \
305 ? CHAR_TABLE_REF (fontset, c) \
306 : fontset_ref ((fontset), (c)))
307
308 static Lisp_Object
309 fontset_ref (fontset, c)
310 Lisp_Object fontset;
311 int c;
312 {
313 Lisp_Object elt;
314
315 elt = CHAR_TABLE_REF (fontset, c);
316 if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
317
318 && NILP (FONTSET_BASE (fontset)))
319 elt = CHAR_TABLE_REF (Vdefault_fontset, c);
320 return elt;
321 }
322
323 324 325
326
327 #define FONTSET_SET(fontset, range, elt) \
328 Fset_char_table_range ((fontset), (range), (elt))
329
330
331 332 333 334 335
336
337 #define FONTSET_ADD(fontset, range, elt, add) \
338 (NILP (add) \
339 ? (NILP (range) \
340 ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
341 : Fset_char_table_range ((fontset), (range), \
342 Fmake_vector (make_number (1), (elt)))) \
343 : fontset_add ((fontset), (range), (elt), (add)))
344
345 static Lisp_Object
346 fontset_add (fontset, range, elt, add)
347 Lisp_Object fontset, range, elt, add;
348 {
349 Lisp_Object args[2];
350 int idx = (EQ (add, Qappend) ? 0 : 1);
351
352 args[1 - idx] = Fmake_vector (make_number (1), elt);
353
354 if (CONSP (range))
355 {
356 int from = XINT (XCAR (range));
357 int to = XINT (XCDR (range));
358 int from1, to1;
359
360 do {
361 from1 = from, to1 = to;
362 args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
363 char_table_set_range (fontset, from, to1,
364 NILP (args[idx]) ? args[1 - idx]
365 : Fvconcat (2, args));
366 from = to1 + 1;
367 } while (from < to);
368 }
369 else
370 {
371 args[idx] = FONTSET_FALLBACK (fontset);
372 FONTSET_FALLBACK (fontset)
373 = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
374 }
375 return Qnil;
376 }
377
378 static int
379 fontset_compare_rfontdef (val1, val2)
380 const void *val1, *val2;
381 {
382 return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
383 - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
384 }
385
386 387 388 389 390 391 392 393
394
395 extern Lisp_Object Fassoc_string ();
396
397 static void
398 reorder_font_vector (font_group, font)
399 Lisp_Object font_group;
400 struct font *font;
401 {
402 Lisp_Object vec, font_object;
403 int size;
404 int i;
405 int score_changed = 0;
406
407 if (font)
408 XSETFONT (font_object, font);
409 else
410 font_object = Qnil;
411
412 vec = XCDR (font_group);
413 size = ASIZE (vec);
414
415 if (NILP (AREF (vec, size - 1)))
416 size--;
417
418 for (i = 0; i < size; i++)
419 {
420 Lisp_Object rfont_def = AREF (vec, i);
421 Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
422 Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
423 int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
424
425 if (! font_match_p (font_spec, font_object))
426 {
427 Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
428
429 if (! NILP (encoding))
430 {
431 Lisp_Object tail;
432
433 for (tail = Vcharset_ordered_list;
434 ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
435 score += 0x100, tail = XCDR (tail))
436 if (EQ (encoding, XCAR (tail)))
437 break;
438 }
439 else
440 {
441 Lisp_Object lang = Ffont_get (font_spec, QClang);
442
443 if (! NILP (lang)
444 && ! EQ (lang, Vcurrent_iso639_language)
445 && (! CONSP (Vcurrent_iso639_language)
446 || NILP (Fmemq (lang, Vcurrent_iso639_language))))
447 score |= 0x100;
448 }
449 }
450 if (RFONT_DEF_SCORE (rfont_def) != score)
451 {
452 RFONT_DEF_SET_SCORE (rfont_def, score);
453 score_changed = 1;
454 }
455 }
456
457 if (score_changed)
458 qsort (XVECTOR (vec)->contents, size, sizeof (Lisp_Object),
459 fontset_compare_rfontdef);
460 XSETCAR (font_group, make_number (charset_ordered_list_tick));
461 }
462
463 464 465 466 467
468
469 static Lisp_Object
470 fontset_get_font_group (Lisp_Object fontset, int c)
471 {
472 Lisp_Object font_group;
473 Lisp_Object base_fontset;
474 int from = 0, to = MAX_CHAR, i;
475
476 xassert (! BASE_FONTSET_P (fontset));
477 if (c >= 0)
478 font_group = CHAR_TABLE_REF (fontset, c);
479 else
480 font_group = FONTSET_FALLBACK (fontset);
481 if (! NILP (font_group))
482 return font_group;
483 base_fontset = FONTSET_BASE (fontset);
484 if (c >= 0)
485 font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
486 else
487 font_group = FONTSET_FALLBACK (base_fontset);
488 if (NILP (font_group))
489 {
490 font_group = make_number (0);
491 if (c >= 0)
492 char_table_set_range (fontset, from, to, font_group);
493 return font_group;
494 }
495 font_group = Fcopy_sequence (font_group);
496 for (i = 0; i < ASIZE (font_group); i++)
497 if (! NILP (AREF (font_group, i)))
498 {
499 Lisp_Object rfont_def;
500
501 RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
502
503 RFONT_DEF_SET_SCORE (rfont_def, i);
504 ASET (font_group, i, rfont_def);
505 }
506 font_group = Fcons (make_number (-1), font_group);
507 if (c >= 0)
508 char_table_set_range (fontset, from, to, font_group);
509 else
510 FONTSET_FALLBACK (fontset) = font_group;
511 return font_group;
512 }
513
514 515 516 517 518 519 520 521 522 523 524 525
526
527 static Lisp_Object
528 fontset_find_font (fontset, c, face, id, fallback)
529 Lisp_Object fontset;
530 int c;
531 struct face *face;
532 int id, fallback;
533 {
534 Lisp_Object vec, font_group;
535 int i, charset_matched = 0, found_index;
536 FRAME_PTR f = (FRAMEP (FONTSET_FRAME (fontset))
537 ? XFRAME (FONTSET_FRAME (fontset)) : XFRAME (selected_frame));
538 Lisp_Object rfont_def;
539
540 font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
541 if (! CONSP (font_group))
542 return font_group;
543 vec = XCDR (font_group);
544 if (ASIZE (vec) == 0)
545 return Qnil;
546
547 if (ASIZE (vec) > 1)
548 {
549 if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
550 551
552 reorder_font_vector (font_group, face->ascii_face->font);
553 if (id >= 0)
554 555
556 for (i = 0; i < ASIZE (vec); i++)
557 {
558 Lisp_Object repertory;
559
560 rfont_def = AREF (vec, i);
561 if (NILP (rfont_def))
562 break;
563 repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
564
565 if (XINT (repertory) == id)
566 {
567 charset_matched = i;
568 break;
569 }
570 }
571 }
572
573
574 for (i = 0; i < ASIZE (vec); i++)
575 {
576 Lisp_Object font_def;
577 Lisp_Object font_entity, font_object;
578
579 found_index = i;
580 if (i == 0)
581 {
582 if (charset_matched > 0)
583 {
584
585 found_index = charset_matched;
586 587
588 charset_matched = - charset_matched;
589
590 i--;
591 }
592 }
593 else if (i == - charset_matched)
594 {
595 596 597
598 rfont_def = AREF (vec, i);
599 font_def = RFONT_DEF_FONT_DEF (rfont_def);
600 for (; i + 1 < ASIZE (vec); i++)
601 {
602 rfont_def = AREF (vec, i + 1);
603 if (NILP (rfont_def))
604 break;
605 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
606 break;
607 }
608 continue;
609 }
610
611 rfont_def = AREF (vec, found_index);
612 if (NILP (rfont_def))
613 {
614 if (i < 0)
615 continue;
616
617 return Qt;
618 }
619 if (INTEGERP (RFONT_DEF_FACE (rfont_def))
620 && XINT (RFONT_DEF_FACE (rfont_def)) < 0)
621
622 continue;
623
624 font_object = RFONT_DEF_OBJECT (rfont_def);
625 if (NILP (font_object))
626 {
627 font_def = RFONT_DEF_FONT_DEF (rfont_def);
628
629 if (! face)
630
631 return Qnil;
632 633 634 635
636 font_entity = font_find_for_lface (f, face->lface,
637 FONT_DEF_SPEC (font_def), -1);
638 if (NILP (font_entity))
639 {
640
641 RFONT_DEF_SET_FACE (rfont_def, -1);
642 continue;
643 }
644 font_object = font_open_for_lface (f, font_entity, face->lface,
645 FONT_DEF_SPEC (font_def));
646 if (NILP (font_object))
647 {
648 649 650 651 652
653 RFONT_DEF_SET_FACE (rfont_def, -1);
654 continue;
655 }
656 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
657 }
658
659 if (font_has_char (f, font_object, c))
660 goto found;
661
662 663
664 font_def = RFONT_DEF_FONT_DEF (rfont_def);
665 for (; found_index + 1 < ASIZE (vec); found_index++)
666 {
667 rfont_def = AREF (vec, found_index + 1);
668 if (NILP (rfont_def))
669 break;
670 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
671 break;
672 font_object = RFONT_DEF_OBJECT (rfont_def);
673 if (! NILP (font_object) && font_has_char (f, font_object, c))
674 {
675 found_index++;
676 goto found;
677 }
678 }
679
680
681 font_entity = font_find_for_lface (f, face->lface,
682 FONT_DEF_SPEC (font_def), c);
683 if (! NILP (font_entity))
684 {
685 686
687 Lisp_Object new_vec;
688 int j;
689
690 font_object = font_open_for_lface (f, font_entity, face->lface,
691 Qnil);
692 if (NILP (font_object))
693 continue;
694 RFONT_DEF_NEW (rfont_def, font_def);
695 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
696 RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
697 new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil);
698 found_index++;
699 for (j = 0; j < found_index; j++)
700 ASET (new_vec, j, AREF (vec, j));
701 ASET (new_vec, j, rfont_def);
702 for (j++; j < ASIZE (new_vec); j++)
703 ASET (new_vec, j, AREF (vec, j - 1));
704 XSETCDR (font_group, new_vec);
705 vec = new_vec;
706 goto found;
707 }
708 if (i >= 0)
709 i = found_index;
710 }
711
712 FONTSET_SET (fontset, make_number (c), make_number (0));
713 return Qnil;
714
715 found:
716 if (fallback && found_index > 0)
717 {
718 719 720 721
722 for (i = found_index; i > 0; i--)
723 ASET (vec, i, AREF (vec, i - 1));
724 ASET (vec, 0, rfont_def);
725 }
726 return rfont_def;
727 }
728
729
730 static Lisp_Object
731 fontset_font (fontset, c, face, id)
732 Lisp_Object fontset;
733 int c;
734 struct face *face;
735 int id;
736 {
737 Lisp_Object rfont_def, default_rfont_def;
738 Lisp_Object base_fontset;
739
740
741 FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
742 rfont_def = fontset_find_font (fontset, c, face, id, 0);
743 if (VECTORP (rfont_def))
744 return rfont_def;
745 if (NILP (rfont_def))
746 FONTSET_SET (fontset, make_number (c), make_number (0));
747
748
749 base_fontset = FONTSET_BASE (fontset);
750 if (! EQ (base_fontset, Vdefault_fontset))
751 {
752 if (NILP (FONTSET_DEFAULT (fontset)))
753 FONTSET_DEFAULT (fontset)
754 = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
755 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
756 default_rfont_def
757 = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
758 if (VECTORP (default_rfont_def))
759 return default_rfont_def;
760 if (NILP (default_rfont_def))
761 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
762 make_number (0));
763 }
764
765
766 if (! EQ (rfont_def, Qt))
767 {
768 FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
769 rfont_def = fontset_find_font (fontset, c, face, id, 1);
770 if (VECTORP (rfont_def))
771 return rfont_def;
772
773 FONTSET_SET (fontset, make_number (c), Qt);
774 }
775
776
777 if (! EQ (base_fontset, Vdefault_fontset)
778 && ! EQ (default_rfont_def, Qt))
779 {
780 FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
781 rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
782 if (VECTORP (rfont_def))
783 return rfont_def;
784
785 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
786 }
787
788 return Qnil;
789 }
790
791 792 793
794
795 static Lisp_Object
796 make_fontset (frame, name, base)
797 Lisp_Object frame, name, base;
798 {
799 Lisp_Object fontset;
800 int size = ASIZE (Vfontset_table);
801 int id = next_fontset_id;
802
803 804 805 806 807
808 while (!NILP (AREF (Vfontset_table, id))) id++;
809
810 if (id + 1 == size)
811 Vfontset_table = larger_vector (Vfontset_table, size + 32, Qnil);
812
813 fontset = Fmake_char_table (Qfontset, Qnil);
814
815 FONTSET_ID (fontset) = make_number (id);
816 if (NILP (base))
817 {
818 FONTSET_NAME (fontset) = name;
819 }
820 else
821 {
822 FONTSET_NAME (fontset) = Qnil;
823 FONTSET_FRAME (fontset) = frame;
824 FONTSET_BASE (fontset) = base;
825 }
826
827 ASET (Vfontset_table, id, fontset);
828 next_fontset_id = id + 1;
829 return fontset;
830 }
831
832
833
834
835
836
837 Lisp_Object
838 fontset_name (id)
839 int id;
840 {
841 Lisp_Object fontset;
842
843 fontset = FONTSET_FROM_ID (id);
844 return FONTSET_NAME (fontset);
845 }
846
847
848
849
850 Lisp_Object
851 fontset_ascii (id)
852 int id;
853 {
854 Lisp_Object fontset, elt;
855
856 fontset= FONTSET_FROM_ID (id);
857 elt = FONTSET_ASCII (fontset);
858 if (CONSP (elt))
859 elt = XCAR (elt);
860 return elt;
861 }
862
863 void
864 free_realized_fontset (f, fontset)
865 FRAME_PTR f;
866 Lisp_Object fontset;
867 {
868 Lisp_Object tail;
869
870 return;
871 for (tail = FONTSET_OBJLIST (fontset); CONSP (tail); tail = XCDR (tail))
872 {
873 xassert (FONT_OBJECT_P (XCAR (tail)));
874 font_close_object (f, XCAR (tail));
875 }
876 }
877
878 879
880
881 void
882 free_face_fontset (f, face)
883 FRAME_PTR f;
884 struct face *face;
885 {
886 Lisp_Object fontset;
887
888 fontset = FONTSET_FROM_ID (face->fontset);
889 if (NILP (fontset))
890 return;
891 xassert (! BASE_FONTSET_P (fontset));
892 xassert (f == XFRAME (FONTSET_FRAME (fontset)));
893 free_realized_fontset (f, fontset);
894 ASET (Vfontset_table, face->fontset, Qnil);
895 if (face->fontset < next_fontset_id)
896 next_fontset_id = face->fontset;
897 if (! NILP (FONTSET_DEFAULT (fontset)))
898 {
899 int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
900
901 fontset = AREF (Vfontset_table, id);
902 xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
903 xassert (f == XFRAME (FONTSET_FRAME (fontset)));
904 free_realized_fontset (f, fontset);
905 ASET (Vfontset_table, id, Qnil);
906 if (id < next_fontset_id)
907 next_fontset_id = face->fontset;
908 }
909 face->fontset = -1;
910 }
911
912
913 914 915
916
917 int
918 face_suitable_for_char_p (face, c)
919 struct face *face;
920 int c;
921 {
922 Lisp_Object fontset, rfont_def;
923
924 fontset = FONTSET_FROM_ID (face->fontset);
925 rfont_def = fontset_font (fontset, c, NULL, -1);
926 return (VECTORP (rfont_def)
927 && INTEGERP (RFONT_DEF_FACE (rfont_def))
928 && face->id == XINT (RFONT_DEF_FACE (rfont_def)));
929 }
930
931
932 933 934
935
936 int
937 face_for_char (f, face, c, pos, object)
938 FRAME_PTR f;
939 struct face *face;
940 int c, pos;
941 Lisp_Object object;
942 {
943 Lisp_Object fontset, rfont_def, charset;
944 int face_id;
945 int id;
946
947 948 949 950
951 if (ASCII_CHAR_P (c) || face->fontset < 0)
952 return face->ascii_face->id;
953
954 xassert (fontset_id_valid_p (face->fontset));
955 fontset = FONTSET_FROM_ID (face->fontset);
956 xassert (!BASE_FONTSET_P (fontset));
957
958 if (pos < 0)
959 {
960 id = -1;
961 charset = Qnil;
962 }
963 else
964 {
965 charset = Fget_char_property (make_number (pos), Qcharset, object);
966 if (CHARSETP (charset))
967 {
968 Lisp_Object val;
969
970 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
971 if (CONSP (val) && CHARSETP (XCDR (val)))
972 charset = XCDR (val);
973 id = XINT (CHARSET_SYMBOL_ID (charset));
974 }
975 else
976 id = -1;
977 }
978
979 rfont_def = fontset_font (fontset, c, face, id);
980 if (VECTORP (rfont_def))
981 {
982 if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
983 face_id = XINT (RFONT_DEF_FACE (rfont_def));
984 else
985 {
986 Lisp_Object font_object;
987
988 font_object = RFONT_DEF_OBJECT (rfont_def);
989 face_id = face_for_font (f, font_object, face);
990 RFONT_DEF_SET_FACE (rfont_def, face_id);
991 }
992 }
993 else
994 {
995 if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
996 face_id = XINT (FONTSET_NOFONT_FACE (fontset));
997 else
998 {
999 face_id = face_for_font (f, Qnil, face);
1000 FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
1001 }
1002 }
1003 xassert (face_id >= 0);
1004 return face_id;
1005 }
1006
1007
1008 Lisp_Object
1009 font_for_char (face, c, pos, object)
1010 struct face *face;
1011 int c, pos;
1012 Lisp_Object object;
1013 {
1014 Lisp_Object fontset, rfont_def, charset;
1015 int id;
1016
1017 if (ASCII_CHAR_P (c))
1018 {
1019 Lisp_Object font_object;
1020
1021 XSETFONT (font_object, face->ascii_face->font);
1022 return font_object;
1023 }
1024
1025 xassert (fontset_id_valid_p (face->fontset));
1026 fontset = FONTSET_FROM_ID (face->fontset);
1027 xassert (!BASE_FONTSET_P (fontset));
1028 if (pos < 0)
1029 {
1030 id = -1;
1031 charset = Qnil;
1032 }
1033 else
1034 {
1035 charset = Fget_char_property (make_number (pos), Qcharset, object);
1036 if (CHARSETP (charset))
1037 {
1038 Lisp_Object val;
1039
1040 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
1041 if (CONSP (val) && CHARSETP (XCDR (val)))
1042 charset = XCDR (val);
1043 id = XINT (CHARSET_SYMBOL_ID (charset));
1044 }
1045 else
1046 id = -1;
1047 }
1048
1049 rfont_def = fontset_font (fontset, c, face, id);
1050 return (VECTORP (rfont_def)
1051 ? RFONT_DEF_OBJECT (rfont_def)
1052 : Qnil);
1053 }
1054
1055
1056 1057 1058 1059
1060
1061 int
1062 make_fontset_for_ascii_face (f, base_fontset_id, face)
1063 FRAME_PTR f;
1064 int base_fontset_id;
1065 struct face *face;
1066 {
1067 Lisp_Object base_fontset, fontset, frame;
1068
1069 XSETFRAME (frame, f);
1070 if (base_fontset_id >= 0)
1071 {
1072 base_fontset = FONTSET_FROM_ID (base_fontset_id);
1073 if (!BASE_FONTSET_P (base_fontset))
1074 base_fontset = FONTSET_BASE (base_fontset);
1075 if (! BASE_FONTSET_P (base_fontset))
1076 abort ();
1077 }
1078 else
1079 base_fontset = Vdefault_fontset;
1080
1081 fontset = make_fontset (frame, Qnil, base_fontset);
1082 return XINT (FONTSET_ID (fontset));
1083 }
1084
1085
1086
1087 1088 1089
1090 static Lisp_Object Vcached_fontset_data;
1091
1092 #define CACHED_FONTSET_NAME ((char *) SDATA (XCAR (Vcached_fontset_data)))
1093 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1094
1095 1096
1097
1098 static Lisp_Object
1099 fontset_pattern_regexp (pattern)
1100 Lisp_Object pattern;
1101 {
1102 if (!index ((char *) SDATA (pattern), '*')
1103 && !index ((char *) SDATA (pattern), '?'))
1104
1105 return Qnil;
1106
1107 if (!CONSP (Vcached_fontset_data)
1108 || strcmp ((char *) SDATA (pattern), CACHED_FONTSET_NAME))
1109 {
1110
1111 unsigned char *regex, *p0, *p1;
1112 int ndashes = 0, nstars = 0, nescs = 0;
1113
1114 for (p0 = SDATA (pattern); *p0; p0++)
1115 {
1116 if (*p0 == '-')
1117 ndashes++;
1118 else if (*p0 == '*')
1119 nstars++;
1120 else if (*p0 == '['
1121 || *p0 == '.' || *p0 == '\\'
1122 || *p0 == '+' || *p0 == '^'
1123 || *p0 == '$')
1124 nescs++;
1125 }
1126
1127 1128 1129
1130 if (ndashes < 14)
1131 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
1132 else
1133 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
1134
1135 *p1++ = '^';
1136 for (p0 = SDATA (pattern); *p0; p0++)
1137 {
1138 if (*p0 == '*')
1139 {
1140 if (ndashes < 14)
1141 *p1++ = '.';
1142 else
1143 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
1144 *p1++ = '*';
1145 }
1146 else if (*p0 == '?')
1147 *p1++ = '.';
1148 else if (*p0 == '['
1149 || *p0 == '.' || *p0 == '\\'
1150 || *p0 == '+' || *p0 == '^'
1151 || *p0 == '$')
1152 *p1++ = '\\', *p1++ = *p0;
1153 else
1154 *p1++ = *p0;
1155 }
1156 *p1++ = '$';
1157 *p1++ = 0;
1158
1159 Vcached_fontset_data = Fcons (build_string ((char *) SDATA (pattern)),
1160 build_string ((char *) regex));
1161 }
1162
1163 return CACHED_FONTSET_REGEX;
1164 }
1165
1166 1167 1168 1169 1170 1171
1172
1173 int
1174 fs_query_fontset (name, name_pattern)
1175 Lisp_Object name;
1176 int name_pattern;
1177 {
1178 Lisp_Object tem;
1179 int i;
1180
1181 name = Fdowncase (name);
1182 if (name_pattern != 1)
1183 {
1184 tem = Frassoc (name, Vfontset_alias_alist);
1185 if (NILP (tem))
1186 tem = Fassoc (name, Vfontset_alias_alist);
1187 if (CONSP (tem) && STRINGP (XCAR (tem)))
1188 name = XCAR (tem);
1189 else if (name_pattern == 0)
1190 {
1191 tem = fontset_pattern_regexp (name);
1192 if (STRINGP (tem))
1193 {
1194 name = tem;
1195 name_pattern = 1;
1196 }
1197 }
1198 }
1199
1200 for (i = 0; i < ASIZE (Vfontset_table); i++)
1201 {
1202 Lisp_Object fontset, this_name;
1203
1204 fontset = FONTSET_FROM_ID (i);
1205 if (NILP (fontset)
1206 || !BASE_FONTSET_P (fontset))
1207 continue;
1208
1209 this_name = FONTSET_NAME (fontset);
1210 if (name_pattern == 1
1211 ? fast_string_match_ignore_case (name, this_name) >= 0
1212 : !xstrcasecmp (SDATA (name), SDATA (this_name)))
1213 return i;
1214 }
1215 return -1;
1216 }
1217
1218
1219 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
1220 doc: 1221 1222 1223 1224 )
1225 (pattern, regexpp)
1226 Lisp_Object pattern, regexpp;
1227 {
1228 Lisp_Object fontset;
1229 int id;
1230
1231 (*check_window_system_func) ();
1232
1233 CHECK_STRING (pattern);
1234
1235 if (SCHARS (pattern) == 0)
1236 return Qnil;
1237
1238 id = fs_query_fontset (pattern, !NILP (regexpp));
1239 if (id < 0)
1240 return Qnil;
1241
1242 fontset = FONTSET_FROM_ID (id);
1243 return FONTSET_NAME (fontset);
1244 }
1245
1246
1247
1248 Lisp_Object
1249 list_fontsets (f, pattern, size)
1250 FRAME_PTR f;
1251 Lisp_Object pattern;
1252 int size;
1253 {
1254 Lisp_Object frame, regexp, val;
1255 int id;
1256
1257 XSETFRAME (frame, f);
1258
1259 regexp = fontset_pattern_regexp (pattern);
1260 val = Qnil;
1261
1262 for (id = 0; id < ASIZE (Vfontset_table); id++)
1263 {
1264 Lisp_Object fontset, name;
1265
1266 fontset = FONTSET_FROM_ID (id);
1267 if (NILP (fontset)
1268 || !BASE_FONTSET_P (fontset)
1269 || !EQ (frame, FONTSET_FRAME (fontset)))
1270 continue;
1271 name = FONTSET_NAME (fontset);
1272
1273 if (STRINGP (regexp)
1274 ? (fast_string_match (regexp, name) < 0)
1275 : strcmp ((char *) SDATA (pattern), (char *) SDATA (name)))
1276 continue;
1277
1278 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
1279 }
1280
1281 return val;
1282 }
1283
1284
1285
1286
1287 static void
1288 free_realized_fontsets (base)
1289 Lisp_Object base;
1290 {
1291 int id;
1292
1293 #if 0
1294 1295 1296 1297
1298 BLOCK_INPUT;
1299 for (id = 0; id < ASIZE (Vfontset_table); id++)
1300 {
1301 Lisp_Object this = AREF (Vfontset_table, id);
1302
1303 if (EQ (FONTSET_BASE (this), base))
1304 {
1305 Lisp_Object tail;
1306
1307 for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1308 tail = XCDR (tail))
1309 {
1310 FRAME_PTR f = XFRAME (FONTSET_FRAME (this));
1311 int face_id = XINT (XCDR (XCAR (tail)));
1312 struct face *face = FACE_FROM_ID (f, face_id);
1313
1314
1315 free_realized_face (f, face);
1316 }
1317 }
1318 }
1319 UNBLOCK_INPUT;
1320 #else
1321 1322
1323 for (id = 0; id < ASIZE (Vfontset_table); id++)
1324 {
1325 Lisp_Object this = AREF (Vfontset_table, id);
1326
1327 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
1328 {
1329 Fclear_face_cache (Qt);
1330 break;
1331 }
1332 }
1333 #endif
1334 }
1335
1336
1337 1338 1339 1340 1341 1342 1343
1344
1345 static Lisp_Object
1346 check_fontset_name (name, frame)
1347 Lisp_Object name, *frame;
1348 {
1349 int id;
1350
1351 if (NILP (*frame))
1352 *frame = selected_frame;
1353 CHECK_LIVE_FRAME (*frame);
1354
1355 if (EQ (name, Qt))
1356 return Vdefault_fontset;
1357 if (NILP (name))
1358 {
1359 id = FRAME_FONTSET (XFRAME (*frame));
1360 }
1361 else
1362 {
1363 CHECK_STRING (name);
1364
1365 id = fs_query_fontset (name, 2);
1366 if (id < 0)
1367
1368 id = fs_query_fontset (name, 0);
1369 if (id < 0)
1370 error ("Fontset `%s' does not exist", SDATA (name));
1371 }
1372 return FONTSET_FROM_ID (id);
1373 }
1374
1375 static void
1376 accumulate_script_ranges (arg, range, val)
1377 Lisp_Object arg, range, val;
1378 {
1379 if (EQ (XCAR (arg), val))
1380 {
1381 if (CONSP (range))
1382 XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1383 else
1384 XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1385 }
1386 }
1387
1388
1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399
1400
1401 static void
1402 set_fontset_font (arg, range)
1403 Lisp_Object arg, range;
1404 {
1405 Lisp_Object fontset, font_def, add, ascii, script_range_list;
1406 int from = XINT (XCAR (range)), to = XINT (XCDR (range));
1407
1408 fontset = AREF (arg, 0);
1409 font_def = AREF (arg, 1);
1410 add = AREF (arg, 2);
1411 ascii = AREF (arg, 3);
1412 script_range_list = AREF (arg, 4);
1413
1414 if (NILP (ascii) && from < 0x80)
1415 {
1416 if (to < 0x80)
1417 return;
1418 from = 0x80;
1419 range = Fcons (make_number (0x80), XCDR (range));
1420 }
1421
1422 #define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
1423 #define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
1424 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
1425
1426 for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
1427 FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
1428 if (CONSP (script_range_list))
1429 {
1430 if (SCRIPT_FROM < from)
1431 range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
1432 while (CONSP (script_range_list) && SCRIPT_TO <= to)
1433 POP_SCRIPT_RANGE ();
1434 if (CONSP (script_range_list) && SCRIPT_FROM <= to)
1435 XSETCAR (XCAR (script_range_list), make_number (to + 1));
1436 }
1437
1438 FONTSET_ADD (fontset, range, font_def, add);
1439 ASET (arg, 4, script_range_list);
1440 }
1441
1442 extern Lisp_Object QCfamily, QCregistry;
1443 static void update_auto_fontset_alist P_ ((Lisp_Object, Lisp_Object));
1444
1445
1446 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1447 doc: 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 )
1481 (name, target, font_spec, frame, add)
1482 Lisp_Object name, target, font_spec, frame, add;
1483 {
1484 Lisp_Object fontset;
1485 Lisp_Object font_def, registry, family;
1486 Lisp_Object range_list;
1487 struct charset *charset = NULL;
1488 Lisp_Object fontname;
1489 int ascii_changed = 0;
1490
1491 fontset = check_fontset_name (name, &frame);
1492
1493 fontname = Qnil;
1494 if (CONSP (font_spec))
1495 {
1496 Lisp_Object spec = Ffont_spec (0, NULL);
1497
1498 font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
1499 font_spec = spec;
1500 fontname = Ffont_xlfd_name (font_spec, Qnil);
1501 }
1502 else if (STRINGP (font_spec))
1503 {
1504 Lisp_Object args[2];
1505 extern Lisp_Object QCname;
1506
1507 fontname = font_spec;
1508 args[0] = QCname;
1509 args[1] = font_spec;
1510 font_spec = Ffont_spec (2, args);
1511 }
1512 else if (FONT_SPEC_P (font_spec))
1513 fontname = Ffont_xlfd_name (font_spec, Qnil);
1514 else if (! NILP (font_spec))
1515 Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
1516
1517 if (! NILP (font_spec))
1518 {
1519 Lisp_Object encoding, repertory;
1520
1521 family = AREF (font_spec, FONT_FAMILY_INDEX);
1522 if (! NILP (family) )
1523 family = SYMBOL_NAME (family);
1524 registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1525 if (! NILP (registry))
1526 registry = Fdowncase (SYMBOL_NAME (registry));
1527 encoding = find_font_encoding (concat3 (family, build_string ("-"),
1528 registry));
1529 if (NILP (encoding))
1530 encoding = Qascii;
1531
1532 if (SYMBOLP (encoding))
1533 {
1534 CHECK_CHARSET (encoding);
1535 encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1536 }
1537 else
1538 {
1539 repertory = XCDR (encoding);
1540 encoding = XCAR (encoding);
1541 CHECK_CHARSET (encoding);
1542 encoding = CHARSET_SYMBOL_ID (encoding);
1543 if (! NILP (repertory) && SYMBOLP (repertory))
1544 {
1545 CHECK_CHARSET (repertory);
1546 repertory = CHARSET_SYMBOL_ID (repertory);
1547 }
1548 }
1549 FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
1550 }
1551 else
1552 font_def = Qnil;
1553
1554 if (CHARACTERP (target))
1555 {
1556 if (XFASTINT (target) < 0x80)
1557 error ("Can't set a font for partial ASCII range");
1558 range_list = Fcons (Fcons (target, target), Qnil);
1559 }
1560 else if (CONSP (target))
1561 {
1562 Lisp_Object from, to;
1563
1564 from = Fcar (target);
1565 to = Fcdr (target);
1566 CHECK_CHARACTER (from);
1567 CHECK_CHARACTER (to);
1568 if (XFASTINT (from) < 0x80)
1569 {
1570 if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
1571 error ("Can't set a font for partial ASCII range");
1572 ascii_changed = 1;
1573 }
1574 range_list = Fcons (target, Qnil);
1575 }
1576 else if (SYMBOLP (target) && !NILP (target))
1577 {
1578 Lisp_Object script_list;
1579 Lisp_Object val;
1580
1581 range_list = Qnil;
1582 script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1583 if (! NILP (Fmemq (target, script_list)))
1584 {
1585 if (EQ (target, Qlatin))
1586 ascii_changed = 1;
1587 val = Fcons (target, Qnil);
1588 map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1589 val);
1590 range_list = Fnreverse (XCDR (val));
1591 }
1592 if (CHARSETP (target))
1593 {
1594 CHECK_CHARSET_GET_CHARSET (target, charset);
1595 if (charset->ascii_compatible_p)
1596 ascii_changed = 1;
1597 }
1598 else if (NILP (range_list))
1599 error ("Invalid script or charset name: %s",
1600 SDATA (SYMBOL_NAME (target)));
1601 }
1602 else if (NILP (target))
1603 range_list = Fcons (Qnil, Qnil);
1604 else
1605 error ("Invalid target for setting a font");
1606
1607 if (ascii_changed)
1608 {
1609 Lisp_Object val;
1610
1611 if (NILP (font_spec))
1612 error ("Can't set ASCII font to nil");
1613 val = CHAR_TABLE_REF (fontset, 0);
1614 if (! NILP (val) && EQ (add, Qappend))
1615
1616 ascii_changed = 0;
1617 }
1618
1619 if (charset)
1620 {
1621 Lisp_Object arg;
1622
1623 arg = Fmake_vector (make_number (5), Qnil);
1624 ASET (arg, 0, fontset);
1625 ASET (arg, 1, font_def);
1626 ASET (arg, 2, add);
1627 ASET (arg, 3, ascii_changed ? Qt : Qnil);
1628 ASET (arg, 4, range_list);
1629
1630 map_charset_chars (set_fontset_font, Qnil, arg, charset,
1631 CHARSET_MIN_CODE (charset),
1632 CHARSET_MAX_CODE (charset));
1633 range_list = AREF (arg, 4);
1634 }
1635 for (; CONSP (range_list); range_list = XCDR (range_list))
1636 FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1637
1638 if (ascii_changed)
1639 {
1640 Lisp_Object tail, frame, alist;
1641 int fontset_id = XINT (FONTSET_ID (fontset));
1642
1643 FONTSET_ASCII (fontset) = fontname;
1644 name = FONTSET_NAME (fontset);
1645 FOR_EACH_FRAME (tail, frame)
1646 {
1647 FRAME_PTR f = XFRAME (frame);
1648 Lisp_Object font_object;
1649 struct face *face;
1650
1651 if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
1652 continue;
1653 if (fontset_id != FRAME_FONTSET (f))
1654 continue;
1655 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
1656 if (face)
1657 font_object = font_load_for_lface (f, face->lface, font_spec);
1658 else
1659 font_object = font_open_by_spec (f, font_spec);
1660 if (! NILP (font_object))
1661 {
1662 update_auto_fontset_alist (font_object, fontset);
1663 alist = Fcons (Fcons (Qfont, Fcons (name, font_object)), Qnil);
1664 Fmodify_frame_parameters (frame, alist);
1665 }
1666 }
1667 }
1668
1669 1670 1671
1672 free_realized_fontsets (fontset);
1673
1674 return Qnil;
1675 }
1676
1677
1678 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1679 doc: 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 )
1691 (name, fontlist)
1692 Lisp_Object name, fontlist;
1693 {
1694 Lisp_Object fontset;
1695 int id;
1696
1697 CHECK_STRING (name);
1698 CHECK_LIST (fontlist);
1699
1700 name = Fdowncase (name);
1701 id = fs_query_fontset (name, 0);
1702 if (id < 0)
1703 {
1704 Lisp_Object font_spec = Ffont_spec (0, NULL);
1705 Lisp_Object short_name;
1706 char xlfd[256];
1707 int len;
1708
1709 if (font_parse_xlfd ((char *) SDATA (name), font_spec) < 0)
1710 error ("Fontset name must be in XLFD format");
1711 short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
1712 if (strncmp ((char *) SDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
1713 || SBYTES (SYMBOL_NAME (short_name)) < 9)
1714 error ("Registry field of fontset name must be \"fontset-*\"");
1715 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
1716 Vfontset_alias_alist);
1717 ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
1718 fontset = make_fontset (Qnil, name, Qnil);
1719 len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
1720 if (len < 0)
1721 error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
1722 FONTSET_ASCII (fontset) = make_unibyte_string (xlfd, len);
1723 }
1724 else
1725 {
1726 fontset = FONTSET_FROM_ID (id);
1727 free_realized_fontsets (fontset);
1728 Fset_char_table_range (fontset, Qt, Qnil);
1729 }
1730
1731 for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
1732 {
1733 Lisp_Object elt, script;
1734
1735 elt = Fcar (fontlist);
1736 script = Fcar (elt);
1737 elt = Fcdr (elt);
1738 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
1739 for (; CONSP (elt); elt = XCDR (elt))
1740 Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
1741 else
1742 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1743 }
1744 return name;
1745 }
1746
1747
1748 1749
1750 static Lisp_Object auto_fontset_alist;
1751
1752
1753 static int num_auto_fontsets;
1754
1755 1756 1757 1758 1759 1760 1761 1762
1763
1764 int
1765 fontset_from_font (font_object)
1766 Lisp_Object font_object;
1767 {
1768 Lisp_Object font_name = font_get_name (font_object);
1769 Lisp_Object font_spec = Fcopy_font_spec (font_object);
1770 Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1771 Lisp_Object fontset_spec, alias, name, fontset;
1772 Lisp_Object val;
1773
1774 val = assoc_no_quit (font_spec, auto_fontset_alist);
1775 if (CONSP (val))
1776 return XINT (FONTSET_ID (XCDR (val)));
1777 if (num_auto_fontsets++ == 0)
1778 alias = intern ("fontset-startup");
1779 else
1780 {
1781 char temp[32];
1782
1783 sprintf (temp, "fontset-auto%d", num_auto_fontsets - 1);
1784 alias = intern (temp);
1785 }
1786 fontset_spec = Fcopy_font_spec (font_spec);
1787 ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
1788 name = Ffont_xlfd_name (fontset_spec, Qnil);
1789 if (NILP (name))
1790 abort ();
1791 fontset = make_fontset (Qnil, name, Qnil);
1792 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
1793 Vfontset_alias_alist);
1794 alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
1795 Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
1796 auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
1797 font_spec = Ffont_spec (0, NULL);
1798 ASET (font_spec, FONT_REGISTRY_INDEX, registry);
1799 {
1800 Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
1801
1802 if (CONSP (target))
1803 target = XCDR (target);
1804 if (! CHARSETP (target))
1805 target = Qlatin;
1806 Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
1807 Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
1808 }
1809
1810 FONTSET_ASCII (fontset) = font_name;
1811
1812 return XINT (FONTSET_ID (fontset));
1813 }
1814
1815
1816 1817 1818 1819
1820
1821 static void
1822 update_auto_fontset_alist (font_object, fontset)
1823 Lisp_Object font_object, fontset;
1824 {
1825 Lisp_Object prev, tail;
1826
1827 for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
1828 prev = tail, tail = XCDR (tail))
1829 if (EQ (fontset, XCDR (XCAR (tail))))
1830 {
1831 if (NILP (prev))
1832 auto_fontset_alist = XCDR (tail);
1833 else
1834 XSETCDR (prev, XCDR (tail));
1835 break;
1836 }
1837 }
1838
1839
1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864
1865
1866
1867 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
1868 doc: )
1869 (position, ch)
1870 Lisp_Object position, ch;
1871 {
1872 EMACS_INT pos, pos_byte, dummy;
1873 int face_id;
1874 int c;
1875 struct frame *f;
1876 struct face *face;
1877 int cs_id;
1878
1879 if (NILP (position))
1880 {
1881 CHECK_CHARACTER (ch);
1882 c = XINT (ch);
1883 f = XFRAME (selected_frame);
1884 face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
1885 pos = -1;
1886 cs_id = -1;
1887 }
1888 else
1889 {
1890 Lisp_Object window, charset;
1891 struct window *w;
1892
1893 CHECK_NUMBER_COERCE_MARKER (position);
1894 pos = XINT (position);
1895 if (pos < BEGV || pos >= ZV)
1896 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1897 pos_byte = CHAR_TO_BYTE (pos);
1898 if (NILP (ch))
1899 c = FETCH_CHAR (pos_byte);
1900 else
1901 {
1902 CHECK_NATNUM (ch);
1903 c = XINT (ch);
1904 }
1905 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1906 if (NILP (window))
1907 return Qnil;
1908 w = XWINDOW (window);
1909 f = XFRAME (w->frame);
1910 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
1911 pos + 100, 0, -1);
1912 charset = Fget_char_property (position, Qcharset, Qnil);
1913 if (CHARSETP (charset))
1914 cs_id = XINT (CHARSET_SYMBOL_ID (charset));
1915 else
1916 cs_id = -1;
1917 }
1918 if (! CHAR_VALID_P (c, 0))
1919 return Qnil;
1920 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
1921 face = FACE_FROM_ID (f, face_id);
1922 if (face->font)
1923 {
1924 unsigned code = face->font->driver->encode_char (face->font, c);
1925 Lisp_Object font_object;
1926 1927
1928 EMACS_INT cod = code;
1929
1930 if (code == FONT_INVALID_CODE)
1931 return Qnil;
1932 XSETFONT (font_object, face->font);
1933 if (cod <= MOST_POSITIVE_FIXNUM)
1934 return Fcons (font_object, make_number (code));
1935 return Fcons (font_object, Fcons (make_number (code >> 16),
1936 make_number (code & 0xFFFF)));
1937 }
1938 return Qnil;
1939 }
1940
1941
1942 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1943 doc: 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 )
1960 (fontset, frame)
1961 Lisp_Object fontset, frame;
1962 {
1963 FRAME_PTR f;
1964 Lisp_Object *realized[2], fontsets[2], tables[2];
1965 Lisp_Object val, elt;
1966 int c, i, j, k;
1967
1968 (*check_window_system_func) ();
1969
1970 fontset = check_fontset_name (fontset, &frame);
1971 f = XFRAME (frame);
1972
1973 1974
1975 realized[0] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1976 * ASIZE (Vfontset_table));
1977 for (i = j = 0; i < ASIZE (Vfontset_table); i++)
1978 {
1979 elt = FONTSET_FROM_ID (i);
1980 if (!NILP (elt)
1981 && EQ (FONTSET_BASE (elt), fontset)
1982 && EQ (FONTSET_FRAME (elt), frame))
1983 realized[0][j++] = elt;
1984 }
1985 realized[0][j] = Qnil;
1986
1987 realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1988 * ASIZE (Vfontset_table));
1989 for (i = j = 0; ! NILP (realized[0][i]); i++)
1990 {
1991 elt = FONTSET_DEFAULT (realized[0][i]);
1992 if (! NILP (elt))
1993 realized[1][j++] = elt;
1994 }
1995 realized[1][j] = Qnil;
1996
1997 tables[0] = Fmake_char_table (Qfontset_info, Qnil);
1998 fontsets[0] = fontset;
1999 if (!EQ (fontset, Vdefault_fontset))
2000 {
2001 tables[1] = Fmake_char_table (Qnil, Qnil);
2002 XCHAR_TABLE (tables[0])->extras[0] = tables[1];
2003 fontsets[1] = Vdefault_fontset;
2004 }
2005
2006 2007
2008 for (k = 0; k <= 1; k++)
2009 {
2010 for (c = 0; c <= MAX_CHAR; )
2011 {
2012 int from = c, to = MAX_5_BYTE_CHAR;
2013
2014 if (c <= MAX_5_BYTE_CHAR)
2015 {
2016 val = char_table_ref_and_range (fontsets[k], c, &from, &to);
2017 }
2018 else
2019 {
2020 val = FONTSET_FALLBACK (fontsets[k]);
2021 to = MAX_CHAR;
2022 }
2023 if (VECTORP (val))
2024 {
2025 Lisp_Object alist;
2026
2027
2028 for (alist = Qnil, i = 0; i < ASIZE (val); i++)
2029 if (! NILP (AREF (val, i)))
2030 alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
2031 alist);
2032 alist = Fnreverse (alist);
2033
2034
2035 for (i = 0; ! NILP (realized[k][i]); i++)
2036 {
2037 if (c <= MAX_5_BYTE_CHAR)
2038 val = FONTSET_REF (realized[k][i], c);
2039 else
2040 val = FONTSET_FALLBACK (realized[k][i]);
2041 if (! CONSP (val) || ! VECTORP (XCDR (val)))
2042 continue;
2043
2044 val = XCDR (val);
2045 for (j = 0; j < ASIZE (val); j++)
2046 {
2047 elt = AREF (val, j);
2048 if (FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
2049 {
2050 Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
2051 Lisp_Object slot, name;
2052
2053 slot = Fassq (RFONT_DEF_SPEC (elt), alist);
2054 name = AREF (font_object, FONT_NAME_INDEX);
2055 if (NILP (Fmember (name, XCDR (slot))))
2056 nconc2 (slot, Fcons (name, Qnil));
2057 }
2058 }
2059 }
2060
2061
2062 if (c <= MAX_5_BYTE_CHAR)
2063 char_table_set_range (tables[k], c, to, alist);
2064 else
2065 XCHAR_TABLE (tables[k])->defalt = alist;
2066
2067
2068 for (; CONSP (alist); alist = XCDR (alist))
2069 {
2070 elt = XCAR (alist);
2071 XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
2072 }
2073 }
2074 c = to + 1;
2075 }
2076 if (EQ (fontset, Vdefault_fontset))
2077 break;
2078 }
2079
2080 return tables[0];
2081 }
2082
2083
2084 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
2085 doc: 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 )
2096 (name, ch, all)
2097 Lisp_Object name, ch, all;
2098 {
2099 int c;
2100 Lisp_Object fontset, elt, list, repertory, val;
2101 int i, j;
2102 Lisp_Object frame;
2103
2104 frame = Qnil;
2105 fontset = check_fontset_name (name, &frame);
2106
2107 CHECK_CHARACTER (ch);
2108 c = XINT (ch);
2109 list = Qnil;
2110 while (1)
2111 {
2112 for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
2113 i++, elt = FONTSET_FALLBACK (fontset))
2114 if (VECTORP (elt))
2115 for (j = 0; j < ASIZE (elt); j++)
2116 {
2117 Lisp_Object family, registry;
2118
2119 val = AREF (elt, j);
2120 if (NILP (val))
2121 return Qnil;
2122 repertory = AREF (val, 1);
2123 if (INTEGERP (repertory))
2124 {
2125 struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
2126
2127 if (! CHAR_CHARSET_P (c, charset))
2128 continue;
2129 }
2130 else if (CHAR_TABLE_P (repertory))
2131 {
2132 if (NILP (CHAR_TABLE_REF (repertory, c)))
2133 continue;
2134 }
2135 val = AREF (val, 0);
2136
2137 family = AREF (val, FONT_FAMILY_INDEX);
2138 if (! NILP (family))
2139 family = SYMBOL_NAME (family);
2140 registry = AREF (val, FONT_REGISTRY_INDEX);
2141 if (! NILP (registry))
2142 registry = SYMBOL_NAME (registry);
2143 val = Fcons (family, registry);
2144 if (NILP (all))
2145 return val;
2146 list = Fcons (val, list);
2147 }
2148 if (EQ (fontset, Vdefault_fontset))
2149 break;
2150 fontset = Vdefault_fontset;
2151 }
2152 return (Fnreverse (list));
2153 }
2154
2155 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
2156 doc: )
2157 ()
2158 {
2159 Lisp_Object fontset, list;
2160 int i;
2161
2162 list = Qnil;
2163 for (i = 0; i < ASIZE (Vfontset_table); i++)
2164 {
2165 fontset = FONTSET_FROM_ID (i);
2166 if (!NILP (fontset)
2167 && BASE_FONTSET_P (fontset))
2168 list = Fcons (FONTSET_NAME (fontset), list);
2169 }
2170
2171 return list;
2172 }
2173
2174
2175 #ifdef FONTSET_DEBUG
2176
2177 Lisp_Object
2178 dump_fontset (fontset)
2179 Lisp_Object fontset;
2180 {
2181 Lisp_Object vec;
2182
2183 vec = Fmake_vector (make_number (3), Qnil);
2184 ASET (vec, 0, FONTSET_ID (fontset));
2185
2186 if (BASE_FONTSET_P (fontset))
2187 {
2188 ASET (vec, 1, FONTSET_NAME (fontset));
2189 }
2190 else
2191 {
2192 Lisp_Object frame;
2193
2194 frame = FONTSET_FRAME (fontset);
2195 if (FRAMEP (frame))
2196 {
2197 FRAME_PTR f = XFRAME (frame);
2198
2199 if (FRAME_LIVE_P (f))
2200 ASET (vec, 1,
2201 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name));
2202 else
2203 ASET (vec, 1,
2204 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
2205 }
2206 if (!NILP (FONTSET_DEFAULT (fontset)))
2207 ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
2208 }
2209 return vec;
2210 }
2211
2212 DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
2213 doc: )
2214 ()
2215 {
2216 Lisp_Object val;
2217 int i;
2218
2219 for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
2220 if (! NILP (AREF (Vfontset_table, i)))
2221 val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
2222 return (Fnreverse (val));
2223 }
2224 #endif
2225
2226 void
2227 syms_of_fontset ()
2228 {
2229 DEFSYM (Qfontset, "fontset");
2230 Fput (Qfontset, Qchar_table_extra_slots, make_number (9));
2231 DEFSYM (Qfontset_info, "fontset-info");
2232 Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
2233
2234 DEFSYM (Qprepend, "prepend");
2235 DEFSYM (Qappend, "append");
2236 DEFSYM (Qlatin, "latin");
2237
2238 Vcached_fontset_data = Qnil;
2239 staticpro (&Vcached_fontset_data);
2240
2241 Vfontset_table = Fmake_vector (make_number (32), Qnil);
2242 staticpro (&Vfontset_table);
2243
2244 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
2245 staticpro (&Vdefault_fontset);
2246 FONTSET_ID (Vdefault_fontset) = make_number (0);
2247 FONTSET_NAME (Vdefault_fontset)
2248 = make_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
2249 ASET (Vfontset_table, 0, Vdefault_fontset);
2250 next_fontset_id = 1;
2251
2252 auto_fontset_alist = Qnil;
2253 staticpro (&auto_fontset_alist);
2254
2255 DEFVAR_LISP ("font-encoding-charset-alist", &Vfont_encoding_charset_alist,
2256 doc: 2257 2258 2259 2260 2261 2262 2263 );
2264 Vfont_encoding_charset_alist = Qnil;
2265
2266 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
2267 doc: 2268 2269 2270 2271 2272 2273 );
2274 Vuse_default_ascent = Qnil;
2275
2276 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
2277 doc: 2278 2279 2280 2281 2282 );
2283 Vignore_relative_composition = Qnil;
2284
2285 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
2286 doc: 2287 2288 );
2289 Valternate_fontname_alist = Qnil;
2290
2291 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
2292 doc: );
2293 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
2294 make_pure_c_string ("fontset-default")),
2295 Qnil);
2296
2297 DEFVAR_LISP ("vertical-centering-font-regexp",
2298 &Vvertical_centering_font_regexp,
2299 doc: 2300 2301 );
2302 Vvertical_centering_font_regexp = Qnil;
2303
2304 DEFVAR_LISP ("otf-script-alist", &Votf_script_alist,
2305 doc: );
2306 Votf_script_alist = Qnil;
2307
2308 defsubr (&Squery_fontset);
2309 defsubr (&Snew_fontset);
2310 defsubr (&Sset_fontset_font);
2311 defsubr (&Sinternal_char_font);
2312 defsubr (&Sfontset_info);
2313 defsubr (&Sfontset_font);
2314 defsubr (&Sfontset_list);
2315 #ifdef FONTSET_DEBUG
2316 defsubr (&Sfontset_list_all);
2317 #endif
2318 }
2319
2320 2321