insdel.c 23.4 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Buffer insertion/deletion and gap motion for GNU Emacs.
Karl Heuer's avatar
Karl Heuer committed
2
   Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
3 4 5 6 7

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Karl Heuer's avatar
Karl Heuer committed
8
the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
9 10 11 12 13 14 15 16 17
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


22
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
23
#include "lisp.h"
24
#include "intervals.h"
Jim Blandy's avatar
Jim Blandy committed
25 26
#include "buffer.h"
#include "window.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
27
#include "blockinput.h"
Jim Blandy's avatar
Jim Blandy committed
28

29 30
#define min(x, y) ((x) < (y) ? (x) : (y))

31
static void insert_from_string_1 ();
32
static void insert_from_buffer_1 ();
Karl Heuer's avatar
Karl Heuer committed
33 34 35
static void gap_left ();
static void gap_right ();
static void adjust_markers ();
Karl Heuer's avatar
Karl Heuer committed
36
static void adjust_point ();
37

Jim Blandy's avatar
Jim Blandy committed
38 39 40
/* Move gap to position `pos'.
   Note that this can quit!  */

41
void
Jim Blandy's avatar
Jim Blandy committed
42 43 44 45 46 47 48 49 50 51 52 53
move_gap (pos)
     int pos;
{
  if (pos < GPT)
    gap_left (pos, 0);
  else if (pos > GPT)
    gap_right (pos);
}

/* Move the gap to POS, which is less than the current GPT.
   If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged.  */

Karl Heuer's avatar
Karl Heuer committed
54
static void
Jim Blandy's avatar
Jim Blandy committed
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
gap_left (pos, newgap)
     register int pos;
     int newgap;
{
  register unsigned char *to, *from;
  register int i;
  int new_s1;

  pos--;

  if (!newgap)
    {
      if (unchanged_modified == MODIFF)
	{
	  beg_unchanged = pos;
	  end_unchanged = Z - pos - 1;
	}
      else
	{
	  if (Z - GPT < end_unchanged)
	    end_unchanged = Z - GPT;
	  if (pos < beg_unchanged)
	    beg_unchanged = pos;
	}
    }

  i = GPT;
  to = GAP_END_ADDR;
  from = GPT_ADDR;
  new_s1 = GPT - BEG;

  /* Now copy the characters.  To move the gap down,
     copy characters up.  */

  while (1)
    {
      /* I gets number of characters left to copy.  */
      i = new_s1 - pos;
      if (i == 0)
	break;
      /* If a quit is requested, stop copying now.
	 Change POS to be where we have actually moved the gap to.  */
      if (QUITP)
	{
	  pos = new_s1;
	  break;
	}
      /* Move at most 32000 chars before checking again for a quit.  */
      if (i > 32000)
	i = 32000;
#ifdef GAP_USE_BCOPY
      if (i >= 128
	  /* bcopy is safe if the two areas of memory do not overlap
	     or on systems where bcopy is always safe for moving upward.  */
	  && (BCOPY_UPWARD_SAFE
	      || to - from >= 128))
	{
	  /* If overlap is not safe, avoid it by not moving too many
	     characters at once.  */
	  if (!BCOPY_UPWARD_SAFE && i > to - from)
	    i = to - from;
	  new_s1 -= i;
	  from -= i, to -= i;
	  bcopy (from, to, i);
	}
      else
#endif
	{
	  new_s1 -= i;
	  while (--i >= 0)
	    *--to = *--from;
	}
    }

  /* Adjust markers, and buffer data structure, to put the gap at POS.
     POS is where the loop above stopped, which may be what was specified
     or may be where a quit was detected.  */
  adjust_markers (pos + 1, GPT, GAP_SIZE);
  GPT = pos + 1;
  QUIT;
}

