X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/33ca35042a2b7098157d25c96111b891d070ba37..041aa96f12491a64f0f0d4fec6a56eb83f38ffbf:/src/textprop.c diff --git a/src/textprop.c b/src/textprop.c index f3d5917a08..7e92be8986 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1,5 +1,5 @@ /* 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. @@ -22,6 +22,10 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "intervals.h" #include "buffer.h" #include "window.h" + +#ifndef NULL +#define NULL (void *)0 +#endif /* NOTES: previous- and next- property change will have to skip @@ -57,9 +61,10 @@ Lisp_Object Qfront_sticky, Qrear_nonsticky; /* 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; /* Extract the interval at the position pointed to by BEGIN from @@ -102,7 +107,7 @@ validate_interval_range (object, begin, end, force) /* If we are asked for a point, but from a subr which operates on a range, then return nothing. */ - if (*begin == *end && begin != end) + if (EQ (*begin, *end) && begin != end) return NULL_INTERVAL; if (XINT (*begin) > XINT (*end)) @@ -113,14 +118,14 @@ validate_interval_range (object, begin, end, force) *end = n; } - if (XTYPE (object) == Lisp_Buffer) + if (BUFFERP (object)) { register struct buffer *b = XBUFFER (object); 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)) @@ -137,9 +142,9 @@ validate_interval_range (object, begin, end, force) 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) @@ -248,7 +253,7 @@ interval_has_some_properties (plist, i) /* Return the value of PROP in property-list PLIST, or Qunbound if it has none. */ -static int +static Lisp_Object property_value (plist, prop) Lisp_Object plist, prop; { @@ -327,9 +332,18 @@ add_properties (plist, i, object) 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))) @@ -342,6 +356,8 @@ add_properties (plist, i, object) 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); @@ -354,7 +370,7 @@ add_properties (plist, i, object) break; /* Record this change in the buffer, for undo purposes. */ - if (XTYPE (object) == Lisp_Buffer) + if (BUFFERP (object)) { modify_region (XBUFFER (object), make_number (i->position), @@ -372,7 +388,7 @@ add_properties (plist, i, object) if (! found) { /* Record this change in the buffer, for undo purposes. */ - if (XTYPE (object) == Lisp_Buffer) + if (BUFFERP (object)) { modify_region (XBUFFER (object), make_number (i->position), @@ -385,6 +401,8 @@ add_properties (plist, i, object) } } + UNGCPRO; + return changed; } @@ -410,7 +428,7 @@ remove_properties (plist, i, object) /* First, remove the symbol if its at the head of the list */ while (! NILP (current_plist) && EQ (sym, Fcar (current_plist))) { - if (XTYPE (object) == Lisp_Buffer) + if (BUFFERP (object)) { modify_region (XBUFFER (object), make_number (i->position), @@ -432,7 +450,7 @@ remove_properties (plist, i, object) this = Fcdr (Fcdr (tail2)); if (EQ (sym, Fcar (this))) { - if (XTYPE (object) == Lisp_Buffer) + if (BUFFERP (object)) { modify_region (XBUFFER (object), make_number (i->position), @@ -481,7 +499,7 @@ If POSITION is at the end of OBJECT, the value is nil.") register INTERVAL i; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &pos, &pos, soft); if (NULL_INTERVAL_P (i)) @@ -524,12 +542,12 @@ overlays are considered only if they are associated with OBJECT.") CHECK_NUMBER_COERCE_MARKER (pos, 0); if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + XSETBUFFER (object, current_buffer); if (WINDOWP (object)) { w = XWINDOW (object); - XSET (object, Lisp_Buffer, w->buffer); + object = w->buffer; } if (BUFFERP (object)) { @@ -543,7 +561,8 @@ overlays are considered only if they are associated with OBJECT.") len = 40; overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); - noverlays = overlays_at (posn, 0, &overlay_vec, &len, &next_overlay); + noverlays = overlays_at (posn, 0, &overlay_vec, &len, + &next_overlay, NULL); /* If there are more than 40, make enough space for all, and try again. */ @@ -551,7 +570,8 @@ overlays are considered only if they are associated with OBJECT.") { len = noverlays; overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); - noverlays = overlays_at (posn, 0, &overlay_vec, &len, &next_overlay); + noverlays = overlays_at (posn, 0, &overlay_vec, &len, + &next_overlay, NULL); } noverlays = sort_overlays (overlay_vec, noverlays, w); @@ -584,9 +604,9 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.") register INTERVAL i, next; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + 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); @@ -594,6 +614,14 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.") 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); @@ -603,7 +631,8 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.") if (! NILP (limit) && !(next->position < XFASTINT (limit))) return limit; - return next->position - (XTYPE (object) == Lisp_String); + XSETFASTINT (pos, next->position - (STRINGP (object))); + return pos; } /* Return 1 if there's a change in some property between BEG and END. */ @@ -615,8 +644,8 @@ property_change_between_p (beg, end) register INTERVAL i, next; Lisp_Object object, pos; - XSET (object, Lisp_Buffer, current_buffer); - XFASTINT (pos) = beg; + XSETBUFFER (object, current_buffer); + XSETFASTINT (pos, beg); i = validate_interval_range (object, &pos, &pos, soft); if (NULL_INTERVAL_P (i)) @@ -656,7 +685,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.") register Lisp_Object here_val; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + XSETBUFFER (object, current_buffer); if (!NILP (limit)) CHECK_NUMBER_COERCE_MARKER (limit, 0); @@ -677,7 +706,8 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.") if (! NILP (limit) && !(next->position < XFASTINT (limit))) return limit; - return next->position - (XTYPE (object) == Lisp_String); + XSETFASTINT (pos, next->position - (STRINGP (object))); + return pos; } DEFUN ("previous-property-change", Fprevious_property_change, @@ -696,7 +726,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT.") register INTERVAL i, previous; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + XSETBUFFER (object, current_buffer); if (!NILP (limit)) CHECK_NUMBER_COERCE_MARKER (limit, 0); @@ -720,8 +750,9 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT.") && !(previous->position + LENGTH (previous) > XFASTINT (limit))) return limit; - return (previous->position + LENGTH (previous) - - (XTYPE (object) == Lisp_String)); + XSETFASTINT (pos, (previous->position + LENGTH (previous) + - (STRINGP (object)))); + return pos; } DEFUN ("previous-single-property-change", Fprevious_single_property_change, @@ -742,7 +773,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT.") register Lisp_Object here_val; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + XSETBUFFER (object, current_buffer); if (!NILP (limit)) CHECK_NUMBER_COERCE_MARKER (limit, 0); @@ -769,10 +800,13 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT.") && !(previous->position + LENGTH (previous) > XFASTINT (limit))) return limit; - return (previous->position + LENGTH (previous) - - (XTYPE (object) == Lisp_String)); + 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\ @@ -786,13 +820,14 @@ Return t if any property value actually changed, nil otherwise.") { register INTERVAL i, unchanged; register int s, len, modified = 0; + struct gcpro gcpro1; properties = validate_plist (properties); if (NILP (properties)) return Qnil; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, hard); if (NULL_INTERVAL_P (i)) @@ -801,6 +836,10 @@ Return t if any property value actually changed, nil otherwise.") 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) @@ -831,6 +870,11 @@ Return t if any property value actually changed, nil otherwise.") 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; @@ -854,6 +898,8 @@ Return t if any property value actually changed, nil otherwise.") } } +/* 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\ @@ -882,19 +928,39 @@ is the string or buffer containing the text.") register INTERVAL i, unchanged; register INTERVAL prev_changed = NULL_INTERVAL; register int s, len; + Lisp_Object ostart, oend; + + ostart = start; + oend = end; props = validate_plist (props); if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + 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 (props)) return Qnil; + /* Restore the original START and END values + because validate_interval_range increments them for strings. */ + start = ostart; + end = oend; + i = validate_interval_range (object, &start, &end, hard); /* This can return if start == end. */ if (NULL_INTERVAL_P (i)) @@ -976,7 +1042,7 @@ Return t if any property was actually removed, nil otherwise.") register int s, len, modified = 0; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); if (NULL_INTERVAL_P (i)) @@ -1052,8 +1118,10 @@ containing the text.") register int e, pos; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + 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)) @@ -1065,7 +1133,7 @@ containing the text.") pos = i->position; if (pos < XINT (start)) pos = XINT (start); - return make_number (pos - (XTYPE (object) == Lisp_String)); + return make_number (pos - (STRINGP (object))); } i = next_interval (i); } @@ -1086,7 +1154,7 @@ containing the text.") register int s, e; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + 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; @@ -1101,7 +1169,7 @@ containing the text.") { if (i->position > s) s = i->position; - return make_number (s - (XTYPE (object) == Lisp_String)); + return make_number (s - (STRINGP (object))); } i = next_interval (i); } @@ -1123,7 +1191,7 @@ is the string or buffer containing the text.") register int s, len, modified; if (NILP (object)) - XSET (object, Lisp_Buffer, current_buffer); + XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); if (NULL_INTERVAL_P (i)) @@ -1224,13 +1292,13 @@ is the string or buffer containing the text.") 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) @@ -1241,6 +1309,7 @@ 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)) @@ -1251,7 +1320,7 @@ copy_text_properties (start, end, src, pos, dest, prop) 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); @@ -1299,6 +1368,8 @@ copy_text_properties (start, end, src, pos, dest, prop) s = i->position; } + GCPRO2 (stuff, dest); + while (! NILP (stuff)) { res = Fcar (stuff); @@ -1309,15 +1380,23 @@ copy_text_properties (start, end, src, pos, dest, prop) 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 call the text property values of\n\ -`point-left' and `point-entered'."); + "If non-nil, don't run `point-left' and `point-entered' text properties.\n\ +This also inhibits the use of the `intangible' text property."); Vinhibit_point_motion_hooks = Qnil; /* Common attributes one might give text */