changeset 1965:2bdbd6ed2430

(Fadd_text_properties, Fremove_text_properties): Add len>0 as condition for main loop. Abort if reach a null interval. (Fset_text_properties): Abort if reach a null interval. (Ftext_properties_at, Fget_text_property): Return nil if POS is end of OBJECT. (add_properties): Use NILP to test result of Fequal. No longer inline. (remove_properties): No longer inline. (set_properties): Total rewrite as function. (validate_interval_range): Don't alter *begin at end of buffer. But do search for a position just before the end. Return null for an empty string. (validate_interval_range): Allow 0 as position in string. Add 1 to specified string positions. (Fprevious_single_property_change): Subtract 1 if object is string. (Fnext_single_property_change): Likewise. (Fprevious_property_change, Fnext_property_change): Likewise. (remove_properties): Call modify_buffer. (add_properties): Likewise. (Fadd_text_properties): Pass new arg to add_properties. (Fremove_text_properties): Likewise. (add_properties, remove_properties): New arg OBJECT. Record undo info. (Fput_text_property): New function.

--- a/src/textprop.c	Mon Mar 01 08:56:22 1993 +0000
+++ b/src/textprop.c	Mon Mar 01 08:57:31 1993 +0000
@@ -30,7 +30,7 @@
   set_properties needs to deal with the interval property cache.
 
   It is assumed that for any interval plist, a property appears
-  only once on the list.  Although some code i.e., remove_properties (),
+  only once on the list.  Although some code i.e., remove_properties,
   handles the more general case, the uniqueness of properties is
   neccessary for the system to remain consistent.  This requirement
   is enforced by the subrs installing properties onto the intervals. */
@@ -56,6 +56,9 @@
    to by BEGIN and END may be integers or markers; if the latter, they
    are coerced to integers.
 
+   When OBJECT is a string, we increment *BEGIN and *END
+   to make them origin-one.
+
    Note that buffer points don't correspond to interval indices.
    For example, point-max is 1 greater than the index of the last
    character.  This difference is handled in the caller, which uses
@@ -67,7 +70,7 @@
    If FORCE is soft (0), it's OK to return NULL_INTERVAL.  Otherwise,
    create an interval tree for OBJECT if one doesn't exist, provided
    the object actually contains text.  In the current design, if there
-   is no text, there can be no text properties. */
+   is no text, there can be no text properties.  */
 
 #define soft 0
 #define hard 1
@@ -78,6 +81,8 @@
      int force;
 {
   register INTERVAL i;
+  int searchpos;
+
   CHECK_STRING_OR_BUFFER (object, 0);
   CHECK_NUMBER_COERCE_MARKER (*begin, 0);
   CHECK_NUMBER_COERCE_MARKER (*end, 0);
@@ -89,44 +94,60 @@
 
   if (XINT (*begin) > XINT (*end))
     {
-      register int n;
-      n = XFASTINT (*begin);	/* This is legit even if *begin is < 0 */
+      Lisp_Object n;
+      n = *begin;
       *begin = *end;
-      XFASTINT (*end) = n;	/* because this is all we do with n.  */
+      *end = n;
     }
 
   if (XTYPE (object) == Lisp_Buffer)
     {
       register struct buffer *b = XBUFFER (object);
 
-      /* If there's no text, there are no properties. */
-      if (BUF_BEGV (b) == BUF_ZV (b))
-	return NULL_INTERVAL;
-
       if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
 	    && XINT (*end) <= BUF_ZV (b)))
 	args_out_of_range (*begin, *end);
       i = b->intervals;
 
+      /* If there's no text, there are no properties. */
+      if (BUF_BEGV (b) == BUF_ZV (b))
+	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
     {
       register struct Lisp_String *s = XSTRING (object);
 
-      if (! (1 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
+      if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
 	     && XINT (*end) <= s->size))
 	args_out_of_range (*begin, *end);
+      /* User-level Positions in strings start with 0,
+	 but the interval code always wants positions starting with 1.  */
+      XFASTINT (*begin) += 1;
+      XFASTINT (*end) += 1;
       i = s->intervals;
+
+      if (s->size == 0)
+	return NULL_INTERVAL;
+
+      searchpos = XINT (*begin);
+      if (searchpos > s->size)
+	searchpos--;
     }
 
   if (NULL_INTERVAL_P (i))
     return (force ? create_root_interval (object) : i);
     
-  return find_interval (i, XINT (*begin));
+  return find_interval (i, searchpos);
 }
 
 /* Validate LIST as a property list.  If LIST is not a list, then
@@ -153,8 +174,6 @@
   return Fcons (list, Fcons (Qnil, Qnil));
 }
 
-#define set_properties(list,i) (i->plist = Fcopy_sequence (list))
-
 /* Return nonzero if interval I has all the properties,
    with the same values, of list PLIST. */
 
@@ -217,18 +236,49 @@
 
   return 0;
 }
+
+/* Set the properties of INTERVAL to PROPERTIES,
+   and record undo info for the previous values.
+   OBJECT is the string or buffer that INTERVAL belongs to.  */
+
+static void
+set_properties (properties, interval, object)
+     Lisp_Object properties, object;
+     INTERVAL interval;
+{
+  Lisp_Object oldprops;
+  oldprops = interval->plist;
+
+  /* Record undo for old properties.  */
+  while (XTYPE (oldprops) == Lisp_Cons)
+    {
+      Lisp_Object sym;
+      sym = Fcar (oldprops);
+      record_property_change (interval->position, LENGTH (interval),
+			      sym, Fcar_safe (Fcdr (oldprops)),
+			      object);
+      
+      oldprops = Fcdr_safe (Fcdr (oldprops));
+    }
+
+  /* Store new properties.  */
+  interval->plist = Fcopy_sequence (properties);
+}
 
 /* Add the properties of PLIST to the interval I, or set
    the value of I's property to the value of the property on PLIST
    if they are different.
 
+   OBJECT should be the string or buffer the interval is in.
+
    Return nonzero if this changes I (i.e., if any members of PLIST
    are actually added to I's plist) */
 
-static INLINE int
-add_properties (plist, i)
+static int
+add_properties (plist, i, object)
      Lisp_Object plist;
      INTERVAL i;
+     Lisp_Object object;
 {
   register Lisp_Object tail1, tail2, sym1, val1;
   register int changed = 0;
@@ -252,9 +302,18 @@
 
 	    /* The properties have the same value on both lists.
 	       Continue to the next property. */
-	    if (Fequal (val1, Fcar (this_cdr)))
+	    if (!NILP (Fequal (val1, Fcar (this_cdr))))
 	      break;
 
+	    /* Record this change in the buffer, for undo purposes.  */
+	    if (XTYPE (object) == Lisp_Buffer)
+	      {
+		record_property_change (i->position, LENGTH (i),
+					sym1, Fcar (this_cdr), object);
+		modify_region (make_number (i->position),
+			       make_number (i->position + LENGTH (i)));
+	      }
+
 	    /* I's property has a different value -- change it */
 	    Fsetcar (this_cdr, val1);
 	    changed++;
@@ -263,6 +322,14 @@
 
       if (! found)
 	{
+	  /* Record this change in the buffer, for undo purposes.  */
+	  if (XTYPE (object) == Lisp_Buffer)
+	    {
+	      record_property_change (i->position, LENGTH (i),
+				      sym1, Qnil, object);
+	      modify_region (make_number (i->position),
+			     make_number (i->position + LENGTH (i)));
+	    }
 	  i->plist = Fcons (sym1, Fcons (val1, i->plist));
 	  changed++;
 	}
@@ -272,12 +339,14 @@
 }
 
 /* For any members of PLIST which are properties of I, remove them
-   from I's plist. */
+   from I's plist.
+   OBJECT is the string or buffer containing I.  */
 
-static INLINE int
-remove_properties (plist, i)
+static int
+remove_properties (plist, i, object)
      Lisp_Object plist;
      INTERVAL i;
+     Lisp_Object object;
 {
   register Lisp_Object tail1, tail2, sym;
   register Lisp_Object current_plist = i->plist;
@@ -291,6 +360,15 @@
       /* First, remove the symbol if its at the head of the list */
       while (! NILP (current_plist) && EQ (sym, Fcar (current_plist)))
 	{
+	  if (XTYPE (object) == Lisp_Buffer)
+	    {
+	      record_property_change (i->position, LENGTH (i),
+				      sym, Fcar (Fcdr (current_plist)),
+				      object);
+	      modify_region (make_number (i->position),
+			     make_number (i->position + LENGTH (i)));
+	    }
+
 	  current_plist = Fcdr (Fcdr (current_plist));
 	  changed++;
 	}
@@ -302,6 +380,14 @@
 	  register Lisp_Object this = Fcdr (Fcdr (tail2));
 	  if (EQ (sym, Fcar (this)))
 	    {
+	      if (XTYPE (object) == Lisp_Buffer)
+		{
+		  record_property_change (i->position, LENGTH (i),
+					  sym, Fcar (Fcdr (this)), object);
+		  modify_region (make_number (i->position),
+				 make_number (i->position + LENGTH (i)));
+		}
+
 	      Fsetcdr (Fcdr (tail2), Fcdr (Fcdr (this)));
 	      changed++;
 	    }
@@ -314,6 +400,7 @@
   return changed;
 }
 
