--- a/src/fontcolor.c	Tue Feb 23 07:28:35 2010 -0600
+++ b/src/fontcolor.c	Mon Mar 29 21:28:13 2010 -0500
@@ -2,6 +2,7 @@
    Copyright (C) 1995 Free Software Foundation, Inc.
    Copyright (C) 1995 Board of Trustees, University of Illinois.
    Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing.
+   Copyright (C) 2010 Didier Verna
 
 This file is part of XEmacs.
 
@@ -103,25 +104,22 @@
 {
   Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (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 */
     MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance,
 		   (c, printcharfun, escapeflag));
-  write_fmt_string (printcharfun, " 0x%x>", c->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
 }
 
 static void
-finalize_color_instance (void *header, int for_disksave)
+finalize_color_instance (Lisp_Object obj)
 {
-  Lisp_Color_Instance *c = (Lisp_Color_Instance *) header;
+  Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
 
   if (!NILP (c->device))
-    {
-      if (for_disksave) finalose (c);
-      MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
-    }
+    MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
 }
 
 static int
@@ -150,13 +148,12 @@
 				    LISP_HASH (obj)));
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance,
-			       0, /*dumpable-flag*/
-			       mark_color_instance, print_color_instance,
-			       finalize_color_instance, color_instance_equal,
-			       color_instance_hash,
-			       color_instance_description,
-			       Lisp_Color_Instance);
+DEFINE_NODUMP_LISP_OBJECT ("color-instance", color_instance,
+			   mark_color_instance, print_color_instance,
+			   finalize_color_instance, color_instance_equal,
+			   color_instance_hash,
+			   color_instance_description,
+			   Lisp_Color_Instance);
 
 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
 Return a new `color-instance' object named NAME (a string).
@@ -177,13 +174,15 @@
 */
        (name, device, noerror))
 {
+  Lisp_Object obj;
   Lisp_Color_Instance *c;
   int retval;
 
   CHECK_STRING (name);
   device = wrap_device (decode_device (device));
 
-  c = ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance);
+  obj = ALLOC_NORMAL_LISP_OBJECT (color_instance);
+  c = XCOLOR_INSTANCE (obj);
   c->name = name;
   c->device = device;
   c->data = 0;
@@ -195,7 +194,7 @@
   if (!retval)
     return Qnil;
 
-  return wrap_color_instance (c);
+  return obj;
 }
 
 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /*
@@ -320,7 +319,7 @@
 {
   Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
   if (print_readably)
-    printing_unreadable_lcrecord (obj, 0);
+    printing_unreadable_lisp_object (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))
@@ -329,17 +328,16 @@
 		     (f, printcharfun, escapeflag));
 
     }
-  write_fmt_string (printcharfun, " 0x%x>", f->header.uid);
+  write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
 }
 
 static void
-finalize_font_instance (void *header, int for_disksave)
+finalize_font_instance (Lisp_Object obj)
 {
-  Lisp_Font_Instance *f = (Lisp_Font_Instance *) header;
+  Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
 
   if (!NILP (f->device))
     {
-      if (for_disksave) finalose (f);
       MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f));
     }
 }
@@ -368,12 +366,11 @@
 			depth + 1);
 }
 
-DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance,
-			       0, /*dumpable-flag*/
-			       mark_font_instance, print_font_instance,
-			       finalize_font_instance, font_instance_equal,
-			       font_instance_hash, font_instance_description,
-			       Lisp_Font_Instance);
+DEFINE_NODUMP_LISP_OBJECT ("font-instance", font_instance,
+			   mark_font_instance, print_font_instance,
+			   finalize_font_instance, font_instance_equal,
+			   font_instance_hash, font_instance_description,
+			   Lisp_Font_Instance);
 
 
 /* #### Why is this exposed to Lisp?  Used in:
@@ -394,6 +391,7 @@
 */
        (name, device, noerror, charset))
 {
+  Lisp_Object obj;
   Lisp_Font_Instance *f;
   int retval = 0;
   Error_Behavior errb = decode_error_behavior_flag (noerror);
@@ -405,7 +403,8 @@
 
   device = wrap_device (decode_device (device));
 
-  f = ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance);
+  obj = ALLOC_NORMAL_LISP_OBJECT (font_instance);
+  f = XFONT_INSTANCE (obj);
   f->name = name;
   f->truename = Qnil;
   f->device = device;
@@ -426,7 +425,7 @@
   if (!retval)
     return Qnil;
 
-  return wrap_font_instance (f);
+  return obj;
 }
 
 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /*
@@ -1212,6 +1211,130 @@
 }
 
 
+/*****************************************************************************
+ Face Background Placement Object
+ ****************************************************************************/
+Lisp_Object Qabsolute, Qrelative;
+
+static const struct memory_description
+face_background_placement_specifier_description[] = {
+  { XD_LISP_OBJECT, offsetof (struct face_background_placement_specifier,
+			      face) },
+  { XD_END }
+};
+
+DEFINE_SPECIFIER_TYPE_WITH_DATA (face_background_placement);
+Lisp_Object Qface_background_placement;
+
+static void
+face_background_placement_create (Lisp_Object obj)
+{
+  Lisp_Specifier *face_background_placement
+    = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
+
+  FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = Qnil;
+}
+
+static void
+face_background_placement_mark (Lisp_Object obj)
+{
+  Lisp_Specifier *face_background_placement
+    = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
+
+  mark_object
+    (FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement));
+}
+
+/* No equal or hash methods; ignore the face the background-placement is based
+   off of for `equal' */
+
+extern Lisp_Object Qbackground_placement;
+
+static Lisp_Object
+face_background_placement_instantiate (Lisp_Object UNUSED (specifier),
+				       Lisp_Object UNUSED (matchspec),
+				       Lisp_Object domain,
+				       Lisp_Object instantiator,
+				       Lisp_Object depth,
+				       int no_fallback)
+{
+  /* When called, we're inside of call_with_suspended_errors(),
+     so we can freely error. */
+  if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative))
+    return instantiator;
+  else if (VECTORP (instantiator))
+    {
+      assert (XVECTOR_LENGTH (instantiator) == 1);
+
+      return FACE_PROPERTY_INSTANCE_1
+	(Fget_face (XVECTOR_DATA (instantiator)[0]),
+	 Qbackground_placement, domain, ERROR_ME, no_fallback, depth);
+    }
+  else
+    ABORT ();	/* Eh? */
+
+  return Qunbound;
+}
+
+static void
+face_background_placement_validate (Lisp_Object instantiator)
+{
+  if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative))
+    return;
+  else if (VECTORP (instantiator) &&
+	   (XVECTOR_LENGTH (instantiator) == 1))
+    {
+      Lisp_Object face = XVECTOR_DATA (instantiator)[0];
+
+      Fget_face (face); /* just to check that the face exists -- dvl */
+    }
+  else if (VECTORP (instantiator))
+    sferror ("Wrong length for background-placement inheritance spec",
+	     instantiator);
+  else
+    invalid_argument
+      ("\
+Background-placement instantiator must be absolute, relative or vector",
+       instantiator);
+}
+
+static void
+face_background_placement_after_change (Lisp_Object specifier,
+					Lisp_Object locale)
+{
+  Lisp_Object face
+    = FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE
+    (XFACE_BACKGROUND_PLACEMENT_SPECIFIER (specifier));
+
+  if (!NILP (face))
+    {
+      face_property_was_changed (face, Qbackground_placement, locale);
+      if (BUFFERP (locale))
+	XBUFFER (locale)->buffer_local_face_property = 1;
+    }
+}
+
+void
+set_face_background_placement_attached_to (Lisp_Object obj, Lisp_Object face)
+{
+  Lisp_Specifier *face_background_placement
+    = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
+
+  FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = face;
+}
+
+DEFUN ("face-background-placement-specifier-p", Fface_background_placement_specifier_p, 1, 1, 0, /*
+Return non-nil if OBJECT is a face-background-placement specifier.
+
+See `make-face-background-placement-specifier' for a description of possible
+face-background-placement instantiators.
+*/
+       (object))
+{
+  return FACE_BACKGROUND_PLACEMENT_SPECIFIERP (object) ? Qt : Qnil;
+}
+
+
 /************************************************************************/
 /*                            initialization                            */
 /************************************************************************/
