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 if (buffer
!= old_buffer
)
680 set_buffer_internal (old_buffer
);
683 /* Check that it is okay to modify the buffer between START and END.
684 Run the before-change-function, if any. If intervals are in use,
685 verify that the text to be modified is not read-only, and call
686 any modification properties the text may have. */
689 prepare_to_modify_buffer (start
, end
)
690 Lisp_Object start
, end
;
692 if (!NILP (current_buffer
->read_only
))
693 Fbarf_if_buffer_read_only ();
695 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
696 if (BUF_INTERVALS (current_buffer
) != 0)
697 verify_interval_modification (current_buffer
, start
, end
);
699 #ifdef CLASH_DETECTION
700 if (!NILP (current_buffer
->filename
)
701 && SAVE_MODIFF
>= MODIFF
)
702 lock_file (current_buffer
->filename
);
704 /* At least warn if this file has changed on disk since it was visited. */
705 if (!NILP (current_buffer
->filename
)
706 && SAVE_MODIFF
>= MODIFF
707 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
708 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
709 call1 (intern ("ask-user-about-supersession-threat"),
710 current_buffer
->filename
);
711 #endif /* not CLASH_DETECTION */
713 signal_before_change (start
, end
);
715 if (current_buffer
->newline_cache
)
716 invalidate_region_cache (current_buffer
,
717 current_buffer
->newline_cache
,
718 start
- BEG
, Z
- end
);
719 if (current_buffer
->width_run_cache
)
720 invalidate_region_cache (current_buffer
,
721 current_buffer
->width_run_cache
,
722 start
- BEG
, Z
- end
);
724 Vdeactivate_mark
= Qt
;
728 before_change_function_restore (value
)
731 Vbefore_change_function
= value
;
735 after_change_function_restore (value
)
738 Vafter_change_function
= value
;
742 before_change_functions_restore (value
)
745 Vbefore_change_functions
= value
;
749 after_change_functions_restore (value
)
752 Vafter_change_functions
= value
;
755 /* Signal a change to the buffer immediately before it happens.
756 START and END are the bounds of the text to be changed,
760 signal_before_change (start
, end
)
761 Lisp_Object start
, end
;
763 /* If buffer is unmodified, run a special hook for that case. */
764 if (SAVE_MODIFF
>= MODIFF
765 && !NILP (Vfirst_change_hook
)
766 && !NILP (Vrun_hooks
))
767 call1 (Vrun_hooks
, Qfirst_change_hook
);
769 /* Now in any case run the before-change-function if any. */
770 if (!NILP (Vbefore_change_function
))
772 int count
= specpdl_ptr
- specpdl
;
773 Lisp_Object function
;
775 function
= Vbefore_change_function
;
777 record_unwind_protect (after_change_function_restore
,
778 Vafter_change_function
);
779 record_unwind_protect (before_change_function_restore
,
780 Vbefore_change_function
);
781 record_unwind_protect (after_change_functions_restore
,
782 Vafter_change_functions
);
783 record_unwind_protect (before_change_functions_restore
,
784 Vbefore_change_functions
);
785 Vafter_change_function
= Qnil
;
786 Vbefore_change_function
= Qnil
;
787 Vafter_change_functions
= Qnil
;
788 Vbefore_change_functions
= Qnil
;
790 call2 (function
, start
, end
);
791 unbind_to (count
, Qnil
);
794 /* Now in any case run the before-change-function if any. */
795 if (!NILP (Vbefore_change_functions
))
797 int count
= specpdl_ptr
- specpdl
;
798 Lisp_Object functions
;
800 functions
= Vbefore_change_functions
;
802 record_unwind_protect (after_change_function_restore
,
803 Vafter_change_function
);
804 record_unwind_protect (before_change_function_restore
,
805 Vbefore_change_function
);
806 record_unwind_protect (after_change_functions_restore
,
807 Vafter_change_functions
);
808 record_unwind_protect (before_change_functions_restore
,
809 Vbefore_change_functions
);
810 Vafter_change_function
= Qnil
;
811 Vbefore_change_function
= Qnil
;
812 Vafter_change_functions
= Qnil
;
813 Vbefore_change_functions
= Qnil
;
815 while (CONSP (functions
))
817 call2 (XCONS (functions
)->car
, start
, end
);
818 functions
= XCONS (functions
)->cdr
;
820 unbind_to (count
, Qnil
);
823 if (!NILP (current_buffer
->overlays_before
)
824 || !NILP (current_buffer
->overlays_after
))
825 report_overlay_modification (start
, end
, 0, start
, end
, Qnil
);
828 /* Signal a change immediately after it happens.
829 POS is the address of the start of the changed text.
830 LENDEL is the number of characters of the text before the change.
831 (Not the whole buffer; just the part that was changed.)
832 LENINS is the number of characters in the changed text.
834 (Hence POS + LENINS - LENDEL is the position after the changed text.) */
837 signal_after_change (pos
, lendel
, lenins
)
838 int pos
, lendel
, lenins
;
840 if (!NILP (Vafter_change_function
))
842 int count
= specpdl_ptr
- specpdl
;
843 Lisp_Object function
;
844 function
= Vafter_change_function
;
846 record_unwind_protect (after_change_function_restore
,
847 Vafter_change_function
);
848 record_unwind_protect (before_change_function_restore
,
849 Vbefore_change_function
);
850 record_unwind_protect (after_change_functions_restore
,
851 Vafter_change_functions
);
852 record_unwind_protect (before_change_functions_restore
,
853 Vbefore_change_functions
);
854 Vafter_change_function
= Qnil
;
855 Vbefore_change_function
= Qnil
;
856 Vafter_change_functions
= Qnil
;
857 Vbefore_change_functions
= Qnil
;
859 call3 (function
, make_number (pos
), make_number (pos
+ lenins
),
860 make_number (lendel
));
861 unbind_to (count
, Qnil
);
863 if (!NILP (Vafter_change_functions
))
865 int count
= specpdl_ptr
- specpdl
;
866 Lisp_Object functions
;
867 functions
= Vafter_change_functions
;
869 record_unwind_protect (after_change_function_restore
,
870 Vafter_change_function
);
871 record_unwind_protect (before_change_function_restore
,
872 Vbefore_change_function
);
873 record_unwind_protect (after_change_functions_restore
,
874 Vafter_change_functions
);
875 record_unwind_protect (before_change_functions_restore
,
876 Vbefore_change_functions
);
877 Vafter_change_function
= Qnil
;
878 Vbefore_change_function
= Qnil
;
879 Vafter_change_functions
= Qnil
;
880 Vbefore_change_functions
= Qnil
;
882 while (CONSP (functions
))
884 call3 (XCONS (functions
)->car
,
885 make_number (pos
), make_number (pos
+ lenins
),
886 make_number (lendel
));
887 functions
= XCONS (functions
)->cdr
;
889 unbind_to (count
, Qnil
);
892 if (!NILP (current_buffer
->overlays_before
)
893 || !NILP (current_buffer
->overlays_after
))
894 report_overlay_modification (make_number (pos
),
895 make_number (pos
+ lenins
- lendel
),
897 make_number (pos
), make_number (pos
+ lenins
),
898 make_number (lendel
));