src/insdel.c

   1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
   2    Copyright (C) 1985, 1986 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
  27 /* Nonzero means don't allow protected fields to be modified.  */
  28
  29 extern int check_protected_fields;
  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   result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment));
 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)
 331      Lisp_Object string;
 332      register int pos, length;
 333 {
 334   register Lisp_Object temp;
 335   struct gcpro gcpro1;
 336
 337   if (length < 1)
 338     return;
 339
 340   /* Make sure point-max won't overflow after this insertion.  */
 341   XSET (temp, Lisp_Int, length + Z);
 342   if (length + Z != XINT (temp))
 343     error ("maximum buffer size exceeded");
 344
 345   GCPRO1 (string);
 346   prepare_to_modify_buffer (point, point);
 347
 348   if (point != GPT)
 349     move_gap (point);
 350   if (GAP_SIZE < length)
 351     make_gap (length - GAP_SIZE);
 352
 353   record_insert (point, length);
 354   MODIFF++;
 355   UNGCPRO;
 356
 357   bcopy (XSTRING (string)->data, GPT_ADDR, length);
 358
 359   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 360   offset_intervals (current_buffer, point, length);
 361
 362   GAP_SIZE -= length;
 363   GPT += length;
 364   ZV += length;
 365   Z += length;
 366
 367   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 368   graft_intervals_into_buffer (XSTRING (string)->intervals, point,
 369                                current_buffer);
 370
 371   SET_PT (point + length);
 372
 373   signal_after_change (point-length, 0, length);
 374 }
 375
 376 /* Insert the character C before point */
 377
 378 void
 379 insert_char (c)
 380      unsigned char c;
 381 {
 382   insert (&c, 1);
 383 }
 384
 385 /* Insert the null-terminated string S before point */
 386
 387 void
 388 insert_string (s)
 389      char *s;
 390 {
 391   insert (s, strlen (s));
 392 }
 393
 394 /* Like `insert' except that all markers pointing at the place where
 395    the insertion happens are adjusted to point after it.
 396    Don't use this function to insert part of a Lisp string,
 397    since gc could happen and relocate it.  */
 398
 399 insert_before_markers (string, length)
 400      unsigned char *string;
 401      register int length;
 402 {
 403   register int opoint = point;
 404   insert (string, length);
 405   adjust_markers (opoint - 1, opoint, length);
 406 }
 407
 408 /* Insert part of a Lisp string, relocating markers after.  */
 409
 410 insert_from_string_before_markers (string, pos, length)
 411      Lisp_Object string;
 412      register int pos, length;
 413 {
 414   register int opoint = point;
 415   insert_from_string (string, pos, length);
 416   adjust_markers (opoint - 1, opoint, length);
 417 }
 418 \f
 419 /* Delete characters in current buffer
 420    from FROM up to (but not including) TO.  */
 421
 422 del_range (from, to)
 423      register int from, to;
 424 {
 425   register int numdel;
 426
 427   /* Make args be valid */
 428   if (from < BEGV)
 429     from = BEGV;
 430   if (to > ZV)
 431     to = ZV;
 432
 433   if ((numdel = to - from) <= 0)
 434     return;
 435
 436   /* Make sure the gap is somewhere in or next to what we are deleting.  */
 437   if (from > GPT)
 438     gap_right (from);
 439   if (to < GPT)
 440     gap_left (to, 0);
 441
 442   prepare_to_modify_buffer (from, to);
 443
 444   record_delete (from, numdel);
 445   MODIFF++;
 446
 447   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 448   offset_intervals (current_buffer, point, - numdel);
 449
 450   /* Relocate point as if it were a marker.  */
 451   if (from < point)
 452     {
 453       if (point < to)
 454         SET_PT (from);
 455       else
 456         SET_PT (point - numdel);
 457     }
 458
 459   /* Relocate all markers pointing into the new, larger gap
 460      to point at the end of the text before the gap.  */
 461   adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
 462
 463   GAP_SIZE += numdel;
 464   ZV -= numdel;
 465   Z -= numdel;
 466   GPT = from;
 467
 468   if (GPT - BEG < beg_unchanged)
 469     beg_unchanged = GPT - BEG;
 470   if (Z - GPT < end_unchanged)
 471     end_unchanged = Z - GPT;
 472
 473   signal_after_change (from, numdel, 0);
 474 }
 475 \f
 476 modify_region (start, end)
 477      int start, end;
 478 {
 479   prepare_to_modify_buffer (start, end);
 480
 481   if (start - 1 < beg_unchanged || unchanged_modified == MODIFF)
 482     beg_unchanged = start - 1;
 483   if (Z - end < end_unchanged
 484       || unchanged_modified == MODIFF)
 485     end_unchanged = Z - end;
 486   MODIFF++;
 487 }
 488
 489 /* Check that it is okay to modify the buffer between START and END.
 490    Run the before-change-function, if any.  If intervals are in use,
 491    verify that the text to be modified is not read-only, and call
 492    any modification properties the text may have. */
 493
 494 prepare_to_modify_buffer (start, end)
 495      Lisp_Object start, end;
 496 {
 497   if (!NILP (current_buffer->read_only))
 498     Fbarf_if_buffer_read_only ();
 499
 500 #if 0                           /* Superceded by interval code */
 501   if (check_protected_fields)
 502     Fregion_fields (start, end, Qnil, Qt);
 503 #endif
 504
 505   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 506   verify_interval_modification (current_buffer, start, end);
 507
 508 #ifdef CLASH_DETECTION
 509   if (!NILP (current_buffer->filename)
 510       && current_buffer->save_modified >= MODIFF)
 511     lock_file (current_buffer->filename);
 512 #else
 513   /* At least warn if this file has changed on disk since it was visited.  */
 514   if (!NILP (current_buffer->filename)
 515       && current_buffer->save_modified >= MODIFF
 516       && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
 517       && !NILP (Ffile_exists_p (current_buffer->filename)))
 518     call1 (intern ("ask-user-about-supersession-threat"),
 519            current_buffer->filename);
 520 #endif /* not CLASH_DETECTION */
 521
 522   signal_before_change (start, end);
 523 }
 524 \f
 525 static Lisp_Object
 526 before_change_function_restore (value)
 527      Lisp_Object value;
 528 {
 529   Vbefore_change_function = value;
 530 }
 531
 532 static Lisp_Object
 533 after_change_function_restore (value)
 534      Lisp_Object value;
 535 {
 536   Vafter_change_function = value;
 537 }
 538
 539 /* Signal a change to the buffer immediatly before it happens.
 540    START and END are the bounds of the text to be changed,
 541    as Lisp objects.  */
 542
 543 signal_before_change (start, end)
 544      Lisp_Object start, end;
 545 {
 546   /* If buffer is unmodified, run a special hook for that case.  */
 547   if (current_buffer->save_modified >= MODIFF
 548       && !NILP (Vfirst_change_function))
 549     {
 550       call0 (Vfirst_change_function);
 551     }
 552   /* Now in any case run the before-change-function if any.  */
 553   if (!NILP (Vbefore_change_function))
 554     {
 555       int count = specpdl_ptr - specpdl;
 556       Lisp_Object function;
 557
 558       function = Vbefore_change_function;
 559       record_unwind_protect (after_change_function_restore,
 560                              Vafter_change_function);
 561       record_unwind_protect (before_change_function_restore,
 562                              Vbefore_change_function);
 563       Vafter_change_function = Qnil;
 564       Vbefore_change_function = Qnil;
 565
 566       call2 (function, start, end);
 567       unbind_to (count, Qnil);
 568     }
 569 }
 570
 571 /* Signal a change immediatly after it happens.
 572    POS is the address of the start of the changed text.
 573    LENDEL is the number of characters of the text before the change.
 574    (Not the whole buffer; just the part that was changed.)
 575    LENINS is the number of characters in the changed text.  */
 576
 577 signal_after_change (pos, lendel, lenins)
 578      int pos, lendel, lenins;
 579 {
 580   if (!NILP (Vafter_change_function))
 581     {
 582       int count = specpdl_ptr - specpdl;
 583       Lisp_Object function;
 584       function = Vafter_change_function;
 585
 586       record_unwind_protect (after_change_function_restore,
 587                              Vafter_change_function);
 588       record_unwind_protect (before_change_function_restore,
 589                              Vbefore_change_function);
 590       Vafter_change_function = Qnil;
 591       Vbefore_change_function = Qnil;
 592
 593       call3 (function, make_number (pos), make_number (pos + lenins),
 594              make_number (lendel));
 595       unbind_to (count, Qnil);
 596     }
 597 }