Karl Heuer's avatar
Karl Heuer committed
137
static void
Jim Blandy's avatar
Jim Blandy committed
138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212
gap_right (pos)
     register int pos;
{
  register unsigned char *to, *from;
  register int i;
  int new_s1;

  pos--;

  if (unchanged_modified == MODIFF)
    {
      beg_unchanged = pos;
      end_unchanged = Z - pos - 1;
    }
  else
    {
      if (Z - pos - 1 < end_unchanged)
	end_unchanged = Z - pos - 1;
      if (GPT - BEG < beg_unchanged)
	beg_unchanged = GPT - BEG;
    }

  i = GPT;
  from = GAP_END_ADDR;
  to = GPT_ADDR;
  new_s1 = GPT - 1;

  /* Now copy the characters.  To move the gap up,
     copy characters down.  */

  while (1)
    {
      /* I gets number of characters left to copy.  */
      i = pos - new_s1;
      if (i == 0)
	break;
      /* If a quit is requested, stop copying now.
	 Change POS to be where we have actually moved the gap to.  */
      if (QUITP)
	{
	  pos = new_s1;
	  break;
	}
      /* Move at most 32000 chars before checking again for a quit.  */
      if (i > 32000)
	i = 32000;
#ifdef GAP_USE_BCOPY
      if (i >= 128
	  /* bcopy is safe if the two areas of memory do not overlap
	     or on systems where bcopy is always safe for moving downward.  */
	  && (BCOPY_DOWNWARD_SAFE
	      || from - to >= 128))
	{
	  /* If overlap is not safe, avoid it by not moving too many
	     characters at once.  */
	  if (!BCOPY_DOWNWARD_SAFE && i > from - to)
	    i = from - to;
	  new_s1 += i;
	  bcopy (from, to, i);
	  from += i, to += i;
	}
      else
#endif
	{
	  new_s1 += i;
	  while (--i >= 0)
	    *to++ = *from++;
	}
    }

  adjust_markers (GPT + GAP_SIZE, pos + 1 + GAP_SIZE, - GAP_SIZE);
  GPT = pos + 1;
  QUIT;
}

213 214 215
/* Add AMOUNT to the position of every marker in the current buffer
   whose current position is between FROM (exclusive) and TO (inclusive).

Jim Blandy's avatar
Jim Blandy committed
216 217
   Also, any markers past the outside of that interval, in the direction
   of adjustment, are first moved back to the near end of the interval
218 219 220 221 222
   and then adjusted by AMOUNT.

   When the latter adjustment is done, if AMOUNT is negative,
   we record the adjustment for undo.  (This case happens only for
   deletion.)  */
Jim Blandy's avatar
Jim Blandy committed
223

Karl Heuer's avatar
Karl Heuer committed
224
static void
Jim Blandy's avatar
Jim Blandy committed
225 226 227 228 229 230 231
adjust_markers (from, to, amount)
     register int from, to, amount;
{
  Lisp_Object marker;
  register struct Lisp_Marker *m;
  register int mpos;

232
  marker = BUF_MARKERS (current_buffer);
Jim Blandy's avatar
Jim Blandy committed
233

Jim Blandy's avatar
Jim Blandy committed
234
  while (!NILP (marker))
Jim Blandy's avatar
Jim Blandy committed
235 236 237 238 239 240 241 242 243 244
    {
      m = XMARKER (marker);
      mpos = m->bufpos;
      if (amount > 0)
	{
	  if (mpos > to && mpos < to + amount)
	    mpos = to + amount;
	}
      else
	{
245 246 247
	  /* Here's the case where a marker is inside text being deleted.
	     AMOUNT can be negative for gap motion, too,
	     but then this range contains no markers.  */
Jim Blandy's avatar
Jim Blandy committed
248
	  if (mpos > from + amount && mpos <= from)
249 250 251 252
	    {
	      record_marker_adjustment (marker, from + amount - mpos);
	      mpos = from + amount;
	    }
Jim Blandy's avatar
Jim Blandy committed
253 254 255 256 257 258 259
	}
      if (mpos > from && mpos <= to)
	mpos += amount;
      m->bufpos = mpos;
      marker = m->chain;
    }
}
Karl Heuer's avatar
Karl Heuer committed
260

261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
/* Adjust markers whose insertion-type is t
   for an insertion of AMOUNT characters at POS.  */

static void
adjust_markers_for_insert (pos, amount)
     register int pos, amount;
{
  Lisp_Object marker;

  marker = BUF_MARKERS (current_buffer);

  while (!NILP (marker))
    {
      register struct Lisp_Marker *m = XMARKER (marker);
      if (m->insertion_type && m->bufpos == pos)
	m->bufpos += amount;
      marker = m->chain;
    }
}

