xemacs-beta: src/glyphs.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:3742ea8250b5
+:e0db3c197671
 /* 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.
 XEmacs is free software; you can redistribute it and/or modify it
 under the terms of the GNU General Public License as published by the
 GCPRO1 (alist);
 for (len -= 2; len >= 1; len -= 2)
 {
 /* Keyword comparisons can be done with eq, the value must be
-done with equal.
+	 done with equal.
-#### Note that this does not optimize re-ordering. */
+	 #### 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);
 }
 { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, domain) },
 { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, device) },
 { 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_INDIRECT (0, 0), { &image_instance_data_description } },
 { XD_END }
 };
 static Lisp_Object
 {
 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
 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))
 write_fmt_string_lisp (printcharfun, "%S ", 1, ii->name);
 write_fmt_string_lisp (printcharfun, "on %s ", 1, ii->domain);
 	if (!FRAME_LIVE_P (f))
 	  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",
 			IMAGE_INSTANCE_SUBWINDOW_ID (ii));
 				   depth + 1));
 break;
 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),
 		    internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1),
 		    internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i),
 		(XDEVICE (image_instance_device (obj)),
 		 image_instance_hash, (i, depth),
 		 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,
 					   image_instance_description,
 					   Lisp_Image_Instance);
 DOESNT_RETURN
 signal_double_image_error (const CIbyte *string1, const CIbyte *string2,
 			   Lisp_Object data)
 {
 signal_error_1 (Qimage_conversion_error,
-list3 (build_msg_string (string1),
+		list3 (build_msg_string (string1),
 		       build_msg_string (string2),
 		       data));
 }
 DOESNT_RETURN
 signal_double_image_error_2 (const CIbyte *string1, const CIbyte *string2,
 			     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));
 }
 /****************************************************************************
 /************************************************************************/
 /*                        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,
 respectively, in the instantiator.  Normally these would
 be Q_file and Q_data, but might be different for mask data. */
 data = find_keyword_in_vector (instantiator, data_keyword);
 file = find_keyword_in_vector (instantiator, file_keyword);
 if (!NILP (file) && NILP (data))
 {
-Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
+struct console_methods *meths
-	(decode_console_type(console_type, ERROR_ME),
+	= decode_console_type(console_type, ERROR_ME);
-	 locate_pixmap_file, (file));
+if (HAS_CONTYPE_METH_P (meths, locate_pixmap_file))
-if (!NILP (retval))
+	{
-	return retval;
+	  Lisp_Object retval
-else
+	    = CONTYPE_METH (meths, locate_pixmap_file, (file));
-	return Fcons (file, Qnil); /* should have been file */
-}
+	  if (!NILP (retval))
+	    return retval;
-return Qnil;
+	  else
+	    return Fcons (file, Qnil); /* should have been file */
+	}
+else /* method unavailable */
+	return Qnil;
+}
+return Qt;
 }
 Lisp_Object
 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
 			     Lisp_Object image_type_tag)
 skip out. */
 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);
 {
 		       Lisp_Object mask_file, Lisp_Object console_type)
 {
 /* 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),
 	 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
 if (NILP (mask_file))
 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
 					     console_type);
 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);
 alist = remassq_no_quit (Q_file, alist);
 /* there can't be a :data at this point. */
 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
 					     console_type);
 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. */
 alist = Fcons (Fcons (Q_file, file),
 		   Fcons (Fcons (Q_data, data), alist));
 name = XCAR (cons);
 CHECK_STRING (name);
 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))
 	invalid_argument
 	  ("Result from xpm-color-symbols eval must be nil, string, or color",
 skip out. */
 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));
 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);
 /* there can't be a :data at this point. */
 alist = Fcons (Fcons (Q_file, file),
 displayed in the given domain. */
 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);
 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
 	   && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit))
 {
 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
 {
 Lisp_Object instance = Qnil;
 Lisp_Object subtable = Qnil;
 	}
 else
 	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 =
 	    noseeum_cons (Qnil,
 			  noseeum_cons (hash_key,
 #endif
 	}
 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
+	 as the hash key instead of the instantiator, the current
-instantiator may not be the same as the original. Thus we
+	 instantiator may not be the same as the original. Thus we
-must update the instance based on the new
+	 must update the instance based on the new
-instantiator. Preserving instance identity like this is
+	 instantiator. Preserving instance identity like this is
-important to stop excessive window system widget creation and
+	 important to stop excessive window system widget creation and
-deletion - and hence flashing. */
+	 deletion - and hence flashing. */
 else
 	{
 	  /* #### This function should be able to cope with *all*
 	     changes to the instantiator, but currently only copes
 	     with the most used properties. This means that it is
 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) },
 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) },
 { 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,
 					  glyph_getprop, glyph_putprop,
 					  glyph_remprop, glyph_plist,
 image_instance_layout (instance, width, height, xoffset, yoffset, domain);
 }
 /*****************************************************************************
-*                     glyph cachel functions                         	     *
+*                     glyph cachel functions	     *
 *****************************************************************************/
 /* #### All of this is 95% copied from face cachels.  Consider
 consolidating.
 #endif /* MEMORY_USAGE_STATS */
 /*****************************************************************************
-*                     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
 redisplay. We have two caches - a per-window instance cache that
 keeps track of subwindows on a window, these are linked to their
 the repainting necessary. Worse, we can get in an endless cycle of
 redisplay if we are not careful. Thus we keep a per-frame list of
 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)
 {
 struct expose_ignore *ei, *prev;
 	    prev->next = ei->next;
 	  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;
 }
 return 0;
 {
 if (!hold_ignored_expose_registration)
 {
 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;
 ei->y = y;
 ei->width = width;
 /* make sure we don't get expose events */
 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_SUBWINDOW_DISPLAYEDP (ii) = 0;
 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)),
 		 unmap_subwindow, (ii));
 }
 	      &&
 	      !disable_animated_pixmaps)
 	    {
 	      /* Increment the index of the image slice we are currently
 		 viewing. */
 	      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
 		 also might not. */
 	      MARK_DEVICE_FRAMES_GLYPHS_CHANGED
 }
 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;
 }

Mercurial > hg > xemacs-beta

comparison src/glyphs.c @ 5118:e0db3c197671 ben-lisp-object