Mercurial > hg > xemacs-beta

comparison src/objects.c @ 5125:b5df3737028a ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents 623d57b7fbe8 d95c102a96d3
children a9c41067dd88
comparison
equal deleted inserted replaced
5124:623d57b7fbe8 5125:b5df3737028a
1 /* Generic Objects and Functions. 1 /* Generic Objects and Functions.
2 Copyright (C) 1995 Free Software Foundation, Inc. 2 Copyright (C) 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois. 3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995, 1996, 2002, 2004 Ben Wing. 4 Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
41 41
42 /* Objects that are substituted when an instantiation fails. 42 /* Objects that are substituted when an instantiation fails.
43 If we leave in the Qunbound value, we will probably get crashes. */ 43 If we leave in the Qunbound value, we will probably get crashes. */
44 Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance; 44 Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance;
45 45
46 /* Authors: Ben Wing, Chuck Thompson */ 46 /* Author: Ben Wing; some earlier code from Chuck Thompson, Jamie
47 Zawinski. */
47 48
48 DOESNT_RETURN 49 DOESNT_RETURN
49 finalose (void *ptr) 50 finalose (void *ptr)
50 { 51 {
51 Lisp_Object obj = wrap_pointer_1 (ptr); 52 Lisp_Object obj = wrap_pointer_1 (ptr);
100 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun, 101 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
101 int escapeflag) 102 int escapeflag)
102 { 103 {
103 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); 104 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
104 if (print_readably) 105 if (print_readably)
105 printing_unreadable_object ("#<color-instance 0x%x>", 106 printing_unreadable_lcrecord (obj, 0);
106 c->header.uid);
107 write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name); 107 write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name);
108 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device); 108 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device);
109 if (!NILP (c->device)) /* Vthe_null_color_instance */ 109 if (!NILP (c->device)) /* Vthe_null_color_instance */
110 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance, 110 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance,
111 (c, printcharfun, escapeflag)); 111 (c, printcharfun, escapeflag));
120 if (!NILP (c->device)) 120 if (!NILP (c->device))
121 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c)); 121 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
122 } 122 }
123 123
124 static int 124 static int
125 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 125 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth,
126 int UNUSED (foldcase))
126 { 127 {
127 Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); 128 Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
128 Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); 129 Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
129 130
130 return (c1 == c2) || 131 return (c1 == c2) ||
315 static void 316 static void
316 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 317 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
317 { 318 {
318 Lisp_Font_Instance *f = XFONT_INSTANCE (obj); 319 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
319 if (print_readably) 320 if (print_readably)
320 printing_unreadable_object ("#<font-instance 0x%x>", f->header.uid); 321 printing_unreadable_lcrecord (obj, 0);
321 write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name); 322 write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name);
322 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device); 323 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device);
323 if (!NILP (f->device)) 324 if (!NILP (f->device))
324 { 325 {
325 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, 326 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
343 /* Fonts are equal if they resolve to the same name. 344 /* Fonts are equal if they resolve to the same name.
344 Since we call `font-truename' to do this, and since font-truename is lazy, 345 Since we call `font-truename' to do this, and since font-truename is lazy,
345 this means the `equal' could cause XListFonts to be run the first time. 346 this means the `equal' could cause XListFonts to be run the first time.
346 */ 347 */
347 static int 348 static int
348 font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 349 font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth,
350 int UNUSED (foldcase))
349 { 351 {
350 /* #### should this be moved into a device method? */ 352 /* #### should this be moved into a device method? */
351 return internal_equal (font_instance_truename_internal 353 return internal_equal (font_instance_truename_internal
352 (obj1, ERROR_ME_DEBUG_WARN), 354 (obj1, ERROR_ME_DEBUG_WARN),
353 font_instance_truename_internal 355 font_instance_truename_internal
840 } 842 }
841 } 843 }
842 844
843 #endif /* MULE */ 845 #endif /* MULE */
844 846
847 /* It's a little non-obvious what's going on here. Specifically:
848
849 MATCHSPEC is a somewhat bogus way in the specifier mechanism of passing
850 in additional information needed to instantiate some object. For fonts,
851 it's a cons of (CHARSET . SECOND-STAGE-P). SECOND-STAGE-P, if set,
852 means "try harder to find an appropriate font" and is a very bogus way
853 of dealing with the fact that it may not be possible to may a charset
854 directly onto a font; it's used esp. under Windows. @@#### We need to
855 change this so that MATCHSPEC is just a character.
856
857 When redisplay is building up its structure, and needs font info, it
858 calls functions in faces.c such as ensure_face_cachel_complete() (map
859 fonts needed for a string of text) or
860 ensure_face_cachel_contains_charset() (map fonts needed for a charset
861 derived from a single character). The former function calls the latter;
862 the latter calls face_property_matching_instance(); this constructs the
863 MATCHSPEC and calls specifier_instance_no_quit() twice (first stage and
864 second stage, updating MATCHSPEC appropriately). That function, in
865 turn, looks up the appropriate specifier method to do the instantiation,
866 which, lo and behold, is this function here (because we set it in
867 initialization using `SPECIFIER_HAS_METHOD (font, instantiate);'). We
868 in turn call the device method `find_charset_font', which maps to
869 mswindows_find_charset_font(), x_find_charset_font(), or similar, in
870 objects-msw.c or the like.
871
872 --ben */
845 873
846 static Lisp_Object 874 static Lisp_Object
847 font_instantiate (Lisp_Object UNUSED (specifier), 875 font_instantiate (Lisp_Object UNUSED (specifier),
848 Lisp_Object USED_IF_MULE (matchspec), 876 Lisp_Object USED_IF_MULE (matchspec),
849 Lisp_Object domain, Lisp_Object instantiator, 877 Lisp_Object domain, Lisp_Object instantiator,
854 Lisp_Object device = DOMAIN_DEVICE (domain); 882 Lisp_Object device = DOMAIN_DEVICE (domain);
855 struct device *d = XDEVICE (device); 883 struct device *d = XDEVICE (device);
856 Lisp_Object instance; 884 Lisp_Object instance;
857 Lisp_Object charset = Qnil; 885 Lisp_Object charset = Qnil;
858 #ifdef MULE 886 #ifdef MULE
859 enum font_specifier_matchspec_stages stage = initial; 887 enum font_specifier_matchspec_stages stage = STAGE_INITIAL;
860 888
861 if (!UNBOUNDP (matchspec)) 889 if (!UNBOUNDP (matchspec))
862 { 890 {
863 charset = Fget_charset (XCAR (matchspec)); 891 charset = Fget_charset (XCAR (matchspec));
864 892
865 #define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \ 893 #define FROB(new_stage, enumstage) \
866 { \ 894 if (EQ(Q##new_stage, XCDR(matchspec))) \
867 stage = new_stage; \ 895 { \
896 stage = enumstage; \
868 } 897 }
869 898
870 FROB(initial) 899 FROB (initial, STAGE_INITIAL)
871 else FROB(final) 900 else FROB (final, STAGE_FINAL)
872 else assert(0); 901 else assert(0);
873 902
874 #undef FROB 903 #undef FROB
875 904
876 } 905 }
894 923
895 if (STRINGP (instantiator)) 924 if (STRINGP (instantiator))
896 { 925 {
897 #ifdef MULE 926 #ifdef MULE
898 /* #### rename these caches. */ 927 /* #### rename these caches. */
899 Lisp_Object cache = stage ? d->charset_font_cache_stage_2 : 928 Lisp_Object cache = stage == STAGE_FINAL ?
929 d->charset_font_cache_stage_2 :
900 d->charset_font_cache_stage_1; 930 d->charset_font_cache_stage_1;
901 #else 931 #else
902 Lisp_Object cache = d->font_instance_cache; 932 Lisp_Object cache = d->font_instance_cache;
903 #endif 933 #endif
904 934
956 Lisp_Object match_inst = Qunbound; 986 Lisp_Object match_inst = Qunbound;
957 assert (XVECTOR_LENGTH (instantiator) == 1); 987 assert (XVECTOR_LENGTH (instantiator) == 1);
958 988
959 match_inst = face_property_matching_instance 989 match_inst = face_property_matching_instance
960 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, 990 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
961 charset, domain, ERROR_ME, no_fallback, depth, initial); 991 charset, domain, ERROR_ME, no_fallback, depth, STAGE_INITIAL);
962 992
963 if (UNBOUNDP(match_inst)) 993 if (UNBOUNDP(match_inst))
964 { 994 {
965 match_inst = face_property_matching_instance 995 match_inst = face_property_matching_instance
966 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, 996 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
967 charset, domain, ERROR_ME, no_fallback, depth, final); 997 charset, domain, ERROR_ME, no_fallback, depth, STAGE_FINAL);
968 } 998 }
969 999
970 return match_inst; 1000 return match_inst;
971 1001
972 } 1002 }