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
)
70 end_unchanged
= Z
- pos
- 1;
74 if (Z
- GPT
< end_unchanged
)
75 end_unchanged
= Z
- GPT
;
76 if (pos
< beg_unchanged
)
86 /* Now copy the characters. To move the gap down,
87 copy characters up. */
91 /* I gets number of characters left to copy. */
95 /* If a quit is requested, stop copying now.
96 Change POS to be where we have actually moved the gap to. */
102 /* Move at most 32000 chars before checking again for a quit. */
107 /* bcopy is safe if the two areas of memory do not overlap
108 or on systems where bcopy is always safe for moving upward. */
109 && (BCOPY_UPWARD_SAFE
110 || to
- from
>= 128))
112 /* If overlap is not safe, avoid it by not moving too many
113 characters at once. */
114 if (!BCOPY_UPWARD_SAFE
&& i
> to
- from
)
129 /* Adjust markers, and buffer data structure, to put the gap at POS.
130 POS is where the loop above stopped, which may be what was specified
131 or may be where a quit was detected. */
132 adjust_markers (pos
+ 1, GPT
, GAP_SIZE
);
141 register unsigned char *to
, *from
;
147 if (unchanged_modified
== MODIFF
)
150 end_unchanged
= Z
- pos
- 1;
154 if (Z
- pos
- 1 < end_unchanged
)
155 end_unchanged
= Z
- pos
- 1;
156 if (GPT
- BEG
< beg_unchanged
)
157 beg_unchanged
= GPT
- BEG
;
165 /* Now copy the characters. To move the gap up,
166 copy characters down. */
170 /* I gets number of characters left to copy. */
174 /* If a quit is requested, stop copying now.
175 Change POS to be where we have actually moved the gap to. */
181 /* Move at most 32000 chars before checking again for a quit. */
186 /* bcopy is safe if the two areas of memory do not overlap
187 or on systems where bcopy is always safe for moving downward. */
188 && (BCOPY_DOWNWARD_SAFE
189 || from
- to
>= 128))
191 /* If overlap is not safe, avoid it by not moving too many
192 characters at once. */
193 if (!BCOPY_DOWNWARD_SAFE
&& i
> from
- to
)
208 adjust_markers (GPT
+ GAP_SIZE
, pos
+ 1 + GAP_SIZE
, - GAP_SIZE
);
213 /* Add AMOUNT to the position of every marker in the current buffer
214 whose current position is between FROM (exclusive) and TO (inclusive).
216 Also, any markers past the outside of that interval, in the direction
217 of adjustment, are first moved back to the near end of the interval
218 and then adjusted by AMOUNT.
220 When the latter adjustment is done, if AMOUNT is negative,
221 we record the adjustment for undo. (This case happens only for
225 adjust_markers (from
, to
, amount
)
226 register int from
, to
, amount
;
229 register struct Lisp_Marker
*m
;
232 marker
= BUF_MARKERS (current_buffer
);
234 while (!NILP (marker
))
236 m
= XMARKER (marker
);
240 if (mpos
> to
&& mpos
< to
+ amount
)
245 /* Here's the case where a marker is inside text being deleted.
246 AMOUNT can be negative for gap motion, too,
247 but then this range contains no markers. */
248 if (mpos
> from
+ amount
&& mpos
<= from
)
250 record_marker_adjustment (marker
, from
+ amount
- mpos
);
251 mpos
= from
+ amount
;
254 if (mpos
> from
&& mpos
<= to
)
261 /* Adjust markers whose insertion-type is t
262 for an insertion of AMOUNT characters at POS. */
265 adjust_markers_for_insert (pos
, amount
)
266 register int pos
, amount
;
270 marker
= BUF_MARKERS (current_buffer
);
272 while (!NILP (marker
))
274 register struct Lisp_Marker
*m
= XMARKER (marker
);
275 if (m
->insertion_type
&& m
->bufpos
== pos
)
281 /* Add the specified amount to point. This is used only when the value
282 of point changes due to an insert or delete; it does not represent
283 a conceptual change in point as a marker. In particular, point is
284 not crossing any interval boundaries, so there's no need to use the
285 usual SET_PT macro. In fact it would be incorrect to do so, because
286 either the old or the new value of point is out of sync with the
287 current set of intervals. */
289 adjust_point (amount
)
292 BUF_PT (current_buffer
) += amount
;
295 /* Make the gap INCREMENT characters longer. */
301 unsigned char *result
;
306 /* If we have to get more space, get enough to last a while. */
309 /* Don't allow a buffer size that won't fit in an int
310 even if it will fit in a Lisp integer.
311 That won't work because so many places use `int'. */
313 if (Z
- BEG
+ GAP_SIZE
+ increment
314 >= ((unsigned) 1 << (min (BITS_PER_INT
, VALBITS
) - 1)))
315 error ("Buffer exceeds maximum size");
318 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
326 /* We can't unblock until the new address is properly stored. */
330 /* Prevent quitting in move_gap. */
335 old_gap_size
= GAP_SIZE
;
337 /* Call the newly allocated space a gap at the end of the whole space. */
339 GAP_SIZE
= increment
;
341 /* Move the new gap down to be consecutive with the end of the old one.
342 This adjusts the markers properly too. */
343 gap_left (real_gap_loc
+ old_gap_size
, 1);
345 /* Now combine the two into one large gap. */
346 GAP_SIZE
+= old_gap_size
;
352 /* Insert a string of specified length before point.
353 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
354 prepare_to_modify_buffer could relocate the text. */
357 insert (string
, length
)
358 register unsigned char *string
;
363 insert_1 (string
, length
, 0, 1);
364 signal_after_change (PT
-length
, 0, length
);
369 insert_and_inherit (string
, length
)
370 register unsigned char *string
;
375 insert_1 (string
, length
, 1, 1);
376 signal_after_change (PT
-length
, 0, length
);
381 insert_1 (string
, length
, inherit
, prepare
)
382 register unsigned char *string
;
384 int inherit
, prepare
;
386 register Lisp_Object temp
;
389 prepare_to_modify_buffer (PT
, PT
);
393 if (GAP_SIZE
< length
)
394 make_gap (length
- GAP_SIZE
);
396 record_insert (PT
, length
);
399 bcopy (string
, GPT_ADDR
, length
);
401 #ifdef USE_TEXT_PROPERTIES
402 if (BUF_INTERVALS (current_buffer
) != 0)
403 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
404 offset_intervals (current_buffer
, PT
, length
);
411 adjust_overlays_for_insert (PT
, length
);
412 adjust_markers_for_insert (PT
, length
);
413 adjust_point (length
);
415 #ifdef USE_TEXT_PROPERTIES
416 if (!inherit
&& BUF_INTERVALS (current_buffer
) != 0)
417 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
422 /* Insert the part of the text of STRING, a Lisp object assumed to be
423 of type string, consisting of the LENGTH characters starting at
424 position POS. If the text of STRING has properties, they are absorbed
427 It does not work to use `insert' for this, because a GC could happen
428 before we bcopy the stuff into the buffer, and relocate the string
429 without insert noticing. */
432 insert_from_string (string
, pos
, length
, inherit
)
434 register int pos
, length
;
439 insert_from_string_1 (string
, pos
, length
, inherit
);
440 signal_after_change (PT
-length
, 0, length
);
445 insert_from_string_1 (string
, pos
, length
, inherit
)
447 register int pos
, length
;
450 register Lisp_Object temp
;
453 /* Make sure point-max won't overflow after this insertion. */
454 XSETINT (temp
, length
+ Z
);
455 if (length
+ Z
!= XINT (temp
))
456 error ("maximum buffer size exceeded");
459 prepare_to_modify_buffer (PT
, PT
);
463 if (GAP_SIZE
< length
)
464 make_gap (length
- GAP_SIZE
);
466 record_insert (PT
, length
);
470 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
472 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
473 offset_intervals (current_buffer
, PT
, length
);
479 adjust_overlays_for_insert (PT
, length
);
480 adjust_markers_for_insert (PT
, length
);
482 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
483 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
484 current_buffer
, inherit
);
486 adjust_point (length
);
489 /* Insert text from BUF, starting at POS and having length LENGTH, into the
490 current buffer. If the text in BUF has properties, they are absorbed
491 into the current buffer.
493 It does not work to use `insert' for this, because a malloc could happen
494 and relocate BUF's text before the bcopy happens. */
497 insert_from_buffer (buf
, pos
, length
, inherit
)
504 insert_from_buffer_1 (buf
, pos
, length
, inherit
);
505 signal_after_change (PT
-length
, 0, length
);
510 insert_from_buffer_1 (buf
, pos
, length
, inherit
)
515 register Lisp_Object temp
;
518 /* Make sure point-max won't overflow after this insertion. */
519 XSETINT (temp
, length
+ Z
);
520 if (length
+ Z
!= XINT (temp
))
521 error ("maximum buffer size exceeded");
523 prepare_to_modify_buffer (PT
, PT
);
527 if (GAP_SIZE
< length
)
528 make_gap (length
- GAP_SIZE
);
530 record_insert (PT
, length
);
533 if (pos
< BUF_GPT (buf
))
535 chunk
= BUF_GPT (buf
) - pos
;
538 bcopy (BUF_CHAR_ADDRESS (buf
, pos
), GPT_ADDR
, chunk
);
543 bcopy (BUF_CHAR_ADDRESS (buf
, pos
+ chunk
),
544 GPT_ADDR
+ chunk
, length
- chunk
);
546 #ifdef USE_TEXT_PROPERTIES
547 if (BUF_INTERVALS (current_buffer
) != 0)
548 offset_intervals (current_buffer
, PT
, length
);
555 adjust_overlays_for_insert (PT
, length
);
556 adjust_markers_for_insert (PT
, length
);
557 adjust_point (length
);
559 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
560 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf
),
562 PT
- length
, length
, current_buffer
, inherit
);
565 /* Insert the character C before point */
574 /* Insert the null-terminated string S before point */
580 insert (s
, strlen (s
));
583 /* Like `insert' except that all markers pointing at the place where
584 the insertion happens are adjusted to point after it.
585 Don't use this function to insert part of a Lisp string,
586 since gc could happen and relocate it. */
589 insert_before_markers (string
, length
)
590 unsigned char *string
;
595 register int opoint
= PT
;
596 insert_1 (string
, length
, 0, 1);
597 adjust_markers (opoint
- 1, opoint
, length
);
598 signal_after_change (PT
-length
, 0, length
);
603 insert_before_markers_and_inherit (string
, length
)
604 unsigned char *string
;
609 register int opoint
= PT
;
610 insert_1 (string
, length
, 1, 1);
611 adjust_markers (opoint
- 1, opoint
, length
);
612 signal_after_change (PT
-length
, 0, length
);
616 /* Insert part of a Lisp string, relocating markers after. */
619 insert_from_string_before_markers (string
, pos
, length
, inherit
)
621 register int pos
, length
;
626 register int opoint
= PT
;
627 insert_from_string_1 (string
, pos
, length
, inherit
);
628 adjust_markers (opoint
- 1, opoint
, length
);
629 signal_after_change (PT
-length
, 0, length
);
633 /* Delete characters in current buffer
634 from FROM up to (but not including) TO. */
638 register int from
, to
;
640 del_range_1 (from
, to
, 1);
643 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
646 del_range_1 (from
, to
, prepare
)
647 register int from
, to
, prepare
;
651 /* Make args be valid */
657 if ((numdel
= to
- from
) <= 0)
660 /* Make sure the gap is somewhere in or next to what we are deleting. */
667 prepare_to_modify_buffer (from
, to
);
669 /* Relocate all markers pointing into the new, larger gap
670 to point at the end of the text before the gap.
671 This has to be done before recording the deletion,
672 so undo handles this after reinserting the text. */
673 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
675 record_delete (from
, numdel
);
678 /* Relocate point as if it were a marker. */
680 adjust_point (from
- (PT
< to
? PT
: to
));
682 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
683 offset_intervals (current_buffer
, from
, - numdel
);
685 /* Adjust the overlay center as needed. This must be done after
686 adjusting the markers that bound the overlays. */
687 adjust_overlays_for_delete (from
, numdel
);
694 if (GPT
- BEG
< beg_unchanged
)
695 beg_unchanged
= GPT
- BEG
;
696 if (Z
- GPT
< end_unchanged
)
697 end_unchanged
= Z
- GPT
;
699 evaporate_overlays (from
);
700 signal_after_change (from
, numdel
, 0);
703 /* Call this if you're about to change the region of BUFFER from START
704 to END. This checks the read-only properties of the region, calls
705 the necessary modification hooks, and warns the next redisplay that
706 it should pay attention to that area. */
708 modify_region (buffer
, start
, end
)
709 struct buffer
*buffer
;
712 struct buffer
*old_buffer
= current_buffer
;
714 if (buffer
!= old_buffer
)
715 set_buffer_internal (buffer
);
717 prepare_to_modify_buffer (start
, end
);
719 if (start
- 1 < beg_unchanged
|| unchanged_modified
== MODIFF
)
720 beg_unchanged
= start
- 1;
721 if (Z
- end
< end_unchanged
722 || unchanged_modified
== MODIFF
)
723 end_unchanged
= Z
- end
;
725 if (MODIFF
<= SAVE_MODIFF
)
726 record_first_change ();
729 buffer
->point_before_scroll
= Qnil
;
731 if (buffer
!= old_buffer
)
732 set_buffer_internal (old_buffer
);
735 /* Check that it is okay to modify the buffer between START and END.
736 Run the before-change-function, if any. If intervals are in use,
737 verify that the text to be modified is not read-only, and call
738 any modification properties the text may have. */
741 prepare_to_modify_buffer (start
, end
)
742 Lisp_Object start
, end
;
744 if (!NILP (current_buffer
->read_only
))
745 Fbarf_if_buffer_read_only ();
747 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
748 if (BUF_INTERVALS (current_buffer
) != 0)
749 verify_interval_modification (current_buffer
, start
, end
);
751 #ifdef CLASH_DETECTION
752 if (!NILP (current_buffer
->file_truename
)
753 /* Make binding buffer-file-name to nil effective. */
754 && !NILP (current_buffer
->filename
)
755 && SAVE_MODIFF
>= MODIFF
)
756 lock_file (current_buffer
->file_truename
);
758 /* At least warn if this file has changed on disk since it was visited. */
759 if (!NILP (current_buffer
->filename
)
760 && SAVE_MODIFF
>= MODIFF
761 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
762 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
763 call1 (intern ("ask-user-about-supersession-threat"),
764 current_buffer
->filename
);
765 #endif /* not CLASH_DETECTION */
767 signal_before_change (start
, end
);
769 if (current_buffer
->newline_cache
)
770 invalidate_region_cache (current_buffer
,
771 current_buffer
->newline_cache
,
772 start
- BEG
, Z
- end
);
773 if (current_buffer
->width_run_cache
)
774 invalidate_region_cache (current_buffer
,
775 current_buffer
->width_run_cache
,
776 start
- BEG
, Z
- end
);
778 Vdeactivate_mark
= Qt
;
781 /* Signal a change to the buffer immediately before it happens.
782 START and END are the bounds of the text to be changed,
786 signal_before_change (start
, end
)
787 Lisp_Object start
, end
;
789 /* If buffer is unmodified, run a special hook for that case. */
790 if (SAVE_MODIFF
>= MODIFF
791 && !NILP (Vfirst_change_hook
)
792 && !NILP (Vrun_hooks
))
793 call1 (Vrun_hooks
, Qfirst_change_hook
);
795 /* Run the before-change-function if any.
796 We don't bother "binding" this variable to nil
797 because it is obsolete anyway and new code should not use it. */
798 if (!NILP (Vbefore_change_function
))
799 call2 (Vbefore_change_function
, start
, end
);
801 /* Now run the before-change-functions if any. */
802 if (!NILP (Vbefore_change_functions
))
805 Lisp_Object before_change_functions
;
806 Lisp_Object after_change_functions
;
807 struct gcpro gcpro1
, gcpro2
;
809 /* "Bind" before-change-functions and after-change-functions
810 to nil--but in a way that errors don't know about.
811 That way, if there's an error in them, they will stay nil. */
812 before_change_functions
= Vbefore_change_functions
;
813 after_change_functions
= Vafter_change_functions
;
814 Vbefore_change_functions
= Qnil
;
815 Vafter_change_functions
= Qnil
;
816 GCPRO2 (before_change_functions
, after_change_functions
);
818 /* Actually run the hook functions. */
819 args
[0] = Qbefore_change_functions
;
822 run_hook_list_with_args (before_change_functions
, 3, args
);
824 /* "Unbind" the variables we "bound" to nil. */
825 Vbefore_change_functions
= before_change_functions
;
826 Vafter_change_functions
= after_change_functions
;
830 if (!NILP (current_buffer
->overlays_before
)
831 || !NILP (current_buffer
->overlays_after
))
832 report_overlay_modification (start
, end
, 0, start
, end
, Qnil
);
835 /* Signal a change immediately after it happens.
836 POS is the address of the start of the changed text.
837 LENDEL is the number of characters of the text before the change.
838 (Not the whole buffer; just the part that was changed.)
839 LENINS is the number of characters in that part of the text
843 signal_after_change (pos
, lendel
, lenins
)
844 int pos
, lendel
, lenins
;
846 /* Run the after-change-function if any.
847 We don't bother "binding" this variable to nil
848 because it is obsolete anyway and new code should not use it. */
849 if (!NILP (Vafter_change_function
))
850 call3 (Vafter_change_function
,
851 make_number (pos
), make_number (pos
+ lenins
),
852 make_number (lendel
));
854 if (!NILP (Vafter_change_functions
))
857 Lisp_Object before_change_functions
;
858 Lisp_Object after_change_functions
;
859 struct gcpro gcpro1
, gcpro2
;
861 /* "Bind" before-change-functions and after-change-functions
862 to nil--but in a way that errors don't know about.
863 That way, if there's an error in them, they will stay nil. */
864 before_change_functions
= Vbefore_change_functions
;
865 after_change_functions
= Vafter_change_functions
;
866 Vbefore_change_functions
= Qnil
;
867 Vafter_change_functions
= Qnil
;
868 GCPRO2 (before_change_functions
, after_change_functions
);
870 /* Actually run the hook functions. */
871 args
[0] = Qafter_change_functions
;
872 XSETFASTINT (args
[1], pos
);
873 XSETFASTINT (args
[2], pos
+ lenins
);
874 XSETFASTINT (args
[3], lendel
);
875 run_hook_list_with_args (after_change_functions
,
878 /* "Unbind" the variables we "bound" to nil. */
879 Vbefore_change_functions
= before_change_functions
;
880 Vafter_change_functions
= after_change_functions
;
884 if (!NILP (current_buffer
->overlays_before
)
885 || !NILP (current_buffer
->overlays_after
))
886 report_overlay_modification (make_number (pos
),
887 make_number (pos
+ lenins
),
889 make_number (pos
), make_number (pos
+ lenins
),
890 make_number (lendel
));
892 /* After an insertion, call the text properties
893 insert-behind-hooks or insert-in-front-hooks. */
895 report_interval_modification (pos
, pos
+ lenins
);