comparison src/buffer.c @ 2508:3aa2f3b35353

* buffer.c (Fmake_overlay, Fmove_overlay): New optional BUFFER arguments. (recenter_overlay_lists): New argument BUF, to use instead of the current buffer. (Foverlay_recenter): Pass the appropriate arguments to recenter_overlay_lists. * buffer.c (Fdelete_overlay): Don't assume that overlay is in the current buffer. Don't forget to declare the argument a Lisp_Object.

2507:7ba4316ae840

  *next_ptr = next;
  return idx;
}

/* Shift overlays in the current buffer's overlay lists,
   to center the lists at POS.  */

void
recenter_overlay_lists (pos)
     int pos;
{
  Lisp_Object overlay, tail, next, prev, beg, end;

  /* See if anything in overlays_before should move to overlays_after.  */

  /* We don't strictly need prev in this loop; it should always be nil.
     But we use it for symmetry and in case that should cease to be true
     with some future change.  */
  prev = Qnil;
  for (tail = current_buffer->overlays_before;
       CONSP (tail);
       prev = tail, tail = next)
    {
      next = XCONS (tail)->cdr;
      overlay = XCONS (tail)->car;

	{
	  /* Splice the cons cell TAIL out of overlays_before.  */
	  if (!NILP (prev))
	    XCONS (prev)->cdr = next;
	  else
	    current_buffer->overlays_before = next;
	  tail = prev;
	  continue;
	}

      beg = OVERLAY_START (overlay);

	  /* Splice the cons cell TAIL out of overlays_before.  */
	  if (!NILP (prev))
	    XCONS (prev)->cdr = next;
	  else
	    current_buffer->overlays_before = next;

	  /* Search thru overlays_after for where to put it.  */
	  other_prev = Qnil;
	  for (other = current_buffer->overlays_after;
	       CONSP (other);
	       other_prev = other, other = XCONS (other)->cdr)
	    {
	      Lisp_Object otherbeg, otheroverlay, follower;
	      int win;

	  /* Add TAIL to overlays_after before OTHER.  */
	  XCONS (tail)->cdr = other;
	  if (!NILP (other_prev))
	    XCONS (other_prev)->cdr = tail;
	  else
	    current_buffer->overlays_after = tail;
	  tail = prev;
	}
      else
	/* We've reached the things that should stay in overlays_before.
	   All the rest of overlays_before must end even earlier,

	break;
    }

  /* See if anything in overlays_after should be in overlays_before.  */
  prev = Qnil;
  for (tail = current_buffer->overlays_after;
       CONSP (tail);
       prev = tail, tail = next)
    {
      next = XCONS (tail)->cdr;
      overlay = XCONS (tail)->car;

	{
	  /* Splice the cons cell TAIL out of overlays_after.  */
	  if (!NILP (prev))
	    XCONS (prev)->cdr = next;
	  else
	    current_buffer->overlays_after = next;
	  tail = prev;
	  continue;
	}

      beg = OVERLAY_START (overlay);

	  /* Splice the cons cell TAIL out of overlays_after.  */
	  if (!NILP (prev))
	    XCONS (prev)->cdr = next;
	  else
	    current_buffer->overlays_after = next;

	  /* Search thru overlays_before for where to put it.  */
	  other_prev = Qnil;
	  for (other = current_buffer->overlays_before;
	       CONSP (other);
	       other_prev = other, other = XCONS (other)->cdr)
	    {
	      Lisp_Object otherend, otheroverlay;
	      int win;

	  /* Add TAIL to overlays_before before OTHER.  */
	  XCONS (tail)->cdr = other;
	  if (!NILP (other_prev))
	    XCONS (other_prev)->cdr = tail;
	  else
	    current_buffer->overlays_before = tail;
	  tail = prev;
	}
    }

  XFASTINT (current_buffer->overlay_center) = pos;
}

DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 2, 0,
  "Create a new overlay in the current buffer, with range BEG to END.\n\
BEG and END may be integers or markers.")
  (beg, end)
     Lisp_Object beg, end;
{
  Lisp_Object overlay;

  if (MARKERP (beg) && XBUFFER (Fmarker_buffer (beg)) != current_buffer)
    error ("Marker points into wrong buffer");
  if (MARKERP (end) && XBUFFER (Fmarker_buffer (end)) != current_buffer)
    error ("Marker points into wrong buffer");

  overlay = Fcons (Fcons (Fcopy_marker (beg), Fcopy_marker (end)), Qnil);

  /* Put the new overlay on the wrong list.  */ 
  end = OVERLAY_END (overlay);
  if (OVERLAY_POSITION (end) < XINT (current_buffer->overlay_center))
    current_buffer->overlays_after
      = Fcons (overlay, current_buffer->overlays_after);
  else
    current_buffer->overlays_before
      = Fcons (overlay, current_buffer->overlays_before);

  /* This puts it in the right list, and in the right order.  */
  recenter_overlay_lists (XINT (current_buffer->overlay_center));

  return overlay;
}

DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 3, 0,
  "Set the endpoints of OVERLAY to BEG and END.")
  (overlay, beg, end)
     Lisp_Object overlay, beg, end;
{
  if (!OVERLAY_VALID (overlay))
    error ("Invalid overlay object");

  current_buffer->overlays_before
    = Fdelq (overlay, current_buffer->overlays_before);
  current_buffer->overlays_after
    = Fdelq (overlay, current_buffer->overlays_after);

  Fset_marker (OVERLAY_START (overlay), beg, Qnil);
  Fset_marker (OVERLAY_END (overlay), end, Qnil);

  /* Put the overlay on the wrong list.  */ 
  end = OVERLAY_END (overlay);
  if (OVERLAY_POSITION (end) < XINT (current_buffer->overlay_center))
    current_buffer->overlays_after
      = Fcons (overlay, current_buffer->overlays_after);
  else
    current_buffer->overlays_before
      = Fcons (overlay, current_buffer->overlays_before);

  /* This puts it in the right list, and in the right order.  */
  recenter_overlay_lists (XINT (current_buffer->overlay_center));

  return overlay;
}

DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
  "Delete the overlay OVERLAY from the current buffer.")
  (overlay)
{
  current_buffer->overlays_before
    = Fdelq (overlay, current_buffer->overlays_before);
  current_buffer->overlays_after
    = Fdelq (overlay, current_buffer->overlays_after);
  return Qnil;
}

DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
  "Return a list of the overays that contain position POS.")

  (pos)
     Lisp_Object pos;
{
  CHECK_NUMBER_COERCE_MARKER (pos, 0);

  recenter_overlay_lists (XINT (pos));
  return Qnil;
}

DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
  "Get the property of overlay OVERLAY with property name NAME.")

2508:3aa2f3b35353

  *next_ptr = next;
  return idx;
}

/* Shift overlays in BUF's overlay lists, to center the lists at POS.  */

