static Lisp_Object Qread_only;
Lisp_Object Qminibuffer_prompt;
+enum property_set_type
+{
+ TEXT_PROPERTY_REPLACE,
+ TEXT_PROPERTY_PREPEND,
+ TEXT_PROPERTY_APPEND
+};
+
/* Sticky properties. */
Lisp_Object Qfront_sticky, Qrear_nonsticky;
xsignal0 (Qtext_read_only);
}
-/* Prepare to modify the region of BUFFER from START to END. */
+/* Prepare to modify the text properties of BUFFER from START to END. */
static void
-modify_region (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
+modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end)
{
+ ptrdiff_t b = XINT (start), e = XINT (end);
struct buffer *buf = XBUFFER (buffer), *old = current_buffer;
set_buffer_internal (buf);
- modify_region_1 (XINT (start), XINT (end), true);
+
+ prepare_to_modify_buffer_1 (b, e, NULL);
+
+ BUF_COMPUTE_UNCHANGED (buf, b - 1, e);
+ if (MODIFF <= SAVE_MODIFF)
+ record_first_change ();
+ MODIFF++;
+
+ bset_point_before_scroll (current_buffer, Qnil);
+
set_buffer_internal (old);
}
+/* Complain if object is not string or buffer type. */
+
+static void
+CHECK_STRING_OR_BUFFER (Lisp_Object x)
+{
+ CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x);
+}
+
/* Extract the interval at the position pointed to by BEGIN from
OBJECT, a string or buffer. Additionally, check that the positions
pointed to by BEGIN and END are within the bounds of OBJECT, and
return list;
}
- return Fcons (list, Fcons (Qnil, Qnil));
+ return list2 (list, Qnil);
}
/* Return true if interval I has all the properties,
are actually added to I's plist) */
static bool
-add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
+add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
+ enum property_set_type set_type)
{
Lisp_Object tail1, tail2, sym1, val1;
bool changed = 0;
}
/* I's property has a different value -- change it */
- Fsetcar (this_cdr, val1);
+ if (set_type == TEXT_PROPERTY_REPLACE)
+ Fsetcar (this_cdr, val1);
+ else {
+ if (CONSP (Fcar (this_cdr)) &&
+ /* Special-case anonymous face properties. */
+ (! EQ (sym1, Qface) ||
+ NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
+ /* The previous value is a list, so prepend (or
+ append) the new value to this list. */
+ if (set_type == TEXT_PROPERTY_PREPEND)
+ Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
+ else
+ nconc2 (Fcar (this_cdr), list1 (val1));
+ else {
+ /* The previous value is a single value, so make it
+ into a list. */
+ if (set_type == TEXT_PROPERTY_PREPEND)
+ Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
+ else
+ Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
+ }
+ }
changed = 1;
break;
}
return make_number (previous->position + LENGTH (previous));
}
\f
-/* Callers note, this can GC when OBJECT is a buffer (or nil). */
+/* Used by add-text-properties and add-face-text-property. */
-DEFUN ("add-text-properties", Fadd_text_properties,
- Sadd_text_properties, 3, 4, 0,
- doc: /* Add properties to the text from START to END.
-The third argument PROPERTIES is a property list
-specifying the property values to add. If the optional fourth argument
-OBJECT is a buffer (or nil, which means the current buffer),
-START and END are buffer positions (integers or markers).
-If OBJECT is a string, START and END are 0-based indices into it.
-Return t if any property value actually changed, nil otherwise. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
-{
+static Lisp_Object
+add_text_properties_1 (Lisp_Object start, Lisp_Object end,
+ Lisp_Object properties, Lisp_Object object,
+ enum property_set_type set_type) {
INTERVAL i, unchanged;
ptrdiff_t s, len;
bool modified = 0;
ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
ptrdiff_t prev_pos = i->position;
- modify_region (object, start, end);
+ modify_text_properties (object, start, end);
/* If someone called us recursively as a side effect of
- modify_region, and changed the intervals behind our back
+ modify_text_properties, and changed the intervals behind our back
(could happen if lock_file, called by prepare_to_modify_buffer,
triggers redisplay, and that calls add-text-properties again
in the same buffer), we cannot continue with I, because its
if (LENGTH (i) == len)
{
- add_properties (properties, i, object);
+ add_properties (properties, i, object, set_type);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
unchanged = i;
i = split_interval_left (unchanged, len);
copy_properties (unchanged, i);
- add_properties (properties, i, object);
+ add_properties (properties, i, object, set_type);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
}
len -= LENGTH (i);
- modified |= add_properties (properties, i, object);
+ modified |= add_properties (properties, i, object, set_type);
i = next_interval (i);
}
}
/* Callers note, this can GC when OBJECT is a buffer (or nil). */
+DEFUN ("add-text-properties", Fadd_text_properties,
+ Sadd_text_properties, 3, 4, 0,
+ doc: /* Add properties to the text from START to END.
+The third argument PROPERTIES is a property list
+specifying the property values to add. If the optional fourth argument
+OBJECT is a buffer (or nil, which means the current buffer),
+START and END are buffer positions (integers or markers).
+If OBJECT is a string, START and END are 0-based indices into it.
+Return t if any property value actually changed, nil otherwise. */)
+ (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
+ Lisp_Object object)
+{
+ return add_text_properties_1 (start, end, properties, object,
+ TEXT_PROPERTY_REPLACE);
+}
+
+/* Callers note, this can GC when OBJECT is a buffer (or nil). */
+
DEFUN ("put-text-property", Fput_text_property,
Sput_text_property, 4, 5, 0,
doc: /* Set one property of the text from START to END.
markers). If OBJECT is a string, START and END are 0-based indices into it. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
{
- Fadd_text_properties (start, end,
- Fcons (property, Fcons (value, Qnil)),
- object);
+ Fadd_text_properties (start, end, list2 (property, value), object);
return Qnil;
}
}
+DEFUN ("add-face-text-property", Fadd_face_text_property,
+ Sadd_face_text_property, 3, 5, 0,
+ doc: /* Add the face property to the text from START to END.
+The third argument FACE specifies the face to add.
+If any text in the region already has any face properties, this new
+face property will be added to the front of the face property list.
+If the optional fourth argument APPENDP is non-nil, append to the end
+of the face property list instead.
+If the optional fifth argument OBJECT is a buffer (or nil, which means
+the current buffer), START and END are buffer positions (integers or
+markers). If OBJECT is a string, START and END are 0-based indices
+into it. */)
+ (Lisp_Object start, Lisp_Object end, Lisp_Object face,
+ Lisp_Object appendp, Lisp_Object object)
+{
+ add_text_properties_1 (start, end, list2 (Qface, face), object,
+ (NILP (appendp)
+ ? TEXT_PROPERTY_PREPEND
+ : TEXT_PROPERTY_APPEND));
+ return Qnil;
+}
+
/* Replace properties of text from START to END with new list of
properties PROPERTIES. OBJECT is the buffer or string containing
the text. OBJECT nil means use the current buffer.
otherwise. */
Lisp_Object
-set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, Lisp_Object coherent_change_p)
+set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
+ Lisp_Object object, Lisp_Object coherent_change_p)
{
register INTERVAL i;
Lisp_Object ostart, oend;
}
if (BUFFERP (object) && !NILP (coherent_change_p))
- modify_region (object, start, end);
+ modify_text_properties (object, start, end);
set_text_properties_1 (start, end, properties, object, i);
ptrdiff_t prev_total_length = TOTAL_LENGTH (i);
ptrdiff_t prev_pos = i->position;
- modify_region (object, start, end);
+ modify_text_properties (object, start, end);
/* If someone called us recursively as a side effect of
- modify_region, and changed the intervals behind our back
+ modify_text_properties, and changed the intervals behind our back
(could happen if lock_file, called by prepare_to_modify_buffer,
triggers redisplay, and that calls add-text-properties again
in the same buffer), we cannot continue with I, because its
/* We are at the beginning of an interval, with len to scan.
The flag `modified' records if changes have been made.
- When object is a buffer, we must call modify_region before changes are
- made and signal_after_change when we are done.
- We call modify_region before calling remove_properties if modified == 0,
+ When object is a buffer, we must call modify_text_properties
+ before changes are made and signal_after_change when we are done.
+ We call modify_text_properties before calling remove_properties if modified == 0,
and we call signal_after_change before returning if modified != 0. */
for (;;)
{
else if (LENGTH (i) == len)
{
if (!modified && BUFFERP (object))
- modify_region (object, start, end);
+ modify_text_properties (object, start, end);
remove_properties (Qnil, properties, i, object);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
i = split_interval_left (i, len);
copy_properties (unchanged, i);
if (!modified && BUFFERP (object))
- modify_region (object, start, end);
+ modify_text_properties (object, start, end);
remove_properties (Qnil, properties, i, object);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
if (interval_has_some_properties_list (properties, i))
{
if (!modified && BUFFERP (object))
- modify_region (object, start, end);
+ modify_text_properties (object, start, end);
remove_properties (Qnil, properties, i, object);
modified = 1;
}
{
if (EQ (Fcar (plist), prop))
{
- plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
+ plist = list2 (prop, Fcar (Fcdr (plist)));
break;
}
plist = Fcdr (Fcdr (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);
+ stuff = Fcons (list3 (make_number (p), make_number (p + len), plist),
+ stuff);
}
i = next_interval (i);
for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
if (EQ (XCAR (plist), prop))
{
- plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil));
+ plist = list2 (prop, Fcar (XCDR (plist)));
break;
}
if (!NILP (plist))
- result = Fcons (Fcons (make_number (s),
- Fcons (make_number (s + len),
- Fcons (plist, Qnil))),
+ result = Fcons (list3 (make_number (s), make_number (s + len),
+ plist),
result);
i = next_interval (i);
/* Text properties `syntax-table'and `display' should be nonsticky
by default. */
Vtext_property_default_nonsticky
- = Fcons (Fcons (intern_c_string ("syntax-table"), Qt),
- Fcons (Fcons (intern_c_string ("display"), Qt), Qnil));
+ = list2 (Fcons (intern_c_string ("syntax-table"), Qt),
+ Fcons (intern_c_string ("display"), Qt));
staticpro (&interval_insert_behind_hooks);
staticpro (&interval_insert_in_front_hooks);
DEFSYM (Qforeground, "foreground");
DEFSYM (Qbackground, "background");
DEFSYM (Qfont, "font");
+ DEFSYM (Qface, "face");
DEFSYM (Qstipple, "stipple");
DEFSYM (Qunderline, "underline");
DEFSYM (Qread_only, "read-only");
defsubr (&Sadd_text_properties);
defsubr (&Sput_text_property);
defsubr (&Sset_text_properties);
+ defsubr (&Sadd_face_text_property);
defsubr (&Sremove_text_properties);
defsubr (&Sremove_list_of_text_properties);
defsubr (&Stext_property_any);