+#if 0
 /* Remove all properties from interval I.  Return non-zero
    if this changes the interval. */
 
@@ -327,12 +414,14 @@
   i->plist = Qnil;
   return 1;
 }
+#endif
 
 DEFUN ("text-properties-at", Ftext_properties_at,
        Stext_properties_at, 1, 2, 0,
   "Return the list of properties held by the character at POSITION\n\
 in optional argument OBJECT, a string or buffer.  If nil, OBJECT\n\
-defaults to the current buffer.")
+defaults to the current buffer.\n\
+If POSITION is at the end of OBJECT, the value is nil.")
   (pos, object)
      Lisp_Object pos, object;
 {
@@ -344,13 +433,20 @@
   i = validate_interval_range (object, &pos, &pos, soft);
   if (NULL_INTERVAL_P (i))
     return Qnil;
+  /* If POS is at the end of the interval,
+     it means it's the end of OBJECT.
+     There are no properties at the very end,
+     since no character follows.  */
+  if (XINT (pos) == LENGTH (i) + i->position)
+    return Qnil;
 
   return i->plist;
 }
 
 DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
   "Return the value of position POS's property PROP, in OBJECT.\n\
-OBJECT is optional and defaults to the current buffer.")
+OBJECT is optional and defaults to the current buffer.\n\
+If POSITION is at the end of OBJECT, the value is nil.")
   (pos, prop, object)
      Lisp_Object pos, object;
      register Lisp_Object prop;
@@ -360,11 +456,17 @@
 
   if (NILP (object))
     XSET (object, Lisp_Buffer, current_buffer);
-
   i = validate_interval_range (object, &pos, &pos, soft);
   if (NULL_INTERVAL_P (i))
     return Qnil;
 
+  /* If POS is at the end of the interval,
+     it means it's the end of OBJECT.
+     There are no properties at the very end,
+     since no character follows.  */
+  if (XINT (pos) == LENGTH (i) + i->position)
+    return Qnil;
+
   for (tail = i->plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
     {
       register Lisp_Object tem;
@@ -402,7 +504,8 @@
   if (NULL_INTERVAL_P (next))
     return Qnil;
 
-  return next->position;
+  return next->position - (XTYPE (object) == Lisp_String);
+;
 }
 
 DEFUN ("next-single-property-change", Fnext_single_property_change,
@@ -434,7 +537,7 @@
   if (NULL_INTERVAL_P (next))
     return Qnil;
 
-  return next->position;
+  return next->position - (XTYPE (object) == Lisp_String);
 }
 
 DEFUN ("previous-property-change", Fprevious_property_change,
@@ -463,7 +566,8 @@
   if (NULL_INTERVAL_P (previous))
     return Qnil;
 
-  return previous->position + LENGTH (previous) - 1;
+  return (previous->position + LENGTH (previous) - 1
+	  - (XTYPE (object) == Lisp_String));
 }
 
 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
@@ -495,7 +599,8 @@
   if (NULL_INTERVAL_P (previous))
     return Qnil;
 
-  return previous->position + LENGTH (previous) - 1;
+  return (previous->position + LENGTH (previous) - 1
+	  - (XTYPE (object) == Lisp_String));
 }
 
 DEFUN ("add-text-properties", Fadd_text_properties,
@@ -548,11 +653,11 @@
 	    {
 	      i = split_interval_left (i, len + 1);
 	      copy_properties (unchanged, i);
-	      add_properties (properties, i);
+	      add_properties (properties, i, object);
 	      return Qt;
 	    }
 
-	  add_properties (properties, i);
+	  add_properties (properties, i, object);
 	  modified = 1;
 	  len -= LENGTH (i);
 	  i = next_interval (i);
@@ -560,8 +665,11 @@
     }
 
   /* We are at the beginning of an interval, with len to scan */
