insdel.c 28.5 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
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
26
#include "charset.h"
Jim Blandy's avatar
Jim Blandy committed
27
#include "window.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
28
#include "blockinput.h"
Jim Blandy's avatar
Jim Blandy committed
29

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

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

39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
Lisp_Object Fcombine_after_change_execute ();

/* Non-nil means don't call the after-change-functions right away,
   just record an element in Vcombine_after_change_calls_list.  */
Lisp_Object Vcombine_after_change_calls;

/* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
   describing changes which happened while combine_after_change_calls
   was nonzero.  We use this to decide how to call them
   once the deferral ends.

   In each element.
   BEG-UNCHANGED is the number of chars before the changed range.
   END-UNCHANGED is the number of chars after the changed range,
   and CHANGE-AMOUNT is the number of characters inserted by the change
   (negative for a deletion).  */
Lisp_Object combine_after_change_list;

/* Buffer which combine_after_change_list is about.  */
Lisp_Object combine_after_change_buffer;

Jim Blandy's avatar
Jim Blandy committed
60 61 62
/* Move gap to position `pos'.
   Note that this can quit!  */

63
void
Jim Blandy's avatar
Jim Blandy committed
64 65 66 67 68 69 70 71 72 73 74 75
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
76
static void
Jim Blandy's avatar
Jim Blandy committed
77 78 79 80 81 82 83 84 85 86 87 88
gap_left (pos, newgap)
     register int pos;
     int newgap;
{
  register unsigned char *to, *from;
  register int i;
  int new_s1;

  pos--;

  if (!newgap)
    {
89 90
      if (unchanged_modified == MODIFF
	  && overlay_unchanged_modified == OVERLAY_MODIFF)
Jim Blandy's avatar
Jim Blandy committed
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 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
	{
	  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;
Karl Heuer's avatar
Karl Heuer committed
157
  if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor.  */
Jim Blandy's avatar
Jim Blandy committed
158 159 160
  QUIT;
}

Karl Heuer's avatar
Karl Heuer committed
161
static void
Jim Blandy's avatar
Jim Blandy committed
162 163 164 165 166 167 168 169 170
gap_right (pos)
     register int pos;
{
  register unsigned char *to, *from;
  register int i;
  int new_s1;

  pos--;

171 172 173
  if (unchanged_modified == MODIFF
      && overlay_unchanged_modified == OVERLAY_MODIFF)

Jim Blandy's avatar
Jim Blandy committed
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 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
    {
      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;
Karl Heuer's avatar
Karl Heuer committed
236
  if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor.  */
Jim Blandy's avatar
Jim Blandy committed
237 238 239
  QUIT;
}

240 241 242
/* 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
243 244
   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
245 246 247 248 249
   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
250

Karl Heuer's avatar
Karl Heuer committed
251
static void
Jim Blandy's avatar
Jim Blandy committed
252 253 254 255 256 257 258
adjust_markers (from, to, amount)
     register int from, to, amount;
{
  Lisp_Object marker;
  register struct Lisp_Marker *m;
  register int mpos;

259
  marker = BUF_MARKERS (current_buffer);
Jim Blandy's avatar
Jim Blandy committed
260

Jim Blandy's avatar
Jim Blandy committed
261
  while (!NILP (marker))
Jim Blandy's avatar
Jim Blandy committed
262 263 264 265 266 267 268 269 270 271
    {
      m = XMARKER (marker);
      mpos = m->bufpos;
      if (amount > 0)
	{
	  if (mpos > to && mpos < to + amount)
	    mpos = to + amount;
	}
      else
	{
272 273 274
	  /* 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
275
	  if (mpos > from + amount && mpos <= from)
276 277 278 279
	    {
	      record_marker_adjustment (marker, from + amount - mpos);
	      mpos = from + amount;
	    }
Jim Blandy's avatar
Jim Blandy committed
280 281 282 283 284 285 286
	}
      if (mpos > from && mpos <= to)
	mpos += amount;
      m->bufpos = mpos;
      marker = m->chain;
    }
}
Karl Heuer's avatar
Karl Heuer committed
287

288 289 290 291 292 293 294 295
/* 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;
Karl Heuer's avatar
Karl Heuer committed
296
  int adjusted = 0;
297 298 299 300 301 302 303

  marker = BUF_MARKERS (current_buffer);

  while (!NILP (marker))
    {
      register struct Lisp_Marker *m = XMARKER (marker);
      if (m->insertion_type && m->bufpos == pos)
Karl Heuer's avatar
Karl Heuer committed
304 305 306 307
	{
	  m->bufpos += amount;
	  adjusted = 1;
	}
308 309
      marker = m->chain;
    }
Karl Heuer's avatar
Karl Heuer committed
310 311 312 313
  if (adjusted)
    /* Adjusting only markers whose insertion-type is t may result in
       disordered overlays in the slot `overlays_before'.  */
    fix_overlays_before (current_buffer, pos, pos + amount);
314 315
}

Karl Heuer's avatar
Karl Heuer committed
316 317 318 319 320
/* 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
321
   either the old or the new value of point is out of sync with the
Karl Heuer's avatar
Karl Heuer committed
322 323 324
   current set of intervals.  */
static void
adjust_point (amount)
325
     int amount;
Karl Heuer's avatar
Karl Heuer committed
326
{
327
  BUF_PT (current_buffer) += amount;
Karl Heuer's avatar
Karl Heuer committed
328
}
Jim Blandy's avatar
Jim Blandy committed
329 330 331

/* Make the gap INCREMENT characters longer.  */

332
void
Jim Blandy's avatar
Jim Blandy committed
333 334 335 336 337 338 339 340 341 342 343
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;

344 345 346 347
  /* 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'.  */
     
348
  if (Z - BEG + GAP_SIZE + increment
349
      >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1)))
