1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 1986, 1993 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 /* Move gap to position `pos'.
29 Note that this can quit! */
40 /* Move the gap to POS, which is less than the current GPT.
41 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
43 gap_left (pos
, newgap
)
47 register unsigned char *to
, *from
;
55 if (unchanged_modified
== MODIFF
)
58 end_unchanged
= Z
- pos
- 1;
62 if (Z
- GPT
< end_unchanged
)
63 end_unchanged
= Z
- GPT
;
64 if (pos
< beg_unchanged
)
74 /* Now copy the characters. To move the gap down,
75 copy characters up. */
79 /* I gets number of characters left to copy. */
83 /* If a quit is requested, stop copying now.
84 Change POS to be where we have actually moved the gap to. */
90 /* Move at most 32000 chars before checking again for a quit. */
95 /* bcopy is safe if the two areas of memory do not overlap
96 or on systems where bcopy is always safe for moving upward. */
100 /* If overlap is not safe, avoid it by not moving too many
101 characters at once. */
102 if (!BCOPY_UPWARD_SAFE
&& i
> to
- from
)
117 /* Adjust markers, and buffer data structure, to put the gap at POS.
118 POS is where the loop above stopped, which may be what was specified
119 or may be where a quit was detected. */
120 adjust_markers (pos
+ 1, GPT
, GAP_SIZE
);
128 register unsigned char *to
, *from
;
134 if (unchanged_modified
== MODIFF
)
137 end_unchanged
= Z
- pos
- 1;
141 if (Z
- pos
- 1 < end_unchanged
)
142 end_unchanged
= Z
- pos
- 1;
143 if (GPT
- BEG
< beg_unchanged
)
144 beg_unchanged
= GPT
- BEG
;
152 /* Now copy the characters. To move the gap up,
153 copy characters down. */
157 /* I gets number of characters left to copy. */
161 /* If a quit is requested, stop copying now.
162 Change POS to be where we have actually moved the gap to. */
168 /* Move at most 32000 chars before checking again for a quit. */
173 /* bcopy is safe if the two areas of memory do not overlap
174 or on systems where bcopy is always safe for moving downward. */
175 && (BCOPY_DOWNWARD_SAFE
176 || from
- to
>= 128))
178 /* If overlap is not safe, avoid it by not moving too many
179 characters at once. */
180 if (!BCOPY_DOWNWARD_SAFE
&& i
> from
- to
)
195 adjust_markers (GPT
+ GAP_SIZE
, pos
+ 1 + GAP_SIZE
, - GAP_SIZE
);
200 /* Add `amount' to the position of every marker in the current buffer
201 whose current position is between `from' (exclusive) and `to' (inclusive).
202 Also, any markers past the outside of that interval, in the direction
203 of adjustment, are first moved back to the near end of the interval
204 and then adjusted by `amount'. */
206 adjust_markers (from
, to
, amount
)
207 register int from
, to
, amount
;
210 register struct Lisp_Marker
*m
;
213 marker
= current_buffer
->markers
;
215 while (!NILP (marker
))
217 m
= XMARKER (marker
);
221 if (mpos
> to
&& mpos
< to
+ amount
)
226 if (mpos
> from
+ amount
&& mpos
<= from
)
227 mpos
= from
+ amount
;
229 if (mpos
> from
&& mpos
<= to
)
236 /* Make the gap INCREMENT characters longer. */
241 unsigned char *result
;
246 /* If we have to get more space, get enough to last a while. */
250 result
= BUFFER_REALLOC (BEG_ADDR
, (Z
- BEG
+ GAP_SIZE
+ increment
));
257 /* Prevent quitting in move_gap. */
262 old_gap_size
= GAP_SIZE
;
264 /* Call the newly allocated space a gap at the end of the whole space. */
266 GAP_SIZE
= increment
;
268 /* Move the new gap down to be consecutive with the end of the old one.
269 This adjusts the markers properly too. */
270 gap_left (real_gap_loc
+ old_gap_size
, 1);
272 /* Now combine the two into one large gap. */
273 GAP_SIZE
+= old_gap_size
;
279 /* Insert a string of specified length before point.
280 DO NOT use this for the contents of a Lisp string!
281 prepare_to_modify_buffer could relocate the string. */
283 insert (string
, length
)
284 register unsigned char *string
;
287 register Lisp_Object temp
;
292 /* Make sure point-max won't overflow after this insertion. */
293 XSET (temp
, Lisp_Int
, length
+ Z
);
294 if (length
+ Z
!= XINT (temp
))
295 error ("maximum buffer size exceeded");
297 prepare_to_modify_buffer (point
, point
);
301 if (GAP_SIZE
< length
)
302 make_gap (length
- GAP_SIZE
);
304 record_insert (point
, length
);
307 bcopy (string
, GPT_ADDR
, length
);
309 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
310 offset_intervals (current_buffer
, point
, length
);
316 SET_PT (point
+ length
);
318 signal_after_change (point
-length
, 0, length
);
321 /* Insert the part of the text of STRING, a Lisp object assumed to be
322 of type string, consisting of the LENGTH characters starting at
323 position POS. If the text of STRING has properties, they are absorbed
326 It does not work to use `insert' for this, because a GC could happen
327 before we bcopy the stuff into the buffer, and relocate the string
328 without insert noticing. */
330 insert_from_string (string
, pos
, length
, inherit
)
332 register int pos
, length
;
335 register Lisp_Object temp
;
341 /* Make sure point-max won't overflow after this insertion. */
342 XSET (temp
, Lisp_Int
, length
+ Z
);
343 if (length
+ Z
!= XINT (temp
))
344 error ("maximum buffer size exceeded");
347 prepare_to_modify_buffer (point
, point
);
351 if (GAP_SIZE
< length
)
352 make_gap (length
- GAP_SIZE
);
354 record_insert (point
, length
);
358 bcopy (XSTRING (string
)->data
, GPT_ADDR
, length
);
360 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
361 offset_intervals (current_buffer
, point
, length
);
368 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
369 graft_intervals_into_buffer (XSTRING (string
)->intervals
, point
, length
,
370 current_buffer
, inherit
);
372 SET_PT (point
+ length
);
374 signal_after_change (point
-length
, 0, length
);
377 /* Insert the character C before point */
386 /* Insert the null-terminated string S before point */
392 insert (s
, strlen (s
));
395 /* Like `insert' except that all markers pointing at the place where
396 the insertion happens are adjusted to point after it.
397 Don't use this function to insert part of a Lisp string,
398 since gc could happen and relocate it. */
400 insert_before_markers (string
, length
)
401 unsigned char *string
;
404 register int opoint
= point
;
405 insert (string
, length
);
406 adjust_markers (opoint
- 1, opoint
, length
);
409 /* Insert part of a Lisp string, relocating markers after. */
411 insert_from_string_before_markers (string
, pos
, length
, inherit
)
413 register int pos
, length
;
416 register int opoint
= point
;
417 insert_from_string (string
, pos
, length
, inherit
);
418 adjust_markers (opoint
- 1, opoint
, length
);
421 /* Delete characters in current buffer
422 from FROM up to (but not including) TO. */
425 register int from
, to
;
429 /* Make args be valid */
435 if ((numdel
= to
- from
) <= 0)
438 /* Make sure the gap is somewhere in or next to what we are deleting. */
444 prepare_to_modify_buffer (from
, to
);
446 record_delete (from
, numdel
);
449 /* Relocate point as if it were a marker. */
455 SET_PT (point
- numdel
);
458 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
459 offset_intervals (current_buffer
, from
, - numdel
);
461 /* Relocate all markers pointing into the new, larger gap
462 to point at the end of the text before the gap. */
463 adjust_markers (to
+ GAP_SIZE
, to
+ GAP_SIZE
, - numdel
- GAP_SIZE
);
470 if (GPT
- BEG
< beg_unchanged
)
471 beg_unchanged
= GPT
- BEG
;
472 if (Z
- GPT
< end_unchanged
)
473 end_unchanged
= Z
- GPT
;
475 signal_after_change (from
, numdel
, 0);
478 /* Call this if you're about to change the region of BUFFER from START
479 to END. This checks the read-only properties of the region, calls
480 the necessary modification hooks, and warns the next redisplay that
481 it should pay attention to that area. */
482 modify_region (buffer
, start
, end
)
483 struct buffer
*buffer
;
486 struct buffer
*old_buffer
= current_buffer
;
488 if (buffer
!= old_buffer
)
489 set_buffer_internal (buffer
);
491 prepare_to_modify_buffer (start
, end
);
493 if (start
- 1 < beg_unchanged
|| unchanged_modified
== MODIFF
)
494 beg_unchanged
= start
- 1;
495 if (Z
- end
< end_unchanged
496 || unchanged_modified
== MODIFF
)
497 end_unchanged
= Z
- end
;
499 if (MODIFF
<= current_buffer
->save_modified
)
500 record_first_change ();
503 if (buffer
!= old_buffer
)
504 set_buffer_internal (old_buffer
);
507 /* Check that it is okay to modify the buffer between START and END.
508 Run the before-change-function, if any. If intervals are in use,
509 verify that the text to be modified is not read-only, and call
510 any modification properties the text may have. */
512 prepare_to_modify_buffer (start
, end
)
513 Lisp_Object start
, end
;
515 if (!NILP (current_buffer
->read_only
))
516 Fbarf_if_buffer_read_only ();
518 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
519 verify_interval_modification (current_buffer
, start
, end
);
521 verify_overlay_modification (start
, end
);
523 #ifdef CLASH_DETECTION
524 if (!NILP (current_buffer
->filename
)
525 && current_buffer
->save_modified
>= MODIFF
)
526 lock_file (current_buffer
->filename
);
528 /* At least warn if this file has changed on disk since it was visited. */
529 if (!NILP (current_buffer
->filename
)
530 && current_buffer
->save_modified
>= MODIFF
531 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
532 && !NILP (Ffile_exists_p (current_buffer
->filename
)))
533 call1 (intern ("ask-user-about-supersession-threat"),
534 current_buffer
->filename
);
535 #endif /* not CLASH_DETECTION */
537 signal_before_change (start
, end
);
539 Vdeactivate_mark
= Qt
;
543 before_change_function_restore (value
)
546 Vbefore_change_function
= value
;
550 after_change_function_restore (value
)
553 Vafter_change_function
= value
;
556 /* Signal a change to the buffer immediately before it happens.
557 START and END are the bounds of the text to be changed,
560 signal_before_change (start
, end
)
561 Lisp_Object start
, end
;
563 /* If buffer is unmodified, run a special hook for that case. */
564 if (current_buffer
->save_modified
>= MODIFF
565 && !NILP (Vfirst_change_hook
)
566 && !NILP (Vrun_hooks
))
567 call1 (Vrun_hooks
, Qfirst_change_hook
);
569 /* Now in any case run the before-change-function if any. */
570 if (!NILP (Vbefore_change_function
))
572 int count
= specpdl_ptr
- specpdl
;
573 Lisp_Object function
;
575 function
= Vbefore_change_function
;
576 record_unwind_protect (after_change_function_restore
,
577 Vafter_change_function
);
578 record_unwind_protect (before_change_function_restore
,
579 Vbefore_change_function
);
580 Vafter_change_function
= Qnil
;
581 Vbefore_change_function
= Qnil
;
583 call2 (function
, start
, end
);
584 unbind_to (count
, Qnil
);
588 /* Signal a change immediately after it happens.
589 POS is the address of the start of the changed text.
590 LENDEL is the number of characters of the text before the change.
591 (Not the whole buffer; just the part that was changed.)
592 LENINS is the number of characters in the changed text. */
594 signal_after_change (pos
, lendel
, lenins
)
595 int pos
, lendel
, lenins
;
597 if (!NILP (Vafter_change_function
))
599 int count
= specpdl_ptr
- specpdl
;
600 Lisp_Object function
;
601 function
= Vafter_change_function
;
603 record_unwind_protect (after_change_function_restore
,
604 Vafter_change_function
);
605 record_unwind_protect (before_change_function_restore
,
606 Vbefore_change_function
);
607 Vafter_change_function
= Qnil
;
608 Vbefore_change_function
= Qnil
;
610 call3 (function
, make_number (pos
), make_number (pos
+ lenins
),
611 make_number (lendel
));
612 unbind_to (count
, Qnil
);