-  while (1)
+  while (len > 0)
     {
+      if (i == 0)
+	abort ();
+
       if (LENGTH (i) >= len)
 	{
 	  if (interval_has_all_properties (properties, i))
@@ -569,7 +677,7 @@
 
 	  if (LENGTH (i) == len)
 	    {
-	      add_properties (properties, i);
+	      add_properties (properties, i, object);
 	      return Qt;
 	    }
 
@@ -577,16 +685,32 @@
 	  unchanged = i;
 	  i = split_interval_left (unchanged, len + 1);
 	  copy_properties (unchanged, i);
-	  add_properties (properties, i);
+	  add_properties (properties, i, object);
 	  return Qt;
 	}
 
       len -= LENGTH (i);
-      modified += add_properties (properties, i);
+      modified += add_properties (properties, i, object);
       i = next_interval (i);
     }
 }
 
+DEFUN ("put-text-property", Fput_text_property,
+       Sput_text_property, 4, 5, 0,
+  "Set one property of the text from START to END.\n\
+The third and fourth arguments PROP and VALUE\n\
+specify the property to add.\n\
+The optional fifth argument, OBJECT,\n\
+is the string or buffer containing the text.")
+  (start, end, prop, value, object)
+     Lisp_Object start, end, prop, value, object;
+{
+  Fadd_text_properties (start, end,
+			Fcons (prop, Fcons (value, Qnil)),
+			object);
+  return Qnil;
+}
+
 DEFUN ("set-text-properties", Fset_text_properties,
        Sset_text_properties, 3, 4, 0,
   "Completely replace properties of text from START to END.\n\
@@ -618,7 +742,7 @@
     {
       unchanged = i;
       i = split_interval_right (unchanged, s - unchanged->position + 1);
-      set_properties (props, i);
+      set_properties (props, i, object);
 
       if (LENGTH (i) > len)
 	{
@@ -638,13 +762,16 @@
   /* We are starting at the beginning of an interval, I */
   while (len > 0)
     {
+      if (i == 0)
+	abort ();
+
       if (LENGTH (i) >= len)
 	{
 	  if (LENGTH (i) > len)
 	    i = split_interval_left (i, len + 1);
 
 	  if (NULL_INTERVAL_P (prev_changed))
-	    set_properties (props, i);
+	    set_properties (props, i, object);
 	  else
 	    merge_interval_left (i);
 	  return Qt;
@@ -653,7 +780,7 @@
       len -= LENGTH (i);
       if (NULL_INTERVAL_P (prev_changed))
 	{
-	  set_properties (props, i);
+	  set_properties (props, i, object);
 	  prev_changed = i;
 	}
       else
@@ -712,11 +839,11 @@
 	    {
 	      i = split_interval_left (i, len + 1);
 	      copy_properties (unchanged, i);
-	      remove_properties (props, i);
+	      remove_properties (props, i, object);
 	      return Qt;
 	    }
 
-	  remove_properties (props, i);
+	  remove_properties (props, i, object);
 	  modified = 1;
 	  len -= LENGTH (i);
 	  i = next_interval (i);
@@ -724,8 +851,11 @@
     }
 
   /* We are at the beginning of an interval, with len to scan */
-  while (1)
+  while (len > 0)
     {
+      if (i == 0)
+	abort ();
+
       if (LENGTH (i) >= len)
 	{
 	  if (! interval_has_some_properties (props, i))
@@ -733,19 +863,19 @@
 
 	  if (LENGTH (i) == len)
 	    {
-	      remove_properties (props, i);
+	      remove_properties (props, i, object);
 	      return Qt;
 	    }
 
 	  /* i has the properties, and goes past the change limit */
 	  unchanged = split_interval_right (i, len + 1);
 	  copy_properties (unchanged, i);
-	  remove_properties (props, i);
+	  remove_properties (props, i, object);
 	  return Qt;
 	}
 
       len -= LENGTH (i);
-      modified += remove_properties (props, i);
+      modified += remove_properties (props, i, object);
       i = next_interval (i);
     }
 }
@@ -903,6 +1033,7 @@
   defsubr (&Sprevious_property_change);
   defsubr (&Sprevious_single_property_change);
   defsubr (&Sadd_text_properties);
+  defsubr (&Sput_text_property);
   defsubr (&Sset_text_properties);
   defsubr (&Sremove_text_properties);
 /*  defsubr (&Serase_text_properties); */