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