Comment change.
[emacs.git] / src / insdel.c
bloba001c81bd9935ebcd51b6fd2aae6841690264449
1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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 2, or (at your option)
9 any later version.
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.
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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 #include <config.h>
23 #include "lisp.h"
24 #include "intervals.h"
25 #include "buffer.h"
26 #include "charset.h"
27 #include "window.h"
28 #include "blockinput.h"
30 #ifndef NULL
31 #define NULL 0
32 #endif
34 #define min(x, y) ((x) < (y) ? (x) : (y))
36 static void insert_from_string_1 ();
37 static void insert_from_buffer_1 ();
38 static void gap_left ();
39 static void gap_right ();
40 static void adjust_markers ();
41 static void adjust_point ();
43 Lisp_Object Fcombine_after_change_execute ();
45 /* Non-nil means don't call the after-change-functions right away,
46 just record an element in Vcombine_after_change_calls_list. */
47 Lisp_Object Vcombine_after_change_calls;
49 /* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
50 describing changes which happened while combine_after_change_calls
51 was nonzero. We use this to decide how to call them
52 once the deferral ends.
54 In each element.
55 BEG-UNCHANGED is the number of chars before the changed range.
56 END-UNCHANGED is the number of chars after the changed range,
57 and CHANGE-AMOUNT is the number of characters inserted by the change
58 (negative for a deletion). */
59 Lisp_Object combine_after_change_list;
61 /* Buffer which combine_after_change_list is about. */
62 Lisp_Object combine_after_change_buffer;
64 /* Move gap to position `pos'.
65 Note that this can quit! */
67 void
68 move_gap (pos)
69 int pos;
71 if (pos < GPT)
72 gap_left (pos, 0);
73 else if (pos > GPT)
74 gap_right (pos);
77 /* Move the gap to POS, which is less than the current GPT.
78 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
80 static void
81 gap_left (pos, newgap)
82 register int pos;
83 int newgap;
85 register unsigned char *to, *from;
86 register int i;
87 int new_s1;
89 pos--;
91 if (!newgap)
93 if (unchanged_modified == MODIFF
94 && overlay_unchanged_modified == OVERLAY_MODIFF)
96 beg_unchanged = pos;
97 end_unchanged = Z - pos - 1;
99 else
101 if (Z - GPT < end_unchanged)
102 end_unchanged = Z - GPT;
103 if (pos < beg_unchanged)
104 beg_unchanged = pos;
108 i = GPT;
109 to = GAP_END_ADDR;
110 from = GPT_ADDR;
111 new_s1 = GPT - BEG;
113 /* Now copy the characters. To move the gap down,
114 copy characters up. */
116 while (1)
118 /* I gets number of characters left to copy. */
119 i = new_s1 - pos;
120 if (i == 0)
121 break;
122 /* If a quit is requested, stop copying now.
123 Change POS to be where we have actually moved the gap to. */
124 if (QUITP)
126 pos = new_s1;
127 break;
129 /* Move at most 32000 chars before checking again for a quit. */
130 if (i > 32000)
131 i = 32000;
132 #ifdef GAP_USE_BCOPY
133 if (i >= 128
134 /* bcopy is safe if the two areas of memory do not overlap
135 or on systems where bcopy is always safe for moving upward. */
136 && (BCOPY_UPWARD_SAFE
137 || to - from >= 128))
139 /* If overlap is not safe, avoid it by not moving too many
140 characters at once. */
141 if (!BCOPY_UPWARD_SAFE && i > to - from)
142 i = to - from;
143 new_s1 -= i;
144 from -= i, to -= i;
145 bcopy (from, to, i);
147 else
148 #endif
150 new_s1 -= i;
151 while (--i >= 0)
152 *--to = *--from;
156 /* Adjust markers, and buffer data structure, to put the gap at POS.
157 POS is where the loop above stopped, which may be what was specified
158 or may be where a quit was detected. */
159 adjust_markers (pos + 1, GPT, GAP_SIZE);
160 GPT = pos + 1;
161 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
162 QUIT;
165 static void
166 gap_right (pos)
167 register int pos;
169 register unsigned char *to, *from;
170 register int i;
171 int new_s1;
173 pos--;
175 if (unchanged_modified == MODIFF
176 && overlay_unchanged_modified == OVERLAY_MODIFF)
179 beg_unchanged = pos;
180 end_unchanged = Z - pos - 1;
182 else
184 if (Z - pos - 1 < end_unchanged)
185 end_unchanged = Z - pos - 1;
186 if (GPT - BEG < beg_unchanged)
187 beg_unchanged = GPT - BEG;
190 i = GPT;
191 from = GAP_END_ADDR;
192 to = GPT_ADDR;
193 new_s1 = GPT - 1;
195 /* Now copy the characters. To move the gap up,
196 copy characters down. */
198 while (1)
200 /* I gets number of characters left to copy. */
201 i = pos - new_s1;
202 if (i == 0)
203 break;
204 /* If a quit is requested, stop copying now.
205 Change POS to be where we have actually moved the gap to. */
206 if (QUITP)
208 pos = new_s1;
209 break;
211 /* Move at most 32000 chars before checking again for a quit. */
212 if (i > 32000)
213 i = 32000;
214 #ifdef GAP_USE_BCOPY
215 if (i >= 128
216 /* bcopy is safe if the two areas of memory do not overlap
217 or on systems where bcopy is always safe for moving downward. */
218 && (BCOPY_DOWNWARD_SAFE
219 || from - to >= 128))
221 /* If overlap is not safe, avoid it by not moving too many
222 characters at once. */
223 if (!BCOPY_DOWNWARD_SAFE && i > from - to)
224 i = from - to;
225 new_s1 += i;
226 bcopy (from, to, i);
227 from += i, to += i;
229 else
230 #endif
232 new_s1 += i;
233 while (--i >= 0)
234 *to++ = *from++;
238 adjust_markers (GPT + GAP_SIZE, pos + 1 + GAP_SIZE, - GAP_SIZE);
239 GPT = pos + 1;
240 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
241 QUIT;
244 /* Add AMOUNT to the position of every marker in the current buffer
245 whose current position is between FROM (exclusive) and TO (inclusive).
247 Also, any markers past the outside of that interval, in the direction
248 of adjustment, are first moved back to the near end of the interval
249 and then adjusted by AMOUNT.
251 When the latter adjustment is done, if AMOUNT is negative,
252 we record the adjustment for undo. (This case happens only for
253 deletion.) */
255 static void
256 adjust_markers (from, to, amount)
257 register int from, to, amount;
259 Lisp_Object marker;
260 register struct Lisp_Marker *m;
261 register int mpos;
263 marker = BUF_MARKERS (current_buffer);
265 while (!NILP (marker))
267 m = XMARKER (marker);
268 mpos = m->bufpos;
269 if (amount > 0)
271 if (mpos > to && mpos < to + amount)
272 mpos = to + amount;
274 else
276 /* Here's the case where a marker is inside text being deleted.
277 AMOUNT can be negative for gap motion, too,
278 but then this range contains no markers. */
279 if (mpos > from + amount && mpos <= from)
281 int before = mpos;
282 int after = from + amount;
284 mpos = after;
286 /* Compute the before and after positions
287 as buffer positions. */
288 if (before > GPT + GAP_SIZE)
289 before -= GAP_SIZE;
290 else if (before > GPT)
291 before = GPT;
293 if (after > GPT + GAP_SIZE)
294 after -= GAP_SIZE;
295 else if (after > GPT)
296 after = GPT;
298 record_marker_adjustment (marker, after - before);
301 if (mpos > from && mpos <= to)
302 mpos += amount;
303 m->bufpos = mpos;
304 marker = m->chain;
308 /* Adjust markers whose insertion-type is t
309 for an insertion of AMOUNT characters at POS. */
311 static void
312 adjust_markers_for_insert (pos, amount)
313 register int pos, amount;
315 Lisp_Object marker;
316 int adjusted = 0;
318 marker = BUF_MARKERS (current_buffer);
320 while (!NILP (marker))
322 register struct Lisp_Marker *m = XMARKER (marker);
323 if (m->insertion_type && m->bufpos == pos)
325 m->bufpos += amount;
326 adjusted = 1;
328 marker = m->chain;
330 if (adjusted)
331 /* Adjusting only markers whose insertion-type is t may result in
332 disordered overlays in the slot `overlays_before'. */
333 fix_overlays_before (current_buffer, pos, pos + amount);
336 /* Add the specified amount to point. This is used only when the value
337 of point changes due to an insert or delete; it does not represent
338 a conceptual change in point as a marker. In particular, point is
339 not crossing any interval boundaries, so there's no need to use the
340 usual SET_PT macro. In fact it would be incorrect to do so, because
341 either the old or the new value of point is out of sync with the
342 current set of intervals. */
343 static void
344 adjust_point (amount)
345 int amount;
347 BUF_PT (current_buffer) += amount;
350 /* Make the gap INCREMENT characters longer. */
352 void
353 make_gap (increment)
354 int increment;
356 unsigned char *result;
357 Lisp_Object tem;
358 int real_gap_loc;
359 int old_gap_size;
361 /* If we have to get more space, get enough to last a while. */
362 increment += 2000;
364 /* Don't allow a buffer size that won't fit in an int
365 even if it will fit in a Lisp integer.
366 That won't work because so many places use `int'. */
368 if (Z - BEG + GAP_SIZE + increment
369 >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1)))
370 error ("Buffer exceeds maximum size");
372 BLOCK_INPUT;
373 /* We allocate extra 1-byte `\0' at the tail for anchoring a search. */
374 result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment + 1));
376 if (result == 0)
378 UNBLOCK_INPUT;
379 memory_full ();
382 /* We can't unblock until the new address is properly stored. */
383 BEG_ADDR = result;
384 UNBLOCK_INPUT;
386 /* Prevent quitting in move_gap. */
387 tem = Vinhibit_quit;
388 Vinhibit_quit = Qt;
390 real_gap_loc = GPT;
391 old_gap_size = GAP_SIZE;
393 /* Call the newly allocated space a gap at the end of the whole space. */
394 GPT = Z + GAP_SIZE;
395 GAP_SIZE = increment;
397 /* Move the new gap down to be consecutive with the end of the old one.
398 This adjusts the markers properly too. */
399 gap_left (real_gap_loc + old_gap_size, 1);
401 /* Now combine the two into one large gap. */
402 GAP_SIZE += old_gap_size;
403 GPT = real_gap_loc;
405 /* Put an anchor. */
406 *(Z_ADDR) = 0;
408 Vinhibit_quit = tem;
411 /* Insert a string of specified length before point.
412 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
413 prepare_to_modify_buffer could relocate the text. */
415 void
416 insert (string, length)
417 register unsigned char *string;
418 register length;
420 if (length > 0)
422 insert_1 (string, length, 0, 1);
423 signal_after_change (PT-length, 0, length);
427 void
428 insert_and_inherit (string, length)
429 register unsigned char *string;
430 register length;
432 if (length > 0)
434 insert_1 (string, length, 1, 1);
435 signal_after_change (PT-length, 0, length);
439 void
440 insert_1 (string, length, inherit, prepare)
441 register unsigned char *string;
442 register int length;
443 int inherit, prepare;
445 register Lisp_Object temp;
447 if (prepare)
448 prepare_to_modify_buffer (PT, PT, NULL);
450 if (PT != GPT)
451 move_gap (PT);
452 if (GAP_SIZE < length)
453 make_gap (length - GAP_SIZE);
455 record_insert (PT, length);
456 MODIFF++;
458 bcopy (string, GPT_ADDR, length);
460 #ifdef USE_TEXT_PROPERTIES
461 if (BUF_INTERVALS (current_buffer) != 0)
462 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
463 offset_intervals (current_buffer, PT, length);
464 #endif
466 GAP_SIZE -= length;
467 GPT += length;
468 ZV += length;
469 Z += length;
470 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
471 adjust_overlays_for_insert (PT, length);
472 adjust_markers_for_insert (PT, length);
473 adjust_point (length);
475 #ifdef USE_TEXT_PROPERTIES
476 if (!inherit && BUF_INTERVALS (current_buffer) != 0)
477 Fset_text_properties (make_number (PT - length), make_number (PT),
478 Qnil, Qnil);
479 #endif
482 /* Insert the part of the text of STRING, a Lisp object assumed to be
483 of type string, consisting of the LENGTH characters starting at
484 position POS. If the text of STRING has properties, they are absorbed
485 into the buffer.
487 It does not work to use `insert' for this, because a GC could happen
488 before we bcopy the stuff into the buffer, and relocate the string
489 without insert noticing. */
491 void
492 insert_from_string (string, pos, length, inherit)
493 Lisp_Object string;
494 register int pos, length;
495 int inherit;
497 if (length > 0)
499 insert_from_string_1 (string, pos, length, inherit);
500 signal_after_change (PT-length, 0, length);
504 static void
505 insert_from_string_1 (string, pos, length, inherit)
506 Lisp_Object string;
507 register int pos, length;
508 int inherit;
510 register Lisp_Object temp;
511 struct gcpro gcpro1;
513 /* Make sure point-max won't overflow after this insertion. */
514 XSETINT (temp, length + Z);
515 if (length + Z != XINT (temp))
516 error ("maximum buffer size exceeded");
518 GCPRO1 (string);
519 prepare_to_modify_buffer (PT, PT, NULL);
521 if (PT != GPT)
522 move_gap (PT);
523 if (GAP_SIZE < length)
524 make_gap (length - GAP_SIZE);
526 record_insert (PT, length);
527 MODIFF++;
528 UNGCPRO;
530 bcopy (XSTRING (string)->data, GPT_ADDR, length);
532 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
533 offset_intervals (current_buffer, PT, length);
535 GAP_SIZE -= length;
536 GPT += length;
537 ZV += length;
538 Z += length;
539 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
540 adjust_overlays_for_insert (PT, length);
541 adjust_markers_for_insert (PT, length);
543 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
544 graft_intervals_into_buffer (XSTRING (string)->intervals, PT, length,
545 current_buffer, inherit);
547 adjust_point (length);
550 /* Insert text from BUF, starting at POS and having length LENGTH, into the
551 current buffer. If the text in BUF has properties, they are absorbed
552 into the current buffer.
554 It does not work to use `insert' for this, because a malloc could happen
555 and relocate BUF's text before the bcopy happens. */
557 void
558 insert_from_buffer (buf, pos, length, inherit)
559 struct buffer *buf;
560 int pos, length;
561 int inherit;
563 if (length > 0)
565 insert_from_buffer_1 (buf, pos, length, inherit);
566 signal_after_change (PT-length, 0, length);
570 static void
571 insert_from_buffer_1 (buf, pos, length, inherit)
572 struct buffer *buf;
573 int pos, length;
574 int inherit;
576 register Lisp_Object temp;
577 int chunk;
579 /* Make sure point-max won't overflow after this insertion. */
580 XSETINT (temp, length + Z);
581 if (length + Z != XINT (temp))
582 error ("maximum buffer size exceeded");
584 prepare_to_modify_buffer (PT, PT, NULL);
586 if (PT != GPT)
587 move_gap (PT);
588 if (GAP_SIZE < length)
589 make_gap (length - GAP_SIZE);
591 record_insert (PT, length);
592 MODIFF++;
594 if (pos < BUF_GPT (buf))
596 chunk = BUF_GPT (buf) - pos;
597 if (chunk > length)
598 chunk = length;
599 bcopy (BUF_CHAR_ADDRESS (buf, pos), GPT_ADDR, chunk);
601 else
602 chunk = 0;
603 if (chunk < length)
604 bcopy (BUF_CHAR_ADDRESS (buf, pos + chunk),
605 GPT_ADDR + chunk, length - chunk);
607 #ifdef USE_TEXT_PROPERTIES
608 if (BUF_INTERVALS (current_buffer) != 0)
609 offset_intervals (current_buffer, PT, length);
610 #endif
612 GAP_SIZE -= length;
613 GPT += length;
614 ZV += length;
615 Z += length;
616 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
617 adjust_overlays_for_insert (PT, length);
618 adjust_markers_for_insert (PT, length);
619 adjust_point (length);
621 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
622 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf),
623 pos, length),
624 PT - length, length, current_buffer, inherit);
627 /* Insert the character C before point */
629 void
630 insert_char (c)
631 int c;
633 unsigned char workbuf[4], *str;
634 int len = CHAR_STRING (c, workbuf, str);
636 insert (str, len);
639 /* Insert the null-terminated string S before point */
641 void
642 insert_string (s)
643 char *s;
645 insert (s, strlen (s));
648 /* Like `insert' except that all markers pointing at the place where
649 the insertion happens are adjusted to point after it.
650 Don't use this function to insert part of a Lisp string,
651 since gc could happen and relocate it. */
653 void
654 insert_before_markers (string, length)
655 unsigned char *string;
656 register int length;
658 if (length > 0)
660 register int opoint = PT;
661 insert_1 (string, length, 0, 1);
662 adjust_markers (opoint - 1, opoint, length);
663 signal_after_change (PT-length, 0, length);
667 void
668 insert_before_markers_and_inherit (string, length)
669 unsigned char *string;
670 register int length;
672 if (length > 0)
674 register int opoint = PT;
675 insert_1 (string, length, 1, 1);
676 adjust_markers (opoint - 1, opoint, length);
677 signal_after_change (PT-length, 0, length);
681 /* Insert part of a Lisp string, relocating markers after. */
683 void
684 insert_from_string_before_markers (string, pos, length, inherit)
685 Lisp_Object string;
686 register int pos, length;
687 int inherit;
689 if (length > 0)
691 register int opoint = PT;
692 insert_from_string_1 (string, pos, length, inherit);
693 adjust_markers (opoint - 1, opoint, length);
694 signal_after_change (PT-length, 0, length);
698 /* Replace the text from FROM to TO with NEW,
699 If PREPARE is nonzero, call prepare_to_modify_buffer.
700 If INHERIT, the newly inserted text should inherit text properties
701 from the surrounding non-deleted text. */
703 /* Note that this does not yet handle markers quite right.
704 Also it needs to record a single undo-entry that does a replacement
705 rather than a separate delete and insert.
706 That way, undo will also handle markers properly. */
708 void
709 replace_range (from, to, new, prepare, inherit)
710 Lisp_Object new;
711 int from, to, prepare, inherit;
713 int numdel;
714 int inslen = XSTRING (new)->size;
715 register Lisp_Object temp;
716 struct gcpro gcpro1;
718 GCPRO1 (new);
720 if (prepare)
722 int range_length = to - from;
723 prepare_to_modify_buffer (from, to, &from);
724 to = from + range_length;
727 /* Make args be valid */
728 if (from < BEGV)
729 from = BEGV;
730 if (to > ZV)
731 to = ZV;
733 UNGCPRO;
735 numdel = to - from;
737 /* Make sure point-max won't overflow after this insertion. */
738 XSETINT (temp, Z - numdel + inslen);
739 if (Z - numdel + inslen != XINT (temp))
740 error ("maximum buffer size exceeded");
742 if (numdel <= 0 && inslen == 0)
743 return;
745 GCPRO1 (new);
747 /* Make sure the gap is somewhere in or next to what we are deleting. */
748 if (from > GPT)
749 gap_right (from);
750 if (to < GPT)
751 gap_left (to, 0);
753 /* Relocate all markers pointing into the new, larger gap
754 to point at the end of the text before the gap.
755 This has to be done before recording the deletion,
756 so undo handles this after reinserting the text. */
757 adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
759 record_delete (from, numdel);
761 GAP_SIZE += numdel;
762 ZV -= numdel;
763 Z -= numdel;
764 GPT = from;
765 *(GPT_ADDR) = 0; /* Put an anchor. */
767 if (GPT - BEG < beg_unchanged)
768 beg_unchanged = GPT - BEG;
769 if (Z - GPT < end_unchanged)
770 end_unchanged = Z - GPT;
772 if (GAP_SIZE < inslen)
773 make_gap (inslen - GAP_SIZE);
775 record_insert (from, inslen);
777 bcopy (XSTRING (new)->data, GPT_ADDR, inslen);
779 /* Relocate point as if it were a marker. */
780 if (from < PT)
781 adjust_point (from + inslen - (PT < to ? PT : to));
783 #ifdef USE_TEXT_PROPERTIES
784 offset_intervals (current_buffer, PT, inslen - numdel);
785 #endif
787 GAP_SIZE -= inslen;
788 GPT += inslen;
789 ZV += inslen;
790 Z += inslen;
791 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
793 /* Adjust the overlay center as needed. This must be done after
794 adjusting the markers that bound the overlays. */
795 adjust_overlays_for_delete (from, numdel);
796 adjust_overlays_for_insert (from, inslen);
797 adjust_markers_for_insert (from, inslen);
799 #ifdef USE_TEXT_PROPERTIES
800 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
801 graft_intervals_into_buffer (XSTRING (new)->intervals, from, inslen,
802 current_buffer, inherit);
803 #endif
805 if (inslen == 0)
806 evaporate_overlays (from);
808 MODIFF++;
809 UNGCPRO;
811 signal_after_change (from, numdel, inslen);
814 /* Delete characters in current buffer
815 from FROM up to (but not including) TO. */
817 void
818 del_range (from, to)
819 register int from, to;
821 del_range_1 (from, to, 1);
824 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
826 void
827 del_range_1 (from, to, prepare)
828 int from, to, prepare;
830 register int numdel;
832 if (prepare)
834 int range_length = to - from;
835 prepare_to_modify_buffer (from, to, &from);
836 to = from + range_length;
839 /* Make args be valid */
840 if (from < BEGV)
841 from = BEGV;
842 if (to > ZV)
843 to = ZV;
845 if ((numdel = to - from) <= 0)
846 return;
848 /* Make sure the gap is somewhere in or next to what we are deleting. */
849 if (from > GPT)
850 gap_right (from);
851 if (to < GPT)
852 gap_left (to, 0);
854 /* Relocate all markers pointing into the new, larger gap
855 to point at the end of the text before the gap.
856 This has to be done before recording the deletion,
857 so undo handles this after reinserting the text. */
858 adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
860 record_delete (from, numdel);
861 MODIFF++;
863 /* Relocate point as if it were a marker. */
864 if (from < PT)
865 adjust_point (from - (PT < to ? PT : to));
867 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
868 offset_intervals (current_buffer, from, - numdel);
870 /* Adjust the overlay center as needed. This must be done after
871 adjusting the markers that bound the overlays. */
872 adjust_overlays_for_delete (from, numdel);
874 GAP_SIZE += numdel;
875 ZV -= numdel;
876 Z -= numdel;
877 GPT = from;
878 *(GPT_ADDR) = 0; /* Put an anchor. */
880 if (GPT - BEG < beg_unchanged)
881 beg_unchanged = GPT - BEG;
882 if (Z - GPT < end_unchanged)
883 end_unchanged = Z - GPT;
885 evaporate_overlays (from);
886 signal_after_change (from, numdel, 0);
889 /* Call this if you're about to change the region of BUFFER from START
890 to END. This checks the read-only properties of the region, calls
891 the necessary modification hooks, and warns the next redisplay that
892 it should pay attention to that area. */
893 void
894 modify_region (buffer, start, end)
895 struct buffer *buffer;
896 int start, end;
898 struct buffer *old_buffer = current_buffer;
900 if (buffer != old_buffer)
901 set_buffer_internal (buffer);
903 prepare_to_modify_buffer (start, end, NULL);
905 if (start - 1 < beg_unchanged
906 || (unchanged_modified == MODIFF
907 && overlay_unchanged_modified == OVERLAY_MODIFF))
908 beg_unchanged = start - 1;
909 if (Z - end < end_unchanged
910 || (unchanged_modified == MODIFF
911 && overlay_unchanged_modified == OVERLAY_MODIFF))
912 end_unchanged = Z - end;
914 if (MODIFF <= SAVE_MODIFF)
915 record_first_change ();
916 MODIFF++;
918 buffer->point_before_scroll = Qnil;
920 if (buffer != old_buffer)
921 set_buffer_internal (old_buffer);
924 /* Check that it is okay to modify the buffer between START and END.
925 Run the before-change-function, if any. If intervals are in use,
926 verify that the text to be modified is not read-only, and call
927 any modification properties the text may have.
929 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
930 by holding its value temporarily in a marker. */
932 void
933 prepare_to_modify_buffer (start, end, preserve_ptr)
934 int start, end;
935 int *preserve_ptr;
937 if (!NILP (current_buffer->read_only))
938 Fbarf_if_buffer_read_only ();
940 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
941 if (BUF_INTERVALS (current_buffer) != 0)
943 if (preserve_ptr)
945 Lisp_Object preserve_marker;
946 struct gcpro gcpro1;
947 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil);
948 GCPRO1 (preserve_marker);
949 verify_interval_modification (current_buffer, start, end);
950 *preserve_ptr = marker_position (preserve_marker);
951 unchain_marker (preserve_marker);
952 UNGCPRO;
954 else
955 verify_interval_modification (current_buffer, start, end);
958 #ifdef CLASH_DETECTION
959 if (!NILP (current_buffer->file_truename)
960 /* Make binding buffer-file-name to nil effective. */
961 && !NILP (current_buffer->filename)
962 && SAVE_MODIFF >= MODIFF)
963 lock_file (current_buffer->file_truename);
964 #else
965 /* At least warn if this file has changed on disk since it was visited. */
966 if (!NILP (current_buffer->filename)
967 && SAVE_MODIFF >= MODIFF
968 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
969 && !NILP (Ffile_exists_p (current_buffer->filename)))
970 call1 (intern ("ask-user-about-supersession-threat"),
971 current_buffer->filename);
972 #endif /* not CLASH_DETECTION */
974 signal_before_change (start, end, preserve_ptr);
976 if (current_buffer->newline_cache)
977 invalidate_region_cache (current_buffer,
978 current_buffer->newline_cache,
979 start - BEG, Z - end);
980 if (current_buffer->width_run_cache)
981 invalidate_region_cache (current_buffer,
982 current_buffer->width_run_cache,
983 start - BEG, Z - end);
985 Vdeactivate_mark = Qt;
988 /* These macros work with an argument named `preserve_ptr'
989 and a local variable named `preserve_marker'. */
991 #define PRESERVE_VALUE \
992 if (preserve_ptr && NILP (preserve_marker)) \
993 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil)
995 #define RESTORE_VALUE \
996 if (! NILP (preserve_marker)) \
998 *preserve_ptr = marker_position (preserve_marker); \
999 unchain_marker (preserve_marker); \
1002 #define PRESERVE_START_END \
1003 if (NILP (start_marker)) \
1004 start_marker = Fcopy_marker (start, Qnil); \
1005 if (NILP (end_marker)) \
1006 end_marker = Fcopy_marker (end, Qnil);
1008 #define FETCH_START \
1009 (! NILP (start_marker) ? Fmarker_position (start_marker) : start)
1011 #define FETCH_END \
1012 (! NILP (end_marker) ? Fmarker_position (end_marker) : end)
1014 /* Signal a change to the buffer immediately before it happens.
1015 START_INT and END_INT are the bounds of the text to be changed.
1017 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1018 by holding its value temporarily in a marker. */
1020 void
1021 signal_before_change (start_int, end_int, preserve_ptr)
1022 int start_int, end_int;
1023 int *preserve_ptr;
1025 Lisp_Object start, end;
1026 Lisp_Object start_marker, end_marker;
1027 Lisp_Object preserve_marker;
1028 struct gcpro gcpro1, gcpro2, gcpro3;
1030 start = make_number (start_int);
1031 end = make_number (end_int);
1032 preserve_marker = Qnil;
1033 start_marker = Qnil;
1034 end_marker = Qnil;
1035 GCPRO3 (preserve_marker, start_marker, end_marker);
1037 /* If buffer is unmodified, run a special hook for that case. */
1038 if (SAVE_MODIFF >= MODIFF
1039 && !NILP (Vfirst_change_hook)
1040 && !NILP (Vrun_hooks))
1042 PRESERVE_VALUE;
1043 PRESERVE_START_END;
1044 call1 (Vrun_hooks, Qfirst_change_hook);
1047 /* Run the before-change-function if any.
1048 We don't bother "binding" this variable to nil
1049 because it is obsolete anyway and new code should not use it. */
1050 if (!NILP (Vbefore_change_function))
1052 PRESERVE_VALUE;
1053 PRESERVE_START_END;
1054 call2 (Vbefore_change_function, FETCH_START, FETCH_END);
1057 /* Now run the before-change-functions if any. */
1058 if (!NILP (Vbefore_change_functions))
1060 Lisp_Object args[3];
1061 Lisp_Object before_change_functions;
1062 Lisp_Object after_change_functions;
1063 struct gcpro gcpro1, gcpro2;
1065 PRESERVE_VALUE;
1066 PRESERVE_START_END;
1068 /* "Bind" before-change-functions and after-change-functions
1069 to nil--but in a way that errors don't know about.
1070 That way, if there's an error in them, they will stay nil. */
1071 before_change_functions = Vbefore_change_functions;
1072 after_change_functions = Vafter_change_functions;
1073 Vbefore_change_functions = Qnil;
1074 Vafter_change_functions = Qnil;
1075 GCPRO2 (before_change_functions, after_change_functions);
1077 /* Actually run the hook functions. */
1078 args[0] = Qbefore_change_functions;
1079 args[1] = FETCH_START;
1080 args[2] = FETCH_END;
1081 run_hook_list_with_args (before_change_functions, 3, args);
1083 /* "Unbind" the variables we "bound" to nil. */
1084 Vbefore_change_functions = before_change_functions;
1085 Vafter_change_functions = after_change_functions;
1086 UNGCPRO;
1089 if (!NILP (current_buffer->overlays_before)
1090 || !NILP (current_buffer->overlays_after))
1092 PRESERVE_VALUE;
1093 report_overlay_modification (FETCH_START, FETCH_END, 0,
1094 FETCH_START, FETCH_END, Qnil);
1097 if (! NILP (start_marker))
1098 free_marker (start_marker);
1099 if (! NILP (end_marker))
1100 free_marker (end_marker);
1101 RESTORE_VALUE;
1102 UNGCPRO;
1105 /* Signal a change immediately after it happens.
1106 POS is the address of the start of the changed text.
1107 LENDEL is the number of characters of the text before the change.
1108 (Not the whole buffer; just the part that was changed.)
1109 LENINS is the number of characters in that part of the text
1110 after the change. */
1112 void
1113 signal_after_change (pos, lendel, lenins)
1114 int pos, lendel, lenins;
1116 /* If we are deferring calls to the after-change functions
1117 and there are no before-change functions,
1118 just record the args that we were going to use. */
1119 if (! NILP (Vcombine_after_change_calls)
1120 && NILP (Vbefore_change_function) && NILP (Vbefore_change_functions)
1121 && NILP (current_buffer->overlays_before)
1122 && NILP (current_buffer->overlays_after))
1124 Lisp_Object elt;
1126 if (!NILP (combine_after_change_list)
1127 && current_buffer != XBUFFER (combine_after_change_buffer))
1128 Fcombine_after_change_execute ();
1130 elt = Fcons (make_number (pos - BEG),
1131 Fcons (make_number (Z - (pos - lendel + lenins)),
1132 Fcons (make_number (lenins - lendel), Qnil)));
1133 combine_after_change_list
1134 = Fcons (elt, combine_after_change_list);
1135 combine_after_change_buffer = Fcurrent_buffer ();
1137 return;
1140 if (!NILP (combine_after_change_list))
1141 Fcombine_after_change_execute ();
1143 /* Run the after-change-function if any.
1144 We don't bother "binding" this variable to nil
1145 because it is obsolete anyway and new code should not use it. */
1146 if (!NILP (Vafter_change_function))
1147 call3 (Vafter_change_function,
1148 make_number (pos), make_number (pos + lenins),
1149 make_number (lendel));
1151 if (!NILP (Vafter_change_functions))
1153 Lisp_Object args[4];
1154 Lisp_Object before_change_functions;
1155 Lisp_Object after_change_functions;
1156 struct gcpro gcpro1, gcpro2;
1158 /* "Bind" before-change-functions and after-change-functions
1159 to nil--but in a way that errors don't know about.
1160 That way, if there's an error in them, they will stay nil. */
1161 before_change_functions = Vbefore_change_functions;
1162 after_change_functions = Vafter_change_functions;
1163 Vbefore_change_functions = Qnil;
1164 Vafter_change_functions = Qnil;
1165 GCPRO2 (before_change_functions, after_change_functions);
1167 /* Actually run the hook functions. */
1168 args[0] = Qafter_change_functions;
1169 XSETFASTINT (args[1], pos);
1170 XSETFASTINT (args[2], pos + lenins);
1171 XSETFASTINT (args[3], lendel);
1172 run_hook_list_with_args (after_change_functions,
1173 4, args);
1175 /* "Unbind" the variables we "bound" to nil. */
1176 Vbefore_change_functions = before_change_functions;
1177 Vafter_change_functions = after_change_functions;
1178 UNGCPRO;
1181 if (!NILP (current_buffer->overlays_before)
1182 || !NILP (current_buffer->overlays_after))
1183 report_overlay_modification (make_number (pos),
1184 make_number (pos + lenins),
1186 make_number (pos), make_number (pos + lenins),
1187 make_number (lendel));
1189 /* After an insertion, call the text properties
1190 insert-behind-hooks or insert-in-front-hooks. */
1191 if (lendel == 0)
1192 report_interval_modification (pos, pos + lenins);
1195 Lisp_Object
1196 Fcombine_after_change_execute_1 (val)
1197 Lisp_Object val;
1199 Vcombine_after_change_calls = val;
1200 return val;
1203 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
1204 Scombine_after_change_execute, 0, 0, 0,
1205 "This function is for use internally in `combine-after-change-calls'.")
1208 register Lisp_Object val;
1209 int count = specpdl_ptr - specpdl;
1210 int beg, end, change;
1211 int begpos, endpos;
1212 Lisp_Object tail;
1214 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1216 Fset_buffer (combine_after_change_buffer);
1218 /* # chars unchanged at beginning of buffer. */
1219 beg = Z - BEG;
1220 /* # chars unchanged at end of buffer. */
1221 end = beg;
1222 /* Total amount of insertion (negative for deletion). */
1223 change = 0;
1225 /* Scan the various individual changes,
1226 accumulating the range info in BEG, END and CHANGE. */
1227 for (tail = combine_after_change_list; CONSP (tail);
1228 tail = XCONS (tail)->cdr)
1230 Lisp_Object elt;
1231 int thisbeg, thisend, thischange;
1233 /* Extract the info from the next element. */
1234 elt = XCONS (tail)->car;
1235 if (! CONSP (elt))
1236 continue;
1237 thisbeg = XINT (XCONS (elt)->car);
1239 elt = XCONS (elt)->cdr;
1240 if (! CONSP (elt))
1241 continue;
1242 thisend = XINT (XCONS (elt)->car);
1244 elt = XCONS (elt)->cdr;
1245 if (! CONSP (elt))
1246 continue;
1247 thischange = XINT (XCONS (elt)->car);
1249 /* Merge this range into the accumulated range. */
1250 change += thischange;
1251 if (thisbeg < beg)
1252 beg = thisbeg;
1253 if (thisend < end)
1254 end = thisend;
1257 /* Get the current start and end positions of the range
1258 that was changed. */
1259 begpos = BEG + beg;
1260 endpos = Z - end;
1262 /* We are about to handle these, so discard them. */
1263 combine_after_change_list = Qnil;
1265 /* Now run the after-change functions for real.
1266 Turn off the flag that defers them. */
1267 record_unwind_protect (Fcombine_after_change_execute_1,
1268 Vcombine_after_change_calls);
1269 signal_after_change (begpos, endpos - begpos - change, endpos - begpos);
1271 return unbind_to (count, val);
1274 syms_of_insdel ()
1276 staticpro (&combine_after_change_list);
1277 combine_after_change_list = Qnil;
1279 DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls,
1280 "Used internally by the `combine-after-change-calls' macro.");
1281 Vcombine_after_change_calls = Qnil;
1283 defsubr (&Scombine_after_change_execute);