diff src/glyphs.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 8f1ee2d15784
children d1247f3cc363
line wrap: on
line diff
--- a/src/glyphs.c	Sat Dec 26 00:20:27 2009 -0600
+++ b/src/glyphs.c	Sat Dec 26 21:18:49 2009 -0600
@@ -1,9 +1,10 @@
 /* Generic glyph/image implementation + display tables
-   Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+   Copyright (C) 1994, 1995 Board of Trustees, University of Illinois
    Copyright (C) 1995 Tinker Systems
    Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005 Ben Wing
    Copyright (C) 1995 Sun Microsystems
    Copyright (C) 1998, 1999, 2000 Andy Piper
+   Copyright (C) 2007 Didier Verna
 
 This file is part of XEmacs.
 
@@ -473,8 +474,8 @@
   for (len -= 2; len >= 1; len -= 2)
     {
       /* Keyword comparisons can be done with eq, the value must be
-         done with equal.
-         #### Note that this does not optimize re-ordering. */
+	 done with equal.
+	 #### Note that this does not optimize re-ordering. */
       if (!EQ (elt[len], old_elt[len])
 	  || !internal_equal (elt[len+1], old_elt[len+1], 0))
 	alist = Fcons (Fcons (elt[len], elt[len+1]), alist);
@@ -913,7 +914,7 @@
   { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, name) },
   { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, parent) },
   { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, instantiator) },
-  { XD_UNION, offsetof (struct Lisp_Image_Instance, u), 
+  { XD_UNION, offsetof (struct Lisp_Image_Instance, u),
     XD_INDIRECT (0, 0), { &image_instance_data_description } },
   { XD_END }
 };
@@ -992,7 +993,7 @@
 
   if (print_readably)
     printing_unreadable_object ("#<image-instance 0x%x>",
-           ii->header.uid);
+	   ii->header.uid);
   write_fmt_string_lisp (printcharfun, "#<image-instance (%s) ", 1,
 			 Fimage_instance_type (obj));
   if (!NILP (ii->name))
@@ -1094,7 +1095,7 @@
 	  write_c_string (printcharfun, "dead");
 	else
 	  write_c_string (printcharfun,
-	                  DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))));
+			  DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))));
       }
       write_c_string (printcharfun, "-frame>");
       write_fmt_string (printcharfun, " 0x%p",
@@ -1292,7 +1293,7 @@
 
     case IMAGE_WIDGET:
       /* We need the hash to be equivalent to what should be
-         displayed. */
+	 displayed. */
       hash = HASH5 (hash,
 		    LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)),
 		    internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
@@ -1313,7 +1314,7 @@
 		 0));
 }
 
-DEFINE_NONDUMPABLE_LISP_OBJECT ("image-instance", image_instance,
+DEFINE_NODUMP_LISP_OBJECT ("image-instance", image_instance,
 					   mark_image_instance, print_image_instance,
 					   finalize_image_instance, image_instance_equal,
 					   image_instance_hash,
@@ -2232,7 +2233,7 @@
 			   Lisp_Object data)
 {
   signal_error_1 (Qimage_conversion_error,
-                list3 (build_msg_string (string1),
+		list3 (build_msg_string (string1),
 		       build_msg_string (string2),
 		       data));
 }
@@ -2242,7 +2243,7 @@
 			     Lisp_Object data1, Lisp_Object data2)
 {
   signal_error_1 (Qimage_conversion_error,
-                list4 (build_msg_string (string1),
+		list4 (build_msg_string (string1),
 		       build_msg_string (string2),
 		       data1, data2));
 }
@@ -2526,9 +2527,10 @@
 /*                        pixmap file functions                         */
 /************************************************************************/
 
-/* If INSTANTIATOR refers to inline data, return Qnil.
+/* If INSTANTIATOR refers to inline data, return Qt.
    If INSTANTIATOR refers to data in a file, return the full filename
-   if it exists; otherwise, return a cons of (filename).
+   if it exists, Qnil if there's no console method for locating the file, or
+   (filename) if there was an error locating the file.
 
    FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
    keywords used to look up the file and inline data,
@@ -2551,17 +2553,24 @@
 
   if (!NILP (file) && NILP (data))
     {
-      Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
-	(decode_console_type(console_type, ERROR_ME),
-	 locate_pixmap_file, (file));
-
-      if (!NILP (retval))
-	return retval;
-      else
-	return Fcons (file, Qnil); /* should have been file */
+      struct console_methods *meths
+	= decode_console_type(console_type, ERROR_ME);
+
+      if (HAS_CONTYPE_METH_P (meths, locate_pixmap_file))
+	{
+	  Lisp_Object retval
+	    = CONTYPE_METH (meths, locate_pixmap_file, (file));
+
+	  if (!NILP (retval))
+	    return retval;
+	  else
+	    return Fcons (file, Qnil); /* should have been file */
+	}
+      else /* method unavailable */
+	return Qnil;
     }
 
-  return Qnil;
+  return Qt;
 }
 
 Lisp_Object
