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)
 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   /* Relocate point as if it were a marker.  */
 448   if (from < point)
 449     {
 450       if (point < to)
 451         SET_PT (from);
 452       else
 453         SET_PT (point - numdel);
 454     }
 455
 456   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 457   offset_intervals (current_buffer, point, - numdel);
 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 /* Call this if you're about to change the region of BUFFER from START
 477    to END.  This checks the read-only properties of the region, calls
 478    the necessary modification hooks, and warns the next redisplay that
 479    it should pay attention to that area.  */
 480 modify_region (buffer, start, end)
 481      struct buffer *buffer;
 482      int start, end;
 483 {
 484   struct buffer *old_buffer = current_buffer;
 485
 486   if (buffer != old_buffer)
 487     set_buffer_internal (buffer);
 488
 489   prepare_to_modify_buffer (start, end);
 490
 491   if (start - 1 < beg_unchanged || unchanged_modified == MODIFF)
 492     beg_unchanged = start - 1;
 493   if (Z - end < end_unchanged
 494       || unchanged_modified == MODIFF)
 495     end_unchanged = Z - end;
 496   MODIFF++;
 497
 498   if (buffer != old_buffer)
 499     set_buffer_internal (old_buffer);
 500 }
 501
 502 /* Check that it is okay to modify the buffer between START and END.
 503    Run the before-change-function, if any.  If intervals are in use,
 504    verify that the text to be modified is not read-only, and call
 505    any modification properties the text may have. */
 506
 507 prepare_to_modify_buffer (start, end)
 508      Lisp_Object start, end;
 509 {
 510   if (!NILP (current_buffer->read_only))
 511     Fbarf_if_buffer_read_only ();
 512
 513   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
 514   verify_interval_modification (current_buffer, start, end);
 515
 516   verify_overlay_modification (start, end);
 517
 518 #ifdef CLASH_DETECTION
 519   if (!NILP (current_buffer->filename)
 520       && current_buffer->save_modified >= MODIFF)
 521     lock_file (current_buffer->filename);
 522 #else
 523   /* At least warn if this file has changed on disk since it was visited.  */
 524   if (!NILP (current_buffer->filename)
 525       && current_buffer->save_modified >= MODIFF
 526       && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
 527       && !NILP (Ffile_exists_p (current_buffer->filename)))
 528     call1 (intern ("ask-user-about-supersession-threat"),
 529            current_buffer->filename);
 530 #endif /* not CLASH_DETECTION */
 531
 532   signal_before_change (start, end);
 533
 534   Vdeactivate_mark = Qt;
 535 }
 536 \f
 537 static Lisp_Object
 538 before_change_function_restore (value)
 539      Lisp_Object value;
 540 {
 541   Vbefore_change_function = value;
 542 }
 543
 544 static Lisp_Object
 545 after_change_function_restore (value)
 546      Lisp_Object value;
 547 {
 548   Vafter_change_function = value;
 549 }
 550
 551 /* Signal a change to the buffer immediately before it happens.
 552    START and END are the bounds of the text to be changed,
 553    as Lisp objects.  */
 554
 555 signal_before_change (start, end)
 556      Lisp_Object start, end;
 557 {
 558   /* If buffer is unmodified, run a special hook for that case.  */
 559   if (current_buffer->save_modified >= MODIFF
 560       && !NILP (Vfirst_change_hook)
 561       && !NILP (Vrun_hooks))
 562     call1 (Vrun_hooks, Qfirst_change_hook);
 563
 564   /* Now in any case run the before-change-function if any.  */
 565   if (!NILP (Vbefore_change_function))
 566     {
 567       int count = specpdl_ptr - specpdl;
 568       Lisp_Object function;
 569
 570       function = Vbefore_change_function;
 571       record_unwind_protect (after_change_function_restore,
 572                              Vafter_change_function);
 573       record_unwind_protect (before_change_function_restore,
 574                              Vbefore_change_function);
 575       Vafter_change_function = Qnil;
 576       Vbefore_change_function = Qnil;
 577
 578       call2 (function, start, end);
 579       unbind_to (count, Qnil);
 580     }
 581 }
 582
 583 /* Signal a change immediately after it happens.
 584    POS is the address of the start of the changed text.
 585    LENDEL is the number of characters of the text before the change.
 586    (Not the whole buffer; just the part that was changed.)
 587    LENINS is the number of characters in the changed text.  */
 588
 589 signal_after_change (pos, lendel, lenins)
 590      int pos, lendel, lenins;
 591 {
 592   if (!NILP (Vafter_change_function))
 593     {
 594       int count = specpdl_ptr - specpdl;
 595       Lisp_Object function;
 596       function = Vafter_change_function;
 597
 598       record_unwind_protect (after_change_function_restore,
 599                              Vafter_change_function);
 600       record_unwind_protect (before_change_function_restore,
 601                              Vbefore_change_function);
 602       Vafter_change_function = Qnil;
 603       Vbefore_change_function = Qnil;
 604
 605       call3 (function, make_number (pos), make_number (pos + lenins),
 606              make_number (lendel));
 607       unbind_to (count, Qnil);
 608     }
 609 }