1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 86, 93, 94, 95, 1997 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)
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. */
24 #include "intervals.h"
28 #include "blockinput.h"
34 #define min(x, y) ((x) < (y) ? (x) : (y))
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));
45 Lisp_Object
Fcombine_after_change_execute ();
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
;
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.
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
;
63 /* Buffer which combine_after_change_list is about. */
64 Lisp_Object combine_after_change_buffer
;
66 /* Move gap to position CHARPOS.
67 Note that this can quit! */
73 move_gap_both (charpos
, charpos_to_bytepos (charpos
));
76 /* Move gap to byte position BYTEPOS, which is also char position CHARPOS.
77 Note that this can quit! */
80 move_gap_both (charpos
, bytepos
)
83 if (bytepos
< GPT_BYTE
)
84 gap_left (charpos
, bytepos
, 0);
85 else if (bytepos
> GPT_BYTE
)
86 gap_right (charpos
, bytepos
);
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. */
95 gap_left (charpos
, bytepos
, newgap
)
96 register int charpos
, bytepos
;
99 register unsigned char *to
, *from
;
105 if (unchanged_modified
== MODIFF
106 && overlay_unchanged_modified
== OVERLAY_MODIFF
)
108 beg_unchanged
= charpos
- BEG
;
109 end_unchanged
= Z
- charpos
;
113 if (Z
- GPT
< end_unchanged
)
114 end_unchanged
= Z
- GPT
;
115 if (charpos
< beg_unchanged
)
116 beg_unchanged
= charpos
- BEG
;
125 /* Now copy the characters. To move the gap down,
126 copy characters up. */
130 /* I gets number of characters left to copy. */
131 i
= new_s1
- bytepos
;
134 /* If a quit is requested, stop copying now.
135 Change BYTEPOS to be where we have actually moved the gap to. */
139 charpos
= BYTE_TO_CHAR (bytepos
);
142 /* Move at most 32000 chars before checking again for a quit. */
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))
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
)
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
);
175 if (bytepos
< charpos
)
177 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
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. */
186 gap_right (charpos
, bytepos
)
187 register int charpos
, bytepos
;
189 register unsigned char *to
, *from
;
193 if (unchanged_modified
== MODIFF
194 && overlay_unchanged_modified
== OVERLAY_MODIFF
)
196 beg_unchanged
= charpos
- BEG
;
197 end_unchanged
= Z
- charpos
;
201 if (Z
- charpos
- 1 < end_unchanged
)
202 end_unchanged
= Z
- charpos
;
203 if (GPT
- BEG
< beg_unchanged
)
204 beg_unchanged
= GPT
- BEG
;
212 /* Now copy the characters. To move the gap up,
213 copy characters down. */
217 /* I gets number of characters left to copy. */
218 i
= bytepos
- new_s1
;
221 /* If a quit is requested, stop copying now.
222 Change BYTEPOS to be where we have actually moved the gap to. */
226 charpos
= BYTE_TO_CHAR (bytepos
);
229 /* Move at most 32000 chars before checking again for a quit. */
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))
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
)
256 adjust_markers_gap_motion (GPT_BYTE
+ GAP_SIZE
, bytepos
+ GAP_SIZE
,
260 if (bytepos
< charpos
)
262 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
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).
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.
273 When the latter adjustment is done, if AMOUNT is negative,
274 we record the adjustment for undo. (This case happens only for
277 The markers' character positions are not altered,
278 because gap motion does not affect character positions. */
280 int adjust_markers_test
;
283 adjust_markers_gap_motion (from
, to
, amount
)
284 register int from
, to
, amount
;
287 register struct Lisp_Marker
*m
;
290 marker
= BUF_MARKERS (current_buffer
);
292 while (!NILP (marker
))
294 m
= XMARKER (marker
);
298 if (mpos
> to
&& mpos
< to
+ amount
)
300 if (adjust_markers_test
)
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
)
312 if (adjust_markers_test
)
314 mpos
= from
+ amount
;
317 if (mpos
> from
&& mpos
<= to
)
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.
328 This function assumes that the gap is adjacent to
329 or inside of the range being deleted. */
332 adjust_markers_for_delete (from
, from_byte
, to
, to_byte
)
333 register int from
, from_byte
, to
, to_byte
;
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
;
341 marker
= BUF_MARKERS (current_buffer
);
343 while (!NILP (marker
))
345 m
= XMARKER (marker
);
346 charpos
= m
->charpos
;
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. */
355 m
->charpos
-= to
- from
;
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
)
361 record_marker_adjustment (marker
, from
- charpos
);
363 /* The gap must be at or after FROM_BYTE when we do a deletion. */
364 m
->bufpos
= from_byte
;
367 /* In a single-byte buffer, a marker's two positions must be equal. */
370 register int i
= m
->bufpos
;
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
)
387 /* Adjust markers for an insertion at CHARPOS / BYTEPOS
388 consisting of NCHARS chars, which are NBYTES bytes.
390 We have to relocate the charpos of every marker that points
391 after the insertion (but not their bufpos).
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. */
398 adjust_markers_for_insert (from
, from_byte
, to
, to_byte
, before_markers
)
399 register int from
, from_byte
, to
, to_byte
, before_markers
;
403 int nchars
= to
- from
;
404 int nbytes
= to_byte
- from_byte
;
406 marker
= BUF_MARKERS (current_buffer
);
408 while (!NILP (marker
))
410 register struct Lisp_Marker
*m
= XMARKER (marker
);
411 if (m
->bufpos
== from_byte
412 && (m
->insertion_type
|| before_markers
))
415 m
->charpos
+= nchars
;
416 if (m
->insertion_type
)
419 else if (m
->bufpos
> from_byte
)
420 m
->charpos
+= nchars
;
422 /* In a single-byte buffer, a marker's two positions must be equal. */
425 register int i
= m
->bufpos
;
427 if (i
> GPT_BYTE
+ GAP_SIZE
)
429 else if (i
> GPT_BYTE
)
439 /* Adjusting only markers whose insertion-type is t may result in
440 disordered overlays in the slot `overlays_before'. */
442 fix_overlays_before (current_buffer
, from
, to
);
445 /* Adjust point for an insertion of NBYTES bytes, which are NCHARS characters.
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
456 adjust_point (nchars
, nbytes
)
459 BUF_PT (current_buffer
) += nchars
;
460 BUF_PT_BYTE (current_buffer
) += nbytes
;
462 /* In a single-byte buffer, the two positions must be equal. */
468 /* Make the gap NBYTES_ADDED bytes longer. */
471 make_gap (nbytes_added
)
474 unsigned char *result
;
477 int real_gap_loc_byte
;
480 /* If we have to get more space, get enough to last a while. */
481 nbytes_added
+= 2000;
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'. */
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");
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));
502 /* We can't unblock until the new address is properly stored. */
506 /* Prevent quitting in move_gap. */
511 real_gap_loc_byte
= GPT_BYTE
;
512 old_gap_size
= GAP_SIZE
;
514 /* Call the newly allocated space a gap at the end of the whole space. */
516 GAP_SIZE
= nbytes_added
;
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);
522 /* Now combine the two into one large gap. */
523 GAP_SIZE
+= old_gap_size
;
525 GPT_BYTE
= real_gap_loc_byte
;
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. */
538 insert (string
, nbytes
)
539 register unsigned char *string
;
545 insert_1 (string
, nbytes
, 0, 1, 0);
546 signal_after_change (opoint
, 0, PT
- opoint
);
551 insert_and_inherit (string
, nbytes
)
552 register unsigned char *string
;
558 insert_1 (string
, nbytes
, 1, 1, 0);
559 signal_after_change (opoint
, 0, PT
- opoint
);
563 /* Insert the character C before point */
569 unsigned char workbuf
[4], *str
;
570 int len
= CHAR_STRING (c
, workbuf
, str
);
575 /* Insert the null-terminated string S before point */
581 insert (s
, strlen (s
));
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. */
590 insert_before_markers (string
, nbytes
)
591 unsigned char *string
;
598 insert_1 (string
, nbytes
, 0, 1, 1);
599 signal_after_change (opoint
, 0, PT
- opoint
);
604 insert_before_markers_and_inherit (string
, nbytes
)
605 unsigned char *string
;
612 insert_1 (string
, nbytes
, 1, 1, 1);
613 signal_after_change (opoint
, 0, PT
- opoint
);
617 /* Subroutine used by the insert functions above. */
620 insert_1 (string
, nbytes
, inherit
, prepare
, before_markers
)
621 register unsigned char *string
;
623 int inherit
, prepare
, before_markers
;
625 register Lisp_Object temp
;
626 int nchars
= chars_in_text (string
, nbytes
);
629 prepare_to_modify_buffer (PT
, PT
, NULL
);
632 move_gap_both (PT
, PT_BYTE
);
633 if (GAP_SIZE
< nbytes
)
634 make_gap (nbytes
- GAP_SIZE
);
636 record_insert (PT
, nchars
);
639 bcopy (string
, GPT_ADDR
, nbytes
);
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
);
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
,
658 adjust_point (nchars
, nbytes
);
663 #ifdef USE_TEXT_PROPERTIES
664 if (!inherit
&& BUF_INTERVALS (current_buffer
) != 0)
665 Fset_text_properties (make_number (PT
- nchars
), make_number (PT
),
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
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. */
680 insert_from_string (string
, pos
, length
, inherit
)
682 register int pos
, length
;
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
);
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. */
699 /* Insert part of a Lisp string, relocating markers after. */
702 insert_from_string_before_markers (string
, pos
, length
, inherit
)
704 register int pos
, length
;
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
);
716 /* Subroutine of the insertion functions above. */
719 insert_from_string_1 (string
, pos
, nbytes
, nchars
, inherit
, before_markers
)
721 register int pos
, nbytes
, nchars
;
722 int inherit
, before_markers
;
724 register Lisp_Object temp
;
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");
733 prepare_to_modify_buffer (PT
, PT
, NULL
);
736 move_gap_both (PT
, PT_BYTE
);
737 if (GAP_SIZE
< nbytes
)
738 make_gap (nbytes
- GAP_SIZE
);
740 record_insert (PT
, nchars
);
744 bcopy (XSTRING (string
)->data
, GPT_ADDR
, nbytes
);
746 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
747 offset_intervals (current_buffer
, PT
, nchars
);
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
,
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
);
768 adjust_point (nchars
, nbytes
);
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.
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. */
779 insert_from_buffer (buf
, charpos
, nchars
, inherit
)
788 insert_from_buffer_1 (buf
, charpos
, nchars
, inherit
);
789 signal_after_change (opoint
, 0, PT
- opoint
);
794 insert_from_buffer_1 (buf
, from
, nchars
, inherit
)
799 register Lisp_Object temp
;
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
;
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");
810 prepare_to_modify_buffer (PT
, PT
, NULL
);
813 move_gap_both (PT
, PT_BYTE
);
814 if (GAP_SIZE
< nbytes
)
815 make_gap (nbytes
- GAP_SIZE
);
817 record_insert (PT
, nchars
);
820 if (from
< BUF_GPT (buf
))
822 chunk
= BUF_GPT_BYTE (buf
) - from_byte
;
825 bcopy (BUF_BYTE_ADDRESS (buf
, from_byte
), GPT_ADDR
, chunk
);
830 bcopy (BUF_BYTE_ADDRESS (buf
, from_byte
+ chunk
),
831 GPT_ADDR
+ chunk
, nbytes
- chunk
);
833 #ifdef USE_TEXT_PROPERTIES
834 if (BUF_INTERVALS (current_buffer
) != 0)
835 offset_intervals (current_buffer
, PT
, nchars
);
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
);
853 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
854 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf
),
857 current_buffer
, inherit
);
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. */
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. */
871 replace_range (from
, to
, new, prepare
, inherit
)
873 int from
, to
, prepare
, inherit
;
875 int insbytes
= XSTRING (new)->size
;
877 int from_byte
, to_byte
;
878 int nbytes_del
, nchars_del
;
879 register Lisp_Object temp
;
886 int range_length
= to
- from
;
887 prepare_to_modify_buffer (from
, to
, &from
);
888 to
= from
+ range_length
;
893 /* Make args be valid */
899 from_byte
= CHAR_TO_BYTE (from
);
900 to_byte
= CHAR_TO_BYTE (to
);
902 nchars_del
= to
- from
;
903 nbytes_del
= to_byte
- from_byte
;
905 if (nbytes_del
<= 0 && insbytes
== 0)
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");
913 inschars
= XINT (Fchars_in_string (new));
917 /* Make sure the gap is somewhere in or next to what we are deleting. */
919 gap_right (from
, from_byte
);
921 gap_left (to
, to_byte
, 0);
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
);
929 record_delete (from
, nchars_del
);
931 GAP_SIZE
+= nbytes_del
;
934 ZV_BYTE
-= nbytes_del
;
935 Z_BYTE
-= nbytes_del
;
937 GPT_BYTE
= from_byte
;
938 *(GPT_ADDR
) = 0; /* Put an anchor. */
943 if (GPT
- BEG
< beg_unchanged
)
944 beg_unchanged
= GPT
- BEG
;
945 if (Z
- GPT
< end_unchanged
)
946 end_unchanged
= Z
- GPT
;
948 if (GAP_SIZE
< insbytes
)
949 make_gap (insbytes
- GAP_SIZE
);
951 record_insert (from
, inschars
);
953 bcopy (XSTRING (new)->data
, GPT_ADDR
, insbytes
);
955 /* Relocate point as if it were a marker. */
957 adjust_point (from
+ inschars
- (PT
< to
? PT
: to
),
958 (from_byte
+ insbytes
959 - (PT_BYTE
< to_byte
? PT_BYTE
: to_byte
)));
961 #ifdef USE_TEXT_PROPERTIES
962 offset_intervals (current_buffer
, PT
, inschars
- nchars_del
);
965 GAP_SIZE
-= insbytes
;
969 GPT_BYTE
+= insbytes
;
972 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
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);
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
);
991 evaporate_overlays (from
);
996 signal_after_change (from
, nchars_del
, inschars
);
999 /* Delete characters in current buffer
1000 from FROM up to (but not including) TO.
1001 If TO comes before FROM, we delete nothing. */
1004 del_range (from
, to
)
1005 register int from
, to
;
1007 del_range_1 (from
, to
, 1);
1010 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
1013 del_range_1 (from
, to
, prepare
)
1014 int from
, to
, prepare
;
1016 int from_byte
, to_byte
;
1018 /* Make args be valid */
1029 int range_length
= to
- from
;
1030 prepare_to_modify_buffer (from
, to
, &from
);
1031 to
= from
+ range_length
;
1034 from_byte
= CHAR_TO_BYTE (from
);
1035 to_byte
= CHAR_TO_BYTE (to
);
1037 del_range_2 (from
, to
, from_byte
, to_byte
);
1040 /* Like del_range_1 but args are byte positions, not char positions. */
1043 del_range_byte (from_byte
, to_byte
, prepare
)
1044 int from_byte
, to_byte
, prepare
;
1048 /* Make args be valid */
1049 if (from_byte
< BEGV_BYTE
)
1050 from_byte
= BEGV_BYTE
;
1051 if (to_byte
> ZV_BYTE
)
1054 if (to_byte
<= from_byte
)
1057 from
= BYTE_TO_CHAR (from_byte
);
1058 to
= BYTE_TO_CHAR (to_byte
);
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
;
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
);
1073 del_range_2 (from
, to
, from_byte
, to_byte
);
1076 /* Like del_range_1, but positions are specified both as charpos
1080 del_range_both (from
, to
, from_byte
, to_byte
, prepare
)
1081 int from
, to
, from_byte
, to_byte
, prepare
;
1083 /* Make args be valid */
1084 if (from_byte
< BEGV_BYTE
)
1085 from_byte
= BEGV_BYTE
;
1086 if (to_byte
> ZV_BYTE
)
1089 if (to_byte
<= from_byte
)
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
;
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
);
1110 del_range_2 (from
, to
, from_byte
, to_byte
);
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. */
1118 del_range_2 (from
, to
, from_byte
, to_byte
)
1119 int from
, to
, from_byte
, to_byte
;
1121 register int nbytes_del
, nchars_del
;
1123 nchars_del
= to
- from
;
1124 nbytes_del
= to_byte
- from_byte
;
1126 /* Make sure the gap is somewhere in or next to what we are deleting. */
1128 gap_right (from
, from_byte
);
1130 gap_left (to
, to_byte
, 0);
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
);
1138 record_delete (from
, nchars_del
);
1141 /* Relocate point as if it were a marker. */
1143 adjust_point (from
- (PT
< to
? PT
: to
),
1144 from_byte
- (PT_BYTE
< to_byte
? PT_BYTE
: to_byte
));
1146 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1147 offset_intervals (current_buffer
, from
, - nchars_del
);
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
);
1153 GAP_SIZE
+= nbytes_del
;
1154 ZV_BYTE
-= nbytes_del
;
1155 Z_BYTE
-= nbytes_del
;
1159 GPT_BYTE
= from_byte
;
1160 *(GPT_ADDR
) = 0; /* Put an anchor. */
1165 if (GPT
- BEG
< beg_unchanged
)
1166 beg_unchanged
= GPT
- BEG
;
1167 if (Z
- GPT
< end_unchanged
)
1168 end_unchanged
= Z
- GPT
;
1170 evaporate_overlays (from
);
1171 signal_after_change (from
, nchars_del
, 0);
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
1181 modify_region (buffer
, start
, end
)
1182 struct buffer
*buffer
;
1185 struct buffer
*old_buffer
= current_buffer
;
1187 if (buffer
!= old_buffer
)
1188 set_buffer_internal (buffer
);
1190 prepare_to_modify_buffer (start
, end
, NULL
);
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
;
1201 if (MODIFF
<= SAVE_MODIFF
)
1202 record_first_change ();
1205 buffer
->point_before_scroll
= Qnil
;
1207 if (buffer
!= old_buffer
)
1208 set_buffer_internal (old_buffer
);
1211 /* Check that it is okay to modify the buffer between START and END,
1212 which are char positions.
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.
1218 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1219 by holding its value temporarily in a marker. */
1222 prepare_to_modify_buffer (start
, end
, preserve_ptr
)
1226 if (!NILP (current_buffer
->read_only
))
1227 Fbarf_if_buffer_read_only ();
1229 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1230 if (BUF_INTERVALS (current_buffer
) != 0)
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
);
1244 verify_interval_modification (current_buffer
, start
, end
);
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
);
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 */
1263 signal_before_change (start
, end
, preserve_ptr
);
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
);
1274 Vdeactivate_mark
= Qt
;
1277 /* These macros work with an argument named `preserve_ptr'
1278 and a local variable named `preserve_marker'. */
1280 #define PRESERVE_VALUE \
1281 if (preserve_ptr && NILP (preserve_marker)) \
1282 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil)
1284 #define RESTORE_VALUE \
1285 if (! NILP (preserve_marker)) \
1287 *preserve_ptr = marker_position (preserve_marker); \
1288 unchain_marker (preserve_marker); \
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);
1297 #define FETCH_START \
1298 (! NILP (start_marker) ? Fmarker_position (start_marker) : start)
1301 (! NILP (end_marker) ? Fmarker_position (end_marker) : end)
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.
1306 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1307 by holding its value temporarily in a marker. */
1310 signal_before_change (start_int
, end_int
, preserve_ptr
)
1311 int start_int
, end_int
;
1314 Lisp_Object start
, end
;
1315 Lisp_Object start_marker
, end_marker
;
1316 Lisp_Object preserve_marker
;
1317 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1319 start
= make_number (start_int
);
1320 end
= make_number (end_int
);
1321 preserve_marker
= Qnil
;
1322 start_marker
= Qnil
;
1324 GCPRO3 (preserve_marker
, start_marker
, end_marker
);
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
))
1333 call1 (Vrun_hooks
, Qfirst_change_hook
);
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
))
1343 call2 (Vbefore_change_function
, FETCH_START
, FETCH_END
);
1346 /* Now run the before-change-functions if any. */
1347 if (!NILP (Vbefore_change_functions
))
1349 Lisp_Object args
[3];
1350 Lisp_Object before_change_functions
;
1351 Lisp_Object after_change_functions
;
1352 struct gcpro gcpro1
, gcpro2
;
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
);
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
);
1372 /* "Unbind" the variables we "bound" to nil. */
1373 Vbefore_change_functions
= before_change_functions
;
1374 Vafter_change_functions
= after_change_functions
;
1378 if (!NILP (current_buffer
->overlays_before
)
1379 || !NILP (current_buffer
->overlays_after
))
1382 report_overlay_modification (FETCH_START
, FETCH_END
, 0,
1383 FETCH_START
, FETCH_END
, Qnil
);
1386 if (! NILP (start_marker
))
1387 free_marker (start_marker
);
1388 if (! NILP (end_marker
))
1389 free_marker (end_marker
);
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. */
1402 signal_after_change (charpos
, lendel
, lenins
)
1403 int charpos
, lendel
, lenins
;
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
))
1415 if (!NILP (combine_after_change_list
)
1416 && current_buffer
!= XBUFFER (combine_after_change_buffer
))
1417 Fcombine_after_change_execute ();
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 ();
1429 if (!NILP (combine_after_change_list
))
1430 Fcombine_after_change_execute ();
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
));
1440 if (!NILP (Vafter_change_functions
))
1442 Lisp_Object args
[4];
1443 Lisp_Object before_change_functions
;
1444 Lisp_Object after_change_functions
;
1445 struct gcpro gcpro1
, gcpro2
;
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
);
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
,
1464 /* "Unbind" the variables we "bound" to nil. */
1465 Vbefore_change_functions
= before_change_functions
;
1466 Vafter_change_functions
= after_change_functions
;
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
),
1475 make_number (charpos
),
1476 make_number (charpos
+ lenins
),
1477 make_number (lendel
));
1479 /* After an insertion, call the text properties
1480 insert-behind-hooks or insert-in-front-hooks. */
1482 report_interval_modification (charpos
, charpos
+ lenins
);
1486 Fcombine_after_change_execute_1 (val
)
1489 Vcombine_after_change_calls
= val
;
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'.")
1498 register Lisp_Object val
;
1499 int count
= specpdl_ptr
- specpdl
;
1500 int beg
, end
, change
;
1504 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
1506 Fset_buffer (combine_after_change_buffer
);
1508 /* # chars unchanged at beginning of buffer. */
1510 /* # chars unchanged at end of buffer. */
1512 /* Total amount of insertion (negative for deletion). */
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
)
1521 int thisbeg
, thisend
, thischange
;
1523 /* Extract the info from the next element. */
1524 elt
= XCONS (tail
)->car
;
1527 thisbeg
= XINT (XCONS (elt
)->car
);
1529 elt
= XCONS (elt
)->cdr
;
1532 thisend
= XINT (XCONS (elt
)->car
);
1534 elt
= XCONS (elt
)->cdr
;
1537 thischange
= XINT (XCONS (elt
)->car
);
1539 /* Merge this range into the accumulated range. */
1540 change
+= thischange
;
1547 /* Get the current start and end positions of the range
1548 that was changed. */
1552 /* We are about to handle these, so discard them. */
1553 combine_after_change_list
= Qnil
;
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
);
1561 return unbind_to (count
, val
);
1566 staticpro (&combine_after_change_list
);
1567 combine_after_change_list
= Qnil
;
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
;
1573 defsubr (&Scombine_after_change_execute
);