Karl Heuer's avatar
Karl Heuer committed
281 282 283 284 285
/* Add the specified amount to point.  This is used only when the value
   of point changes due to an insert or delete; it does not represent
   a conceptual change in point as a marker.  In particular, point is
   not crossing any interval boundaries, so there's no need to use the
   usual SET_PT macro.  In fact it would be incorrect to do so, because
Karl Heuer's avatar
Karl Heuer committed
286
   either the old or the new value of point is out of sync with the
Karl Heuer's avatar
Karl Heuer committed
287 288 289
   current set of intervals.  */
static void
adjust_point (amount)
290
     int amount;
Karl Heuer's avatar
Karl Heuer committed
291
{
292
  BUF_PT (current_buffer) += amount;
Karl Heuer's avatar
Karl Heuer committed
293
}
Jim Blandy's avatar
Jim Blandy committed
294 295 296

/* Make the gap INCREMENT characters longer.  */

297
void
Jim Blandy's avatar
Jim Blandy committed
298 299 300 301 302 303 304 305 306 307 308
make_gap (increment)
     int increment;
{
  unsigned char *result;
  Lisp_Object tem;
  int real_gap_loc;
  int old_gap_size;

  /* If we have to get more space, get enough to last a while.  */
  increment += 2000;

309 310 311 312
  /* Don't allow a buffer size that won't fit in an int
     even if it will fit in a Lisp integer.
     That won't work because so many places use `int'.  */
     
313
  if (Z - BEG + GAP_SIZE + increment
314
      >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1)))
315
    error ("Buffer exceeds maximum size");
316

317
  BLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
318
  result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment));
319

Jim Blandy's avatar
Jim Blandy committed
320
  if (result == 0)
321 322 323 324 325 326
    {
      UNBLOCK_INPUT;
      memory_full ();
    }

  /* We can't unblock until the new address is properly stored.  */
Jim Blandy's avatar
Jim Blandy committed
327
  BEG_ADDR = result;
328
  UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352

  /* Prevent quitting in move_gap.  */
  tem = Vinhibit_quit;
  Vinhibit_quit = Qt;

  real_gap_loc = GPT;
  old_gap_size = GAP_SIZE;

  /* Call the newly allocated space a gap at the end of the whole space.  */
  GPT = Z + GAP_SIZE;
  GAP_SIZE = increment;

  /* Move the new gap down to be consecutive with the end of the old one.
     This adjusts the markers properly too.  */
  gap_left (real_gap_loc + old_gap_size, 1);

  /* Now combine the two into one large gap.  */
  GAP_SIZE += old_gap_size;
  GPT = real_gap_loc;

  Vinhibit_quit = tem;
}

/* Insert a string of specified length before point.
353 354
   DO NOT use this for the contents of a Lisp string or a Lisp buffer!
   prepare_to_modify_buffer could relocate the text.  */
Jim Blandy's avatar
Jim Blandy committed
355

356
void
Jim Blandy's avatar
Jim Blandy committed
357 358 359 360
insert (string, length)
     register unsigned char *string;
     register length;
{
361 362
  if (length > 0)
    {
363
      insert_1 (string, length, 0, 1);
364 365 366 367
      signal_after_change (PT-length, 0, length);
    }
}

368
void
369 370 371 372 373 374
insert_and_inherit (string, length)
     register unsigned char *string;
     register length;
{
  if (length > 0)
    {
375
      insert_1 (string, length, 1, 1);
Karl Heuer's avatar
Karl Heuer committed
376
      signal_after_change (PT-length, 0, length);
377 378
    }
}
Jim Blandy's avatar
Jim Blandy committed
379

380 381
void
insert_1 (string, length, inherit, prepare)
382
     register unsigned char *string;
383 384
     register int length;
     int inherit, prepare;
