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