350
    error ("Buffer exceeds maximum size");
351

352
  BLOCK_INPUT;
Karl Heuer's avatar
Karl Heuer committed
353 354
  /* We allocate extra 1-byte `\0' at the tail for anchoring a search.  */
  result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment + 1));
355

Jim Blandy's avatar
Jim Blandy committed
356
  if (result == 0)
357 358 359 360 361 362
    {
      UNBLOCK_INPUT;
      memory_full ();
    }

  /* We can't unblock until the new address is properly stored.  */
Jim Blandy's avatar
Jim Blandy committed
363
  BEG_ADDR = result;
364
  UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384

  /* 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;

Karl Heuer's avatar
Karl Heuer committed
385 386 387
  /* Put an anchor.  */
  *(Z_ADDR) = 0;

Jim Blandy's avatar
Jim Blandy committed
388 389 390 391
  Vinhibit_quit = tem;
}

/* Insert a string of specified length before point.
392 393
   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
394

395
void
Jim Blandy's avatar
Jim Blandy committed
396 397 398 399
insert (string, length)
     register unsigned char *string;
     register length;
{
400 401
  if (length > 0)
    {
402
      insert_1 (string, length, 0, 1);
403 404 405 406
      signal_after_change (PT-length, 0, length);
    }
}

407
void
408 409 410 411 412 413
insert_and_inherit (string, length)
     register unsigned char *string;
     register length;
{
  if (length > 0)
    {
414
      insert_1 (string, length, 1, 1);
Karl Heuer's avatar
Karl Heuer committed
415
      signal_after_change (PT-length, 0, length);
416 417
    }
}
Jim Blandy's avatar
Jim Blandy committed
418

419 420
void
insert_1 (string, length, inherit, prepare)
421
     register unsigned char *string;
422 423
     register int length;
     int inherit, prepare;
424 425
{
  register Lisp_Object temp;
Jim Blandy's avatar
Jim Blandy committed
426

427 428
  if (prepare)
    prepare_to_modify_buffer (PT, PT);
Jim Blandy's avatar
Jim Blandy committed
429

Karl Heuer's avatar
Karl Heuer committed
430 431
  if (PT != GPT)
    move_gap (PT);
Jim Blandy's avatar
Jim Blandy committed
432 433 434
  if (GAP_SIZE < length)
    make_gap (length - GAP_SIZE);

Karl Heuer's avatar
Karl Heuer committed
435
  record_insert (PT, length);
Jim Blandy's avatar
Jim Blandy committed
436 437 438 439
  MODIFF++;

  bcopy (string, GPT_ADDR, length);

440
#ifdef USE_TEXT_PROPERTIES
441
  if (BUF_INTERVALS (current_buffer) != 0)
442 443 444
    /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES.  */
    offset_intervals (current_buffer, PT, length);
