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_1 ();
29 static void insert_from_string_1 ();
30 static void insert_from_buffer_1 ();
31 static void gap_left ();
32 static void gap_right ();
33 static void adjust_markers ();
34 static void adjust_point ();
36 /* Move gap to position `pos'.
37 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
= current_buffer
->markers
;
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 current_buffer
->text
.pt
+= amount
;
260 /* Make the gap INCREMENT characters longer. */
265 unsigned char *result
;
270 /* If we have to get more space, get enough to last a while. */
274 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
282 /* We can't unblock until the new address is properly stored. */
286 /* Prevent quitting in move_gap. */
291 old_gap_size
= GAP_SIZE
;
293 /* Call the newly allocated space a gap at the end of the whole space. */
295 GAP_SIZE
= increment
;
297 /* Move the new gap down to be consecutive with the end of the old one.
298 This adjusts the markers properly too. */
299 gap_left (real_gap_loc
+ old_gap_size
, 1);
301 /* Now combine the two into one large gap. */
302 GAP_SIZE
+= old_gap_size
;
308 /* Insert a string of specified length before point.
309 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
310 prepare_to_modify_buffer could relocate the text. */
312 insert (string
, length
)
313 register unsigned char *string
;
318 insert_1 (string
, length
, 0);
319 signal_after_change (PT
-length
, 0, length
);
323 insert_and_inherit (string
, length
)
324 register unsigned char *string
;
329 insert_1 (string
, length
, 1);
330 signal_after_change (PT
-length
, 0, length
);
335 insert_1 (string
, length
, inherit
)
336 register unsigned char *string
;
340 register Lisp_Object temp
;
342 /* Make sure point-max won't overflow after this insertion. */
343 XSETINT (temp
, length
+ Z
);
344 if (length
+ Z
!= XINT (temp
))
345 error ("maximum buffer size exceeded");
347 prepare_to_modify_buffer (PT
, PT
);
351 if (GAP_SIZE
< length
)
352 make_gap (length
- GAP_SIZE
);
354 record_insert (PT
, length
);
357 bcopy (string
, GPT_ADDR
, length
);
359 #ifdef USE_TEXT_PROPERTIES
360 if (current_buffer
->intervals
!= 0)
361 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
362 offset_intervals (current_buffer
, PT
, length
);
369 adjust_point (length
);
371 #ifdef USE_TEXT_PROPERTIES
372 if (!inherit
&& current_buffer
->intervals
!= 0)
373 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
378 /* Insert the part of the text of STRING, a Lisp object assumed to be
379 of type string, consisting of the LENGTH characters starting at
380 position POS. If the text of STRING has properties, they are absorbed
383 It does not work to use `insert' for this, because a GC could happen
384 before we bcopy the stuff into the buffer, and relocate the string
385 without insert noticing. */
387 insert_from_string (string
, pos
, length
, inherit
)
389 register int pos
, length
;
394 insert_from_string_1 (string
, pos
, length
, inherit
);
395 signal_after_change (PT
-length
, 0, length
);
400 insert_from_string_1 (string
, pos
, length
, inherit
)
402 register int pos
, length
;
405 register Lisp_Object temp
;
408 /* Make sure point-max won't overflow after this insertion. */
409 XSETINT (temp
, length
+ Z
);
410 if (length
+ Z
!= XINT (temp
))
411 error ("maximum buffer size exceeded");
414 prepare_to_modify_buffer (PT
, PT
);
418 if (GAP_SIZE
< length
)
419 make_gap (length
- GAP_SIZE
);
421 record_insert (PT
, length
);
425 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
427 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
428 offset_intervals (current_buffer
, PT
, length
);
435 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
436 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
437 current_buffer
, inherit
);
439 adjust_point (length
);
442 /* Insert text from BUF, starting at POS and having length LENGTH, into the
443 current buffer. If the text in BUF has properties, they are absorbed
444 into the current buffer.
446 It does not work to use `insert' for this, because a malloc could happen
447 and relocate BUF's text before the bcopy happens. */
450 insert_from_buffer (buf
, pos
, length
, inherit
)
457 insert_from_buffer_1 (buf
, pos
, length
, inherit
);
458 signal_after_change (PT
-length
, 0, length
);
463 insert_from_buffer_1 (buf
, pos
, length
, inherit
)
468 register Lisp_Object temp
;
471 /* Make sure point-max won't overflow after this insertion. */
472 XSETINT (temp
, length
+ Z
);
473 if (length
+ Z
!= XINT (temp
))
474 error ("maximum buffer size exceeded");
476 prepare_to_modify_buffer (PT
, PT
);
480 if (GAP_SIZE
< length
)
481 make_gap (length
- GAP_SIZE
);
483 record_insert (PT
, length
);
486 if (pos
< BUF_GPT (buf
))
488 chunk
= BUF_GPT (buf
) - pos
;
491 bcopy (BUF_CHAR_ADDRESS (buf
, pos
), GPT_ADDR
, chunk
);
496 bcopy (BUF_CHAR_ADDRESS (buf
, pos
+ chunk
),
497 GPT_ADDR
+ chunk
, length
- chunk
);
499 #ifdef USE_TEXT_PROPERTIES
500 if (current_buffer
->intervals
!= 0)
501 offset_intervals (current_buffer
, PT
, length
);
508 adjust_point (length
);
510 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
511 graft_intervals_into_buffer (copy_intervals (buf
->intervals
, pos
, length
),
512 PT
- length
, length
, current_buffer
, inherit
);
515 /* Insert the character C before point */
524 /* Insert the null-terminated string S before point */
530 insert (s
, strlen (s
));
533 /* Like `insert' except that all markers pointing at the place where
534 the insertion happens are adjusted to point after it.
535 Don't use this function to insert part of a Lisp string,
536 since gc could happen and relocate it. */
538 insert_before_markers (string
, length
)
539 unsigned char *string
;
544 register int opoint
= PT
;
545 insert_1 (string
, length
, 0);
546 adjust_markers (opoint
- 1, opoint
, length
);
547 signal_after_change (PT
-length
, 0, length
);
551 insert_before_markers_and_inherit (string
, length
)
552 unsigned char *string
;
557 register int opoint
= PT
;
558 insert_1 (string
, length
, 1);
559 adjust_markers (opoint
- 1, opoint
, length
);
560 signal_after_change (PT
-length
, 0, length
);
564 /* Insert part of a Lisp string, relocating markers after. */
566 insert_from_string_before_markers (string
, pos
, length
, inherit
)
568 register int pos
, length
;
573 register int opoint
= PT
;
574 insert_from_string_1 (string
, pos
, length
, inherit
);
575 adjust_markers (opoint
- 1, opoint
, length
);
576 signal_after_change (PT
-length
, 0, length
);
580 /* Delete characters in current buffer
581 from FROM up to (but not including) TO. */
584 register int from
, to
;
586 return del_range_1 (from
, to
, 1);
589 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
591 del_range_1 (from
, to
, prepare
)
592 register int from
, to
, prepare
;
596 /* Make args be valid */
602 if ((numdel
= to
- from
) <= 0)
605 /* Make sure the gap is somewhere in or next to what we are deleting. */
612 prepare_to_modify_buffer (from
, to
);
614 record_delete (from
, numdel
);
617 /* Relocate point as if it were a marker. */
619 adjust_point (from
- (PT
< to
? PT
: to
));
621 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
622 offset_intervals (current_buffer
, from
, - numdel
);
624 /* Relocate all markers pointing into the new, larger gap
625 to point at the end of the text before the gap. */
626 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
633 if (GPT
- BEG
< beg_unchanged
)
634 beg_unchanged
= GPT
- BEG
;
635 if (Z
- GPT
< end_unchanged
)
636 end_unchanged
= Z
- GPT
;
638 evaporate_overlays (from
);
639 signal_after_change (from
, numdel
, 0);
642 /* Call this if you're about to change the region of BUFFER from START
643 to END. This checks the read-only properties of the region, calls
644 the necessary modification hooks, and warns the next redisplay that
645 it should pay attention to that area. */
646 modify_region (buffer
, start
, end
)
647 struct buffer
*buffer
;
650 struct buffer
*old_buffer
= current_buffer
;
652 if (buffer
!= old_buffer
)
653 set_buffer_internal (buffer
);
655 prepare_to_modify_buffer (start
, end
);
657 if (start
- 1 < beg_unchanged
|| unchanged_modified
== MODIFF
)
658 beg_unchanged
= start
- 1;
659 if (Z
- end
< end_unchanged
660 || unchanged_modified
== MODIFF
)
661 end_unchanged
= Z
- end
;
663 if (MODIFF
<= current_buffer
->save_modified
)
664 record_first_change ();
667 if (buffer
!= old_buffer
)
668 set_buffer_internal (old_buffer
);
671 /* Check that it is okay to modify the buffer between START and END.
672 Run the before-change-function, if any. If intervals are in use,
673 verify that the text to be modified is not read-only, and call
674 any modification properties the text may have. */
676 prepare_to_modify_buffer (start
, end
)
677 Lisp_Object start
, end
;
679 if (!NILP (current_buffer
->read_only
))
680 Fbarf_if_buffer_read_only ();
682 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
683 if (current_buffer
->intervals
!= 0)
684 verify_interval_modification (current_buffer
, start
, end
);
686 if (!NILP (current_buffer
->overlays_before
)
687 || !NILP (current_buffer
->overlays_after
))
688 verify_overlay_modification (start
, end
);
690 #ifdef CLASH_DETECTION
691 if (!NILP (current_buffer
->filename
)
692 && current_buffer
->save_modified
>= MODIFF
)
693 lock_file (current_buffer
->filename
);
695 /* At least warn if this file has changed on disk since it was visited. */
696 if (!NILP (current_buffer
->filename
)
697 && current_buffer
->save_modified
>= MODIFF
698 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
699 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
700 call1 (intern ("ask-user-about-supersession-threat"),
701 current_buffer
->filename
);
702 #endif /* not CLASH_DETECTION */
704 signal_before_change (start
, end
);
706 if (current_buffer
->newline_cache
)
707 invalidate_region_cache (current_buffer
,
708 current_buffer
->newline_cache
,
709 start
- BEG
, Z
- end
);
710 if (current_buffer
->width_run_cache
)
711 invalidate_region_cache (current_buffer
,
712 current_buffer
->width_run_cache
,
713 start
- BEG
, Z
- end
);
715 Vdeactivate_mark
= Qt
;
719 before_change_function_restore (value
)
722 Vbefore_change_function
= value
;
726 after_change_function_restore (value
)
729 Vafter_change_function
= value
;
733 before_change_functions_restore (value
)
736 Vbefore_change_functions
= value
;
740 after_change_functions_restore (value
)
743 Vafter_change_functions
= value
;
746 /* Signal a change to the buffer immediately before it happens.
747 START and END are the bounds of the text to be changed,
750 signal_before_change (start
, end
)
751 Lisp_Object start
, end
;
753 /* If buffer is unmodified, run a special hook for that case. */
754 if (current_buffer
->save_modified
>= MODIFF
755 && !NILP (Vfirst_change_hook
)
756 && !NILP (Vrun_hooks
))
757 call1 (Vrun_hooks
, Qfirst_change_hook
);
759 /* Now in any case run the before-change-function if any. */
760 if (!NILP (Vbefore_change_function
))
762 int count
= specpdl_ptr
- specpdl
;
763 Lisp_Object function
;
765 function
= Vbefore_change_function
;
767 record_unwind_protect (after_change_function_restore
,
768 Vafter_change_function
);
769 record_unwind_protect (before_change_function_restore
,
770 Vbefore_change_function
);
771 record_unwind_protect (after_change_functions_restore
,
772 Vafter_change_functions
);
773 record_unwind_protect (before_change_functions_restore
,
774 Vbefore_change_functions
);
775 Vafter_change_function
= Qnil
;
776 Vbefore_change_function
= Qnil
;
777 Vafter_change_functions
= Qnil
;
778 Vbefore_change_functions
= Qnil
;
780 call2 (function
, start
, end
);
781 unbind_to (count
, Qnil
);
784 /* Now in any case run the before-change-function if any. */
785 if (!NILP (Vbefore_change_functions
))
787 int count
= specpdl_ptr
- specpdl
;
788 Lisp_Object functions
;
790 functions
= Vbefore_change_functions
;
792 record_unwind_protect (after_change_function_restore
,
793 Vafter_change_function
);
794 record_unwind_protect (before_change_function_restore
,
795 Vbefore_change_function
);
796 record_unwind_protect (after_change_functions_restore
,
797 Vafter_change_functions
);
798 record_unwind_protect (before_change_functions_restore
,
799 Vbefore_change_functions
);
800 Vafter_change_function
= Qnil
;
801 Vbefore_change_function
= Qnil
;
802 Vafter_change_functions
= Qnil
;
803 Vbefore_change_functions
= Qnil
;
805 while (CONSP (functions
))
807 call2 (XCONS (functions
)->car
, start
, end
);
808 functions
= XCONS (functions
)->cdr
;
810 unbind_to (count
, Qnil
);
814 /* Signal a change immediately after it happens.
815 POS is the address of the start of the changed text.
816 LENDEL is the number of characters of the text before the change.
817 (Not the whole buffer; just the part that was changed.)
818 LENINS is the number of characters in the changed text. */
820 signal_after_change (pos
, lendel
, lenins
)
821 int pos
, lendel
, lenins
;
823 if (!NILP (Vafter_change_function
))
825 int count
= specpdl_ptr
- specpdl
;
826 Lisp_Object function
;
827 function
= Vafter_change_function
;
829 record_unwind_protect (after_change_function_restore
,
830 Vafter_change_function
);
831 record_unwind_protect (before_change_function_restore
,
832 Vbefore_change_function
);
833 record_unwind_protect (after_change_functions_restore
,
834 Vafter_change_functions
);
835 record_unwind_protect (before_change_functions_restore
,
836 Vbefore_change_functions
);
837 Vafter_change_function
= Qnil
;
838 Vbefore_change_function
= Qnil
;
839 Vafter_change_functions
= Qnil
;
840 Vbefore_change_functions
= Qnil
;
842 call3 (function
, make_number (pos
), make_number (pos
+ lenins
),
843 make_number (lendel
));
844 unbind_to (count
, Qnil
);
846 if (!NILP (Vafter_change_functions
))
848 int count
= specpdl_ptr
- specpdl
;
849 Lisp_Object functions
;
850 functions
= Vafter_change_functions
;
852 record_unwind_protect (after_change_function_restore
,
853 Vafter_change_function
);
854 record_unwind_protect (before_change_function_restore
,
855 Vbefore_change_function
);
856 record_unwind_protect (after_change_functions_restore
,
857 Vafter_change_functions
);
858 record_unwind_protect (before_change_functions_restore
,
859 Vbefore_change_functions
);
860 Vafter_change_function
= Qnil
;
861 Vbefore_change_function
= Qnil
;
862 Vafter_change_functions
= Qnil
;
863 Vbefore_change_functions
= Qnil
;
865 while (CONSP (functions
))
867 call3 (XCONS (functions
)->car
,
868 make_number (pos
), make_number (pos
+ lenins
),
869 make_number (lendel
));
870 functions
= XCONS (functions
)->cdr
;
872 unbind_to (count
, Qnil
);