385 386
{
  register Lisp_Object temp;
Jim Blandy's avatar
Jim Blandy committed
387

388 389
  if (prepare)
    prepare_to_modify_buffer (PT, PT);
Jim Blandy's avatar
Jim Blandy committed
390

Karl Heuer's avatar
Karl Heuer committed
391 392
  if (PT != GPT)
    move_gap (PT);
Jim Blandy's avatar
Jim Blandy committed
393 394 395
  if (GAP_SIZE < length)
    make_gap (length - GAP_SIZE);

Karl Heuer's avatar
Karl Heuer committed
396
  record_insert (PT, length);
Jim Blandy's avatar
Jim Blandy committed
397 398 399 400
  MODIFF++;

  bcopy (string, GPT_ADDR, length);

401
#ifdef USE_TEXT_PROPERTIES
402
  if (BUF_INTERVALS (current_buffer) != 0)
403 404 405
    /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES.  */
    offset_intervals (current_buffer, PT, length);
#endif
406

Jim Blandy's avatar
Jim Blandy committed
407 408 409 410
  GAP_SIZE -= length;
  GPT += length;
  ZV += length;
  Z += length;
411
  adjust_overlays_for_insert (PT, length);
412
  adjust_markers_for_insert (PT, length);
Karl Heuer's avatar
Karl Heuer committed
413
  adjust_point (length);
414

415
#ifdef USE_TEXT_PROPERTIES
416
  if (!inherit && BUF_INTERVALS (current_buffer) != 0)
417 418
    Fset_text_properties (make_number (PT - length), make_number (PT),
			  Qnil, Qnil);
419
#endif
Jim Blandy's avatar
Jim Blandy committed
420 421
}

422 423 424 425 426 427
/* Insert the part of the text of STRING, a Lisp object assumed to be
   of type string, consisting of the LENGTH characters starting at
   position POS.  If the text of STRING has properties, they are absorbed
   into the buffer.

   It does not work to use `insert' for this, because a GC could happen
Jim Blandy's avatar
Jim Blandy committed
428 429
   before we bcopy the stuff into the buffer, and relocate the string
   without insert noticing.  */
430

431
void
432
insert_from_string (string, pos, length, inherit)
Jim Blandy's avatar
Jim Blandy committed
433 434
     Lisp_Object string;
     register int pos, length;
435
     int inherit;
436 437 438 439
{
  if (length > 0)
    {
      insert_from_string_1 (string, pos, length, inherit);
Karl Heuer's avatar
Karl Heuer committed
440
      signal_after_change (PT-length, 0, length);
441 442 443 444 445 446 447 448
    }
}

static void
insert_from_string_1 (string, pos, length, inherit)
     Lisp_Object string;
     register int pos, length;
     int inherit;
Jim Blandy's avatar
Jim Blandy committed
449 450 451 452 453
{
  register Lisp_Object temp;
  struct gcpro gcpro1;

  /* Make sure point-max won't overflow after this insertion.  */
454
  XSETINT (temp, length + Z);
Jim Blandy's avatar
Jim Blandy committed
455 456 457 458
  if (length + Z != XINT (temp))
    error ("maximum buffer size exceeded");

  GCPRO1 (string);
Karl Heuer's avatar
Karl Heuer committed
459
  prepare_to_modify_buffer (PT, PT);
Jim Blandy's avatar
Jim Blandy committed
460

Karl Heuer's avatar
Karl Heuer committed
461 462
  if (PT != GPT)
    move_gap (PT);
Jim Blandy's avatar
Jim Blandy committed
463 464 465
  if (GAP_SIZE < length)
    make_gap (length - GAP_SIZE);

Karl Heuer's avatar
Karl Heuer committed
466
  record_insert (PT, length);
Jim Blandy's avatar
Jim Blandy committed
467 468 469 470 471
  MODIFF++;
  UNGCPRO;

  bcopy (XSTRING (string)->data, GPT_ADDR, length);

472
  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
Karl Heuer's avatar
Karl Heuer committed
473
  offset_intervals (current_buffer, PT, length);
474

Jim Blandy's avatar
Jim Blandy committed
475 476 477 478
  GAP_SIZE -= length;
  GPT += length;
  ZV += length;
  Z += length;
479
  adjust_overlays_for_insert (PT, length);
480
  adjust_markers_for_insert (PT, length);
481 482

  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
Karl Heuer's avatar
Karl Heuer committed
483
  graft_intervals_into_buffer (XSTRING (string)->intervals, PT, length,
484
			       current_buffer, inherit);
485

Karl Heuer's avatar
Karl Heuer committed
486
  adjust_point (length);
Jim Blandy's avatar
Jim Blandy committed
487 488
}

