(change_frame_size_1): Reject new sizes if they cause overflow.
[emacs.git] / src / insdel.c
blobb3bc81467fdbb33c156e35ae83cf643bf1804c03
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 "window.h"
27 #include "blockinput.h"
29 #define min(x, y) ((x) < (y) ? (x) : (y))
31 static void insert_from_string_1 ();
32 static void insert_from_buffer_1 ();
33 static void gap_left ();
34 static void gap_right ();
35 static void adjust_markers ();
36 static void adjust_point ();
38 Lisp_Object Fcombine_after_change_execute ();
40 /* Non-nil means don't call the after-change-functions right away,
41 just record an element in Vcombine_after_change_calls_list. */
42 Lisp_Object Vcombine_after_change_calls;
44 /* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
45 describing changes which happened while combine_after_change_calls
46 was nonzero. We use this to decide how to call them
47 once the deferral ends.
49 In each element.
50 BEG-UNCHANGED is the number of chars before the changed range.
51 END-UNCHANGED is the number of chars after the changed range,
52 and CHANGE-AMOUNT is the number of characters inserted by the change
53 (negative for a deletion). */
54 Lisp_Object combine_after_change_list;
56 /* Buffer which combine_after_change_list is about. */
57 Lisp_Object combine_after_change_buffer;
59 /* Move gap to position `pos'.
60 Note that this can quit! */
62 void
63 move_gap (pos)
64 int pos;
66 if (pos < GPT)
67 gap_left (pos, 0);
68 else if (pos > GPT)
69 gap_right (pos);
72 /* Move the gap to POS, which is less than the current GPT.
73 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
75 static void
76 gap_left (pos, newgap)
77 register int pos;
78 int newgap;
80 register unsigned char *to, *from;
81 register int i;
82 int new_s1;
84 pos--;
86 if (!newgap)
88 if (unchanged_modified == MODIFF
89 && overlay_unchanged_modified == OVERLAY_MODIFF)
91 beg_unchanged = pos;
92 end_unchanged = Z - pos - 1;
94 else
96 if (Z - GPT < end_unchanged)
97 end_unchanged = Z - GPT;
98 if (pos < beg_unchanged)
99 beg_unchanged = pos;
103 i = GPT;
104 to = GAP_END_ADDR;
105 from = GPT_ADDR;
106 new_s1 = GPT - BEG;
108 /* Now copy the characters. To move the gap down,
109 copy characters up. */
111 while (1)
113 /* I gets number of characters left to copy. */
114 i = new_s1 - pos;
115 if (i == 0)
116 break;
117 /* If a quit is requested, stop copying now.
118 Change POS to be where we have actually moved the gap to. */
119 if (QUITP)
121 pos = new_s1;
122 break;
124 /* Move at most 32000 chars before checking again for a quit. */
125 if (i > 32000)
126 i = 32000;
127 #ifdef GAP_USE_BCOPY
128 if (i >= 128
129 /* bcopy is safe if the two areas of memory do not overlap
130 or on systems where bcopy is always safe for moving upward. */
131 && (BCOPY_UPWARD_SAFE
132 || to - from >= 128))
134 /* If overlap is not safe, avoid it by not moving too many
135 characters at once. */
136 if (!BCOPY_UPWARD_SAFE && i > to - from)
137 i = to - from;
138 new_s1 -= i;
139 from -= i, to -= i;
140 bcopy (from, to, i);
142 else
143 #endif
145 new_s1 -= i;
146 while (--i >= 0)
147 *--to = *--from;
151 /* Adjust markers, and buffer data structure, to put the gap at POS.
152 POS is where the loop above stopped, which may be what was specified
153 or may be where a quit was detected. */
154 adjust_markers (pos + 1, GPT, GAP_SIZE);
155 GPT = pos + 1;
156 QUIT;
159 static void
160 gap_right (pos)
161 register int pos;
163 register unsigned char *to, *from;
164 register int i;
165 int new_s1;
167 pos--;
169 if (unchanged_modified == MODIFF
170 && overlay_unchanged_modified == OVERLAY_MODIFF)
173 beg_unchanged = pos;
174 end_unchanged = Z - pos - 1;
176 else
178 if (Z - pos - 1 < end_unchanged)
179 end_unchanged = Z - pos - 1;
180 if (GPT - BEG < beg_unchanged)
181 beg_unchanged = GPT - BEG;
184 i = GPT;
185 from = GAP_END_ADDR;
186 to = GPT_ADDR;
187 new_s1 = GPT - 1;
189 /* Now copy the characters. To move the gap up,
190 copy characters down. */
192 while (1)
194 /* I gets number of characters left to copy. */
195 i = pos - new_s1;
196 if (i == 0)
197 break;
198 /* If a quit is requested, stop copying now.
199 Change POS to be where we have actually moved the gap to. */
200 if (QUITP)
202 pos = new_s1;
203 break;
205 /* Move at most 32000 chars before checking again for a quit. */
206 if (i > 32000)
207 i = 32000;
208 #ifdef GAP_USE_BCOPY
209 if (i >= 128
210 /* bcopy is safe if the two areas of memory do not overlap
211 or on systems where bcopy is always safe for moving downward. */
212 && (BCOPY_DOWNWARD_SAFE
213 || from - to >= 128))
215 /* If overlap is not safe, avoid it by not moving too many
216 characters at once. */
217 if (!BCOPY_DOWNWARD_SAFE && i > from - to)
218 i = from - to;
219 new_s1 += i;
220 bcopy (from, to, i);
221 from += i, to += i;
223 else
224 #endif
226 new_s1 += i;
227 while (--i >= 0)
228 *to++ = *from++;
232 adjust_markers (GPT + GAP_SIZE, pos + 1 + GAP_SIZE, - GAP_SIZE);
233 GPT = pos + 1;
234 QUIT;
237 /* Add AMOUNT to the position of every marker in the current buffer
238 whose current position is between FROM (exclusive) and TO (inclusive).
240 Also, any markers past the outside of that interval, in the direction
241 of adjustment, are first moved back to the near end of the interval
242 and then adjusted by AMOUNT.
244 When the latter adjustment is done, if AMOUNT is negative,
245 we record the adjustment for undo. (This case happens only for
246 deletion.) */
248 static void
249 adjust_markers (from, to, amount)
250 register int from, to, amount;
252 Lisp_Object marker;
253 register struct Lisp_Marker *m;
254 register int mpos;
256 marker = BUF_MARKERS (current_buffer);
258 while (!NILP (marker))
260 m = XMARKER (marker);
261 mpos = m->bufpos;
262 if (amount > 0)
264 if (mpos > to && mpos < to + amount)
265 mpos = to + amount;
267 else
269 /* Here's the case where a marker is inside text being deleted.
270 AMOUNT can be negative for gap motion, too,
271 but then this range contains no markers. */
272 if (mpos > from + amount && mpos <= from)
274 record_marker_adjustment (marker, from + amount - mpos);
275 mpos = from + amount;
278 if (mpos > from && mpos <= to)
279 mpos += amount;
280 m->bufpos = mpos;
281 marker = m->chain;
285 /* Adjust markers whose insertion-type is t
286 for an insertion of AMOUNT characters at POS. */
288 static void
289 adjust_markers_for_insert (pos, amount)
290 register int pos, amount;
292 Lisp_Object marker;
294 marker = BUF_MARKERS (current_buffer);
296 while (!NILP (marker))
298 register struct Lisp_Marker *m = XMARKER (marker);
299 if (m->insertion_type && m->bufpos == pos)
300 m->bufpos += amount;
301 marker = m->chain;
305 /* Add the specified amount to point. This is used only when the value
306 of point changes due to an insert or delete; it does not represent
307 a conceptual change in point as a marker. In particular, point is
308 not crossing any interval boundaries, so there's no need to use the
309 usual SET_PT macro. In fact it would be incorrect to do so, because
310 either the old or the new value of point is out of sync with the
311 current set of intervals. */
312 static void
313 adjust_point (amount)
314 int amount;
316 BUF_PT (current_buffer) += amount;
319 /* Make the gap INCREMENT characters longer. */
321 void
322 make_gap (increment)
323 int increment;
325 unsigned char *result;
326 Lisp_Object tem;
327 int real_gap_loc;
328 int old_gap_size;
330 /* If we have to get more space, get enough to last a while. */
331 increment += 2000;
333 /* Don't allow a buffer size that won't fit in an int
334 even if it will fit in a Lisp integer.
335 That won't work because so many places use `int'. */
337 if (Z - BEG + GAP_SIZE + increment
338 >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1)))
339 error ("Buffer exceeds maximum size");
341 BLOCK_INPUT;
342 result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment));
344 if (result == 0)
346 UNBLOCK_INPUT;
347 memory_full ();
350 /* We can't unblock until the new address is properly stored. */
351 BEG_ADDR = result;
352 UNBLOCK_INPUT;
354 /* Prevent quitting in move_gap. */
355 tem = Vinhibit_quit;
356 Vinhibit_quit = Qt;
358 real_gap_loc = GPT;
359 old_gap_size = GAP_SIZE;
361 /* Call the newly allocated space a gap at the end of the whole space. */
362 GPT = Z + GAP_SIZE;
363 GAP_SIZE = increment;
365 /* Move the new gap down to be consecutive with the end of the old one.
366 This adjusts the markers properly too. */
367 gap_left (real_gap_loc + old_gap_size, 1);
369 /* Now combine the two into one large gap. */
370 GAP_SIZE += old_gap_size;
371 GPT = real_gap_loc;
373 Vinhibit_quit = tem;
376 /* Insert a string of specified length before point.
377 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
378 prepare_to_modify_buffer could relocate the text. */
380 void
381 insert (string, length)
382 register unsigned char *string;
383 register length;
385 if (length > 0)
387 insert_1 (string, length, 0, 1);
388 signal_after_change (PT-length, 0, length);
392 void
393 insert_and_inherit (string, length)
394 register unsigned char *string;
395 register length;
397 if (length > 0)
399 insert_1 (string, length, 1, 1);
400 signal_after_change (PT-length, 0, length);
404 void
405 insert_1 (string, length, inherit, prepare)
406 register unsigned char *string;
407 register int length;
408 int inherit, prepare;
410 register Lisp_Object temp;
412 if (prepare)
413 prepare_to_modify_buffer (PT, PT);
415 if (PT != GPT)
416 move_gap (PT);
417 if (GAP_SIZE < length)
418 make_gap (length - GAP_SIZE);
420 record_insert (PT, length);
421 MODIFF++;
423 bcopy (string, GPT_ADDR, length);
425 #ifdef USE_TEXT_PROPERTIES
426 if (BUF_INTERVALS (current_buffer) != 0)
427 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
428 offset_intervals (current_buffer, PT, length);
429 #endif
431 GAP_SIZE -= length;
432 GPT += length;
433 ZV += length;
434 Z += length;
435 adjust_overlays_for_insert (PT, length);
436 adjust_markers_for_insert (PT, length);
437 adjust_point (length);
439 #ifdef USE_TEXT_PROPERTIES
440 if (!inherit && BUF_INTERVALS (current_buffer) != 0)
441 Fset_text_properties (make_number (PT - length), make_number (PT),
442 Qnil, Qnil);
443 #endif
446 /* Insert the part of the text of STRING, a Lisp object assumed to be
447 of type string, consisting of the LENGTH characters starting at
448 position POS. If the text of STRING has properties, they are absorbed
449 into the buffer.
451 It does not work to use `insert' for this, because a GC could happen
452 before we bcopy the stuff into the buffer, and relocate the string
453 without insert noticing. */
455 void
456 insert_from_string (string, pos, length, inherit)
457 Lisp_Object string;
458 register int pos, length;
459 int inherit;
461 if (length > 0)
463 insert_from_string_1 (string, pos, length, inherit);
464 signal_after_change (PT-length, 0, length);
468 static void
469 insert_from_string_1 (string, pos, length, inherit)
470 Lisp_Object string;
471 register int pos, length;
472 int inherit;
474 register Lisp_Object temp;
475 struct gcpro gcpro1;
477 /* Make sure point-max won't overflow after this insertion. */
478 XSETINT (temp, length + Z);
479 if (length + Z != XINT (temp))
480 error ("maximum buffer size exceeded");
482 GCPRO1 (string);
483 prepare_to_modify_buffer (PT, PT);
485 if (PT != GPT)
486 move_gap (PT);
487 if (GAP_SIZE < length)
488 make_gap (length - GAP_SIZE);
490 record_insert (PT, length);
491 MODIFF++;
492 UNGCPRO;
494 bcopy (XSTRING (string)->data, GPT_ADDR, length);
496 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
497 offset_intervals (current_buffer, PT, length);
499 GAP_SIZE -= length;
500 GPT += length;
501 ZV += length;
502 Z += length;
503 adjust_overlays_for_insert (PT, length);
504 adjust_markers_for_insert (PT, length);
506 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
507 graft_intervals_into_buffer (XSTRING (string)->intervals, PT, length,
508 current_buffer, inherit);
510 adjust_point (length);
513 /* Insert text from BUF, starting at POS and having length LENGTH, into the
514 current buffer. If the text in BUF has properties, they are absorbed
515 into the current buffer.
517 It does not work to use `insert' for this, because a malloc could happen
518 and relocate BUF's text before the bcopy happens. */
520 void
521 insert_from_buffer (buf, pos, length, inherit)
522 struct buffer *buf;
523 int pos, length;
524 int inherit;
526 if (length > 0)
528 insert_from_buffer_1 (buf, pos, length, inherit);
529 signal_after_change (PT-length, 0, length);
533 static void
534 insert_from_buffer_1 (buf, pos, length, inherit)
535 struct buffer *buf;
536 int pos, length;
537 int inherit;
539 register Lisp_Object temp;
540 int chunk;
542 /* Make sure point-max won't overflow after this insertion. */
543 XSETINT (temp, length + Z);
544 if (length + Z != XINT (temp))
545 error ("maximum buffer size exceeded");
547 prepare_to_modify_buffer (PT, PT);
549 if (PT != GPT)
550 move_gap (PT);
551 if (GAP_SIZE < length)
552 make_gap (length - GAP_SIZE);
554 record_insert (PT, length);
555 MODIFF++;
557 if (pos < BUF_GPT (buf))
559 chunk = BUF_GPT (buf) - pos;
560 if (chunk > length)
561 chunk = length;
562 bcopy (BUF_CHAR_ADDRESS (buf, pos), GPT_ADDR, chunk);
564 else
565 chunk = 0;
566 if (chunk < length)
567 bcopy (BUF_CHAR_ADDRESS (buf, pos + chunk),
568 GPT_ADDR + chunk, length - chunk);
570 #ifdef USE_TEXT_PROPERTIES
571 if (BUF_INTERVALS (current_buffer) != 0)
572 offset_intervals (current_buffer, PT, length);
573 #endif
575 GAP_SIZE -= length;
576 GPT += length;
577 ZV += length;
578 Z += length;
579 adjust_overlays_for_insert (PT, length);
580 adjust_markers_for_insert (PT, length);
581 adjust_point (length);
583 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
584 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf),
585 pos, length),
586 PT - length, length, current_buffer, inherit);
589 /* Insert the character C before point */
591 void
592 insert_char (c)
593 unsigned char c;
595 insert (&c, 1);
598 /* Insert the null-terminated string S before point */
600 void
601 insert_string (s)
602 char *s;
604 insert (s, strlen (s));
607 /* Like `insert' except that all markers pointing at the place where
608 the insertion happens are adjusted to point after it.
609 Don't use this function to insert part of a Lisp string,
610 since gc could happen and relocate it. */
612 void
613 insert_before_markers (string, length)
614 unsigned char *string;
615 register int length;
617 if (length > 0)
619 register int opoint = PT;
620 insert_1 (string, length, 0, 1);
621 adjust_markers (opoint - 1, opoint, length);
622 signal_after_change (PT-length, 0, length);
626 void
627 insert_before_markers_and_inherit (string, length)
628 unsigned char *string;
629 register int length;
631 if (length > 0)
633 register int opoint = PT;
634 insert_1 (string, length, 1, 1);
635 adjust_markers (opoint - 1, opoint, length);
636 signal_after_change (PT-length, 0, length);
640 /* Insert part of a Lisp string, relocating markers after. */
642 void
643 insert_from_string_before_markers (string, pos, length, inherit)
644 Lisp_Object string;
645 register int pos, length;
646 int inherit;
648 if (length > 0)
650 register int opoint = PT;
651 insert_from_string_1 (string, pos, length, inherit);
652 adjust_markers (opoint - 1, opoint, length);
653 signal_after_change (PT-length, 0, length);
657 /* Delete characters in current buffer
658 from FROM up to (but not including) TO. */
660 void
661 del_range (from, to)
662 register int from, to;
664 del_range_1 (from, to, 1);
667 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
669 void
670 del_range_1 (from, to, prepare)
671 register int from, to, prepare;
673 register int numdel;
675 /* Make args be valid */
676 if (from < BEGV)
677 from = BEGV;
678 if (to > ZV)
679 to = ZV;
681 if ((numdel = to - from) <= 0)
682 return;
684 /* Make sure the gap is somewhere in or next to what we are deleting. */
685 if (from > GPT)
686 gap_right (from);
687 if (to < GPT)
688 gap_left (to, 0);
690 if (prepare)
691 prepare_to_modify_buffer (from, to);
693 /* Relocate all markers pointing into the new, larger gap
694 to point at the end of the text before the gap.
695 This has to be done before recording the deletion,
696 so undo handles this after reinserting the text. */
697 adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
699 record_delete (from, numdel);
700 MODIFF++;
702 /* Relocate point as if it were a marker. */
703 if (from < PT)
704 adjust_point (from - (PT < to ? PT : to));
706 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
707 offset_intervals (current_buffer, from, - numdel);
709 /* Adjust the overlay center as needed. This must be done after
710 adjusting the markers that bound the overlays. */
711 adjust_overlays_for_delete (from, numdel);
713 GAP_SIZE += numdel;
714 ZV -= numdel;
715 Z -= numdel;
716 GPT = from;
718 if (GPT - BEG < beg_unchanged)
719 beg_unchanged = GPT - BEG;
720 if (Z - GPT < end_unchanged)
721 end_unchanged = Z - GPT;
723 evaporate_overlays (from);
724 signal_after_change (from, numdel, 0);
727 /* Call this if you're about to change the region of BUFFER from START
728 to END. This checks the read-only properties of the region, calls
729 the necessary modification hooks, and warns the next redisplay that
730 it should pay attention to that area. */
731 void
732 modify_region (buffer, start, end)
733 struct buffer *buffer;
734 int start, end;
736 struct buffer *old_buffer = current_buffer;
738 if (buffer != old_buffer)
739 set_buffer_internal (buffer);
741 prepare_to_modify_buffer (start, end);
743 if (start - 1 < beg_unchanged
744 || (unchanged_modified == MODIFF
745 && overlay_unchanged_modified == OVERLAY_MODIFF))
746 beg_unchanged = start - 1;
747 if (Z - end < end_unchanged
748 || (unchanged_modified == MODIFF
749 && overlay_unchanged_modified == OVERLAY_MODIFF))
750 end_unchanged = Z - end;
752 if (MODIFF <= SAVE_MODIFF)
753 record_first_change ();
754 MODIFF++;
756 buffer->point_before_scroll = Qnil;
758 if (buffer != old_buffer)
759 set_buffer_internal (old_buffer);
762 /* Check that it is okay to modify the buffer between START and END.
763 Run the before-change-function, if any. If intervals are in use,
764 verify that the text to be modified is not read-only, and call
765 any modification properties the text may have. */
767 void
768 prepare_to_modify_buffer (start, end)
769 int start, end;
771 if (!NILP (current_buffer->read_only))
772 Fbarf_if_buffer_read_only ();
774 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
775 if (BUF_INTERVALS (current_buffer) != 0)
776 verify_interval_modification (current_buffer, start, end);
778 #ifdef CLASH_DETECTION
779 if (!NILP (current_buffer->file_truename)
780 /* Make binding buffer-file-name to nil effective. */
781 && !NILP (current_buffer->filename)
782 && SAVE_MODIFF >= MODIFF)
783 lock_file (current_buffer->file_truename);
784 #else
785 /* At least warn if this file has changed on disk since it was visited. */
786 if (!NILP (current_buffer->filename)
787 && SAVE_MODIFF >= MODIFF
788 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
789 && !NILP (Ffile_exists_p (current_buffer->filename)))
790 call1 (intern ("ask-user-about-supersession-threat"),
791 current_buffer->filename);
792 #endif /* not CLASH_DETECTION */
794 signal_before_change (start, end);
796 if (current_buffer->newline_cache)
797 invalidate_region_cache (current_buffer,
798 current_buffer->newline_cache,
799 start - BEG, Z - end);
800 if (current_buffer->width_run_cache)
801 invalidate_region_cache (current_buffer,
802 current_buffer->width_run_cache,
803 start - BEG, Z - end);
805 Vdeactivate_mark = Qt;
808 /* Signal a change to the buffer immediately before it happens.
809 START_INT and END_INT are the bounds of the text to be changed. */
811 void
812 signal_before_change (start_int, end_int)
813 int start_int, end_int;
815 Lisp_Object start, end;
817 start = make_number (start_int);
818 end = make_number (end_int);
820 /* If buffer is unmodified, run a special hook for that case. */
821 if (SAVE_MODIFF >= MODIFF
822 && !NILP (Vfirst_change_hook)
823 && !NILP (Vrun_hooks))
824 call1 (Vrun_hooks, Qfirst_change_hook);
826 /* Run the before-change-function if any.
827 We don't bother "binding" this variable to nil
828 because it is obsolete anyway and new code should not use it. */
829 if (!NILP (Vbefore_change_function))
830 call2 (Vbefore_change_function, start, end);
832 /* Now run the before-change-functions if any. */
833 if (!NILP (Vbefore_change_functions))
835 Lisp_Object args[3];
836 Lisp_Object before_change_functions;
837 Lisp_Object after_change_functions;
838 struct gcpro gcpro1, gcpro2;
840 /* "Bind" before-change-functions and after-change-functions
841 to nil--but in a way that errors don't know about.
842 That way, if there's an error in them, they will stay nil. */
843 before_change_functions = Vbefore_change_functions;
844 after_change_functions = Vafter_change_functions;
845 Vbefore_change_functions = Qnil;
846 Vafter_change_functions = Qnil;
847 GCPRO2 (before_change_functions, after_change_functions);
849 /* Actually run the hook functions. */
850 args[0] = Qbefore_change_functions;
851 args[1] = start;
852 args[2] = end;
853 run_hook_list_with_args (before_change_functions, 3, args);
855 /* "Unbind" the variables we "bound" to nil. */
856 Vbefore_change_functions = before_change_functions;
857 Vafter_change_functions = after_change_functions;
858 UNGCPRO;
861 if (!NILP (current_buffer->overlays_before)
862 || !NILP (current_buffer->overlays_after))
863 report_overlay_modification (start, end, 0, start, end, Qnil);
866 /* Signal a change immediately after it happens.
867 POS is the address of the start of the changed text.
868 LENDEL is the number of characters of the text before the change.
869 (Not the whole buffer; just the part that was changed.)
870 LENINS is the number of characters in that part of the text
871 after the change. */
873 void
874 signal_after_change (pos, lendel, lenins)
875 int pos, lendel, lenins;
877 /* If we are deferring calls to the after-change functions
878 and there are no before-change functions,
879 just record the args that we were going to use. */
880 if (! NILP (Vcombine_after_change_calls)
881 && NILP (Vbefore_change_function) && NILP (Vbefore_change_functions)
882 && NILP (current_buffer->overlays_before)
883 && NILP (current_buffer->overlays_after))
885 Lisp_Object elt;
887 if (!NILP (combine_after_change_list)
888 && current_buffer != XBUFFER (combine_after_change_buffer))
889 Fcombine_after_change_execute ();
891 elt = Fcons (make_number (pos - BEG),
892 Fcons (make_number (Z - (pos - lendel + lenins)),
893 Fcons (make_number (lenins - lendel), Qnil)));
894 combine_after_change_list
895 = Fcons (elt, combine_after_change_list);
896 combine_after_change_buffer = Fcurrent_buffer ();
898 return;
901 if (!NILP (combine_after_change_list))
902 Fcombine_after_change_execute ();
904 /* Run the after-change-function if any.
905 We don't bother "binding" this variable to nil
906 because it is obsolete anyway and new code should not use it. */
907 if (!NILP (Vafter_change_function))
908 call3 (Vafter_change_function,
909 make_number (pos), make_number (pos + lenins),
910 make_number (lendel));
912 if (!NILP (Vafter_change_functions))
914 Lisp_Object args[4];
915 Lisp_Object before_change_functions;
916 Lisp_Object after_change_functions;
917 struct gcpro gcpro1, gcpro2;
919 /* "Bind" before-change-functions and after-change-functions
920 to nil--but in a way that errors don't know about.
921 That way, if there's an error in them, they will stay nil. */
922 before_change_functions = Vbefore_change_functions;
923 after_change_functions = Vafter_change_functions;
924 Vbefore_change_functions = Qnil;
925 Vafter_change_functions = Qnil;
926 GCPRO2 (before_change_functions, after_change_functions);
928 /* Actually run the hook functions. */
929 args[0] = Qafter_change_functions;
930 XSETFASTINT (args[1], pos);
931 XSETFASTINT (args[2], pos + lenins);
932 XSETFASTINT (args[3], lendel);
933 run_hook_list_with_args (after_change_functions,
934 4, args);
936 /* "Unbind" the variables we "bound" to nil. */
937 Vbefore_change_functions = before_change_functions;
938 Vafter_change_functions = after_change_functions;
939 UNGCPRO;
942 if (!NILP (current_buffer->overlays_before)
943 || !NILP (current_buffer->overlays_after))
944 report_overlay_modification (make_number (pos),
945 make_number (pos + lenins),
947 make_number (pos), make_number (pos + lenins),
948 make_number (lendel));
950 /* After an insertion, call the text properties
951 insert-behind-hooks or insert-in-front-hooks. */
952 if (lendel == 0)
953 report_interval_modification (pos, pos + lenins);
956 Lisp_Object
957 Fcombine_after_change_execute_1 (val)
958 Lisp_Object val;
960 Vcombine_after_change_calls = val;
961 return val;
964 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
965 Scombine_after_change_execute, 0, 0, 0,
966 "This function is for use internally in `combine-after-change-calls'.")
969 register Lisp_Object val;
970 int count = specpdl_ptr - specpdl;
971 int beg, end, change;
972 int begpos, endpos;
973 Lisp_Object tail;
975 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
977 Fset_buffer (combine_after_change_buffer);
979 /* # chars unchanged at beginning of buffer. */
980 beg = Z - BEG;
981 /* # chars unchanged at end of buffer. */
982 end = beg;
983 /* Total amount of insertion (negative for deletion). */
984 change = 0;
986 /* Scan the various individual changes,
987 accumulating the range info in BEG, END and CHANGE. */
988 for (tail = combine_after_change_list; CONSP (tail);
989 tail = XCONS (tail)->cdr)
991 Lisp_Object elt, thisbeg, thisend, thischange;
993 /* Extract the info from the next element. */
994 elt = XCONS (tail)->car;
995 if (! CONSP (elt))
996 continue;
997 thisbeg = XINT (XCONS (elt)->car);
999 elt = XCONS (elt)->cdr;
1000 if (! CONSP (elt))
1001 continue;
1002 thisend = XINT (XCONS (elt)->car);
1004 elt = XCONS (elt)->cdr;
1005 if (! CONSP (elt))
1006 continue;
1007 thischange = XINT (XCONS (elt)->car);
1009 /* Merge this range into the accumulated range. */
1010 change += thischange;
1011 if (thisbeg < beg)
1012 beg = thisbeg;
1013 if (thisend < end)
1014 end = thisend;
1017 /* Get the current start and end positions of the range
1018 that was changed. */
1019 begpos = BEG + beg;
1020 endpos = Z - end;
1022 /* We are about to handle these, so discard them. */
1023 combine_after_change_list = Qnil;
1025 /* Now run the after-change functions for real.
1026 Turn off the flag that defers them. */
1027 record_unwind_protect (Fcombine_after_change_execute_1,
1028 Vcombine_after_change_calls);
1029 signal_after_change (begpos, endpos - begpos - change, endpos - begpos);
1031 return unbind_to (count, val);
1034 syms_of_insdel ()
1036 staticpro (&combine_after_change_list);
1037 combine_after_change_list = Qnil;
1039 DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls,
1040 "Used internally by the `combine-after-change-calls' macro.");
1041 Vcombine_after_change_calls = Qnil;
1043 defsubr (&Scombine_after_change_execute);