@@ -1219,12 +1342,13 @@
 void
 syms_of_fontcolor (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (color_instance);
-  INIT_LRECORD_IMPLEMENTATION (font_instance);
+  INIT_LISP_OBJECT (color_instance);
+  INIT_LISP_OBJECT (font_instance);
 
   DEFSUBR (Fcolor_specifier_p);
   DEFSUBR (Ffont_specifier_p);
   DEFSUBR (Fface_boolean_specifier_p);
+  DEFSUBR (Fface_background_placement_specifier_p);
 
   DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep);
   DEFSUBR (Fmake_color_instance);
@@ -1249,6 +1373,10 @@
 
   /* Qcolor, Qfont defined in general.c */
   DEFSYMBOL (Qface_boolean);
+
+  DEFSYMBOL (Qface_background_placement);
+  DEFSYMBOL (Qabsolute);
+  DEFSYMBOL (Qrelative);
 }
 
 void
@@ -1258,26 +1386,35 @@
   INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
   INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean",
 					 "face-boolean-specifier-p");
+  INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_background_placement,
+				       "face-background-placement",
+				       "\
+face-background-placement-specifier-p");
 
   SPECIFIER_HAS_METHOD (color, instantiate);
   SPECIFIER_HAS_METHOD (font, instantiate);
   SPECIFIER_HAS_METHOD (face_boolean, instantiate);
