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