Include charset.h.
[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 record_marker_adjustment (marker, from + amount - mpos);
278 mpos = from + amount;
279 }
280 }
281 if (mpos > from && mpos <= to)
282 mpos += amount;
283 m->bufpos = mpos;
284 marker = m->chain;
285 }
286 }
287
288 /* Adjust markers whose insertion-type is t
289 for an insertion of AMOUNT characters at POS. */
290
291 static void
292 adjust_markers_for_insert (pos, amount)
293 register int pos, amount;
294 {
295 Lisp_Object marker;
296 int adjusted = 0;
297
298 marker = BUF_MARKERS (current_buffer);
299
300 while (!NILP (marker))
301 {
302 register struct Lisp_Marker *m = XMARKER (marker);
303 if (m->insertion_type && m->bufpos == pos)
304 {
305 m->bufpos += amount;
306 adjusted = 1;
307 }
308 marker = m->chain;
309 }
310 if (adjusted)
311 /* Adjusting only markers whose insertion-type is t may result in
312 disordered overlays in the slot `overlays_before'. */
313 fix_overlays_before (current_buffer, pos, pos + amount);
314 }
315
316 /* Add the specified amount to point. This is used only when the value
317 of point changes due to an insert or delete; it does not represent
318 a conceptual change in point as a marker. In particular, point is
319 not crossing any interval boundaries, so there's no need to use the
320 usual SET_PT macro. In fact it would be incorrect to do so, because
321 either the old or the new value of point is out of sync with the
322 current set of intervals. */
323 static void
324 adjust_point (amount)
325 int amount;
326 {
327 BUF_PT (current_buffer) += amount;
328 }
329 \f
330 /* Make the gap INCREMENT characters longer. */
331
332 void
333 make_gap (increment)
334 int increment;
335 {
336 unsigned char *result;
337 Lisp_Object tem;
338 int real_gap_loc;
339 int old_gap_size;
340
341 /* If we have to get more space, get enough to last a while. */
342 increment += 2000;
343
344 /* Don't allow a buffer size that won't fit in an int
345 even if it will fit in a Lisp integer.
346 That won't work because so many places use `int'. */
347
348 if (Z - BEG + GAP_SIZE + increment
349 >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1)))
350 error ("Buffer exceeds maximum size");
351
352 BLOCK_INPUT;
353 /* We allocate extra 1-byte `\0' at the tail for anchoring a search. */
354 result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment + 1));
355
356 if (result == 0)
357 {
358 UNBLOCK_INPUT;
359 memory_full ();
360 }
361
362 /* We can't unblock until the new address is properly stored. */
363 BEG_ADDR = result;
364 UNBLOCK_INPUT;
365
366 /* Prevent quitting in move_gap. */
367 tem = Vinhibit_quit;
368 Vinhibit_quit = Qt;
369
370 real_gap_loc = GPT;
371 old_gap_size = GAP_SIZE;
372
373 /* Call the newly allocated space a gap at the end of the whole space. */
374 GPT = Z + GAP_SIZE;
375 GAP_SIZE = increment;
376
377 /* Move the new gap down to be consecutive with the end of the old one.
378 This adjusts the markers properly too. */
379 gap_left (real_gap_loc + old_gap_size, 1);
380
381 /* Now combine the two into one large gap. */
382 GAP_SIZE += old_gap_size;
383 GPT = real_gap_loc;
384
385 /* Put an anchor. */
386 *(Z_ADDR) = 0;
387
388 Vinhibit_quit = tem;
389 }
390 \f
391 /* Insert a string of specified length before point.
392 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
393 prepare_to_modify_buffer could relocate the text. */
394
395 void
396 insert (string, length)
397 register unsigned char *string;
398 register length;
399 {
400 if (length > 0)
401 {
402 insert_1 (string, length, 0, 1);
403 signal_after_change (PT-length, 0, length);
404 }
405 }
406
407 void
408 insert_and_inherit (string, length)
409 register unsigned char *string;
410 register length;
411 {
412 if (length > 0)
413 {
414 insert_1 (string, length, 1, 1);
415 signal_after_change (PT-length, 0, length);
416 }
417 }
418
419 void
420 insert_1 (string, length, inherit, prepare)
421 register unsigned char *string;
422 register int length;
423 int inherit, prepare;
424 {
425 register Lisp_Object temp;
426
427 if (prepare)
428 prepare_to_modify_buffer (PT, PT);
429
430 if (PT != GPT)
431 move_gap (PT);
432 if (GAP_SIZE < length)
433 make_gap (length - GAP_SIZE);
434
435 record_insert (PT, length);
436 MODIFF++;
437
438 bcopy (string, GPT_ADDR, length);
439
440 #ifdef USE_TEXT_PROPERTIES
441 if (BUF_INTERVALS (current_buffer) != 0)
442 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
443 offset_intervals (current_buffer, PT, length);
444 #endif
445
446 GAP_SIZE -= length;
447 GPT += length;
448 ZV += length;
449 Z += length;
450 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
451 adjust_overlays_for_insert (PT, length);
452 adjust_markers_for_insert (PT, length);
453 adjust_point (length);
454
455 #ifdef USE_TEXT_PROPERTIES
456 if (!inherit && BUF_INTERVALS (current_buffer) != 0)
457 Fset_text_properties (make_number (PT - length), make_number (PT),
458 Qnil, Qnil);
459 #endif
460 }
461
462 /* Insert the part of the text of STRING, a Lisp object assumed to be
463 of type string, consisting of the LENGTH characters starting at
464 position POS. If the text of STRING has properties, they are absorbed
465 into the buffer.
466
467 It does not work to use `insert' for this, because a GC could happen
468 before we bcopy the stuff into the buffer, and relocate the string
469 without insert noticing. */
470
471 void
472 insert_from_string (string, pos, length, inherit)
473 Lisp_Object string;
474 register int pos, length;
475 int inherit;
476 {
477 if (length > 0)
478 {
479 insert_from_string_1 (string, pos, length, inherit);
480 signal_after_change (PT-length, 0, length);
481 }
482 }
483
484 static void
485 insert_from_string_1 (string, pos, length, inherit)
486 Lisp_Object string;
487 register int pos, length;
488 int inherit;
489 {
490 register Lisp_Object temp;
491 struct gcpro gcpro1;
492
493 /* Make sure point-max won't overflow after this insertion. */
494 XSETINT (temp, length + Z);
495 if (length + Z != XINT (temp))
496 error ("maximum buffer size exceeded");
497
498 GCPRO1 (string);
499 prepare_to_modify_buffer (PT, PT);
500
501 if (PT != GPT)
502 move_gap (PT);
503 if (GAP_SIZE < length)
504 make_gap (length - GAP_SIZE);
505
506 record_insert (PT, length);
507 MODIFF++;
508 UNGCPRO;
509
510 bcopy (XSTRING (string)->data, GPT_ADDR, length);
511
512 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
513 offset_intervals (current_buffer, PT, length);
514
515 GAP_SIZE -= length;
516 GPT += length;
517 ZV += length;
518 Z += length;
519 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
520 adjust_overlays_for_insert (PT, length);
521 adjust_markers_for_insert (PT, length);
522
523 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
524 graft_intervals_into_buffer (XSTRING (string)->intervals, PT, length,
525 current_buffer, inherit);
526
527 adjust_point (length);
528 }
529
530 /* Insert text from BUF, starting at POS and having length LENGTH, into the
531 current buffer. If the text in BUF has properties, they are absorbed
532 into the current buffer.
533
534 It does not work to use `insert' for this, because a malloc could happen
535 and relocate BUF's text before the bcopy happens. */
536
537 void
538 insert_from_buffer (buf, pos, length, inherit)
539 struct buffer *buf;
540 int pos, length;
541 int inherit;
542 {
543 if (length > 0)
544 {
545 insert_from_buffer_1 (buf, pos, length, inherit);
546 signal_after_change (PT-length, 0, length);
547 }
548 }
549
550 static void
551 insert_from_buffer_1 (buf, pos, length, inherit)
552 struct buffer *buf;
553 int pos, length;
554 int inherit;
555 {
556 register Lisp_Object temp;
557 int chunk;
558
559 /* Make sure point-max won't overflow after this insertion. */
560 XSETINT (temp, length + Z);
561 if (length + Z != XINT (temp))
562 error ("maximum buffer size exceeded");
563
564 prepare_to_modify_buffer (PT, PT);
565
566 if (PT != GPT)
567 move_gap (PT);
568 if (GAP_SIZE < length)
569 make_gap (length - GAP_SIZE);
570
571 record_insert (PT, length);
572 MODIFF++;
573
574 if (pos < BUF_GPT (buf))
575 {
576 chunk = BUF_GPT (buf) - pos;
577 if (chunk > length)
578 chunk = length;
579 bcopy (BUF_CHAR_ADDRESS (buf, pos), GPT_ADDR, chunk);
580 }
581 else
582 chunk = 0;
583 if (chunk < length)
584 bcopy (BUF_CHAR_ADDRESS (buf, pos + chunk),
585 GPT_ADDR + chunk, length - chunk);
586
587 #ifdef USE_TEXT_PROPERTIES
588 if (BUF_INTERVALS (current_buffer) != 0)
589 offset_intervals (current_buffer, PT, length);
590 #endif
591
592 GAP_SIZE -= length;
593 GPT += length;
594 ZV += length;
595 Z += length;
596 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
597 adjust_overlays_for_insert (PT, length);
598 adjust_markers_for_insert (PT, length);
599 adjust_point (length);
600
601 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
602 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf),
603 pos, length),
604 PT - length, length, current_buffer, inherit);
605 }
606
607 /* Insert the character C before point */
608
609 void
610 insert_char (c)
611 int c;
612 {
613 unsigned char workbuf[4], *str;
614 int len = CHAR_STRING (c, workbuf, str);
615
616 insert (str, len);
617 }
618
619 /* Insert the null-terminated string S before point */
620
621 void
622 insert_string (s)
623 char *s;
624 {
625 insert (s, strlen (s));
626 }
627
628 /* Like `insert' except that all markers pointing at the place where
629 the insertion happens are adjusted to point after it.
630 Don't use this function to insert part of a Lisp string,
631 since gc could happen and relocate it. */
632
633 void
634 insert_before_markers (string, length)
635 unsigned char *string;
636 register int length;
637 {
638 if (length > 0)
639 {
640 register int opoint = PT;
641 insert_1 (string, length, 0, 1);
642 adjust_markers (opoint - 1, opoint, length);
643 signal_after_change (PT-length, 0, length);
644 }
645 }
646
647 void
648 insert_before_markers_and_inherit (string, length)
649 unsigned char *string;
650 register int length;
651 {
652 if (length > 0)
653 {
654 register int opoint = PT;
655 insert_1 (string, length, 1, 1);
656 adjust_markers (opoint - 1, opoint, length);
657 signal_after_change (PT-length, 0, length);
658 }
659 }
660
661 /* Insert part of a Lisp string, relocating markers after. */
662
663 void
664 insert_from_string_before_markers (string, pos, length, inherit)
665 Lisp_Object string;
666 register int pos, length;
667 int inherit;
668 {
669 if (length > 0)
670 {
671 register int opoint = PT;
672 insert_from_string_1 (string, pos, length, inherit);
673 adjust_markers (opoint - 1, opoint, length);
674 signal_after_change (PT-length, 0, length);
675 }
676 }
677 \f
678 /* Delete characters in current buffer
679 from FROM up to (but not including) TO. */
680
681 void
682 del_range (from, to)
683 register int from, to;
684 {
685 del_range_1 (from, to, 1);
686 }
687
688 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
689
690 void
691 del_range_1 (from, to, prepare)
692 register int from, to, prepare;
693 {
694 register int numdel;
695
696 /* Make args be valid */
697 if (from < BEGV)
698 from = BEGV;
699 if (to > ZV)
700 to = ZV;
701
702 if ((numdel = to - from) <= 0)
703 return;
704
705 /* Make sure the gap is somewhere in or next to what we are deleting. */
706 if (from > GPT)
707 gap_right (from);
708 if (to < GPT)
709 gap_left (to, 0);
710
711 if (prepare)
712 prepare_to_modify_buffer (from, to);
713
714 /* Relocate all markers pointing into the new, larger gap
715 to point at the end of the text before the gap.
716 This has to be done before recording the deletion,
717 so undo handles this after reinserting the text. */
718 adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
719
720 record_delete (from, numdel);
721 MODIFF++;
722
723 /* Relocate point as if it were a marker. */
724 if (from < PT)
725 adjust_point (from - (PT < to ? PT : to));
726
727 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
728 offset_intervals (current_buffer, from, - numdel);
729
730 /* Adjust the overlay center as needed. This must be done after
731 adjusting the markers that bound the overlays. */
732 adjust_overlays_for_delete (from, numdel);
733
734 GAP_SIZE += numdel;
735 ZV -= numdel;
736 Z -= numdel;
737 GPT = from;
738 *(GPT_ADDR) = 0; /* Put an anchor. */
739
740 if (GPT - BEG < beg_unchanged)
741 beg_unchanged = GPT - BEG;
742 if (Z - GPT < end_unchanged)
743 end_unchanged = Z - GPT;
744
745 evaporate_overlays (from);
746 signal_after_change (from, numdel, 0);
747 }
748 \f
749 /* Call this if you're about to change the region of BUFFER from START
750 to END. This checks the read-only properties of the region, calls
751 the necessary modification hooks, and warns the next redisplay that
752 it should pay attention to that area. */
753 void
754 modify_region (buffer, start, end)
755 struct buffer *buffer;
756 int start, end;
757 {
758 struct buffer *old_buffer = current_buffer;
759
760 if (buffer != old_buffer)
761 set_buffer_internal (buffer);
762
763 prepare_to_modify_buffer (start, end);
764
765 if (start - 1 < beg_unchanged
766 || (unchanged_modified == MODIFF
767 && overlay_unchanged_modified == OVERLAY_MODIFF))
768 beg_unchanged = start - 1;
769 if (Z - end < end_unchanged
770 || (unchanged_modified == MODIFF
771 && overlay_unchanged_modified == OVERLAY_MODIFF))
772 end_unchanged = Z - end;
773
774 if (MODIFF <= SAVE_MODIFF)
775 record_first_change ();
776 MODIFF++;
777
778 buffer->point_before_scroll = Qnil;
779
780 if (buffer != old_buffer)
781 set_buffer_internal (old_buffer);
782 }
783
784 /* Check that it is okay to modify the buffer between START and END.
785 Run the before-change-function, if any. If intervals are in use,
786 verify that the text to be modified is not read-only, and call
787 any modification properties the text may have. */
788
789 void
790 prepare_to_modify_buffer (start, end)
791 int start, end;
792 {
793 if (!NILP (current_buffer->read_only))
794 Fbarf_if_buffer_read_only ();
795
796 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
797 if (BUF_INTERVALS (current_buffer) != 0)
798 verify_interval_modification (current_buffer, start, end);
799
800 #ifdef CLASH_DETECTION
801 if (!NILP (current_buffer->file_truename)
802 /* Make binding buffer-file-name to nil effective. */
803 && !NILP (current_buffer->filename)
804 && SAVE_MODIFF >= MODIFF)
805 lock_file (current_buffer->file_truename);
806 #else
807 /* At least warn if this file has changed on disk since it was visited. */
808 if (!NILP (current_buffer->filename)
809 && SAVE_MODIFF >= MODIFF
810 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
811 && !NILP (Ffile_exists_p (current_buffer->filename)))
812 call1 (intern ("ask-user-about-supersession-threat"),
813 current_buffer->filename);
814 #endif /* not CLASH_DETECTION */
815
816 signal_before_change (start, end);
817
818 if (current_buffer->newline_cache)
819 invalidate_region_cache (current_buffer,
820 current_buffer->newline_cache,
821 start - BEG, Z - end);
822 if (current_buffer->width_run_cache)
823 invalidate_region_cache (current_buffer,
824 current_buffer->width_run_cache,
825 start - BEG, Z - end);
826
827 Vdeactivate_mark = Qt;
828 }
829 \f
830 /* Signal a change to the buffer immediately before it happens.
831 START_INT and END_INT are the bounds of the text to be changed. */
832
833 void
834 signal_before_change (start_int, end_int)
835 int start_int, end_int;
836 {
837 Lisp_Object start, end;
838
839 start = make_number (start_int);
840 end = make_number (end_int);
841
842 /* If buffer is unmodified, run a special hook for that case. */
843 if (SAVE_MODIFF >= MODIFF
844 && !NILP (Vfirst_change_hook)
845 && !NILP (Vrun_hooks))
846 call1 (Vrun_hooks, Qfirst_change_hook);
847
848 /* Run the before-change-function if any.
849 We don't bother "binding" this variable to nil
850 because it is obsolete anyway and new code should not use it. */
851 if (!NILP (Vbefore_change_function))
852 call2 (Vbefore_change_function, start, end);
853
854 /* Now run the before-change-functions if any. */
855 if (!NILP (Vbefore_change_functions))
856 {
857 Lisp_Object args[3];
858 Lisp_Object before_change_functions;
859 Lisp_Object after_change_functions;
860 struct gcpro gcpro1, gcpro2;
861
862 /* "Bind" before-change-functions and after-change-functions
863 to nil--but in a way that errors don't know about.
864 That way, if there's an error in them, they will stay nil. */
865 before_change_functions = Vbefore_change_functions;
866 after_change_functions = Vafter_change_functions;
867 Vbefore_change_functions = Qnil;
868 Vafter_change_functions = Qnil;
869 GCPRO2 (before_change_functions, after_change_functions);
870
871 /* Actually run the hook functions. */
872 args[0] = Qbefore_change_functions;
873 args[1] = start;
874 args[2] = end;
875 run_hook_list_with_args (before_change_functions, 3, args);
876
877 /* "Unbind" the variables we "bound" to nil. */
878 Vbefore_change_functions = before_change_functions;
879 Vafter_change_functions = after_change_functions;
880 UNGCPRO;
881 }
882
883 if (!NILP (current_buffer->overlays_before)
884 || !NILP (current_buffer->overlays_after))
885 report_overlay_modification (start, end, 0, start, end, Qnil);
886 }
887
888 /* Signal a change immediately after it happens.
889 POS is the address of the start of the changed text.
890 LENDEL is the number of characters of the text before the change.
891 (Not the whole buffer; just the part that was changed.)
892 LENINS is the number of characters in that part of the text
893 after the change. */
894
895 void
896 signal_after_change (pos, lendel, lenins)
897 int pos, lendel, lenins;
898 {
899 /* If we are deferring calls to the after-change functions
900 and there are no before-change functions,
901 just record the args that we were going to use. */
902 if (! NILP (Vcombine_after_change_calls)
903 && NILP (Vbefore_change_function) && NILP (Vbefore_change_functions)
904 && NILP (current_buffer->overlays_before)
905 && NILP (current_buffer->overlays_after))
906 {
907 Lisp_Object elt;
908
909 if (!NILP (combine_after_change_list)
910 && current_buffer != XBUFFER (combine_after_change_buffer))
911 Fcombine_after_change_execute ();
912
913 elt = Fcons (make_number (pos - BEG),
914 Fcons (make_number (Z - (pos - lendel + lenins)),
915 Fcons (make_number (lenins - lendel), Qnil)));
916 combine_after_change_list
917 = Fcons (elt, combine_after_change_list);
918 combine_after_change_buffer = Fcurrent_buffer ();
919
920 return;
921 }
922
923 if (!NILP (combine_after_change_list))
924 Fcombine_after_change_execute ();
925
926 /* Run the after-change-function if any.
927 We don't bother "binding" this variable to nil
928 because it is obsolete anyway and new code should not use it. */
929 if (!NILP (Vafter_change_function))
930 call3 (Vafter_change_function,
931 make_number (pos), make_number (pos + lenins),
932 make_number (lendel));
933
934 if (!NILP (Vafter_change_functions))
935 {
936 Lisp_Object args[4];
937 Lisp_Object before_change_functions;
938 Lisp_Object after_change_functions;
939 struct gcpro gcpro1, gcpro2;
940
941 /* "Bind" before-change-functions and after-change-functions
942 to nil--but in a way that errors don't know about.
943 That way, if there's an error in them, they will stay nil. */
944 before_change_functions = Vbefore_change_functions;
945 after_change_functions = Vafter_change_functions;
946 Vbefore_change_functions = Qnil;
947 Vafter_change_functions = Qnil;
948 GCPRO2 (before_change_functions, after_change_functions);
949
950 /* Actually run the hook functions. */
951 args[0] = Qafter_change_functions;
952 XSETFASTINT (args[1], pos);
953 XSETFASTINT (args[2], pos + lenins);
954 XSETFASTINT (args[3], lendel);
955 run_hook_list_with_args (after_change_functions,
956 4, args);
957
958 /* "Unbind" the variables we "bound" to nil. */
959 Vbefore_change_functions = before_change_functions;
960 Vafter_change_functions = after_change_functions;
961 UNGCPRO;
962 }
963
964 if (!NILP (current_buffer->overlays_before)
965 || !NILP (current_buffer->overlays_after))
966 report_overlay_modification (make_number (pos),
967 make_number (pos + lenins),
968 1,
969 make_number (pos), make_number (pos + lenins),
970 make_number (lendel));
971
972 /* After an insertion, call the text properties
973 insert-behind-hooks or insert-in-front-hooks. */
974 if (lendel == 0)
975 report_interval_modification (pos, pos + lenins);
976 }
977
978 Lisp_Object
979 Fcombine_after_change_execute_1 (val)
980 Lisp_Object val;
981 {
982 Vcombine_after_change_calls = val;
983 return val;
984 }
985
986 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
987 Scombine_after_change_execute, 0, 0, 0,
988 "This function is for use internally in `combine-after-change-calls'.")
989 ()
990 {
991 register Lisp_Object val;
992 int count = specpdl_ptr - specpdl;
993 int beg, end, change;
994 int begpos, endpos;
995 Lisp_Object tail;
996
997 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
998
999 Fset_buffer (combine_after_change_buffer);
1000
1001 /* # chars unchanged at beginning of buffer. */
1002 beg = Z - BEG;
1003 /* # chars unchanged at end of buffer. */
1004 end = beg;
1005 /* Total amount of insertion (negative for deletion). */
1006 change = 0;
1007
1008 /* Scan the various individual changes,
1009 accumulating the range info in BEG, END and CHANGE. */
1010 for (tail = combine_after_change_list; CONSP (tail);
1011 tail = XCONS (tail)->cdr)
1012 {
1013 Lisp_Object elt, thisbeg, thisend, thischange;
1014
1015 /* Extract the info from the next element. */
1016 elt = XCONS (tail)->car;
1017 if (! CONSP (elt))
1018 continue;
1019 thisbeg = XINT (XCONS (elt)->car);
1020
1021 elt = XCONS (elt)->cdr;
1022 if (! CONSP (elt))
1023 continue;
1024 thisend = XINT (XCONS (elt)->car);
1025
1026 elt = XCONS (elt)->cdr;
1027 if (! CONSP (elt))
1028 continue;
1029 thischange = XINT (XCONS (elt)->car);
1030
1031 /* Merge this range into the accumulated range. */
1032 change += thischange;
1033 if (thisbeg < beg)
1034 beg = thisbeg;
1035 if (thisend < end)
1036 end = thisend;
1037 }
1038
1039 /* Get the current start and end positions of the range
1040 that was changed. */
1041 begpos = BEG + beg;
1042 endpos = Z - end;
1043
1044 /* We are about to handle these, so discard them. */
1045 combine_after_change_list = Qnil;
1046
1047 /* Now run the after-change functions for real.
1048 Turn off the flag that defers them. */
1049 record_unwind_protect (Fcombine_after_change_execute_1,
1050 Vcombine_after_change_calls);
1051 signal_after_change (begpos, endpos - begpos - change, endpos - begpos);
1052
1053 return unbind_to (count, val);
1054 }
1055 \f
1056 syms_of_insdel ()
1057 {
1058 staticpro (&combine_after_change_list);
1059 combine_after_change_list = Qnil;
1060
1061 DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls,
1062 "Used internally by the `combine-after-change-calls' macro.");
1063 Vcombine_after_change_calls = Qnil;
1064
1065 defsubr (&Scombine_after_change_execute);
1066 }