+  SPECIFIER_HAS_METHOD (face_background_placement, instantiate);
 
   SPECIFIER_HAS_METHOD (color, validate);
   SPECIFIER_HAS_METHOD (font, validate);
   SPECIFIER_HAS_METHOD (face_boolean, validate);
+  SPECIFIER_HAS_METHOD (face_background_placement, validate);
 
   SPECIFIER_HAS_METHOD (color, create);
   SPECIFIER_HAS_METHOD (font, create);
   SPECIFIER_HAS_METHOD (face_boolean, create);
+  SPECIFIER_HAS_METHOD (face_background_placement, create);
 
   SPECIFIER_HAS_METHOD (color, mark);
   SPECIFIER_HAS_METHOD (font, mark);
   SPECIFIER_HAS_METHOD (face_boolean, mark);
+  SPECIFIER_HAS_METHOD (face_background_placement, mark);
 
   SPECIFIER_HAS_METHOD (color, after_change);
   SPECIFIER_HAS_METHOD (font, after_change);
   SPECIFIER_HAS_METHOD (face_boolean, after_change);
+  SPECIFIER_HAS_METHOD (face_background_placement, after_change);
 
 #ifdef MULE
   SPECIFIER_HAS_METHOD (font, validate_matchspec);
@@ -1290,26 +1427,26 @@
   REINITIALIZE_SPECIFIER_TYPE (color);
   REINITIALIZE_SPECIFIER_TYPE (font);
   REINITIALIZE_SPECIFIER_TYPE (face_boolean);
+  REINITIALIZE_SPECIFIER_TYPE (face_background_placement);
 }
 
 void
 reinit_vars_of_fontcolor (void)
 {
-  staticpro_nodump (&Vthe_null_color_instance);
   {
-    Lisp_Color_Instance *c =
-      ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance);
+    Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (color_instance);
+    Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
     c->name = Qnil;
     c->device = Qnil;
     c->data = 0;
 
-    Vthe_null_color_instance = wrap_color_instance (c);
+    Vthe_null_color_instance = obj;
+    staticpro_nodump (&Vthe_null_color_instance);
   }
 
-  staticpro_nodump (&Vthe_null_font_instance);
   {
-    Lisp_Font_Instance *f =
-      ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance);
+    Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (font_instance);
+    Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
     f->name = Qnil;
     f->truename = Qnil;
     f->device = Qnil;
@@ -1320,7 +1457,8 @@
     f->width = 0;
     f->proportional_p = 0;
 
-    Vthe_null_font_instance = wrap_font_instance (f);
+    Vthe_null_font_instance = obj;
+    staticpro_nodump (&Vthe_null_font_instance);
   }
 }