#endif
445

Jim Blandy's avatar
Jim Blandy committed
446 447 448 449
  GAP_SIZE -= length;
  GPT += length;
  ZV += length;
  Z += length;
Karl Heuer's avatar
Karl Heuer committed
450
  if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor.  */
451
  adjust_overlays_for_insert (PT, length);
452
  adjust_markers_for_insert (PT, length);
Karl Heuer's avatar
Karl Heuer committed
453
  adjust_point (length);
454

455
#ifdef USE_TEXT_PROPERTIES
456
  if (!inherit && BUF_INTERVALS (current_buffer) != 0)
457 458
    Fset_text_properties (make_number (PT - length), make_number (PT),
			  Qnil, Qnil);
459
#endif
Jim Blandy's avatar
Jim Blandy committed
460 461
}

462 463 464 465 466 467
/* 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
468 469
   before we bcopy the stuff into the buffer, and relocate the string
   without insert noticing.  */
470

471
void
472
insert_from_string (string, pos, length, inherit)
Jim Blandy's avatar
Jim Blandy committed
473 474
     Lisp_Object string;
     register int pos, length;
475
     int inherit;
476 477 478 479
{
  if (length > 0)
    {
      insert_from_string_1 (string, pos, length, inherit);
Karl Heuer's avatar
Karl Heuer committed
480
      signal_after_change (PT-length, 0, length);
481 482 483 484 485 486 487 488
    }
}

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
489 490 491 492 493
{
  register Lisp_Object temp;
  struct gcpro gcpro1;

  /* Make sure point-max won't overflow after this insertion.  */
494
  XSETINT (temp, length + Z);
Jim Blandy's avatar
Jim Blandy committed
495 496 497 498
  if (length + Z != XINT (temp))
    error ("maximum buffer size exceeded");

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

Karl Heuer's avatar
Karl Heuer committed
501 502
  if (PT != GPT)
    move_gap (PT);
Jim Blandy's avatar
Jim Blandy committed
503 504 505
  if (GAP_SIZE < length)
    make_gap (length - GAP_SIZE);

Karl Heuer's avatar
Karl Heuer committed
506
  record_insert (PT, length);
Jim Blandy's avatar
Jim Blandy committed
507 508 509 510 511
  MODIFF++;
  UNGCPRO;

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

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

Jim Blandy's avatar
Jim Blandy committed
515 516 517 518
  GAP_SIZE -= length;
  GPT += length;
  ZV += length;
  Z += length;
Karl Heuer's avatar
Karl Heuer committed
519
  if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor.  */
520
  adjust_overlays_for_insert (PT, length);
521
  adjust_markers_for_insert (PT, length);
522 523

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

Karl Heuer's avatar
Karl Heuer committed
527
  adjust_point (length);
Jim Blandy's avatar
Jim Blandy committed
528 529
}

530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575
/* 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))
    {
576 577 578
      chunk = BUF_GPT (buf) - pos;
      if (chunk > length)
	chunk = length;
579 580 581 582 583 584 585 586 587
      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
588
  if (BUF_INTERVALS (current_buffer) != 0)
589 590 591 592 593 594 595
    offset_intervals (current_buffer, PT, length);
#endif

  GAP_SIZE -= length;
  GPT += length;
  ZV += length;
  Z += length;
Karl Heuer's avatar
Karl Heuer committed
596
  if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor.  */
597
  adjust_overlays_for_insert (PT, length);
598
  adjust_markers_for_insert (PT, length);
599 600 601
  adjust_point (length);

  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
602 603
  graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf),
					       pos, length),
604 605 606
			       PT - length, length, current_buffer, inherit);
}

Jim Blandy's avatar
Jim Blandy committed
607 608 609 610
/* Insert the character C before point */

void
insert_char (c)
Karl Heuer's avatar
Karl Heuer committed
611
     int c;
Jim Blandy's avatar
Jim Blandy committed
612
{
Karl Heuer's avatar
Karl Heuer committed
613 614 615 616
  unsigned char workbuf[4], *str;
  int len = CHAR_STRING (c, workbuf, str);

  insert (str, len);
Jim Blandy's avatar
Jim Blandy committed
617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632
}

/* 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.  */

