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).
215 Also, any markers past the outside of that interval, in the direction
216 of adjustment, are first moved back to the near end of the interval
217 and then adjusted by `amount'. */
220 adjust_markers (from
, to
, amount
)
221 register int from
, to
, amount
;
224 register struct Lisp_Marker
*m
;
227 marker
= BUF_MARKERS (current_buffer
);
229 while (!NILP (marker
))
231 m
= XMARKER (marker
);
235 if (mpos
> to
&& mpos
< to
+ amount
)
240 if (mpos
> from
+ amount
&& mpos
<= from
)
241 mpos
= from
+ amount
;
243 if (mpos
> from
&& mpos
<= to
)
250 /* Adjust markers whose insertion-type is t
251 for an insertion of AMOUNT characters at POS. */
254 adjust_markers_for_insert (pos
, amount
)
255 register int pos
, amount
;
259 marker
= BUF_MARKERS (current_buffer
);
261 while (!NILP (marker
))
263 register struct Lisp_Marker
*m
= XMARKER (marker
);
264 if (m
->insertion_type
&& m
->bufpos
== pos
)
270 /* Add the specified amount to point. This is used only when the value
271 of point changes due to an insert or delete; it does not represent
272 a conceptual change in point as a marker. In particular, point is
273 not crossing any interval boundaries, so there's no need to use the
274 usual SET_PT macro. In fact it would be incorrect to do so, because
275 either the old or the new value of point is out of sync with the
276 current set of intervals. */
278 adjust_point (amount
)
281 BUF_PT (current_buffer
) += amount
;
284 /* Make the gap INCREMENT characters longer. */
290 unsigned char *result
;
295 /* If we have to get more space, get enough to last a while. */
298 /* Don't allow a buffer size that won't fit in an int
299 even if it will fit in a Lisp integer.
300 That won't work because so many places use `int'. */
302 if (Z
- BEG
+ GAP_SIZE
+ increment
303 >= ((unsigned) 1 << (min (BITS_PER_INT
, VALBITS
) - 1)))
304 error ("Buffer exceeds maximum size");
307 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
315 /* We can't unblock until the new address is properly stored. */
319 /* Prevent quitting in move_gap. */
324 old_gap_size
= GAP_SIZE
;
326 /* Call the newly allocated space a gap at the end of the whole space. */
328 GAP_SIZE
= increment
;
330 /* Move the new gap down to be consecutive with the end of the old one.
331 This adjusts the markers properly too. */
332 gap_left (real_gap_loc
+ old_gap_size
, 1);
334 /* Now combine the two into one large gap. */
335 GAP_SIZE
+= old_gap_size
;
341 /* Insert a string of specified length before point.
342 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
343 prepare_to_modify_buffer could relocate the text. */
346 insert (string
, length
)
347 register unsigned char *string
;
352 insert_1 (string
, length
, 0, 1);
353 signal_after_change (PT
-length
, 0, length
);
358 insert_and_inherit (string
, length
)
359 register unsigned char *string
;
364 insert_1 (string
, length
, 1, 1);
365 signal_after_change (PT
-length
, 0, length
);
370 insert_1 (string
, length
, inherit
, prepare
)
371 register unsigned char *string
;
373 int inherit
, prepare
;
375 register Lisp_Object temp
;
378 prepare_to_modify_buffer (PT
, PT
);
382 if (GAP_SIZE
< length
)
383 make_gap (length
- GAP_SIZE
);
385 record_insert (PT
, length
);
388 bcopy (string
, GPT_ADDR
, length
);
390 #ifdef USE_TEXT_PROPERTIES
391 if (BUF_INTERVALS (current_buffer
) != 0)
392 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
393 offset_intervals (current_buffer
, PT
, length
);
400 adjust_overlays_for_insert (PT
, length
);
401 adjust_markers_for_insert (PT
, length
);
402 adjust_point (length
);
404 #ifdef USE_TEXT_PROPERTIES
405 if (!inherit
&& BUF_INTERVALS (current_buffer
) != 0)
406 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
411 /* Insert the part of the text of STRING, a Lisp object assumed to be
412 of type string, consisting of the LENGTH characters starting at
413 position POS. If the text of STRING has properties, they are absorbed
416 It does not work to use `insert' for this, because a GC could happen
417 before we bcopy the stuff into the buffer, and relocate the string
418 without insert noticing. */
421 insert_from_string (string
, pos
, length
, inherit
)
423 register int pos
, length
;
428 insert_from_string_1 (string
, pos
, length
, inherit
);
429 signal_after_change (PT
-length
, 0, length
);
434 insert_from_string_1 (string
, pos
, length
, inherit
)
436 register int pos
, length
;
439 register Lisp_Object temp
;
442 /* Make sure point-max won't overflow after this insertion. */
443 XSETINT (temp
, length
+ Z
);
444 if (length
+ Z
!= XINT (temp
))
445 error ("maximum buffer size exceeded");
448 prepare_to_modify_buffer (PT
, PT
);
452 if (GAP_SIZE
< length
)
453 make_gap (length
- GAP_SIZE
);
455 record_insert (PT
, length
);
459 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
461 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
462 offset_intervals (current_buffer
, PT
, length
);
468 adjust_overlays_for_insert (PT
, length
);
469 adjust_markers_for_insert (PT
, length
);
471 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
472 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
473 current_buffer
, inherit
);
475 adjust_point (length
);
478 /* Insert text from BUF, starting at POS and having length LENGTH, into the
479 current buffer. If the text in BUF has properties, they are absorbed
480 into the current buffer.
482 It does not work to use `insert' for this, because a malloc could happen
483 and relocate BUF's text before the bcopy happens. */
486 insert_from_buffer (buf
, pos
, length
, inherit
)
493 insert_from_buffer_1 (buf
, pos
, length
, inherit
);
494 signal_after_change (PT
-length
, 0, length
);
499 insert_from_buffer_1 (buf
, pos
, length
, inherit
)
504 register Lisp_Object temp
;
507 /* Make sure point-max won't overflow after this insertion. */
508 XSETINT (temp
, length
+ Z
);
509 if (length
+ Z
!= XINT (temp
))
510 error ("maximum buffer size exceeded");
512 prepare_to_modify_buffer (PT
, PT
);
516 if (GAP_SIZE
< length
)
517 make_gap (length
- GAP_SIZE
);
519 record_insert (PT
, length
);
522 if (pos
< BUF_GPT (buf
))
524 chunk
= BUF_GPT (buf
) - pos
;
527 bcopy (BUF_CHAR_ADDRESS (buf
, pos
), GPT_ADDR
, chunk
);
532 bcopy (BUF_CHAR_ADDRESS (buf
, pos
+ chunk
),
533 GPT_ADDR
+ chunk
, length
- chunk
);
535 #ifdef USE_TEXT_PROPERTIES
536 if (BUF_INTERVALS (current_buffer
) != 0)
537 offset_intervals (current_buffer
, PT
, length
);
544 adjust_overlays_for_insert (PT
, length
);
545 adjust_markers_for_insert (PT
, length
);
546 adjust_point (length
);
548 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
549 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf
),
551 PT
- length
, length
, current_buffer
, inherit
);
554 /* Insert the character C before point */
563 /* Insert the null-terminated string S before point */
569 insert (s
, strlen (s
));
572 /* Like `insert' except that all markers pointing at the place where
573 the insertion happens are adjusted to point after it.
574 Don't use this function to insert part of a Lisp string,
575 since gc could happen and relocate it. */
578 insert_before_markers (string
, length
)
579 unsigned char *string
;
584 register int opoint
= PT
;
585 insert_1 (string
, length
, 0, 1);
586 adjust_markers (opoint
- 1, opoint
, length
);
587 signal_after_change (PT
-length
, 0, length
);
592 insert_before_markers_and_inherit (string
, length
)
593 unsigned char *string
;
598 register int opoint
= PT
;
599 insert_1 (string
, length
, 1, 1);
600 adjust_markers (opoint
- 1, opoint
, length
);
601 signal_after_change (PT
-length
, 0, length
);
605 /* Insert part of a Lisp string, relocating markers after. */
608 insert_from_string_before_markers (string
, pos
, length
, inherit
)
610 register int pos
, length
;
615 register int opoint
= PT
;
616 insert_from_string_1 (string
, pos
, length
, inherit
);
617 adjust_markers (opoint
- 1, opoint
, length
);
618 signal_after_change (PT
-length
, 0, length
);
622 /* Delete characters in current buffer
623 from FROM up to (but not including) TO. */
627 register int from
, to
;
629 del_range_1 (from
, to
, 1);
632 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
635 del_range_1 (from
, to
, prepare
)
636 register int from
, to
, prepare
;
640 /* Make args be valid */
646 if ((numdel
= to
- from
) <= 0)
649 /* Make sure the gap is somewhere in or next to what we are deleting. */
656 prepare_to_modify_buffer (from
, to
);
658 record_delete (from
, numdel
);
661 /* Relocate point as if it were a marker. */
663 adjust_point (from
- (PT
< to
? PT
: to
));
665 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
666 offset_intervals (current_buffer
, from
, - numdel
);
668 /* Relocate all markers pointing into the new, larger gap
669 to point at the end of the text before the gap. */
670 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
672 /* Adjust the overlay center as needed. This must be done after
673 adjusting the markers that bound the overlays. */
674 adjust_overlays_for_delete (from
, numdel
);
681 if (GPT
- BEG
< beg_unchanged
)
682 beg_unchanged
= GPT
- BEG
;
683 if (Z
- GPT
< end_unchanged
)
684 end_unchanged
= Z
- GPT
;
686 evaporate_overlays (from
);
687 signal_after_change (from
, numdel
, 0);
690 /* Call this if you're about to change the region of BUFFER from START
691 to END. This checks the read-only properties of the region, calls
692 the necessary modification hooks, and warns the next redisplay that
693 it should pay attention to that area. */
695 modify_region (buffer
, start
, end
)
696 struct buffer
*buffer
;
699 struct buffer
*old_buffer
= current_buffer
;
701 if (buffer
!= old_buffer
)
702 set_buffer_internal (buffer
);
704 prepare_to_modify_buffer (start
, end
);
706 if (start
- 1 < beg_unchanged
|| unchanged_modified
== MODIFF
)
707 beg_unchanged
= start
- 1;
708 if (Z
- end
< end_unchanged
709 || unchanged_modified
== MODIFF
)
710 end_unchanged
= Z
- end
;
712 if (MODIFF
<= SAVE_MODIFF
)
713 record_first_change ();
716 buffer
->point_before_scroll
= Qnil
;
718 if (buffer
!= old_buffer
)
719 set_buffer_internal (old_buffer
);
722 /* Check that it is okay to modify the buffer between START and END.
723 Run the before-change-function, if any. If intervals are in use,
724 verify that the text to be modified is not read-only, and call
725 any modification properties the text may have. */
728 prepare_to_modify_buffer (start
, end
)
729 Lisp_Object start
, end
;
731 if (!NILP (current_buffer
->read_only
))
732 Fbarf_if_buffer_read_only ();
734 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
735 if (BUF_INTERVALS (current_buffer
) != 0)
736 verify_interval_modification (current_buffer
, start
, end
);
738 #ifdef CLASH_DETECTION
739 if (!NILP (current_buffer
->file_truename
)
740 /* Make binding buffer-file-name to nil effective. */
741 && !NILP (current_buffer
->filename
)
742 && SAVE_MODIFF
>= MODIFF
)
743 lock_file (current_buffer
->file_truename
);
745 /* At least warn if this file has changed on disk since it was visited. */
746 if (!NILP (current_buffer
->filename
)
747 && SAVE_MODIFF
>= MODIFF
748 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
749 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
750 call1 (intern ("ask-user-about-supersession-threat"),
751 current_buffer
->filename
);
752 #endif /* not CLASH_DETECTION */
754 signal_before_change (start
, end
);
756 if (current_buffer
->newline_cache
)
757 invalidate_region_cache (current_buffer
,
758 current_buffer
->newline_cache
,
759 start
- BEG
, Z
- end
);
760 if (current_buffer
->width_run_cache
)
761 invalidate_region_cache (current_buffer
,
762 current_buffer
->width_run_cache
,
763 start
- BEG
, Z
- end
);
765 Vdeactivate_mark
= Qt
;
768 /* Signal a change to the buffer immediately before it happens.
769 START and END are the bounds of the text to be changed,
773 signal_before_change (start
, end
)
774 Lisp_Object start
, end
;
776 /* If buffer is unmodified, run a special hook for that case. */
777 if (SAVE_MODIFF
>= MODIFF
778 && !NILP (Vfirst_change_hook
)
779 && !NILP (Vrun_hooks
))
780 call1 (Vrun_hooks
, Qfirst_change_hook
);
782 /* Run the before-change-function if any.
783 We don't bother "binding" this variable to nil
784 because it is obsolete anyway and new code should not use it. */
785 if (!NILP (Vbefore_change_function
))
786 call2 (Vbefore_change_function
, start
, end
);
788 /* Now run the before-change-functions if any. */
789 if (!NILP (Vbefore_change_functions
))
792 Lisp_Object before_change_functions
;
793 Lisp_Object after_change_functions
;
794 struct gcpro gcpro1
, gcpro2
;
796 /* "Bind" before-change-functions and after-change-functions
797 to nil--but in a way that errors don't know about.
798 That way, if there's an error in them, they will stay nil. */
799 before_change_functions
= Vbefore_change_functions
;
800 after_change_functions
= Vafter_change_functions
;
801 Vbefore_change_functions
= Qnil
;
802 Vafter_change_functions
= Qnil
;
803 GCPRO2 (before_change_functions
, after_change_functions
);
805 /* Actually run the hook functions. */
806 args
[0] = Qbefore_change_functions
;
809 run_hook_list_with_args (before_change_functions
, 3, args
);
811 /* "Unbind" the variables we "bound" to nil. */
812 Vbefore_change_functions
= before_change_functions
;
813 Vafter_change_functions
= after_change_functions
;
817 if (!NILP (current_buffer
->overlays_before
)
818 || !NILP (current_buffer
->overlays_after
))
819 report_overlay_modification (start
, end
, 0, start
, end
, Qnil
);
822 /* Signal a change immediately after it happens.
823 POS is the address of the start of the changed text.
824 LENDEL is the number of characters of the text before the change.
825 (Not the whole buffer; just the part that was changed.)
826 LENINS is the number of characters in the changed text.
828 (Hence POS + LENINS - LENDEL is the position after the changed text.) */
831 signal_after_change (pos
, lendel
, lenins
)
832 int pos
, lendel
, lenins
;
834 /* Run the after-change-function if any.
835 We don't bother "binding" this variable to nil
836 because it is obsolete anyway and new code should not use it. */
837 if (!NILP (Vafter_change_function
))
838 call3 (Vafter_change_function
,
839 make_number (pos
), make_number (pos
+ lenins
),
840 make_number (lendel
));
842 if (!NILP (Vafter_change_functions
))
845 Lisp_Object before_change_functions
;
846 Lisp_Object after_change_functions
;
847 struct gcpro gcpro1
, gcpro2
;
849 /* "Bind" before-change-functions and after-change-functions
850 to nil--but in a way that errors don't know about.
851 That way, if there's an error in them, they will stay nil. */
852 before_change_functions
= Vbefore_change_functions
;
853 after_change_functions
= Vafter_change_functions
;
854 Vbefore_change_functions
= Qnil
;
855 Vafter_change_functions
= Qnil
;
856 GCPRO2 (before_change_functions
, after_change_functions
);
858 /* Actually run the hook functions. */
859 args
[0] = Qafter_change_functions
;
860 XSETFASTINT (args
[1], pos
);
861 XSETFASTINT (args
[2], pos
+ lenins
);
862 XSETFASTINT (args
[3], lendel
);
863 run_hook_list_with_args (after_change_functions
,
866 /* "Unbind" the variables we "bound" to nil. */
867 Vbefore_change_functions
= before_change_functions
;
868 Vafter_change_functions
= after_change_functions
;
872 if (!NILP (current_buffer
->overlays_before
)
873 || !NILP (current_buffer
->overlays_after
))
874 report_overlay_modification (make_number (pos
),
875 make_number (pos
+ lenins
- lendel
),
877 make_number (pos
), make_number (pos
+ lenins
),
878 make_number (lendel
));
880 /* After an insertion, call the text properties
881 insert-behind-hooks or insert-in-front-hooks. */
883 report_interval_modification (pos
, pos
+ lenins
);