1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 #include "intervals.h"
26 #include "blockinput.h"
28 static void insert_from_string_1 ();
29 static void insert_from_buffer_1 ();
30 static void gap_left ();
31 static void gap_right ();
32 static void adjust_markers ();
33 static void adjust_point ();
35 /* Move gap to position `pos'.
36 Note that this can quit! */
48 /* Move the gap to POS, which is less than the current GPT.
49 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
52 gap_left (pos
, newgap
)
56 register unsigned char *to
, *from
;
64 if (unchanged_modified
== MODIFF
)
67 end_unchanged
= Z
- pos
- 1;
71 if (Z
- GPT
< end_unchanged
)
72 end_unchanged
= Z
- GPT
;
73 if (pos
< beg_unchanged
)
83 /* Now copy the characters. To move the gap down,
84 copy characters up. */
88 /* I gets number of characters left to copy. */
92 /* If a quit is requested, stop copying now.
93 Change POS to be where we have actually moved the gap to. */
99 /* Move at most 32000 chars before checking again for a quit. */
104 /* bcopy is safe if the two areas of memory do not overlap
105 or on systems where bcopy is always safe for moving upward. */
106 && (BCOPY_UPWARD_SAFE
107 || to
- from
>= 128))
109 /* If overlap is not safe, avoid it by not moving too many
110 characters at once. */
111 if (!BCOPY_UPWARD_SAFE
&& i
> to
- from
)
126 /* Adjust markers, and buffer data structure, to put the gap at POS.
127 POS is where the loop above stopped, which may be what was specified
128 or may be where a quit was detected. */
129 adjust_markers (pos
+ 1, GPT
, GAP_SIZE
);
138 register unsigned char *to
, *from
;
144 if (unchanged_modified
== MODIFF
)
147 end_unchanged
= Z
- pos
- 1;
151 if (Z
- pos
- 1 < end_unchanged
)
152 end_unchanged
= Z
- pos
- 1;
153 if (GPT
- BEG
< beg_unchanged
)
154 beg_unchanged
= GPT
- BEG
;
162 /* Now copy the characters. To move the gap up,
163 copy characters down. */
167 /* I gets number of characters left to copy. */
171 /* If a quit is requested, stop copying now.
172 Change POS to be where we have actually moved the gap to. */
178 /* Move at most 32000 chars before checking again for a quit. */
183 /* bcopy is safe if the two areas of memory do not overlap
184 or on systems where bcopy is always safe for moving downward. */
185 && (BCOPY_DOWNWARD_SAFE
186 || from
- to
>= 128))
188 /* If overlap is not safe, avoid it by not moving too many
189 characters at once. */
190 if (!BCOPY_DOWNWARD_SAFE
&& i
> from
- to
)
205 adjust_markers (GPT
+ GAP_SIZE
, pos
+ 1 + GAP_SIZE
, - GAP_SIZE
);
210 /* Add `amount' to the position of every marker in the current buffer
211 whose current position is between `from' (exclusive) and `to' (inclusive).
212 Also, any markers past the outside of that interval, in the direction
213 of adjustment, are first moved back to the near end of the interval
214 and then adjusted by `amount'. */
217 adjust_markers (from
, to
, amount
)
218 register int from
, to
, amount
;
221 register struct Lisp_Marker
*m
;
224 marker
= BUF_MARKERS (current_buffer
);
226 while (!NILP (marker
))
228 m
= XMARKER (marker
);
232 if (mpos
> to
&& mpos
< to
+ amount
)
237 if (mpos
> from
+ amount
&& mpos
<= from
)
238 mpos
= from
+ amount
;
240 if (mpos
> from
&& mpos
<= to
)
247 /* Add the specified amount to point. This is used only when the value
248 of point changes due to an insert or delete; it does not represent
249 a conceptual change in point as a marker. In particular, point is
250 not crossing any interval boundaries, so there's no need to use the
251 usual SET_PT macro. In fact it would be incorrect to do so, because
252 either the old or the new value of point is out of synch with the
253 current set of intervals. */
255 adjust_point (amount
)
257 BUF_PT (current_buffer
) += amount
;
260 /* Make the gap INCREMENT characters longer. */
266 unsigned char *result
;
271 /* If we have to get more space, get enough to last a while. */
274 /* Don't allow a buffer size that won't fit in an int
275 even if it will fit in a Lisp integer.
276 That won't work because so many places use `int'. */
278 if (VALBITS
> INTBITS
279 && (Z
- BEG
+ GAP_SIZE
+ increment
) >= ((unsigned) 1 << (INTBITS
- 1)))
280 error ("Buffer too big");
283 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
291 /* We can't unblock until the new address is properly stored. */
295 /* Prevent quitting in move_gap. */
300 old_gap_size
= GAP_SIZE
;
302 /* Call the newly allocated space a gap at the end of the whole space. */
304 GAP_SIZE
= increment
;
306 /* Move the new gap down to be consecutive with the end of the old one.
307 This adjusts the markers properly too. */
308 gap_left (real_gap_loc
+ old_gap_size
, 1);
310 /* Now combine the two into one large gap. */
311 GAP_SIZE
+= old_gap_size
;
317 /* Insert a string of specified length before point.
318 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
319 prepare_to_modify_buffer could relocate the text. */
322 insert (string
, length
)
323 register unsigned char *string
;
328 insert_1 (string
, length
, 0, 1);
329 signal_after_change (PT
-length
, 0, length
);
334 insert_and_inherit (string
, length
)
335 register unsigned char *string
;
340 insert_1 (string
, length
, 1, 1);
341 signal_after_change (PT
-length
, 0, length
);
346 insert_1 (string
, length
, inherit
, prepare
)
347 register unsigned char *string
;
349 int inherit
, prepare
;
351 register Lisp_Object temp
;
353 /* Make sure point-max won't overflow after this insertion. */
354 XSETINT (temp
, length
+ Z
);
355 if (length
+ Z
!= XINT (temp
))
356 error ("maximum buffer size exceeded");
359 prepare_to_modify_buffer (PT
, PT
);
363 if (GAP_SIZE
< length
)
364 make_gap (length
- GAP_SIZE
);
366 record_insert (PT
, length
);
369 bcopy (string
, GPT_ADDR
, length
);
371 #ifdef USE_TEXT_PROPERTIES
372 if (BUF_INTERVALS (current_buffer
) != 0)
373 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
374 offset_intervals (current_buffer
, PT
, length
);
381 adjust_overlays_for_insert (PT
, length
);
382 adjust_point (length
);
384 #ifdef USE_TEXT_PROPERTIES
385 if (!inherit
&& BUF_INTERVALS (current_buffer
) != 0)
386 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
391 /* Insert the part of the text of STRING, a Lisp object assumed to be
392 of type string, consisting of the LENGTH characters starting at
393 position POS. If the text of STRING has properties, they are absorbed
396 It does not work to use `insert' for this, because a GC could happen
397 before we bcopy the stuff into the buffer, and relocate the string
398 without insert noticing. */
401 insert_from_string (string
, pos
, length
, inherit
)
403 register int pos
, length
;
408 insert_from_string_1 (string
, pos
, length
, inherit
);
409 signal_after_change (PT
-length
, 0, length
);
414 insert_from_string_1 (string
, pos
, length
, inherit
)
416 register int pos
, length
;
419 register Lisp_Object temp
;
422 /* Make sure point-max won't overflow after this insertion. */
423 XSETINT (temp
, length
+ Z
);
424 if (length
+ Z
!= XINT (temp
))
425 error ("maximum buffer size exceeded");
428 prepare_to_modify_buffer (PT
, PT
);
432 if (GAP_SIZE
< length
)
433 make_gap (length
- GAP_SIZE
);
435 record_insert (PT
, length
);
439 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
441 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
442 offset_intervals (current_buffer
, PT
, length
);
448 adjust_overlays_for_insert (PT
, length
);
450 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
451 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
452 current_buffer
, inherit
);
454 adjust_point (length
);
457 /* Insert text from BUF, starting at POS and having length LENGTH, into the
458 current buffer. If the text in BUF has properties, they are absorbed
459 into the current buffer.
461 It does not work to use `insert' for this, because a malloc could happen
462 and relocate BUF's text before the bcopy happens. */
465 insert_from_buffer (buf
, pos
, length
, inherit
)
472 insert_from_buffer_1 (buf
, pos
, length
, inherit
);
473 signal_after_change (PT
-length
, 0, length
);
478 insert_from_buffer_1 (buf
, pos
, length
, inherit
)
483 register Lisp_Object temp
;
486 /* Make sure point-max won't overflow after this insertion. */
487 XSETINT (temp
, length
+ Z
);
488 if (length
+ Z
!= XINT (temp
))
489 error ("maximum buffer size exceeded");
491 prepare_to_modify_buffer (PT
, PT
);
495 if (GAP_SIZE
< length
)
496 make_gap (length
- GAP_SIZE
);
498 record_insert (PT
, length
);
501 if (pos
< BUF_GPT (buf
))
503 chunk
= BUF_GPT (buf
) - pos
;
506 bcopy (BUF_CHAR_ADDRESS (buf
, pos
), GPT_ADDR
, chunk
);
511 bcopy (BUF_CHAR_ADDRESS (buf
, pos
+ chunk
),
512 GPT_ADDR
+ chunk
, length
- chunk
);
514 #ifdef USE_TEXT_PROPERTIES
515 if (BUF_INTERVALS (current_buffer
) != 0)
516 offset_intervals (current_buffer
, PT
, length
);
523 adjust_overlays_for_insert (PT
, length
);
524 adjust_point (length
);
526 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
527 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf
),
529 PT
- length
, length
, current_buffer
, inherit
);
532 /* Insert the character C before point */
541 /* Insert the null-terminated string S before point */
547 insert (s
, strlen (s
));
550 /* Like `insert' except that all markers pointing at the place where
551 the insertion happens are adjusted to point after it.
552 Don't use this function to insert part of a Lisp string,
553 since gc could happen and relocate it. */
556 insert_before_markers (string
, length
)
557 unsigned char *string
;
562 register int opoint
= PT
;
563 insert_1 (string
, length
, 0, 1);
564 adjust_markers (opoint
- 1, opoint
, length
);
565 signal_after_change (PT
-length
, 0, length
);
570 insert_before_markers_and_inherit (string
, length
)
571 unsigned char *string
;
576 register int opoint
= PT
;
577 insert_1 (string
, length
, 1, 1);
578 adjust_markers (opoint
- 1, opoint
, length
);
579 signal_after_change (PT
-length
, 0, length
);
583 /* Insert part of a Lisp string, relocating markers after. */
586 insert_from_string_before_markers (string
, pos
, length
, inherit
)
588 register int pos
, length
;
593 register int opoint
= PT
;
594 insert_from_string_1 (string
, pos
, length
, inherit
);
595 adjust_markers (opoint
- 1, opoint
, length
);
596 signal_after_change (PT
-length
, 0, length
);
600 /* Delete characters in current buffer
601 from FROM up to (but not including) TO. */
605 register int from
, to
;
607 del_range_1 (from
, to
, 1);
610 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
613 del_range_1 (from
, to
, prepare
)
614 register int from
, to
, prepare
;
618 /* Make args be valid */
624 if ((numdel
= to
- from
) <= 0)
627 /* Make sure the gap is somewhere in or next to what we are deleting. */
634 prepare_to_modify_buffer (from
, to
);
636 record_delete (from
, numdel
);
639 /* Relocate point as if it were a marker. */
641 adjust_point (from
- (PT
< to
? PT
: to
));
643 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
644 offset_intervals (current_buffer
, from
, - numdel
);
646 /* Relocate all markers pointing into the new, larger gap
647 to point at the end of the text before the gap. */
648 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
650 /* Adjust the overlay center as needed. This must be done after
651 adjusting the markers that bound the overlays. */
652 adjust_overlays_for_delete (from
, numdel
);
659 if (GPT
- BEG
< beg_unchanged
)
660 beg_unchanged
= GPT
- BEG
;
661 if (Z
- GPT
< end_unchanged
)
662 end_unchanged
= Z
- GPT
;
664 evaporate_overlays (from
);
665 signal_after_change (from
, numdel
, 0);
668 /* Call this if you're about to change the region of BUFFER from START
669 to END. This checks the read-only properties of the region, calls
670 the necessary modification hooks, and warns the next redisplay that
671 it should pay attention to that area. */
673 modify_region (buffer
, start
, end
)
674 struct buffer
*buffer
;
677 struct buffer
*old_buffer
= current_buffer
;
679 if (buffer
!= old_buffer
)
680 set_buffer_internal (buffer
);
682 prepare_to_modify_buffer (start
, end
);
684 if (start
- 1 < beg_unchanged
|| unchanged_modified
== MODIFF
)
685 beg_unchanged
= start
- 1;
686 if (Z
- end
< end_unchanged
687 || unchanged_modified
== MODIFF
)
688 end_unchanged
= Z
- end
;
690 if (MODIFF
<= SAVE_MODIFF
)
691 record_first_change ();
694 buffer
->point_before_scroll
= Qnil
;
696 if (buffer
!= old_buffer
)
697 set_buffer_internal (old_buffer
);
700 /* Check that it is okay to modify the buffer between START and END.
701 Run the before-change-function, if any. If intervals are in use,
702 verify that the text to be modified is not read-only, and call
703 any modification properties the text may have. */
706 prepare_to_modify_buffer (start
, end
)
707 Lisp_Object start
, end
;
709 if (!NILP (current_buffer
->read_only
))
710 Fbarf_if_buffer_read_only ();
712 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
713 if (BUF_INTERVALS (current_buffer
) != 0)
714 verify_interval_modification (current_buffer
, start
, end
);
716 #ifdef CLASH_DETECTION
717 if (!NILP (current_buffer
->file_truename
)
718 && SAVE_MODIFF
>= MODIFF
)
719 lock_file (current_buffer
->file_truename
);
721 /* At least warn if this file has changed on disk since it was visited. */
722 if (!NILP (current_buffer
->filename
)
723 && SAVE_MODIFF
>= MODIFF
724 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
725 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
726 call1 (intern ("ask-user-about-supersession-threat"),
727 current_buffer
->filename
);
728 #endif /* not CLASH_DETECTION */
730 signal_before_change (start
, end
);
732 if (current_buffer
->newline_cache
)
733 invalidate_region_cache (current_buffer
,
734 current_buffer
->newline_cache
,
735 start
- BEG
, Z
- end
);
736 if (current_buffer
->width_run_cache
)
737 invalidate_region_cache (current_buffer
,
738 current_buffer
->width_run_cache
,
739 start
- BEG
, Z
- end
);
741 Vdeactivate_mark
= Qt
;
745 before_change_function_restore (value
)
748 Vbefore_change_function
= value
;
752 after_change_function_restore (value
)
755 Vafter_change_function
= value
;
759 before_change_functions_restore (value
)
762 Vbefore_change_functions
= value
;
766 after_change_functions_restore (value
)
769 Vafter_change_functions
= value
;
772 /* Signal a change to the buffer immediately before it happens.
773 START and END are the bounds of the text to be changed,
777 signal_before_change (start
, end
)
778 Lisp_Object start
, end
;
780 /* If buffer is unmodified, run a special hook for that case. */
781 if (SAVE_MODIFF
>= MODIFF
782 && !NILP (Vfirst_change_hook
)
783 && !NILP (Vrun_hooks
))
784 call1 (Vrun_hooks
, Qfirst_change_hook
);
786 /* Now in any case run the before-change-function if any. */
787 if (!NILP (Vbefore_change_function
))
789 int count
= specpdl_ptr
- specpdl
;
790 Lisp_Object function
;
792 function
= Vbefore_change_function
;
794 record_unwind_protect (after_change_function_restore
,
795 Vafter_change_function
);
796 record_unwind_protect (before_change_function_restore
,
797 Vbefore_change_function
);
798 record_unwind_protect (after_change_functions_restore
,
799 Vafter_change_functions
);
800 record_unwind_protect (before_change_functions_restore
,
801 Vbefore_change_functions
);
802 Vafter_change_function
= Qnil
;
803 Vbefore_change_function
= Qnil
;
804 Vafter_change_functions
= Qnil
;
805 Vbefore_change_functions
= Qnil
;
807 call2 (function
, start
, end
);
808 unbind_to (count
, Qnil
);
811 /* Now in any case run the before-change-function if any. */
812 if (!NILP (Vbefore_change_functions
))
814 int count
= specpdl_ptr
- specpdl
;
815 Lisp_Object functions
;
817 functions
= Vbefore_change_functions
;
819 record_unwind_protect (after_change_function_restore
,
820 Vafter_change_function
);
821 record_unwind_protect (before_change_function_restore
,
822 Vbefore_change_function
);
823 record_unwind_protect (after_change_functions_restore
,
824 Vafter_change_functions
);
825 record_unwind_protect (before_change_functions_restore
,
826 Vbefore_change_functions
);
827 Vafter_change_function
= Qnil
;
828 Vbefore_change_function
= Qnil
;
829 Vafter_change_functions
= Qnil
;
830 Vbefore_change_functions
= Qnil
;
832 while (CONSP (functions
))
834 call2 (XCONS (functions
)->car
, start
, end
);
835 functions
= XCONS (functions
)->cdr
;
837 unbind_to (count
, Qnil
);
840 if (!NILP (current_buffer
->overlays_before
)
841 || !NILP (current_buffer
->overlays_after
))
842 report_overlay_modification (start
, end
, 0, start
, end
, Qnil
);
845 /* Signal a change immediately after it happens.
846 POS is the address of the start of the changed text.
847 LENDEL is the number of characters of the text before the change.
848 (Not the whole buffer; just the part that was changed.)
849 LENINS is the number of characters in the changed text.
851 (Hence POS + LENINS - LENDEL is the position after the changed text.) */
854 signal_after_change (pos
, lendel
, lenins
)
855 int pos
, lendel
, lenins
;
857 if (!NILP (Vafter_change_function
))
859 int count
= specpdl_ptr
- specpdl
;
860 Lisp_Object function
;
861 function
= Vafter_change_function
;
863 record_unwind_protect (after_change_function_restore
,
864 Vafter_change_function
);
865 record_unwind_protect (before_change_function_restore
,
866 Vbefore_change_function
);
867 record_unwind_protect (after_change_functions_restore
,
868 Vafter_change_functions
);
869 record_unwind_protect (before_change_functions_restore
,
870 Vbefore_change_functions
);
871 Vafter_change_function
= Qnil
;
872 Vbefore_change_function
= Qnil
;
873 Vafter_change_functions
= Qnil
;
874 Vbefore_change_functions
= Qnil
;
876 call3 (function
, make_number (pos
), make_number (pos
+ lenins
),
877 make_number (lendel
));
878 unbind_to (count
, Qnil
);
880 if (!NILP (Vafter_change_functions
))
882 int count
= specpdl_ptr
- specpdl
;
883 Lisp_Object functions
;
884 functions
= Vafter_change_functions
;
886 record_unwind_protect (after_change_function_restore
,
887 Vafter_change_function
);
888 record_unwind_protect (before_change_function_restore
,
889 Vbefore_change_function
);
890 record_unwind_protect (after_change_functions_restore
,
891 Vafter_change_functions
);
892 record_unwind_protect (before_change_functions_restore
,
893 Vbefore_change_functions
);
894 Vafter_change_function
= Qnil
;
895 Vbefore_change_function
= Qnil
;
896 Vafter_change_functions
= Qnil
;
897 Vbefore_change_functions
= Qnil
;
899 while (CONSP (functions
))
901 call3 (XCONS (functions
)->car
,
902 make_number (pos
), make_number (pos
+ lenins
),
903 make_number (lendel
));
904 functions
= XCONS (functions
)->cdr
;
906 unbind_to (count
, Qnil
);
909 if (!NILP (current_buffer
->overlays_before
)
910 || !NILP (current_buffer
->overlays_after
))
911 report_overlay_modification (make_number (pos
),
912 make_number (pos
+ lenins
- lendel
),
914 make_number (pos
), make_number (pos
+ lenins
),
915 make_number (lendel
));