633
void
Jim Blandy's avatar
Jim Blandy committed
634 635 636 637
insert_before_markers (string, length)
     unsigned char *string;
     register int length;
{
638 639
  if (length > 0)
    {
Karl Heuer's avatar
Karl Heuer committed
640
      register int opoint = PT;
641
      insert_1 (string, length, 0, 1);
642
      adjust_markers (opoint - 1, opoint, length);
Karl Heuer's avatar
Karl Heuer committed
643
      signal_after_change (PT-length, 0, length);
644
    }
Jim Blandy's avatar
Jim Blandy committed
645 646
}

647
void
648 649 650 651 652 653 654
insert_before_markers_and_inherit (string, length)
     unsigned char *string;
     register int length;
{
  if (length > 0)
    {
      register int opoint = PT;
655
      insert_1 (string, length, 1, 1);
656 657 658 659 660
      adjust_markers (opoint - 1, opoint, length);
      signal_after_change (PT-length, 0, length);
    }
}

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

663
void
664
insert_from_string_before_markers (string, pos, length, inherit)
Jim Blandy's avatar
Jim Blandy committed
665 666
     Lisp_Object string;
     register int pos, length;
667
     int inherit;
Jim Blandy's avatar
Jim Blandy committed
668
{
669 670
  if (length > 0)
    {
Karl Heuer's avatar
Karl Heuer committed
671
      register int opoint = PT;
672 673
      insert_from_string_1 (string, pos, length, inherit);
      adjust_markers (opoint - 1, opoint, length);
Karl Heuer's avatar
Karl Heuer committed
674
      signal_after_change (PT-length, 0, length);
675
    }
Jim Blandy's avatar
Jim Blandy committed
676 677 678 679 680
}

/* Delete characters in current buffer
   from FROM up to (but not including) TO.  */

681
void
Jim Blandy's avatar
Jim Blandy committed
682 683
del_range (from, to)
     register int from, to;
684
{
685
  del_range_1 (from, to, 1);
686 687 688 689
}

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

690
void
691 692
del_range_1 (from, to, prepare)
     register int from, to, prepare;
Jim Blandy's avatar
Jim Blandy committed
693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710
{
  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);

711 712
  if (prepare)
    prepare_to_modify_buffer (from, to);
Jim Blandy's avatar
Jim Blandy committed
713

714 715 716 717 718 719
  /* 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);

720 721 722
  record_delete (from, numdel);
  MODIFF++;

Jim Blandy's avatar
Jim Blandy committed
723
  /* Relocate point as if it were a marker.  */
Karl Heuer's avatar
Karl Heuer committed
724
  if (from < PT)
Karl Heuer's avatar
Karl Heuer committed
725
    adjust_point (from - (PT < to ? PT : to));
Jim Blandy's avatar
Jim Blandy committed
726

727
  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
728
  offset_intervals (current_buffer, from, - numdel);
729

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

Jim Blandy's avatar
Jim Blandy committed
734 735 736 737
  GAP_SIZE += numdel;
  ZV -= numdel;
  Z -= numdel;
  GPT = from;
Karl Heuer's avatar
Karl Heuer committed
738
  *(GPT_ADDR) = 0;		/* Put an anchor.  */
Jim Blandy's avatar
Jim Blandy committed
739 740 741 742 743 744

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

745
  evaporate_overlays (from);
Jim Blandy's avatar
Jim Blandy committed
746 747 748
  signal_after_change (from, numdel, 0);
}

749 750 751 752
/* 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.  */
753
void
754 755
modify_region (buffer, start, end)
     struct buffer *buffer;
Jim Blandy's avatar
Jim Blandy committed
756 757
     int start, end;
{
758 759 760 761 762
  struct buffer *old_buffer = current_buffer;

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

Jim Blandy's avatar
Jim Blandy committed
763 764
  prepare_to_modify_buffer (start, end);

765 766 767
  if (start - 1 < beg_unchanged
      || (unchanged_modified == MODIFF
	  && overlay_unchanged_modified == OVERLAY_MODIFF))
Jim Blandy's avatar
Jim Blandy committed
768 769
    beg_unchanged = start - 1;
  if (Z - end < end_unchanged
770 771
      || (unchanged_modified == MODIFF
	  && overlay_unchanged_modified == OVERLAY_MODIFF))
Jim Blandy's avatar
Jim Blandy committed
772
    end_unchanged = Z - end;
773

774
  if (MODIFF <= SAVE_MODIFF)
775
    record_first_change ();
Jim Blandy's avatar
Jim Blandy committed
776
  MODIFF++;
777

778 779
  buffer->point_before_scroll = Qnil;

780 781
  if (buffer != old_buffer)
    set_buffer_internal (old_buffer);
Jim Blandy's avatar
Jim Blandy committed
782 783 784
}

