+
+/* Return a list representing the text properties of OBJECT between
+ START and END. if PROP is non-nil, report only on that property.
+ Each result list element has the form (S E PLIST), where S and E
+ are positions in OBJECT and PLIST is a property list containing the
+ text properties of OBJECT between S and E. Value is nil if OBJECT
+ doesn't contain text properties between START and END. */
+
+Lisp_Object
+text_property_list (object, start, end, prop)
+ Lisp_Object object, start, end, prop;
+{
+ struct interval *i;
+ Lisp_Object result;
+
+ result = Qnil;
+
+ i = validate_interval_range (object, &start, &end, soft);
+ if (!NULL_INTERVAL_P (i))
+ {
+ int s = XINT (start);
+ int e = XINT (end);
+
+ while (s < e)
+ {
+ int interval_end, len;
+ Lisp_Object plist;
+
+ interval_end = i->position + LENGTH (i);
+ if (interval_end > e)
+ interval_end = e;
+ len = interval_end - s;
+
+ plist = i->plist;
+
+ if (!NILP (prop))
+ for (; !NILP (plist); plist = Fcdr (Fcdr (plist)))
+ if (EQ (Fcar (plist), prop))
+ {
+ plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
+ break;
+ }
+
+ if (!NILP (plist))
+ result = Fcons (Fcons (make_number (s),
+ Fcons (make_number (s + len),
+ Fcons (plist, Qnil))),
+ result);
+
+ i = next_interval (i);
+ if (NULL_INTERVAL_P (i))
+ break;
+ s = i->position;
+ }
+ }
+
+ return result;
+}
+
+
+/* Add text properties to OBJECT from LIST. LIST is a list of triples
+ (START END PLIST), where START and END are positions and PLIST is a
+ property list containing the text properties to add. Adjust START
+ and END positions by DELTA before adding properties. Value is
+ non-zero if OBJECT was modified. */
+
+int
+add_text_properties_from_list (object, list, delta)
+ Lisp_Object object, list, delta;
+{
+ struct gcpro gcpro1, gcpro2;
+ int modified_p = 0;
+
+ GCPRO2 (list, object);
+
+ for (; CONSP (list); list = XCDR (list))
+ {
+ Lisp_Object item, start, end, plist, tem;
+
+ item = XCAR (list);
+ start = make_number (XINT (XCAR (item)) + XINT (delta));
+ end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
+ plist = XCAR (XCDR (XCDR (item)));
+
+ tem = Fadd_text_properties (start, end, plist, object);
+ if (!NILP (tem))
+ modified_p = 1;
+ }
+
+ UNGCPRO;
+ return modified_p;
+}
+
+
+
+/* Modify end-points of ranges in LIST destructively. LIST is a list
+ as returned from text_property_list. Change end-points equal to
+ OLD_END to NEW_END. */
+
+void
+extend_property_ranges (list, old_end, new_end)
+ Lisp_Object list, old_end, new_end;
+{
+ for (; CONSP (list); list = XCDR (list))
+ {
+ Lisp_Object item, end;
+
+ item = XCAR (list);
+ end = XCAR (XCDR (item));
+
+ if (EQ (end, old_end))
+ XSETCAR (XCDR (item), new_end);
+ }
+}
+
+
+\f
+/* Call the modification hook functions in LIST, each with START and END. */
+
+static void
+call_mod_hooks (list, start, end)
+ Lisp_Object list, start, end;
+{
+ struct gcpro gcpro1;
+ GCPRO1 (list);
+ while (!NILP (list))
+ {
+ call2 (Fcar (list), start, end);
+ list = Fcdr (list);
+ }
+ UNGCPRO;
+}
+
+/* Check for read-only intervals between character positions START ... END,
+ in BUF, and signal an error if we find one.
+
+ Then check for any modification hooks in the range.
+ Create a list of all these hooks in lexicographic order,
+ eliminating consecutive extra copies of the same hook. Then call
+ those hooks in order, with START and END - 1 as arguments. */
+
+void
+verify_interval_modification (buf, start, end)
+ struct buffer *buf;
+ int start, end;
+{
+ register INTERVAL intervals = BUF_INTERVALS (buf);
+ register INTERVAL i;
+ Lisp_Object hooks;
+ register Lisp_Object prev_mod_hooks;
+ Lisp_Object mod_hooks;
+ struct gcpro gcpro1;
+
+ hooks = Qnil;
+ prev_mod_hooks = Qnil;
+ mod_hooks = Qnil;
+
+ interval_insert_behind_hooks = Qnil;
+ interval_insert_in_front_hooks = Qnil;
+
+ if (NULL_INTERVAL_P (intervals))
+ return;
+
+ if (start > end)
+ {
+ int temp = start;
+ start = end;
+ end = temp;
+ }
+
+ /* For an insert operation, check the two chars around the position. */
+ if (start == end)
+ {
+ INTERVAL prev = NULL;
+ Lisp_Object before, after;
+
+ /* Set I to the interval containing the char after START,
+ and PREV to the interval containing the char before START.
+ Either one may be null. They may be equal. */
+ i = find_interval (intervals, start);
+
+ if (start == BUF_BEGV (buf))
+ prev = 0;
+ else if (i->position == start)
+ prev = previous_interval (i);
+ else if (i->position < start)
+ prev = i;
+ if (start == BUF_ZV (buf))
+ i = 0;
+
+ /* If Vinhibit_read_only is set and is not a list, we can
+ skip the read_only checks. */
+ if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
+ {
+ /* If I and PREV differ we need to check for the read-only
+ property together with its stickiness. If either I or
+ PREV are 0, this check is all we need.
+ We have to take special care, since read-only may be
+ indirectly defined via the category property. */
+ if (i != prev)
+ {
+ if (! NULL_INTERVAL_P (i))
+ {
+ after = textget (i->plist, Qread_only);
+
+ /* If interval I is read-only and read-only is
+ front-sticky, inhibit insertion.
+ Check for read-only as well as category. */
+ if (! NILP (after)
+ && NILP (Fmemq (after, Vinhibit_read_only)))
+ {
+ Lisp_Object tem;
+
+ tem = textget (i->plist, Qfront_sticky);
+ if (TMEM (Qread_only, tem)
+ || (NILP (Fplist_get (i->plist, Qread_only))
+ && TMEM (Qcategory, tem)))
+ text_read_only ();
+ }
+ }
+
+ if (! NULL_INTERVAL_P (prev))
+ {
+ before = textget (prev->plist, Qread_only);
+
+ /* If interval PREV is read-only and read-only isn't
+ rear-nonsticky, inhibit insertion.
+ Check for read-only as well as category. */
+ if (! NILP (before)
+ && NILP (Fmemq (before, Vinhibit_read_only)))
+ {
+ Lisp_Object tem;
+
+ tem = textget (prev->plist, Qrear_nonsticky);
+ if (! TMEM (Qread_only, tem)
+ && (! NILP (Fplist_get (prev->plist,Qread_only))
+ || ! TMEM (Qcategory, tem)))
+ text_read_only ();
+ }
+ }
+ }
+ else if (! NULL_INTERVAL_P (i))
+ {
+ after = textget (i->plist, Qread_only);
+
+ /* If interval I is read-only and read-only is
+ front-sticky, inhibit insertion.
+ Check for read-only as well as category. */
+ if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
+ {
+ Lisp_Object tem;
+
+ tem = textget (i->plist, Qfront_sticky);
+ if (TMEM (Qread_only, tem)
+ || (NILP (Fplist_get (i->plist, Qread_only))
+ && TMEM (Qcategory, tem)))
+ text_read_only ();
+
+ tem = textget (prev->plist, Qrear_nonsticky);
+ if (! TMEM (Qread_only, tem)
+ && (! NILP (Fplist_get (prev->plist, Qread_only))
+ || ! TMEM (Qcategory, tem)))
+ text_read_only ();
+ }
+ }
+ }
+
+ /* Run both insert hooks (just once if they're the same). */
+ if (!NULL_INTERVAL_P (prev))
+ interval_insert_behind_hooks
+ = textget (prev->plist, Qinsert_behind_hooks);
+ if (!NULL_INTERVAL_P (i))
+ interval_insert_in_front_hooks
+ = textget (i->plist, Qinsert_in_front_hooks);
+ }
+ else
+ {
+ /* Loop over intervals on or next to START...END,
+ collecting their hooks. */
+
+ i = find_interval (intervals, start);
+ do
+ {
+ if (! INTERVAL_WRITABLE_P (i))
+ text_read_only ();
+
+ if (!inhibit_modification_hooks)
+ {
+ mod_hooks = textget (i->plist, Qmodification_hooks);
+ if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
+ {
+ hooks = Fcons (mod_hooks, hooks);
+ prev_mod_hooks = mod_hooks;
+ }
+ }
+
+ i = next_interval (i);
+ }
+ /* Keep going thru the interval containing the char before END. */
+ while (! NULL_INTERVAL_P (i) && i->position < end);
+
+ if (!inhibit_modification_hooks)
+ {
+ GCPRO1 (hooks);
+ hooks = Fnreverse (hooks);
+ while (! EQ (hooks, Qnil))
+ {
+ call_mod_hooks (Fcar (hooks), make_number (start),
+ make_number (end));
+ hooks = Fcdr (hooks);
+ }
+ UNGCPRO;
+ }
+ }
+}
+
+/* Run the interval hooks for an insertion on character range START ... END.
+ verify_interval_modification chose which hooks to run;
+ this function is called after the insertion happens
+ so it can indicate the range of inserted text. */
+
+void
+report_interval_modification (start, end)
+ Lisp_Object start, end;
+{
+ if (! NILP (interval_insert_behind_hooks))
+ call_mod_hooks (interval_insert_behind_hooks, start, end);
+ if (! NILP (interval_insert_in_front_hooks)
+ && ! EQ (interval_insert_in_front_hooks,
+ interval_insert_behind_hooks))
+ call_mod_hooks (interval_insert_in_front_hooks, start, end);
+}
+\f