src/insdel.c

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