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