src/insdel.c

   1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
   2    Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 1, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <config.h>
  22 #include "lisp.h"
  23 #include "intervals.h"
  24 #include "buffer.h"
  25 #include "window.h"
  26 #include "blockinput.h"
  27
  28 static void insert_1 ();
  29 static void insert_from_string_1 ();
  30
  31 /* Move gap to position `pos'.
  32    Note that this can quit!  */
  33
  34 move_gap (pos)
  35      int pos;
  36 {
  37   if (pos < GPT)
  38     gap_left (pos, 0);
  39   else if (pos > GPT)
  40     gap_right (pos);
  41 }
  42
  43 /* Move the gap to POS, which is less than the current GPT.
  44    If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged.  */
  45
  46 gap_left (pos, newgap)
  47      register int pos;
  48      int newgap;
  49 {
  50   register unsigned char *to, *from;
  51   register int i;
  52   int new_s1;
  53
  54   pos--;
  55
  56   if (!newgap)
  57     {
  58       if (unchanged_modified == MODIFF)
  59         {
  60           beg_unchanged = pos;
  61           end_unchanged = Z - pos - 1;
  62         }
  63       else
  64         {
  65           if (Z - GPT < end_unchanged)
  66             end_unchanged = Z - GPT;
  67           if (pos < beg_unchanged)
  68             beg_unchanged = pos;
  69         }
  70     }
  71
  72   i = GPT;
  73   to = GAP_END_ADDR;
  74   from = GPT_ADDR;
  75   new_s1 = GPT - BEG;
  76
  77   /* Now copy the characters.  To move the gap down,
  78      copy characters up.  */
  79
  80   while (1)
  81     {
  82       /* I gets number of characters left to copy.  */
  83       i = new_s1 - pos;
  84       if (i == 0)
  85         break;
  86       /* If a quit is requested, stop copying now.
  87          Change POS to be where we have actually moved the gap to.  */
  88       if (QUITP)
  89         {
  90           pos = new_s1;
  91           break;
  92         }
  93       /* Move at most 32000 chars before checking again for a quit.  */
  94       if (i > 32000)
  95         i = 32000;
  96 #ifdef GAP_USE_BCOPY
  97       if (i >= 128
  98           /* bcopy is safe if the two areas of memory do not overlap
  99              or on systems where bcopy is always safe for moving upward.  */
 100           && (BCOPY_UPWARD_SAFE
 101               || to - from >= 128))
 102         {
 103           /* If overlap is not safe, avoid it by not moving too many
 104              characters at once.  */
 105           if (!BCOPY_UPWARD_SAFE && i > to - from)
 106             i = to - from;
 107           new_s1 -= i;
 108           from -= i, to -= i;
 109           bcopy (from, to, i);
 110         }
 111       else
 112 #endif
 113         {
 114           new_s1 -= i;
 115           while (--i >= 0)
 116             *--to = *--from;
 117         }
 118     }
 119
 120   /* Adjust markers, and buffer data structure, to put the gap at POS.
 121      POS is where the loop above stopped, which may be what was specified
 122      or may be where a quit was detected.  */
 123   adjust_markers (pos + 1, GPT, GAP_SIZE);
 124   GPT = pos + 1;
 125   QUIT;
 126 }
 127
 128 gap_right (pos)
 129      register int pos;
 130 {
 131   register unsigned char *to, *from;
 132   register int i;
 133   int new_s1;
 134
 135   pos--;
 136
 137   if (unchanged_modified == MODIFF)
 138     {
 139       beg_unchanged = pos;
 140       end_unchanged = Z - pos - 1;
 141     }
 142   else
 143     {
 144       if (Z - pos - 1 < end_unchanged)
 145         end_unchanged = Z - pos - 1;
 146       if (GPT - BEG < beg_unchanged)
 147         beg_unchanged = GPT - BEG;
 148     }
 149
 150   i = GPT;
 151   from = GAP_END_ADDR;
 152   to = GPT_ADDR;
 153   new_s1 = GPT - 1;
 154
 155   /* Now copy the characters.  To move the gap up,
 156      copy characters down.  */
 157
 158   while (1)
 159     {
 160       /* I gets number of characters left to copy.  */
 161       i = pos - new_s1;
 162       if (i == 0)
 163         break;
 164       /* If a quit is requested, stop copying now.
 165          Change POS to be where we have actually moved the gap to.  */
 166       if (QUITP)
 167         {
 168           pos = new_s1;
 169           break;
 170         }
 171       /* Move at most 32000 chars before checking again for a quit.  */
 172       if (i > 32000)
 173         i = 32000;
 174 #ifdef GAP_USE_BCOPY
 175       if (i >= 128
 176           /* bcopy is safe if the two areas of memory do not overlap
 177              or on systems where bcopy is always safe for moving downward.  */
 178           && (BCOPY_DOWNWARD_SAFE
 179               || from - to >= 128))
 180         {
 181           /* If overlap is not safe, avoid it by not moving too many
 182              characters at once.  */
 183           if (!BCOPY_DOWNWARD_SAFE && i > from - to)
 184             i = from - to;
 185           new_s1 += i;
 186           bcopy (from, to, i);
 187           from += i, to += i;
 188         }
 189       else
 190 #endif
 191         {
 192           new_s1 += i;
 193           while (--i >= 0)
 194             *to++ = *from++;
 195         }
 196     }
 197
 198   adjust_markers (GPT + GAP_SIZE, pos + 1 + GAP_SIZE, - GAP_SIZE);
 199   GPT = pos + 1;
 200   QUIT;
 201 }
 202
 203 /* Add `amount' to the position of every marker in the current buffer
 204    whose current position is between `from' (exclusive) and `to' (inclusive).
 205    Also, any markers past the outside of that interval, in the direction
 206    of adjustment, are first moved back to the near end of the interval
 207    and then adjusted by `amount'.  */
 208
 209 adjust_markers (from, to, amount)
 210      register int from, to, amount;
 211 {
 212   Lisp_Object marker;
 213   register struct Lisp_Marker *m;
 214   register int mpos;
 215
 216   marker = current_buffer->markers;
 217
 218   while (!NILP (marker))
 219     {
 220       m = XMARKER (marker);
 221       mpos = m->bufpos;
 222       if (amount > 0)
 223         {
 224           if (mpos > to && mpos < to + amount)
 225             mpos = to + amount;
 226         }
 227       else
 228         {
 229           if (mpos > from + amount && mpos <= from)
 230             mpos = from + amount;
 231         }
 232       if (mpos > from && mpos <= to)
 233         mpos += amount;
 234       m->bufpos = mpos;
 235       marker = m->chain;
 236     }
 237 }
 238 \f
 239 /* Make the gap INCREMENT characters longer.  */
 240
 241 make_gap (increment)
 242      int increment;
 243 {
 244   unsigned char *result;
 245   Lisp_Object tem;
 246   int real_gap_loc;
 247   int old_gap_size;
 248
 249   /* If we have to get more space, get enough to last a while.  */
 250   increment += 2000;
 251
 252   BLOCK_INPUT;
 253   result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment));
 254   UNBLOCK_INPUT;
 255
 256   if (result == 0)
 257     memory_full ();
 258   BEG_ADDR = result;
 259
 260   /* Prevent quitting in move_gap.  */
 261   tem = Vinhibit_quit;
 262   Vinhibit_quit = Qt;
 263
 264   real_gap_loc = GPT;
 265   old_gap_size = GAP_SIZE;
 266
 267   /* Call the newly allocated space a gap at the end of the whole space.  */
 268   GPT = Z + GAP_SIZE;
 269   GAP_SIZE = increment;
 270
 271   /* Move the new gap down to be consecutive with the end of the old one.
 272      This adjusts the markers properly too.  */
 273   gap_left (real_gap_loc + old_gap_size, 1);
 274
 275   /* Now combine the two into one large gap.  */
 276   GAP_SIZE += old_gap_size;
 277   GPT = real_gap_loc;
 278
 279   Vinhibit_quit = tem;
 280 }
 281 \f
 282 /* Insert a string of specified length before point.
 283    DO NOT use this for the contents of a Lisp string!
 284    prepare_to_modify_buffer could relocate the string.  */
 285
 286 insert (string, length)
 287      register unsigned char *string;
 288      register length;
 289 {
 290   if (length > 0)
 291     {
 292       insert_1 (string, length);
 293       signal_after_change (point-length, 0, length);
 294     }
 295 }
 296
 297 static void
 298 insert_1 (string, length)
 299      register unsigned char *string;
 300      register length;
 301 {
 302   register Lisp_Object temp;
 303
 304   /* Make sure point-max won't overflow after this insertion.  */
 305   XSET (temp, Lisp_Int, length + Z);
 306   if (length + Z != XINT (temp))
 307     error ("maximum buffer size exceeded");
 308
 309   prepare_to_modify_buffer (point, point);
 310
 311   if (point != GPT)
 312     move_gap (point);
 313   if (GAP_SIZE < length)
 314     make_gap (length - GAP_SIZE);
 315
 316   record_insert (point, length);
 317   MODIFF++;
 318
 319   bcopy (string, GPT_ADDR, length);
 320
 321   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 322   offset_intervals (current_buffer, point, length);
 323
 324   GAP_SIZE -= length;
 325   GPT += length;
 326   ZV += length;
 327   Z += length;
 328   SET_PT (point + length);
 329 }
 330
 331 /* Insert the part of the text of STRING, a Lisp object assumed to be
 332    of type string, consisting of the LENGTH characters starting at
 333    position POS.  If the text of STRING has properties, they are absorbed
 334    into the buffer.
 335
 336    It does not work to use `insert' for this, because a GC could happen
 337    before we bcopy the stuff into the buffer, and relocate the string
 338    without insert noticing.  */
 339
 340 insert_from_string (string, pos, length, inherit)
 341      Lisp_Object string;
 342      register int pos, length;
 343      int inherit;
 344 {
 345   if (length > 0)
 346     {
 347       insert_from_string_1 (string, pos, length, inherit);
 348       signal_after_change (point-length, 0, length);
 349     }
 350 }
 351
 352 static void
 353 insert_from_string_1 (string, pos, length, inherit)
 354      Lisp_Object string;
 355      register int pos, length;
 356      int inherit;
 357 {
 358   register Lisp_Object temp;
 359   struct gcpro gcpro1;
 360
 361   /* Make sure point-max won't overflow after this insertion.  */
 362   XSET (temp, Lisp_Int, length + Z);
 363   if (length + Z != XINT (temp))
 364     error ("maximum buffer size exceeded");
 365
 366   GCPRO1 (string);
 367   prepare_to_modify_buffer (point, point);
 368
 369   if (point != GPT)
 370     move_gap (point);
 371   if (GAP_SIZE < length)
 372     make_gap (length - GAP_SIZE);
 373
 374   record_insert (point, length);
 375   MODIFF++;
 376   UNGCPRO;
 377
 378   bcopy (XSTRING (string)->data, GPT_ADDR, length);
 379
 380   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 381   offset_intervals (current_buffer, point, length);
 382
 383   GAP_SIZE -= length;
 384   GPT += length;
 385   ZV += length;
 386   Z += length;
 387
 388   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 389   graft_intervals_into_buffer (XSTRING (string)->intervals, point, length,
 390                                current_buffer, inherit);
 391
 392   SET_PT (point + length);
 393 }
 394
 395 /* Insert the character C before point */
 396
 397 void
 398 insert_char (c)
 399      unsigned char c;
 400 {
 401   insert (&c, 1);
 402 }
 403
 404 /* Insert the null-terminated string S before point */
 405
 406 void
 407 insert_string (s)
 408      char *s;
 409 {
 410   insert (s, strlen (s));
 411 }
 412
 413 /* Like `insert' except that all markers pointing at the place where
 414    the insertion happens are adjusted to point after it.
 415    Don't use this function to insert part of a Lisp string,
 416    since gc could happen and relocate it.  */
 417
 418 insert_before_markers (string, length)
 419      unsigned char *string;
 420      register int length;
 421 {
 422   if (length > 0)
 423     {
 424       register int opoint = point;
 425       insert_1 (string, length);
 426       adjust_markers (opoint - 1, opoint, length);
 427       signal_after_change (point-length, 0, length);
 428     }
 429 }
 430
 431 /* Insert part of a Lisp string, relocating markers after.  */
 432
 433 insert_from_string_before_markers (string, pos, length, inherit)
 434      Lisp_Object string;
 435      register int pos, length;
 436      int inherit;
 437 {
 438   if (length > 0)
 439     {
 440       register int opoint = point;
 441       insert_from_string_1 (string, pos, length, inherit);
 442       adjust_markers (opoint - 1, opoint, length);
 443       signal_after_change (point-length, 0, length);
 444     }
 445 }
 446 \f
 447 /* Delete characters in current buffer
 448    from FROM up to (but not including) TO.  */
 449
 450 del_range (from, to)
 451      register int from, to;
 452 {
 453   return del_range_1 (from, to, 1);
 454 }
 455
 456 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer.  */
 457
 458 del_range_1 (from, to, prepare)
 459      register int from, to, prepare;
 460 {
 461   register int numdel;
 462
 463   /* Make args be valid */
 464   if (from < BEGV)
 465     from = BEGV;
 466   if (to > ZV)
 467     to = ZV;
 468
 469   if ((numdel = to - from) <= 0)
 470     return;
 471
 472   /* Make sure the gap is somewhere in or next to what we are deleting.  */
 473   if (from > GPT)
 474     gap_right (from);
 475   if (to < GPT)
 476     gap_left (to, 0);
 477
 478   if (prepare)
 479     prepare_to_modify_buffer (from, to);
 480
 481   record_delete (from, numdel);
 482   MODIFF++;
 483
 484   /* Relocate point as if it were a marker.  */
 485   if (from < point)
 486     {
 487       if (point < to)
 488         SET_PT (from);
 489       else
 490         SET_PT (point - numdel);
 491     }
 492
 493   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 494   offset_intervals (current_buffer, from, - numdel);
 495
 496   /* Relocate all markers pointing into the new, larger gap
 497      to point at the end of the text before the gap.  */
 498   adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
 499
 500   GAP_SIZE += numdel;
 501   ZV -= numdel;
 502   Z -= numdel;
 503   GPT = from;
 504
 505   if (GPT - BEG < beg_unchanged)
 506     beg_unchanged = GPT - BEG;
 507   if (Z - GPT < end_unchanged)
 508     end_unchanged = Z - GPT;
 509
 510   signal_after_change (from, numdel, 0);
 511 }
 512 \f
 513 /* Call this if you're about to change the region of BUFFER from START
 514    to END.  This checks the read-only properties of the region, calls
 515    the necessary modification hooks, and warns the next redisplay that
 516    it should pay attention to that area.  */
 517 modify_region (buffer, start, end)
 518      struct buffer *buffer;
 519      int start, end;
 520 {
 521   struct buffer *old_buffer = current_buffer;
 522
 523   if (buffer != old_buffer)
 524     set_buffer_internal (buffer);
 525
 526   prepare_to_modify_buffer (start, end);
 527
 528   if (start - 1 < beg_unchanged || unchanged_modified == MODIFF)
 529     beg_unchanged = start - 1;
 530   if (Z - end < end_unchanged
 531       || unchanged_modified == MODIFF)
 532     end_unchanged = Z - end;
 533
 534   if (MODIFF <= current_buffer->save_modified)
 535     record_first_change ();
 536   MODIFF++;
 537
 538   if (buffer != old_buffer)
 539     set_buffer_internal (old_buffer);
 540 }
 541
 542 /* Check that it is okay to modify the buffer between START and END.
 543    Run the before-change-function, if any.  If intervals are in use,
 544    verify that the text to be modified is not read-only, and call
 545    any modification properties the text may have. */
 546
 547 prepare_to_modify_buffer (start, end)
 548      Lisp_Object start, end;
 549 {
 550   if (!NILP (current_buffer->read_only))
 551     Fbarf_if_buffer_read_only ();
 552
 553   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 554   verify_interval_modification (current_buffer, start, end);
 555
 556   verify_overlay_modification (start, end);
 557
 558 #ifdef CLASH_DETECTION
 559   if (!NILP (current_buffer->filename)
 560       && current_buffer->save_modified >= MODIFF)
 561     lock_file (current_buffer->filename);
 562 #else
 563   /* At least warn if this file has changed on disk since it was visited.  */
 564   if (!NILP (current_buffer->filename)
 565       && current_buffer->save_modified >= MODIFF
 566       && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
 567       && !NILP (Ffile_exists_p (current_buffer->filename)))
 568     call1 (intern ("ask-user-about-supersession-threat"),
 569            current_buffer->filename);
 570 #endif /* not CLASH_DETECTION */
 571
 572   signal_before_change (start, end);
 573
 574   Vdeactivate_mark = Qt;
 575 }
 576 \f
 577 static Lisp_Object
 578 before_change_function_restore (value)
 579      Lisp_Object value;
 580 {
 581   Vbefore_change_function = value;
 582 }
 583
 584 static Lisp_Object
 585 after_change_function_restore (value)
 586      Lisp_Object value;
 587 {
 588   Vafter_change_function = value;
 589 }
 590
 591 static Lisp_Object
 592 before_change_functions_restore (value)
 593      Lisp_Object value;
 594 {
 595   Vbefore_change_functions = value;
 596 }
 597
 598 static Lisp_Object
 599 after_change_functions_restore (value)
 600      Lisp_Object value;
 601 {
 602   Vafter_change_functions = value;
 603 }
 604
 605 /* Signal a change to the buffer immediately before it happens.
 606    START and END are the bounds of the text to be changed,
 607    as Lisp objects.  */
 608
 609 signal_before_change (start, end)
 610      Lisp_Object start, end;
 611 {
 612   /* If buffer is unmodified, run a special hook for that case.  */
 613   if (current_buffer->save_modified >= MODIFF
 614       && !NILP (Vfirst_change_hook)
 615       && !NILP (Vrun_hooks))
 616     call1 (Vrun_hooks, Qfirst_change_hook);
 617
 618   /* Now in any case run the before-change-function if any.  */
 619   if (!NILP (Vbefore_change_function))
 620     {
 621       int count = specpdl_ptr - specpdl;
 622       Lisp_Object function;
 623
 624       function = Vbefore_change_function;
 625
 626       record_unwind_protect (after_change_function_restore,
 627                              Vafter_change_function);
 628       record_unwind_protect (before_change_function_restore,
 629                              Vbefore_change_function);
 630       record_unwind_protect (after_change_functions_restore,
 631                              Vafter_change_functions);
 632       record_unwind_protect (before_change_functions_restore,
 633                              Vbefore_change_functions);
 634       Vafter_change_function = Qnil;
 635       Vbefore_change_function = Qnil;
 636       Vafter_change_functions = Qnil;
 637       Vbefore_change_functions = Qnil;
 638
 639       call2 (function, start, end);
 640       unbind_to (count, Qnil);
 641     }
 642
 643   /* Now in any case run the before-change-function if any.  */
 644   if (!NILP (Vbefore_change_functions))
 645     {
 646       int count = specpdl_ptr - specpdl;
 647       Lisp_Object functions;
 648
 649       functions = Vbefore_change_functions;
 650
 651       record_unwind_protect (after_change_function_restore,
 652                              Vafter_change_function);
 653       record_unwind_protect (before_change_function_restore,
 654                              Vbefore_change_function);
 655       record_unwind_protect (after_change_functions_restore,
 656                              Vafter_change_functions);
 657       record_unwind_protect (before_change_functions_restore,
 658                              Vbefore_change_functions);
 659       Vafter_change_function = Qnil;
 660       Vbefore_change_function = Qnil;
 661       Vafter_change_functions = Qnil;
 662       Vbefore_change_functions = Qnil;
 663
 664       while (CONSP (functions))
 665         {
 666           call2 (XCONS (functions)->car, start, end);
 667           functions = XCONS (functions)->cdr;
 668         }
 669       unbind_to (count, Qnil);
 670     }
 671 }
 672
 673 /* Signal a change immediately after it happens.
 674    POS is the address of the start of the changed text.
 675    LENDEL is the number of characters of the text before the change.
 676    (Not the whole buffer; just the part that was changed.)
 677    LENINS is the number of characters in the changed text.  */
 678
 679 signal_after_change (pos, lendel, lenins)
 680      int pos, lendel, lenins;
 681 {
 682   if (!NILP (Vafter_change_function))
 683     {
 684       int count = specpdl_ptr - specpdl;
 685       Lisp_Object function;
 686       function = Vafter_change_function;
 687
 688       record_unwind_protect (after_change_function_restore,
 689                              Vafter_change_function);
 690       record_unwind_protect (before_change_function_restore,
 691                              Vbefore_change_function);
 692       record_unwind_protect (after_change_functions_restore,
 693                              Vafter_change_functions);
 694       record_unwind_protect (before_change_functions_restore,
 695                              Vbefore_change_functions);
 696       Vafter_change_function = Qnil;
 697       Vbefore_change_function = Qnil;
 698       Vafter_change_functions = Qnil;
 699       Vbefore_change_functions = Qnil;
 700
 701       call3 (function, make_number (pos), make_number (pos + lenins),
 702              make_number (lendel));
 703       unbind_to (count, Qnil);
 704     }
 705   if (!NILP (Vafter_change_functions))
 706     {
 707       int count = specpdl_ptr - specpdl;
 708       Lisp_Object functions;
 709       functions = Vafter_change_functions;
 710
 711       record_unwind_protect (after_change_function_restore,
 712                              Vafter_change_function);
 713       record_unwind_protect (before_change_function_restore,
 714                              Vbefore_change_function);
 715       record_unwind_protect (after_change_functions_restore,
 716                              Vafter_change_functions);
 717       record_unwind_protect (before_change_functions_restore,
 718                              Vbefore_change_functions);
 719       Vafter_change_function = Qnil;
 720       Vbefore_change_function = Qnil;
 721       Vafter_change_functions = Qnil;
 722       Vbefore_change_functions = Qnil;
 723
 724       while (CONSP (functions))
 725         {
 726           call3 (XCONS (functions)->car,
 727                  make_number (pos), make_number (pos + lenins),
 728                  make_number (lendel));
 729           functions = XCONS (functions)->cdr;
 730         }
 731       unbind_to (count, Qnil);
 732     }
 733 }