1 files changed, 97 insertions, 10 deletions

diff --git a/src/textprop.c b/src/textprop.c
index 3c62f0ad230..13d2b4edd9a 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -122,14 +122,6 @@ validate_interval_range (object, begin, end, force)
         return NULL_INTERVAL;
 
       searchpos = XINT (*begin);
-      if (searchpos == BUF_Z (b))
-        searchpos--;
-#if 0
-      /* Special case for point-max:  return the interval for the
-         last character. */
-      if (*begin == *end && *begin == BUF_Z (b))
-        *begin -= 1;
-#endif
     }
   else
     {
@@ -149,8 +141,6 @@ validate_interval_range (object, begin, end, force)
         return NULL_INTERVAL;
 
       searchpos = XINT (*begin);
-      if (searchpos > s->size)
-        searchpos--;
     }
 
   if (NULL_INTERVAL_P (i))
@@ -1005,6 +995,102 @@ is the string or buffer containing the text.")
 }
 #endif /* 0 */
 
+/* I don't think this is the right interface to export; how often do you
+   want to do something like this, other than when you're copying objects
+   around?
+
+   I think it would be better to have a pair of functions, one which
+   returns the text properties of a region as a list of ranges and
+   plists, and another which applies such a list to another object.  */
+
+/* DEFUN ("copy-text-properties", Fcopy_text_properties,
+       Scopy_text_properties, 5, 6, 0,
+  "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
+SRC and DEST may each refer to strings or buffers.\n\
+Optional sixth argument PROP causes only that property to be copied.\n\
+Properties are copied to DEST as if by `add-text-properties'.\n\
+Return t if any property value actually changed, nil otherwise.") */
+
+Lisp_Object
+copy_text_properties (start, end, src, pos, dest, prop)
+       Lisp_Object start, end, src, pos, dest, prop;
+{
+  INTERVAL i;
+  Lisp_Object res;
+  Lisp_Object stuff;
+  Lisp_Object plist;
+  int s, e, e2, p, len, modified = 0;
+
+  i = validate_interval_range (src, &start, &end, soft);
+  if (NULL_INTERVAL_P (i))
+    return Qnil;
+
+  CHECK_NUMBER_COERCE_MARKER (pos, 0);
+  {
+    Lisp_Object dest_start, dest_end;
+
+    dest_start = pos;
+    XFASTINT (dest_end) = XINT (dest_start) + (XINT (end) - XINT (start));
+    /* Apply this to a copy of pos; it will try to increment its arguments,
+       which we don't want.  */
+    validate_interval_range (dest, &dest_start, &dest_end, soft);
+  }
+
+  s = XINT (start);
+  e = XINT (end);
+  p = XINT (pos);
+
+  stuff = Qnil;
+
+  while (s < e)
+    {
+      e2 = i->position + LENGTH (i);
+      if (e2 > e)
+        e2 = e;
+      len = e2 - s;
+
+      plist = i->plist;
+      if (! NILP (prop))
+        while (! NILP (plist))
+          {
+            if (EQ (Fcar (plist), prop))
+              {
+                plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
+                break;
+              }
+            plist = Fcdr (Fcdr (plist));
+          }
+      if (! NILP (plist))
+        {
+          /* Must defer modifications to the interval tree in case src
+             and dest refer to the same string or buffer. */
+          stuff = Fcons (Fcons (make_number (p),
+                                Fcons (make_number (p + len),
+                                       Fcons (plist, Qnil))),
+                        stuff);
+        }
+
+      i = next_interval (i);
+      if (NULL_INTERVAL_P (i))
+        break;
+
+      p += len;
+      s = i->position;
+    }
+
+  while (! NILP (stuff))
+    {
+      res = Fcar (stuff);
+      res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
+                                  Fcar (Fcdr (Fcdr (res))), dest);
+      if (! NILP (res))
+        modified++;
+      stuff = Fcdr (stuff);
+    }
+
+  return modified ? Qt : Qnil;
+}
+
 void
 syms_of_textprop ()
 {
@@ -1058,6 +1144,7 @@ percentage by which the left interval tree should not differ from the right.");
   defsubr (&Sset_text_properties);
   defsubr (&Sremove_text_properties);
 /*  defsubr (&Serase_text_properties); */
+/*  defsubr (&Scopy_text_properties); */
 }
 
 #else