(copy_text): When copying from multibyte to unibyte, do
[bpt/emacs.git] / src / insdel.c
1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 86, 93, 94, 95, 97, 1998 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 2, 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21
22 #include <config.h>
23 #include "lisp.h"
24 #include "intervals.h"
25 #include "buffer.h"
26 #include "charset.h"
27 #include "window.h"
28 #include "blockinput.h"
29
30 #ifndef NULL
31 #define NULL 0
32 #endif
33
34 #define min(x, y) ((x) < (y) ? (x) : (y))
35
36 static void insert_from_string_1 P_ ((Lisp_Object, int, int, int, int, int, int));
37 static void insert_from_buffer_1 ();
38 static void gap_left P_ ((int, int, int));
39 static void gap_right P_ ((int, int));
40 static void adjust_markers_gap_motion P_ ((int, int, int));
41 static void adjust_markers_for_insert P_ ((int, int, int, int, int));
42 static void adjust_markers_for_delete P_ ((int, int, int, int));
43 static void adjust_point P_ ((int, int));
44
45 Lisp_Object Fcombine_after_change_execute ();
46
47 /* Non-nil means don't call the after-change-functions right away,
48 just record an element in Vcombine_after_change_calls_list. */
49 Lisp_Object Vcombine_after_change_calls;
50
51 /* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
52 describing changes which happened while combine_after_change_calls
53 was nonzero. We use this to decide how to call them
54 once the deferral ends.
55
56 In each element.
57 BEG-UNCHANGED is the number of chars before the changed range.
58 END-UNCHANGED is the number of chars after the changed range,
59 and CHANGE-AMOUNT is the number of characters inserted by the change
60 (negative for a deletion). */
61 Lisp_Object combine_after_change_list;
62
63 /* Buffer which combine_after_change_list is about. */
64 Lisp_Object combine_after_change_buffer;
65
66 #define DEFAULT_NONASCII_INSERT_OFFSET 0x800
67 \f
68 /* Move gap to position CHARPOS.
69 Note that this can quit! */
70
71 void
72 move_gap (charpos)
73 int charpos;
74 {
75 move_gap_both (charpos, charpos_to_bytepos (charpos));
76 }
77
78 /* Move gap to byte position BYTEPOS, which is also char position CHARPOS.
79 Note that this can quit! */
80
81 void
82 move_gap_both (charpos, bytepos)
83 int charpos, bytepos;
84 {
85 if (bytepos < GPT_BYTE)
86 gap_left (charpos, bytepos, 0);
87 else if (bytepos > GPT_BYTE)
88 gap_right (charpos, bytepos);
89 }
90
91 /* Move the gap to a position less than the current GPT.
92 BYTEPOS describes the new position as a byte position,
93 and CHARPOS is the corresponding char position.
94 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
95
96 static void
97 gap_left (charpos, bytepos, newgap)
98 register int charpos, bytepos;
99 int newgap;
100 {
101 register unsigned char *to, *from;
102 register int i;
103 int new_s1;
104
105 if (!newgap)
106 {
107 if (unchanged_modified == MODIFF
108 && overlay_unchanged_modified == OVERLAY_MODIFF)
109 {
110 beg_unchanged = charpos - BEG;
111 end_unchanged = Z - charpos;
112 }
113 else
114 {
115 if (Z - GPT < end_unchanged)
116 end_unchanged = Z - GPT;
117 if (charpos < beg_unchanged)
118 beg_unchanged = charpos - BEG;
119 }
120 }
121
122 i = GPT_BYTE;
123 to = GAP_END_ADDR;
124 from = GPT_ADDR;
125 new_s1 = GPT_BYTE;
126
127 /* Now copy the characters. To move the gap down,
128 copy characters up. */
129
130 while (1)
131 {
132 /* I gets number of characters left to copy. */
133 i = new_s1 - bytepos;
134 if (i == 0)
135 break;
136 /* If a quit is requested, stop copying now.
137 Change BYTEPOS to be where we have actually moved the gap to. */
138 if (QUITP)
139 {
140 bytepos = new_s1;
141 charpos = BYTE_TO_CHAR (bytepos);
142 break;
143 }
144 /* Move at most 32000 chars before checking again for a quit. */
145 if (i > 32000)
146 i = 32000;
147 #ifdef GAP_USE_BCOPY
148 if (i >= 128
149 /* bcopy is safe if the two areas of memory do not overlap
150 or on systems where bcopy is always safe for moving upward. */
151 && (BCOPY_UPWARD_SAFE
152 || to - from >= 128))
153 {
154 /* If overlap is not safe, avoid it by not moving too many
155 characters at once. */
156 if (!BCOPY_UPWARD_SAFE && i > to - from)
157 i = to - from;
158 new_s1 -= i;
159 from -= i, to -= i;
160 bcopy (from, to, i);
161 }
162 else
163 #endif
164 {
165 new_s1 -= i;
166 while (--i >= 0)
167 *--to = *--from;
168 }
169 }
170
171 /* Adjust markers, and buffer data structure, to put the gap at BYTEPOS.
172 BYTEPOS is where the loop above stopped, which may be what was specified
173 or may be where a quit was detected. */
174 adjust_markers_gap_motion (bytepos, GPT_BYTE, GAP_SIZE);
175 GPT_BYTE = bytepos;
176 GPT = charpos;
177 if (bytepos < charpos)
178 abort ();
179 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
180 QUIT;
181 }
182
183 /* Move the gap to a position greater than than the current GPT.
184 BYTEPOS describes the new position as a byte position,
185 and CHARPOS is the corresponding char position. */
186
187 static void
188 gap_right (charpos, bytepos)
189 register int charpos, bytepos;
190 {
191 register unsigned char *to, *from;
192 register int i;
193 int new_s1;
194
195 if (unchanged_modified == MODIFF
196 && overlay_unchanged_modified == OVERLAY_MODIFF)
197 {
198 beg_unchanged = charpos - BEG;
199 end_unchanged = Z - charpos;
200 }
201 else
202 {
203 if (Z - charpos - 1 < end_unchanged)
204 end_unchanged = Z - charpos;
205 if (GPT - BEG < beg_unchanged)
206 beg_unchanged = GPT - BEG;
207 }
208
209 i = GPT_BYTE;
210 from = GAP_END_ADDR;
211 to = GPT_ADDR;
212 new_s1 = GPT_BYTE;
213
214 /* Now copy the characters. To move the gap up,
215 copy characters down. */
216
217 while (1)
218 {
219 /* I gets number of characters left to copy. */
220 i = bytepos - new_s1;
221 if (i == 0)
222 break;
223 /* If a quit is requested, stop copying now.
224 Change BYTEPOS to be where we have actually moved the gap to. */
225 if (QUITP)
226 {
227 bytepos = new_s1;
228 charpos = BYTE_TO_CHAR (bytepos);
229 break;
230 }
231 /* Move at most 32000 chars before checking again for a quit. */
232 if (i > 32000)
233 i = 32000;
234 #ifdef GAP_USE_BCOPY
235 if (i >= 128
236 /* bcopy is safe if the two areas of memory do not overlap
237 or on systems where bcopy is always safe for moving downward. */
238 && (BCOPY_DOWNWARD_SAFE
239 || from - to >= 128))
240 {
241 /* If overlap is not safe, avoid it by not moving too many
242 characters at once. */
243 if (!BCOPY_DOWNWARD_SAFE && i > from - to)
244 i = from - to;
245 new_s1 += i;
246 bcopy (from, to, i);
247 from += i, to += i;
248 }
249 else
250 #endif
251 {
252 new_s1 += i;
253 while (--i >= 0)
254 *to++ = *from++;
255 }
256 }
257
258 adjust_markers_gap_motion (GPT_BYTE + GAP_SIZE, bytepos + GAP_SIZE,
259 - GAP_SIZE);
260 GPT = charpos;
261 GPT_BYTE = bytepos;
262 if (bytepos < charpos)
263 abort ();
264 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
265 QUIT;
266 }
267 \f
268 /* Add AMOUNT to the byte position of every marker in the current buffer
269 whose current byte position is between FROM (exclusive) and TO (inclusive).
270
271 Also, any markers past the outside of that interval, in the direction
272 of adjustment, are first moved back to the near end of the interval
273 and then adjusted by AMOUNT.
274
275 When the latter adjustment is done, if AMOUNT is negative,
276 we record the adjustment for undo. (This case happens only for
277 deletion.)
278
279 The markers' character positions are not altered,
280 because gap motion does not affect character positions. */
281
282 int adjust_markers_test;
283
284 static void
285 adjust_markers_gap_motion (from, to, amount)
286 register int from, to, amount;
287 {
288 /* Now that a marker has a bytepos, not counting the gap,
289 nothing needs to be done here. */
290 #if 0
291 Lisp_Object marker;
292 register struct Lisp_Marker *m;
293 register int mpos;
294
295 marker = BUF_MARKERS (current_buffer);
296
297 while (!NILP (marker))
298 {
299 m = XMARKER (marker);
300 mpos = m->bytepos;
301 if (amount > 0)
302 {
303 if (mpos > to && mpos < to + amount)
304 {
305 if (adjust_markers_test)
306 abort ();
307 mpos = to + amount;
308 }
309 }
310 else
311 {
312 /* Here's the case where a marker is inside text being deleted.
313 AMOUNT can be negative for gap motion, too,
314 but then this range contains no markers. */
315 if (mpos > from + amount && mpos <= from)
316 {
317 if (adjust_markers_test)
318 abort ();
319 mpos = from + amount;
320 }
321 }
322 if (mpos > from && mpos <= to)
323 mpos += amount;
324 m->bufpos = mpos;
325 marker = m->chain;
326 }
327 #endif
328 }
329 \f
330 /* Adjust all markers for a deletion
331 whose range in bytes is FROM_BYTE to TO_BYTE.
332 The range in charpos is FROM to TO.
333
334 This function assumes that the gap is adjacent to
335 or inside of the range being deleted. */
336
337 static void
338 adjust_markers_for_delete (from, from_byte, to, to_byte)
339 register int from, from_byte, to, to_byte;
340 {
341 Lisp_Object marker;
342 register struct Lisp_Marker *m;
343 register int charpos;
344 /* This is what GAP_SIZE will be when this deletion is finished. */
345 int coming_gap_size = GAP_SIZE + to_byte - from_byte;
346
347 marker = BUF_MARKERS (current_buffer);
348
349 while (!NILP (marker))
350 {
351 m = XMARKER (marker);
352 charpos = m->charpos;
353
354 if (charpos > Z)
355 abort ();
356
357 /* If the marker is after the deletion,
358 relocate by number of chars / bytes deleted. */
359 if (charpos > to)
360 {
361 m->charpos -= to - from;
362 m->bytepos -= to_byte - from_byte;
363 }
364
365 /* Here's the case where a marker is inside text being deleted. */
366 else if (charpos > from)
367 {
368 record_marker_adjustment (marker, from - charpos);
369 m->charpos = from;
370 m->bytepos = from_byte;
371 }
372
373 /* In a single-byte buffer, a marker's two positions must be equal. */
374 if (Z == Z_BYTE)
375 {
376 register int i = m->bytepos;
377
378 #if 0
379 /* We use FROM_BYTE here instead of GPT_BYTE
380 because FROM_BYTE is where the gap will be after the deletion. */
381 if (i > from_byte + coming_gap_size)
382 i -= coming_gap_size;
383 else if (i > from_byte)
384 i = from_byte;
385 #endif
386
387 if (m->charpos != i)
388 abort ();
389 }
390
391 marker = m->chain;
392 }
393 }
394 \f
395 /* Adjust markers for an insertion at CHARPOS / BYTEPOS
396 consisting of NCHARS chars, which are NBYTES bytes.
397
398 We have to relocate the charpos of every marker that points
399 after the insertion (but not their bytepos).
400
401 When a marker points at the insertion point,
402 we advance it if either its insertion-type is t
403 or BEFORE_MARKERS is true. */
404
405 static void
406 adjust_markers_for_insert (from, from_byte, to, to_byte, before_markers)
407 register int from, from_byte, to, to_byte, before_markers;
408 {
409 Lisp_Object marker;
410 int adjusted = 0;
411 int nchars = to - from;
412 int nbytes = to_byte - from_byte;
413
414 marker = BUF_MARKERS (current_buffer);
415
416 while (!NILP (marker))
417 {
418 register struct Lisp_Marker *m = XMARKER (marker);
419 if (m->bytepos == from_byte
420 && (m->insertion_type || before_markers))
421 {
422 m->bytepos += nbytes;
423 m->charpos += nchars;
424 if (m->insertion_type)
425 adjusted = 1;
426 }
427 else if (m->bytepos > from_byte)
428 {
429 m->bytepos += nbytes;
430 m->charpos += nchars;
431 }
432
433 /* In a single-byte buffer, a marker's two positions must be equal. */
434 if (Z == Z_BYTE)
435 {
436 register int i = m->bytepos;
437
438 #if 0
439 if (i > GPT_BYTE + GAP_SIZE)
440 i -= GAP_SIZE;
441 else if (i > GPT_BYTE)
442 i = GPT_BYTE;
443 #endif
444
445 if (m->charpos != i)
446 abort ();
447 }
448
449 marker = m->chain;
450 }
451
452 /* Adjusting only markers whose insertion-type is t may result in
453 disordered overlays in the slot `overlays_before'. */
454 if (adjusted)
455 fix_overlays_before (current_buffer, from, to);
456 }
457
458 /* Adjust point for an insertion of NBYTES bytes, which are NCHARS characters.
459
460 This is used only when the value of point changes due to an insert
461 or delete; it does not represent a conceptual change in point as a
462 marker. In particular, point is not crossing any interval
463 boundaries, so there's no need to use the usual SET_PT macro. In
464 fact it would be incorrect to do so, because either the old or the
465 new value of point is out of sync with the current set of
466 intervals. */
467
468 static void
469 adjust_point (nchars, nbytes)
470 int nchars, nbytes;
471 {
472 BUF_PT (current_buffer) += nchars;
473 BUF_PT_BYTE (current_buffer) += nbytes;
474
475 /* In a single-byte buffer, the two positions must be equal. */
476 if (ZV == ZV_BYTE
477 && PT != PT_BYTE)
478 abort ();
479 }
480 \f
481 /* Make the gap NBYTES_ADDED bytes longer. */
482
483 void
484 make_gap (nbytes_added)
485 int nbytes_added;
486 {
487 unsigned char *result;
488 Lisp_Object tem;
489 int real_gap_loc;
490 int real_gap_loc_byte;
491 int old_gap_size;
492
493 /* If we have to get more space, get enough to last a while. */
494 nbytes_added += 2000;
495
496 /* Don't allow a buffer size that won't fit in an int
497 even if it will fit in a Lisp integer.
498 That won't work because so many places use `int'. */
499
500 if (Z_BYTE - BEG_BYTE + GAP_SIZE + nbytes_added
501 >= ((unsigned) 1 << (min (BITS_PER_INT, VALBITS) - 1)))
502 error ("Buffer exceeds maximum size");
503
504 BLOCK_INPUT;
505 /* We allocate extra 1-byte `\0' at the tail for anchoring a search. */
506 result = BUFFER_REALLOC (BEG_ADDR, (Z_BYTE - BEG_BYTE
507 + GAP_SIZE + nbytes_added + 1));
508
509 if (result == 0)
510 {
511 UNBLOCK_INPUT;
512 memory_full ();
513 }
514
515 /* We can't unblock until the new address is properly stored. */
516 BEG_ADDR = result;
517 UNBLOCK_INPUT;
518
519 /* Prevent quitting in move_gap. */
520 tem = Vinhibit_quit;
521 Vinhibit_quit = Qt;
522
523 real_gap_loc = GPT;
524 real_gap_loc_byte = GPT_BYTE;
525 old_gap_size = GAP_SIZE;
526
527 /* Call the newly allocated space a gap at the end of the whole space. */
528 GPT = Z + GAP_SIZE;
529 GPT_BYTE = Z_BYTE + GAP_SIZE;
530 GAP_SIZE = nbytes_added;
531
532 /* Move the new gap down to be consecutive with the end of the old one.
533 This adjusts the markers properly too. */
534 gap_left (real_gap_loc + old_gap_size, real_gap_loc_byte + old_gap_size, 1);
535
536 /* Now combine the two into one large gap. */
537 GAP_SIZE += old_gap_size;
538 GPT = real_gap_loc;
539 GPT_BYTE = real_gap_loc_byte;
540
541 /* Put an anchor. */
542 *(Z_ADDR) = 0;
543
544 Vinhibit_quit = tem;
545 }
546 \f
547 /* Copy NBYTES bytes of text from FROM_ADDR to TO_ADDR.
548 FROM_MULTIBYTE says whether the incoming text is multibyte.
549 TO_MULTIBYTE says whether to store the text as multibyte.
550 If FROM_MULTIBYTE != TO_MULTIBYTE, we convert.
551
552 Return the number of bytes stored at TO_ADDR. */
553
554 int
555 copy_text (from_addr, to_addr, nbytes,
556 from_multibyte, to_multibyte)
557 unsigned char *from_addr;
558 unsigned char *to_addr;
559 int nbytes;
560 int from_multibyte, to_multibyte;
561 {
562 if (from_multibyte == to_multibyte)
563 {
564 bcopy (from_addr, to_addr, nbytes);
565 return nbytes;
566 }
567 else if (from_multibyte)
568 {
569 int nchars = 0;
570 int bytes_left = nbytes;
571
572 /* Convert multibyte to single byte. */
573 while (bytes_left > 0)
574 {
575 int thislen, c;
576 c = STRING_CHAR_AND_LENGTH (from_addr, bytes_left, thislen);
577 *to_addr++ = SINGLE_BYTE_CHAR_P (c) ? c : (c & 0177) + 0200;
578 from_addr += thislen;
579 bytes_left--;
580 nchars++;
581 }
582 return nchars;
583 }
584 else
585 {
586 unsigned char *initial_to_addr = to_addr;
587
588 /* Convert single-byte to multibyte. */
589 while (nbytes > 0)
590 {
591 int c = *from_addr++;
592 unsigned char workbuf[4], *str;
593 int len;
594
595 if (c >= 0200 && c < 0400)
596 {
597 if (nonascii_insert_offset > 0)
598 c += nonascii_insert_offset;
599 else
600 c += DEFAULT_NONASCII_INSERT_OFFSET;
601
602 len = CHAR_STRING (c, workbuf, str);
603 bcopy (str, to_addr, len);
604 to_addr += len;
605 nbytes--;
606 }
607 else
608 /* Special case for speed. */
609 *to_addr++ = c, nbytes--;
610 }
611 return to_addr - initial_to_addr;
612 }
613 }
614
615 /* Return the number of bytes it would take
616 to convert some single-byte text to multibyte.
617 The single-byte text consists of NBYTES bytes at PTR. */
618
619 int
620 count_size_as_multibyte (ptr, nbytes)
621 unsigned char *ptr;
622 int nbytes;
623 {
624 int i;
625 int outgoing_nbytes = 0;
626
627 for (i = 0; i < nbytes; i++)
628 {
629 unsigned int c = *ptr++;
630 if (c >= 0200 && c < 0400)
631 {
632 if (nonascii_insert_offset > 0)
633 c += nonascii_insert_offset;
634 else
635 c += DEFAULT_NONASCII_INSERT_OFFSET;
636 }
637 outgoing_nbytes += XINT (Fchar_bytes (make_number (c)));
638 }
639
640 return outgoing_nbytes;
641 }
642 \f
643 /* Insert a string of specified length before point.
644 This function judges multibyteness based on
645 enable_multibyte_characters in the current buffer;
646 it never converts between single-byte and multibyte.
647
648 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
649 prepare_to_modify_buffer could relocate the text. */
650
651 void
652 insert (string, nbytes)
653 register unsigned char *string;
654 register nbytes;
655 {
656 if (nbytes > 0)
657 {
658 int opoint = PT;
659 insert_1 (string, nbytes, 0, 1, 0);
660 signal_after_change (opoint, 0, PT - opoint);
661 }
662 }
663
664 /* Likewise, but inherit text properties from neighboring characters. */
665
666 void
667 insert_and_inherit (string, nbytes)
668 register unsigned char *string;
669 register nbytes;
670 {
671 if (nbytes > 0)
672 {
673 int opoint = PT;
674 insert_1 (string, nbytes, 1, 1, 0);
675 signal_after_change (opoint, 0, PT - opoint);
676 }
677 }
678
679 /* Insert the character C before point. Do not inherit text properties. */
680
681 void
682 insert_char (c)
683 int c;
684 {
685 unsigned char workbuf[4], *str;
686 int len;
687
688 if (! NILP (current_buffer->enable_multibyte_characters))
689 len = CHAR_STRING (c, workbuf, str);
690 else
691 {
692 len = 1;
693 workbuf[0] = c;
694 str = workbuf;
695 }
696
697 insert (str, len);
698 }
699
700 /* Insert the null-terminated string S before point. */
701
702 void
703 insert_string (s)
704 char *s;
705 {
706 insert (s, strlen (s));
707 }
708
709 /* Like `insert' except that all markers pointing at the place where
710 the insertion happens are adjusted to point after it.
711 Don't use this function to insert part of a Lisp string,
712 since gc could happen and relocate it. */
713
714 void
715 insert_before_markers (string, nbytes)
716 unsigned char *string;
717 register int nbytes;
718 {
719 if (nbytes > 0)
720 {
721 int opoint = PT;
722
723 insert_1 (string, nbytes, 0, 1, 1);
724 signal_after_change (opoint, 0, PT - opoint);
725 }
726 }
727
728 /* Likewise, but inherit text properties from neighboring characters. */
729
730 void
731 insert_before_markers_and_inherit (string, nbytes)
732 unsigned char *string;
733 register int nbytes;
734 {
735 if (nbytes > 0)
736 {
737 int opoint = PT;
738
739 insert_1 (string, nbytes, 1, 1, 1);
740 signal_after_change (opoint, 0, PT - opoint);
741 }
742 }
743 \f
744 /* Subroutine used by the insert functions above. */
745
746 void
747 insert_1 (string, nbytes, inherit, prepare, before_markers)
748 register unsigned char *string;
749 register int nbytes;
750 int inherit, prepare, before_markers;
751 {
752 register Lisp_Object temp;
753 int nchars = chars_in_text (string, nbytes);
754
755 if (prepare)
756 prepare_to_modify_buffer (PT, PT, NULL);
757
758 if (PT != GPT)
759 move_gap_both (PT, PT_BYTE);
760 if (GAP_SIZE < nbytes)
761 make_gap (nbytes - GAP_SIZE);
762
763 record_insert (PT, nchars);
764 MODIFF++;
765
766 bcopy (string, GPT_ADDR, nbytes);
767
768 #ifdef USE_TEXT_PROPERTIES
769 if (BUF_INTERVALS (current_buffer) != 0)
770 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
771 offset_intervals (current_buffer, PT, nchars);
772 #endif
773
774 GAP_SIZE -= nbytes;
775 GPT += nchars;
776 ZV += nchars;
777 Z += nchars;
778 GPT_BYTE += nbytes;
779 ZV_BYTE += nbytes;
780 Z_BYTE += nbytes;
781 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
782 adjust_overlays_for_insert (PT, nchars);
783 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars, PT_BYTE + nbytes,
784 before_markers);
785 adjust_point (nchars, nbytes);
786
787 if (GPT_BYTE < GPT)
788 abort ();
789
790 #ifdef USE_TEXT_PROPERTIES
791 if (!inherit && BUF_INTERVALS (current_buffer) != 0)
792 Fset_text_properties (make_number (PT - nchars), make_number (PT),
793 Qnil, Qnil);
794 #endif
795 }
796
797 /* Insert a sequence of NCHARS chars which occupy NBYTES bytes
798 starting at STRING. INHERIT, PREPARE and BEFORE_MARKERS
799 are the same as in insert_1. */
800
801 void
802 insert_1_both (string, nchars, nbytes, inherit, prepare, before_markers)
803 register unsigned char *string;
804 register int nchars, nbytes;
805 int inherit, prepare, before_markers;
806 {
807 register Lisp_Object temp;
808
809 if (prepare)
810 prepare_to_modify_buffer (PT, PT, NULL);
811
812 if (PT != GPT)
813 move_gap_both (PT, PT_BYTE);
814 if (GAP_SIZE < nbytes)
815 make_gap (nbytes - GAP_SIZE);
816
817 record_insert (PT, nchars);
818 MODIFF++;
819
820 bcopy (string, GPT_ADDR, nbytes);
821
822 #ifdef USE_TEXT_PROPERTIES
823 if (BUF_INTERVALS (current_buffer) != 0)
824 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES. */
825 offset_intervals (current_buffer, PT, nchars);
826 #endif
827
828 GAP_SIZE -= nbytes;
829 GPT += nchars;
830 ZV += nchars;
831 Z += nchars;
832 GPT_BYTE += nbytes;
833 ZV_BYTE += nbytes;
834 Z_BYTE += nbytes;
835 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
836 adjust_overlays_for_insert (PT, nchars);
837 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars, PT_BYTE + nbytes,
838 before_markers);
839 adjust_point (nchars, nbytes);
840
841 if (GPT_BYTE < GPT)
842 abort ();
843
844 #ifdef USE_TEXT_PROPERTIES
845 if (!inherit && BUF_INTERVALS (current_buffer) != 0)
846 Fset_text_properties (make_number (PT - nchars), make_number (PT),
847 Qnil, Qnil);
848 #endif
849 }
850 \f
851 /* Insert the part of the text of STRING, a Lisp object assumed to be
852 of type string, consisting of the LENGTH characters (LENGTH_BYTE bytes)
853 starting at position POS / POS_BYTE. If the text of STRING has properties,
854 copy them into the buffer.
855
856 It does not work to use `insert' for this, because a GC could happen
857 before we bcopy the stuff into the buffer, and relocate the string
858 without insert noticing. */
859
860 void
861 insert_from_string (string, pos, pos_byte, length, length_byte, inherit)
862 Lisp_Object string;
863 register int pos, pos_byte, length, length_byte;
864 int inherit;
865 {
866 if (length > 0)
867 {
868 int opoint = PT;
869 insert_from_string_1 (string, pos, pos_byte, length, length_byte,
870 inherit, 0);
871 signal_after_change (opoint, 0, PT - opoint);
872 }
873 }
874
875 /* Like `insert_from_string' except that all markers pointing
876 at the place where the insertion happens are adjusted to point after it. */
877
878 void
879 insert_from_string_before_markers (string, pos, pos_byte,
880 length, length_byte, inherit)
881 Lisp_Object string;
882 register int pos, pos_byte, length, length_byte;
883 int inherit;
884 {
885 if (length > 0)
886 {
887 int opoint = PT;
888 insert_from_string_1 (string, pos, pos_byte, length, length_byte,
889 inherit, 1);
890 signal_after_change (opoint, 0, PT - opoint);
891 }
892 }
893
894 /* Subroutine of the insertion functions above. */
895
896 static void
897 insert_from_string_1 (string, pos, pos_byte, nchars, nbytes,
898 inherit, before_markers)
899 Lisp_Object string;
900 register int pos, pos_byte, nchars, nbytes;
901 int inherit, before_markers;
902 {
903 register Lisp_Object temp;
904 struct gcpro gcpro1;
905 int outgoing_nbytes = nbytes;
906
907 /* Make OUTGOING_NBYTES describe the text
908 as it will be inserted in this buffer. */
909
910 if (NILP (current_buffer->enable_multibyte_characters))
911 outgoing_nbytes = nchars;
912 else if (nchars == nbytes)
913 outgoing_nbytes
914 = count_size_as_multibyte (&XSTRING (string)->data[pos_byte],
915 nbytes);
916
917 /* Make sure point-max won't overflow after this insertion. */
918 XSETINT (temp, outgoing_nbytes + Z);
919 if (outgoing_nbytes + Z != XINT (temp))
920 error ("Maximum buffer size exceeded");
921
922 GCPRO1 (string);
923 prepare_to_modify_buffer (PT, PT, NULL);
924
925 if (PT != GPT)
926 move_gap_both (PT, PT_BYTE);
927 if (GAP_SIZE < nbytes)
928 make_gap (outgoing_nbytes - GAP_SIZE);
929
930 record_insert (PT, nchars);
931 MODIFF++;
932 UNGCPRO;
933
934 /* Copy the string text into the buffer, perhaps converting
935 between single-byte and multibyte. */
936 copy_text (XSTRING (string)->data + pos_byte, GPT_ADDR, nbytes,
937 /* If these are equal, it is a single-byte string.
938 Its chars are either ASCII, in which case copy_text
939 won't change it, or single-byte non-ASCII chars,
940 that need to be changed. */
941 nchars != nbytes,
942 ! NILP (current_buffer->enable_multibyte_characters));
943
944 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
945 offset_intervals (current_buffer, PT, nchars);
946
947 GAP_SIZE -= outgoing_nbytes;
948 GPT += nchars;
949 ZV += nchars;
950 Z += nchars;
951 GPT_BYTE += outgoing_nbytes;
952 ZV_BYTE += outgoing_nbytes;
953 Z_BYTE += outgoing_nbytes;
954 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
955 adjust_overlays_for_insert (PT, nchars);
956 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
957 PT_BYTE + outgoing_nbytes,
958 before_markers);
959
960 if (GPT_BYTE < GPT)
961 abort ();
962
963 graft_intervals_into_buffer (XSTRING (string)->intervals, PT, nchars,
964 current_buffer, inherit);
965
966 adjust_point (nchars, outgoing_nbytes);
967 }
968 \f
969 /* Insert text from BUF, NCHARS characters starting at CHARPOS, into the
970 current buffer. If the text in BUF has properties, they are absorbed
971 into the current buffer.
972
973 It does not work to use `insert' for this, because a malloc could happen
974 and relocate BUF's text before the bcopy happens. */
975
976 void
977 insert_from_buffer (buf, charpos, nchars, inherit)
978 struct buffer *buf;
979 int charpos, nchars;
980 int inherit;
981 {
982 if (nchars > 0)
983 {
984 int opoint = PT;
985
986 insert_from_buffer_1 (buf, charpos, nchars, inherit);
987 signal_after_change (opoint, 0, PT - opoint);
988 }
989 }
990
991 static void
992 insert_from_buffer_1 (buf, from, nchars, inherit)
993 struct buffer *buf;
994 int from, nchars;
995 int inherit;
996 {
997 register Lisp_Object temp;
998 int chunk;
999 int from_byte = buf_charpos_to_bytepos (buf, from);
1000 int to_byte = buf_charpos_to_bytepos (buf, from + nchars);
1001 int incoming_nbytes = to_byte - from_byte;
1002 int outgoing_nbytes = incoming_nbytes;
1003
1004 /* Make OUTGOING_NBYTES describe the text
1005 as it will be inserted in this buffer. */
1006
1007 if (NILP (current_buffer->enable_multibyte_characters))
1008 outgoing_nbytes = nchars;
1009 else if (NILP (buf->enable_multibyte_characters))
1010 outgoing_nbytes
1011 = count_size_as_multibyte (BUF_BYTE_ADDRESS (buf, from_byte),
1012 incoming_nbytes);
1013
1014 /* Make sure point-max won't overflow after this insertion. */
1015 XSETINT (temp, outgoing_nbytes + Z);
1016 if (outgoing_nbytes + Z != XINT (temp))
1017 error ("Maximum buffer size exceeded");
1018
1019 prepare_to_modify_buffer (PT, PT, NULL);
1020
1021 if (PT != GPT)
1022 move_gap_both (PT, PT_BYTE);
1023 if (GAP_SIZE < outgoing_nbytes)
1024 make_gap (outgoing_nbytes - GAP_SIZE);
1025
1026 record_insert (PT, nchars);
1027 MODIFF++;
1028
1029 if (from < BUF_GPT (buf))
1030 {
1031 chunk = BUF_GPT_BYTE (buf) - from_byte;
1032 if (chunk > incoming_nbytes)
1033 chunk = incoming_nbytes;
1034 copy_text (BUF_BYTE_ADDRESS (buf, from_byte),
1035 GPT_ADDR, chunk,
1036 ! NILP (buf->enable_multibyte_characters),
1037 ! NILP (current_buffer->enable_multibyte_characters));
1038 }
1039 else
1040 chunk = 0;
1041 if (chunk < incoming_nbytes)
1042 copy_text (BUF_BYTE_ADDRESS (buf, from_byte + chunk),
1043 GPT_ADDR + chunk, incoming_nbytes - chunk,
1044 ! NILP (buf->enable_multibyte_characters),
1045 ! NILP (current_buffer->enable_multibyte_characters));
1046
1047 #ifdef USE_TEXT_PROPERTIES
1048 if (BUF_INTERVALS (current_buffer) != 0)
1049 offset_intervals (current_buffer, PT, nchars);
1050 #endif
1051
1052 GAP_SIZE -= outgoing_nbytes;
1053 GPT += nchars;
1054 ZV += nchars;
1055 Z += nchars;
1056 GPT_BYTE += outgoing_nbytes;
1057 ZV_BYTE += outgoing_nbytes;
1058 Z_BYTE += outgoing_nbytes;
1059 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1060 adjust_overlays_for_insert (PT, nchars);
1061 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
1062 PT_BYTE + outgoing_nbytes, 0);
1063 adjust_point (nchars, outgoing_nbytes);
1064
1065 if (GPT_BYTE < GPT)
1066 abort ();
1067
1068 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1069 graft_intervals_into_buffer (copy_intervals (BUF_INTERVALS (buf),
1070 from, nchars),
1071 PT - nchars, nchars,
1072 current_buffer, inherit);
1073 }
1074 \f
1075 void
1076 adjust_before_replace (from, from_byte, to, to_byte)
1077 int from, from_byte, to, to_byte;
1078 {
1079 adjust_markers_for_delete (from, from_byte, to, to_byte);
1080 record_delete (from, to - from);
1081 }
1082
1083 void
1084 adjust_after_replace (from, from_byte, to, to_byte, len, len_byte)
1085 int from, from_byte, to, to_byte, len, len_byte;
1086 {
1087 record_insert (from, len);
1088 if (from < PT)
1089 adjust_point (len, len_byte);
1090 #ifdef USE_TEXT_PROPERTIES
1091 offset_intervals (current_buffer, PT, len - (to - from));
1092 #endif
1093 adjust_overlays_for_delete (from, to - from);
1094 adjust_overlays_for_insert (from, len);
1095 adjust_markers_for_insert (from, from_byte,
1096 from + len, from_byte + len_byte, 0);
1097 if (len == 0)
1098 evaporate_overlays (from);
1099 MODIFF++;
1100 signal_after_change (from, to - from, len);
1101 }
1102
1103 /* Replace the text from character positions FROM to TO with NEW,
1104 If PREPARE is nonzero, call prepare_to_modify_buffer.
1105 If INHERIT, the newly inserted text should inherit text properties
1106 from the surrounding non-deleted text. */
1107
1108 /* Note that this does not yet handle markers quite right.
1109 Also it needs to record a single undo-entry that does a replacement
1110 rather than a separate delete and insert.
1111 That way, undo will also handle markers properly. */
1112
1113 void
1114 replace_range (from, to, new, prepare, inherit)
1115 Lisp_Object new;
1116 int from, to, prepare, inherit;
1117 {
1118 int inschars = XSTRING (new)->size;
1119 int insbytes = XSTRING (new)->size_byte;
1120 int from_byte, to_byte;
1121 int nbytes_del, nchars_del;
1122 register Lisp_Object temp;
1123 struct gcpro gcpro1;
1124
1125 GCPRO1 (new);
1126
1127 if (prepare)
1128 {
1129 int range_length = to - from;
1130 prepare_to_modify_buffer (from, to, &from);
1131 to = from + range_length;
1132 }
1133
1134 UNGCPRO;
1135
1136 /* Make args be valid */
1137 if (from < BEGV)
1138 from = BEGV;
1139 if (to > ZV)
1140 to = ZV;
1141
1142 from_byte = CHAR_TO_BYTE (from);
1143 to_byte = CHAR_TO_BYTE (to);
1144
1145 nchars_del = to - from;
1146 nbytes_del = to_byte - from_byte;
1147
1148 if (nbytes_del <= 0 && insbytes == 0)
1149 return;
1150
1151 /* Make sure point-max won't overflow after this insertion. */
1152 XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
1153 if (Z_BYTE - nbytes_del + insbytes != XINT (temp))
1154 error ("Maximum buffer size exceeded");
1155
1156 GCPRO1 (new);
1157
1158 /* Make sure the gap is somewhere in or next to what we are deleting. */
1159 if (from > GPT)
1160 gap_right (from, from_byte);
1161 if (to < GPT)
1162 gap_left (to, to_byte, 0);
1163
1164 /* Relocate all markers pointing into the new, larger gap
1165 to point at the end of the text before the gap.
1166 Do this before recording the deletion,
1167 so that undo handles this after reinserting the text. */
1168 adjust_markers_for_delete (from, from_byte, to, to_byte);
1169
1170 record_delete (from, nchars_del);
1171
1172 GAP_SIZE += nbytes_del;
1173 ZV -= nchars_del;
1174 Z -= nchars_del;
1175 ZV_BYTE -= nbytes_del;
1176 Z_BYTE -= nbytes_del;
1177 GPT = from;
1178 GPT_BYTE = from_byte;
1179 *(GPT_ADDR) = 0; /* Put an anchor. */
1180
1181 if (GPT_BYTE < GPT)
1182 abort ();
1183
1184 if (GPT - BEG < beg_unchanged)
1185 beg_unchanged = GPT - BEG;
1186 if (Z - GPT < end_unchanged)
1187 end_unchanged = Z - GPT;
1188
1189 if (GAP_SIZE < insbytes)
1190 make_gap (insbytes - GAP_SIZE);
1191
1192 record_insert (from, inschars);
1193
1194 bcopy (XSTRING (new)->data, GPT_ADDR, insbytes);
1195
1196 /* Relocate point as if it were a marker. */
1197 if (from < PT)
1198 adjust_point (from + inschars - (PT < to ? PT : to),
1199 (from_byte + insbytes
1200 - (PT_BYTE < to_byte ? PT_BYTE : to_byte)));
1201
1202 #ifdef USE_TEXT_PROPERTIES
1203 offset_intervals (current_buffer, PT, inschars - nchars_del);
1204 #endif
1205
1206 GAP_SIZE -= insbytes;
1207 GPT += inschars;
1208 ZV += inschars;
1209 Z += inschars;
1210 GPT_BYTE += insbytes;
1211 ZV_BYTE += insbytes;
1212 ZV_BYTE += insbytes;
1213 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1214
1215 if (GPT_BYTE < GPT)
1216 abort ();
1217
1218 /* Adjust the overlay center as needed. This must be done after
1219 adjusting the markers that bound the overlays. */
1220 adjust_overlays_for_delete (from, nchars_del);
1221 adjust_overlays_for_insert (from, inschars);
1222 adjust_markers_for_insert (from, from_byte, from + inschars,
1223 from_byte + insbytes, 0);
1224
1225 #ifdef USE_TEXT_PROPERTIES
1226 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1227 graft_intervals_into_buffer (XSTRING (new)->intervals, from,
1228 inschars, current_buffer, inherit);
1229 #endif
1230
1231 if (insbytes == 0)
1232 evaporate_overlays (from);
1233
1234 MODIFF++;
1235 UNGCPRO;
1236
1237 signal_after_change (from, nchars_del, inschars);
1238 }
1239 \f
1240 /* Delete characters in current buffer
1241 from FROM up to (but not including) TO.
1242 If TO comes before FROM, we delete nothing. */
1243
1244 void
1245 del_range (from, to)
1246 register int from, to;
1247 {
1248 del_range_1 (from, to, 1);
1249 }
1250
1251 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. */
1252
1253 void
1254 del_range_1 (from, to, prepare)
1255 int from, to, prepare;
1256 {
1257 int from_byte, to_byte;
1258
1259 /* Make args be valid */
1260 if (from < BEGV)
1261 from = BEGV;
1262 if (to > ZV)
1263 to = ZV;
1264
1265 if (to <= from)
1266 return;
1267
1268 if (prepare)
1269 {
1270 int range_length = to - from;
1271 prepare_to_modify_buffer (from, to, &from);
1272 to = from + range_length;
1273 }
1274
1275 from_byte = CHAR_TO_BYTE (from);
1276 to_byte = CHAR_TO_BYTE (to);
1277
1278 del_range_2 (from, to, from_byte, to_byte);
1279 }
1280
1281 /* Like del_range_1 but args are byte positions, not char positions. */
1282
1283 void
1284 del_range_byte (from_byte, to_byte, prepare)
1285 int from_byte, to_byte, prepare;
1286 {
1287 int from, to;
1288
1289 /* Make args be valid */
1290 if (from_byte < BEGV_BYTE)
1291 from_byte = BEGV_BYTE;
1292 if (to_byte > ZV_BYTE)
1293 to_byte = ZV_BYTE;
1294
1295 if (to_byte <= from_byte)
1296 return;
1297
1298 from = BYTE_TO_CHAR (from_byte);
1299 to = BYTE_TO_CHAR (to_byte);
1300
1301 if (prepare)
1302 {
1303 int old_from = from, old_to = Z - to;
1304 int range_length = to - from;
1305 prepare_to_modify_buffer (from, to, &from);
1306 to = from + range_length;
1307
1308 if (old_from != from)
1309 from_byte = CHAR_TO_BYTE (from);
1310 if (old_to == Z - to)
1311 to_byte = CHAR_TO_BYTE (to);
1312 }
1313
1314 del_range_2 (from, to, from_byte, to_byte);
1315 }
1316
1317 /* Like del_range_1, but positions are specified both as charpos
1318 and bytepos. */
1319
1320 void
1321 del_range_both (from, to, from_byte, to_byte, prepare)
1322 int from, to, from_byte, to_byte, prepare;
1323 {
1324 /* Make args be valid */
1325 if (from_byte < BEGV_BYTE)
1326 from_byte = BEGV_BYTE;
1327 if (to_byte > ZV_BYTE)
1328 to_byte = ZV_BYTE;
1329
1330 if (to_byte <= from_byte)
1331 return;
1332
1333 if (from < BEGV)
1334 from = BEGV;
1335 if (to > ZV)
1336 to = ZV;
1337
1338 if (prepare)
1339 {
1340 int old_from = from, old_to = Z - to;
1341 int range_length = to - from;
1342 prepare_to_modify_buffer (from, to, &from);
1343 to = from + range_length;
1344
1345 if (old_from != from)
1346 from_byte = CHAR_TO_BYTE (from);
1347 if (old_to == Z - to)
1348 to_byte = CHAR_TO_BYTE (to);
1349 }
1350
1351 del_range_2 (from, to, from_byte, to_byte);
1352 }
1353
1354 /* Delete a range of text, specified both as character positions
1355 and byte positions. FROM and TO are character positions,
1356 while FROM_BYTE and TO_BYTE are byte positions. */
1357
1358 void
1359 del_range_2 (from, to, from_byte, to_byte)
1360 int from, to, from_byte, to_byte;
1361 {
1362 register int nbytes_del, nchars_del;
1363
1364 nchars_del = to - from;
1365 nbytes_del = to_byte - from_byte;
1366
1367 /* Make sure the gap is somewhere in or next to what we are deleting. */
1368 if (from > GPT)
1369 gap_right (from, from_byte);
1370 if (to < GPT)
1371 gap_left (to, to_byte, 0);
1372
1373 /* Relocate all markers pointing into the new, larger gap
1374 to point at the end of the text before the gap.
1375 Do this before recording the deletion,
1376 so that undo handles this after reinserting the text. */
1377 adjust_markers_for_delete (from, from_byte, to, to_byte);
1378
1379 record_delete (from, nchars_del);
1380 MODIFF++;
1381
1382 /* Relocate point as if it were a marker. */
1383 if (from < PT)
1384 adjust_point (from - (PT < to ? PT : to),
1385 from_byte - (PT_BYTE < to_byte ? PT_BYTE : to_byte));
1386
1387 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1388 offset_intervals (current_buffer, from, - nchars_del);
1389
1390 /* Adjust the overlay center as needed. This must be done after
1391 adjusting the markers that bound the overlays. */
1392 adjust_overlays_for_delete (from_byte, nchars_del);
1393
1394 GAP_SIZE += nbytes_del;
1395 ZV_BYTE -= nbytes_del;
1396 Z_BYTE -= nbytes_del;
1397 ZV -= nchars_del;
1398 Z -= nchars_del;
1399 GPT = from;
1400 GPT_BYTE = from_byte;
1401 *(GPT_ADDR) = 0; /* Put an anchor. */
1402
1403 if (GPT_BYTE < GPT)
1404 abort ();
1405
1406 if (GPT - BEG < beg_unchanged)
1407 beg_unchanged = GPT - BEG;
1408 if (Z - GPT < end_unchanged)
1409 end_unchanged = Z - GPT;
1410
1411 evaporate_overlays (from);
1412 signal_after_change (from, nchars_del, 0);
1413 }
1414 \f
1415 /* Call this if you're about to change the region of BUFFER from
1416 character positions START to END. This checks the read-only
1417 properties of the region, calls the necessary modification hooks,
1418 and warns the next redisplay that it should pay attention to that
1419 area. */
1420
1421 void
1422 modify_region (buffer, start, end)
1423 struct buffer *buffer;
1424 int start, end;
1425 {
1426 struct buffer *old_buffer = current_buffer;
1427
1428 if (buffer != old_buffer)
1429 set_buffer_internal (buffer);
1430
1431 prepare_to_modify_buffer (start, end, NULL);
1432
1433 if (start - 1 < beg_unchanged
1434 || (unchanged_modified == MODIFF
1435 && overlay_unchanged_modified == OVERLAY_MODIFF))
1436 beg_unchanged = start - 1;
1437 if (Z - end < end_unchanged
1438 || (unchanged_modified == MODIFF
1439 && overlay_unchanged_modified == OVERLAY_MODIFF))
1440 end_unchanged = Z - end;
1441
1442 if (MODIFF <= SAVE_MODIFF)
1443 record_first_change ();
1444 MODIFF++;
1445
1446 buffer->point_before_scroll = Qnil;
1447
1448 if (buffer != old_buffer)
1449 set_buffer_internal (old_buffer);
1450 }
1451 \f
1452 /* Check that it is okay to modify the buffer between START and END,
1453 which are char positions.
1454
1455 Run the before-change-function, if any. If intervals are in use,
1456 verify that the text to be modified is not read-only, and call
1457 any modification properties the text may have.
1458
1459 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1460 by holding its value temporarily in a marker. */
1461
1462 void
1463 prepare_to_modify_buffer (start, end, preserve_ptr)
1464 int start, end;
1465 int *preserve_ptr;
1466 {
1467 if (!NILP (current_buffer->read_only))
1468 Fbarf_if_buffer_read_only ();
1469
1470 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
1471 if (BUF_INTERVALS (current_buffer) != 0)
1472 {
1473 if (preserve_ptr)
1474 {
1475 Lisp_Object preserve_marker;
1476 struct gcpro gcpro1;
1477 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil);
1478 GCPRO1 (preserve_marker);
1479 verify_interval_modification (current_buffer, start, end);
1480 *preserve_ptr = marker_position (preserve_marker);
1481 unchain_marker (preserve_marker);
1482 UNGCPRO;
1483 }
1484 else
1485 verify_interval_modification (current_buffer, start, end);
1486 }
1487
1488 #ifdef CLASH_DETECTION
1489 if (!NILP (current_buffer->file_truename)
1490 /* Make binding buffer-file-name to nil effective. */
1491 && !NILP (current_buffer->filename)
1492 && SAVE_MODIFF >= MODIFF)
1493 lock_file (current_buffer->file_truename);
1494 #else
1495 /* At least warn if this file has changed on disk since it was visited. */
1496 if (!NILP (current_buffer->filename)
1497 && SAVE_MODIFF >= MODIFF
1498 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
1499 && !NILP (Ffile_exists_p (current_buffer->filename)))
1500 call1 (intern ("ask-user-about-supersession-threat"),
1501 current_buffer->filename);
1502 #endif /* not CLASH_DETECTION */
1503
1504 signal_before_change (start, end, preserve_ptr);
1505
1506 if (current_buffer->newline_cache)
1507 invalidate_region_cache (current_buffer,
1508 current_buffer->newline_cache,
1509 start - BEG, Z - end);
1510 if (current_buffer->width_run_cache)
1511 invalidate_region_cache (current_buffer,
1512 current_buffer->width_run_cache,
1513 start - BEG, Z - end);
1514
1515 Vdeactivate_mark = Qt;
1516 }
1517 \f
1518 /* These macros work with an argument named `preserve_ptr'
1519 and a local variable named `preserve_marker'. */
1520
1521 #define PRESERVE_VALUE \
1522 if (preserve_ptr && NILP (preserve_marker)) \
1523 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil)
1524
1525 #define RESTORE_VALUE \
1526 if (! NILP (preserve_marker)) \
1527 { \
1528 *preserve_ptr = marker_position (preserve_marker); \
1529 unchain_marker (preserve_marker); \
1530 }
1531
1532 #define PRESERVE_START_END \
1533 if (NILP (start_marker)) \
1534 start_marker = Fcopy_marker (start, Qnil); \
1535 if (NILP (end_marker)) \
1536 end_marker = Fcopy_marker (end, Qnil);
1537
1538 #define FETCH_START \
1539 (! NILP (start_marker) ? Fmarker_position (start_marker) : start)
1540
1541 #define FETCH_END \
1542 (! NILP (end_marker) ? Fmarker_position (end_marker) : end)
1543
1544 /* Signal a change to the buffer immediately before it happens.
1545 START_INT and END_INT are the bounds of the text to be changed.
1546
1547 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1548 by holding its value temporarily in a marker. */
1549
1550 void
1551 signal_before_change (start_int, end_int, preserve_ptr)
1552 int start_int, end_int;
1553 int *preserve_ptr;
1554 {
1555 Lisp_Object start, end;
1556 Lisp_Object start_marker, end_marker;
1557 Lisp_Object preserve_marker;
1558 struct gcpro gcpro1, gcpro2, gcpro3;
1559
1560 start = make_number (start_int);
1561 end = make_number (end_int);
1562 preserve_marker = Qnil;
1563 start_marker = Qnil;
1564 end_marker = Qnil;
1565 GCPRO3 (preserve_marker, start_marker, end_marker);
1566
1567 /* If buffer is unmodified, run a special hook for that case. */
1568 if (SAVE_MODIFF >= MODIFF
1569 && !NILP (Vfirst_change_hook)
1570 && !NILP (Vrun_hooks))
1571 {
1572 PRESERVE_VALUE;
1573 PRESERVE_START_END;
1574 call1 (Vrun_hooks, Qfirst_change_hook);
1575 }
1576
1577 /* Run the before-change-function if any.
1578 We don't bother "binding" this variable to nil
1579 because it is obsolete anyway and new code should not use it. */
1580 if (!NILP (Vbefore_change_function))
1581 {
1582 PRESERVE_VALUE;
1583 PRESERVE_START_END;
1584 call2 (Vbefore_change_function, FETCH_START, FETCH_END);
1585 }
1586
1587 /* Now run the before-change-functions if any. */
1588 if (!NILP (Vbefore_change_functions))
1589 {
1590 Lisp_Object args[3];
1591 Lisp_Object before_change_functions;
1592 Lisp_Object after_change_functions;
1593 struct gcpro gcpro1, gcpro2;
1594
1595 PRESERVE_VALUE;
1596 PRESERVE_START_END;
1597
1598 /* "Bind" before-change-functions and after-change-functions
1599 to nil--but in a way that errors don't know about.
1600 That way, if there's an error in them, they will stay nil. */
1601 before_change_functions = Vbefore_change_functions;
1602 after_change_functions = Vafter_change_functions;
1603 Vbefore_change_functions = Qnil;
1604 Vafter_change_functions = Qnil;
1605 GCPRO2 (before_change_functions, after_change_functions);
1606
1607 /* Actually run the hook functions. */
1608 args[0] = Qbefore_change_functions;
1609 args[1] = FETCH_START;
1610 args[2] = FETCH_END;
1611 run_hook_list_with_args (before_change_functions, 3, args);
1612
1613 /* "Unbind" the variables we "bound" to nil. */
1614 Vbefore_change_functions = before_change_functions;
1615 Vafter_change_functions = after_change_functions;
1616 UNGCPRO;
1617 }
1618
1619 if (!NILP (current_buffer->overlays_before)
1620 || !NILP (current_buffer->overlays_after))
1621 {
1622 PRESERVE_VALUE;
1623 report_overlay_modification (FETCH_START, FETCH_END, 0,
1624 FETCH_START, FETCH_END, Qnil);
1625 }
1626
1627 if (! NILP (start_marker))
1628 free_marker (start_marker);
1629 if (! NILP (end_marker))
1630 free_marker (end_marker);
1631 RESTORE_VALUE;
1632 UNGCPRO;
1633 }
1634
1635 /* Signal a change immediately after it happens.
1636 CHARPOS is the character position of the start of the changed text.
1637 LENDEL is the number of characters of the text before the change.
1638 (Not the whole buffer; just the part that was changed.)
1639 LENINS is the number of characters in that part of the text
1640 after the change. */
1641
1642 void
1643 signal_after_change (charpos, lendel, lenins)
1644 int charpos, lendel, lenins;
1645 {
1646 /* If we are deferring calls to the after-change functions
1647 and there are no before-change functions,
1648 just record the args that we were going to use. */
1649 if (! NILP (Vcombine_after_change_calls)
1650 && NILP (Vbefore_change_function) && NILP (Vbefore_change_functions)
1651 && NILP (current_buffer->overlays_before)
1652 && NILP (current_buffer->overlays_after))
1653 {
1654 Lisp_Object elt;
1655
1656 if (!NILP (combine_after_change_list)
1657 && current_buffer != XBUFFER (combine_after_change_buffer))
1658 Fcombine_after_change_execute ();
1659
1660 elt = Fcons (make_number (charpos - BEG),
1661 Fcons (make_number (Z - (charpos - lendel + lenins)),
1662 Fcons (make_number (lenins - lendel), Qnil)));
1663 combine_after_change_list
1664 = Fcons (elt, combine_after_change_list);
1665 combine_after_change_buffer = Fcurrent_buffer ();
1666
1667 return;
1668 }
1669
1670 if (!NILP (combine_after_change_list))
1671 Fcombine_after_change_execute ();
1672
1673 /* Run the after-change-function if any.
1674 We don't bother "binding" this variable to nil
1675 because it is obsolete anyway and new code should not use it. */
1676 if (!NILP (Vafter_change_function))
1677 call3 (Vafter_change_function,
1678 make_number (charpos), make_number (charpos + lenins),
1679 make_number (lendel));
1680
1681 if (!NILP (Vafter_change_functions))
1682 {
1683 Lisp_Object args[4];
1684 Lisp_Object before_change_functions;
1685 Lisp_Object after_change_functions;
1686 struct gcpro gcpro1, gcpro2;
1687
1688 /* "Bind" before-change-functions and after-change-functions
1689 to nil--but in a way that errors don't know about.
1690 That way, if there's an error in them, they will stay nil. */
1691 before_change_functions = Vbefore_change_functions;
1692 after_change_functions = Vafter_change_functions;
1693 Vbefore_change_functions = Qnil;
1694 Vafter_change_functions = Qnil;
1695 GCPRO2 (before_change_functions, after_change_functions);
1696
1697 /* Actually run the hook functions. */
1698 args[0] = Qafter_change_functions;
1699 XSETFASTINT (args[1], charpos);
1700 XSETFASTINT (args[2], charpos + lenins);
1701 XSETFASTINT (args[3], lendel);
1702 run_hook_list_with_args (after_change_functions,
1703 4, args);
1704
1705 /* "Unbind" the variables we "bound" to nil. */
1706 Vbefore_change_functions = before_change_functions;
1707 Vafter_change_functions = after_change_functions;
1708 UNGCPRO;
1709 }
1710
1711 if (!NILP (current_buffer->overlays_before)
1712 || !NILP (current_buffer->overlays_after))
1713 report_overlay_modification (make_number (charpos),
1714 make_number (charpos + lenins),
1715 1,
1716 make_number (charpos),
1717 make_number (charpos + lenins),
1718 make_number (lendel));
1719
1720 /* After an insertion, call the text properties
1721 insert-behind-hooks or insert-in-front-hooks. */
1722 if (lendel == 0)
1723 report_interval_modification (charpos, charpos + lenins);
1724 }
1725
1726 Lisp_Object
1727 Fcombine_after_change_execute_1 (val)
1728 Lisp_Object val;
1729 {
1730 Vcombine_after_change_calls = val;
1731 return val;
1732 }
1733
1734 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
1735 Scombine_after_change_execute, 0, 0, 0,
1736 "This function is for use internally in `combine-after-change-calls'.")
1737 ()
1738 {
1739 register Lisp_Object val;
1740 int count = specpdl_ptr - specpdl;
1741 int beg, end, change;
1742 int begpos, endpos;
1743 Lisp_Object tail;
1744
1745 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1746
1747 Fset_buffer (combine_after_change_buffer);
1748
1749 /* # chars unchanged at beginning of buffer. */
1750 beg = Z - BEG;
1751 /* # chars unchanged at end of buffer. */
1752 end = beg;
1753 /* Total amount of insertion (negative for deletion). */
1754 change = 0;
1755
1756 /* Scan the various individual changes,
1757 accumulating the range info in BEG, END and CHANGE. */
1758 for (tail = combine_after_change_list; CONSP (tail);
1759 tail = XCONS (tail)->cdr)
1760 {
1761 Lisp_Object elt;
1762 int thisbeg, thisend, thischange;
1763
1764 /* Extract the info from the next element. */
1765 elt = XCONS (tail)->car;
1766 if (! CONSP (elt))
1767 continue;
1768 thisbeg = XINT (XCONS (elt)->car);
1769
1770 elt = XCONS (elt)->cdr;
1771 if (! CONSP (elt))
1772 continue;
1773 thisend = XINT (XCONS (elt)->car);
1774
1775 elt = XCONS (elt)->cdr;
1776 if (! CONSP (elt))
1777 continue;
1778 thischange = XINT (XCONS (elt)->car);
1779
1780 /* Merge this range into the accumulated range. */
1781 change += thischange;
1782 if (thisbeg < beg)
1783 beg = thisbeg;
1784 if (thisend < end)
1785 end = thisend;
1786 }
1787
1788 /* Get the current start and end positions of the range
1789 that was changed. */
1790 begpos = BEG + beg;
1791 endpos = Z - end;
1792
1793 /* We are about to handle these, so discard them. */
1794 combine_after_change_list = Qnil;
1795
1796 /* Now run the after-change functions for real.
1797 Turn off the flag that defers them. */
1798 record_unwind_protect (Fcombine_after_change_execute_1,
1799 Vcombine_after_change_calls);
1800 signal_after_change (begpos, endpos - begpos - change, endpos - begpos);
1801
1802 return unbind_to (count, val);
1803 }
1804 \f
1805 syms_of_insdel ()
1806 {
1807 staticpro (&combine_after_change_list);
1808 combine_after_change_list = Qnil;
1809
1810 DEFVAR_LISP ("combine-after-change-calls", &Vcombine_after_change_calls,
1811 "Used internally by the `combine-after-change-calls' macro.");
1812 Vcombine_after_change_calls = Qnil;
1813
1814 defsubr (&Scombine_after_change_execute);
1815 }