comparison src/editfns.c @ 48094:2a8ba962e34d

(overlays_around, get_pos_property): New funs. (find_field): Use them. Also be careful not to modify POS before its last use. (Fmessage): Don't Fformat if there's nothing to format.

48093:b7cdece1cebf

{
  return current_buffer->mark;
}


/* Find the field surrounding POS in *BEG and *END.  If POS is nil,
   the value of point is used instead.  If BEG or END null,
   means don't store the beginning or end of the field.

   BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned

     Lisp_Object beg_limit, end_limit;
     int *beg, *end;
{
  /* Fields right before and after the point.  */
  Lisp_Object before_field, after_field;
  /* If the fields came from overlays, the associated overlays.
     Qnil means they came from text-properties.  */
  Lisp_Object before_overlay = Qnil, after_overlay = Qnil;
  /* 1 if POS counts as the start of a field.  */
  int at_field_start = 0;
  /* 1 if POS counts as the end of a field.  */
  int at_field_end = 0;

    XSETFASTINT (pos, PT);
  else
    CHECK_NUMBER_COERCE_MARKER (pos);

  after_field
    = get_char_property_and_overlay (pos, Qfield, Qnil, &after_overlay);
  before_field
    = (XFASTINT (pos) > BEGV
       ? get_char_property_and_overlay (make_number (XINT (pos) - 1),
					Qfield, Qnil,
					&before_overlay)
       : Qnil);

  /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
     and POS is at beginning of a field, which can also be interpreted
     as the end of the previous field.  Note that the case where if
     MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
     more natural one; then we avoid treating the beginning of a field
     specially.  */
  if (NILP (merge_at_boundary) && !EQ (after_field, before_field))
    /* We are at a boundary, see which direction is inclusive.  We
       decide by seeing which field the `field' property sticks to.  */
    {
      /* -1 means insertions go into before_field, 1 means they go
	 into after_field, 0 means neither.  */
      int stickiness;
      /* Whether the before/after_field come from overlays.  */
      int bop = !NILP (before_overlay);
      int aop = !NILP (after_overlay);

      if (bop && XMARKER (OVERLAY_END (before_overlay))->insertion_type == 1)
	/* before_field is from an overlay, which expands upon
	   end-insertions.  Note that it's possible for after_overlay to
	   also eat insertions here, but then they will overlap, and
	   there's not much we can do.  */
	stickiness = -1;
      else if (aop
	       && XMARKER (OVERLAY_START (after_overlay))->insertion_type == 0)
	/* after_field is from an overlay, which expand to contain
	   start-insertions.  */
	stickiness = 1;
      else if (bop && aop)
	/* Both fields come from overlays, but neither will contain any
	   insertion here.  */
	stickiness = 0;
      else if (bop)
	/* before_field is an overlay that won't eat any insertion, but
	   after_field is from a text-property.  Assume that the
	   text-property continues underneath the overlay, and so will
	   be inherited by any insertion, regardless of any stickiness
	   settings.  */
	stickiness = 1;
      else if (aop)
	/* Similarly, when after_field is the overlay.  */
	stickiness = -1;
      else
	/* Both fields come from text-properties.  Look for explicit
	   stickiness properties.  */
	stickiness = text_property_stickiness (Qfield, pos);

      if (stickiness > 0)
	at_field_start = 1;
      else if (stickiness < 0)
	at_field_end = 1;
      else
	/* STICKINESS == 0 means that any inserted text will get a
	   `field' char-property of nil, so check to see if that
	   matches either of the adjacent characters (this being a
	   kind of "stickiness by default").  */
	{
	  if (NILP (before_field))
	    at_field_end = 1; /* Sticks to the left.  */
	  else if (NILP (after_field))
	    at_field_start = 1; /* Sticks to the right.  */
	}
    }

  /* Note about special `boundary' fields:

     Consider the case where the point (`.') is between the fields `x' and `y':

	   the beginning of the following field.  */
	*beg = XFASTINT (pos);
      else
	/* Find the previous field boundary.  */
	{
	  if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary))
	    /* Skip a `boundary' field.  */
	    pos = Fprevious_single_char_property_change (pos, Qfield, Qnil,
							 beg_limit);

	  pos = Fprevious_single_char_property_change (pos, Qfield, Qnil,
						       beg_limit);
	  *beg = NILP (pos) ? BEGV : XFASTINT (pos);
	}
    }

  if (end)
    {

      return Qnil;
    }
  else
    {
      register Lisp_Object val;
      val = Fformat (nargs, args);
      message3 (val, SBYTES (val), STRING_MULTIBYTE (val));
      return val;
    }
}

48094:2a8ba962e34d

{
  return current_buffer->mark;
}


/* Find all the overlays in the current buffer that touch position POS.
   Return the number found, and store them in a vector in VEC
   of length LEN.  */

static int
overlays_around (pos, vec, len)
     int pos;
     Lisp_Object *vec;
     int len;
{
  Lisp_Object tail, overlay, start, end;
  int startpos, endpos;
  int idx = 0;

  for (tail = current_buffer->overlays_before;
       GC_CONSP (tail);
       tail = XCDR (tail))
    {
      overlay = XCAR (tail);

      end = OVERLAY_END (overlay);
      endpos = OVERLAY_POSITION (end);
      if (endpos < pos)
	  break;
      start = OVERLAY_START (overlay);
      startpos = OVERLAY_POSITION (start);
      if (startpos <= pos)
	{
	  if (idx < len)
	    vec[idx] = overlay;
	  /* Keep counting overlays even if we can't return them all.  */
	  idx++;
	}
    }

  for (tail = current_buffer->overlays_after;
       GC_CONSP (tail);
       tail = XCDR (tail))
    {
      overlay = XCAR (tail);

      start = OVERLAY_START (overlay);
      startpos = OVERLAY_POSITION (start);
      if (pos < startpos)
	break;
      end = OVERLAY_END (overlay);
      endpos = OVERLAY_POSITION (end);
      if (pos <= endpos)
	{
	  if (idx < len)
	    vec[idx] = overlay;
	  idx++;
	}
    }

  return idx;
}

