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"
28 #include "blockinput.h"
34 #define min(x, y) ((x) < (y) ? (x) : (y))
36 static void insert_from_string_1 ();
37 static void insert_from_buffer_1 ();
38 static void gap_left ();
39 static void gap_right ();
40 static void adjust_markers ();
41 static void adjust_point ();
43 Lisp_Object
Fcombine_after_change_execute ();
45 /* Non-nil means don't call the after-change-functions right away,
46 just record an element in Vcombine_after_change_calls_list. */
47 Lisp_Object Vcombine_after_change_calls
;
49 /* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
50 describing changes which happened while combine_after_change_calls
51 was nonzero. We use this to decide how to call them
52 once the deferral ends.
55 BEG-UNCHANGED is the number of chars before the changed range.
56 END-UNCHANGED is the number of chars after the changed range,
57 and CHANGE-AMOUNT is the number of characters inserted by the change
58 (negative for a deletion). */
59 Lisp_Object combine_after_change_list
;
61 /* Buffer which combine_after_change_list is about. */
62 Lisp_Object combine_after_change_buffer
;
64 /* Move gap to position `pos'.
65 Note that this can quit! */
77 /* Move the gap to POS, which is less than the current GPT.
78 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
81 gap_left (pos
, newgap
)
85 register unsigned char *to
, *from
;
93 if (unchanged_modified
== MODIFF
94 && overlay_unchanged_modified
== OVERLAY_MODIFF
)
97 end_unchanged
= Z
- pos
- 1;
101 if (Z
- GPT
< end_unchanged
)
102 end_unchanged
= Z
- GPT
;
103 if (pos
< beg_unchanged
)
113 /* Now copy the characters. To move the gap down,
114 copy characters up. */
118 /* I gets number of characters left to copy. */
122 /* If a quit is requested, stop copying now.
123 Change POS to be where we have actually moved the gap to. */
129 /* Move at most 32000 chars before checking again for a quit. */
134 /* bcopy is safe if the two areas of memory do not overlap
135 or on systems where bcopy is always safe for moving upward. */
136 && (BCOPY_UPWARD_SAFE
137 || to
- from
>= 128))
139 /* If overlap is not safe, avoid it by not moving too many
140 characters at once. */
141 if (!BCOPY_UPWARD_SAFE
&& i
> to
- from
)
156 /* Adjust markers, and buffer data structure, to put the gap at POS.
157 POS is where the loop above stopped, which may be what was specified
158 or may be where a quit was detected. */
159 adjust_markers (pos
+ 1, GPT
, GAP_SIZE
);
161 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
169 register unsigned char *to
, *from
;
175 if (unchanged_modified
== MODIFF
176 && overlay_unchanged_modified
== OVERLAY_MODIFF
)
180 end_unchanged
= Z
- pos
- 1;
184 if (Z
- pos
- 1 < end_unchanged
)
185 end_unchanged
= Z
- pos
- 1;
186 if (GPT
- BEG
< beg_unchanged
)
187 beg_unchanged
= GPT
- BEG
;
195 /* Now copy the characters. To move the gap up,
196 copy characters down. */
200 /* I gets number of characters left to copy. */
204 /* If a quit is requested, stop copying now.
205 Change POS to be where we have actually moved the gap to. */
211 /* Move at most 32000 chars before checking again for a quit. */
216 /* bcopy is safe if the two areas of memory do not overlap
217 or on systems where bcopy is always safe for moving downward. */
218 && (BCOPY_DOWNWARD_SAFE
219 || from
- to
>= 128))
221 /* If overlap is not safe, avoid it by not moving too many
222 characters at once. */
223 if (!BCOPY_DOWNWARD_SAFE
&& i
> from
- to
)
238 adjust_markers (GPT
+ GAP_SIZE
, pos
+ 1 + GAP_SIZE
, - GAP_SIZE
);
240 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
244 /* Add AMOUNT to the position of every marker in the current buffer
245 whose current position is between FROM (exclusive) and TO (inclusive).
247 Also, any markers past the outside of that interval, in the direction
248 of adjustment, are first moved back to the near end of the interval
249 and then adjusted by AMOUNT.
251 When the latter adjustment is done, if AMOUNT is negative,
252 we record the adjustment for undo. (This case happens only for
256 adjust_markers (from
, to
, amount
)
257 register int from
, to
, amount
;
260 register struct Lisp_Marker
*m
;
263 marker
= BUF_MARKERS (current_buffer
);
265 while (!NILP (marker
))
267 m
= XMARKER (marker
);
271 if (mpos
> to
&& mpos
< to
+ amount
)
276 /* Here's the case where a marker is inside text being deleted.
277 AMOUNT can be negative for gap motion, too,
278 but then this range contains no markers. */
279 if (mpos
> from
+ amount
&& mpos
<= from
)
282 int after
= from
+ amount
;
286 /* Compute the before and after positions
287 as buffer positions. */
288 if (before
> GPT
+ GAP_SIZE
)
290 else if (before
> GPT
)
293 if (after
> GPT
+ GAP_SIZE
)
295 else if (after
> GPT
)
298 record_marker_adjustment (marker
, after
- before
);
301 if (mpos
> from
&& mpos
<= to
)
308 /* Adjust markers whose insertion-type is t
309 for an insertion of AMOUNT characters at POS. */
312 adjust_markers_for_insert (pos
, amount
)
313 register int pos
, amount
;
318 marker
= BUF_MARKERS (current_buffer
);
320 while (!NILP (marker
))
322 register struct Lisp_Marker
*m
= XMARKER (marker
);
323 if (m
->insertion_type
&& m
->bufpos
== pos
)
331 /* Adjusting only markers whose insertion-type is t may result in
332 disordered overlays in the slot `overlays_before'. */
333 fix_overlays_before (current_buffer
, pos
, pos
+ amount
);
336 /* Add the specified amount to point. This is used only when the value
337 of point changes due to an insert or delete; it does not represent
338 a conceptual change in point as a marker. In particular, point is
339 not crossing any interval boundaries, so there's no need to use the
340 usual SET_PT macro. In fact it would be incorrect to do so, because
341 either the old or the new value of point is out of sync with the
342 current set of intervals. */
344 adjust_point (amount
)
347 BUF_PT (current_buffer
) += amount
;
350 /* Make the gap INCREMENT characters longer. */
356 unsigned char *result
;
361 /* If we have to get more space, get enough to last a while. */
364 /* Don't allow a buffer size that won't fit in an int
365 even if it will fit in a Lisp integer.
366 That won't work because so many places use `int'. */
368 if (Z
- BEG
+ GAP_SIZE
+ increment
369 >= ((unsigned) 1 << (min (BITS_PER_INT
, VALBITS
) - 1)))
370 error ("Buffer exceeds maximum size");
373 /* We allocate extra 1-byte `\0' at the tail for anchoring a search. */
374 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
+ 1));
382 /* We can't unblock until the new address is properly stored. */
386 /* Prevent quitting in move_gap. */
391 old_gap_size
= GAP_SIZE
;
393 /* Call the newly allocated space a gap at the end of the whole space. */
395 GAP_SIZE
= increment
;
397 /* Move the new gap down to be consecutive with the end of the old one.
398 This adjusts the markers properly too. */
399 gap_left (real_gap_loc
+ old_gap_size
, 1);
401 /* Now combine the two into one large gap. */
402 GAP_SIZE
+= old_gap_size
;
411 /* Insert a string of specified length before point.
412 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
413 prepare_to_modify_buffer could relocate the text. */
416 insert (string
, length
)
417 register unsigned char *string
;
422 insert_1 (string
, length
, 0, 1);
423 signal_after_change (PT
-length
, 0, length
);
428 insert_and_inherit (string
, length
)
429 register unsigned char *string
;
434 insert_1 (string
, length
, 1, 1);
435 signal_after_change (PT
-length
, 0, length
);
440 insert_1 (string
, length
, inherit
, prepare
)
441 register unsigned char *string
;
443 int inherit
, prepare
;
445 register Lisp_Object temp
;
448 prepare_to_modify_buffer (PT
, PT
, NULL
);
452 if (GAP_SIZE
< length
)
453 make_gap (length
- GAP_SIZE
);
455 record_insert (PT
, length
);
458 bcopy (string
, GPT_ADDR
, length
);
460 #ifdef USE_TEXT_PROPERTIES
461 if (BUF_INTERVALS (current_buffer
) != 0)
462 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
463 offset_intervals (current_buffer
, PT
, length
);
470 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
471 adjust_overlays_for_insert (PT
, length
);
472 adjust_markers_for_insert (PT
, length
);
473 adjust_point (length
);
475 #ifdef USE_TEXT_PROPERTIES
476 if (!inherit
&& BUF_INTERVALS (current_buffer
) != 0)
477 Fset_text_properties (make_number (PT
- length
), make_number (PT
),
482 /* Insert the part of the text of STRING, a Lisp object assumed to be
483 of type string, consisting of the LENGTH characters starting at
484 position POS. If the text of STRING has properties, they are absorbed
487 It does not work to use `insert' for this, because a GC could happen
488 before we bcopy the stuff into the buffer, and relocate the string
489 without insert noticing. */
492 insert_from_string (string
, pos
, length
, inherit
)
494 register int pos
, length
;
499 insert_from_string_1 (string
, pos
, length
, inherit
);
500 signal_after_change (PT
-length
, 0, length
);
505 insert_from_string_1 (string
, pos
, length
, inherit
)
507 register int pos
, length
;
510 register Lisp_Object temp
;
513 /* Make sure point-max won't overflow after this insertion. */
514 XSETINT (temp
, length
+ Z
);
515 if (length
+ Z
!= XINT (temp
))
516 error ("maximum buffer size exceeded");
519 prepare_to_modify_buffer (PT
, PT
, NULL
);
523 if (GAP_SIZE
< length
)
524 make_gap (length
- GAP_SIZE
);
526 record_insert (PT
, length
);
530 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
532 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
533 offset_intervals (current_buffer
, PT
, length
);
539 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
540 adjust_overlays_for_insert (PT
, length
);
541 adjust_markers_for_insert (PT
, length
);
543 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
544 graft_intervals_into_buffer (XSTRING (string
)->intervals
, PT
, length
,
545 current_buffer
, inherit
);
547 adjust_point (length
);
550 /* Insert text from BUF, starting at POS and having length LENGTH, into the
551 current buffer. If the text in BUF has properties, they are absorbed
552 into the current buffer.
554 It does not work to use `insert' for this, because a malloc could happen
555 and relocate BUF's text before the bcopy happens. */
558 insert_from_buffer (buf
, pos
, length
, inherit
)
565 insert_from_buffer_1 (buf
, pos
, length
, inherit
);
566 signal_after_change (PT
-length
, 0, length
);
571 insert_from_buffer_1 (buf
, pos
, length
, inherit
)
576 register Lisp_Object temp
;
579 /* Make sure point-max won't overflow after this insertion. */
580 XSETINT (temp
, length
+ Z
);
581 if (length
+ Z
!= XINT (temp
))
582 error ("maximum buffer size exceeded");
584 prepare_to_modify_buffer (PT
, PT
, NULL
);
588 if (GAP_SIZE
< length
)
589 make_gap (length
- GAP_SIZE
);
591 record_insert (PT
, length
);
594 if (pos
< BUF_GPT (buf
))
596 chunk
= BUF_GPT (buf
) - pos
;
599 bcopy (BUF_CHAR_ADDRESS (buf
, pos
), GPT_ADDR
, chunk
);
604 bcopy (BUF_CHAR_ADDRESS (buf
, pos
+ chunk
),
605 GPT_ADDR
+ chunk
, length
- chunk
);
607 #ifdef USE_TEXT_PROPERTIES
608 if (BUF_INTERVALS (current_buffer
) != 0)
609 offset_intervals (current_buffer
, PT
, length
);
616 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
617 adjust_overlays_for_insert (PT
, length
);
618 adjust_markers_for_insert (PT
, length
);
619 adjust_point (length
);
621 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
622 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf
),
624 PT
- length
, length
, current_buffer
, inherit
);
627 /* Insert the character C before point */
633 unsigned char workbuf
[4], *str
;
634 int len
= CHAR_STRING (c
, workbuf
, str
);
639 /* Insert the null-terminated string S before point */
645 insert (s
, strlen (s
));
648 /* Like `insert' except that all markers pointing at the place where
649 the insertion happens are adjusted to point after it.
650 Don't use this function to insert part of a Lisp string,
651 since gc could happen and relocate it. */
654 insert_before_markers (string
, length
)
655 unsigned char *string
;
660 register int opoint
= PT
;
661 insert_1 (string
, length
, 0, 1);
662 adjust_markers (opoint
- 1, opoint
, length
);
663 signal_after_change (PT
-length
, 0, length
);
668 insert_before_markers_and_inherit (string
, length
)
669 unsigned char *string
;
674 register int opoint
= PT
;
675 insert_1 (string
, length
, 1, 1);
676 adjust_markers (opoint
- 1, opoint
, length
);
677 signal_after_change (PT
-length
, 0, length
);
681 /* Insert part of a Lisp string, relocating markers after. */
684 insert_from_string_before_markers (string
, pos
, length
, inherit
)
686 register int pos
, length
;
691 register int opoint
= PT
;
692 insert_from_string_1 (string
, pos
, length
, inherit
);
693 adjust_markers (opoint
- 1, opoint
, length
);
694 signal_after_change (PT
-length
, 0, length
);
698 /* Replace the text from FROM to TO with NEW,
699 If PREPARE is nonzero, call prepare_to_modify_buffer.
700 If INHERIT, the newly inserted text should inherit text properties
701 from the surrounding non-deleted text. */
703 /* Note that this does not yet handle markers quite right.
704 Also it needs to record a single undo-entry that does a replacement
705 rather than a separate delete and insert.
706 That way, undo will also handle markers properly. */
709 replace_range (from
, to
, new, prepare
, inherit
)
711 int from
, to
, prepare
, inherit
;
714 int inslen
= XSTRING (new)->size
;
715 register Lisp_Object temp
;
722 int range_length
= to
- from
;
723 prepare_to_modify_buffer (from
, to
, &from
);
724 to
= from
+ range_length
;
727 /* Make args be valid */
737 /* Make sure point-max won't overflow after this insertion. */
738 XSETINT (temp
, Z
- numdel
+ inslen
);
739 if (Z
- numdel
+ inslen
!= XINT (temp
))
740 error ("maximum buffer size exceeded");
742 if (numdel
<= 0 && inslen
== 0)
747 /* Make sure the gap is somewhere in or next to what we are deleting. */
753 /* Relocate all markers pointing into the new, larger gap
754 to point at the end of the text before the gap.
755 This has to be done before recording the deletion,
756 so undo handles this after reinserting the text. */
757 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
759 record_delete (from
, numdel
);
765 *(GPT_ADDR
) = 0; /* Put an anchor. */
767 if (GPT
- BEG
< beg_unchanged
)
768 beg_unchanged
= GPT
- BEG
;
769 if (Z
- GPT
< end_unchanged
)
770 end_unchanged
= Z
- GPT
;
772 if (GAP_SIZE
< inslen
)
773 make_gap (inslen
- GAP_SIZE
);
775 record_insert (from
, inslen
);
777 bcopy (XSTRING (new)->data
, GPT_ADDR
, inslen
);
779 /* Relocate point as if it were a marker. */
781 adjust_point (from
+ inslen
- (PT
< to
? PT
: to
));
783 #ifdef USE_TEXT_PROPERTIES
784 offset_intervals (current_buffer
, PT
, inslen
- numdel
);
791 if (GAP_SIZE
> 0) *(GPT_ADDR
) = 0; /* Put an anchor. */
793 /* Adjust the overlay center as needed. This must be done after
794 adjusting the markers that bound the overlays. */
795 adjust_overlays_for_delete (from
, numdel
);
796 adjust_overlays_for_insert (from
, inslen
);
797 adjust_markers_for_insert (from
, inslen
);
799 #ifdef USE_TEXT_PROPERTIES
800 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
801 graft_intervals_into_buffer (XSTRING (new)->intervals
, from
, inslen
,
802 current_buffer
, inherit
);
806 evaporate_overlays (from
);
811 signal_after_change (from
, numdel
, inslen
);
814 /* Delete characters in current buffer
815 from FROM up to (but not including) TO. */
819 register int from
, to
;
821 del_range_1 (from
, to
, 1);
824 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
827 del_range_1 (from
, to
, prepare
)
828 int from
, to
, prepare
;
834 int range_length
= to
- from
;
835 prepare_to_modify_buffer (from
, to
, &from
);
836 to
= from
+ range_length
;
839 /* Make args be valid */
845 if ((numdel
= to
- from
) <= 0)
848 /* Make sure the gap is somewhere in or next to what we are deleting. */
854 /* Relocate all markers pointing into the new, larger gap
855 to point at the end of the text before the gap.
856 This has to be done before recording the deletion,
857 so undo handles this after reinserting the text. */
858 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
860 record_delete (from
, numdel
);
863 /* Relocate point as if it were a marker. */
865 adjust_point (from
- (PT
< to
? PT
: to
));
867 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
868 offset_intervals (current_buffer
, from
, - numdel
);
870 /* Adjust the overlay center as needed. This must be done after
871 adjusting the markers that bound the overlays. */
872 adjust_overlays_for_delete (from
, numdel
);
878 *(GPT_ADDR
) = 0; /* Put an anchor. */
880 if (GPT
- BEG
< beg_unchanged
)
881 beg_unchanged
= GPT
- BEG
;
882 if (Z
- GPT
< end_unchanged
)
883 end_unchanged
= Z
- GPT
;
885 evaporate_overlays (from
);
886 signal_after_change (from
, numdel
, 0);
889 /* Call this if you're about to change the region of BUFFER from START
890 to END. This checks the read-only properties of the region, calls
891 the necessary modification hooks, and warns the next redisplay that
892 it should pay attention to that area. */
894 modify_region (buffer
, start
, end
)
895 struct buffer
*buffer
;
898 struct buffer
*old_buffer
= current_buffer
;
900 if (buffer
!= old_buffer
)
901 set_buffer_internal (buffer
);
903 prepare_to_modify_buffer (start
, end
, NULL
);
905 if (start
- 1 < beg_unchanged
906 || (unchanged_modified
== MODIFF
907 && overlay_unchanged_modified
== OVERLAY_MODIFF
))
908 beg_unchanged
= start
- 1;
909 if (Z
- end
< end_unchanged
910 || (unchanged_modified
== MODIFF
911 && overlay_unchanged_modified
== OVERLAY_MODIFF
))
912 end_unchanged
= Z
- end
;
914 if (MODIFF
<= SAVE_MODIFF
)
915 record_first_change ();
918 buffer
->point_before_scroll
= Qnil
;
920 if (buffer
!= old_buffer
)
921 set_buffer_internal (old_buffer
);
924 /* Check that it is okay to modify the buffer between START and END.
925 Run the before-change-function, if any. If intervals are in use,
926 verify that the text to be modified is not read-only, and call
927 any modification properties the text may have.
929 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
930 by holding its value temporarily in a marker. */
933 prepare_to_modify_buffer (start
, end
, preserve_ptr
)
937 if (!NILP (current_buffer
->read_only
))
938 Fbarf_if_buffer_read_only ();
940 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
941 if (BUF_INTERVALS (current_buffer
) != 0)
945 Lisp_Object preserve_marker
;
947 preserve_marker
= Fcopy_marker (make_number (*preserve_ptr
), Qnil
);
948 GCPRO1 (preserve_marker
);
949 verify_interval_modification (current_buffer
, start
, end
);
950 *preserve_ptr
= marker_position (preserve_marker
);
951 unchain_marker (preserve_marker
);
955 verify_interval_modification (current_buffer
, start
, end
);
958 #ifdef CLASH_DETECTION
959 if (!NILP (current_buffer
->file_truename
)
960 /* Make binding buffer-file-name to nil effective. */
961 && !NILP (current_buffer
->filename
)
962 && SAVE_MODIFF
>= MODIFF
)
963 lock_file (current_buffer
->file_truename
);
965 /* At least warn if this file has changed on disk since it was visited. */
966 if (!NILP (current_buffer
->filename
)
967 && SAVE_MODIFF
>= MODIFF
968 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
969 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
970 call1 (intern ("ask-user-about-supersession-threat"),
971 current_buffer
->filename
);
972 #endif /* not CLASH_DETECTION */
974 signal_before_change (start
, end
, preserve_ptr
);
976 if (current_buffer
->newline_cache
)
977 invalidate_region_cache (current_buffer
,
978 current_buffer
->newline_cache
,
979 start
- BEG
, Z
- end
);
980 if (current_buffer
->width_run_cache
)
981 invalidate_region_cache (current_buffer
,
982 current_buffer
->width_run_cache
,
983 start
- BEG
, Z
- end
);
985 Vdeactivate_mark
= Qt
;
988 /* These macros work with an argument named `preserve_ptr'
989 and a local variable named `preserve_marker'. */
991 #define PRESERVE_VALUE \
992 if (preserve_ptr && NILP (preserve_marker)) \
993 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil)
995 #define RESTORE_VALUE \
996 if (! NILP (preserve_marker)) \
998 *preserve_ptr = marker_position (preserve_marker); \
999 unchain_marker (preserve_marker); \
1002 #define PRESERVE_START_END \
1003 if (NILP (start_marker)) \
1004 start_marker = Fcopy_marker (start, Qnil); \
1005 if (NILP (end_marker)) \
1006 end_marker = Fcopy_marker (end, Qnil);
1008 #define FETCH_START \
1009 (! NILP (start_marker) ? Fmarker_position (start_marker) : start)
1012 (! NILP (end_marker) ? Fmarker_position (end_marker) : end)
1014 /* Signal a change to the buffer immediately before it happens.
1015 START_INT and END_INT are the bounds of the text to be changed.
1017 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1018 by holding its value temporarily in a marker. */
1021 signal_before_change (start_int
, end_int
, preserve_ptr
)
1022 int start_int
, end_int
;
1025 Lisp_Object start
, end
;
1026 Lisp_Object start_marker
, end_marker
;
1027 Lisp_Object preserve_marker
;
1028 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1030 start
= make_number (start_int
);
1031 end
= make_number (end_int
);
1032 preserve_marker
= Qnil
;
1033 start_marker
= Qnil
;
1035 GCPRO3 (preserve_marker
, start_marker
, end_marker
);
1037 /* If buffer is unmodified, run a special hook for that case. */
1038 if (SAVE_MODIFF
>= MODIFF
1039 && !NILP (Vfirst_change_hook
)
1040 && !NILP (Vrun_hooks
))
1044 call1 (Vrun_hooks
, Qfirst_change_hook
);
1047 /* Run the before-change-function if any.
1048 We don't bother "binding" this variable to nil
1049 because it is obsolete anyway and new code should not use it. */
1050 if (!NILP (Vbefore_change_function
))
1054 call2 (Vbefore_change_function
, FETCH_START
, FETCH_END
);
1057 /* Now run the before-change-functions if any. */
1058 if (!NILP (Vbefore_change_functions
))
1060 Lisp_Object args
[3];
1061 Lisp_Object before_change_functions
;
1062 Lisp_Object after_change_functions
;
1063 struct gcpro gcpro1
, gcpro2
;
1068 /* "Bind" before-change-functions and after-change-functions
1069 to nil--but in a way that errors don't know about.
1070 That way, if there's an error in them, they will stay nil. */
1071 before_change_functions
= Vbefore_change_functions
;
1072 after_change_functions
= Vafter_change_functions
;
1073 Vbefore_change_functions
= Qnil
;
1074 Vafter_change_functions
= Qnil
;
1075 GCPRO2 (before_change_functions
, after_change_functions
);
1077 /* Actually run the hook functions. */
1078 args
[0] = Qbefore_change_functions
;
1079 args
[1] = FETCH_START
;
1080 args
[2] = FETCH_END
;
1081 run_hook_list_with_args (before_change_functions
, 3, args
);
1083 /* "Unbind" the variables we "bound" to nil. */
1084 Vbefore_change_functions
= before_change_functions
;
1085 Vafter_change_functions
= after_change_functions
;
1089 if (!NILP (current_buffer
->overlays_before
)
1090 || !NILP (current_buffer
->overlays_after
))
1093 report_overlay_modification (FETCH_START
, FETCH_END
, 0,
1094 FETCH_START
, FETCH_END
, Qnil
);
1097 if (! NILP (start_marker
))
1098 free_marker (start_marker
);
1099 if (! NILP (end_marker
))
1100 free_marker (end_marker
);
1105 /* Signal a change immediately after it happens.
1106 POS is the address of the start of the changed text.
1107 LENDEL is the number of characters of the text before the change.
1108 (Not the whole buffer; just the part that was changed.)
1109 LENINS is the number of characters in that part of the text
1110 after the change. */
1113 signal_after_change (pos
, lendel
, lenins
)
1114 int pos
, lendel
, lenins
;
1116 /* If we are deferring calls to the after-change functions
1117 and there are no before-change functions,
1118 just record the args that we were going to use. */
1119 if (! NILP (Vcombine_after_change_calls
)
1120 && NILP (Vbefore_change_function
) && NILP (Vbefore_change_functions
)
1121 && NILP (current_buffer
->overlays_before
)
1122 && NILP (current_buffer
->overlays_after
))
1126 if (!NILP (combine_after_change_list
)
1127 && current_buffer
!= XBUFFER (combine_after_change_buffer
))
1128 Fcombine_after_change_execute ();
1130 elt
= Fcons (make_number (pos
- BEG
),
1131 Fcons (make_number (Z
- (pos
- lendel
+ lenins
)),
1132 Fcons (make_number (lenins
- lendel
), Qnil
)));
1133 combine_after_change_list
1134 = Fcons (elt
, combine_after_change_list
);
1135 combine_after_change_buffer
= Fcurrent_buffer ();
1140 if (!NILP (combine_after_change_list
))
1141 Fcombine_after_change_execute ();
1143 /* Run the after-change-function if any.
1144 We don't bother "binding" this variable to nil
1145 because it is obsolete anyway and new code should not use it. */
1146 if (!NILP (Vafter_change_function
))
1147 call3 (Vafter_change_function
,
1148 make_number (pos
), make_number (pos
+ lenins
),
1149 make_number (lendel
));
1151 if (!NILP (Vafter_change_functions
))
1153 Lisp_Object args
[4];
1154 Lisp_Object before_change_functions
;
1155 Lisp_Object after_change_functions
;
1156 struct gcpro gcpro1
, gcpro2
;
1158 /* "Bind" before-change-functions and after-change-functions
1159 to nil--but in a way that errors don't know about.
1160 That way, if there's an error in them, they will stay nil. */
1161 before_change_functions
= Vbefore_change_functions
;
1162 after_change_functions
= Vafter_change_functions
;
1163 Vbefore_change_functions
= Qnil
;
1164 Vafter_change_functions
= Qnil
;
1165 GCPRO2 (before_change_functions
, after_change_functions
);
1167 /* Actually run the hook functions. */
1168 args
[0] = Qafter_change_functions
;
1169 XSETFASTINT (args
[1], pos
);
1170 XSETFASTINT (args
[2], pos
+ lenins
);
1171 XSETFASTINT (args
[3], lendel
);
1172 run_hook_list_with_args (after_change_functions
,
1175 /* "Unbind" the variables we "bound" to nil. */
1176 Vbefore_change_functions
= before_change_functions
;
1177 Vafter_change_functions
= after_change_functions
;
1181 if (!NILP (current_buffer
->overlays_before
)
1182 || !NILP (current_buffer
->overlays_after
))
1183 report_overlay_modification (make_number (pos
),
1184 make_number (pos
+ lenins
),
1186 make_number (pos
), make_number (pos
+ lenins
),
1187 make_number (lendel
));
1189 /* After an insertion, call the text properties
1190 insert-behind-hooks or insert-in-front-hooks. */
1192 report_interval_modification (pos
, pos
+ lenins
);
1196 Fcombine_after_change_execute_1 (val
)
1199 Vcombine_after_change_calls
= val
;
1203 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute
,
1204 Scombine_after_change_execute
, 0, 0, 0,
1205 "This function is for use internally in `combine-after-change-calls'.")
1208 register Lisp_Object val
;
1209 int count
= specpdl_ptr
- specpdl
;
1210 int beg
, end
, change
;
1214 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
1216 Fset_buffer (combine_after_change_buffer
);
1218 /* # chars unchanged at beginning of buffer. */
1220 /* # chars unchanged at end of buffer. */
1222 /* Total amount of insertion (negative for deletion). */
1225 /* Scan the various individual changes,
1226 accumulating the range info in BEG, END and CHANGE. */
1227 for (tail
= combine_after_change_list
; CONSP (tail
);
1228 tail
= XCONS (tail
)->cdr
)
1231 int thisbeg
, thisend
, thischange
;
1233 /* Extract the info from the next element. */
1234 elt
= XCONS (tail
)->car
;
1237 thisbeg
= XINT (XCONS (elt
)->car
);
1239 elt
= XCONS (elt
)->cdr
;
1242 thisend
= XINT (XCONS (elt
)->car
);
1244 elt
= XCONS (elt
)->cdr
;
1247 thischange
= XINT (XCONS (elt
)->car
);
1249 /* Merge this range into the accumulated range. */
1250 change
+= thischange
;
1257 /* Get the current start and end positions of the range
1258 that was changed. */
1262 /* We are about to handle these, so discard them. */
1263 combine_after_change_list
= Qnil
;
1265 /* Now run the after-change functions for real.
1266 Turn off the flag that defers them. */
1267 record_unwind_protect (Fcombine_after_change_execute_1
,
1268 Vcombine_after_change_calls
);
1269 signal_after_change (begpos
, endpos
- begpos
- change
, endpos
- begpos
);
1271 return unbind_to (count
, val
);
1276 staticpro (&combine_after_change_list
);
1277 combine_after_change_list
= Qnil
;
1279 DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls
,
1280 "Used internally by the `combine-after-change-calls' macro.");
1281 Vcombine_after_change_calls
= Qnil
;
1283 defsubr (&Scombine_after_change_execute
);