489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534
/* Insert text from BUF, starting at POS and having length LENGTH, into the
   current buffer.  If the text in BUF has properties, they are absorbed
   into the current buffer.

   It does not work to use `insert' for this, because a malloc could happen
   and relocate BUF's text before the bcopy happens.  */

void
insert_from_buffer (buf, pos, length, inherit)
     struct buffer *buf;
     int pos, length;
     int inherit;
{
  if (length > 0)
    {
      insert_from_buffer_1 (buf, pos, length, inherit);
      signal_after_change (PT-length, 0, length);
    }
}

static void
insert_from_buffer_1 (buf, pos, length, inherit)
     struct buffer *buf;
     int pos, length;
     int inherit;
{
  register Lisp_Object temp;
  int chunk;

  /* Make sure point-max won't overflow after this insertion.  */
  XSETINT (temp, length + Z);
  if (length + Z != XINT (temp))
    error ("maximum buffer size exceeded");

  prepare_to_modify_buffer (PT, PT);

  if (PT != GPT)
    move_gap (PT);
  if (GAP_SIZE < length)
    make_gap (length - GAP_SIZE);

  record_insert (PT, length);
  MODIFF++;

  if (pos < BUF_GPT (buf))
    {
535 536 537
      chunk = BUF_GPT (buf) - pos;
      if (chunk > length)
	chunk = length;
538 539 540 541 542 543 544 545 546
      bcopy (BUF_CHAR_ADDRESS (buf, pos), GPT_ADDR, chunk);
    }
  else
    chunk = 0;
  if (chunk < length)
    bcopy (BUF_CHAR_ADDRESS (buf, pos + chunk),
	   GPT_ADDR + chunk, length - chunk);

#ifdef USE_TEXT_PROPERTIES
547
  if (BUF_INTERVALS (current_buffer) != 0)
548 549 550 551 552 553 554
    offset_intervals (current_buffer, PT, length);
#endif

  GAP_SIZE -= length;
  GPT += length;
  ZV += length;
  Z += length;
555
  adjust_overlays_for_insert (PT, length);
556
  adjust_markers_for_insert (PT, length);
557 558 559
  adjust_point (length);

  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
560 561
  graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf),
					       pos, length),
562 563 564
			       PT - length, length, current_buffer, inherit);
}

Jim Blandy's avatar
Jim Blandy committed
565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587
/* Insert the character C before point */

void
insert_char (c)
     unsigned char c;
{
  insert (&c, 1);
}

/* Insert the null-terminated string S before point */

void
insert_string (s)
     char *s;
{
  insert (s, strlen (s));
}

/* Like `insert' except that all markers pointing at the place where
   the insertion happens are adjusted to point after it.
   Don't use this function to insert part of a Lisp string,
   since gc could happen and relocate it.  */

588
void
Jim Blandy's avatar
Jim Blandy committed
589 590 591 592
insert_before_markers (string, length)
     unsigned char *string;
     register int length;
{
593 594
  if (length > 0)
    {
Karl Heuer's avatar
Karl Heuer committed
595
      register int opoint = PT;
596
      insert_1 (string, length, 0, 1);
597
      adjust_markers (opoint - 1, opoint, length);
Karl Heuer's avatar
Karl Heuer committed
598
      signal_after_change (PT-length, 0, length);
599
    }
Jim Blandy's avatar
Jim Blandy committed
600 601
}

602
void
603 604 605 606 607 608 609
insert_before_markers_and_inherit (string, length)
     unsigned char *string;
     register int length;
{
  if (length > 0)
    {
      register int opoint = PT;
610
      insert_1 (string, length, 1, 1);
611 612 613 614 615
      adjust_markers (opoint - 1, opoint, length);
      signal_after_change (PT-length, 0, length);
    }
}

Jim Blandy's avatar
Jim Blandy committed
616 617
/* Insert part of a Lisp string, relocating markers after.  */