/* Return the value of property PROP, in OBJECT at POSITION.
   It's the value of PROP that a char inserted at POSITION would get.
   OBJECT is optional and defaults to the current buffer.
   If OBJECT is a buffer, then overlay properties are considered as well as
   text properties.
   If OBJECT is a window, then that window's buffer is used, but
   window-specific overlays are considered only if they are associated
   with OBJECT. */
static Lisp_Object
get_pos_property (position, prop, object)
     Lisp_Object position, object;
     register Lisp_Object prop;
{
  struct window *w = 0;

  CHECK_NUMBER_COERCE_MARKER (position);

  if (NILP (object))
    XSETBUFFER (object, current_buffer);

  if (WINDOWP (object))
    {
      w = XWINDOW (object);
      object = w->buffer;
    }
  if (BUFFERP (object))
    {
      int posn = XINT (position);
      int noverlays;
      Lisp_Object *overlay_vec, tem;
      struct buffer *obuf = current_buffer;

      set_buffer_temp (XBUFFER (object));

      /* First try with room for 40 overlays.  */
      noverlays = 40;
      overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
      noverlays = overlays_around (posn, overlay_vec, noverlays);

      /* If there are more than 40,
	 make enough space for all, and try again.  */
      if (noverlays > 40)
	{
	  overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
	  noverlays = overlays_around (posn, overlay_vec, noverlays);
	}
      noverlays = sort_overlays (overlay_vec, noverlays, NULL);

      set_buffer_temp (obuf);

      /* Now check the overlays in order of decreasing priority.  */
      while (--noverlays >= 0)
	{
	  Lisp_Object ol = overlay_vec[noverlays];
	  tem = Foverlay_get (ol, prop);
	  if (!NILP (tem))
	    {
	      /* Check the overlay is indeed active at point.  */
	      Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol);
	      if ((OVERLAY_POSITION (start) == posn
		   && XMARKER (start)->insertion_type == 1)
		  || (OVERLAY_POSITION (finish) == posn
		      && XMARKER (finish)->insertion_type == 0))
		; /* The overlay will not cover a char inserted at point.  */
	      else
		{
		  return tem;
		}
	    }
	}
      
    }

  { /* Now check the text-properties.  */
    int stickiness = text_property_stickiness (Qfield, position);
    if (stickiness > 0)
      return Fget_text_property (position, Qfield, Qnil);
    else if (stickiness < 0 && XINT (position) > BEGV)
      return Fget_text_property (make_number (XINT (position) - 1),
				 Qfield, Qnil);
    else
      return Qnil;
  }
}

/* Find the field surrounding POS in *BEG and *END.  If POS is nil,
   the value of point is used instead.  If BEG or END null,
   means don't store the beginning or end of the field.

   BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned

     Lisp_Object beg_limit, end_limit;
     int *beg, *end;
{
  /* Fields right before and after the point.  */
  Lisp_Object before_field, after_field;
  /* 1 if POS counts as the start of a field.  */
  int at_field_start = 0;
  /* 1 if POS counts as the end of a field.  */
  int at_field_end = 0;

    XSETFASTINT (pos, PT);
  else
    CHECK_NUMBER_COERCE_MARKER (pos);

  after_field
    = get_char_property_and_overlay (pos, Qfield, Qnil, NULL);
  before_field
    = (XFASTINT (pos) > BEGV
       ? get_char_property_and_overlay (make_number (XINT (pos) - 1),
					Qfield, Qnil, NULL)
       : Qnil);

  /* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
     and POS is at beginning of a field, which can also be interpreted
     as the end of the previous field.  Note that the case where if
     MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
     more natural one; then we avoid treating the beginning of a field
     specially.  */
  if (NILP (merge_at_boundary))
    {
      Lisp_Object field = get_pos_property (pos, Qfield, Qnil);
      if (!EQ (field, after_field))
	at_field_end = 1;
      if (!EQ (field, before_field))
	at_field_start = 1;
    }

  /* Note about special `boundary' fields:

     Consider the case where the point (`.') is between the fields `x' and `y':

	   the beginning of the following field.  */
	*beg = XFASTINT (pos);
      else
	/* Find the previous field boundary.  */
	{
	  Lisp_Object p = pos;
	  if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary))
	    /* Skip a `boundary' field.  */
	    p = Fprevious_single_char_property_change (p, Qfield, Qnil,
						       beg_limit);

	  p = Fprevious_single_char_property_change (p, Qfield, Qnil,
						     beg_limit);
	  *beg = NILP (p) ? BEGV : XFASTINT (p);
	}
    }

  if (end)
    {

      return Qnil;
    }
  else
    {
      register Lisp_Object val;
      val = nargs < 2 && STRINGP (args[0]) ? args[0] : Fformat (nargs, args);
      message3 (val, SBYTES (val), STRING_MULTIBYTE (val));
      return val;
    }
}