/* Interface code for dealing with text properties.
- Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation,
+ Copyright (C) 1993-1995, 1997, 1999-2014 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
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);
}
return list;
}
- return Fcons (list, Fcons (Qnil, Qnil));
+ return list2 (list, Qnil);
}
/* Return true if interval I has all the properties,
if (set_type == TEXT_PROPERTY_PREPEND)
Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
else
- nconc2 (Fcar (this_cdr), Fcons (val1, Qnil));
+ 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,
- Fcons (val1, Fcons (Fcar (this_cdr), Qnil)));
+ Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
else
- Fsetcar (this_cdr,
- Fcons (Fcar (this_cdr), Fcons (val1, Qnil)));
+ Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
}
}
changed = 1;
else
{
Lisp_Object initial_value, value;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
if (! NILP (object))
CHECK_BUFFER (object);
break;
}
- unbind_to (count, Qnil);
+ dynwind_end ();
}
return position;
}
else
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
if (! NILP (object))
CHECK_BUFFER (object);
}
}
- unbind_to (count, Qnil);
+ dynwind_end ();
}
return position;
do
{
if (got >= len)
- RETURN_UNGCPRO (Qnil);
+ return Qnil;
len -= got;
i = next_interval (i);
got = LENGTH (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
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
+FACE specifies the face to add. It should be a valid value of the
+`face' property (typically a face name or a plist of face attributes
+and values).
+
+If any text in the region already has a non-nil `face' property, those
+face(s) are retained. This is done by setting the `face' property to
+a list of faces, with FACE as the first element (by default) and the
+pre-existing faces as the remaining elements.
+
+If optional fourth argument APPEND is non-nil, append FACE to the end
+of the face list instead.
+
+If 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)
+ Lisp_Object append, Lisp_Object object)
{
- add_text_properties_1 (start, end,
- Fcons (Qface, Fcons (face, Qnil)),
- object,
- NILP (appendp)? TEXT_PROPERTY_PREPEND:
- TEXT_PROPERTY_APPEND);
+ add_text_properties_1 (start, end, list2 (Qface, face), object,
+ (NILP (append)
+ ? TEXT_PROPERTY_PREPEND
+ : TEXT_PROPERTY_APPEND));
return Qnil;
}
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;
}
len -= LENGTH (i);
i = next_interval (i);
+ if (!i)
+ {
+ if (modified)
+ {
+ if (BUFFERP (object))
+ signal_after_change (XINT (start),
+ XINT (end) - XINT (start),
+ XINT (end) - XINT (start));
+ return Qt;
+ }
+ else
+ return Qnil;
+ }
}
}
\f
int
text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer)
{
- Lisp_Object prev_pos, front_sticky;
- bool is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
+ bool ignore_previous_character;
+ Lisp_Object prev_pos = make_number (XINT (pos) - 1);
+ Lisp_Object front_sticky;
+ bool is_rear_sticky = true, is_front_sticky = false; /* defaults */
Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky);
if (NILP (buffer))
XSETBUFFER (buffer, current_buffer);
- if (CONSP (defalt) && !NILP (XCDR (defalt)))
- is_rear_sticky = 0;
+ ignore_previous_character = XINT (pos) <= BUF_BEGV (XBUFFER (buffer));
- if (XINT (pos) > BUF_BEGV (XBUFFER (buffer)))
- /* Consider previous character. */
+ if (ignore_previous_character || (CONSP (defalt) && !NILP (XCDR (defalt))))
+ is_rear_sticky = false;
+ else
{
- Lisp_Object rear_non_sticky;
-
- prev_pos = make_number (XINT (pos) - 1);
- rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
+ Lisp_Object rear_non_sticky
+ = Fget_text_property (prev_pos, Qrear_nonsticky, buffer);
if (!NILP (CONSP (rear_non_sticky)
? Fmemq (prop, rear_non_sticky)
: rear_non_sticky))
/* PROP is rear-non-sticky. */
- is_rear_sticky = 0;
+ is_rear_sticky = false;
}
- else
- return 0;
/* Consider following character. */
/* This signals an arg-out-of-range error if pos is outside the
|| (CONSP (front_sticky)
&& !NILP (Fmemq (prop, front_sticky))))
/* PROP is inherited from after. */
- is_front_sticky = 1;
+ is_front_sticky = true;
/* Simple cases, where the properties are consistent. */
if (is_rear_sticky && !is_front_sticky)
disambiguate. Basically, rear-sticky wins, _except_ if the
property that would be inherited has a value of nil, in which case
front-sticky wins. */
- if (XINT (pos) == BUF_BEGV (XBUFFER (buffer))
+ if (ignore_previous_character
|| NILP (Fget_text_property (prev_pos, prop, buffer)))
return 1;
else
{
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);
void
syms_of_textprop (void)
{
+#include "textprop.x"
+
DEFVAR_LISP ("default-text-properties", Vdefault_text_properties,
doc: /* Property-list used as default values.
The value of a property in this list is seen as the value for every
/* 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 (Qmouse_entered, "mouse-entered");
DEFSYM (Qpoint_left, "point-left");
DEFSYM (Qpoint_entered, "point-entered");
-
- defsubr (&Stext_properties_at);
- defsubr (&Sget_text_property);
- defsubr (&Sget_char_property);
- defsubr (&Sget_char_property_and_overlay);
- defsubr (&Snext_char_property_change);
- defsubr (&Sprevious_char_property_change);
- defsubr (&Snext_single_char_property_change);
- defsubr (&Sprevious_single_char_property_change);
- defsubr (&Snext_property_change);
- defsubr (&Snext_single_property_change);
- defsubr (&Sprevious_property_change);
- defsubr (&Sprevious_single_property_change);
- 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);
- defsubr (&Stext_property_not_all);
}
HCoop / bpt / emacs.git / blobdiff