618
void
619
insert_from_string_before_markers (string, pos, length, inherit)
Jim Blandy's avatar
Jim Blandy committed
620 621
     Lisp_Object string;
     register int pos, length;
622
     int inherit;
Jim Blandy's avatar
Jim Blandy committed
623
{
624 625
  if (length > 0)
    {
Karl Heuer's avatar
Karl Heuer committed
626
      register int opoint = PT;
627 628
      insert_from_string_1 (string, pos, length, inherit);
      adjust_markers (opoint - 1, opoint, length);
Karl Heuer's avatar
Karl Heuer committed
629
      signal_after_change (PT-length, 0, length);
630
    }
Jim Blandy's avatar
Jim Blandy committed
631 632 633 634 635
}

/* Delete characters in current buffer
   from FROM up to (but not including) TO.  */

636
void
Jim Blandy's avatar
Jim Blandy committed
637 638
del_range (from, to)
     register int from, to;
639
{
640
  del_range_1 (from, to, 1);
641 642 643 644
}

/* Like del_range; PREPARE says whether to call prepare_to_modify_buffer.  */

645
void
646 647
del_range_1 (from, to, prepare)
     register int from, to, prepare;
Jim Blandy's avatar
Jim Blandy committed
648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665
{
  register int numdel;

  /* Make args be valid */
  if (from < BEGV)
    from = BEGV;
  if (to > ZV)
    to = ZV;

  if ((numdel = to - from) <= 0)
    return;

  /* Make sure the gap is somewhere in or next to what we are deleting.  */
  if (from > GPT)
    gap_right (from);
  if (to < GPT)
    gap_left (to, 0);

666 667
  if (prepare)
    prepare_to_modify_buffer (from, to);
Jim Blandy's avatar
Jim Blandy committed
668

669 670 671 672 673 674
  /* Relocate all markers pointing into the new, larger gap
     to point at the end of the text before the gap.
     This has to be done before recording the deletion,
     so undo handles this after reinserting the text.  */
  adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);

675 676 677
  record_delete (from, numdel);
  MODIFF++;

Jim Blandy's avatar
Jim Blandy committed
678
  /* Relocate point as if it were a marker.  */
Karl Heuer's avatar
Karl Heuer committed
679
  if (from < PT)
Karl Heuer's avatar
Karl Heuer committed
680
    adjust_point (from - (PT < to ? PT : to));
Jim Blandy's avatar
Jim Blandy committed
681

682
  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
683
  offset_intervals (current_buffer, from, - numdel);
684

685
  /* Adjust the overlay center as needed.  This must be done after
Karl Heuer's avatar
Karl Heuer committed
686
     adjusting the markers that bound the overlays.  */
687 688
  adjust_overlays_for_delete (from, numdel);

Jim Blandy's avatar
Jim Blandy committed
689 690 691 692 693 694 695 696 697 698
  GAP_SIZE += numdel;
  ZV -= numdel;
  Z -= numdel;
  GPT = from;

  if (GPT - BEG < beg_unchanged)
    beg_unchanged = GPT - BEG;
  if (Z - GPT < end_unchanged)
    end_unchanged = Z - GPT;

699
  evaporate_overlays (from);
Jim Blandy's avatar
Jim Blandy committed
700 701 702
  signal_after_change (from, numdel, 0);
}

703 704 705 706
/* Call this if you're about to change the region of BUFFER from START
   to END.  This checks the read-only properties of the region, calls
   the necessary modification hooks, and warns the next redisplay that
   it should pay attention to that area.  */
707
void
708 709
modify_region (buffer, start, end)
     struct buffer *buffer;
Jim Blandy's avatar
Jim Blandy committed
710 711
     int start, end;
{
712 713 714 715 716
  struct buffer *old_buffer = current_buffer;

  if (buffer != old_buffer)
    set_buffer_internal (buffer);

Jim Blandy's avatar
Jim Blandy committed
717 718 719 720 721 722 723
  prepare_to_modify_buffer (start, end);

  if (start - 1 < beg_unchanged || unchanged_modified == MODIFF)
    beg_unchanged = start - 1;
  if (Z - end < end_unchanged
      || unchanged_modified == MODIFF)
    end_unchanged = Z - end;
724

725
  if (MODIFF <= SAVE_MODIFF)
726
    record_first_change ();
Jim Blandy's avatar
Jim Blandy committed
727
  MODIFF++;
728

729 730
  buffer->point_before_scroll = Qnil;

731 732
  if (buffer != old_buffer)
    set_buffer_internal (old_buffer);
Jim Blandy's avatar
Jim Blandy committed
733 734 735
}

