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