(adjust_markers): Don't be confused by the gap
[bpt/emacs.git] / src / insdel.c
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 2, 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21
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"
29
30 #define min(x, y) ((x) < (y) ? (x) : (y))
31
32 static void insert_from_string_1 ();
33 static void insert_from_buffer_1 ();
34 static void gap_left ();
35 static void gap_right ();
36 static void adjust_markers ();
37 static void adjust_point ();
38
39 Lisp_Object Fcombine_after_change_execute ();
40
41 /* Non-nil means don't call the after-change-functions right away,
42 just record an element in Vcombine_after_change_calls_list. */
43 Lisp_Object Vcombine_after_change_calls;
44
45 /* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
46 describing changes which happened while combine_after_change_calls
47 was nonzero. We use this to decide how to call them
48 once the deferral ends.
49
50 In each element.
51 BEG-UNCHANGED is the number of chars before the changed range.
52 END-UNCHANGED is the number of chars after the changed range,
53 and CHANGE-AMOUNT is the number of characters inserted by the change
54 (negative for a deletion). */
55 Lisp_Object combine_after_change_list;
56
57 /* Buffer which combine_after_change_list is about. */
58 Lisp_Object combine_after_change_buffer;
59
60 /* Move gap to position `pos'.
61 Note that this can quit! */
62
63 void
64 move_gap (pos)
65 int pos;
66 {
67 if (pos < GPT)
68 gap_left (pos, 0);
69 else if (pos > GPT)
70 gap_right (pos);
71 }
72
73 /* Move the gap to POS, which is less than the current GPT.
74 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
75
76 static void
77 gap_left (pos, newgap)
78 register int pos;
79 int newgap;
80 {
81 register unsigned char *to, *from;
82 register int i;
83 int new_s1;
84
85 pos--;
86
87 if (!newgap)
88 {
89 if (unchanged_modified == MODIFF
90 && overlay_unchanged_modified == OVERLAY_MODIFF)
91 {
92 beg_unchanged = pos;
93 end_unchanged = Z - pos - 1;
94 }
95 else
96 {
97 if (Z - GPT < end_unchanged)
98 end_unchanged = Z - GPT;
99 if (pos < beg_unchanged)
100 beg_unchanged = pos;
101 }
102 }
103
104 i = GPT;
105 to = GAP_END_ADDR;
106 from = GPT_ADDR;
107 new_s1 = GPT - BEG;
108
109 /* Now copy the characters. To move the gap down,
110 copy characters up. */
111
112 while (1)
113 {
114 /* I gets number of characters left to copy. */
115 i = new_s1 - pos;
116 if (i == 0)
117 break;
118 /* If a quit is requested, stop copying now.
119 Change POS to be where we have actually moved the gap to. */
120 if (QUITP)
121 {
122 pos = new_s1;
123 break;
124 }
125 /* Move at most 32000 chars before checking again for a quit. */
126 if (i > 32000)
127 i = 32000;
128 #ifdef GAP_USE_BCOPY
129 if (i >= 128
130 /* bcopy is safe if the two areas of memory do not overlap
131 or on systems where bcopy is always safe for moving upward. */
132 && (BCOPY_UPWARD_SAFE
133 || to - from >= 128))
134 {
135 /* If overlap is not safe, avoid it by not moving too many
136 characters at once. */
137 if (!BCOPY_UPWARD_SAFE && i > to - from)
138 i = to - from;
139 new_s1 -= i;
140 from -= i, to -= i;
141 bcopy (from, to, i);
142 }
143 else
144 #endif
145 {
146 new_s1 -= i;
147 while (--i >= 0)
148 *--to = *--from;
149 }
150 }
151
152 /* Adjust markers, and buffer data structure, to put the gap at POS.
153 POS is where the loop above stopped, which may be what was specified
154 or may be where a quit was detected. */
155 adjust_markers (pos + 1, GPT, GAP_SIZE);
156 GPT = pos + 1;
157 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
158 QUIT;
159 }
160
161 static void
162 gap_right (pos)
163 register int pos;
164 {
165 register unsigned char *to, *from;
166 register int i;
167 int new_s1;
168
169 pos--;
170
171 if (unchanged_modified == MODIFF
172 && overlay_unchanged_modified == OVERLAY_MODIFF)
173
174 {
175 beg_unchanged = pos;
176 end_unchanged = Z - pos - 1;
177 }
178 else
179 {
180 if (Z - pos - 1 < end_unchanged)
181 end_unchanged = Z - pos - 1;
182 if (GPT - BEG < beg_unchanged)
183 beg_unchanged = GPT - BEG;
184 }
185
186 i = GPT;
187 from = GAP_END_ADDR;
188 to = GPT_ADDR;
189 new_s1 = GPT - 1;
190
191 /* Now copy the characters. To move the gap up,
192 copy characters down. */
193
194 while (1)
195 {
196 /* I gets number of characters left to copy. */
197 i = pos - new_s1;
198 if (i == 0)
199 break;
200 /* If a quit is requested, stop copying now.
201 Change POS to be where we have actually moved the gap to. */
202 if (QUITP)
203 {
204 pos = new_s1;
205 break;
206 }
207 /* Move at most 32000 chars before checking again for a quit. */
208 if (i > 32000)
209 i = 32000;
210 #ifdef GAP_USE_BCOPY
211 if (i >= 128
212 /* bcopy is safe if the two areas of memory do not overlap
213 or on systems where bcopy is always safe for moving downward. */
214 && (BCOPY_DOWNWARD_SAFE
215 || from - to >= 128))
216 {
217 /* If overlap is not safe, avoid it by not moving too many
218 characters at once. */
219 if (!BCOPY_DOWNWARD_SAFE && i > from - to)
220 i = from - to;
221 new_s1 += i;
222 bcopy (from, to, i);
223 from += i, to += i;
224 }
225 else
226 #endif
227 {
228 new_s1 += i;
229 while (--i >= 0)
230 *to++ = *from++;
231 }
232 }
233
234 adjust_markers (GPT + GAP_SIZE, pos + 1 + GAP_SIZE, - GAP_SIZE);
235 GPT = pos + 1;
236 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
237 QUIT;
238 }
239
240 /* Add AMOUNT to the position of every marker in the current buffer
241 whose current position is between FROM (exclusive) and TO (inclusive).
242
243 Also, any markers past the outside of that interval, in the direction
244 of adjustment, are first moved back to the near end of the interval
245 and then adjusted by AMOUNT.
246
247 When the latter adjustment is done, if AMOUNT is negative,
248 we record the adjustment for undo. (This case happens only for
249 deletion.) */
250
251 static void
252 adjust_markers (from, to, amount)
253 register int from, to, amount;
254 {
255 Lisp_Object marker;
256 register struct Lisp_Marker *m;
257 register int mpos;
258
259 marker = BUF_MARKERS (current_buffer);
260
261 while (!NILP (marker))
262 {
263 m = XMARKER (marker);
264 mpos = m->bufpos;
265 if (amount > 0)
266 {
267 if (mpos > to && mpos < to + amount)
268 mpos = to + amount;
269 }
270 else
271 {
272 /* Here's the case where a marker is inside text being deleted.
273 AMOUNT can be negative for gap motion, too,
274 but then this range contains no markers. */
275 if (mpos > from + amount && mpos <= from)
276 {
277 int before = mpos;
278 int after = from + amount;
279
280 mpos = after;
281
282 /* Compute the before and after positions
283 as buffer positions. */
284 if (before > GPT + GAP_SIZE)
285 before -= GAP_SIZE;
286 else if (before > GPT)
287 before = GPT;
288
289 if (after > GPT + GAP_SIZE)
290 after -= GAP_SIZE;
291 else if (after > GPT)
292 after = GPT;
293
294 record_marker_adjustment (marker, after - before);
295 }
296 }
297 if (mpos > from && mpos <= to)
298 mpos += amount;
299 m->bufpos = mpos;
300 marker = m->chain;
301 }
302 }
303
304 /* Adjust markers whose insertion-type is t
305 for an insertion of AMOUNT characters at POS. */
306
307 static void
308 adjust_markers_for_insert (pos, amount)
309 register int pos, amount;
310 {
311 Lisp_Object marker;
312 int adjusted = 0;
313
314 marker = BUF_MARKERS (current_buffer);
315
316 while (!NILP (marker))
317 {
318 register struct Lisp_Marker *m = XMARKER (marker);
319 if (m->insertion_type && m->bufpos == pos)
320 {
321 m->bufpos += amount;
322 adjusted = 1;
323 }
324 marker = m->chain;
325 }
326 if (adjusted)
327 /* Adjusting only markers whose insertion-type is t may result in
328 disordered overlays in the slot `overlays_before'. */
329 fix_overlays_before (current_buffer, pos, pos + amount);
330 }
331
332 /* Add the specified amount to point. This is used only when the value
333 of point changes due to an insert or delete; it does not represent
334 a conceptual change in point as a marker. In particular, point is
335 not crossing any interval boundaries, so there's no need to use the
336 usual SET_PT macro. In fact it would be incorrect to do so, because
337 either the old or the new value of point is out of sync with the
338 current set of intervals. */
339 static void
340 adjust_point (amount)
341 int amount;
342 {
343 BUF_PT (current_buffer) += amount;
344 }
345 \f
346 /* Make the gap INCREMENT characters longer. */
347
348 void
349 make_gap (increment)
350 int increment;
351 {
352 unsigned char *result;
353 Lisp_Object tem;
354 int real_gap_loc;
355 int old_gap_size;
356
357 /* If we have to get more space, get enough to last a while. */
358 increment += 2000;
359
360 /* Don't allow a buffer size that won't fit in an int
361 even if it will fit in a Lisp integer.
362 That won't work because so many places use `int'. */
363
364 if (Z - BEG + GAP_SIZE + increment
365 >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1)))
366 error ("Buffer exceeds maximum size");
367
368 BLOCK_INPUT;
369 /* We allocate extra 1-byte `\0' at the tail for anchoring a search. */
370 result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment + 1));
371
372 if (result == 0)
373 {
374 UNBLOCK_INPUT;
375 memory_full ();
376 }
377
378 /* We can't unblock until the new address is properly stored. */
379 BEG_ADDR = result;
380 UNBLOCK_INPUT;
381
382 /* Prevent quitting in move_gap. */
383 tem = Vinhibit_quit;
384 Vinhibit_quit = Qt;
385
386 real_gap_loc = GPT;
387 old_gap_size = GAP_SIZE;
388
389 /* Call the newly allocated space a gap at the end of the whole space. */
390 GPT = Z + GAP_SIZE;
391 GAP_SIZE = increment;
392
393 /* Move the new gap down to be consecutive with the end of the old one.
394 This adjusts the markers properly too. */
395 gap_left (real_gap_loc + old_gap_size, 1);
396
397 /* Now combine the two into one large gap. */
398 GAP_SIZE += old_gap_size;
399 GPT = real_gap_loc;
400
401 /* Put an anchor. */
402 *(Z_ADDR) = 0;
403
404 Vinhibit_quit = tem;
405 }
406 \f
407 /* Insert a string of specified length before point.
408 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
409 prepare_to_modify_buffer could relocate the text. */
410
411 void
412 insert (string, length)
413 register unsigned char *string;
414 register length;
415 {
416 if (length > 0)
417 {
418 insert_1 (string, length, 0, 1);
419 signal_after_change (PT-length, 0, length);
420 }
421 }
422
423 void
424 insert_and_inherit (string, length)
425 register unsigned char *string;
426 register length;
427 {
428 if (length > 0)
429 {
430 insert_1 (string, length, 1, 1);
431 signal_after_change (PT-length, 0, length);
432 }
433 }
434
435 void
436 insert_1 (string, length, inherit, prepare)
437 register unsigned char *string;
438 register int length;
439 int inherit, prepare;
440 {
441 register Lisp_Object temp;
442
443 if (prepare)
444 prepare_to_modify_buffer (PT, PT);
445
446 if (PT != GPT)
447 move_gap (PT);
448 if (GAP_SIZE < length)
449 make_gap (length - GAP_SIZE);
450
451 record_insert (PT, length);
452 MODIFF++;
453
454 bcopy (string, GPT_ADDR, length);
455
456 #ifdef USE_TEXT_PROPERTIES
457 if (BUF_INTERVALS (current_buffer) != 0)
458 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
459 offset_intervals (current_buffer, PT, length);
460 #endif
461
462 GAP_SIZE -= length;
463 GPT += length;
464 ZV += length;
465 Z += length;
466 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
467 adjust_overlays_for_insert (PT, length);
468 adjust_markers_for_insert (PT, length);
469 adjust_point (length);
470
471 #ifdef USE_TEXT_PROPERTIES
472 if (!inherit && BUF_INTERVALS (current_buffer) != 0)
473 Fset_text_properties (make_number (PT - length), make_number (PT),
474 Qnil, Qnil);
475 #endif
476 }
477
478 /* Insert the part of the text of STRING, a Lisp object assumed to be
479 of type string, consisting of the LENGTH characters starting at
480 position POS. If the text of STRING has properties, they are absorbed
481 into the buffer.
482
483 It does not work to use `insert' for this, because a GC could happen
484 before we bcopy the stuff into the buffer, and relocate the string
485 without insert noticing. */
486
487 void
488 insert_from_string (string, pos, length, inherit)
489 Lisp_Object string;
490 register int pos, length;
491 int inherit;
492 {
493 if (length > 0)
494 {
495 insert_from_string_1 (string, pos, length, inherit);
496 signal_after_change (PT-length, 0, length);
497 }
498 }
499
500 static void
501 insert_from_string_1 (string, pos, length, inherit)
502 Lisp_Object string;
503 register int pos, length;
504 int inherit;
505 {
506 register Lisp_Object temp;
507 struct gcpro gcpro1;
508
509 /* Make sure point-max won't overflow after this insertion. */
510 XSETINT (temp, length + Z);
511 if (length + Z != XINT (temp))
512 error ("maximum buffer size exceeded");
513
514 GCPRO1 (string);
515 prepare_to_modify_buffer (PT, PT);
516
517 if (PT != GPT)
518 move_gap (PT);
519 if (GAP_SIZE < length)
520 make_gap (length - GAP_SIZE);
521
522 record_insert (PT, length);
523 MODIFF++;
524 UNGCPRO;
525
526 bcopy (XSTRING (string)->data, GPT_ADDR, length);
527
528 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
529 offset_intervals (current_buffer, PT, length);
530
531 GAP_SIZE -= length;
532 GPT += length;
533 ZV += length;
534 Z += length;
535 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
536 adjust_overlays_for_insert (PT, length);
537 adjust_markers_for_insert (PT, length);
538
539 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
540 graft_intervals_into_buffer (XSTRING (string)->intervals, PT, length,
541 current_buffer, inherit);
542
543 adjust_point (length);
544 }
545
546 /* Insert text from BUF, starting at POS and having length LENGTH, into the
547 current buffer. If the text in BUF has properties, they are absorbed
548 into the current buffer.
549
550 It does not work to use `insert' for this, because a malloc could happen
551 and relocate BUF's text before the bcopy happens. */
552
553 void
554 insert_from_buffer (buf, pos, length, inherit)
555 struct buffer *buf;
556 int pos, length;
557 int inherit;
558 {
559 if (length > 0)
560 {
561 insert_from_buffer_1 (buf, pos, length, inherit);
562 signal_after_change (PT-length, 0, length);
563 }
564 }
565
566 static void
567 insert_from_buffer_1 (buf, pos, length, inherit)
568 struct buffer *buf;
569 int pos, length;
570 int inherit;
571 {
572 register Lisp_Object temp;
573 int chunk;
574
575 /* Make sure point-max won't overflow after this insertion. */
576 XSETINT (temp, length + Z);
577 if (length + Z != XINT (temp))
578 error ("maximum buffer size exceeded");
579
580 prepare_to_modify_buffer (PT, PT);
581
582 if (PT != GPT)
583 move_gap (PT);
584 if (GAP_SIZE < length)
585 make_gap (length - GAP_SIZE);
586
587 record_insert (PT, length);
588 MODIFF++;
589
590 if (pos < BUF_GPT (buf))
591 {
592 chunk = BUF_GPT (buf) - pos;
593 if (chunk > length)
594 chunk = length;
595 bcopy (BUF_CHAR_ADDRESS (buf, pos), GPT_ADDR, chunk);
596 }
597 else
598 chunk = 0;
599 if (chunk < length)
600 bcopy (BUF_CHAR_ADDRESS (buf, pos + chunk),
601 GPT_ADDR + chunk, length - chunk);
602
603 #ifdef USE_TEXT_PROPERTIES
604 if (BUF_INTERVALS (current_buffer) != 0)
605 offset_intervals (current_buffer, PT, length);
606 #endif
607
608 GAP_SIZE -= length;
609 GPT += length;
610 ZV += length;
611 Z += length;
612 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
613 adjust_overlays_for_insert (PT, length);
614 adjust_markers_for_insert (PT, length);
615 adjust_point (length);
616
617 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
618 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf),
619 pos, length),
620 PT - length, length, current_buffer, inherit);
621 }
622
623 /* Insert the character C before point */
624
625 void
626 insert_char (c)
627 int c;
628 {
629 unsigned char workbuf[4], *str;
630 int len = CHAR_STRING (c, workbuf, str);
631
632 insert (str, len);
633 }
634
635 /* Insert the null-terminated string S before point */
636
637 void
638 insert_string (s)
639 char *s;
640 {
641 insert (s, strlen (s));
642 }
643
644 /* Like `insert' except that all markers pointing at the place where
645 the insertion happens are adjusted to point after it.
646 Don't use this function to insert part of a Lisp string,
647 since gc could happen and relocate it. */
648
649 void
650 insert_before_markers (string, length)
651 unsigned char *string;
652 register int length;
653 {
654 if (length > 0)
655 {
656 register int opoint = PT;
657 insert_1 (string, length, 0, 1);
658 adjust_markers (opoint - 1, opoint, length);
659 signal_after_change (PT-length, 0, length);
660 }
661 }
662
663 void
664 insert_before_markers_and_inherit (string, length)
665 unsigned char *string;
666 register int length;
667 {
668 if (length > 0)
669 {
670 register int opoint = PT;
671 insert_1 (string, length, 1, 1);
672 adjust_markers (opoint - 1, opoint, length);
673 signal_after_change (PT-length, 0, length);
674 }
675 }
676
677 /* Insert part of a Lisp string, relocating markers after. */
678
679 void
680 insert_from_string_before_markers (string, pos, length, inherit)
681 Lisp_Object string;
682 register int pos, length;
683 int inherit;
684 {
685 if (length > 0)
686 {
687 register int opoint = PT;
688 insert_from_string_1 (string, pos, length, inherit);
689 adjust_markers (opoint - 1, opoint, length);
690 signal_after_change (PT-length, 0, length);
691 }
692 }
693 \f
694 /* Delete characters in current buffer
695 from FROM up to (but not including) TO. */
696
697 void
698 del_range (from, to)
699 register int from, to;
700 {
701 del_range_1 (from, to, 1);
702 }
703
704 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
705
706 void
707 del_range_1 (from, to, prepare)
708 register int from, to, prepare;
709 {
710 register int numdel;
711
712 /* Make args be valid */
713 if (from < BEGV)
714 from = BEGV;
715 if (to > ZV)
716 to = ZV;
717
718 if ((numdel = to - from) <= 0)
719 return;
720
721 /* Make sure the gap is somewhere in or next to what we are deleting. */
722 if (from > GPT)
723 gap_right (from);
724 if (to < GPT)
725 gap_left (to, 0);
726
727 if (prepare)
728 prepare_to_modify_buffer (from, to);
729
730 /* Relocate all markers pointing into the new, larger gap
731 to point at the end of the text before the gap.
732 This has to be done before recording the deletion,
733 so undo handles this after reinserting the text. */
734 adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
735
736 record_delete (from, numdel);
737 MODIFF++;
738
739 /* Relocate point as if it were a marker. */
740 if (from < PT)
741 adjust_point (from - (PT < to ? PT : to));
742
743 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
744 offset_intervals (current_buffer, from, - numdel);
745
746 /* Adjust the overlay center as needed. This must be done after
747 adjusting the markers that bound the overlays. */
748 adjust_overlays_for_delete (from, numdel);
749
750 GAP_SIZE += numdel;
751 ZV -= numdel;
752 Z -= numdel;
753 GPT = from;
754 *(GPT_ADDR) = 0; /* Put an anchor. */
755
756 if (GPT - BEG < beg_unchanged)
757 beg_unchanged = GPT - BEG;
758 if (Z - GPT < end_unchanged)
759 end_unchanged = Z - GPT;
760
761 evaporate_overlays (from);
762 signal_after_change (from, numdel, 0);
763 }
764 \f
765 /* Call this if you're about to change the region of BUFFER from START
766 to END. This checks the read-only properties of the region, calls
767 the necessary modification hooks, and warns the next redisplay that
768 it should pay attention to that area. */
769 void
770 modify_region (buffer, start, end)
771 struct buffer *buffer;
772 int start, end;
773 {
774 struct buffer *old_buffer = current_buffer;
775
776 if (buffer != old_buffer)
777 set_buffer_internal (buffer);
778
779 prepare_to_modify_buffer (start, end);
780
781 if (start - 1 < beg_unchanged
782 || (unchanged_modified == MODIFF
783 && overlay_unchanged_modified == OVERLAY_MODIFF))
784 beg_unchanged = start - 1;
785 if (Z - end < end_unchanged
786 || (unchanged_modified == MODIFF
787 && overlay_unchanged_modified == OVERLAY_MODIFF))
788 end_unchanged = Z - end;
789
790 if (MODIFF <= SAVE_MODIFF)
791 record_first_change ();
792 MODIFF++;
793
794 buffer->point_before_scroll = Qnil;
795
796 if (buffer != old_buffer)
797 set_buffer_internal (old_buffer);
798 }
799
800 /* Check that it is okay to modify the buffer between START and END.
801 Run the before-change-function, if any. If intervals are in use,
802 verify that the text to be modified is not read-only, and call
803 any modification properties the text may have. */
804
805 void
806 prepare_to_modify_buffer (start, end)
807 int start, end;
808 {
809 if (!NILP (current_buffer->read_only))
810 Fbarf_if_buffer_read_only ();
811
812 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
813 if (BUF_INTERVALS (current_buffer) != 0)
814 verify_interval_modification (current_buffer, start, end);
815
816 #ifdef CLASH_DETECTION
817 if (!NILP (current_buffer->file_truename)
818 /* Make binding buffer-file-name to nil effective. */
819 && !NILP (current_buffer->filename)
820 && SAVE_MODIFF >= MODIFF)
821 lock_file (current_buffer->file_truename);
822 #else
823 /* At least warn if this file has changed on disk since it was visited. */
824 if (!NILP (current_buffer->filename)
825 && SAVE_MODIFF >= MODIFF
826 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
827 && !NILP (Ffile_exists_p (current_buffer->filename)))
828 call1 (intern ("ask-user-about-supersession-threat"),
829 current_buffer->filename);
830 #endif /* not CLASH_DETECTION */
831
832 signal_before_change (start, end);
833
834 if (current_buffer->newline_cache)
835 invalidate_region_cache (current_buffer,
836 current_buffer->newline_cache,
837 start - BEG, Z - end);
838 if (current_buffer->width_run_cache)
839 invalidate_region_cache (current_buffer,
840 current_buffer->width_run_cache,
841 start - BEG, Z - end);
842
843 Vdeactivate_mark = Qt;
844 }
845 \f
846 /* Signal a change to the buffer immediately before it happens.
847 START_INT and END_INT are the bounds of the text to be changed. */
848
849 void
850 signal_before_change (start_int, end_int)
851 int start_int, end_int;
852 {
853 Lisp_Object start, end;
854
855 start = make_number (start_int);
856 end = make_number (end_int);
857
858 /* If buffer is unmodified, run a special hook for that case. */
859 if (SAVE_MODIFF >= MODIFF
860 && !NILP (Vfirst_change_hook)
861 && !NILP (Vrun_hooks))
862 call1 (Vrun_hooks, Qfirst_change_hook);
863
864 /* Run the before-change-function if any.
865 We don't bother "binding" this variable to nil
866 because it is obsolete anyway and new code should not use it. */
867 if (!NILP (Vbefore_change_function))
868 call2 (Vbefore_change_function, start, end);
869
870 /* Now run the before-change-functions if any. */
871 if (!NILP (Vbefore_change_functions))
872 {
873 Lisp_Object args[3];
874 Lisp_Object before_change_functions;
875 Lisp_Object after_change_functions;
876 struct gcpro gcpro1, gcpro2;
877
878 /* "Bind" before-change-functions and after-change-functions
879 to nil--but in a way that errors don't know about.
880 That way, if there's an error in them, they will stay nil. */
881 before_change_functions = Vbefore_change_functions;
882 after_change_functions = Vafter_change_functions;
883 Vbefore_change_functions = Qnil;
884 Vafter_change_functions = Qnil;
885 GCPRO2 (before_change_functions, after_change_functions);
886
887 /* Actually run the hook functions. */
888 args[0] = Qbefore_change_functions;
889 args[1] = start;
890 args[2] = end;
891 run_hook_list_with_args (before_change_functions, 3, args);
892
893 /* "Unbind" the variables we "bound" to nil. */
894 Vbefore_change_functions = before_change_functions;
895 Vafter_change_functions = after_change_functions;
896 UNGCPRO;
897 }
898
899 if (!NILP (current_buffer->overlays_before)
900 || !NILP (current_buffer->overlays_after))
901 report_overlay_modification (start, end, 0, start, end, Qnil);
902 }
903
904 /* Signal a change immediately after it happens.
905 POS is the address of the start of the changed text.
906 LENDEL is the number of characters of the text before the change.
907 (Not the whole buffer; just the part that was changed.)
908 LENINS is the number of characters in that part of the text
909 after the change. */
910
911 void
912 signal_after_change (pos, lendel, lenins)
913 int pos, lendel, lenins;
914 {
915 /* If we are deferring calls to the after-change functions
916 and there are no before-change functions,
917 just record the args that we were going to use. */
918 if (! NILP (Vcombine_after_change_calls)
919 && NILP (Vbefore_change_function) && NILP (Vbefore_change_functions)
920 && NILP (current_buffer->overlays_before)
921 && NILP (current_buffer->overlays_after))
922 {
923 Lisp_Object elt;
924
925 if (!NILP (combine_after_change_list)
926 && current_buffer != XBUFFER (combine_after_change_buffer))
927 Fcombine_after_change_execute ();
928
929 elt = Fcons (make_number (pos - BEG),
930 Fcons (make_number (Z - (pos - lendel + lenins)),
931 Fcons (make_number (lenins - lendel), Qnil)));
932 combine_after_change_list
933 = Fcons (elt, combine_after_change_list);
934 combine_after_change_buffer = Fcurrent_buffer ();
935
936 return;
937 }
938
939 if (!NILP (combine_after_change_list))
940 Fcombine_after_change_execute ();
941
942 /* Run the after-change-function if any.
943 We don't bother "binding" this variable to nil
944 because it is obsolete anyway and new code should not use it. */
945 if (!NILP (Vafter_change_function))
946 call3 (Vafter_change_function,
947 make_number (pos), make_number (pos + lenins),
948 make_number (lendel));
949
950 if (!NILP (Vafter_change_functions))
951 {
952 Lisp_Object args[4];
953 Lisp_Object before_change_functions;
954 Lisp_Object after_change_functions;
955 struct gcpro gcpro1, gcpro2;
956
957 /* "Bind" before-change-functions and after-change-functions
958 to nil--but in a way that errors don't know about.
959 That way, if there's an error in them, they will stay nil. */
960 before_change_functions = Vbefore_change_functions;
961 after_change_functions = Vafter_change_functions;
962 Vbefore_change_functions = Qnil;
963 Vafter_change_functions = Qnil;
964 GCPRO2 (before_change_functions, after_change_functions);
965
966 /* Actually run the hook functions. */
967 args[0] = Qafter_change_functions;
968 XSETFASTINT (args[1], pos);
969 XSETFASTINT (args[2], pos + lenins);
970 XSETFASTINT (args[3], lendel);
971 run_hook_list_with_args (after_change_functions,
972 4, args);
973
974 /* "Unbind" the variables we "bound" to nil. */
975 Vbefore_change_functions = before_change_functions;
976 Vafter_change_functions = after_change_functions;
977 UNGCPRO;
978 }
979
980 if (!NILP (current_buffer->overlays_before)
981 || !NILP (current_buffer->overlays_after))
982 report_overlay_modification (make_number (pos),
983 make_number (pos + lenins),
984 1,
985 make_number (pos), make_number (pos + lenins),
986 make_number (lendel));
987
988 /* After an insertion, call the text properties
989 insert-behind-hooks or insert-in-front-hooks. */
990 if (lendel == 0)
991 report_interval_modification (pos, pos + lenins);
992 }
993
994 Lisp_Object
995 Fcombine_after_change_execute_1 (val)
996 Lisp_Object val;
997 {
998 Vcombine_after_change_calls = val;
999 return val;
1000 }
1001
1002 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
1003 Scombine_after_change_execute, 0, 0, 0,
1004 "This function is for use internally in `combine-after-change-calls'.")
1005 ()
1006 {
1007 register Lisp_Object val;
1008 int count = specpdl_ptr - specpdl;
1009 int beg, end, change;
1010 int begpos, endpos;
1011 Lisp_Object tail;
1012
1013 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1014
1015 Fset_buffer (combine_after_change_buffer);
1016
1017 /* # chars unchanged at beginning of buffer. */
1018 beg = Z - BEG;
1019 /* # chars unchanged at end of buffer. */
1020 end = beg;
1021 /* Total amount of insertion (negative for deletion). */
1022 change = 0;
1023
1024 /* Scan the various individual changes,
1025 accumulating the range info in BEG, END and CHANGE. */
1026 for (tail = combine_after_change_list; CONSP (tail);
1027 tail = XCONS (tail)->cdr)
1028 {
1029 Lisp_Object elt;
1030 int thisbeg, thisend, thischange;
1031
1032 /* Extract the info from the next element. */
1033 elt = XCONS (tail)->car;
1034 if (! CONSP (elt))
1035 continue;
1036 thisbeg = XINT (XCONS (elt)->car);
1037
1038 elt = XCONS (elt)->cdr;
1039 if (! CONSP (elt))
1040 continue;
1041 thisend = XINT (XCONS (elt)->car);
1042
1043 elt = XCONS (elt)->cdr;
1044 if (! CONSP (elt))
1045 continue;
1046 thischange = XINT (XCONS (elt)->car);
1047
1048 /* Merge this range into the accumulated range. */
1049 change += thischange;
1050 if (thisbeg < beg)
1051 beg = thisbeg;
1052 if (thisend < end)
1053 end = thisend;
1054 }
1055
1056 /* Get the current start and end positions of the range
1057 that was changed. */
1058 begpos = BEG + beg;
1059 endpos = Z - end;
1060
1061 /* We are about to handle these, so discard them. */
1062 combine_after_change_list = Qnil;
1063
1064 /* Now run the after-change functions for real.
1065 Turn off the flag that defers them. */
1066 record_unwind_protect (Fcombine_after_change_execute_1,
1067 Vcombine_after_change_calls);
1068 signal_after_change (begpos, endpos - begpos - change, endpos - begpos);
1069
1070 return unbind_to (count, val);
1071 }
1072 \f
1073 syms_of_insdel ()
1074 {
1075 staticpro (&combine_after_change_list);
1076 combine_after_change_list = Qnil;
1077
1078 DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls,
1079 "Used internally by the `combine-after-change-calls' macro.");
1080 Vcombine_after_change_calls = Qnil;
1081
1082 defsubr (&Scombine_after_change_execute);
1083 }