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

merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents 623d57b7fbe8 d95c102a96d3
children a9c41067dd88
line wrap: on
line diff
--- a/src/objects.c	Wed Jan 20 07:05:57 2010 -0600
+++ b/src/objects.c	Wed Feb 24 01:58:04 2010 -0600
@@ -1,7 +1,7 @@
 /* Generic Objects and Functions.
    Copyright (C) 1995 Free Software Foundation, Inc.
    Copyright (C) 1995 Board of Trustees, University of Illinois.
-   Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
+   Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -43,7 +43,8 @@
    If we leave in the Qunbound value, we will probably get crashes. */
 Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance;
 
-/* Authors: Ben Wing, Chuck Thompson */
+/* Author: Ben Wing; some earlier code from Chuck Thompson, Jamie
+   Zawinski. */
 
 DOESNT_RETURN
 finalose (void *ptr)
@@ -102,8 +103,7 @@
 {
   Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
   if (print_readably)
-    printing_unreadable_object ("#<color-instance 0x%x>",
-	   c->header.uid);
+    printing_unreadable_lcrecord (obj, 0);
   write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name);
   write_fmt_string_lisp (printcharfun, " on %s", 1, c->device);
   if (!NILP (c->device)) /* Vthe_null_color_instance */
@@ -122,7 +122,8 @@
 }
 
 static int
-color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth,
+		      int UNUSED (foldcase))
 {
   Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
   Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
@@ -317,7 +318,7 @@
 {
   Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
   if (print_readably)
-    printing_unreadable_object ("#<font-instance 0x%x>", f->header.uid);
+    printing_unreadable_lcrecord (obj, 0);
   write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name);
   write_fmt_string_lisp (printcharfun, " on %s", 1, f->device);
   if (!NILP (f->device))
@@ -345,7 +346,8 @@
    this means the `equal' could cause XListFonts to be run the first time.
  */
 static int
-font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth,
+		     int UNUSED (foldcase))
 {
   /* #### should this be moved into a device method? */
   return internal_equal (font_instance_truename_internal
@@ -842,6 +844,32 @@
 
 #endif /* MULE */
 
+/* It's a little non-obvious what's going on here.  Specifically:
+
+   MATCHSPEC is a somewhat bogus way in the specifier mechanism of passing
+   in additional information needed to instantiate some object.  For fonts,
+   it's a cons of (CHARSET . SECOND-STAGE-P).  SECOND-STAGE-P, if set,
+   means "try harder to find an appropriate font" and is a very bogus way
+   of dealing with the fact that it may not be possible to may a charset
+   directly onto a font; it's used esp. under Windows.  @@#### We need to
+   change this so that MATCHSPEC is just a character.
+
+   When redisplay is building up its structure, and needs font info, it
+   calls functions in faces.c such as ensure_face_cachel_complete() (map
+   fonts needed for a string of text) or
+   ensure_face_cachel_contains_charset() (map fonts needed for a charset
+   derived from a single character).  The former function calls the latter;
+   the latter calls face_property_matching_instance(); this constructs the
+   MATCHSPEC and calls specifier_instance_no_quit() twice (first stage and
+   second stage, updating MATCHSPEC appropriately).  That function, in
+   turn, looks up the appropriate specifier method to do the instantiation,
+   which, lo and behold, is this function here (because we set it in
+   initialization using `SPECIFIER_HAS_METHOD (font, instantiate);').  We
+   in turn call the device method `find_charset_font', which maps to
+   mswindows_find_charset_font(), x_find_charset_font(), or similar, in
+   objects-msw.c or the like.
+
+   --ben */
 
 static Lisp_Object
 font_instantiate (Lisp_Object UNUSED (specifier),
@@ -856,19 +884,20 @@
   Lisp_Object instance;
   Lisp_Object charset = Qnil;
 #ifdef MULE
-  enum font_specifier_matchspec_stages stage = initial;
+  enum font_specifier_matchspec_stages stage = STAGE_INITIAL;
 
   if (!UNBOUNDP (matchspec))
     {
       charset = Fget_charset (XCAR (matchspec));
 
-#define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec)))	\
-	    {							\
-	      stage = new_stage;				\
+#define FROB(new_stage, enumstage)			\
+          if (EQ(Q##new_stage, XCDR(matchspec)))	\
+	    {						\
+	      stage = enumstage;			\
 	    }
 
-	  FROB(initial)
-	  else FROB(final)
+	  FROB (initial, STAGE_INITIAL)
+	  else FROB (final, STAGE_FINAL)
 	  else assert(0);
 
 #undef FROB
@@ -896,7 +925,8 @@
     {
 #ifdef MULE
       /* #### rename these caches. */
-      Lisp_Object cache = stage ? d->charset_font_cache_stage_2 :
+      Lisp_Object cache = stage == STAGE_FINAL ?
+	d->charset_font_cache_stage_2 :
 	d->charset_font_cache_stage_1;
 #else
       Lisp_Object cache = d->font_instance_cache;
@@ -958,13 +988,13 @@
 
       match_inst = face_property_matching_instance
 	(Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
-	 charset, domain, ERROR_ME, no_fallback, depth, initial);
+	 charset, domain, ERROR_ME, no_fallback, depth, STAGE_INITIAL);
 
       if (UNBOUNDP(match_inst))
 	{
 	  match_inst = face_property_matching_instance
 	    (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
-	     charset, domain, ERROR_ME, no_fallback, depth, final);
+	     charset, domain, ERROR_ME, no_fallback, depth, STAGE_FINAL);
 	}
 
       return match_inst;