/* Check that it is okay to modify the buffer between START and END.
785 786 787
   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
788

789
void
Jim Blandy's avatar
Jim Blandy committed
790
prepare_to_modify_buffer (start, end)
791
     int start, end;
Jim Blandy's avatar
Jim Blandy committed
792
{
Jim Blandy's avatar
Jim Blandy committed
793
  if (!NILP (current_buffer->read_only))
Jim Blandy's avatar
Jim Blandy committed
794 795
    Fbarf_if_buffer_read_only ();

796
  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
797
  if (BUF_INTERVALS (current_buffer) != 0)
798
    verify_interval_modification (current_buffer, start, end);
Jim Blandy's avatar
Jim Blandy committed
799 800

#ifdef CLASH_DETECTION
801
  if (!NILP (current_buffer->file_truename)
802 803
      /* Make binding buffer-file-name to nil effective.  */
      && !NILP (current_buffer->filename)
804
      && SAVE_MODIFF >= MODIFF)
805
    lock_file (current_buffer->file_truename);
Jim Blandy's avatar
Jim Blandy committed
806 807
#else
  /* At least warn if this file has changed on disk since it was visited.  */
Jim Blandy's avatar
Jim Blandy committed
808
  if (!NILP (current_buffer->filename)
809
      && SAVE_MODIFF >= MODIFF
Jim Blandy's avatar
Jim Blandy committed
810 811
      && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
      && !NILP (Ffile_exists_p (current_buffer->filename)))
Jim Blandy's avatar
Jim Blandy committed
812 813 814 815 816
    call1 (intern ("ask-user-about-supersession-threat"),
	   current_buffer->filename);
#endif /* not CLASH_DETECTION */

  signal_before_change (start, end);
817

818 819 820 821 822 823 824 825 826
  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);

827
  Vdeactivate_mark = Qt;
Jim Blandy's avatar
Jim Blandy committed
828 829
}

830
/* Signal a change to the buffer immediately before it happens.
831
   START_INT and END_INT are the bounds of the text to be changed.  */
Jim Blandy's avatar
Jim Blandy committed
832

833
void
834 835
signal_before_change (start_int, end_int)
     int start_int, end_int;
