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 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! */
47 /* Move the gap to POS, which is less than the current GPT.
48 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
51 gap_left (pos
, newgap
)
55 register unsigned char *to
, *from
;
63 if (unchanged_modified
== MODIFF
)
66 end_unchanged
= Z
- pos
- 1;
70 if (Z
- GPT
< end_unchanged
)
71 end_unchanged
= Z
- GPT
;
72 if (pos
< beg_unchanged
)
82 /* Now copy the characters. To move the gap down,
83 copy characters up. */
87 /* I gets number of characters left to copy. */
91 /* If a quit is requested, stop copying now.
92 Change POS to be where we have actually moved the gap to. */
98 /* Move at most 32000 chars before checking again for a quit. */
103 /* bcopy is safe if the two areas of memory do not overlap
104 or on systems where bcopy is always safe for moving upward. */
105 && (BCOPY_UPWARD_SAFE
106 || to
- from
>= 128))
108 /* If overlap is not safe, avoid it by not moving too many
109 characters at once. */
110 if (!BCOPY_UPWARD_SAFE
&& i
> to
- from
)
125 /* Adjust markers, and buffer data structure, to put the gap at POS.
126 POS is where the loop above stopped, which may be what was specified
127 or may be where a quit was detected. */
128 adjust_markers (pos
+ 1, GPT
, GAP_SIZE
);
137 register unsigned char *to
, *from
;
143 if (unchanged_modified
== MODIFF
)
146 end_unchanged
= Z
- pos
- 1;
150 if (Z
- pos
- 1 < end_unchanged
)
151 end_unchanged
= Z
- pos
- 1;
152 if (GPT
- BEG
< beg_unchanged
)
153 beg_unchanged
= GPT
- BEG
;
161 /* Now copy the characters. To move the gap up,
162 copy characters down. */
166 /* I gets number of characters left to copy. */
170 /* If a quit is requested, stop copying now.
171 Change POS to be where we have actually moved the gap to. */
177 /* Move at most 32000 chars before checking again for a quit. */
182 /* bcopy is safe if the two areas of memory do not overlap
183 or on systems where bcopy is always safe for moving downward. */
184 && (BCOPY_DOWNWARD_SAFE
185 || from
- to
>= 128))
187 /* If overlap is not safe, avoid it by not moving too many
188 characters at once. */
189 if (!BCOPY_DOWNWARD_SAFE
&& i
> from
- to
)
204 adjust_markers (GPT
+ GAP_SIZE
, pos
+ 1 + GAP_SIZE
, - GAP_SIZE
);
209 /* Add `amount' to the position of every marker in the current buffer
210 whose current position is between `from' (exclusive) and `to' (inclusive).
211 Also, any markers past the outside of that interval, in the direction
212 of adjustment, are first moved back to the near end of the interval
213 and then adjusted by `amount'. */
216 adjust_markers (from
, to
, amount
)
217 register int from
, to
, amount
;
220 register struct Lisp_Marker
*m
;
223 marker
= current_buffer
->markers
;
225 while (!NILP (marker
))
227 m
= XMARKER (marker
);
231 if (mpos
> to
&& mpos
< to
+ amount
)
236 if (mpos
> from
+ amount
&& mpos
<= from
)
237 mpos
= from
+ amount
;
239 if (mpos
> from
&& mpos
<= to
)
246 /* Add the specified amount to point. This is used only when the value
247 of point changes due to an insert or delete; it does not represent
248 a conceptual change in point as a marker. In particular, point is
249 not crossing any interval boundaries, so there's no need to use the
250 usual SET_PT macro. In fact it would be incorrect to do so, because
251 either the old or the new value of point is out of synch with the
252 current set of intervals. */
254 adjust_point (amount
)
256 current_buffer
->text
.pt
+= amount
;
259 /* Make the gap INCREMENT characters longer. */
264 unsigned char *result
;
269 /* If we have to get more space, get enough to last a while. */
273 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
281 /* We can't unblock until the new address is properly stored. */
285 /* Prevent quitting in move_gap. */
290 old_gap_size
= GAP_SIZE
;
292 /* Call the newly allocated space a gap at the end of the whole space. */
294 GAP_SIZE
= increment
;
296 /* Move the new gap down to be consecutive with the end of the old one.
297 This adjusts the markers properly too. */
298 gap_left (real_gap_loc
+ old_gap_size
, 1);
300 /* Now combine the two into one large gap. */
301 GAP_SIZE
+= old_gap_size
;
307 /* Insert a string of specified length before point.
308 DO NOT use this for the contents of a Lisp string!
309 prepare_to_modify_buffer could relocate the string. */
311 insert (string
, length
)
312 register unsigned char *string
;
317 insert_1 (string
, length
, 0);
318 signal_after_change (PT
-length
, 0, length
);
322 insert_and_inherit (string
, length
)
323 register unsigned char *string
;
328 insert_1 (string
, length
, 1);
329 signal_after_change (PT
-length
, 0, length
);
334 insert_1 (string
, length
, inherit
)
335 register unsigned char *string
;
339 register Lisp_Object temp
;
341 /* Make sure point-max won't overflow after this insertion. */
342 XSETINT (temp
, length
+ Z
);
343 if (length
+ Z
!= XINT (temp
))
344 error ("maximum buffer size exceeded");
346 prepare_to_modify_buffer (PT
, PT
);
350 if (GAP_SIZE
< length
)
351 make_gap (length
- GAP_SIZE
);
353 record_insert (PT
, length
);
356 bcopy (string
, GPT_ADDR
, length
);
358 #ifdef USE_TEXT_PROPERTIES
359 if (current_buffer
->intervals
!= 0)
360 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
361 offset_intervals (current_buffer
, PT
, length
);
368 adjust_point (length
);
370 #ifdef USE_TEXT_PROPERTIES
371 if (!inherit
&& current_buffer
->intervals
!= 0)
372 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
377 /* Insert the part of the text of STRING, a Lisp object assumed to be
378 of type string, consisting of the LENGTH characters starting at
379 position POS. If the text of STRING has properties, they are absorbed
382 It does not work to use `insert' for this, because a GC could happen
383 before we bcopy the stuff into the buffer, and relocate the string
384 without insert noticing. */
386 insert_from_string (string
, pos
, length
, inherit
)
388 register int pos
, length
;
393 insert_from_string_1 (string
, pos
, length
, inherit
);
394 signal_after_change (PT
-length
, 0, length
);
399 insert_from_string_1 (string
, pos
, length
, inherit
)
401 register int pos
, length
;
404 register Lisp_Object temp
;
407 /* Make sure point-max won't overflow after this insertion. */
408 XSETINT (temp
, length
+ Z
);
409 if (length
+ Z
!= XINT (temp
))
410 error ("maximum buffer size exceeded");
413 prepare_to_modify_buffer (PT
, PT
);
417 if (GAP_SIZE
< length
)
418 make_gap (length
- GAP_SIZE
);
420 record_insert (PT
, length
);
424 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
426 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
427 offset_intervals (current_buffer
, PT
, length
);
434 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
435 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
436 current_buffer
, inherit
);
438 adjust_point (length
);
441 /* Insert the character C before point */
450 /* Insert the null-terminated string S before point */
456 insert (s
, strlen (s
));
459 /* Like `insert' except that all markers pointing at the place where
460 the insertion happens are adjusted to point after it.
461 Don't use this function to insert part of a Lisp string,
462 since gc could happen and relocate it. */
464 insert_before_markers (string
, length
)
465 unsigned char *string
;
470 register int opoint
= PT
;
471 insert_1 (string
, length
, 0);
472 adjust_markers (opoint
- 1, opoint
, length
);
473 signal_after_change (PT
-length
, 0, length
);
477 insert_before_markers_and_inherit (string
, length
)
478 unsigned char *string
;
483 register int opoint
= PT
;
484 insert_1 (string
, length
, 1);
485 adjust_markers (opoint
- 1, opoint
, length
);
486 signal_after_change (PT
-length
, 0, length
);
490 /* Insert part of a Lisp string, relocating markers after. */
492 insert_from_string_before_markers (string
, pos
, length
, inherit
)
494 register int pos
, length
;
499 register int opoint
= PT
;
500 insert_from_string_1 (string
, pos
, length
, inherit
);
501 adjust_markers (opoint
- 1, opoint
, length
);
502 signal_after_change (PT
-length
, 0, length
);
506 /* Delete characters in current buffer
507 from FROM up to (but not including) TO. */
510 register int from
, to
;
512 return del_range_1 (from
, to
, 1);
515 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
517 del_range_1 (from
, to
, prepare
)
518 register int from
, to
, prepare
;
522 /* Make args be valid */
528 if ((numdel
= to
- from
) <= 0)
531 /* Make sure the gap is somewhere in or next to what we are deleting. */
538 prepare_to_modify_buffer (from
, to
);
540 record_delete (from
, numdel
);
543 /* Relocate point as if it were a marker. */
545 adjust_point (from
- (PT
< to
? PT
: to
));
547 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
548 offset_intervals (current_buffer
, from
, - numdel
);
550 /* Relocate all markers pointing into the new, larger gap
551 to point at the end of the text before the gap. */
552 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
559 if (GPT
- BEG
< beg_unchanged
)
560 beg_unchanged
= GPT
- BEG
;
561 if (Z
- GPT
< end_unchanged
)
562 end_unchanged
= Z
- GPT
;
564 evaporate_overlays (from
);
565 signal_after_change (from
, numdel
, 0);
568 /* Call this if you're about to change the region of BUFFER from START
569 to END. This checks the read-only properties of the region, calls
570 the necessary modification hooks, and warns the next redisplay that
571 it should pay attention to that area. */
572 modify_region (buffer
, start
, end
)
573 struct buffer
*buffer
;
576 struct buffer
*old_buffer
= current_buffer
;
578 if (buffer
!= old_buffer
)
579 set_buffer_internal (buffer
);
581 prepare_to_modify_buffer (start
, end
);
583 if (start
- 1 < beg_unchanged
|| unchanged_modified
== MODIFF
)
584 beg_unchanged
= start
- 1;
585 if (Z
- end
< end_unchanged
586 || unchanged_modified
== MODIFF
)
587 end_unchanged
= Z
- end
;
589 if (MODIFF
<= current_buffer
->save_modified
)
590 record_first_change ();
593 if (buffer
!= old_buffer
)
594 set_buffer_internal (old_buffer
);
597 /* Check that it is okay to modify the buffer between START and END.
598 Run the before-change-function, if any. If intervals are in use,
599 verify that the text to be modified is not read-only, and call
600 any modification properties the text may have. */
602 prepare_to_modify_buffer (start
, end
)
603 Lisp_Object start
, end
;
605 if (!NILP (current_buffer
->read_only
))
606 Fbarf_if_buffer_read_only ();
608 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
609 if (current_buffer
->intervals
!= 0)
610 verify_interval_modification (current_buffer
, start
, end
);
612 if (!NILP (current_buffer
->overlays_before
)
613 || !NILP (current_buffer
->overlays_after
))
614 verify_overlay_modification (start
, end
);
616 #ifdef CLASH_DETECTION
617 if (!NILP (current_buffer
->filename
)
618 && current_buffer
->save_modified
>= MODIFF
)
619 lock_file (current_buffer
->filename
);
621 /* At least warn if this file has changed on disk since it was visited. */
622 if (!NILP (current_buffer
->filename
)
623 && current_buffer
->save_modified
>= MODIFF
624 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
625 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
626 call1 (intern ("ask-user-about-supersession-threat"),
627 current_buffer
->filename
);
628 #endif /* not CLASH_DETECTION */
630 signal_before_change (start
, end
);
632 if (current_buffer
->newline_cache
)
633 invalidate_region_cache (current_buffer
,
634 current_buffer
->newline_cache
,
635 start
- BEG
, Z
- end
);
636 if (current_buffer
->width_run_cache
)
637 invalidate_region_cache (current_buffer
,
638 current_buffer
->width_run_cache
,
639 start
- BEG
, Z
- end
);
641 Vdeactivate_mark
= Qt
;
645 before_change_function_restore (value
)
648 Vbefore_change_function
= value
;
652 after_change_function_restore (value
)
655 Vafter_change_function
= value
;
659 before_change_functions_restore (value
)
662 Vbefore_change_functions
= value
;
666 after_change_functions_restore (value
)
669 Vafter_change_functions
= value
;
672 /* Signal a change to the buffer immediately before it happens.
673 START and END are the bounds of the text to be changed,
676 signal_before_change (start
, end
)
677 Lisp_Object start
, end
;
679 /* If buffer is unmodified, run a special hook for that case. */
680 if (current_buffer
->save_modified
>= MODIFF
681 && !NILP (Vfirst_change_hook
)
682 && !NILP (Vrun_hooks
))
683 call1 (Vrun_hooks
, Qfirst_change_hook
);
685 /* Now in any case run the before-change-function if any. */
686 if (!NILP (Vbefore_change_function
))
688 int count
= specpdl_ptr
- specpdl
;
689 Lisp_Object function
;
691 function
= Vbefore_change_function
;
693 record_unwind_protect (after_change_function_restore
,
694 Vafter_change_function
);
695 record_unwind_protect (before_change_function_restore
,
696 Vbefore_change_function
);
697 record_unwind_protect (after_change_functions_restore
,
698 Vafter_change_functions
);
699 record_unwind_protect (before_change_functions_restore
,
700 Vbefore_change_functions
);
701 Vafter_change_function
= Qnil
;
702 Vbefore_change_function
= Qnil
;
703 Vafter_change_functions
= Qnil
;
704 Vbefore_change_functions
= Qnil
;
706 call2 (function
, start
, end
);
707 unbind_to (count
, Qnil
);
710 /* Now in any case run the before-change-function if any. */
711 if (!NILP (Vbefore_change_functions
))
713 int count
= specpdl_ptr
- specpdl
;
714 Lisp_Object functions
;
716 functions
= Vbefore_change_functions
;
718 record_unwind_protect (after_change_function_restore
,
719 Vafter_change_function
);
720 record_unwind_protect (before_change_function_restore
,
721 Vbefore_change_function
);
722 record_unwind_protect (after_change_functions_restore
,
723 Vafter_change_functions
);
724 record_unwind_protect (before_change_functions_restore
,
725 Vbefore_change_functions
);
726 Vafter_change_function
= Qnil
;
727 Vbefore_change_function
= Qnil
;
728 Vafter_change_functions
= Qnil
;
729 Vbefore_change_functions
= Qnil
;
731 while (CONSP (functions
))
733 call2 (XCONS (functions
)->car
, start
, end
);
734 functions
= XCONS (functions
)->cdr
;
736 unbind_to (count
, Qnil
);
740 /* Signal a change immediately after it happens.
741 POS is the address of the start of the changed text.
742 LENDEL is the number of characters of the text before the change.
743 (Not the whole buffer; just the part that was changed.)
744 LENINS is the number of characters in the changed text. */
746 signal_after_change (pos
, lendel
, lenins
)
747 int pos
, lendel
, lenins
;
749 if (!NILP (Vafter_change_function
))
751 int count
= specpdl_ptr
- specpdl
;
752 Lisp_Object function
;
753 function
= Vafter_change_function
;
755 record_unwind_protect (after_change_function_restore
,
756 Vafter_change_function
);
757 record_unwind_protect (before_change_function_restore
,
758 Vbefore_change_function
);
759 record_unwind_protect (after_change_functions_restore
,
760 Vafter_change_functions
);
761 record_unwind_protect (before_change_functions_restore
,
762 Vbefore_change_functions
);
763 Vafter_change_function
= Qnil
;
764 Vbefore_change_function
= Qnil
;
765 Vafter_change_functions
= Qnil
;
766 Vbefore_change_functions
= Qnil
;
768 call3 (function
, make_number (pos
), make_number (pos
+ lenins
),
769 make_number (lendel
));
770 unbind_to (count
, Qnil
);
772 if (!NILP (Vafter_change_functions
))
774 int count
= specpdl_ptr
- specpdl
;
775 Lisp_Object functions
;
776 functions
= Vafter_change_functions
;
778 record_unwind_protect (after_change_function_restore
,
779 Vafter_change_function
);
780 record_unwind_protect (before_change_function_restore
,
781 Vbefore_change_function
);
782 record_unwind_protect (after_change_functions_restore
,
783 Vafter_change_functions
);
784 record_unwind_protect (before_change_functions_restore
,
785 Vbefore_change_functions
);
786 Vafter_change_function
= Qnil
;
787 Vbefore_change_function
= Qnil
;
788 Vafter_change_functions
= Qnil
;
789 Vbefore_change_functions
= Qnil
;
791 while (CONSP (functions
))
793 call3 (XCONS (functions
)->car
,
794 make_number (pos
), make_number (pos
+ lenins
),
795 make_number (lendel
));
796 functions
= XCONS (functions
)->cdr
;
798 unbind_to (count
, Qnil
);