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