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 /* Delete characters in current buffer
699 from FROM up to (but not including) TO. */
703 register int from
, to
;
705 del_range_1 (from
, to
, 1);
708 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
711 del_range_1 (from
, to
, prepare
)
712 int from
, to
, prepare
;
718 int range_length
= to
- from
;
719 prepare_to_modify_buffer (from
, to
, &from
);
720 to
= from
+ range_length
;
723 /* Make args be valid */
729 if ((numdel
= to
- from
) <= 0)
732 /* Make sure the gap is somewhere in or next to what we are deleting. */
738 /* Relocate all markers pointing into the new, larger gap
739 to point at the end of the text before the gap.
740 This has to be done before recording the deletion,
741 so undo handles this after reinserting the text. */
742 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
744 record_delete (from
, numdel
);
747 /* Relocate point as if it were a marker. */
749 adjust_point (from
- (PT
< to
? PT
: to
));
751 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
752 offset_intervals (current_buffer
, from
, - numdel
);
754 /* Adjust the overlay center as needed. This must be done after
755 adjusting the markers that bound the overlays. */
756 adjust_overlays_for_delete (from
, numdel
);
762 *(GPT_ADDR
) = 0; /* Put an anchor. */
764 if (GPT
- BEG
< beg_unchanged
)
765 beg_unchanged
= GPT
- BEG
;
766 if (Z
- GPT
< end_unchanged
)
767 end_unchanged
= Z
- GPT
;
769 evaporate_overlays (from
);
770 signal_after_change (from
, numdel
, 0);
773 /* Call this if you're about to change the region of BUFFER from START
774 to END. This checks the read-only properties of the region, calls
775 the necessary modification hooks, and warns the next redisplay that
776 it should pay attention to that area. */
778 modify_region (buffer
, start
, end
)
779 struct buffer
*buffer
;
782 struct buffer
*old_buffer
= current_buffer
;
784 if (buffer
!= old_buffer
)
785 set_buffer_internal (buffer
);
787 prepare_to_modify_buffer (start
, end
, NULL
);
789 if (start
- 1 < beg_unchanged
790 || (unchanged_modified
== MODIFF
791 && overlay_unchanged_modified
== OVERLAY_MODIFF
))
792 beg_unchanged
= start
- 1;
793 if (Z
- end
< end_unchanged
794 || (unchanged_modified
== MODIFF
795 && overlay_unchanged_modified
== OVERLAY_MODIFF
))
796 end_unchanged
= Z
- end
;
798 if (MODIFF
<= SAVE_MODIFF
)
799 record_first_change ();
802 buffer
->point_before_scroll
= Qnil
;
804 if (buffer
!= old_buffer
)
805 set_buffer_internal (old_buffer
);
808 /* Check that it is okay to modify the buffer between START and END.
809 Run the before-change-function, if any. If intervals are in use,
810 verify that the text to be modified is not read-only, and call
811 any modification properties the text may have.
813 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
814 by holding its value temporarily in a marker. */
817 prepare_to_modify_buffer (start
, end
, preserve_ptr
)
821 if (!NILP (current_buffer
->read_only
))
822 Fbarf_if_buffer_read_only ();
824 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
825 if (BUF_INTERVALS (current_buffer
) != 0)
829 Lisp_Object preserve_marker
;
831 preserve_marker
= Fcopy_marker (make_number (*preserve_ptr
), Qnil
);
832 GCPRO1 (preserve_marker
);
833 verify_interval_modification (current_buffer
, start
, end
);
834 *preserve_ptr
= marker_position (preserve_marker
);
835 unchain_marker (preserve_marker
);
839 verify_interval_modification (current_buffer
, start
, end
);
842 #ifdef CLASH_DETECTION
843 if (!NILP (current_buffer
->file_truename
)
844 /* Make binding buffer-file-name to nil effective. */
845 && !NILP (current_buffer
->filename
)
846 && SAVE_MODIFF
>= MODIFF
)
847 lock_file (current_buffer
->file_truename
);
849 /* At least warn if this file has changed on disk since it was visited. */
850 if (!NILP (current_buffer
->filename
)
851 && SAVE_MODIFF
>= MODIFF
852 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
853 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
854 call1 (intern ("ask-user-about-supersession-threat"),
855 current_buffer
->filename
);
856 #endif /* not CLASH_DETECTION */
858 signal_before_change (start
, end
, preserve_ptr
);
860 if (current_buffer
->newline_cache
)
861 invalidate_region_cache (current_buffer
,
862 current_buffer
->newline_cache
,
863 start
- BEG
, Z
- end
);
864 if (current_buffer
->width_run_cache
)
865 invalidate_region_cache (current_buffer
,
866 current_buffer
->width_run_cache
,
867 start
- BEG
, Z
- end
);
869 Vdeactivate_mark
= Qt
;
872 /* These macros work with an argument named `preserve_ptr'
873 and a local variable named `preserve_marker'. */
875 #define PRESERVE_VALUE \
876 if (preserve_ptr && NILP (preserve_marker)) \
877 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil)
879 #define RESTORE_VALUE \
880 if (! NILP (preserve_marker)) \
882 *preserve_ptr = marker_position (preserve_marker); \
883 unchain_marker (preserve_marker); \
886 /* Signal a change to the buffer immediately before it happens.
887 START_INT and END_INT are the bounds of the text to be changed.
889 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
890 by holding its value temporarily in a marker. */
893 signal_before_change (start_int
, end_int
, preserve_ptr
)
894 int start_int
, end_int
;
897 Lisp_Object start
, end
;
898 Lisp_Object preserve_marker
;
901 start
= make_number (start_int
);
902 end
= make_number (end_int
);
903 preserve_marker
= Qnil
;
904 GCPRO1 (preserve_marker
);
906 /* If buffer is unmodified, run a special hook for that case. */
907 if (SAVE_MODIFF
>= MODIFF
908 && !NILP (Vfirst_change_hook
)
909 && !NILP (Vrun_hooks
))
912 call1 (Vrun_hooks
, Qfirst_change_hook
);
915 /* Run the before-change-function if any.
916 We don't bother "binding" this variable to nil
917 because it is obsolete anyway and new code should not use it. */
918 if (!NILP (Vbefore_change_function
))
921 call2 (Vbefore_change_function
, start
, end
);
924 /* Now run the before-change-functions if any. */
925 if (!NILP (Vbefore_change_functions
))
928 Lisp_Object before_change_functions
;
929 Lisp_Object after_change_functions
;
930 struct gcpro gcpro1
, gcpro2
;
934 /* "Bind" before-change-functions and after-change-functions
935 to nil--but in a way that errors don't know about.
936 That way, if there's an error in them, they will stay nil. */
937 before_change_functions
= Vbefore_change_functions
;
938 after_change_functions
= Vafter_change_functions
;
939 Vbefore_change_functions
= Qnil
;
940 Vafter_change_functions
= Qnil
;
941 GCPRO2 (before_change_functions
, after_change_functions
);
943 /* Actually run the hook functions. */
944 args
[0] = Qbefore_change_functions
;
947 run_hook_list_with_args (before_change_functions
, 3, args
);
949 /* "Unbind" the variables we "bound" to nil. */
950 Vbefore_change_functions
= before_change_functions
;
951 Vafter_change_functions
= after_change_functions
;
955 if (!NILP (current_buffer
->overlays_before
)
956 || !NILP (current_buffer
->overlays_after
))
959 report_overlay_modification (start
, end
, 0, start
, end
, Qnil
);
966 /* Signal a change immediately after it happens.
967 POS is the address of the start of the changed text.
968 LENDEL is the number of characters of the text before the change.
969 (Not the whole buffer; just the part that was changed.)
970 LENINS is the number of characters in that part of the text
974 signal_after_change (pos
, lendel
, lenins
)
975 int pos
, lendel
, lenins
;
977 /* If we are deferring calls to the after-change functions
978 and there are no before-change functions,
979 just record the args that we were going to use. */
980 if (! NILP (Vcombine_after_change_calls
)
981 && NILP (Vbefore_change_function
) && NILP (Vbefore_change_functions
)
982 && NILP (current_buffer
->overlays_before
)
983 && NILP (current_buffer
->overlays_after
))
987 if (!NILP (combine_after_change_list
)
988 && current_buffer
!= XBUFFER (combine_after_change_buffer
))
989 Fcombine_after_change_execute ();
991 elt
= Fcons (make_number (pos
- BEG
),
992 Fcons (make_number (Z
- (pos
- lendel
+ lenins
)),
993 Fcons (make_number (lenins
- lendel
), Qnil
)));
994 combine_after_change_list
995 = Fcons (elt
, combine_after_change_list
);
996 combine_after_change_buffer
= Fcurrent_buffer ();
1001 if (!NILP (combine_after_change_list
))
1002 Fcombine_after_change_execute ();
1004 /* Run the after-change-function if any.
1005 We don't bother "binding" this variable to nil
1006 because it is obsolete anyway and new code should not use it. */
1007 if (!NILP (Vafter_change_function
))
1008 call3 (Vafter_change_function
,
1009 make_number (pos
), make_number (pos
+ lenins
),
1010 make_number (lendel
));
1012 if (!NILP (Vafter_change_functions
))
1014 Lisp_Object args
[4];
1015 Lisp_Object before_change_functions
;
1016 Lisp_Object after_change_functions
;
1017 struct gcpro gcpro1
, gcpro2
;
1019 /* "Bind" before-change-functions and after-change-functions
1020 to nil--but in a way that errors don't know about.
1021 That way, if there's an error in them, they will stay nil. */
1022 before_change_functions
= Vbefore_change_functions
;
1023 after_change_functions
= Vafter_change_functions
;
1024 Vbefore_change_functions
= Qnil
;
1025 Vafter_change_functions
= Qnil
;
1026 GCPRO2 (before_change_functions
, after_change_functions
);
1028 /* Actually run the hook functions. */
1029 args
[0] = Qafter_change_functions
;
1030 XSETFASTINT (args
[1], pos
);
1031 XSETFASTINT (args
[2], pos
+ lenins
);
1032 XSETFASTINT (args
[3], lendel
);
1033 run_hook_list_with_args (after_change_functions
,
1036 /* "Unbind" the variables we "bound" to nil. */
1037 Vbefore_change_functions
= before_change_functions
;
1038 Vafter_change_functions
= after_change_functions
;
1042 if (!NILP (current_buffer
->overlays_before
)
1043 || !NILP (current_buffer
->overlays_after
))
1044 report_overlay_modification (make_number (pos
),
1045 make_number (pos
+ lenins
),
1047 make_number (pos
), make_number (pos
+ lenins
),
1048 make_number (lendel
));
1050 /* After an insertion, call the text properties
1051 insert-behind-hooks or insert-in-front-hooks. */
1053 report_interval_modification (pos
, pos
+ lenins
);
1057 Fcombine_after_change_execute_1 (val
)
1060 Vcombine_after_change_calls
= val
;
1064 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute
,
1065 Scombine_after_change_execute
, 0, 0, 0,
1066 "This function is for use internally in `combine-after-change-calls'.")
1069 register Lisp_Object val
;
1070 int count
= specpdl_ptr
- specpdl
;
1071 int beg
, end
, change
;
1075 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
1077 Fset_buffer (combine_after_change_buffer
);
1079 /* # chars unchanged at beginning of buffer. */
1081 /* # chars unchanged at end of buffer. */
1083 /* Total amount of insertion (negative for deletion). */
1086 /* Scan the various individual changes,
1087 accumulating the range info in BEG, END and CHANGE. */
1088 for (tail
= combine_after_change_list
; CONSP (tail
);
1089 tail
= XCONS (tail
)->cdr
)
1092 int thisbeg
, thisend
, thischange
;
1094 /* Extract the info from the next element. */
1095 elt
= XCONS (tail
)->car
;
1098 thisbeg
= XINT (XCONS (elt
)->car
);
1100 elt
= XCONS (elt
)->cdr
;
1103 thisend
= XINT (XCONS (elt
)->car
);
1105 elt
= XCONS (elt
)->cdr
;
1108 thischange
= XINT (XCONS (elt
)->car
);
1110 /* Merge this range into the accumulated range. */
1111 change
+= thischange
;
1118 /* Get the current start and end positions of the range
1119 that was changed. */
1123 /* We are about to handle these, so discard them. */
1124 combine_after_change_list
= Qnil
;
1126 /* Now run the after-change functions for real.
1127 Turn off the flag that defers them. */
1128 record_unwind_protect (Fcombine_after_change_execute_1
,
1129 Vcombine_after_change_calls
);
1130 signal_after_change (begpos
, endpos
- begpos
- change
, endpos
- begpos
);
1132 return unbind_to (count
, val
);
1137 staticpro (&combine_after_change_list
);
1138 combine_after_change_list
= Qnil
;
1140 DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls
,
1141 "Used internally by the `combine-after-change-calls' macro.");
1142 Vcombine_after_change_calls
= Qnil
;
1144 defsubr (&Scombine_after_change_execute
);