static Lisp_Object Qread_only;
Lisp_Object Qminibuffer_prompt;
-/* Sticky properties */
+enum property_set_type
+{
+ TEXT_PROPERTY_REPLACE,
+ TEXT_PROPERTY_PREPEND,
+ TEXT_PROPERTY_APPEND
+};
+
+/* Sticky properties. */
Lisp_Object Qfront_sticky, Qrear_nonsticky;
/* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
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;
}
if (WINDOWP (object))
{
+ CHECK_LIVE_WINDOW (object);
w = XWINDOW (object);
- object = w->buffer;
+ object = w->contents;
}
if (BUFFERP (object))
{
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;
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.
{
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);
HCoop / bpt / emacs.git / blobdiff