Mercurial > hg > xemacs-beta
comparison src/objects.c @ 5118:e0db3c197671 ben-lisp-object
merge up to latest default branch, doesn't compile yet
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sat, 26 Dec 2009 21:18:49 -0600 |
parents | 3742ea8250b5 a23ac8f90a49 |
children | 623d57b7fbe8 |
comparison
equal
deleted
inserted
replaced
5117:3742ea8250b5 | 5118:e0db3c197671 |
---|---|
61 | 61 |
62 Lisp_Object Qcolor_instancep; | 62 Lisp_Object Qcolor_instancep; |
63 | 63 |
64 static const struct memory_description color_instance_data_description_1 []= { | 64 static const struct memory_description color_instance_data_description_1 []= { |
65 #ifdef HAVE_TTY | 65 #ifdef HAVE_TTY |
66 #ifdef NEW_GC | |
67 { XD_LISP_OBJECT, tty_console }, | |
68 #else /* not NEW_GC */ | |
66 { XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } }, | 69 { XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } }, |
70 #endif /* not NEW_GC */ | |
67 #endif | 71 #endif |
68 { XD_END } | 72 { XD_END } |
69 }; | 73 }; |
70 | 74 |
71 static const struct sized_memory_description color_instance_data_description = { | 75 static const struct sized_memory_description color_instance_data_description = { |
97 int escapeflag) | 101 int escapeflag) |
98 { | 102 { |
99 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); | 103 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); |
100 if (print_readably) | 104 if (print_readably) |
101 printing_unreadable_object ("#<color-instance 0x%x>", | 105 printing_unreadable_object ("#<color-instance 0x%x>", |
102 c->header.uid); | 106 c->header.uid); |
103 write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name); | 107 write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name); |
104 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device); | 108 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device); |
105 if (!NILP (c->device)) /* Vthe_null_color_instance */ | 109 if (!NILP (c->device)) /* Vthe_null_color_instance */ |
106 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance, | 110 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance, |
107 (c, printcharfun, escapeflag)); | 111 (c, printcharfun, escapeflag)); |
143 !d ? LISP_HASH (obj) | 147 !d ? LISP_HASH (obj) |
144 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), | 148 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), |
145 LISP_HASH (obj))); | 149 LISP_HASH (obj))); |
146 } | 150 } |
147 | 151 |
148 DEFINE_NONDUMPABLE_LISP_OBJECT ("color-instance", color_instance, | 152 DEFINE_NODUMP_LISP_OBJECT ("color-instance", color_instance, |
149 mark_color_instance, print_color_instance, | 153 mark_color_instance, print_color_instance, |
150 finalize_color_instance, color_instance_equal, | 154 finalize_color_instance, color_instance_equal, |
151 color_instance_hash, | 155 color_instance_hash, |
152 color_instance_description, | 156 color_instance_description, |
153 Lisp_Color_Instance); | 157 Lisp_Color_Instance); |
154 | 158 |
155 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* | 159 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* |
156 Return a new `color-instance' object named NAME (a string). | 160 Return a new `color-instance' object named NAME (a string). |
157 | 161 |
158 Optional argument DEVICE specifies the device this object applies to | 162 Optional argument DEVICE specifies the device this object applies to |
271 static Lisp_Object font_instance_truename_internal (Lisp_Object xfont, | 275 static Lisp_Object font_instance_truename_internal (Lisp_Object xfont, |
272 Error_Behavior errb); | 276 Error_Behavior errb); |
273 | 277 |
274 static const struct memory_description font_instance_data_description_1 []= { | 278 static const struct memory_description font_instance_data_description_1 []= { |
275 #ifdef HAVE_TTY | 279 #ifdef HAVE_TTY |
276 { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description} }, | 280 #ifdef NEW_GC |
281 { XD_LISP_OBJECT, tty_console }, | |
282 #else /* not NEW_GC */ | |
283 { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description } }, | |
284 #endif /* not NEW_GC */ | |
277 #endif | 285 #endif |
278 { XD_END } | 286 { XD_END } |
279 }; | 287 }; |
280 | 288 |
281 static const struct sized_memory_description font_instance_data_description = { | 289 static const struct sized_memory_description font_instance_data_description = { |
285 static const struct memory_description font_instance_description[] = { | 293 static const struct memory_description font_instance_description[] = { |
286 { XD_INT, offsetof (Lisp_Font_Instance, font_instance_type) }, | 294 { XD_INT, offsetof (Lisp_Font_Instance, font_instance_type) }, |
287 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, name)}, | 295 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, name)}, |
288 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, truename)}, | 296 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, truename)}, |
289 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, device)}, | 297 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, device)}, |
290 { XD_UNION, offsetof (Lisp_Font_Instance, data), | 298 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, charset)}, |
299 { XD_UNION, offsetof (Lisp_Font_Instance, data), | |
291 XD_INDIRECT (0, 0), { &font_instance_data_description } }, | 300 XD_INDIRECT (0, 0), { &font_instance_data_description } }, |
292 { XD_END } | 301 { XD_END } |
293 }; | 302 }; |
294 | 303 |
295 | 304 |
313 if (print_readably) | 322 if (print_readably) |
314 printing_unreadable_object ("#<font-instance 0x%x>", f->header.uid); | 323 printing_unreadable_object ("#<font-instance 0x%x>", f->header.uid); |
315 write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name); | 324 write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name); |
316 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device); | 325 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device); |
317 if (!NILP (f->device)) | 326 if (!NILP (f->device)) |
318 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, | 327 { |
319 (f, printcharfun, escapeflag)); | 328 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, |
329 (f, printcharfun, escapeflag)); | |
330 | |
331 } | |
320 write_fmt_string (printcharfun, " 0x%x>", f->header.uid); | 332 write_fmt_string (printcharfun, " 0x%x>", f->header.uid); |
321 } | 333 } |
322 | 334 |
323 static void | 335 static void |
324 finalize_font_instance (void *header, int for_disksave) | 336 finalize_font_instance (void *header, int for_disksave) |
353 return internal_hash (font_instance_truename_internal | 365 return internal_hash (font_instance_truename_internal |
354 (obj, ERROR_ME_DEBUG_WARN), | 366 (obj, ERROR_ME_DEBUG_WARN), |
355 depth + 1); | 367 depth + 1); |
356 } | 368 } |
357 | 369 |
358 DEFINE_NONDUMPABLE_LISP_OBJECT ("font-instance", font_instance, | 370 DEFINE_NODUMP_LISP_OBJECT ("font-instance", font_instance, |
359 mark_font_instance, print_font_instance, | 371 mark_font_instance, print_font_instance, |
360 finalize_font_instance, font_instance_equal, | 372 finalize_font_instance, font_instance_equal, |
361 font_instance_hash, font_instance_description, | 373 font_instance_hash, font_instance_description, |
362 Lisp_Font_Instance); | 374 Lisp_Font_Instance); |
363 | 375 |
364 | 376 |
365 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* | 377 /* #### Why is this exposed to Lisp? Used in: |
378 x-frob-font-size, gtk-font-menu-load-font, x-font-menu-load-font-xft, | |
379 x-font-menu-load-font-core, mswindows-font-menu-load-font, | |
380 mswindows-frob-font-style-and-sizify, mswindows-frob-font-size. */ | |
381 DEFUN ("make-font-instance", Fmake_font_instance, 1, 4, 0, /* | |
366 Return a new `font-instance' object named NAME. | 382 Return a new `font-instance' object named NAME. |
367 DEVICE specifies the device this object applies to and defaults to the | 383 DEVICE specifies the device this object applies to and defaults to the |
368 selected device. An error is signalled if the font is unknown or cannot | 384 selected device. An error is signalled if the font is unknown or cannot |
369 be allocated; however, if NOERROR is non-nil, nil is simply returned in | 385 be allocated; however, if NOERROR is non-nil, nil is simply returned in |
370 this case. | 386 this case. CHARSET is used internally. #### make helper function? |
371 | 387 |
372 The returned object is a normal, first-class lisp object. The way you | 388 The returned object is a normal, first-class lisp object. The way you |
373 `deallocate' the font is the way you deallocate any other lisp object: | 389 `deallocate' the font is the way you deallocate any other lisp object: |
374 you drop all pointers to it and allow it to be garbage collected. When | 390 you drop all pointers to it and allow it to be garbage collected. When |
375 these objects are GCed, the underlying X data is deallocated as well. | 391 these objects are GCed, the underlying GUI data is deallocated as well. |
376 */ | 392 */ |
377 (name, device, noerror)) | 393 (name, device, noerror, charset)) |
378 { | 394 { |
379 Lisp_Object obj; | 395 Lisp_Object obj; |
380 Lisp_Font_Instance *f; | 396 Lisp_Font_Instance *f; |
381 int retval = 0; | 397 int retval = 0; |
382 Error_Behavior errb = decode_error_behavior_flag (noerror); | 398 Error_Behavior errb = decode_error_behavior_flag (noerror); |
399 | 415 |
400 /* Stick some default values here ... */ | 416 /* Stick some default values here ... */ |
401 f->ascent = f->height = 1; | 417 f->ascent = f->height = 1; |
402 f->descent = 0; | 418 f->descent = 0; |
403 f->width = 1; | 419 f->width = 1; |
420 f->charset = charset; | |
404 f->proportional_p = 0; | 421 f->proportional_p = 0; |
405 | 422 |
406 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance, | 423 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance, |
407 (f, name, device, errb)); | 424 (f, name, device, errb)); |
408 | 425 |
480 { | 497 { |
481 Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); | 498 Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); |
482 | 499 |
483 if (NILP (f->device)) | 500 if (NILP (f->device)) |
484 { | 501 { |
485 maybe_signal_error (Qgui_error, "Couldn't determine font truename", | 502 maybe_signal_error (Qgui_error, |
486 font_instance, Qfont, errb); | 503 "can't determine truename: " |
504 "no device for font instance", | |
505 font_instance, Qfont, errb); | |
487 return Qnil; | 506 return Qnil; |
488 } | 507 } |
489 | 508 |
490 return DEVMETH_OR_GIVEN (XDEVICE (f->device), | 509 return DEVMETH_OR_GIVEN (XDEVICE (f->device), |
491 font_instance_truename, (f, errb), f->name); | 510 font_instance_truename, (f, errb), f->name); |
501 { | 520 { |
502 CHECK_FONT_INSTANCE (font_instance); | 521 CHECK_FONT_INSTANCE (font_instance); |
503 return font_instance_truename_internal (font_instance, ERROR_ME); | 522 return font_instance_truename_internal (font_instance, ERROR_ME); |
504 } | 523 } |
505 | 524 |
525 DEFUN ("font-instance-charset", Ffont_instance_charset, 1, 1, 0, /* | |
526 Return the Mule charset that FONT-INSTANCE was allocated to handle. | |
527 */ | |
528 (font_instance)) | |
529 { | |
530 CHECK_FONT_INSTANCE (font_instance); | |
531 return XFONT_INSTANCE (font_instance)->charset; | |
532 } | |
533 | |
506 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /* | 534 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /* |
507 Return the properties (an alist or nil) of FONT-INSTANCE. | 535 Return the properties (an alist or nil) of FONT-INSTANCE. |
508 */ | 536 */ |
509 (font_instance)) | 537 (font_instance)) |
510 { | 538 { |
570 of for `equal' */ | 598 of for `equal' */ |
571 | 599 |
572 static Lisp_Object | 600 static Lisp_Object |
573 color_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), | 601 color_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), |
574 Lisp_Object domain, Lisp_Object instantiator, | 602 Lisp_Object domain, Lisp_Object instantiator, |
575 Lisp_Object depth) | 603 Lisp_Object depth, int no_fallback) |
576 { | 604 { |
577 /* When called, we're inside of call_with_suspended_errors(), | 605 /* When called, we're inside of call_with_suspended_errors(), |
578 so we can freely error. */ | 606 so we can freely error. */ |
579 Lisp_Object device = DOMAIN_DEVICE (domain); | 607 Lisp_Object device = DOMAIN_DEVICE (domain); |
580 struct device *d = XDEVICE (device); | 608 struct device *d = XDEVICE (device); |
581 | 609 |
582 if (COLOR_INSTANCEP (instantiator)) | 610 if (COLOR_INSTANCEP (instantiator)) |
583 { | 611 { |
584 /* If we are on the same device then we're done. Otherwise change | 612 /* If we are on the same device then we're done. Otherwise change |
585 the instantiator to the name used to generate the pixel and let the | 613 the instantiator to the name used to generate the pixel and let the |
586 STRINGP case deal with it. */ | 614 STRINGP case deal with it. */ |
587 if (NILP (device) /* Vthe_null_color_instance */ | 615 if (NILP (device) /* Vthe_null_color_instance */ |
588 || EQ (device, XCOLOR_INSTANCE (instantiator)->device)) | 616 || EQ (device, XCOLOR_INSTANCE (instantiator)->device)) |
589 return instantiator; | 617 return instantiator; |
590 else | 618 else |
591 instantiator = Fcolor_instance_name (instantiator); | 619 instantiator = Fcolor_instance_name (instantiator); |
592 } | 620 } |
593 | 621 |
621 if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)))) | 649 if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)))) |
622 gui_error ("Color specifier not attached to a face", | 650 gui_error ("Color specifier not attached to a face", |
623 instantiator); | 651 instantiator); |
624 return (FACE_PROPERTY_INSTANCE_1 | 652 return (FACE_PROPERTY_INSTANCE_1 |
625 (Fget_face (XVECTOR_DATA (instantiator)[0]), | 653 (Fget_face (XVECTOR_DATA (instantiator)[0]), |
626 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier)), | 654 COLOR_SPECIFIER_FACE_PROPERTY |
627 domain, ERROR_ME, 0, depth)); | 655 (XCOLOR_SPECIFIER (specifier)), |
656 domain, ERROR_ME, no_fallback, depth)); | |
628 | 657 |
629 case 2: | 658 case 2: |
630 return (FACE_PROPERTY_INSTANCE_1 | 659 return (FACE_PROPERTY_INSTANCE_1 |
631 (Fget_face (XVECTOR_DATA (instantiator)[0]), | 660 (Fget_face (XVECTOR_DATA (instantiator)[0]), |
632 XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, 0, depth)); | 661 XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, |
662 no_fallback, depth)); | |
633 | 663 |
634 default: | 664 default: |
635 ABORT (); | 665 ABORT (); |
636 } | 666 } |
637 } | 667 } |
753 | 783 |
754 static int | 784 static int |
755 font_spec_matches_charset (struct device *d, Lisp_Object charset, | 785 font_spec_matches_charset (struct device *d, Lisp_Object charset, |
756 const Ibyte *nonreloc, Lisp_Object reloc, | 786 const Ibyte *nonreloc, Lisp_Object reloc, |
757 Bytecount offset, Bytecount length, | 787 Bytecount offset, Bytecount length, |
758 int stage) | 788 enum font_specifier_matchspec_stages stage) |
759 { | 789 { |
760 return DEVMETH_OR_GIVEN (d, font_spec_matches_charset, | 790 return DEVMETH_OR_GIVEN (d, font_spec_matches_charset, |
761 (d, charset, nonreloc, reloc, offset, length, | 791 (d, charset, nonreloc, reloc, offset, length, |
762 stage), | 792 stage), |
763 1); | 793 1); |
766 static void | 796 static void |
767 font_validate_matchspec (Lisp_Object matchspec) | 797 font_validate_matchspec (Lisp_Object matchspec) |
768 { | 798 { |
769 CHECK_CONS (matchspec); | 799 CHECK_CONS (matchspec); |
770 Fget_charset (XCAR (matchspec)); | 800 Fget_charset (XCAR (matchspec)); |
801 | |
802 do | |
803 { | |
804 if (EQ(XCDR(matchspec), Qinitial)) | |
805 { | |
806 break; | |
807 } | |
808 if (EQ(XCDR(matchspec), Qfinal)) | |
809 { | |
810 break; | |
811 } | |
812 | |
813 invalid_argument("Invalid font matchspec stage", | |
814 XCDR(matchspec)); | |
815 } while (0); | |
771 } | 816 } |
772 | 817 |
773 void | 818 void |
774 initialize_charset_font_caches (struct device *d) | 819 initialize_charset_font_caches (struct device *d) |
775 { | 820 { |
789 { | 834 { |
790 struct device *d = XDEVICE (XCAR (devcons)); | 835 struct device *d = XDEVICE (XCAR (devcons)); |
791 hash_table = Fgethash (charset, d->charset_font_cache_stage_1, | 836 hash_table = Fgethash (charset, d->charset_font_cache_stage_1, |
792 Qunbound); | 837 Qunbound); |
793 if (!UNBOUNDP (hash_table)) | 838 if (!UNBOUNDP (hash_table)) |
794 Fclrhash (hash_table); | 839 Fclrhash (hash_table); |
795 hash_table = Fgethash (charset, d->charset_font_cache_stage_2, | 840 hash_table = Fgethash (charset, d->charset_font_cache_stage_2, |
796 Qunbound); | 841 Qunbound); |
797 if (!UNBOUNDP (hash_table)) | 842 if (!UNBOUNDP (hash_table)) |
798 Fclrhash (hash_table); | 843 Fclrhash (hash_table); |
799 } | 844 } |
800 } | 845 } |
801 | 846 |
802 #endif /* MULE */ | 847 #endif /* MULE */ |
803 | 848 |
804 | 849 |
805 static Lisp_Object | 850 static Lisp_Object |
806 font_instantiate (Lisp_Object UNUSED (specifier), | 851 font_instantiate (Lisp_Object UNUSED (specifier), |
807 Lisp_Object USED_IF_MULE (matchspec), | 852 Lisp_Object USED_IF_MULE (matchspec), |
808 Lisp_Object domain, Lisp_Object instantiator, | 853 Lisp_Object domain, Lisp_Object instantiator, |
809 Lisp_Object depth) | 854 Lisp_Object depth, int no_fallback) |
810 { | 855 { |
811 /* When called, we're inside of call_with_suspended_errors(), | 856 /* When called, we're inside of call_with_suspended_errors(), |
812 so we can freely error. */ | 857 so we can freely error. */ |
813 Lisp_Object device = DOMAIN_DEVICE (domain); | 858 Lisp_Object device = DOMAIN_DEVICE (domain); |
814 struct device *d = XDEVICE (device); | 859 struct device *d = XDEVICE (device); |
815 Lisp_Object instance; | 860 Lisp_Object instance; |
816 Lisp_Object charset = Qnil; | 861 Lisp_Object charset = Qnil; |
817 #ifdef MULE | 862 #ifdef MULE |
818 int stage = 0; | 863 enum font_specifier_matchspec_stages stage = initial; |
819 | 864 |
820 if (!UNBOUNDP (matchspec)) | 865 if (!UNBOUNDP (matchspec)) |
821 { | 866 { |
822 charset = Fget_charset (XCAR (matchspec)); | 867 charset = Fget_charset (XCAR (matchspec)); |
823 stage = NILP (XCDR (matchspec)) ? 0 : 1; | 868 |
869 #define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \ | |
870 { \ | |
871 stage = new_stage; \ | |
872 } | |
873 | |
874 FROB(initial) | |
875 else FROB(final) | |
876 else assert(0); | |
877 | |
878 #undef FROB | |
879 | |
824 } | 880 } |
825 #endif | 881 #endif |
826 | 882 |
827 if (FONT_INSTANCEP (instantiator)) | 883 if (FONT_INSTANCEP (instantiator)) |
828 { | 884 { |
829 if (NILP (device) | 885 if (NILP (device) |
830 || EQ (device, XFONT_INSTANCE (instantiator)->device)) | 886 || EQ (device, XFONT_INSTANCE (instantiator)->device)) |
831 { | 887 { |
832 #ifdef MULE | 888 #ifdef MULE |
833 if (font_spec_matches_charset (d, charset, 0, | 889 if (font_spec_matches_charset (d, charset, 0, |
834 Ffont_instance_truename | 890 Ffont_instance_truename |
835 (instantiator), | 891 (instantiator), |
841 } | 897 } |
842 | 898 |
843 if (STRINGP (instantiator)) | 899 if (STRINGP (instantiator)) |
844 { | 900 { |
845 #ifdef MULE | 901 #ifdef MULE |
902 /* #### rename these caches. */ | |
846 Lisp_Object cache = stage ? d->charset_font_cache_stage_2 : | 903 Lisp_Object cache = stage ? d->charset_font_cache_stage_2 : |
847 d->charset_font_cache_stage_1; | 904 d->charset_font_cache_stage_1; |
848 #else | 905 #else |
849 Lisp_Object cache = d->font_instance_cache; | 906 Lisp_Object cache = d->font_instance_cache; |
850 #endif | 907 #endif |
851 | 908 |
852 #ifdef MULE | 909 #ifdef MULE |
873 | 930 |
874 if (UNBOUNDP (matching_font)) | 931 if (UNBOUNDP (matching_font)) |
875 { | 932 { |
876 /* make sure we cache the failures, too. */ | 933 /* make sure we cache the failures, too. */ |
877 matching_font = | 934 matching_font = |
878 DEVMETH_OR_GIVEN (d, find_charset_font, | 935 DEVMETH_OR_GIVEN (d, find_charset_font, |
879 (device, instantiator, charset, stage), | 936 (device, instantiator, charset, stage), |
880 instantiator); | 937 instantiator); |
881 Fputhash (instantiator, matching_font, hash_table); | 938 Fputhash (instantiator, matching_font, hash_table); |
882 } | 939 } |
883 if (NILP (matching_font)) | 940 if (NILP (matching_font)) |
884 return Qunbound; | 941 return Qunbound; |
885 instantiator = matching_font; | 942 instantiator = matching_font; |
890 instance = Fgethash (instantiator, cache, Qunbound); | 947 instance = Fgethash (instantiator, cache, Qunbound); |
891 /* Otherwise, make a new one. */ | 948 /* Otherwise, make a new one. */ |
892 if (UNBOUNDP (instance)) | 949 if (UNBOUNDP (instance)) |
893 { | 950 { |
894 /* make sure we cache the failures, too. */ | 951 /* make sure we cache the failures, too. */ |
895 instance = Fmake_font_instance (instantiator, device, Qt); | 952 instance = Fmake_font_instance (instantiator, device, Qt, charset); |
896 Fputhash (instantiator, instance, cache); | 953 Fputhash (instantiator, instance, cache); |
897 } | 954 } |
898 | 955 |
899 return NILP (instance) ? Qunbound : instance; | 956 return NILP (instance) ? Qunbound : instance; |
900 } | 957 } |
901 else if (VECTORP (instantiator)) | 958 else if (VECTORP (instantiator)) |
902 { | 959 { |
960 Lisp_Object match_inst = Qunbound; | |
903 assert (XVECTOR_LENGTH (instantiator) == 1); | 961 assert (XVECTOR_LENGTH (instantiator) == 1); |
904 return (face_property_matching_instance | 962 |
905 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, | 963 match_inst = face_property_matching_instance |
906 charset, domain, ERROR_ME, 0, depth)); | 964 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, |
965 charset, domain, ERROR_ME, no_fallback, depth, initial); | |
966 | |
967 if (UNBOUNDP(match_inst)) | |
968 { | |
969 match_inst = face_property_matching_instance | |
970 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, | |
971 charset, domain, ERROR_ME, no_fallback, depth, final); | |
972 } | |
973 | |
974 return match_inst; | |
975 | |
907 } | 976 } |
908 else if (NILP (instantiator)) | 977 else if (NILP (instantiator)) |
909 return Qunbound; | 978 return Qunbound; |
910 else | 979 else |
911 ABORT (); /* Eh? */ | 980 ABORT (); /* Eh? */ |
1002 | 1071 |
1003 static Lisp_Object | 1072 static Lisp_Object |
1004 face_boolean_instantiate (Lisp_Object specifier, | 1073 face_boolean_instantiate (Lisp_Object specifier, |
1005 Lisp_Object UNUSED (matchspec), | 1074 Lisp_Object UNUSED (matchspec), |
1006 Lisp_Object domain, Lisp_Object instantiator, | 1075 Lisp_Object domain, Lisp_Object instantiator, |
1007 Lisp_Object depth) | 1076 Lisp_Object depth, int no_fallback) |
1008 { | 1077 { |
1009 /* When called, we're inside of call_with_suspended_errors(), | 1078 /* When called, we're inside of call_with_suspended_errors(), |
1010 so we can freely error. */ | 1079 so we can freely error. */ |
1011 if (NILP (instantiator) || EQ (instantiator, Qt)) | 1080 if (NILP (instantiator) || EQ (instantiator, Qt)) |
1012 return instantiator; | 1081 return instantiator; |
1029 (XFACE_BOOLEAN_SPECIFIER (specifier)); | 1098 (XFACE_BOOLEAN_SPECIFIER (specifier)); |
1030 } | 1099 } |
1031 | 1100 |
1032 retval = (FACE_PROPERTY_INSTANCE_1 | 1101 retval = (FACE_PROPERTY_INSTANCE_1 |
1033 (Fget_face (XVECTOR_DATA (instantiator)[0]), | 1102 (Fget_face (XVECTOR_DATA (instantiator)[0]), |
1034 prop, domain, ERROR_ME, 0, depth)); | 1103 prop, domain, ERROR_ME, no_fallback, depth)); |
1035 | 1104 |
1036 if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2])) | 1105 if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2])) |
1037 retval = NILP (retval) ? Qt : Qnil; | 1106 retval = NILP (retval) ? Qt : Qnil; |
1038 | 1107 |
1039 return retval; | 1108 return retval; |
1142 DEFSUBR (Ffont_instance_p); | 1211 DEFSUBR (Ffont_instance_p); |
1143 DEFSUBR (Ffont_instance_name); | 1212 DEFSUBR (Ffont_instance_name); |
1144 DEFSUBR (Ffont_instance_ascent); | 1213 DEFSUBR (Ffont_instance_ascent); |
1145 DEFSUBR (Ffont_instance_descent); | 1214 DEFSUBR (Ffont_instance_descent); |
1146 DEFSUBR (Ffont_instance_width); | 1215 DEFSUBR (Ffont_instance_width); |
1216 DEFSUBR (Ffont_instance_charset); | |
1147 DEFSUBR (Ffont_instance_proportional_p); | 1217 DEFSUBR (Ffont_instance_proportional_p); |
1148 DEFSUBR (Ffont_instance_truename); | 1218 DEFSUBR (Ffont_instance_truename); |
1149 DEFSUBR (Ffont_instance_properties); | 1219 DEFSUBR (Ffont_instance_properties); |
1150 DEFSUBR (Ffont_list); | 1220 DEFSUBR (Ffont_list); |
1151 | 1221 |