Jim Blandy's avatar
Jim Blandy committed
836
{
837 838 839 840 841
  Lisp_Object start, end;

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

Jim Blandy's avatar
Jim Blandy committed
842
  /* If buffer is unmodified, run a special hook for that case.  */
843
  if (SAVE_MODIFF >= MODIFF
Jim Blandy's avatar
Jim Blandy committed
844 845 846 847
      && !NILP (Vfirst_change_hook)
      && !NILP (Vrun_hooks))
    call1 (Vrun_hooks, Qfirst_change_hook);

848 849 850
  /* 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
851
  if (!NILP (Vbefore_change_function))
852
    call2 (Vbefore_change_function, start, end);
853

854
  /* Now run the before-change-functions if any.  */
855 856
  if (!NILP (Vbefore_change_functions))
    {
857 858 859 860 861 862 863 864 865 866
      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;
867 868
      Vbefore_change_functions = Qnil;
      Vafter_change_functions = Qnil;
869 870 871 872 873 874 875 876 877 878 879 880
      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;
881
    }
882 883 884

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

888
/* Signal a change immediately after it happens.
Jim Blandy's avatar
Jim Blandy committed
889 890 891
   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.)
892 893
   LENINS is the number of characters in that part of the text
   after the change.  */
Jim Blandy's avatar
Jim Blandy committed
894

895
void
Jim Blandy's avatar
Jim Blandy committed
896 897 898
signal_after_change (pos, lendel, lenins)
     int pos, lendel, lenins;
{
899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925
  /* If we are deferring calls to the after-change functions
     and there are no before-change functions,
     just record the args that we were going to use.  */
  if (! NILP (Vcombine_after_change_calls)
      && NILP (Vbefore_change_function) && NILP (Vbefore_change_functions)
      && NILP (current_buffer->overlays_before)
      && NILP (current_buffer->overlays_after))
    {
      Lisp_Object elt;

      if (!NILP (combine_after_change_list)
	  && current_buffer != XBUFFER (combine_after_change_buffer))
	Fcombine_after_change_execute ();

      elt = Fcons (make_number (pos - BEG),
		   Fcons (make_number (Z - (pos - lendel + lenins)),
			  Fcons (make_number (lenins - lendel), Qnil)));
      combine_after_change_list
	= Fcons (elt, combine_after_change_list);
      combine_after_change_buffer = Fcurrent_buffer ();

      return;
    }

  if (!NILP (combine_after_change_list)) 
    Fcombine_after_change_execute ();

926 927 928
  /* 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
929
  if (!NILP (Vafter_change_function))
930 931 932
    call3 (Vafter_change_function,
	   make_number (pos), make_number (pos + lenins),
	   make_number (lendel));
Jim Blandy's avatar
Jim Blandy committed
933

934 935
  if (!NILP (Vafter_change_functions))
    {
936 937 938 939 940 941 942 943 944 945
      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;
946 947
      Vbefore_change_functions = Qnil;
      Vafter_change_functions = Qnil;
948 949 950 951 952 953 954 955 956 957 958 959 960 961
      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;
962
    }
963 964 965

  if (!NILP (current_buffer->overlays_before)
      || !NILP (current_buffer->overlays_after))
966
    report_overlay_modification (make_number (pos),
967
				 make_number (pos + lenins),
968 969 970
				 1,
				 make_number (pos), make_number (pos + lenins),
				 make_number (lendel));
971 972 973 974 975

  /* 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
976
}
977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066

Lisp_Object
Fcombine_after_change_execute_1 (val)
     Lisp_Object val;
{
  Vcombine_after_change_calls = val;
  return val;
}

DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
  Scombine_after_change_execute, 0, 0, 0,
  "This function is for use internally in `combine-after-change-calls'.")
  ()
{
  register Lisp_Object val;
  int count = specpdl_ptr - specpdl;
  int beg, end, change;
  int begpos, endpos;
  Lisp_Object tail;

  record_unwind_protect (Fset_buffer, Fcurrent_buffer ());

  Fset_buffer (combine_after_change_buffer);

  /* # chars unchanged at beginning of buffer.  */
  beg = Z - BEG;
  /* # chars unchanged at end of buffer.  */
  end = beg;
  /* Total amount of insertion (negative for deletion).  */
  change = 0;

  /* Scan the various individual changes,
     accumulating the range info in BEG, END and CHANGE.  */
  for (tail = combine_after_change_list; CONSP (tail);
       tail = XCONS (tail)->cdr)
    {
      Lisp_Object elt, thisbeg, thisend, thischange;

      /* Extract the info from the next element.  */
      elt = XCONS (tail)->car;
      if (! CONSP (elt))
	continue;
      thisbeg = XINT (XCONS (elt)->car);

      elt = XCONS (elt)->cdr;
      if (! CONSP (elt))
	continue;
      thisend = XINT (XCONS (elt)->car);

      elt = XCONS (elt)->cdr;
      if (! CONSP (elt))
	continue;
      thischange = XINT (XCONS (elt)->car);

      /* Merge this range into the accumulated range.  */
      change += thischange;
      if (thisbeg < beg)
	beg = thisbeg;
      if (thisend < end)
	end = thisend;
    }

  /* Get the current start and end positions of the range
     that was changed.  */
  begpos = BEG + beg;
  endpos = Z - end;
  
  /* We are about to handle these, so discard them.  */
  combine_after_change_list = Qnil;

  /* Now run the after-change functions for real.
     Turn off the flag that defers them.  */
  record_unwind_protect (Fcombine_after_change_execute_1,
			 Vcombine_after_change_calls);
  signal_after_change (begpos, endpos - begpos - change, endpos - begpos);

  return unbind_to (count, val);
}

syms_of_insdel ()
{
  staticpro (&combine_after_change_list);
  combine_after_change_list = Qnil;

  DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls,
     "Used internally by the `combine-after-change-calls' macro.");
  Vcombine_after_change_calls = Qnil;

  defsubr (&Scombine_after_change_execute);
}