void
recenter_overlay_lists (buf, pos)
     struct buffer *buf;
     int pos;
{
  Lisp_Object overlay, tail, next, prev, beg, end;

  /* See if anything in overlays_before should move to overlays_after.  */

  /* We don't strictly need prev in this loop; it should always be nil.
     But we use it for symmetry and in case that should cease to be true
     with some future change.  */
  prev = Qnil;
  for (tail = buf->overlays_before;
       CONSP (tail);
       prev = tail, tail = next)
    {
      next = XCONS (tail)->cdr;
      overlay = XCONS (tail)->car;

	{
	  /* Splice the cons cell TAIL out of overlays_before.  */
	  if (!NILP (prev))
	    XCONS (prev)->cdr = next;
	  else
	    buf->overlays_before = next;
	  tail = prev;
	  continue;
	}

      beg = OVERLAY_START (overlay);

	  /* Splice the cons cell TAIL out of overlays_before.  */
	  if (!NILP (prev))
	    XCONS (prev)->cdr = next;
	  else
	    buf->overlays_before = next;

	  /* Search thru overlays_after for where to put it.  */
	  other_prev = Qnil;
	  for (other = buf->overlays_after;
	       CONSP (other);
	       other_prev = other, other = XCONS (other)->cdr)
	    {
	      Lisp_Object otherbeg, otheroverlay, follower;
	      int win;

	  /* Add TAIL to overlays_after before OTHER.  */
	  XCONS (tail)->cdr = other;
	  if (!NILP (other_prev))
	    XCONS (other_prev)->cdr = tail;
	  else
	    buf->overlays_after = tail;
	  tail = prev;
	}
      else
	/* We've reached the things that should stay in overlays_before.
	   All the rest of overlays_before must end even earlier,

	break;
    }

  /* See if anything in overlays_after should be in overlays_before.  */
  prev = Qnil;
  for (tail = buf->overlays_after;
       CONSP (tail);
       prev = tail, tail = next)
    {
      next = XCONS (tail)->cdr;
      overlay = XCONS (tail)->car;

	{
	  /* Splice the cons cell TAIL out of overlays_after.  */
	  if (!NILP (prev))
	    XCONS (prev)->cdr = next;
	  else
	    buf->overlays_after = next;
	  tail = prev;
	  continue;
	}

      beg = OVERLAY_START (overlay);

	  /* Splice the cons cell TAIL out of overlays_after.  */
	  if (!NILP (prev))
	    XCONS (prev)->cdr = next;
	  else
	    buf->overlays_after = next;

	  /* Search thru overlays_before for where to put it.  */
	  other_prev = Qnil;
	  for (other = buf->overlays_before;
	       CONSP (other);
	       other_prev = other, other = XCONS (other)->cdr)
	    {
	      Lisp_Object otherend, otheroverlay;
	      int win;

	  /* Add TAIL to overlays_before before OTHER.  */
	  XCONS (tail)->cdr = other;
	  if (!NILP (other_prev))
	    XCONS (other_prev)->cdr = tail;
	  else
	    buf->overlays_before = tail;
	  tail = prev;
	}
    }

  XFASTINT (buf->overlay_center) = pos;
}

DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 3, 0,
  "Create a new overlay with range BEG to END in BUFFER.\n\
If omitted, BUFFER defaults to the current buffer.\n\
BEG and END may be integers or markers.")
  (beg, end, buffer)
     Lisp_Object beg, end, buffer;
{
  Lisp_Object overlay;
  struct buffer *b;

  if (NILP (buffer))
    XSET (buffer, Lisp_Buffer, current_buffer);
  CHECK_BUFFER (buffer, 2);

  b = XBUFFER (buffer);

  if (MARKERP (beg))
    {
      if (! EQ (Fmarker_buffer (beg), buffer))
	error ("Marker points into wrong buffer");
      else
	beg = Fcopy_marker (beg);
    }
  else
    beg = Fset_marker (Fmake_marker (), beg, buffer);
  if (MARKERP (end))
    {
      if (! EQ (Fmarker_buffer (end), buffer))
	error ("Marker points into wrong buffer");
      else
	end = Fcopy_marker (end);
    }
  else
    end = Fset_marker (Fmake_marker (), end, buffer);

  overlay = Fcons (Fcons (beg, end), Qnil);

  /* Put the new overlay on the wrong list.  */ 
  end = OVERLAY_END (overlay);
  if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
    b->overlays_after = Fcons (overlay, b->overlays_after);
  else
    b->overlays_before = Fcons (overlay, b->overlays_before);

  /* This puts it in the right list, and in the right order.  */
  recenter_overlay_lists (b, XINT (b->overlay_center));

  return overlay;
}

DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
  "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
If omitted, don't change OVERLAY's buffer.")
  (overlay, beg, end, buffer)
     Lisp_Object overlay, beg, end, buffer;
{
  struct buffer *b;

  if (!OVERLAY_VALID (overlay))
    error ("Invalid overlay object");

  if (NILP (buffer))
    buffer = Fmarker_buffer (OVERLAY_START (overlay));
  CHECK_BUFFER (buffer, 3);

  b = XBUFFER (buffer);

  b->overlays_before = Fdelq (overlay, b->overlays_before);
  b->overlays_after  = Fdelq (overlay, b->overlays_after);

  Fset_marker (OVERLAY_START (overlay), beg, buffer);
  Fset_marker (OVERLAY_END   (overlay), end, buffer);

  /* Put the overlay on the wrong list.  */ 
  end = OVERLAY_END (overlay);
  if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
    b->overlays_after = Fcons (overlay, b->overlays_after);
  else
    b->overlays_before = Fcons (overlay, b->overlays_before);

  /* This puts it in the right list, and in the right order.  */
  recenter_overlay_lists (b, XINT (b->overlay_center));

  return overlay;
}

DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
  "Delete the overlay OVERLAY from its buffer.")
  (overlay)
     Lisp_Object overlay;
{
  struct buffer *b;

  if (OVERLAY_VALID (overlay))
    b = XBUFFER (Fmarker_buffer (OVERLAY_START (overlay)));
  else
    /* Guess! */
    b = current_buffer;

  b->overlays_before = Fdelq (overlay, b->overlays_before);
  b->overlays_after  = Fdelq (overlay, b->overlays_after);

  return Qnil;
}

DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
  "Return a list of the overays that contain position POS.")

  (pos)
     Lisp_Object pos;
{
  CHECK_NUMBER_COERCE_MARKER (pos, 0);

  recenter_overlay_lists (current_buffer, XINT (pos));
  return Qnil;
}

DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
  "Get the property of overlay OVERLAY with property name NAME.")