/* Check that it is okay to modify the buffer between START and END.
736 737 738
   Run the before-change-function, if any.  If intervals are in use,
   verify that the text to be modified is not read-only, and call
   any modification properties the text may have. */
Jim Blandy's avatar
Jim Blandy committed
739

740
void
Jim Blandy's avatar
Jim Blandy committed
741
prepare_to_modify_buffer (start, end)
742
     int start, end;
Jim Blandy's avatar
Jim Blandy committed
743
{
Jim Blandy's avatar
Jim Blandy committed
744
  if (!NILP (current_buffer->read_only))
Jim Blandy's avatar
Jim Blandy committed
745 746
    Fbarf_if_buffer_read_only ();

747
  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
748
  if (BUF_INTERVALS (current_buffer) != 0)
749
    verify_interval_modification (current_buffer, start, end);
Jim Blandy's avatar
Jim Blandy committed
750 751

#ifdef CLASH_DETECTION
752
  if (!NILP (current_buffer->file_truename)
753 754
      /* Make binding buffer-file-name to nil effective.  */
      && !NILP (current_buffer->filename)
755
      && SAVE_MODIFF >= MODIFF)
756
    lock_file (current_buffer->file_truename);
Jim Blandy's avatar
Jim Blandy committed
757 758
#else
  /* At least warn if this file has changed on disk since it was visited.  */
Jim Blandy's avatar
Jim Blandy committed
759
  if (!NILP (current_buffer->filename)
760
      && SAVE_MODIFF >= MODIFF
Jim Blandy's avatar
Jim Blandy committed
761 762
      && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
      && !NILP (Ffile_exists_p (current_buffer->filename)))
Jim Blandy's avatar
Jim Blandy committed
763 764 765 766 767
    call1 (intern ("ask-user-about-supersession-threat"),
	   current_buffer->filename);
#endif /* not CLASH_DETECTION */

  signal_before_change (start, end);
768

769 770 771 772 773 774 775 776 777
  if (current_buffer->newline_cache)
    invalidate_region_cache (current_buffer,
                             current_buffer->newline_cache,
                             start - BEG, Z - end);
  if (current_buffer->width_run_cache)
    invalidate_region_cache (current_buffer,
                             current_buffer->width_run_cache,
                             start - BEG, Z - end);

778
  Vdeactivate_mark = Qt;
Jim Blandy's avatar
Jim Blandy committed
779 780
}

781
/* Signal a change to the buffer immediately before it happens.
782
   START_INT and END_INT are the bounds of the text to be changed.  */
Jim Blandy's avatar
Jim Blandy committed
783

784
void
785 786
signal_before_change (start_int, end_int)
     int start_int, end_int;
