]> code.delx.au - gnu-emacs/blob - src/insdel.c
(Fmake_marker): Initialize marker's bytepos and charpos.
[gnu-emacs] / src / insdel.c
1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 86, 93, 94, 95, 1997 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 #ifndef NULL
31 #define NULL 0
32 #endif
33
34 #define min(x, y) ((x) < (y) ? (x) : (y))
35
36 static void insert_from_string_1 P_ ((Lisp_Object, int, int, int, int, int));
37 static void insert_from_buffer_1 ();
38 static void gap_left P_ ((int, int, int));
39 static void gap_right P_ ((int, int));
40 static void adjust_markers_gap_motion P_ ((int, int, int));
41 static void adjust_markers_for_insert P_ ((int, int, int, int, int));
42 static void adjust_markers_for_delete P_ ((int, int, int, int));
43 static void adjust_point P_ ((int, int));
44
45 Lisp_Object Fcombine_after_change_execute ();
46
47 /* Non-nil means don't call the after-change-functions right away,
48 just record an element in Vcombine_after_change_calls_list. */
49 Lisp_Object Vcombine_after_change_calls;
50
51 /* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
52 describing changes which happened while combine_after_change_calls
53 was nonzero. We use this to decide how to call them
54 once the deferral ends.
55
56 In each element.
57 BEG-UNCHANGED is the number of chars before the changed range.
58 END-UNCHANGED is the number of chars after the changed range,
59 and CHANGE-AMOUNT is the number of characters inserted by the change
60 (negative for a deletion). */
61 Lisp_Object combine_after_change_list;
62
63 /* Buffer which combine_after_change_list is about. */
64 Lisp_Object combine_after_change_buffer;
65
66 /* Move gap to position CHARPOS.
67 Note that this can quit! */
68
69 void
70 move_gap (charpos)
71 int charpos;
72 {
73 move_gap_both (charpos, charpos_to_bytepos (charpos));
74 }
75
76 /* Move gap to byte position BYTEPOS, which is also char position CHARPOS.
77 Note that this can quit! */
78
79 void
80 move_gap_both (charpos, bytepos)
81 int charpos, bytepos;
82 {
83 if (bytepos < GPT_BYTE)
84 gap_left (charpos, bytepos, 0);
85 else if (bytepos > GPT_BYTE)
86 gap_right (charpos, bytepos);
87 }
88
89 /* Move the gap to a position less than the current GPT.
90 BYTEPOS describes the new position as a byte position,
91 and CHARPOS is the corresponding char position.
92 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
93
94 static void
95 gap_left (charpos, bytepos, newgap)
96 register int charpos, bytepos;
97 int newgap;
98 {
99 register unsigned char *to, *from;
100 register int i;
101 int new_s1;
102
103 if (!newgap)
104 {
105 if (unchanged_modified == MODIFF
106 && overlay_unchanged_modified == OVERLAY_MODIFF)
107 {
108 beg_unchanged = charpos - BEG;
109 end_unchanged = Z - charpos;
110 }
111 else
112 {
113 if (Z - GPT < end_unchanged)
114 end_unchanged = Z - GPT;
115 if (charpos < beg_unchanged)
116 beg_unchanged = charpos - BEG;
117 }
118 }
119
120 i = GPT_BYTE;
121 to = GAP_END_ADDR;
122 from = GPT_ADDR;
123 new_s1 = GPT_BYTE;
124
125 /* Now copy the characters. To move the gap down,
126 copy characters up. */
127
128 while (1)
129 {
130 /* I gets number of characters left to copy. */
131 i = new_s1 - bytepos;
132 if (i == 0)
133 break;
134 /* If a quit is requested, stop copying now.
135 Change BYTEPOS to be where we have actually moved the gap to. */
136 if (QUITP)
137 {
138 bytepos = new_s1;
139 charpos = BYTE_TO_CHAR (bytepos);
140 break;
141 }
142 /* Move at most 32000 chars before checking again for a quit. */
143 if (i > 32000)
144 i = 32000;
145 #ifdef GAP_USE_BCOPY
146 if (i >= 128
147 /* bcopy is safe if the two areas of memory do not overlap
148 or on systems where bcopy is always safe for moving upward. */
149 && (BCOPY_UPWARD_SAFE
150 || to - from >= 128))
151 {
152 /* If overlap is not safe, avoid it by not moving too many
153 characters at once. */
154 if (!BCOPY_UPWARD_SAFE && i > to - from)
155 i = to - from;
156 new_s1 -= i;
157 from -= i, to -= i;
158 bcopy (from, to, i);
159 }
160 else
161 #endif
162 {
163 new_s1 -= i;
164 while (--i >= 0)
165 *--to = *--from;
166 }
167 }
168
169 /* Adjust markers, and buffer data structure, to put the gap at BYTEPOS.
170 BYTEPOS is where the loop above stopped, which may be what was specified
171 or may be where a quit was detected. */
172 adjust_markers_gap_motion (bytepos, GPT_BYTE, GAP_SIZE);
173 GPT_BYTE = bytepos;
174 GPT = charpos;
175 if (bytepos < charpos)
176 abort ();
177 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
178 QUIT;
179 }
180
181 /* Move the gap to a position greater than than the current GPT.
182 BYTEPOS describes the new position as a byte position,
183 and CHARPOS is the corresponding char position. */
184
185 static void
186 gap_right (charpos, bytepos)
187 register int charpos, bytepos;
188 {
189 register unsigned char *to, *from;
190 register int i;
191 int new_s1;
192
193 if (unchanged_modified == MODIFF
194 && overlay_unchanged_modified == OVERLAY_MODIFF)
195 {
196 beg_unchanged = charpos - BEG;
197 end_unchanged = Z - charpos;
198 }
199 else
200 {
201 if (Z - charpos - 1 < end_unchanged)
202 end_unchanged = Z - charpos;
203 if (GPT - BEG < beg_unchanged)
204 beg_unchanged = GPT - BEG;
205 }
206
207 i = GPT_BYTE;
208 from = GAP_END_ADDR;
209 to = GPT_ADDR;
210 new_s1 = GPT_BYTE;
211
212 /* Now copy the characters. To move the gap up,
213 copy characters down. */
214
215 while (1)
216 {
217 /* I gets number of characters left to copy. */
218 i = bytepos - new_s1;
219 if (i == 0)
220 break;
221 /* If a quit is requested, stop copying now.
222 Change BYTEPOS to be where we have actually moved the gap to. */
223 if (QUITP)
224 {
225 bytepos = new_s1;
226 charpos = BYTE_TO_CHAR (bytepos);
227 break;
228 }
229 /* Move at most 32000 chars before checking again for a quit. */
230 if (i > 32000)
231 i = 32000;
232 #ifdef GAP_USE_BCOPY
233 if (i >= 128
234 /* bcopy is safe if the two areas of memory do not overlap
235 or on systems where bcopy is always safe for moving downward. */
236 && (BCOPY_DOWNWARD_SAFE
237 || from - to >= 128))
238 {
239 /* If overlap is not safe, avoid it by not moving too many
240 characters at once. */
241 if (!BCOPY_DOWNWARD_SAFE && i > from - to)
242 i = from - to;
243 new_s1 += i;
244 bcopy (from, to, i);
245 from += i, to += i;
246 }
247 else
248 #endif
249 {
250 new_s1 += i;
251 while (--i >= 0)
252 *to++ = *from++;
253 }
254 }
255
256 adjust_markers_gap_motion (GPT_BYTE + GAP_SIZE, bytepos + GAP_SIZE,
257 - GAP_SIZE);
258 GPT = charpos;
259 GPT_BYTE = bytepos;
260 if (bytepos < charpos)
261 abort ();
262 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
263 QUIT;
264 }
265
266 /* Add AMOUNT to the byte position of every marker in the current buffer
267 whose current byte position is between FROM (exclusive) and TO (inclusive).
268
269 Also, any markers past the outside of that interval, in the direction
270 of adjustment, are first moved back to the near end of the interval
271 and then adjusted by AMOUNT.
272
273 When the latter adjustment is done, if AMOUNT is negative,
274 we record the adjustment for undo. (This case happens only for
275 deletion.)
276
277 The markers' character positions are not altered,
278 because gap motion does not affect character positions. */
279
280 int adjust_markers_test;
281
282 static void
283 adjust_markers_gap_motion (from, to, amount)
284 register int from, to, amount;
285 {
286 Lisp_Object marker;
287 register struct Lisp_Marker *m;
288 register int mpos;
289
290 marker = BUF_MARKERS (current_buffer);
291
292 while (!NILP (marker))
293 {
294 m = XMARKER (marker);
295 mpos = m->bufpos;
296 if (amount > 0)
297 {
298 if (mpos > to && mpos < to + amount)
299 {
300 if (adjust_markers_test)
301 abort ();
302 mpos = to + amount;
303 }
304 }
305 else
306 {
307 /* Here's the case where a marker is inside text being deleted.
308 AMOUNT can be negative for gap motion, too,
309 but then this range contains no markers. */
310 if (mpos > from + amount && mpos <= from)
311 {
312 if (adjust_markers_test)
313 abort ();
314 mpos = from + amount;
315 }
316 }
317 if (mpos > from && mpos <= to)
318 mpos += amount;
319 m->bufpos = mpos;
320 marker = m->chain;
321 }
322 }
323
324 /* Adjust all markers for a deletion
325 whose range in bytes is FROM_BYTE to TO_BYTE.
326 The range in charpos is FROM to TO.
327
328 This function assumes that the gap is adjacent to
329 or inside of the range being deleted. */
330
331 static void
332 adjust_markers_for_delete (from, from_byte, to, to_byte)
333 register int from, from_byte, to, to_byte;
334 {
335 Lisp_Object marker;
336 register struct Lisp_Marker *m;
337 register int charpos;
338 /* This is what GAP_SIZE will be when this deletion is finished. */
339 int coming_gap_size = GAP_SIZE + to_byte - from_byte;
340
341 marker = BUF_MARKERS (current_buffer);
342
343 while (!NILP (marker))
344 {
345 m = XMARKER (marker);
346 charpos = m->charpos;
347
348 if (charpos > Z)
349 abort ();
350
351 /* If the marker is after the deletion,
352 its bufpos needs no change because the deleted text
353 becomes gap; but its charpos needs to be decreased. */
354 if (charpos > to)
355 m->charpos -= to - from;
356
357 /* Here's the case where a marker is inside text being deleted.
358 We take advantage of the fact that the deletion is at the gap. */
359 else if (charpos > from)
360 {
361 record_marker_adjustment (marker, from - charpos);
362 m->charpos = from;
363 /* The gap must be at or after FROM_BYTE when we do a deletion. */
364 m->bufpos = from_byte;
365 }
366
367 /* In a single-byte buffer, a marker's two positions must be equal. */
368 if (Z == Z_BYTE)
369 {
370 register int i = m->bufpos;
371
372 /* We use FROM_BYTE here instead of GPT_BYTE
373 because FROM_BYTE is where the gap will be after the deletion. */
374 if (i > from_byte + coming_gap_size)
375 i -= coming_gap_size;
376 else if (i > from_byte)
377 i = from_byte;
378
379 if (m->charpos != i)
380 abort ();
381 }
382
383 marker = m->chain;
384 }
385 }
386
387 /* Adjust markers for an insertion at CHARPOS / BYTEPOS
388 consisting of NCHARS chars, which are NBYTES bytes.
389
390 We have to relocate the charpos of every marker that points
391 after the insertion (but not their bufpos).
392
393 When a marker points at the insertion point,
394 we advance it if either its insertion-type is t
395 or BEFORE_MARKERS is true. */
396
397 static void
398 adjust_markers_for_insert (from, from_byte, to, to_byte, before_markers)
399 register int from, from_byte, to, to_byte, before_markers;
400 {
401 Lisp_Object marker;
402 int adjusted = 0;
403 int nchars = to - from;
404 int nbytes = to_byte - from_byte;
405
406 marker = BUF_MARKERS (current_buffer);
407
408 while (!NILP (marker))
409 {
410 register struct Lisp_Marker *m = XMARKER (marker);
411 if (m->bufpos == from_byte
412 && (m->insertion_type || before_markers))
413 {
414 m->bufpos += nbytes;
415 m->charpos += nchars;
416 if (m->insertion_type)
417 adjusted = 1;
418 }
419 else if (m->bufpos > from_byte)
420 m->charpos += nchars;
421
422 /* In a single-byte buffer, a marker's two positions must be equal. */
423 if (Z == Z_BYTE)
424 {
425 register int i = m->bufpos;
426
427 if (i > GPT_BYTE + GAP_SIZE)
428 i -= GAP_SIZE;
429 else if (i > GPT_BYTE)
430 i = GPT_BYTE;
431
432 if (m->charpos != i)
433 abort ();
434 }
435
436 marker = m->chain;
437 }
438
439 /* Adjusting only markers whose insertion-type is t may result in
440 disordered overlays in the slot `overlays_before'. */
441 if (adjusted)
442 fix_overlays_before (current_buffer, from, to);
443 }
444
445 /* Adjust point for an insertion of NBYTES bytes, which are NCHARS characters.
446
447 This is used only when the value of point changes due to an insert
448 or delete; it does not represent a conceptual change in point as a
449 marker. In particular, point is not crossing any interval
450 boundaries, so there's no need to use the usual SET_PT macro. In
451 fact it would be incorrect to do so, because either the old or the
452 new value of point is out of sync with the current set of
453 intervals. */
454
455 static void
456 adjust_point (nchars, nbytes)
457 int nchars, nbytes;
458 {
459 BUF_PT (current_buffer) += nchars;
460 BUF_PT_BYTE (current_buffer) += nbytes;
461
462 /* In a single-byte buffer, the two positions must be equal. */
463 if (ZV == ZV_BYTE
464 && PT != PT_BYTE)
465 abort ();
466 }
467 \f
468 /* Make the gap NBYTES_ADDED bytes longer. */
469
470 void
471 make_gap (nbytes_added)
472 int nbytes_added;
473 {
474 unsigned char *result;
475 Lisp_Object tem;
476 int real_gap_loc;
477 int real_gap_loc_byte;
478 int old_gap_size;
479
480 /* If we have to get more space, get enough to last a while. */
481 nbytes_added += 2000;
482
483 /* Don't allow a buffer size that won't fit in an int
484 even if it will fit in a Lisp integer.
485 That won't work because so many places use `int'. */
486
487 if (Z_BYTE - BEG_BYTE + GAP_SIZE + nbytes_added
488 >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1)))
489 error ("Buffer exceeds maximum size");
490
491 BLOCK_INPUT;
492 /* We allocate extra 1-byte `\0' at the tail for anchoring a search. */
493 result = BUFFER_REALLOC (BEG_ADDR, (Z_BYTE - BEG_BYTE
494 + GAP_SIZE + nbytes_added + 1));
495
496 if (result == 0)
497 {
498 UNBLOCK_INPUT;
499 memory_full ();
500 }
501
502 /* We can't unblock until the new address is properly stored. */
503 BEG_ADDR = result;
504 UNBLOCK_INPUT;
505
506 /* Prevent quitting in move_gap. */
507 tem = Vinhibit_quit;
508 Vinhibit_quit = Qt;
509
510 real_gap_loc = GPT;
511 real_gap_loc_byte = GPT_BYTE;
512 old_gap_size = GAP_SIZE;
513
514 /* Call the newly allocated space a gap at the end of the whole space. */
515 GPT = Z + GAP_SIZE;
516 GAP_SIZE = nbytes_added;
517
518 /* Move the new gap down to be consecutive with the end of the old one.
519 This adjusts the markers properly too. */
520 gap_left (real_gap_loc + old_gap_size, real_gap_loc_byte + old_gap_size, 1);
521
522 /* Now combine the two into one large gap. */
523 GAP_SIZE += old_gap_size;
524 GPT = real_gap_loc;
525 GPT_BYTE = real_gap_loc_byte;
526
527 /* Put an anchor. */
528 *(Z_ADDR) = 0;
529
530 Vinhibit_quit = tem;
531 }
532 \f
533 /* Insert a string of specified length before point.
534 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
535 prepare_to_modify_buffer could relocate the text. */
536
537 void
538 insert (string, nbytes)
539 register unsigned char *string;
540 register nbytes;
541 {
542 if (nbytes > 0)
543 {
544 int opoint = PT;
545 insert_1 (string, nbytes, 0, 1, 0);
546 signal_after_change (opoint, 0, PT - opoint);
547 }
548 }
549
550 void
551 insert_and_inherit (string, nbytes)
552 register unsigned char *string;
553 register nbytes;
554 {
555 if (nbytes > 0)
556 {
557 int opoint = PT;
558 insert_1 (string, nbytes, 1, 1, 0);
559 signal_after_change (opoint, 0, PT - opoint);
560 }
561 }
562
563 /* Insert the character C before point */
564
565 void
566 insert_char (c)
567 int c;
568 {
569 unsigned char workbuf[4], *str;
570 int len = CHAR_STRING (c, workbuf, str);
571
572 insert (str, len);
573 }
574
575 /* Insert the null-terminated string S before point */
576
577 void
578 insert_string (s)
579 char *s;
580 {
581 insert (s, strlen (s));
582 }
583
584 /* Like `insert' except that all markers pointing at the place where
585 the insertion happens are adjusted to point after it.
586 Don't use this function to insert part of a Lisp string,
587 since gc could happen and relocate it. */
588
589 void
590 insert_before_markers (string, nbytes)
591 unsigned char *string;
592 register int nbytes;
593 {
594 if (nbytes > 0)
595 {
596 int opoint = PT;
597
598 insert_1 (string, nbytes, 0, 1, 1);
599 signal_after_change (opoint, 0, PT - opoint);
600 }
601 }
602
603 void
604 insert_before_markers_and_inherit (string, nbytes)
605 unsigned char *string;
606 register int nbytes;
607 {
608 if (nbytes > 0)
609 {
610 int opoint = PT;
611
612 insert_1 (string, nbytes, 1, 1, 1);
613 signal_after_change (opoint, 0, PT - opoint);
614 }
615 }
616
617 /* Subroutine used by the insert functions above. */
618
619 void
620 insert_1 (string, nbytes, inherit, prepare, before_markers)
621 register unsigned char *string;
622 register int nbytes;
623 int inherit, prepare, before_markers;
624 {
625 register Lisp_Object temp;
626 int nchars = chars_in_text (string, nbytes);
627
628 if (prepare)
629 prepare_to_modify_buffer (PT, PT, NULL);
630
631 if (PT != GPT)
632 move_gap_both (PT, PT_BYTE);
633 if (GAP_SIZE < nbytes)
634 make_gap (nbytes - GAP_SIZE);
635
636 record_insert (PT, nchars);
637 MODIFF++;
638
639 bcopy (string, GPT_ADDR, nbytes);
640
641 #ifdef USE_TEXT_PROPERTIES
642 if (BUF_INTERVALS (current_buffer) != 0)
643 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
644 offset_intervals (current_buffer, PT, nchars);
645 #endif
646
647 GAP_SIZE -= nbytes;
648 GPT += nchars;
649 ZV += nchars;
650 Z += nchars;
651 GPT_BYTE += nbytes;
652 ZV_BYTE += nbytes;
653 Z_BYTE += nbytes;
654 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
655 adjust_overlays_for_insert (PT, nchars);
656 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars, PT_BYTE + nbytes,
657 before_markers);
658 adjust_point (nchars, nbytes);
659
660 if (GPT_BYTE < GPT)
661 abort ();
662
663 #ifdef USE_TEXT_PROPERTIES
664 if (!inherit && BUF_INTERVALS (current_buffer) != 0)
665 Fset_text_properties (make_number (PT - nchars), make_number (PT),
666 Qnil, Qnil);
667 #endif
668 }
669 \f
670 /* Insert the part of the text of STRING, a Lisp object assumed to be
671 of type string, consisting of the LENGTH characters starting at
672 position POS. If the text of STRING has properties, they are absorbed
673 into the buffer.
674
675 It does not work to use `insert' for this, because a GC could happen
676 before we bcopy the stuff into the buffer, and relocate the string
677 without insert noticing. */
678
679 void
680 insert_from_string (string, pos, length, inherit)
681 Lisp_Object string;
682 register int pos, length;
683 int inherit;
684 {
685 if (length > 0)
686 {
687 int opoint = PT;
688 int nchars = chars_in_text (XSTRING (string)->data + pos, length);
689 insert_from_string_1 (string, pos, length, nchars, inherit, 0);
690 signal_after_change (opoint, 0, PT - opoint);
691 }
692 }
693
694 /* Like `insert' except that all markers pointing at the place where
695 the insertion happens are adjusted to point after it.
696 Don't use this function to insert part of a Lisp string,
697 since gc could happen and relocate it. */
698
699 /* Insert part of a Lisp string, relocating markers after. */
700
701 void
702 insert_from_string_before_markers (string, pos, length, inherit)
703 Lisp_Object string;
704 register int pos, length;
705 int inherit;
706 {
707 if (length > 0)
708 {
709 int opoint = PT;
710 int nchars = chars_in_text (XSTRING (string)->data + pos, length);
711 insert_from_string_1 (string, pos, length, nchars, inherit, 1);
712 signal_after_change (opoint, 0, PT - opoint);
713 }
714 }
715
716 /* Subroutine of the insertion functions above. */
717
718 static void
719 insert_from_string_1 (string, pos, nbytes, nchars, inherit, before_markers)
720 Lisp_Object string;
721 register int pos, nbytes, nchars;
722 int inherit, before_markers;
723 {
724 register Lisp_Object temp;
725 struct gcpro gcpro1;
726
727 /* Make sure point-max won't overflow after this insertion. */
728 XSETINT (temp, nbytes + Z_BYTE);
729 if (nbytes + Z_BYTE != XINT (temp))
730 error ("Maximum buffer size exceeded");
731
732 GCPRO1 (string);
733 prepare_to_modify_buffer (PT, PT, NULL);
734
735 if (PT != GPT)
736 move_gap_both (PT, PT_BYTE);
737 if (GAP_SIZE < nbytes)
738 make_gap (nbytes - GAP_SIZE);
739
740 record_insert (PT, nchars);
741 MODIFF++;
742 UNGCPRO;
743
744 bcopy (XSTRING (string)->data, GPT_ADDR, nbytes);
745
746 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
747 offset_intervals (current_buffer, PT, nchars);
748
749 GAP_SIZE -= nbytes;
750 GPT += nchars;
751 ZV += nchars;
752 Z += nchars;
753 GPT_BYTE += nbytes;
754 ZV_BYTE += nbytes;
755 Z_BYTE += nbytes;
756 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
757 adjust_overlays_for_insert (PT, nchars);
758 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars, PT_BYTE + nbytes,
759 before_markers);
760
761 if (GPT_BYTE < GPT)
762 abort ();
763
764 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
765 graft_intervals_into_buffer (XSTRING (string)->intervals, PT, nchars,
766 current_buffer, inherit);
767
768 adjust_point (nchars, nbytes);
769 }
770 \f
771 /* Insert text from BUF, NCHARS characters starting at CHARPOS, into the
772 current buffer. If the text in BUF has properties, they are absorbed
773 into the current buffer.
774
775 It does not work to use `insert' for this, because a malloc could happen
776 and relocate BUF's text before the bcopy happens. */
777
778 void
779 insert_from_buffer (buf, charpos, nchars, inherit)
780 struct buffer *buf;
781 int charpos, nchars;
782 int inherit;
783 {
784 if (nchars > 0)
785 {
786 int opoint = PT;
787
788 insert_from_buffer_1 (buf, charpos, nchars, inherit);
789 signal_after_change (opoint, 0, PT - opoint);
790 }
791 }
792
793 static void
794 insert_from_buffer_1 (buf, from, nchars, inherit)
795 struct buffer *buf;
796 int from, nchars;
797 int inherit;
798 {
799 register Lisp_Object temp;
800 int chunk;
801 int from_byte = buf_charpos_to_bytepos (buf, from);
802 int to_byte = buf_charpos_to_bytepos (buf, from + nchars);
803 int nbytes = to_byte - from_byte;
804
805 /* Make sure point-max won't overflow after this insertion. */
806 XSETINT (temp, nbytes + Z);
807 if (nbytes + Z != XINT (temp))
808 error ("Maximum buffer size exceeded");
809
810 prepare_to_modify_buffer (PT, PT, NULL);
811
812 if (PT != GPT)
813 move_gap_both (PT, PT_BYTE);
814 if (GAP_SIZE < nbytes)
815 make_gap (nbytes - GAP_SIZE);
816
817 record_insert (PT, nchars);
818 MODIFF++;
819
820 if (from < BUF_GPT (buf))
821 {
822 chunk = BUF_GPT_BYTE (buf) - from_byte;
823 if (chunk > nbytes)
824 chunk = nbytes;
825 bcopy (BUF_BYTE_ADDRESS (buf, from_byte), GPT_ADDR, chunk);
826 }
827 else
828 chunk = 0;
829 if (chunk < nbytes)
830 bcopy (BUF_BYTE_ADDRESS (buf, from_byte + chunk),
831 GPT_ADDR + chunk, nbytes - chunk);
832
833 #ifdef USE_TEXT_PROPERTIES
834 if (BUF_INTERVALS (current_buffer) != 0)
835 offset_intervals (current_buffer, PT, nchars);
836 #endif
837
838 GAP_SIZE -= nbytes;
839 GPT += nchars;
840 ZV += nchars;
841 Z += nchars;
842 GPT_BYTE += nbytes;
843 ZV_BYTE += nbytes;
844 Z_BYTE += nbytes;
845 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
846 adjust_overlays_for_insert (PT, nchars);
847 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars, PT_BYTE + nbytes, 0);
848 adjust_point (nchars, nbytes);
849
850 if (GPT_BYTE < GPT)
851 abort ();
852
853 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
854 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf),
855 from, nchars),
856 PT - nchars, nchars,
857 current_buffer, inherit);
858 }
859 \f
860 /* Replace the text from character positions FROM to TO with NEW,
861 If PREPARE is nonzero, call prepare_to_modify_buffer.
862 If INHERIT, the newly inserted text should inherit text properties
863 from the surrounding non-deleted text. */
864
865 /* Note that this does not yet handle markers quite right.
866 Also it needs to record a single undo-entry that does a replacement
867 rather than a separate delete and insert.
868 That way, undo will also handle markers properly. */
869
870 void
871 replace_range (from, to, new, prepare, inherit)
872 Lisp_Object new;
873 int from, to, prepare, inherit;
874 {
875 int insbytes = XSTRING (new)->size;
876 int inschars;
877 int from_byte, to_byte;
878 int nbytes_del, nchars_del;
879 register Lisp_Object temp;
880 struct gcpro gcpro1;
881
882 GCPRO1 (new);
883
884 if (prepare)
885 {
886 int range_length = to - from;
887 prepare_to_modify_buffer (from, to, &from);
888 to = from + range_length;
889 }
890
891 UNGCPRO;
892
893 /* Make args be valid */
894 if (from < BEGV)
895 from = BEGV;
896 if (to > ZV)
897 to = ZV;
898
899 from_byte = CHAR_TO_BYTE (from);
900 to_byte = CHAR_TO_BYTE (to);
901
902 nchars_del = to - from;
903 nbytes_del = to_byte - from_byte;
904
905 if (nbytes_del <= 0 && insbytes == 0)
906 return;
907
908 /* Make sure point-max won't overflow after this insertion. */
909 XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
910 if (Z_BYTE - nbytes_del + insbytes != XINT (temp))
911 error ("Maximum buffer size exceeded");
912
913 inschars = XINT (Fchars_in_string (new));
914
915 GCPRO1 (new);
916
917 /* Make sure the gap is somewhere in or next to what we are deleting. */
918 if (from > GPT)
919 gap_right (from, from_byte);
920 if (to < GPT)
921 gap_left (to, to_byte, 0);
922
923 /* Relocate all markers pointing into the new, larger gap
924 to point at the end of the text before the gap.
925 Do this before recording the deletion,
926 so that undo handles this after reinserting the text. */
927 adjust_markers_for_delete (from, from_byte, to, to_byte);
928
929 record_delete (from, nchars_del);
930
931 GAP_SIZE += nbytes_del;
932 ZV -= nchars_del;
933 Z -= nchars_del;
934 ZV_BYTE -= nbytes_del;
935 Z_BYTE -= nbytes_del;
936 GPT = from;
937 GPT_BYTE = from_byte;
938 *(GPT_ADDR) = 0; /* Put an anchor. */
939
940 if (GPT_BYTE < GPT)
941 abort ();
942
943 if (GPT - BEG < beg_unchanged)
944 beg_unchanged = GPT - BEG;
945 if (Z - GPT < end_unchanged)
946 end_unchanged = Z - GPT;
947
948 if (GAP_SIZE < insbytes)
949 make_gap (insbytes - GAP_SIZE);
950
951 record_insert (from, inschars);
952
953 bcopy (XSTRING (new)->data, GPT_ADDR, insbytes);
954
955 /* Relocate point as if it were a marker. */
956 if (from < PT)
957 adjust_point (from + inschars - (PT < to ? PT : to),
958 (from_byte + insbytes
959 - (PT_BYTE < to_byte ? PT_BYTE : to_byte)));
960
961 #ifdef USE_TEXT_PROPERTIES
962 offset_intervals (current_buffer, PT, inschars - nchars_del);
963 #endif
964
965 GAP_SIZE -= insbytes;
966 GPT += inschars;
967 ZV += inschars;
968 Z += inschars;
969 GPT_BYTE += insbytes;
970 ZV_BYTE += insbytes;
971 ZV_BYTE += insbytes;
972 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
973
974 if (GPT_BYTE < GPT)
975 abort ();
976
977 /* Adjust the overlay center as needed. This must be done after
978 adjusting the markers that bound the overlays. */
979 adjust_overlays_for_delete (from, nchars_del);
980 adjust_overlays_for_insert (from, inschars);
981 adjust_markers_for_insert (from, from_byte, from + inschars,
982 from_byte + insbytes, 0);
983
984 #ifdef USE_TEXT_PROPERTIES
985 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
986 graft_intervals_into_buffer (XSTRING (new)->intervals, from,
987 inschars, current_buffer, inherit);
988 #endif
989
990 if (insbytes == 0)
991 evaporate_overlays (from);
992
993 MODIFF++;
994 UNGCPRO;
995
996 signal_after_change (from, nchars_del, inschars);
997 }
998 \f
999 /* Delete characters in current buffer
1000 from FROM up to (but not including) TO.
1001 If TO comes before FROM, we delete nothing. */
1002
1003 void
1004 del_range (from, to)
1005 register int from, to;
1006 {
1007 del_range_1 (from, to, 1);
1008 }
1009
1010 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
1011
1012 void
1013 del_range_1 (from, to, prepare)
1014 int from, to, prepare;
1015 {
1016 int from_byte, to_byte;
1017
1018 /* Make args be valid */
1019 if (from < BEGV)
1020 from = BEGV;
1021 if (to > ZV)
1022 to = ZV;
1023
1024 if (to <= from)
1025 return;
1026
1027 if (prepare)
1028 {
1029 int range_length = to - from;
1030 prepare_to_modify_buffer (from, to, &from);
1031 to = from + range_length;
1032 }
1033
1034 from_byte = CHAR_TO_BYTE (from);
1035 to_byte = CHAR_TO_BYTE (to);
1036
1037 del_range_2 (from, to, from_byte, to_byte);
1038 }
1039
1040 /* Like del_range_1 but args are byte positions, not char positions. */
1041
1042 void
1043 del_range_byte (from_byte, to_byte, prepare)
1044 int from_byte, to_byte, prepare;
1045 {
1046 int from, to;
1047
1048 /* Make args be valid */
1049 if (from_byte < BEGV_BYTE)
1050 from_byte = BEGV_BYTE;
1051 if (to_byte > ZV_BYTE)
1052 to_byte = ZV_BYTE;
1053
1054 if (to_byte <= from_byte)
1055 return;
1056
1057 from = BYTE_TO_CHAR (from_byte);
1058 to = BYTE_TO_CHAR (to_byte);
1059
1060 if (prepare)
1061 {
1062 int old_from = from, old_to = Z - to;
1063 int range_length = to - from;
1064 prepare_to_modify_buffer (from, to, &from);
1065 to = from + range_length;
1066
1067 if (old_from != from)
1068 from_byte = CHAR_TO_BYTE (from);
1069 if (old_to == Z - to)
1070 to_byte = CHAR_TO_BYTE (to);
1071 }
1072
1073 del_range_2 (from, to, from_byte, to_byte);
1074 }
1075
1076 /* Like del_range_1, but positions are specified both as charpos
1077 and bytepos. */
1078
1079 void
1080 del_range_both (from, to, from_byte, to_byte, prepare)
1081 int from, to, from_byte, to_byte, prepare;
1082 {
1083 /* Make args be valid */
1084 if (from_byte < BEGV_BYTE)
1085 from_byte = BEGV_BYTE;
1086 if (to_byte > ZV_BYTE)
1087 to_byte = ZV_BYTE;
1088
1089 if (to_byte <= from_byte)
1090 return;
1091
1092 if (from < BEGV)
1093 from = BEGV;
1094 if (to > ZV)
1095 to = ZV;
1096
1097 if (prepare)
1098 {
1099 int old_from = from, old_to = Z - to;
1100 int range_length = to - from;
1101 prepare_to_modify_buffer (from, to, &from);
1102 to = from + range_length;
1103
1104 if (old_from != from)
1105 from_byte = CHAR_TO_BYTE (from);
1106 if (old_to == Z - to)
1107 to_byte = CHAR_TO_BYTE (to);
1108 }
1109
1110 del_range_2 (from, to, from_byte, to_byte);
1111 }
1112
1113 /* Delete a range of text, specified both as character positions
1114 and byte positions. FROM and TO are character positions,
1115 while FROM_BYTE and TO_BYTE are byte positions. */
1116
1117 void
1118 del_range_2 (from, to, from_byte, to_byte)
1119 int from, to, from_byte, to_byte;
1120 {
1121 register int nbytes_del, nchars_del;
1122
1123 nchars_del = to - from;
1124 nbytes_del = to_byte - from_byte;
1125
1126 /* Make sure the gap is somewhere in or next to what we are deleting. */
1127 if (from > GPT)
1128 gap_right (from, from_byte);
1129 if (to < GPT)
1130 gap_left (to, to_byte, 0);
1131
1132 /* Relocate all markers pointing into the new, larger gap
1133 to point at the end of the text before the gap.
1134 Do this before recording the deletion,
1135 so that undo handles this after reinserting the text. */
1136 adjust_markers_for_delete (from, from_byte, to, to_byte);
1137
1138 record_delete (from, nchars_del);
1139 MODIFF++;
1140
1141 /* Relocate point as if it were a marker. */
1142 if (from < PT)
1143 adjust_point (from - (PT < to ? PT : to),
1144 from_byte - (PT_BYTE < to_byte ? PT_BYTE : to_byte));
1145
1146 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1147 offset_intervals (current_buffer, from, - nchars_del);
1148
1149 /* Adjust the overlay center as needed. This must be done after
1150 adjusting the markers that bound the overlays. */
1151 adjust_overlays_for_delete (from_byte, nchars_del);
1152
1153 GAP_SIZE += nbytes_del;
1154 ZV_BYTE -= nbytes_del;
1155 Z_BYTE -= nbytes_del;
1156 ZV -= nchars_del;
1157 Z -= nchars_del;
1158 GPT = from;
1159 GPT_BYTE = from_byte;
1160 *(GPT_ADDR) = 0; /* Put an anchor. */
1161
1162 if (GPT_BYTE < GPT)
1163 abort ();
1164
1165 if (GPT - BEG < beg_unchanged)
1166 beg_unchanged = GPT - BEG;
1167 if (Z - GPT < end_unchanged)
1168 end_unchanged = Z - GPT;
1169
1170 evaporate_overlays (from);
1171 signal_after_change (from, nchars_del, 0);
1172 }
1173 \f
1174 /* Call this if you're about to change the region of BUFFER from
1175 character positions START to END. This checks the read-only
1176 properties of the region, calls the necessary modification hooks,
1177 and warns the next redisplay that it should pay attention to that
1178 area. */
1179
1180 void
1181 modify_region (buffer, start, end)
1182 struct buffer *buffer;
1183 int start, end;
1184 {
1185 struct buffer *old_buffer = current_buffer;
1186
1187 if (buffer != old_buffer)
1188 set_buffer_internal (buffer);
1189
1190 prepare_to_modify_buffer (start, end, NULL);
1191
1192 if (start - 1 < beg_unchanged
1193 || (unchanged_modified == MODIFF
1194 && overlay_unchanged_modified == OVERLAY_MODIFF))
1195 beg_unchanged = start - 1;
1196 if (Z - end < end_unchanged
1197 || (unchanged_modified == MODIFF
1198 && overlay_unchanged_modified == OVERLAY_MODIFF))
1199 end_unchanged = Z - end;
1200
1201 if (MODIFF <= SAVE_MODIFF)
1202 record_first_change ();
1203 MODIFF++;
1204
1205 buffer->point_before_scroll = Qnil;
1206
1207 if (buffer != old_buffer)
1208 set_buffer_internal (old_buffer);
1209 }
1210 \f
1211 /* Check that it is okay to modify the buffer between START and END,
1212 which are char positions.
1213
1214 Run the before-change-function, if any. If intervals are in use,
1215 verify that the text to be modified is not read-only, and call
1216 any modification properties the text may have.
1217
1218 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1219 by holding its value temporarily in a marker. */
1220
1221 void
1222 prepare_to_modify_buffer (start, end, preserve_ptr)
1223 int start, end;
1224 int *preserve_ptr;
1225 {
1226 if (!NILP (current_buffer->read_only))
1227 Fbarf_if_buffer_read_only ();
1228
1229 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1230 if (BUF_INTERVALS (current_buffer) != 0)
1231 {
1232 if (preserve_ptr)
1233 {
1234 Lisp_Object preserve_marker;
1235 struct gcpro gcpro1;
1236 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil);
1237 GCPRO1 (preserve_marker);
1238 verify_interval_modification (current_buffer, start, end);
1239 *preserve_ptr = marker_position (preserve_marker);
1240 unchain_marker (preserve_marker);
1241 UNGCPRO;
1242 }
1243 else
1244 verify_interval_modification (current_buffer, start, end);
1245 }
1246
1247 #ifdef CLASH_DETECTION
1248 if (!NILP (current_buffer->file_truename)
1249 /* Make binding buffer-file-name to nil effective. */
1250 && !NILP (current_buffer->filename)
1251 && SAVE_MODIFF >= MODIFF)
1252 lock_file (current_buffer->file_truename);
1253 #else
1254 /* At least warn if this file has changed on disk since it was visited. */
1255 if (!NILP (current_buffer->filename)
1256 && SAVE_MODIFF >= MODIFF
1257 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
1258 && !NILP (Ffile_exists_p (current_buffer->filename)))
1259 call1 (intern ("ask-user-about-supersession-threat"),
1260 current_buffer->filename);
1261 #endif /* not CLASH_DETECTION */
1262
1263 signal_before_change (start, end, preserve_ptr);
1264
1265 if (current_buffer->newline_cache)
1266 invalidate_region_cache (current_buffer,
1267 current_buffer->newline_cache,
1268 start - BEG, Z - end);
1269 if (current_buffer->width_run_cache)
1270 invalidate_region_cache (current_buffer,
1271 current_buffer->width_run_cache,
1272 start - BEG, Z - end);
1273
1274 Vdeactivate_mark = Qt;
1275 }
1276 \f
1277 /* These macros work with an argument named `preserve_ptr'
1278 and a local variable named `preserve_marker'. */
1279
1280 #define PRESERVE_VALUE \
1281 if (preserve_ptr && NILP (preserve_marker)) \
1282 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil)
1283
1284 #define RESTORE_VALUE \
1285 if (! NILP (preserve_marker)) \
1286 { \
1287 *preserve_ptr = marker_position (preserve_marker); \
1288 unchain_marker (preserve_marker); \
1289 }
1290
1291 #define PRESERVE_START_END \
1292 if (NILP (start_marker)) \
1293 start_marker = Fcopy_marker (start, Qnil); \
1294 if (NILP (end_marker)) \
1295 end_marker = Fcopy_marker (end, Qnil);
1296
1297 #define FETCH_START \
1298 (! NILP (start_marker) ? Fmarker_position (start_marker) : start)
1299
1300 #define FETCH_END \
1301 (! NILP (end_marker) ? Fmarker_position (end_marker) : end)
1302
1303 /* Signal a change to the buffer immediately before it happens.
1304 START_INT and END_INT are the bounds of the text to be changed.
1305
1306 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1307 by holding its value temporarily in a marker. */
1308
1309 void
1310 signal_before_change (start_int, end_int, preserve_ptr)
1311 int start_int, end_int;
1312 int *preserve_ptr;
1313 {
1314 Lisp_Object start, end;
1315 Lisp_Object start_marker, end_marker;
1316 Lisp_Object preserve_marker;
1317 struct gcpro gcpro1, gcpro2, gcpro3;
1318
1319 start = make_number (start_int);
1320 end = make_number (end_int);
1321 preserve_marker = Qnil;
1322 start_marker = Qnil;
1323 end_marker = Qnil;
1324 GCPRO3 (preserve_marker, start_marker, end_marker);
1325
1326 /* If buffer is unmodified, run a special hook for that case. */
1327 if (SAVE_MODIFF >= MODIFF
1328 && !NILP (Vfirst_change_hook)
1329 && !NILP (Vrun_hooks))
1330 {
1331 PRESERVE_VALUE;
1332 PRESERVE_START_END;
1333 call1 (Vrun_hooks, Qfirst_change_hook);
1334 }
1335
1336 /* Run the before-change-function if any.
1337 We don't bother "binding" this variable to nil
1338 because it is obsolete anyway and new code should not use it. */
1339 if (!NILP (Vbefore_change_function))
1340 {
1341 PRESERVE_VALUE;
1342 PRESERVE_START_END;
1343 call2 (Vbefore_change_function, FETCH_START, FETCH_END);
1344 }
1345
1346 /* Now run the before-change-functions if any. */
1347 if (!NILP (Vbefore_change_functions))
1348 {
1349 Lisp_Object args[3];
1350 Lisp_Object before_change_functions;
1351 Lisp_Object after_change_functions;
1352 struct gcpro gcpro1, gcpro2;
1353
1354 PRESERVE_VALUE;
1355 PRESERVE_START_END;
1356
1357 /* "Bind" before-change-functions and after-change-functions
1358 to nil--but in a way that errors don't know about.
1359 That way, if there's an error in them, they will stay nil. */
1360 before_change_functions = Vbefore_change_functions;
1361 after_change_functions = Vafter_change_functions;
1362 Vbefore_change_functions = Qnil;
1363 Vafter_change_functions = Qnil;
1364 GCPRO2 (before_change_functions, after_change_functions);
1365
1366 /* Actually run the hook functions. */
1367 args[0] = Qbefore_change_functions;
1368 args[1] = FETCH_START;
1369 args[2] = FETCH_END;
1370 run_hook_list_with_args (before_change_functions, 3, args);
1371
1372 /* "Unbind" the variables we "bound" to nil. */
1373 Vbefore_change_functions = before_change_functions;
1374 Vafter_change_functions = after_change_functions;
1375 UNGCPRO;
1376 }
1377
1378 if (!NILP (current_buffer->overlays_before)
1379 || !NILP (current_buffer->overlays_after))
1380 {
1381 PRESERVE_VALUE;
1382 report_overlay_modification (FETCH_START, FETCH_END, 0,
1383 FETCH_START, FETCH_END, Qnil);
1384 }
1385
1386 if (! NILP (start_marker))
1387 free_marker (start_marker);
1388 if (! NILP (end_marker))
1389 free_marker (end_marker);
1390 RESTORE_VALUE;
1391 UNGCPRO;
1392 }
1393
1394 /* Signal a change immediately after it happens.
1395 CHARPOS is the character position of the start of the changed text.
1396 LENDEL is the number of characters of the text before the change.
1397 (Not the whole buffer; just the part that was changed.)
1398 LENINS is the number of characters in that part of the text
1399 after the change. */
1400
1401 void
1402 signal_after_change (charpos, lendel, lenins)
1403 int charpos, lendel, lenins;
1404 {
1405 /* If we are deferring calls to the after-change functions
1406 and there are no before-change functions,
1407 just record the args that we were going to use. */
1408 if (! NILP (Vcombine_after_change_calls)
1409 && NILP (Vbefore_change_function) && NILP (Vbefore_change_functions)
1410 && NILP (current_buffer->overlays_before)
1411 && NILP (current_buffer->overlays_after))
1412 {
1413 Lisp_Object elt;
1414
1415 if (!NILP (combine_after_change_list)
1416 && current_buffer != XBUFFER (combine_after_change_buffer))
1417 Fcombine_after_change_execute ();
1418
1419 elt = Fcons (make_number (charpos - BEG),
1420 Fcons (make_number (Z - (charpos - lendel + lenins)),
1421 Fcons (make_number (lenins - lendel), Qnil)));
1422 combine_after_change_list
1423 = Fcons (elt, combine_after_change_list);
1424 combine_after_change_buffer = Fcurrent_buffer ();
1425
1426 return;
1427 }
1428
1429 if (!NILP (combine_after_change_list))
1430 Fcombine_after_change_execute ();
1431
1432 /* Run the after-change-function if any.
1433 We don't bother "binding" this variable to nil
1434 because it is obsolete anyway and new code should not use it. */
1435 if (!NILP (Vafter_change_function))
1436 call3 (Vafter_change_function,
1437 make_number (charpos), make_number (charpos + lenins),
1438 make_number (lendel));
1439
1440 if (!NILP (Vafter_change_functions))
1441 {
1442 Lisp_Object args[4];
1443 Lisp_Object before_change_functions;
1444 Lisp_Object after_change_functions;
1445 struct gcpro gcpro1, gcpro2;
1446
1447 /* "Bind" before-change-functions and after-change-functions
1448 to nil--but in a way that errors don't know about.
1449 That way, if there's an error in them, they will stay nil. */
1450 before_change_functions = Vbefore_change_functions;
1451 after_change_functions = Vafter_change_functions;
1452 Vbefore_change_functions = Qnil;
1453 Vafter_change_functions = Qnil;
1454 GCPRO2 (before_change_functions, after_change_functions);
1455
1456 /* Actually run the hook functions. */
1457 args[0] = Qafter_change_functions;
1458 XSETFASTINT (args[1], charpos);
1459 XSETFASTINT (args[2], charpos + lenins);
1460 XSETFASTINT (args[3], lendel);
1461 run_hook_list_with_args (after_change_functions,
1462 4, args);
1463
1464 /* "Unbind" the variables we "bound" to nil. */
1465 Vbefore_change_functions = before_change_functions;
1466 Vafter_change_functions = after_change_functions;
1467 UNGCPRO;
1468 }
1469
1470 if (!NILP (current_buffer->overlays_before)
1471 || !NILP (current_buffer->overlays_after))
1472 report_overlay_modification (make_number (charpos),
1473 make_number (charpos + lenins),
1474 1,
1475 make_number (charpos),
1476 make_number (charpos + lenins),
1477 make_number (lendel));
1478
1479 /* After an insertion, call the text properties
1480 insert-behind-hooks or insert-in-front-hooks. */
1481 if (lendel == 0)
1482 report_interval_modification (charpos, charpos + lenins);
1483 }
1484
1485 Lisp_Object
1486 Fcombine_after_change_execute_1 (val)
1487 Lisp_Object val;
1488 {
1489 Vcombine_after_change_calls = val;
1490 return val;
1491 }
1492
1493 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
1494 Scombine_after_change_execute, 0, 0, 0,
1495 "This function is for use internally in `combine-after-change-calls'.")
1496 ()
1497 {
1498 register Lisp_Object val;
1499 int count = specpdl_ptr - specpdl;
1500 int beg, end, change;
1501 int begpos, endpos;
1502 Lisp_Object tail;
1503
1504 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1505
1506 Fset_buffer (combine_after_change_buffer);
1507
1508 /* # chars unchanged at beginning of buffer. */
1509 beg = Z - BEG;
1510 /* # chars unchanged at end of buffer. */
1511 end = beg;
1512 /* Total amount of insertion (negative for deletion). */
1513 change = 0;
1514
1515 /* Scan the various individual changes,
1516 accumulating the range info in BEG, END and CHANGE. */
1517 for (tail = combine_after_change_list; CONSP (tail);
1518 tail = XCONS (tail)->cdr)
1519 {
1520 Lisp_Object elt;
1521 int thisbeg, thisend, thischange;
1522
1523 /* Extract the info from the next element. */
1524 elt = XCONS (tail)->car;
1525 if (! CONSP (elt))
1526 continue;
1527 thisbeg = XINT (XCONS (elt)->car);
1528
1529 elt = XCONS (elt)->cdr;
1530 if (! CONSP (elt))
1531 continue;
1532 thisend = XINT (XCONS (elt)->car);
1533
1534 elt = XCONS (elt)->cdr;
1535 if (! CONSP (elt))
1536 continue;
1537 thischange = XINT (XCONS (elt)->car);
1538
1539 /* Merge this range into the accumulated range. */
1540 change += thischange;
1541 if (thisbeg < beg)
1542 beg = thisbeg;
1543 if (thisend < end)
1544 end = thisend;
1545 }
1546
1547 /* Get the current start and end positions of the range
1548 that was changed. */
1549 begpos = BEG + beg;
1550 endpos = Z - end;
1551
1552 /* We are about to handle these, so discard them. */
1553 combine_after_change_list = Qnil;
1554
1555 /* Now run the after-change functions for real.
1556 Turn off the flag that defers them. */
1557 record_unwind_protect (Fcombine_after_change_execute_1,
1558 Vcombine_after_change_calls);
1559 signal_after_change (begpos, endpos - begpos - change, endpos - begpos);
1560
1561 return unbind_to (count, val);
1562 }
1563 \f
1564 syms_of_insdel ()
1565 {
1566 staticpro (&combine_after_change_list);
1567 combine_after_change_list = Qnil;
1568
1569 DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls,
1570 "Used internally by the `combine-after-change-calls' macro.");
1571 Vcombine_after_change_calls = Qnil;
1572
1573 defsubr (&Scombine_after_change_execute);
1574 }