changeset 4007:55da23f04d01

* textprop.c (copy_text_properties): Pass a copy of POS to validate_interval_range; that function increments its arguments, which isn't what we want. * intervals.c (find_interval): Consistently treat POSITION as an actual buffer position, i.e. origin 1. The old code seemed undecided on this point. Treat the end of the buffer as being part of the rightmost interval. (adjust_intervals_for_insertion): Consistently treat POSITION as origin 1. (interval_deletion_adjustment): The exception: FROM should be origin zero here. Consistently treat it as such. Simplify code which shrinks and possibly deletes intervals. (adjust_intervals_for_deletion): Treat start as origin 1; our caller does. (set_point): Use buffer positions throughout, not a mix of buffer posns and origin zero posns. (get_local_map): Remove special case for POSITION at end of buffer; find_interval handles that case correctly. (verify_interval_modification): Remove special case for START at end of buffer. * textprop.c (validate_interval_range): End-of-buffer/string positions no longer need special handling. * textprop.c (copy_text_properties): New function, from David Gillespie. * intervals.h: Declare copy_text_properties. * fns.c: #include "intervals.h". (Fsubstring): Copy text properties to result string. (concat): Copy text properties to result string. * ymakefile (fns.o): Note that this depends on INTERVAL_SRC.

--- a/src/textprop.c	Tue Jul 06 14:54:28 1993 +0000
+++ b/src/textprop.c	Tue Jul 06 14:55:20 1993 +0000
@@ -122,14 +122,6 @@
 	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 @@
 	return NULL_INTERVAL;
 
       searchpos = XINT (*begin);
-      if (searchpos > s->size)
-	searchpos--;
     }
 
   if (NULL_INTERVAL_P (i))
@@ -1005,6 +995,102 @@
 }
 #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 @@
   defsubr (&Sset_text_properties);
   defsubr (&Sremove_text_properties);
 /*  defsubr (&Serase_text_properties); */
+/*  defsubr (&Scopy_text_properties); */
 }
 
 #else