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 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"
27 #include "blockinput.h"
29 #define min(x, y) ((x) < (y) ? (x) : (y))
31 static void insert_from_string_1 ();
32 static void insert_from_buffer_1 ();
33 static void gap_left ();
34 static void gap_right ();
35 static void adjust_markers ();
36 static void adjust_point ();
38 /* Move gap to position `pos'.
39 Note that this can quit! */
51 /* Move the gap to POS, which is less than the current GPT.
52 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
55 gap_left (pos
, newgap
)
59 register unsigned char *to
, *from
;
67 if (unchanged_modified
== MODIFF
68 && overlay_unchanged_modified
== OVERLAY_MODIFF
)
71 end_unchanged
= Z
- pos
- 1;
75 if (Z
- GPT
< end_unchanged
)
76 end_unchanged
= Z
- GPT
;
77 if (pos
< beg_unchanged
)
87 /* Now copy the characters. To move the gap down,
88 copy characters up. */
92 /* I gets number of characters left to copy. */
96 /* If a quit is requested, stop copying now.
97 Change POS to be where we have actually moved the gap to. */
103 /* Move at most 32000 chars before checking again for a quit. */
108 /* bcopy is safe if the two areas of memory do not overlap
109 or on systems where bcopy is always safe for moving upward. */
110 && (BCOPY_UPWARD_SAFE
111 || to
- from
>= 128))
113 /* If overlap is not safe, avoid it by not moving too many
114 characters at once. */
115 if (!BCOPY_UPWARD_SAFE
&& i
> to
- from
)
130 /* Adjust markers, and buffer data structure, to put the gap at POS.
131 POS is where the loop above stopped, which may be what was specified
132 or may be where a quit was detected. */
133 adjust_markers (pos
+ 1, GPT
, GAP_SIZE
);
142 register unsigned char *to
, *from
;
148 if (unchanged_modified
== MODIFF
149 && overlay_unchanged_modified
== OVERLAY_MODIFF
)
153 end_unchanged
= Z
- pos
- 1;
157 if (Z
- pos
- 1 < end_unchanged
)
158 end_unchanged
= Z
- pos
- 1;
159 if (GPT
- BEG
< beg_unchanged
)
160 beg_unchanged
= GPT
- BEG
;
168 /* Now copy the characters. To move the gap up,
169 copy characters down. */
173 /* I gets number of characters left to copy. */
177 /* If a quit is requested, stop copying now.
178 Change POS to be where we have actually moved the gap to. */
184 /* Move at most 32000 chars before checking again for a quit. */
189 /* bcopy is safe if the two areas of memory do not overlap
190 or on systems where bcopy is always safe for moving downward. */
191 && (BCOPY_DOWNWARD_SAFE
192 || from
- to
>= 128))
194 /* If overlap is not safe, avoid it by not moving too many
195 characters at once. */
196 if (!BCOPY_DOWNWARD_SAFE
&& i
> from
- to
)
211 adjust_markers (GPT
+ GAP_SIZE
, pos
+ 1 + GAP_SIZE
, - GAP_SIZE
);
216 /* Add AMOUNT to the position of every marker in the current buffer
217 whose current position is between FROM (exclusive) and TO (inclusive).
219 Also, any markers past the outside of that interval, in the direction
220 of adjustment, are first moved back to the near end of the interval
221 and then adjusted by AMOUNT.
223 When the latter adjustment is done, if AMOUNT is negative,
224 we record the adjustment for undo. (This case happens only for
228 adjust_markers (from
, to
, amount
)
229 register int from
, to
, amount
;
232 register struct Lisp_Marker
*m
;
235 marker
= BUF_MARKERS (current_buffer
);
237 while (!NILP (marker
))
239 m
= XMARKER (marker
);
243 if (mpos
> to
&& mpos
< to
+ amount
)
248 /* Here's the case where a marker is inside text being deleted.
249 AMOUNT can be negative for gap motion, too,
250 but then this range contains no markers. */
251 if (mpos
> from
+ amount
&& mpos
<= from
)
253 record_marker_adjustment (marker
, from
+ amount
- mpos
);
254 mpos
= from
+ amount
;
257 if (mpos
> from
&& mpos
<= to
)
264 /* Adjust markers whose insertion-type is t
265 for an insertion of AMOUNT characters at POS. */
268 adjust_markers_for_insert (pos
, amount
)
269 register int pos
, amount
;
273 marker
= BUF_MARKERS (current_buffer
);
275 while (!NILP (marker
))
277 register struct Lisp_Marker
*m
= XMARKER (marker
);
278 if (m
->insertion_type
&& m
->bufpos
== pos
)
284 /* Add the specified amount to point. This is used only when the value
285 of point changes due to an insert or delete; it does not represent
286 a conceptual change in point as a marker. In particular, point is
287 not crossing any interval boundaries, so there's no need to use the
288 usual SET_PT macro. In fact it would be incorrect to do so, because
289 either the old or the new value of point is out of sync with the
290 current set of intervals. */
292 adjust_point (amount
)
295 BUF_PT (current_buffer
) += amount
;
298 /* Make the gap INCREMENT characters longer. */
304 unsigned char *result
;
309 /* If we have to get more space, get enough to last a while. */
312 /* Don't allow a buffer size that won't fit in an int
313 even if it will fit in a Lisp integer.
314 That won't work because so many places use `int'. */
316 if (Z
- BEG
+ GAP_SIZE
+ increment
317 >= ((unsigned) 1 << (min (BITS_PER_INT
, VALBITS
) - 1)))
318 error ("Buffer exceeds maximum size");
321 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
329 /* We can't unblock until the new address is properly stored. */
333 /* Prevent quitting in move_gap. */
338 old_gap_size
= GAP_SIZE
;
340 /* Call the newly allocated space a gap at the end of the whole space. */
342 GAP_SIZE
= increment
;
344 /* Move the new gap down to be consecutive with the end of the old one.
345 This adjusts the markers properly too. */
346 gap_left (real_gap_loc
+ old_gap_size
, 1);
348 /* Now combine the two into one large gap. */
349 GAP_SIZE
+= old_gap_size
;
355 /* Insert a string of specified length before point.
356 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
357 prepare_to_modify_buffer could relocate the text. */
360 insert (string
, length
)
361 register unsigned char *string
;
366 insert_1 (string
, length
, 0, 1);
367 signal_after_change (PT
-length
, 0, length
);
372 insert_and_inherit (string
, length
)
373 register unsigned char *string
;
378 insert_1 (string
, length
, 1, 1);
379 signal_after_change (PT
-length
, 0, length
);
384 insert_1 (string
, length
, inherit
, prepare
)
385 register unsigned char *string
;
387 int inherit
, prepare
;
389 register Lisp_Object temp
;
392 prepare_to_modify_buffer (PT
, PT
);
396 if (GAP_SIZE
< length
)
397 make_gap (length
- GAP_SIZE
);
399 record_insert (PT
, length
);
402 bcopy (string
, GPT_ADDR
, length
);
404 #ifdef USE_TEXT_PROPERTIES
405 if (BUF_INTERVALS (current_buffer
) != 0)
406 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
407 offset_intervals (current_buffer
, PT
, length
);
414 adjust_overlays_for_insert (PT
, length
);
415 adjust_markers_for_insert (PT
, length
);
416 adjust_point (length
);
418 #ifdef USE_TEXT_PROPERTIES
419 if (!inherit
&& BUF_INTERVALS (current_buffer
) != 0)
420 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
425 /* Insert the part of the text of STRING, a Lisp object assumed to be
426 of type string, consisting of the LENGTH characters starting at
427 position POS. If the text of STRING has properties, they are absorbed
430 It does not work to use `insert' for this, because a GC could happen
431 before we bcopy the stuff into the buffer, and relocate the string
432 without insert noticing. */
435 insert_from_string (string
, pos
, length
, inherit
)
437 register int pos
, length
;
442 insert_from_string_1 (string
, pos
, length
, inherit
);
443 signal_after_change (PT
-length
, 0, length
);
448 insert_from_string_1 (string
, pos
, length
, inherit
)
450 register int pos
, length
;
453 register Lisp_Object temp
;
456 /* Make sure point-max won't overflow after this insertion. */
457 XSETINT (temp
, length
+ Z
);
458 if (length
+ Z
!= XINT (temp
))
459 error ("maximum buffer size exceeded");
462 prepare_to_modify_buffer (PT
, PT
);
466 if (GAP_SIZE
< length
)
467 make_gap (length
- GAP_SIZE
);
469 record_insert (PT
, length
);
473 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
475 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
476 offset_intervals (current_buffer
, PT
, length
);
482 adjust_overlays_for_insert (PT
, length
);
483 adjust_markers_for_insert (PT
, length
);
485 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
486 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
487 current_buffer
, inherit
);
489 adjust_point (length
);
492 /* Insert text from BUF, starting at POS and having length LENGTH, into the
493 current buffer. If the text in BUF has properties, they are absorbed
494 into the current buffer.
496 It does not work to use `insert' for this, because a malloc could happen
497 and relocate BUF's text before the bcopy happens. */
500 insert_from_buffer (buf
, pos
, length
, inherit
)
507 insert_from_buffer_1 (buf
, pos
, length
, inherit
);
508 signal_after_change (PT
-length
, 0, length
);
513 insert_from_buffer_1 (buf
, pos
, length
, inherit
)
518 register Lisp_Object temp
;
521 /* Make sure point-max won't overflow after this insertion. */
522 XSETINT (temp
, length
+ Z
);
523 if (length
+ Z
!= XINT (temp
))
524 error ("maximum buffer size exceeded");
526 prepare_to_modify_buffer (PT
, PT
);
530 if (GAP_SIZE
< length
)
531 make_gap (length
- GAP_SIZE
);
533 record_insert (PT
, length
);
536 if (pos
< BUF_GPT (buf
))
538 chunk
= BUF_GPT (buf
) - pos
;
541 bcopy (BUF_CHAR_ADDRESS (buf
, pos
), GPT_ADDR
, chunk
);
546 bcopy (BUF_CHAR_ADDRESS (buf
, pos
+ chunk
),
547 GPT_ADDR
+ chunk
, length
- chunk
);
549 #ifdef USE_TEXT_PROPERTIES
550 if (BUF_INTERVALS (current_buffer
) != 0)
551 offset_intervals (current_buffer
, PT
, length
);
558 adjust_overlays_for_insert (PT
, length
);
559 adjust_markers_for_insert (PT
, length
);
560 adjust_point (length
);
562 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
563 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf
),
565 PT
- length
, length
, current_buffer
, inherit
);
568 /* Insert the character C before point */
577 /* Insert the null-terminated string S before point */
583 insert (s
, strlen (s
));
586 /* Like `insert' except that all markers pointing at the place where
587 the insertion happens are adjusted to point after it.
588 Don't use this function to insert part of a Lisp string,
589 since gc could happen and relocate it. */
592 insert_before_markers (string
, length
)
593 unsigned char *string
;
598 register int opoint
= PT
;
599 insert_1 (string
, length
, 0, 1);
600 adjust_markers (opoint
- 1, opoint
, length
);
601 signal_after_change (PT
-length
, 0, length
);
606 insert_before_markers_and_inherit (string
, length
)
607 unsigned char *string
;
612 register int opoint
= PT
;
613 insert_1 (string
, length
, 1, 1);
614 adjust_markers (opoint
- 1, opoint
, length
);
615 signal_after_change (PT
-length
, 0, length
);
619 /* Insert part of a Lisp string, relocating markers after. */
622 insert_from_string_before_markers (string
, pos
, length
, inherit
)
624 register int pos
, length
;
629 register int opoint
= PT
;
630 insert_from_string_1 (string
, pos
, length
, inherit
);
631 adjust_markers (opoint
- 1, opoint
, length
);
632 signal_after_change (PT
-length
, 0, length
);
636 /* Delete characters in current buffer
637 from FROM up to (but not including) TO. */
641 register int from
, to
;
643 del_range_1 (from
, to
, 1);
646 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
649 del_range_1 (from
, to
, prepare
)
650 register int from
, to
, prepare
;
654 /* Make args be valid */
660 if ((numdel
= to
- from
) <= 0)
663 /* Make sure the gap is somewhere in or next to what we are deleting. */
670 prepare_to_modify_buffer (from
, to
);
672 /* Relocate all markers pointing into the new, larger gap
673 to point at the end of the text before the gap.
674 This has to be done before recording the deletion,
675 so undo handles this after reinserting the text. */
676 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
678 record_delete (from
, numdel
);
681 /* Relocate point as if it were a marker. */
683 adjust_point (from
- (PT
< to
? PT
: to
));
685 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
686 offset_intervals (current_buffer
, from
, - numdel
);
688 /* Adjust the overlay center as needed. This must be done after
689 adjusting the markers that bound the overlays. */
690 adjust_overlays_for_delete (from
, numdel
);
697 if (GPT
- BEG
< beg_unchanged
)
698 beg_unchanged
= GPT
- BEG
;
699 if (Z
- GPT
< end_unchanged
)
700 end_unchanged
= Z
- GPT
;
702 evaporate_overlays (from
);
703 signal_after_change (from
, numdel
, 0);
706 /* Call this if you're about to change the region of BUFFER from START
707 to END. This checks the read-only properties of the region, calls
708 the necessary modification hooks, and warns the next redisplay that
709 it should pay attention to that area. */
711 modify_region (buffer
, start
, end
)
712 struct buffer
*buffer
;
715 struct buffer
*old_buffer
= current_buffer
;
717 if (buffer
!= old_buffer
)
718 set_buffer_internal (buffer
);
720 prepare_to_modify_buffer (start
, end
);
722 if (start
- 1 < beg_unchanged
723 || (unchanged_modified
== MODIFF
724 && overlay_unchanged_modified
== OVERLAY_MODIFF
))
725 beg_unchanged
= start
- 1;
726 if (Z
- end
< end_unchanged
727 || (unchanged_modified
== MODIFF
728 && overlay_unchanged_modified
== OVERLAY_MODIFF
))
729 end_unchanged
= Z
- end
;
731 if (MODIFF
<= SAVE_MODIFF
)
732 record_first_change ();
735 buffer
->point_before_scroll
= Qnil
;
737 if (buffer
!= old_buffer
)
738 set_buffer_internal (old_buffer
);
741 /* Check that it is okay to modify the buffer between START and END.
742 Run the before-change-function, if any. If intervals are in use,
743 verify that the text to be modified is not read-only, and call
744 any modification properties the text may have. */
747 prepare_to_modify_buffer (start
, end
)
750 if (!NILP (current_buffer
->read_only
))
751 Fbarf_if_buffer_read_only ();
753 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
754 if (BUF_INTERVALS (current_buffer
) != 0)
755 verify_interval_modification (current_buffer
, start
, end
);
757 #ifdef CLASH_DETECTION
758 if (!NILP (current_buffer
->file_truename
)
759 /* Make binding buffer-file-name to nil effective. */
760 && !NILP (current_buffer
->filename
)
761 && SAVE_MODIFF
>= MODIFF
)
762 lock_file (current_buffer
->file_truename
);
764 /* At least warn if this file has changed on disk since it was visited. */
765 if (!NILP (current_buffer
->filename
)
766 && SAVE_MODIFF
>= MODIFF
767 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
768 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
769 call1 (intern ("ask-user-about-supersession-threat"),
770 current_buffer
->filename
);
771 #endif /* not CLASH_DETECTION */
773 signal_before_change (start
, end
);
775 if (current_buffer
->newline_cache
)
776 invalidate_region_cache (current_buffer
,
777 current_buffer
->newline_cache
,
778 start
- BEG
, Z
- end
);
779 if (current_buffer
->width_run_cache
)
780 invalidate_region_cache (current_buffer
,
781 current_buffer
->width_run_cache
,
782 start
- BEG
, Z
- end
);
784 Vdeactivate_mark
= Qt
;
787 /* Signal a change to the buffer immediately before it happens.
788 START_INT and END_INT are the bounds of the text to be changed. */
791 signal_before_change (start_int
, end_int
)
792 int start_int
, end_int
;
794 Lisp_Object start
, end
;
796 start
= make_number (start_int
);
797 end
= make_number (end_int
);
799 /* If buffer is unmodified, run a special hook for that case. */
800 if (SAVE_MODIFF
>= MODIFF
801 && !NILP (Vfirst_change_hook
)
802 && !NILP (Vrun_hooks
))
803 call1 (Vrun_hooks
, Qfirst_change_hook
);
805 /* Run the before-change-function if any.
806 We don't bother "binding" this variable to nil
807 because it is obsolete anyway and new code should not use it. */
808 if (!NILP (Vbefore_change_function
))
809 call2 (Vbefore_change_function
, start
, end
);
811 /* Now run the before-change-functions if any. */
812 if (!NILP (Vbefore_change_functions
))
815 Lisp_Object before_change_functions
;
816 Lisp_Object after_change_functions
;
817 struct gcpro gcpro1
, gcpro2
;
819 /* "Bind" before-change-functions and after-change-functions
820 to nil--but in a way that errors don't know about.
821 That way, if there's an error in them, they will stay nil. */
822 before_change_functions
= Vbefore_change_functions
;
823 after_change_functions
= Vafter_change_functions
;
824 Vbefore_change_functions
= Qnil
;
825 Vafter_change_functions
= Qnil
;
826 GCPRO2 (before_change_functions
, after_change_functions
);
828 /* Actually run the hook functions. */
829 args
[0] = Qbefore_change_functions
;
832 run_hook_list_with_args (before_change_functions
, 3, args
);
834 /* "Unbind" the variables we "bound" to nil. */
835 Vbefore_change_functions
= before_change_functions
;
836 Vafter_change_functions
= after_change_functions
;
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 that part of the text
853 signal_after_change (pos
, lendel
, lenins
)
854 int pos
, lendel
, lenins
;
856 /* Run the after-change-function if any.
857 We don't bother "binding" this variable to nil
858 because it is obsolete anyway and new code should not use it. */
859 if (!NILP (Vafter_change_function
))
860 call3 (Vafter_change_function
,
861 make_number (pos
), make_number (pos
+ lenins
),
862 make_number (lendel
));
864 if (!NILP (Vafter_change_functions
))
867 Lisp_Object before_change_functions
;
868 Lisp_Object after_change_functions
;
869 struct gcpro gcpro1
, gcpro2
;
871 /* "Bind" before-change-functions and after-change-functions
872 to nil--but in a way that errors don't know about.
873 That way, if there's an error in them, they will stay nil. */
874 before_change_functions
= Vbefore_change_functions
;
875 after_change_functions
= Vafter_change_functions
;
876 Vbefore_change_functions
= Qnil
;
877 Vafter_change_functions
= Qnil
;
878 GCPRO2 (before_change_functions
, after_change_functions
);
880 /* Actually run the hook functions. */
881 args
[0] = Qafter_change_functions
;
882 XSETFASTINT (args
[1], pos
);
883 XSETFASTINT (args
[2], pos
+ lenins
);
884 XSETFASTINT (args
[3], lendel
);
885 run_hook_list_with_args (after_change_functions
,
888 /* "Unbind" the variables we "bound" to nil. */
889 Vbefore_change_functions
= before_change_functions
;
890 Vafter_change_functions
= after_change_functions
;
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
),
899 make_number (pos
), make_number (pos
+ lenins
),
900 make_number (lendel
));
902 /* After an insertion, call the text properties
903 insert-behind-hooks or insert-in-front-hooks. */
905 report_interval_modification (pos
, pos
+ lenins
);