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, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 #include "intervals.h"
26 #include "blockinput.h"
28 #define min(x, y) ((x) < (y) ? (x) : (y))
30 static void insert_from_string_1 ();
31 static void insert_from_buffer_1 ();
32 static void gap_left ();
33 static void gap_right ();
34 static void adjust_markers ();
35 static void adjust_point ();
37 /* Move gap to position `pos'.
38 Note that this can quit! */
50 /* Move the gap to POS, which is less than the current GPT.
51 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
54 gap_left (pos
, newgap
)
58 register unsigned char *to
, *from
;
66 if (unchanged_modified
== MODIFF
)
69 end_unchanged
= Z
- pos
- 1;
73 if (Z
- GPT
< end_unchanged
)
74 end_unchanged
= Z
- GPT
;
75 if (pos
< beg_unchanged
)
85 /* Now copy the characters. To move the gap down,
86 copy characters up. */
90 /* I gets number of characters left to copy. */
94 /* If a quit is requested, stop copying now.
95 Change POS to be where we have actually moved the gap to. */
101 /* Move at most 32000 chars before checking again for a quit. */
106 /* bcopy is safe if the two areas of memory do not overlap
107 or on systems where bcopy is always safe for moving upward. */
108 && (BCOPY_UPWARD_SAFE
109 || to
- from
>= 128))
111 /* If overlap is not safe, avoid it by not moving too many
112 characters at once. */
113 if (!BCOPY_UPWARD_SAFE
&& i
> to
- from
)
128 /* Adjust markers, and buffer data structure, to put the gap at POS.
129 POS is where the loop above stopped, which may be what was specified
130 or may be where a quit was detected. */
131 adjust_markers (pos
+ 1, GPT
, GAP_SIZE
);
140 register unsigned char *to
, *from
;
146 if (unchanged_modified
== MODIFF
)
149 end_unchanged
= Z
- pos
- 1;
153 if (Z
- pos
- 1 < end_unchanged
)
154 end_unchanged
= Z
- pos
- 1;
155 if (GPT
- BEG
< beg_unchanged
)
156 beg_unchanged
= GPT
- BEG
;
164 /* Now copy the characters. To move the gap up,
165 copy characters down. */
169 /* I gets number of characters left to copy. */
173 /* If a quit is requested, stop copying now.
174 Change POS to be where we have actually moved the gap to. */
180 /* Move at most 32000 chars before checking again for a quit. */
185 /* bcopy is safe if the two areas of memory do not overlap
186 or on systems where bcopy is always safe for moving downward. */
187 && (BCOPY_DOWNWARD_SAFE
188 || from
- to
>= 128))
190 /* If overlap is not safe, avoid it by not moving too many
191 characters at once. */
192 if (!BCOPY_DOWNWARD_SAFE
&& i
> from
- to
)
207 adjust_markers (GPT
+ GAP_SIZE
, pos
+ 1 + GAP_SIZE
, - GAP_SIZE
);
212 /* Add `amount' to the position of every marker in the current buffer
213 whose current position is between `from' (exclusive) and `to' (inclusive).
214 Also, any markers past the outside of that interval, in the direction
215 of adjustment, are first moved back to the near end of the interval
216 and then adjusted by `amount'. */
219 adjust_markers (from
, to
, amount
)
220 register int from
, to
, amount
;
223 register struct Lisp_Marker
*m
;
226 marker
= BUF_MARKERS (current_buffer
);
228 while (!NILP (marker
))
230 m
= XMARKER (marker
);
234 if (mpos
> to
&& mpos
< to
+ amount
)
239 if (mpos
> from
+ amount
&& mpos
<= from
)
240 mpos
= from
+ amount
;
242 if (mpos
> from
&& mpos
<= to
)
249 /* Add the specified amount to point. This is used only when the value
250 of point changes due to an insert or delete; it does not represent
251 a conceptual change in point as a marker. In particular, point is
252 not crossing any interval boundaries, so there's no need to use the
253 usual SET_PT macro. In fact it would be incorrect to do so, because
254 either the old or the new value of point is out of synch with the
255 current set of intervals. */
257 adjust_point (amount
)
260 BUF_PT (current_buffer
) += amount
;
263 /* Make the gap INCREMENT characters longer. */
269 unsigned char *result
;
274 /* If we have to get more space, get enough to last a while. */
277 /* Don't allow a buffer size that won't fit in an int
278 even if it will fit in a Lisp integer.
279 That won't work because so many places use `int'. */
281 if (Z
- BEG
+ GAP_SIZE
+ increment
282 >= ((unsigned) 1 << (min (INTBITS
, VALBITS
) - 1)))
283 error ("Buffer exceeds maximum size");
286 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
294 /* We can't unblock until the new address is properly stored. */
298 /* Prevent quitting in move_gap. */
303 old_gap_size
= GAP_SIZE
;
305 /* Call the newly allocated space a gap at the end of the whole space. */
307 GAP_SIZE
= increment
;
309 /* Move the new gap down to be consecutive with the end of the old one.
310 This adjusts the markers properly too. */
311 gap_left (real_gap_loc
+ old_gap_size
, 1);
313 /* Now combine the two into one large gap. */
314 GAP_SIZE
+= old_gap_size
;
320 /* Insert a string of specified length before point.
321 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
322 prepare_to_modify_buffer could relocate the text. */
325 insert (string
, length
)
326 register unsigned char *string
;
331 insert_1 (string
, length
, 0, 1);
332 signal_after_change (PT
-length
, 0, length
);
337 insert_and_inherit (string
, length
)
338 register unsigned char *string
;
343 insert_1 (string
, length
, 1, 1);
344 signal_after_change (PT
-length
, 0, length
);
349 insert_1 (string
, length
, inherit
, prepare
)
350 register unsigned char *string
;
352 int inherit
, prepare
;
354 register Lisp_Object temp
;
357 prepare_to_modify_buffer (PT
, PT
);
361 if (GAP_SIZE
< length
)
362 make_gap (length
- GAP_SIZE
);
364 record_insert (PT
, length
);
367 bcopy (string
, GPT_ADDR
, length
);
369 #ifdef USE_TEXT_PROPERTIES
370 if (BUF_INTERVALS (current_buffer
) != 0)
371 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
372 offset_intervals (current_buffer
, PT
, length
);
379 adjust_overlays_for_insert (PT
, length
);
380 adjust_point (length
);
382 #ifdef USE_TEXT_PROPERTIES
383 if (!inherit
&& BUF_INTERVALS (current_buffer
) != 0)
384 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
389 /* Insert the part of the text of STRING, a Lisp object assumed to be
390 of type string, consisting of the LENGTH characters starting at
391 position POS. If the text of STRING has properties, they are absorbed
394 It does not work to use `insert' for this, because a GC could happen
395 before we bcopy the stuff into the buffer, and relocate the string
396 without insert noticing. */
399 insert_from_string (string
, pos
, length
, inherit
)
401 register int pos
, length
;
406 insert_from_string_1 (string
, pos
, length
, inherit
);
407 signal_after_change (PT
-length
, 0, length
);
412 insert_from_string_1 (string
, pos
, length
, inherit
)
414 register int pos
, length
;
417 register Lisp_Object temp
;
420 /* Make sure point-max won't overflow after this insertion. */
421 XSETINT (temp
, length
+ Z
);
422 if (length
+ Z
!= XINT (temp
))
423 error ("maximum buffer size exceeded");
426 prepare_to_modify_buffer (PT
, PT
);
430 if (GAP_SIZE
< length
)
431 make_gap (length
- GAP_SIZE
);
433 record_insert (PT
, length
);
437 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
439 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
440 offset_intervals (current_buffer
, PT
, length
);
446 adjust_overlays_for_insert (PT
, length
);
448 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
449 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
450 current_buffer
, inherit
);
452 adjust_point (length
);
455 /* Insert text from BUF, starting at POS and having length LENGTH, into the
456 current buffer. If the text in BUF has properties, they are absorbed
457 into the current buffer.
459 It does not work to use `insert' for this, because a malloc could happen
460 and relocate BUF's text before the bcopy happens. */
463 insert_from_buffer (buf
, pos
, length
, inherit
)
470 insert_from_buffer_1 (buf
, pos
, length
, inherit
);
471 signal_after_change (PT
-length
, 0, length
);
476 insert_from_buffer_1 (buf
, pos
, length
, inherit
)
481 register Lisp_Object temp
;
484 /* Make sure point-max won't overflow after this insertion. */
485 XSETINT (temp
, length
+ Z
);
486 if (length
+ Z
!= XINT (temp
))
487 error ("maximum buffer size exceeded");
489 prepare_to_modify_buffer (PT
, PT
);
493 if (GAP_SIZE
< length
)
494 make_gap (length
- GAP_SIZE
);
496 record_insert (PT
, length
);
499 if (pos
< BUF_GPT (buf
))
501 chunk
= BUF_GPT (buf
) - pos
;
504 bcopy (BUF_CHAR_ADDRESS (buf
, pos
), GPT_ADDR
, chunk
);
509 bcopy (BUF_CHAR_ADDRESS (buf
, pos
+ chunk
),
510 GPT_ADDR
+ chunk
, length
- chunk
);
512 #ifdef USE_TEXT_PROPERTIES
513 if (BUF_INTERVALS (current_buffer
) != 0)
514 offset_intervals (current_buffer
, PT
, length
);
521 adjust_overlays_for_insert (PT
, length
);
522 adjust_point (length
);
524 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
525 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf
),
527 PT
- length
, length
, current_buffer
, inherit
);
530 /* Insert the character C before point */
539 /* Insert the null-terminated string S before point */
545 insert (s
, strlen (s
));
548 /* Like `insert' except that all markers pointing at the place where
549 the insertion happens are adjusted to point after it.
550 Don't use this function to insert part of a Lisp string,
551 since gc could happen and relocate it. */
554 insert_before_markers (string
, length
)
555 unsigned char *string
;
560 register int opoint
= PT
;
561 insert_1 (string
, length
, 0, 1);
562 adjust_markers (opoint
- 1, opoint
, length
);
563 signal_after_change (PT
-length
, 0, length
);
568 insert_before_markers_and_inherit (string
, length
)
569 unsigned char *string
;
574 register int opoint
= PT
;
575 insert_1 (string
, length
, 1, 1);
576 adjust_markers (opoint
- 1, opoint
, length
);
577 signal_after_change (PT
-length
, 0, length
);
581 /* Insert part of a Lisp string, relocating markers after. */
584 insert_from_string_before_markers (string
, pos
, length
, inherit
)
586 register int pos
, length
;
591 register int opoint
= PT
;
592 insert_from_string_1 (string
, pos
, length
, inherit
);
593 adjust_markers (opoint
- 1, opoint
, length
);
594 signal_after_change (PT
-length
, 0, length
);
598 /* Delete characters in current buffer
599 from FROM up to (but not including) TO. */
603 register int from
, to
;
605 del_range_1 (from
, to
, 1);
608 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
611 del_range_1 (from
, to
, prepare
)
612 register int from
, to
, prepare
;
616 /* Make args be valid */
622 if ((numdel
= to
- from
) <= 0)
625 /* Make sure the gap is somewhere in or next to what we are deleting. */
632 prepare_to_modify_buffer (from
, to
);
634 record_delete (from
, numdel
);
637 /* Relocate point as if it were a marker. */
639 adjust_point (from
- (PT
< to
? PT
: to
));
641 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
642 offset_intervals (current_buffer
, from
, - numdel
);
644 /* Relocate all markers pointing into the new, larger gap
645 to point at the end of the text before the gap. */
646 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
648 /* Adjust the overlay center as needed. This must be done after
649 adjusting the markers that bound the overlays. */
650 adjust_overlays_for_delete (from
, numdel
);
657 if (GPT
- BEG
< beg_unchanged
)
658 beg_unchanged
= GPT
- BEG
;
659 if (Z
- GPT
< end_unchanged
)
660 end_unchanged
= Z
- GPT
;
662 evaporate_overlays (from
);
663 signal_after_change (from
, numdel
, 0);
666 /* Call this if you're about to change the region of BUFFER from START
667 to END. This checks the read-only properties of the region, calls
668 the necessary modification hooks, and warns the next redisplay that
669 it should pay attention to that area. */
671 modify_region (buffer
, start
, end
)
672 struct buffer
*buffer
;
675 struct buffer
*old_buffer
= current_buffer
;
677 if (buffer
!= old_buffer
)
678 set_buffer_internal (buffer
);
680 prepare_to_modify_buffer (start
, end
);
682 if (start
- 1 < beg_unchanged
|| unchanged_modified
== MODIFF
)
683 beg_unchanged
= start
- 1;
684 if (Z
- end
< end_unchanged
685 || unchanged_modified
== MODIFF
)
686 end_unchanged
= Z
- end
;
688 if (MODIFF
<= SAVE_MODIFF
)
689 record_first_change ();
692 buffer
->point_before_scroll
= Qnil
;
694 if (buffer
!= old_buffer
)
695 set_buffer_internal (old_buffer
);
698 /* Check that it is okay to modify the buffer between START and END.
699 Run the before-change-function, if any. If intervals are in use,
700 verify that the text to be modified is not read-only, and call
701 any modification properties the text may have. */
704 prepare_to_modify_buffer (start
, end
)
705 Lisp_Object start
, end
;
707 if (!NILP (current_buffer
->read_only
))
708 Fbarf_if_buffer_read_only ();
710 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
711 if (BUF_INTERVALS (current_buffer
) != 0)
712 verify_interval_modification (current_buffer
, start
, end
);
714 #ifdef CLASH_DETECTION
715 if (!NILP (current_buffer
->file_truename
)
716 /* Make binding buffer-file-name to nil effective. */
717 && !NILP (current_buffer
->filename
)
718 && SAVE_MODIFF
>= MODIFF
)
719 lock_file (current_buffer
->file_truename
);
721 /* At least warn if this file has changed on disk since it was visited. */
722 if (!NILP (current_buffer
->filename
)
723 && SAVE_MODIFF
>= MODIFF
724 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
725 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
726 call1 (intern ("ask-user-about-supersession-threat"),
727 current_buffer
->filename
);
728 #endif /* not CLASH_DETECTION */
730 signal_before_change (start
, end
);
732 if (current_buffer
->newline_cache
)
733 invalidate_region_cache (current_buffer
,
734 current_buffer
->newline_cache
,
735 start
- BEG
, Z
- end
);
736 if (current_buffer
->width_run_cache
)
737 invalidate_region_cache (current_buffer
,
738 current_buffer
->width_run_cache
,
739 start
- BEG
, Z
- end
);
741 Vdeactivate_mark
= Qt
;
744 /* Signal a change to the buffer immediately before it happens.
745 START and END are the bounds of the text to be changed,
749 signal_before_change (start
, end
)
750 Lisp_Object start
, end
;
752 /* If buffer is unmodified, run a special hook for that case. */
753 if (SAVE_MODIFF
>= MODIFF
754 && !NILP (Vfirst_change_hook
)
755 && !NILP (Vrun_hooks
))
756 call1 (Vrun_hooks
, Qfirst_change_hook
);
758 /* Run the before-change-function if any.
759 We don't bother "binding" this variable to nil
760 because it is obsolete anyway and new code should not use it. */
761 if (!NILP (Vbefore_change_function
))
762 call2 (Vbefore_change_function
, start
, end
);
764 /* Now run the before-change-functions if any. */
765 if (!NILP (Vbefore_change_functions
))
768 Lisp_Object before_change_functions
;
769 Lisp_Object after_change_functions
;
770 struct gcpro gcpro1
, gcpro2
;
772 /* "Bind" before-change-functions and after-change-functions
773 to nil--but in a way that errors don't know about.
774 That way, if there's an error in them, they will stay nil. */
775 before_change_functions
= Vbefore_change_functions
;
776 after_change_functions
= Vafter_change_functions
;
777 Vbefore_change_functions
= Qnil
;
778 Vafter_change_functions
= Qnil
;
779 GCPRO2 (before_change_functions
, after_change_functions
);
781 /* Actually run the hook functions. */
782 args
[0] = Qbefore_change_functions
;
785 run_hook_list_with_args (before_change_functions
, 3, args
);
787 /* "Unbind" the variables we "bound" to nil. */
788 Vbefore_change_functions
= before_change_functions
;
789 Vafter_change_functions
= after_change_functions
;
793 if (!NILP (current_buffer
->overlays_before
)
794 || !NILP (current_buffer
->overlays_after
))
795 report_overlay_modification (start
, end
, 0, start
, end
, Qnil
);
798 /* Signal a change immediately after it happens.
799 POS is the address of the start of the changed text.
800 LENDEL is the number of characters of the text before the change.
801 (Not the whole buffer; just the part that was changed.)
802 LENINS is the number of characters in the changed text.
804 (Hence POS + LENINS - LENDEL is the position after the changed text.) */
807 signal_after_change (pos
, lendel
, lenins
)
808 int pos
, lendel
, lenins
;
810 /* Run the after-change-function if any.
811 We don't bother "binding" this variable to nil
812 because it is obsolete anyway and new code should not use it. */
813 if (!NILP (Vafter_change_function
))
814 call3 (Vafter_change_function
,
815 make_number (pos
), make_number (pos
+ lenins
),
816 make_number (lendel
));
818 if (!NILP (Vafter_change_functions
))
821 Lisp_Object before_change_functions
;
822 Lisp_Object after_change_functions
;
823 struct gcpro gcpro1
, gcpro2
;
825 /* "Bind" before-change-functions and after-change-functions
826 to nil--but in a way that errors don't know about.
827 That way, if there's an error in them, they will stay nil. */
828 before_change_functions
= Vbefore_change_functions
;
829 after_change_functions
= Vafter_change_functions
;
830 Vbefore_change_functions
= Qnil
;
831 Vafter_change_functions
= Qnil
;
832 GCPRO2 (before_change_functions
, after_change_functions
);
834 /* Actually run the hook functions. */
835 args
[0] = Qafter_change_functions
;
836 XSETFASTINT (args
[1], pos
);
837 XSETFASTINT (args
[2], pos
+ lenins
);
838 XSETFASTINT (args
[3], lendel
);
839 run_hook_list_with_args (after_change_functions
,
842 /* "Unbind" the variables we "bound" to nil. */
843 Vbefore_change_functions
= before_change_functions
;
844 Vafter_change_functions
= after_change_functions
;
848 if (!NILP (current_buffer
->overlays_before
)
849 || !NILP (current_buffer
->overlays_after
))
850 report_overlay_modification (make_number (pos
),
851 make_number (pos
+ lenins
- lendel
),
853 make_number (pos
), make_number (pos
+ lenins
),
854 make_number (lendel
));