Jim Blandy's avatar
Jim Blandy committed
787
{
788 789 790 791 792
  Lisp_Object start, end;

  start = make_number (start_int);
  end = make_number (end_int);

Jim Blandy's avatar
Jim Blandy committed
793
  /* If buffer is unmodified, run a special hook for that case.  */
794
  if (SAVE_MODIFF >= MODIFF
Jim Blandy's avatar
Jim Blandy committed
795 796 797 798
      && !NILP (Vfirst_change_hook)
      && !NILP (Vrun_hooks))
    call1 (Vrun_hooks, Qfirst_change_hook);

799 800 801
  /* Run the before-change-function if any.
     We don't bother "binding" this variable to nil
     because it is obsolete anyway and new code should not use it.  */
Jim Blandy's avatar
Jim Blandy committed
802
  if (!NILP (Vbefore_change_function))
803
    call2 (Vbefore_change_function, start, end);
804

805
  /* Now run the before-change-functions if any.  */
806 807
  if (!NILP (Vbefore_change_functions))
    {
808 809 810 811 812 813 814 815 816 817
      Lisp_Object args[3];
      Lisp_Object before_change_functions;
      Lisp_Object after_change_functions;
      struct gcpro gcpro1, gcpro2;

      /* "Bind" before-change-functions and after-change-functions
	 to nil--but in a way that errors don't know about.
	 That way, if there's an error in them, they will stay nil.  */
      before_change_functions = Vbefore_change_functions;
      after_change_functions = Vafter_change_functions;
818 819
      Vbefore_change_functions = Qnil;
      Vafter_change_functions = Qnil;
820 821 822 823 824 825 826 827 828 829 830 831
      GCPRO2 (before_change_functions, after_change_functions);

      /* Actually run the hook functions.  */
      args[0] = Qbefore_change_functions;
      args[1] = start;
      args[2] = end;
      run_hook_list_with_args (before_change_functions, 3, args);

      /* "Unbind" the variables we "bound" to nil.  */
      Vbefore_change_functions = before_change_functions;
      Vafter_change_functions = after_change_functions;
      UNGCPRO;
832
    }
833 834 835

  if (!NILP (current_buffer->overlays_before)
      || !NILP (current_buffer->overlays_after))
836
    report_overlay_modification (start, end, 0, start, end, Qnil);
Jim Blandy's avatar
Jim Blandy committed
837 838
}

839
/* Signal a change immediately after it happens.
Jim Blandy's avatar
Jim Blandy committed
840 841 842
   POS is the address of the start of the changed text.
   LENDEL is the number of characters of the text before the change.
   (Not the whole buffer; just the part that was changed.)
843 844
   LENINS is the number of characters in that part of the text
   after the change.  */
Jim Blandy's avatar
Jim Blandy committed
845

846
void
Jim Blandy's avatar
Jim Blandy committed
847 848 849
signal_after_change (pos, lendel, lenins)
     int pos, lendel, lenins;
{
850 851 852
  /* Run the after-change-function if any.
     We don't bother "binding" this variable to nil
     because it is obsolete anyway and new code should not use it.  */
Jim Blandy's avatar
Jim Blandy committed
853
  if (!NILP (Vafter_change_function))
854 855 856
    call3 (Vafter_change_function,
	   make_number (pos), make_number (pos + lenins),
	   make_number (lendel));
Jim Blandy's avatar
Jim Blandy committed
857

858 859
  if (!NILP (Vafter_change_functions))
    {
860 861 862 863 864 865 866 867 868 869
      Lisp_Object args[4];
      Lisp_Object before_change_functions;
      Lisp_Object after_change_functions;
      struct gcpro gcpro1, gcpro2;

      /* "Bind" before-change-functions and after-change-functions
	 to nil--but in a way that errors don't know about.
	 That way, if there's an error in them, they will stay nil.  */
      before_change_functions = Vbefore_change_functions;
      after_change_functions = Vafter_change_functions;
870 871
      Vbefore_change_functions = Qnil;
      Vafter_change_functions = Qnil;
872 873 874 875 876 877 878 879 880 881 882 883 884 885
      GCPRO2 (before_change_functions, after_change_functions);

      /* Actually run the hook functions.  */
      args[0] = Qafter_change_functions;
      XSETFASTINT (args[1], pos);
      XSETFASTINT (args[2], pos + lenins);
      XSETFASTINT (args[3], lendel);
      run_hook_list_with_args (after_change_functions,
			       4, args);

      /* "Unbind" the variables we "bound" to nil.  */
      Vbefore_change_functions = before_change_functions;
      Vafter_change_functions = after_change_functions;
      UNGCPRO;
886
    }
887 888 889

  if (!NILP (current_buffer->overlays_before)
      || !NILP (current_buffer->overlays_after))
890
    report_overlay_modification (make_number (pos),
891
				 make_number (pos + lenins),
892 893 894
				 1,
				 make_number (pos), make_number (pos + lenins),
				 make_number (lendel));
895 896 897 898 899

  /* After an insertion, call the text properties
     insert-behind-hooks or insert-in-front-hooks.  */
  if (lendel == 0)
    report_interval_modification (pos, pos + lenins);
Jim Blandy's avatar
Jim Blandy committed
900
}