]> code.delx.au - gnu-emacs/blob - src/insdel.c
(init_baud_rate) [USE_GETOBAUD]: Use getobaud.
[gnu-emacs] / src / insdel.c
1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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)
9 any later version.
10
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.
15
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. */
19
20
21 #include <config.h>
22 #include "lisp.h"
23 #include "intervals.h"
24 #include "buffer.h"
25 #include "window.h"
26 #include "blockinput.h"
27
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 ();
34
35 /* Move gap to position `pos'.
36 Note that this can quit! */
37
38 move_gap (pos)
39 int pos;
40 {
41 if (pos < GPT)
42 gap_left (pos, 0);
43 else if (pos > GPT)
44 gap_right (pos);
45 }
46
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. */
49
50 static void
51 gap_left (pos, newgap)
52 register int pos;
53 int newgap;
54 {
55 register unsigned char *to, *from;
56 register int i;
57 int new_s1;
58
59 pos--;
60
61 if (!newgap)
62 {
63 if (unchanged_modified == MODIFF)
64 {
65 beg_unchanged = pos;
66 end_unchanged = Z - pos - 1;
67 }
68 else
69 {
70 if (Z - GPT < end_unchanged)
71 end_unchanged = Z - GPT;
72 if (pos < beg_unchanged)
73 beg_unchanged = pos;
74 }
75 }
76
77 i = GPT;
78 to = GAP_END_ADDR;
79 from = GPT_ADDR;
80 new_s1 = GPT - BEG;
81
82 /* Now copy the characters. To move the gap down,
83 copy characters up. */
84
85 while (1)
86 {
87 /* I gets number of characters left to copy. */
88 i = new_s1 - pos;
89 if (i == 0)
90 break;
91 /* If a quit is requested, stop copying now.
92 Change POS to be where we have actually moved the gap to. */
93 if (QUITP)
94 {
95 pos = new_s1;
96 break;
97 }
98 /* Move at most 32000 chars before checking again for a quit. */
99 if (i > 32000)
100 i = 32000;
101 #ifdef GAP_USE_BCOPY
102 if (i >= 128
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))
107 {
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)
111 i = to - from;
112 new_s1 -= i;
113 from -= i, to -= i;
114 bcopy (from, to, i);
115 }
116 else
117 #endif
118 {
119 new_s1 -= i;
120 while (--i >= 0)
121 *--to = *--from;
122 }
123 }
124
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);
129 GPT = pos + 1;
130 QUIT;
131 }
132
133 static void
134 gap_right (pos)
135 register int pos;
136 {
137 register unsigned char *to, *from;
138 register int i;
139 int new_s1;
140
141 pos--;
142
143 if (unchanged_modified == MODIFF)
144 {
145 beg_unchanged = pos;
146 end_unchanged = Z - pos - 1;
147 }
148 else
149 {
150 if (Z - pos - 1 < end_unchanged)
151 end_unchanged = Z - pos - 1;
152 if (GPT - BEG < beg_unchanged)
153 beg_unchanged = GPT - BEG;
154 }
155
156 i = GPT;
157 from = GAP_END_ADDR;
158 to = GPT_ADDR;
159 new_s1 = GPT - 1;
160
161 /* Now copy the characters. To move the gap up,
162 copy characters down. */
163
164 while (1)
165 {
166 /* I gets number of characters left to copy. */
167 i = pos - new_s1;
168 if (i == 0)
169 break;
170 /* If a quit is requested, stop copying now.
171 Change POS to be where we have actually moved the gap to. */
172 if (QUITP)
173 {
174 pos = new_s1;
175 break;
176 }
177 /* Move at most 32000 chars before checking again for a quit. */
178 if (i > 32000)
179 i = 32000;
180 #ifdef GAP_USE_BCOPY
181 if (i >= 128
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))
186 {
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)
190 i = from - to;
191 new_s1 += i;
192 bcopy (from, to, i);
193 from += i, to += i;
194 }
195 else
196 #endif
197 {
198 new_s1 += i;
199 while (--i >= 0)
200 *to++ = *from++;
201 }
202 }
203
204 adjust_markers (GPT + GAP_SIZE, pos + 1 + GAP_SIZE, - GAP_SIZE);
205 GPT = pos + 1;
206 QUIT;
207 }
208
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'. */
214
215 static void
216 adjust_markers (from, to, amount)
217 register int from, to, amount;
218 {
219 Lisp_Object marker;
220 register struct Lisp_Marker *m;
221 register int mpos;
222
223 marker = current_buffer->markers;
224
225 while (!NILP (marker))
226 {
227 m = XMARKER (marker);
228 mpos = m->bufpos;
229 if (amount > 0)
230 {
231 if (mpos > to && mpos < to + amount)
232 mpos = to + amount;
233 }
234 else
235 {
236 if (mpos > from + amount && mpos <= from)
237 mpos = from + amount;
238 }
239 if (mpos > from && mpos <= to)
240 mpos += amount;
241 m->bufpos = mpos;
242 marker = m->chain;
243 }
244 }
245
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. */
253 static void
254 adjust_point (amount)
255 {
256 current_buffer->text.pt += amount;
257 }
258 \f
259 /* Make the gap INCREMENT characters longer. */
260
261 make_gap (increment)
262 int increment;
263 {
264 unsigned char *result;
265 Lisp_Object tem;
266 int real_gap_loc;
267 int old_gap_size;
268
269 /* If we have to get more space, get enough to last a while. */
270 increment += 2000;
271
272 BLOCK_INPUT;
273 result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment));
274 UNBLOCK_INPUT;
275
276 if (result == 0)
277 memory_full ();
278 BEG_ADDR = result;
279
280 /* Prevent quitting in move_gap. */
281 tem = Vinhibit_quit;
282 Vinhibit_quit = Qt;
283
284 real_gap_loc = GPT;
285 old_gap_size = GAP_SIZE;
286
287 /* Call the newly allocated space a gap at the end of the whole space. */
288 GPT = Z + GAP_SIZE;
289 GAP_SIZE = increment;
290
291 /* Move the new gap down to be consecutive with the end of the old one.
292 This adjusts the markers properly too. */
293 gap_left (real_gap_loc + old_gap_size, 1);
294
295 /* Now combine the two into one large gap. */
296 GAP_SIZE += old_gap_size;
297 GPT = real_gap_loc;
298
299 Vinhibit_quit = tem;
300 }
301 \f
302 /* Insert a string of specified length before point.
303 DO NOT use this for the contents of a Lisp string!
304 prepare_to_modify_buffer could relocate the string. */
305
306 insert (string, length)
307 register unsigned char *string;
308 register length;
309 {
310 if (length > 0)
311 {
312 insert_1 (string, length, 0);
313 signal_after_change (PT-length, 0, length);
314 }
315 }
316
317 insert_and_inherit (string, length)
318 register unsigned char *string;
319 register length;
320 {
321 if (length > 0)
322 {
323 insert_1 (string, length, 1);
324 signal_after_change (PT-length, 0, length);
325 }
326 }
327
328 static void
329 insert_1 (string, length, inherit)
330 register unsigned char *string;
331 register length;
332 int inherit;
333 {
334 register Lisp_Object temp;
335
336 /* Make sure point-max won't overflow after this insertion. */
337 XSET (temp, Lisp_Int, length + Z);
338 if (length + Z != XINT (temp))
339 error ("maximum buffer size exceeded");
340
341 prepare_to_modify_buffer (PT, PT);
342
343 if (PT != GPT)
344 move_gap (PT);
345 if (GAP_SIZE < length)
346 make_gap (length - GAP_SIZE);
347
348 record_insert (PT, length);
349 MODIFF++;
350
351 bcopy (string, GPT_ADDR, length);
352
353 #ifdef USE_TEXT_PROPERTIES
354 if (current_buffer->intervals != 0)
355 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
356 offset_intervals (current_buffer, PT, length);
357 #endif
358
359 GAP_SIZE -= length;
360 GPT += length;
361 ZV += length;
362 Z += length;
363 adjust_point (length);
364
365 #ifdef USE_TEXT_PROPERTIES
366 if (!inherit && current_buffer->intervals != 0)
367 Fset_text_properties (make_number (PT - length), make_number (PT),
368 Qnil, Qnil);
369 #endif
370 }
371
372 /* Insert the part of the text of STRING, a Lisp object assumed to be
373 of type string, consisting of the LENGTH characters starting at
374 position POS. If the text of STRING has properties, they are absorbed
375 into the buffer.
376
377 It does not work to use `insert' for this, because a GC could happen
378 before we bcopy the stuff into the buffer, and relocate the string
379 without insert noticing. */
380
381 insert_from_string (string, pos, length, inherit)
382 Lisp_Object string;
383 register int pos, length;
384 int inherit;
385 {
386 if (length > 0)
387 {
388 insert_from_string_1 (string, pos, length, inherit);
389 signal_after_change (PT-length, 0, length);
390 }
391 }
392
393 static void
394 insert_from_string_1 (string, pos, length, inherit)
395 Lisp_Object string;
396 register int pos, length;
397 int inherit;
398 {
399 register Lisp_Object temp;
400 struct gcpro gcpro1;
401
402 /* Make sure point-max won't overflow after this insertion. */
403 XSET (temp, Lisp_Int, length + Z);
404 if (length + Z != XINT (temp))
405 error ("maximum buffer size exceeded");
406
407 GCPRO1 (string);
408 prepare_to_modify_buffer (PT, PT);
409
410 if (PT != GPT)
411 move_gap (PT);
412 if (GAP_SIZE < length)
413 make_gap (length - GAP_SIZE);
414
415 record_insert (PT, length);
416 MODIFF++;
417 UNGCPRO;
418
419 bcopy (XSTRING (string)->data, GPT_ADDR, length);
420
421 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
422 offset_intervals (current_buffer, PT, length);
423
424 GAP_SIZE -= length;
425 GPT += length;
426 ZV += length;
427 Z += length;
428
429 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
430 graft_intervals_into_buffer (XSTRING (string)->intervals, PT, length,
431 current_buffer, inherit);
432
433 adjust_point (length);
434 }
435
436 /* Insert the character C before point */
437
438 void
439 insert_char (c)
440 unsigned char c;
441 {
442 insert (&c, 1);
443 }
444
445 /* Insert the null-terminated string S before point */
446
447 void
448 insert_string (s)
449 char *s;
450 {
451 insert (s, strlen (s));
452 }
453
454 /* Like `insert' except that all markers pointing at the place where
455 the insertion happens are adjusted to point after it.
456 Don't use this function to insert part of a Lisp string,
457 since gc could happen and relocate it. */
458
459 insert_before_markers (string, length)
460 unsigned char *string;
461 register int length;
462 {
463 if (length > 0)
464 {
465 register int opoint = PT;
466 insert_1 (string, length, 1);
467 adjust_markers (opoint - 1, opoint, length);
468 signal_after_change (PT-length, 0, length);
469 }
470 }
471
472 insert_before_markers_and_inherit (string, length)
473 unsigned char *string;
474 register int length;
475 {
476 if (length > 0)
477 {
478 register int opoint = PT;
479 insert_1 (string, length, 1);
480 adjust_markers (opoint - 1, opoint, length);
481 signal_after_change (PT-length, 0, length);
482 }
483 }
484
485 /* Insert part of a Lisp string, relocating markers after. */
486
487 insert_from_string_before_markers (string, pos, length, inherit)
488 Lisp_Object string;
489 register int pos, length;
490 int inherit;
491 {
492 if (length > 0)
493 {
494 register int opoint = PT;
495 insert_from_string_1 (string, pos, length, inherit);
496 adjust_markers (opoint - 1, opoint, length);
497 signal_after_change (PT-length, 0, length);
498 }
499 }
500 \f
501 /* Delete characters in current buffer
502 from FROM up to (but not including) TO. */
503
504 del_range (from, to)
505 register int from, to;
506 {
507 return del_range_1 (from, to, 1);
508 }
509
510 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
511
512 del_range_1 (from, to, prepare)
513 register int from, to, prepare;
514 {
515 register int numdel;
516
517 /* Make args be valid */
518 if (from < BEGV)
519 from = BEGV;
520 if (to > ZV)
521 to = ZV;
522
523 if ((numdel = to - from) <= 0)
524 return;
525
526 /* Make sure the gap is somewhere in or next to what we are deleting. */
527 if (from > GPT)
528 gap_right (from);
529 if (to < GPT)
530 gap_left (to, 0);
531
532 if (prepare)
533 prepare_to_modify_buffer (from, to);
534
535 record_delete (from, numdel);
536 MODIFF++;
537
538 /* Relocate point as if it were a marker. */
539 if (from < PT)
540 adjust_point (from - (PT < to ? PT : to));
541
542 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
543 offset_intervals (current_buffer, from, - numdel);
544
545 /* Relocate all markers pointing into the new, larger gap
546 to point at the end of the text before the gap. */
547 adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
548
549 GAP_SIZE += numdel;
550 ZV -= numdel;
551 Z -= numdel;
552 GPT = from;
553
554 if (GPT - BEG < beg_unchanged)
555 beg_unchanged = GPT - BEG;
556 if (Z - GPT < end_unchanged)
557 end_unchanged = Z - GPT;
558
559 signal_after_change (from, numdel, 0);
560 }
561 \f
562 /* Call this if you're about to change the region of BUFFER from START
563 to END. This checks the read-only properties of the region, calls
564 the necessary modification hooks, and warns the next redisplay that
565 it should pay attention to that area. */
566 modify_region (buffer, start, end)
567 struct buffer *buffer;
568 int start, end;
569 {
570 struct buffer *old_buffer = current_buffer;
571
572 if (buffer != old_buffer)
573 set_buffer_internal (buffer);
574
575 prepare_to_modify_buffer (start, end);
576
577 if (start - 1 < beg_unchanged || unchanged_modified == MODIFF)
578 beg_unchanged = start - 1;
579 if (Z - end < end_unchanged
580 || unchanged_modified == MODIFF)
581 end_unchanged = Z - end;
582
583 if (MODIFF <= current_buffer->save_modified)
584 record_first_change ();
585 MODIFF++;
586
587 if (buffer != old_buffer)
588 set_buffer_internal (old_buffer);
589 }
590
591 /* Check that it is okay to modify the buffer between START and END.
592 Run the before-change-function, if any. If intervals are in use,
593 verify that the text to be modified is not read-only, and call
594 any modification properties the text may have. */
595
596 prepare_to_modify_buffer (start, end)
597 Lisp_Object start, end;
598 {
599 if (!NILP (current_buffer->read_only))
600 Fbarf_if_buffer_read_only ();
601
602 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
603 if (current_buffer->intervals != 0)
604 verify_interval_modification (current_buffer, start, end);
605
606 if (!NILP (current_buffer->overlays_before)
607 || !NILP (current_buffer->overlays_after))
608 verify_overlay_modification (start, end);
609
610 #ifdef CLASH_DETECTION
611 if (!NILP (current_buffer->filename)
612 && current_buffer->save_modified >= MODIFF)
613 lock_file (current_buffer->filename);
614 #else
615 /* At least warn if this file has changed on disk since it was visited. */
616 if (!NILP (current_buffer->filename)
617 && current_buffer->save_modified >= MODIFF
618 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
619 && !NILP (Ffile_exists_p (current_buffer->filename)))
620 call1 (intern ("ask-user-about-supersession-threat"),
621 current_buffer->filename);
622 #endif /* not CLASH_DETECTION */
623
624 signal_before_change (start, end);
625
626 Vdeactivate_mark = Qt;
627 }
628 \f
629 static Lisp_Object
630 before_change_function_restore (value)
631 Lisp_Object value;
632 {
633 Vbefore_change_function = value;
634 }
635
636 static Lisp_Object
637 after_change_function_restore (value)
638 Lisp_Object value;
639 {
640 Vafter_change_function = value;
641 }
642
643 static Lisp_Object
644 before_change_functions_restore (value)
645 Lisp_Object value;
646 {
647 Vbefore_change_functions = value;
648 }
649
650 static Lisp_Object
651 after_change_functions_restore (value)
652 Lisp_Object value;
653 {
654 Vafter_change_functions = value;
655 }
656
657 /* Signal a change to the buffer immediately before it happens.
658 START and END are the bounds of the text to be changed,
659 as Lisp objects. */
660
661 signal_before_change (start, end)
662 Lisp_Object start, end;
663 {
664 /* If buffer is unmodified, run a special hook for that case. */
665 if (current_buffer->save_modified >= MODIFF
666 && !NILP (Vfirst_change_hook)
667 && !NILP (Vrun_hooks))
668 call1 (Vrun_hooks, Qfirst_change_hook);
669
670 /* Now in any case run the before-change-function if any. */
671 if (!NILP (Vbefore_change_function))
672 {
673 int count = specpdl_ptr - specpdl;
674 Lisp_Object function;
675
676 function = Vbefore_change_function;
677
678 record_unwind_protect (after_change_function_restore,
679 Vafter_change_function);
680 record_unwind_protect (before_change_function_restore,
681 Vbefore_change_function);
682 record_unwind_protect (after_change_functions_restore,
683 Vafter_change_functions);
684 record_unwind_protect (before_change_functions_restore,
685 Vbefore_change_functions);
686 Vafter_change_function = Qnil;
687 Vbefore_change_function = Qnil;
688 Vafter_change_functions = Qnil;
689 Vbefore_change_functions = Qnil;
690
691 call2 (function, start, end);
692 unbind_to (count, Qnil);
693 }
694
695 /* Now in any case run the before-change-function if any. */
696 if (!NILP (Vbefore_change_functions))
697 {
698 int count = specpdl_ptr - specpdl;
699 Lisp_Object functions;
700
701 functions = Vbefore_change_functions;
702
703 record_unwind_protect (after_change_function_restore,
704 Vafter_change_function);
705 record_unwind_protect (before_change_function_restore,
706 Vbefore_change_function);
707 record_unwind_protect (after_change_functions_restore,
708 Vafter_change_functions);
709 record_unwind_protect (before_change_functions_restore,
710 Vbefore_change_functions);
711 Vafter_change_function = Qnil;
712 Vbefore_change_function = Qnil;
713 Vafter_change_functions = Qnil;
714 Vbefore_change_functions = Qnil;
715
716 while (CONSP (functions))
717 {
718 call2 (XCONS (functions)->car, start, end);
719 functions = XCONS (functions)->cdr;
720 }
721 unbind_to (count, Qnil);
722 }
723 }
724
725 /* Signal a change immediately after it happens.
726 POS is the address of the start of the changed text.
727 LENDEL is the number of characters of the text before the change.
728 (Not the whole buffer; just the part that was changed.)
729 LENINS is the number of characters in the changed text. */
730
731 signal_after_change (pos, lendel, lenins)
732 int pos, lendel, lenins;
733 {
734 if (!NILP (Vafter_change_function))
735 {
736 int count = specpdl_ptr - specpdl;
737 Lisp_Object function;
738 function = Vafter_change_function;
739
740 record_unwind_protect (after_change_function_restore,
741 Vafter_change_function);
742 record_unwind_protect (before_change_function_restore,
743 Vbefore_change_function);
744 record_unwind_protect (after_change_functions_restore,
745 Vafter_change_functions);
746 record_unwind_protect (before_change_functions_restore,
747 Vbefore_change_functions);
748 Vafter_change_function = Qnil;
749 Vbefore_change_function = Qnil;
750 Vafter_change_functions = Qnil;
751 Vbefore_change_functions = Qnil;
752
753 call3 (function, make_number (pos), make_number (pos + lenins),
754 make_number (lendel));
755 unbind_to (count, Qnil);
756 }
757 if (!NILP (Vafter_change_functions))
758 {
759 int count = specpdl_ptr - specpdl;
760 Lisp_Object functions;
761 functions = Vafter_change_functions;
762
763 record_unwind_protect (after_change_function_restore,
764 Vafter_change_function);
765 record_unwind_protect (before_change_function_restore,
766 Vbefore_change_function);
767 record_unwind_protect (after_change_functions_restore,
768 Vafter_change_functions);
769 record_unwind_protect (before_change_functions_restore,
770 Vbefore_change_functions);
771 Vafter_change_function = Qnil;
772 Vbefore_change_function = Qnil;
773 Vafter_change_functions = Qnil;
774 Vbefore_change_functions = Qnil;
775
776 while (CONSP (functions))
777 {
778 call3 (XCONS (functions)->car,
779 make_number (pos), make_number (pos + lenins),
780 make_number (lendel));
781 functions = XCONS (functions)->cdr;
782 }
783 unbind_to (count, Qnil);
784 }
785 }