@@ -2586,12 +2595,15 @@
   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
 					     console_type);
 
+  if (NILP (file)) /* normalization impossible for the console type */
+    RETURN_UNGCPRO (Qnil);
+
   if (CONSP (file)) /* failure locating filename */
     signal_double_image_error ("Opening pixmap file",
 			       "no such file or directory",
 			       Fcar (file));
 
-  if (NILP (file)) /* no conversion necessary */
+  if (EQ (file, Qt)) /* no conversion necessary */
     RETURN_UNGCPRO (inst);
 
   alist = tagged_vector_to_alist (inst);
@@ -2737,10 +2749,10 @@
   /* This is unclean but it's fairly standard -- a number of the
      bitmaps in /usr/include/X11/bitmaps use it -- so we support
      it. */
-  if (NILP (mask_file)
+  if (EQ (mask_file, Qt)
       /* don't override explicitly specified mask data. */
       && NILP (assq_no_quit (Q_mask_data, alist))
-      && !NILP (file))
+      && !EQ (file, Qt))
     {
       mask_file = MAYBE_LISP_CONTYPE_METH
 	(decode_console_type(console_type, ERROR_ME),
@@ -2790,17 +2802,20 @@
   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
 						  Q_mask_data, console_type);
 
+  if (NILP (file)) /* normalization impossible for the console type */
+    RETURN_UNGCPRO (Qnil);
+
   if (CONSP (file)) /* failure locating filename */
     signal_double_image_error ("Opening bitmap file",
 			       "no such file or directory",
 			       Fcar (file));
 
-  if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
+  if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */
     RETURN_UNGCPRO (inst);
 
   alist = tagged_vector_to_alist (inst);
 
-  if (!NILP (file))
+  if (!EQ (file, Qt))
     {
       int xhot, yhot;
       Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
@@ -2875,17 +2890,22 @@
   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
 						  Q_mask_data, console_type);
 
+  if (NILP (file)) /* normalization impossible for the console type */
+    RETURN_UNGCPRO (Qnil);
+
   if (CONSP (file)) /* failure locating filename */
     signal_double_image_error ("Opening bitmap file",
 			       "no such file or directory",
 			       Fcar (file));
 
-  if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
+  if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */
     RETURN_UNGCPRO (inst);
 
   alist = tagged_vector_to_alist (inst);
 
   {
+    /* #### FIXME: what if EQ (file, Qt) && !EQ (mask, Qt) ? Is that possible?
+       If so, we have a problem... -- dvl */
     Lisp_Object data = make_string_from_file (file);
     alist = remassq_no_quit (Q_file, alist);
     /* there can't be a :data at this point. */
@@ -3056,7 +3076,7 @@
       value = XCDR (cons);
       CHECK_CONS (value);
       value = XCAR (value);
-      value = Feval (value);
+      value = IGNORE_MULTIPLE_VALUES (Feval (value));
       if (NILP (value))
 	continue;
       if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
@@ -3091,6 +3111,9 @@
   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
 					     console_type);
 
+  if (NILP (file)) /* normalization impossible for the console type */
+    RETURN_UNGCPRO (Qnil);
+
   if (CONSP (file)) /* failure locating filename */
     signal_double_image_error ("Opening pixmap file",
 			       "no such file or directory",
@@ -3099,13 +3122,13 @@
   color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
 						   Qunbound);
 
-  if (NILP (file) && !UNBOUNDP (color_symbols))
+  if (EQ (file, Qt) && !UNBOUNDP (color_symbols))
     /* no conversion necessary */
     RETURN_UNGCPRO (inst);
 
   alist = tagged_vector_to_alist (inst);
 
-  if (!NILP (file))
+  if (!NILP (file) && !EQ (file, Qt))
     {
       Lisp_Object data = pixmap_to_lisp_data (file, 0);
       alist = remassq_no_quit (Q_file, alist);
@@ -3233,7 +3256,7 @@
 static Lisp_Object
 image_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec),
 		   Lisp_Object domain, Lisp_Object instantiator,
-		   Lisp_Object depth)
+		   Lisp_Object depth, int no_fallback)
 {
   Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
   int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
@@ -3272,7 +3295,7 @@
       assert (XVECTOR_LENGTH (instantiator) == 3);
       return (FACE_PROPERTY_INSTANCE
 	      (Fget_face (XVECTOR_DATA (instantiator)[2]),
-	       Qbackground_pixmap, domain, 1, depth));
+	       Qbackground_pixmap, domain, no_fallback, depth));
     }
   else
     {
@@ -3356,7 +3379,7 @@
 	ABORT ();	/* We're not allowed anything else currently. */
 
       /* If we don't have an instance at this point then create
-         one. */
+	 one. */
       if (UNBOUNDP (instance))
 	{
 	  Lisp_Object locative =
@@ -3403,12 +3426,12 @@
       else if (NILP (instance))
 	gui_error ("Can't instantiate image (probably cached)", instantiator);
       /* We found an instance. However, because we are using the glyph
-         as the hash key instead of the instantiator, the current
-         instantiator may not be the same as the original. Thus we
-         must update the instance based on the new
-         instantiator. Preserving instance identity like this is
-         important to stop excessive window system widget creation and
-         deletion - and hence flashing. */
+	 as the hash key instead of the instantiator, the current
+	 instantiator may not be the same as the original. Thus we
+	 must update the instance based on the new
+	 instantiator. Preserving instance identity like this is
+	 important to stop excessive window system widget creation and
+	 deletion - and hence flashing. */
       else
 	{
 	  /* #### This function should be able to cope with *all*
@@ -3787,7 +3810,7 @@
   { XD_END }
 };
 
-DEFINE_LISP_OBJECT_WITH_PROPS ("glyph", glyph,
+DEFINE_DUMPABLE_LISP_OBJECT_WITH_PROPS ("glyph", glyph,
 					  mark_glyph, print_glyph, 0,
 					  glyph_equal, glyph_hash,
 					  glyph_description,
@@ -4256,7 +4279,7 @@
 
 
 /*****************************************************************************
- *                     glyph cachel functions                         	     *
+ *                     glyph cachel functions	     *
  *****************************************************************************/
 
 /* #### All of this is 95% copied from face cachels.  Consider
@@ -4429,7 +4452,7 @@
 
 
 /*****************************************************************************
- *                     subwindow cachel functions                     	     *
+ *                     subwindow cachel functions	     *
  *****************************************************************************/
 /* Subwindows are curious in that you have to physically unmap them to
    not display them. It is problematic deciding what to do in
@@ -4535,10 +4558,12 @@
    expose events that are going to come and ignore them as
    required. */
 
+#ifndef NEW_GC
 struct expose_ignore_blocktype
 {
   Blocktype_declare (struct expose_ignore);
 } *the_expose_ignore_blocktype;
+#endif /* not NEW_GC */
 
 int
 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
@@ -4569,7 +4594,9 @@
 	  if (ei == f->subwindow_exposures_tail)
 	    f->subwindow_exposures_tail = prev;
 
+#ifndef NEW_GC
 	  Blocktype_free (the_expose_ignore_blocktype, ei);
+#endif /* not NEW_GC */
 	  return 1;
 	}
       prev = ei;
@@ -4584,7 +4611,11 @@
     {
       struct expose_ignore *ei;
 
+#ifdef NEW_GC
+      ei = alloc_lrecord_type (struct expose_ignore, &lrecord_expose_ignore);
+#else /* not NEW_GC */
       ei = Blocktype_alloc (the_expose_ignore_blocktype);
+#endif /* not NEW_GC */
 
       ei->next = NULL;
       ei->x = x;
@@ -4789,7 +4820,7 @@
   register_ignored_expose (f, IMAGE_INSTANCE_DISPLAY_X (ii),
 			   IMAGE_INSTANCE_DISPLAY_Y (ii),
 			   IMAGE_INSTANCE_DISPLAY_WIDTH (ii),
-			   IMAGE_INSTANCE_DISPLAY_HEIGHT (ii));  
+			   IMAGE_INSTANCE_DISPLAY_HEIGHT (ii));
   IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
 
   MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)),
@@ -5065,7 +5096,7 @@
 	    {
 	      /* Increment the index of the image slice we are currently
 		 viewing. */
-	      IMAGE_INSTANCE_PIXMAP_SLICE (ii) = 
+	      IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
 		(IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
 		% IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
 	      /* We might need to kick redisplay at this point - but we
@@ -5425,8 +5456,10 @@
 void
 reinit_vars_of_glyphs (void)
 {
+#ifndef NEW_GC
   the_expose_ignore_blocktype =
     Blocktype_new (struct expose_ignore_blocktype);
+#endif /* not NEW_GC */
 
   hold_ignored_expose_registration = 0;
 }