1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 1986, 1993, 1994 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. */
275 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
283 /* We can't unblock until the new address is properly stored. */
287 /* Prevent quitting in move_gap. */
292 old_gap_size
= GAP_SIZE
;
294 /* Call the newly allocated space a gap at the end of the whole space. */
296 GAP_SIZE
= increment
;
298 /* Move the new gap down to be consecutive with the end of the old one.
299 This adjusts the markers properly too. */
300 gap_left (real_gap_loc
+ old_gap_size
, 1);
302 /* Now combine the two into one large gap. */
303 GAP_SIZE
+= old_gap_size
;
309 /* Insert a string of specified length before point.
310 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
311 prepare_to_modify_buffer could relocate the text. */
314 insert (string
, length
)
315 register unsigned char *string
;
320 insert_1 (string
, length
, 0, 1);
321 signal_after_change (PT
-length
, 0, length
);
326 insert_and_inherit (string
, length
)
327 register unsigned char *string
;
332 insert_1 (string
, length
, 1, 1);
333 signal_after_change (PT
-length
, 0, length
);
338 insert_1 (string
, length
, inherit
, prepare
)
339 register unsigned char *string
;
341 int inherit
, prepare
;
343 register Lisp_Object temp
;
345 /* Make sure point-max won't overflow after this insertion. */
346 XSETINT (temp
, length
+ Z
);
347 if (length
+ Z
!= XINT (temp
))
348 error ("maximum buffer size exceeded");
351 prepare_to_modify_buffer (PT
, PT
);
355 if (GAP_SIZE
< length
)
356 make_gap (length
- GAP_SIZE
);
358 record_insert (PT
, length
);
361 bcopy (string
, GPT_ADDR
, length
);
363 #ifdef USE_TEXT_PROPERTIES
364 if (BUF_INTERVALS (current_buffer
) != 0)
365 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
366 offset_intervals (current_buffer
, PT
, length
);
373 adjust_point (length
);
375 #ifdef USE_TEXT_PROPERTIES
376 if (!inherit
&& BUF_INTERVALS (current_buffer
) != 0)
377 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
382 /* Insert the part of the text of STRING, a Lisp object assumed to be
383 of type string, consisting of the LENGTH characters starting at
384 position POS. If the text of STRING has properties, they are absorbed
387 It does not work to use `insert' for this, because a GC could happen
388 before we bcopy the stuff into the buffer, and relocate the string
389 without insert noticing. */
392 insert_from_string (string
, pos
, length
, inherit
)
394 register int pos
, length
;
399 insert_from_string_1 (string
, pos
, length
, inherit
);
400 signal_after_change (PT
-length
, 0, length
);
405 insert_from_string_1 (string
, pos
, length
, inherit
)
407 register int pos
, length
;
410 register Lisp_Object temp
;
413 /* Make sure point-max won't overflow after this insertion. */
414 XSETINT (temp
, length
+ Z
);
415 if (length
+ Z
!= XINT (temp
))
416 error ("maximum buffer size exceeded");
419 prepare_to_modify_buffer (PT
, PT
);
423 if (GAP_SIZE
< length
)
424 make_gap (length
- GAP_SIZE
);
426 record_insert (PT
, length
);
430 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
432 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
433 offset_intervals (current_buffer
, PT
, length
);
440 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
441 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
442 current_buffer
, inherit
);
444 adjust_point (length
);
447 /* Insert text from BUF, starting at POS and having length LENGTH, into the
448 current buffer. If the text in BUF has properties, they are absorbed
449 into the current buffer.
451 It does not work to use `insert' for this, because a malloc could happen
452 and relocate BUF's text before the bcopy happens. */
455 insert_from_buffer (buf
, pos
, length
, inherit
)
462 insert_from_buffer_1 (buf
, pos
, length
, inherit
);
463 signal_after_change (PT
-length
, 0, length
);
468 insert_from_buffer_1 (buf
, pos
, length
, inherit
)
473 register Lisp_Object temp
;
476 /* Make sure point-max won't overflow after this insertion. */
477 XSETINT (temp
, length
+ Z
);
478 if (length
+ Z
!= XINT (temp
))
479 error ("maximum buffer size exceeded");
481 prepare_to_modify_buffer (PT
, PT
);
485 if (GAP_SIZE
< length
)
486 make_gap (length
- GAP_SIZE
);
488 record_insert (PT
, length
);
491 if (pos
< BUF_GPT (buf
))
493 chunk
= BUF_GPT (buf
) - pos
;
496 bcopy (BUF_CHAR_ADDRESS (buf
, pos
), GPT_ADDR
, chunk
);
501 bcopy (BUF_CHAR_ADDRESS (buf
, pos
+ chunk
),
502 GPT_ADDR
+ chunk
, length
- chunk
);
504 #ifdef USE_TEXT_PROPERTIES
505 if (BUF_INTERVALS (current_buffer
) != 0)
506 offset_intervals (current_buffer
, PT
, length
);
513 adjust_point (length
);
515 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
516 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf
),
518 PT
- length
, length
, current_buffer
, inherit
);
521 /* Insert the character C before point */
530 /* Insert the null-terminated string S before point */
536 insert (s
, strlen (s
));
539 /* Like `insert' except that all markers pointing at the place where
540 the insertion happens are adjusted to point after it.
541 Don't use this function to insert part of a Lisp string,
542 since gc could happen and relocate it. */
545 insert_before_markers (string
, length
)
546 unsigned char *string
;
551 register int opoint
= PT
;
552 insert_1 (string
, length
, 0, 1);
553 adjust_markers (opoint
- 1, opoint
, length
);
554 signal_after_change (PT
-length
, 0, length
);
559 insert_before_markers_and_inherit (string
, length
)
560 unsigned char *string
;
565 register int opoint
= PT
;
566 insert_1 (string
, length
, 1, 1);
567 adjust_markers (opoint
- 1, opoint
, length
);
568 signal_after_change (PT
-length
, 0, length
);
572 /* Insert part of a Lisp string, relocating markers after. */
575 insert_from_string_before_markers (string
, pos
, length
, inherit
)
577 register int pos
, length
;
582 register int opoint
= PT
;
583 insert_from_string_1 (string
, pos
, length
, inherit
);
584 adjust_markers (opoint
- 1, opoint
, length
);
585 signal_after_change (PT
-length
, 0, length
);
589 /* Delete characters in current buffer
590 from FROM up to (but not including) TO. */
594 register int from
, to
;
596 del_range_1 (from
, to
, 1);
599 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
602 del_range_1 (from
, to
, prepare
)
603 register int from
, to
, prepare
;
607 /* Make args be valid */
613 if ((numdel
= to
- from
) <= 0)
616 /* Make sure the gap is somewhere in or next to what we are deleting. */
623 prepare_to_modify_buffer (from
, to
);
625 record_delete (from
, numdel
);
628 /* Relocate point as if it were a marker. */
630 adjust_point (from
- (PT
< to
? PT
: to
));
632 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
633 offset_intervals (current_buffer
, from
, - numdel
);
635 /* Relocate all markers pointing into the new, larger gap
636 to point at the end of the text before the gap. */
637 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
644 if (GPT
- BEG
< beg_unchanged
)
645 beg_unchanged
= GPT
- BEG
;
646 if (Z
- GPT
< end_unchanged
)
647 end_unchanged
= Z
- GPT
;
649 evaporate_overlays (from
);
650 signal_after_change (from
, numdel
, 0);
653 /* Call this if you're about to change the region of BUFFER from START
654 to END. This checks the read-only properties of the region, calls
655 the necessary modification hooks, and warns the next redisplay that
656 it should pay attention to that area. */
658 modify_region (buffer
, start
, end
)
659 struct buffer
*buffer
;
662 struct buffer
*old_buffer
= current_buffer
;
664 if (buffer
!= old_buffer
)
665 set_buffer_internal (buffer
);
667 prepare_to_modify_buffer (start
, end
);
669 if (start
- 1 < beg_unchanged
|| unchanged_modified
== MODIFF
)
670 beg_unchanged
= start
- 1;
671 if (Z
- end
< end_unchanged
672 || unchanged_modified
== MODIFF
)
673 end_unchanged
= Z
- end
;
675 if (MODIFF
<= SAVE_MODIFF
)
676 record_first_change ();
679 buffer
->point_before_scroll
= Qnil
;
681 if (buffer
!= old_buffer
)
682 set_buffer_internal (old_buffer
);
685 /* Check that it is okay to modify the buffer between START and END.
686 Run the before-change-function, if any. If intervals are in use,
687 verify that the text to be modified is not read-only, and call
688 any modification properties the text may have. */
691 prepare_to_modify_buffer (start
, end
)
692 Lisp_Object start
, end
;
694 if (!NILP (current_buffer
->read_only
))
695 Fbarf_if_buffer_read_only ();
697 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
698 if (BUF_INTERVALS (current_buffer
) != 0)
699 verify_interval_modification (current_buffer
, start
, end
);
701 #ifdef CLASH_DETECTION
702 if (!NILP (current_buffer
->filename
)
703 && SAVE_MODIFF
>= MODIFF
)
704 lock_file (current_buffer
->filename
);
706 /* At least warn if this file has changed on disk since it was visited. */
707 if (!NILP (current_buffer
->filename
)
708 && SAVE_MODIFF
>= MODIFF
709 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
710 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
711 call1 (intern ("ask-user-about-supersession-threat"),
712 current_buffer
->filename
);
713 #endif /* not CLASH_DETECTION */
715 signal_before_change (start
, end
);
717 if (current_buffer
->newline_cache
)
718 invalidate_region_cache (current_buffer
,
719 current_buffer
->newline_cache
,
720 start
- BEG
, Z
- end
);
721 if (current_buffer
->width_run_cache
)
722 invalidate_region_cache (current_buffer
,
723 current_buffer
->width_run_cache
,
724 start
- BEG
, Z
- end
);
726 Vdeactivate_mark
= Qt
;
730 before_change_function_restore (value
)
733 Vbefore_change_function
= value
;
737 after_change_function_restore (value
)
740 Vafter_change_function
= value
;
744 before_change_functions_restore (value
)
747 Vbefore_change_functions
= value
;
751 after_change_functions_restore (value
)
754 Vafter_change_functions
= value
;
757 /* Signal a change to the buffer immediately before it happens.
758 START and END are the bounds of the text to be changed,
762 signal_before_change (start
, end
)
763 Lisp_Object start
, end
;
765 /* If buffer is unmodified, run a special hook for that case. */
766 if (SAVE_MODIFF
>= MODIFF
767 && !NILP (Vfirst_change_hook
)
768 && !NILP (Vrun_hooks
))
769 call1 (Vrun_hooks
, Qfirst_change_hook
);
771 /* Now in any case run the before-change-function if any. */
772 if (!NILP (Vbefore_change_function
))
774 int count
= specpdl_ptr
- specpdl
;
775 Lisp_Object function
;
777 function
= Vbefore_change_function
;
779 record_unwind_protect (after_change_function_restore
,
780 Vafter_change_function
);
781 record_unwind_protect (before_change_function_restore
,
782 Vbefore_change_function
);
783 record_unwind_protect (after_change_functions_restore
,
784 Vafter_change_functions
);
785 record_unwind_protect (before_change_functions_restore
,
786 Vbefore_change_functions
);
787 Vafter_change_function
= Qnil
;
788 Vbefore_change_function
= Qnil
;
789 Vafter_change_functions
= Qnil
;
790 Vbefore_change_functions
= Qnil
;
792 call2 (function
, start
, end
);
793 unbind_to (count
, Qnil
);
796 /* Now in any case run the before-change-function if any. */
797 if (!NILP (Vbefore_change_functions
))
799 int count
= specpdl_ptr
- specpdl
;
800 Lisp_Object functions
;
802 functions
= Vbefore_change_functions
;
804 record_unwind_protect (after_change_function_restore
,
805 Vafter_change_function
);
806 record_unwind_protect (before_change_function_restore
,
807 Vbefore_change_function
);
808 record_unwind_protect (after_change_functions_restore
,
809 Vafter_change_functions
);
810 record_unwind_protect (before_change_functions_restore
,
811 Vbefore_change_functions
);
812 Vafter_change_function
= Qnil
;
813 Vbefore_change_function
= Qnil
;
814 Vafter_change_functions
= Qnil
;
815 Vbefore_change_functions
= Qnil
;
817 while (CONSP (functions
))
819 call2 (XCONS (functions
)->car
, start
, end
);
820 functions
= XCONS (functions
)->cdr
;
822 unbind_to (count
, Qnil
);
825 if (!NILP (current_buffer
->overlays_before
)
826 || !NILP (current_buffer
->overlays_after
))
827 report_overlay_modification (start
, end
, 0, start
, end
, Qnil
);
830 /* Signal a change immediately after it happens.
831 POS is the address of the start of the changed text.
832 LENDEL is the number of characters of the text before the change.
833 (Not the whole buffer; just the part that was changed.)
834 LENINS is the number of characters in the changed text.
836 (Hence POS + LENINS - LENDEL is the position after the changed text.) */
839 signal_after_change (pos
, lendel
, lenins
)
840 int pos
, lendel
, lenins
;
842 if (!NILP (Vafter_change_function
))
844 int count
= specpdl_ptr
- specpdl
;
845 Lisp_Object function
;
846 function
= Vafter_change_function
;
848 record_unwind_protect (after_change_function_restore
,
849 Vafter_change_function
);
850 record_unwind_protect (before_change_function_restore
,
851 Vbefore_change_function
);
852 record_unwind_protect (after_change_functions_restore
,
853 Vafter_change_functions
);
854 record_unwind_protect (before_change_functions_restore
,
855 Vbefore_change_functions
);
856 Vafter_change_function
= Qnil
;
857 Vbefore_change_function
= Qnil
;
858 Vafter_change_functions
= Qnil
;
859 Vbefore_change_functions
= Qnil
;
861 call3 (function
, make_number (pos
), make_number (pos
+ lenins
),
862 make_number (lendel
));
863 unbind_to (count
, Qnil
);
865 if (!NILP (Vafter_change_functions
))
867 int count
= specpdl_ptr
- specpdl
;
868 Lisp_Object functions
;
869 functions
= Vafter_change_functions
;
871 record_unwind_protect (after_change_function_restore
,
872 Vafter_change_function
);
873 record_unwind_protect (before_change_function_restore
,
874 Vbefore_change_function
);
875 record_unwind_protect (after_change_functions_restore
,
876 Vafter_change_functions
);
877 record_unwind_protect (before_change_functions_restore
,
878 Vbefore_change_functions
);
879 Vafter_change_function
= Qnil
;
880 Vbefore_change_function
= Qnil
;
881 Vafter_change_functions
= Qnil
;
882 Vbefore_change_functions
= Qnil
;
884 while (CONSP (functions
))
886 call3 (XCONS (functions
)->car
,
887 make_number (pos
), make_number (pos
+ lenins
),
888 make_number (lendel
));
889 functions
= XCONS (functions
)->cdr
;
891 unbind_to (count
, Qnil
);
894 if (!NILP (current_buffer
->overlays_before
)
895 || !NILP (current_buffer
->overlays_after
))
896 report_overlay_modification (make_number (pos
),
897 make_number (pos
+ lenins
- lendel
),
899 make_number (pos
), make_number (pos
+ lenins
),
900 make_number (lendel
));