# HG changeset patch # User Richard M. Stallman # Date 730976251 0 # Node ID 2bdbd6ed24307e21d5dbc6c4d2608af2da752698 # Parent e6c49ff3a53caaa1e5d9586d8d724a722abcf54e (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. diff -r e6c49ff3a53c -r 2bdbd6ed2430 src/textprop.c --- 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); */