/* Interface code for dealing with text properties.
- Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to
the o1's cdr. Otherwise, return zero. This is handy for
traversing plists. */
-#define PLIST_ELT_P(o1, o2) (CONSP (o1) && CONSP ((o2) = XCONS (o1)->cdr))
+#define PLIST_ELT_P(o1, o2) (CONSP (o1) && ((o2)=XCONS (o1)->cdr, CONSP (o2)))
Lisp_Object Vinhibit_point_motion_hooks;
+Lisp_Object Vdefault_properties;
\f
/* Extract the interval at the position pointed to by BEGIN from
if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end)
&& XINT (*end) <= BUF_ZV (b)))
args_out_of_range (*begin, *end);
- i = b->intervals;
+ i = BUF_INTERVALS (b);
/* If there's no text, there are no properties. */
if (BUF_BEGV (b) == BUF_ZV (b))
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;
+ XSETFASTINT (*begin, XFASTINT (*begin) + 1);
if (begin != end)
- XFASTINT (*end) += 1;
+ XSETFASTINT (*end, XFASTINT (*end) + 1);
i = s->intervals;
if (s->size == 0)
INTERVAL i;
Lisp_Object object;
{
- register Lisp_Object tail1, tail2, sym1, val1;
+ Lisp_Object tail1, tail2, sym1, val1;
register int changed = 0;
register int found;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ tail1 = plist;
+ sym1 = Qnil;
+ val1 = Qnil;
+ /* No need to protect OBJECT, because we can GC only in the case
+ where it is a buffer, and live buffers are always protected.
+ I and its plist are also protected, via OBJECT. */
+ GCPRO3 (tail1, sym1, val1);
/* Go through each element of PLIST. */
for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
if (EQ (sym1, Fcar (tail2)))
{
+ /* No need to gcpro, because tail2 protects this
+ and it must be a cons cell (we get an error otherwise). */
register Lisp_Object this_cdr;
this_cdr = Fcdr (tail2);
}
}
+ UNGCPRO;
+
return changed;
}
if (NILP (object))
XSETBUFFER (object, current_buffer);
- if (!NILP (limit))
+ if (! NILP (limit) && ! EQ (limit, Qt))
CHECK_NUMBER_COERCE_MARKER (limit, 0);
i = validate_interval_range (object, &pos, &pos, soft);
return limit;
next = next_interval (i);
+ /* If LIMIT is t, return start of next interval--don't
+ bother checking further intervals. */
+ if (EQ (limit, Qt))
+ {
+ XSETFASTINT (pos, next->position - (STRINGP (object)));
+ return pos;
+ }
+
while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)
&& (NILP (limit) || next->position < XFASTINT (limit)))
next = next_interval (next);
if (! NILP (limit) && !(next->position < XFASTINT (limit)))
return limit;
- XFASTINT (pos) = next->position - (STRINGP (object));
+ XSETFASTINT (pos, next->position - (STRINGP (object)));
return pos;
}
Lisp_Object object, pos;
XSETBUFFER (object, current_buffer);
- XFASTINT (pos) = beg;
+ XSETFASTINT (pos, beg);
i = validate_interval_range (object, &pos, &pos, soft);
if (NULL_INTERVAL_P (i))
if (! NILP (limit) && !(next->position < XFASTINT (limit)))
return limit;
- XFASTINT (pos) = next->position - (STRINGP (object));
+ XSETFASTINT (pos, next->position - (STRINGP (object)));
return pos;
}
&& !(previous->position + LENGTH (previous) > XFASTINT (limit)))
return limit;
- XFASTINT (pos) = (previous->position + LENGTH (previous)
- - (STRINGP (object)));
+ XSETFASTINT (pos, (previous->position + LENGTH (previous)
+ - (STRINGP (object))));
return pos;
}
&& !(previous->position + LENGTH (previous) > XFASTINT (limit)))
return limit;
- XFASTINT (pos) = (previous->position + LENGTH (previous)
- - (STRINGP (object)));
+ XSETFASTINT (pos, (previous->position + LENGTH (previous)
+ - (STRINGP (object))));
return pos;
}
+/* 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,
"Add properties to the text from START to END.\n\
{
register INTERVAL i, unchanged;
register int s, len, modified = 0;
+ struct gcpro gcpro1;
properties = validate_plist (properties);
if (NILP (properties))
s = XINT (start);
len = XINT (end) - s;
+ /* No need to protect OBJECT, because we GC only if it's a buffer,
+ and live buffers are always protected. */
+ GCPRO1 (properties);
+
/* If we're not starting on an interval boundary, we have to
split this interval. */
if (i->position != s)
if (LENGTH (i) >= len)
{
+ /* We can UNGCPRO safely here, because there will be just
+ one more chance to gc, in the next call to add_properties,
+ and after that we will not need PROPERTIES or OBJECT again. */
+ UNGCPRO;
+
if (interval_has_all_properties (properties, i))
return modified ? Qt : Qnil;
}
}
+/* 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,
"Set one property of the text from START to END.\n\
if (NILP (object))
XSETBUFFER (object, current_buffer);
+ /* If we want no properties for a whole string,
+ get rid of its intervals. */
+ if (NILP (props) && STRINGP (object)
+ && XFASTINT (start) == 0
+ && XFASTINT (end) == XSTRING (object)->size)
+ {
+ XSTRING (object)->intervals = 0;
+ return Qt;
+ }
+
i = validate_interval_range (object, &start, &end, soft);
+
if (NULL_INTERVAL_P (i))
{
/* If buffer has no props, and we want none, return now. */
if (NILP (object))
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
+ if (NULL_INTERVAL_P (i))
+ return (!NILP (value) || EQ (start, end) ? Qnil : start);
e = XINT (end);
while (! NULL_INTERVAL_P (i))
returns the text properties of a region as a list of ranges and
plists, and another which applies such a list to another object. */
-/* DEFUN ("copy-text-properties", Fcopy_text_properties,
- Scopy_text_properties, 5, 6, 0,
- "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\
-SRC and DEST may each refer to strings or buffers.\n\
-Optional sixth argument PROP causes only that property to be copied.\n\
-Properties are copied to DEST as if by `add-text-properties'.\n\
-Return t if any property value actually changed, nil otherwise.") */
+/* Add properties from SRC to SRC of SRC, starting at POS in DEST.
+ SRC and DEST may each refer to strings or buffers.
+ Optional sixth argument PROP causes only that property to be copied.
+ Properties are copied to DEST as if by `add-text-properties'.
+ Return t if any property value actually changed, nil otherwise. */
+
+/* Note this can GC when DEST is a buffer. */
Lisp_Object
copy_text_properties (start, end, src, pos, dest, prop)
Lisp_Object stuff;
Lisp_Object plist;
int s, e, e2, p, len, modified = 0;
+ struct gcpro gcpro1, gcpro2;
i = validate_interval_range (src, &start, &end, soft);
if (NULL_INTERVAL_P (i))
Lisp_Object dest_start, dest_end;
dest_start = pos;
- XFASTINT (dest_end) = XINT (dest_start) + (XINT (end) - XINT (start));
+ XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
/* Apply this to a copy of pos; it will try to increment its arguments,
which we don't want. */
validate_interval_range (dest, &dest_start, &dest_end, soft);
s = i->position;
}
+ GCPRO2 (stuff, dest);
+
while (! NILP (stuff))
{
res = Fcar (stuff);
stuff = Fcdr (stuff);
}
+ UNGCPRO;
+
return modified ? Qt : Qnil;
}
void
syms_of_textprop ()
{
+ DEFVAR_LISP ("default-properties", &Vdefault_properties,
+ "Property-list used as default values.\n\
+The value of a property in this list is seen as the value for every character\n\
+that does not have its own value for that property.");
+ Vdefault_properties = Qnil;
+
DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks,
"If non-nil, don't run `point-left' and `point-entered' text properties.\n\
This also inhibits the use of the `intangible' text property.");