Commit 5fbe2a44 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(Fadd_text_properties): Put OBJECT arg last. Make it optional.

(Fset_text_properties, Fremove_text_properties): Likewise.
(Fnext_single_property_change, Fprevious_single_property_change):
(Fnext_property_change, Fprevious_property_change): Likewise.
(Ferase_text_properties): #if 0.
(Fget_text_property): New function.
parent dcb70223
...@@ -337,7 +337,6 @@ defaults to the current buffer.") ...@@ -337,7 +337,6 @@ defaults to the current buffer.")
Lisp_Object pos, object; Lisp_Object pos, object;
{ {
register INTERVAL i; register INTERVAL i;
register int p;
if (NILP (object)) if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer); XSET (object, Lisp_Buffer, current_buffer);
...@@ -349,16 +348,49 @@ defaults to the current buffer.") ...@@ -349,16 +348,49 @@ defaults to the current buffer.")
return i->plist; 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.
OBJECT is optional and defaults to the current buffer.")
(pos, prop, object)
Lisp_Object sym, object;
register Lisp_Object prop;
{
register INTERVAL i;
register Lisp_Object tail;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &pos, &pos, soft);
if (NULL_INTERVAL_P (i))
return Qnil;
for (tail = i->plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
{
register Lisp_Object tem;
tem = Fcar (tail);
if (EQ (prop, tem))
return Fcar (Fcdr (tail));
}
return Qnil;
}
DEFUN ("next-property-change", Fnext_property_change, DEFUN ("next-property-change", Fnext_property_change,
Snext_property_change, 2, 2, 0, Snext_property_change, 1, 2, 0,
"Return the position after POSITION in OBJECT which has properties\n\ "Return the position of next property change.\n\
different from those at POSITION. OBJECT may be a string or buffer.\n\ Scans characters forward from POS in OBJECT till it finds\n\
Returns nil if unsuccessful.") a change in some text property, then returns the position of the change.\n\
The optional second argument OBJECT is the string or buffer to scan.\n\
Return nil if the property is constant all the way to the end of OBJECT.\n\
If the value is non-nil, it is a position greater than POS, never equal.")
(pos, object) (pos, object)
Lisp_Object pos, object; Lisp_Object pos, object;
{ {
register INTERVAL i, next; register INTERVAL i, next;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &pos, &pos, soft); i = validate_interval_range (object, &pos, &pos, soft);
if (NULL_INTERVAL_P (i)) if (NULL_INTERVAL_P (i))
return Qnil; return Qnil;
...@@ -374,15 +406,22 @@ Returns nil if unsuccessful.") ...@@ -374,15 +406,22 @@ Returns nil if unsuccessful.")
} }
DEFUN ("next-single-property-change", Fnext_single_property_change, DEFUN ("next-single-property-change", Fnext_single_property_change,
Snext_single_property_change, 3, 3, 0, Snext_single_property_change, 1, 3, 0,
"Return the position after POSITION in OBJECT which has a different\n\ "Return the position of next property change for a specific property.\n\
value for PROPERTY than the text at POSITION. OBJECT may be a string or\n\ Scans characters forward from POS till it finds\n\
buffer. Returns nil if unsuccessful.") a change in the PROP property, then returns the position of the change.\n\
(pos, object, prop) The optional third argument OBJECT is the string or buffer to scan.\n\
Return nil if the property is constant all the way to the end of OBJECT.\n\
If the value is non-nil, it is a position greater than POS, never equal.")
(pos, prop, object)
Lisp_Object pos, prop, object;
{ {
register INTERVAL i, next; register INTERVAL i, next;
register Lisp_Object here_val; register Lisp_Object here_val;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &pos, &pos, soft); i = validate_interval_range (object, &pos, &pos, soft);
if (NULL_INTERVAL_P (i)) if (NULL_INTERVAL_P (i))
return Qnil; return Qnil;
...@@ -399,15 +438,21 @@ buffer. Returns nil if unsuccessful.") ...@@ -399,15 +438,21 @@ buffer. Returns nil if unsuccessful.")
} }
DEFUN ("previous-property-change", Fprevious_property_change, DEFUN ("previous-property-change", Fprevious_property_change,
Sprevious_property_change, 2, 2, 0, Sprevious_property_change, 1, 2, 0,
"Return the position preceding POSITION in OBJECT which has properties\n\ "Return the position of previous property change.\n\
different from those at POSITION. OBJECT may be a string or buffer.\n\ Scans characters backwards from POS in OBJECT till it finds\n\
Returns nil if unsuccessful.") a change in some text property, then returns the position of the change.\n\
The optional second argument OBJECT is the string or buffer to scan.\n\
Return nil if the property is constant all the way to the start of OBJECT.\n\
If the value is non-nil, it is a position less than POS, never equal.")
(pos, object) (pos, object)
Lisp_Object pos, object; Lisp_Object pos, object;
{ {
register INTERVAL i, previous; register INTERVAL i, previous;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &pos, &pos, soft); i = validate_interval_range (object, &pos, &pos, soft);
if (NULL_INTERVAL_P (i)) if (NULL_INTERVAL_P (i))
return Qnil; return Qnil;
...@@ -422,15 +467,22 @@ Returns nil if unsuccessful.") ...@@ -422,15 +467,22 @@ Returns nil if unsuccessful.")
} }
DEFUN ("previous-single-property-change", Fprevious_single_property_change, DEFUN ("previous-single-property-change", Fprevious_single_property_change,
Sprevious_single_property_change, 3, 3, 0, Sprevious_single_property_change, 2, 3, 0,
"Return the position preceding POSITION in OBJECT which has a\n\ "Return the position of previous property change for a specific property.\n\
different value for PROPERTY than the text at POSITION. OBJECT may be\n\ Scans characters backward from POS till it finds\n\
a string or buffer. Returns nil if unsuccessful.") a change in the PROP property, then returns the position of the change.\n\
(pos, object, prop) The optional third argument OBJECT is the string or buffer to scan.\n\
Return nil if the property is constant all the way to the start of OBJECT.\n\
If the value is non-nil, it is a position less than POS, never equal.")
(pos, prop, object)
Lisp_Object pos, prop, object;
{ {
register INTERVAL i, previous; register INTERVAL i, previous;
register Lisp_Object here_val; register Lisp_Object here_val;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &pos, &pos, soft); i = validate_interval_range (object, &pos, &pos, soft);
if (NULL_INTERVAL_P (i)) if (NULL_INTERVAL_P (i))
return Qnil; return Qnil;
...@@ -447,12 +499,15 @@ a string or buffer. Returns nil if unsuccessful.") ...@@ -447,12 +499,15 @@ a string or buffer. Returns nil if unsuccessful.")
} }
DEFUN ("add-text-properties", Fadd_text_properties, DEFUN ("add-text-properties", Fadd_text_properties,
Sadd_text_properties, 4, 4, 0, Sadd_text_properties, 3, 4, 0,
"Add the PROPERTIES, a property list, to the text of OBJECT,\n\ "Add properties to the text from START to END.\n\
a string or buffer, in the range START to END. Returns t if any change\n\ The third argument PROPS is a property list\n\
was made, nil otherwise.") specifying the property values to add.\n\
(object, start, end, properties) The optional fourth argument, OBJECT,\n\
Lisp_Object object, start, end, properties; is the string or buffer containing the text.\n\
Return t if any property value actually changed, nil otherwise.")
(start, end, properties, object)
Lisp_Object start, end, properties, object;
{ {
register INTERVAL i, unchanged; register INTERVAL i, unchanged;
register int s, len, modified; register int s, len, modified;
...@@ -461,6 +516,9 @@ was made, nil otherwise.") ...@@ -461,6 +516,9 @@ was made, nil otherwise.")
if (NILP (properties)) if (NILP (properties))
return Qnil; return Qnil;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &start, &end, hard); i = validate_interval_range (object, &start, &end, hard);
if (NULL_INTERVAL_P (i)) if (NULL_INTERVAL_P (i))
return Qnil; return Qnil;
...@@ -530,23 +588,25 @@ was made, nil otherwise.") ...@@ -530,23 +588,25 @@ was made, nil otherwise.")
} }
DEFUN ("set-text-properties", Fset_text_properties, DEFUN ("set-text-properties", Fset_text_properties,
Sset_text_properties, 4, 4, 0, Sset_text_properties, 3, 4, 0,
"Make the text of OBJECT, a string or buffer, have precisely\n\ "Completely replace properties of text from START to END.\n\
PROPERTIES, a list of properties, in the range START to END.\n\ The third argument PROPS is the new property list.\n\
\n\ The optional fourth argument, OBJECT,\n\
If called with a valid property list, return t (text was changed).\n\ is the string or buffer containing the text.")
Otherwise return nil.") (start, end, props, object)
(object, start, end, properties) Lisp_Object start, end, props, object;
Lisp_Object object, start, end, properties;
{ {
register INTERVAL i, unchanged; register INTERVAL i, unchanged;
register INTERVAL prev_changed = NULL_INTERVAL; register INTERVAL prev_changed = NULL_INTERVAL;
register int s, len; register int s, len;
properties = validate_plist (properties); props = validate_plist (props);
if (NILP (properties)) if (NILP (props))
return Qnil; return Qnil;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &start, &end, hard); i = validate_interval_range (object, &start, &end, hard);
if (NULL_INTERVAL_P (i)) if (NULL_INTERVAL_P (i))
return Qnil; return Qnil;
...@@ -558,7 +618,7 @@ Otherwise return nil.") ...@@ -558,7 +618,7 @@ Otherwise return nil.")
{ {
unchanged = i; unchanged = i;
i = split_interval_right (unchanged, s - unchanged->position + 1); i = split_interval_right (unchanged, s - unchanged->position + 1);
set_properties (properties, i); set_properties (props, i);
if (LENGTH (i) > len) if (LENGTH (i) > len)
{ {
...@@ -584,7 +644,7 @@ Otherwise return nil.") ...@@ -584,7 +644,7 @@ Otherwise return nil.")
i = split_interval_left (i, len + 1); i = split_interval_left (i, len + 1);
if (NULL_INTERVAL_P (prev_changed)) if (NULL_INTERVAL_P (prev_changed))
set_properties (properties, i); set_properties (props, i);
else else
merge_interval_left (i); merge_interval_left (i);
return Qt; return Qt;
...@@ -593,7 +653,7 @@ Otherwise return nil.") ...@@ -593,7 +653,7 @@ Otherwise return nil.")
len -= LENGTH (i); len -= LENGTH (i);
if (NULL_INTERVAL_P (prev_changed)) if (NULL_INTERVAL_P (prev_changed))
{ {
set_properties (properties, i); set_properties (props, i);
prev_changed = i; prev_changed = i;
} }
else else
...@@ -606,16 +666,23 @@ Otherwise return nil.") ...@@ -606,16 +666,23 @@ Otherwise return nil.")
} }
DEFUN ("remove-text-properties", Fremove_text_properties, DEFUN ("remove-text-properties", Fremove_text_properties,
Sremove_text_properties, 4, 4, 0, Sremove_text_properties, 3, 4, 0,
"Remove the PROPERTIES, a property list, from the text of OBJECT,\n\ "Remove some properties from text from START to END.\n\
a string or buffer, in the range START to END. Returns t if any change\n\ The third argument PROPS is a property list\n\
was made, nil otherwise.") whose property names specify the properties to remove.\n\
(object, start, end, properties) \(The values stored in PROPS are ignored.)\n\
Lisp_Object object, start, end, properties; The optional fourth argument, OBJECT,\n\
is the string or buffer containing the text.\n\
Return t if any property was actually removed, nil otherwise.")
(start, end, props, object)
Lisp_Object start, end, props, object;
{ {
register INTERVAL i, unchanged; register INTERVAL i, unchanged;
register int s, len, modified; register int s, len, modified;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &start, &end, soft); i = validate_interval_range (object, &start, &end, soft);
if (NULL_INTERVAL_P (i)) if (NULL_INTERVAL_P (i))
return Qnil; return Qnil;
...@@ -627,7 +694,7 @@ was made, nil otherwise.") ...@@ -627,7 +694,7 @@ was made, nil otherwise.")
{ {
/* No properties on this first interval -- return if /* No properties on this first interval -- return if
it covers the entire region. */ it covers the entire region. */
if (! interval_has_some_properties (properties, i)) if (! interval_has_some_properties (props, i))
{ {
int got = (LENGTH (i) - (s - i->position)); int got = (LENGTH (i) - (s - i->position));
if (got >= len) if (got >= len)
...@@ -645,11 +712,11 @@ was made, nil otherwise.") ...@@ -645,11 +712,11 @@ was made, nil otherwise.")
{ {
i = split_interval_left (i, len + 1); i = split_interval_left (i, len + 1);
copy_properties (unchanged, i); copy_properties (unchanged, i);
remove_properties (properties, i); remove_properties (props, i);
return Qt; return Qt;
} }
remove_properties (properties, i); remove_properties (props, i);
modified = 1; modified = 1;
len -= LENGTH (i); len -= LENGTH (i);
i = next_interval (i); i = next_interval (i);
...@@ -661,39 +728,45 @@ was made, nil otherwise.") ...@@ -661,39 +728,45 @@ was made, nil otherwise.")
{ {
if (LENGTH (i) >= len) if (LENGTH (i) >= len)
{ {
if (! interval_has_some_properties (properties, i)) if (! interval_has_some_properties (props, i))
return modified ? Qt : Qnil; return modified ? Qt : Qnil;
if (LENGTH (i) == len) if (LENGTH (i) == len)
{ {
remove_properties (properties, i); remove_properties (props, i);
return Qt; return Qt;
} }
/* i has the properties, and goes past the change limit */ /* i has the properties, and goes past the change limit */
unchanged = split_interval_right (i, len + 1); unchanged = split_interval_right (i, len + 1);
copy_properties (unchanged, i); copy_properties (unchanged, i);
remove_properties (properties, i); remove_properties (props, i);
return Qt; return Qt;
} }
len -= LENGTH (i); len -= LENGTH (i);
modified += remove_properties (properties, i); modified += remove_properties (props, i);
i = next_interval (i); i = next_interval (i);
} }
} }
#if 0 /* You can use set-text-properties for this. */
DEFUN ("erase-text-properties", Ferase_text_properties, DEFUN ("erase-text-properties", Ferase_text_properties,
Serase_text_properties, 3, 3, 0, Serase_text_properties, 2, 3, 0,
"Remove all text properties from OBJECT (a string or buffer), in the\n\ "Remove all properties from the text from START to END.\n\
range START to END. Returns t if any change was made, nil otherwise.") The optional third argument, OBJECT,\n\
(object, start, end) is the string or buffer containing the text.")
Lisp_Object object, start, end; (start, end, object)
Lisp_Object start, end, object;
{ {
register INTERVAL i; register INTERVAL i;
register INTERVAL prev_changed = NULL_INTERVAL; register INTERVAL prev_changed = NULL_INTERVAL;
register int s, len, modified; register int s, len, modified;
if (NILP (object))
XSET (object, Lisp_Buffer, current_buffer);
i = validate_interval_range (object, &start, &end, soft); i = validate_interval_range (object, &start, &end, soft);
if (NULL_INTERVAL_P (i)) if (NULL_INTERVAL_P (i))
return Qnil; return Qnil;
...@@ -783,6 +856,7 @@ range START to END. Returns t if any change was made, nil otherwise.") ...@@ -783,6 +856,7 @@ range START to END. Returns t if any change was made, nil otherwise.")
return modified ? Qt : Qnil; return modified ? Qt : Qnil;
} }
#endif /* 0 */
void void
syms_of_textprop () syms_of_textprop ()
...@@ -823,6 +897,7 @@ percentage by which the left interval tree should not differ from the right."); ...@@ -823,6 +897,7 @@ percentage by which the left interval tree should not differ from the right.");
Qmodification = intern ("modification"); Qmodification = intern ("modification");
defsubr (&Stext_properties_at); defsubr (&Stext_properties_at);
defsubr (&Sget_text_property);
defsubr (&Snext_property_change); defsubr (&Snext_property_change);
defsubr (&Snext_single_property_change); defsubr (&Snext_single_property_change);
defsubr (&Sprevious_property_change); defsubr (&Sprevious_property_change);
...@@ -830,7 +905,7 @@ percentage by which the left interval tree should not differ from the right."); ...@@ -830,7 +905,7 @@ percentage by which the left interval tree should not differ from the right.");
defsubr (&Sadd_text_properties); defsubr (&Sadd_text_properties);
defsubr (&Sset_text_properties); defsubr (&Sset_text_properties);
defsubr (&Sremove_text_properties); defsubr (&Sremove_text_properties);
defsubr (&Serase_text_properties); /* defsubr (&Serase_text_properties); */
} }
#else #else
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment