Fix pcase memoizing; change lexbound byte-code marker.
[emacs.git] / src / insdel.c
blob7fcf9522a3344e9f1569c0d704eb5366cb3c741a
1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985-1986, 1993-1995, 1997-2011
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
22 #include <setjmp.h>
23 #include "lisp.h"
24 #include "intervals.h"
25 #include "buffer.h"
26 #include "character.h"
27 #include "window.h"
28 #include "blockinput.h"
29 #include "region-cache.h"
31 #ifndef NULL
32 #define NULL 0
33 #endif
35 static void insert_from_string_1 (Lisp_Object string,
36 EMACS_INT pos, EMACS_INT pos_byte,
37 EMACS_INT nchars, EMACS_INT nbytes,
38 int inherit, int before_markers);
39 static void insert_from_buffer_1 (struct buffer *buf,
40 EMACS_INT from, EMACS_INT nchars,
41 int inherit);
42 static void gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap);
43 static void gap_right (EMACS_INT charpos, EMACS_INT bytepos);
44 static void adjust_markers_gap_motion (EMACS_INT from, EMACS_INT to,
45 EMACS_INT amount);
46 static void adjust_markers_for_insert (EMACS_INT from, EMACS_INT from_byte,
47 EMACS_INT to, EMACS_INT to_byte,
48 int before_markers);
49 static void adjust_markers_for_replace (EMACS_INT, EMACS_INT, EMACS_INT,
50 EMACS_INT, EMACS_INT, EMACS_INT);
51 static void adjust_point (EMACS_INT nchars, EMACS_INT nbytes);
53 Lisp_Object Fcombine_after_change_execute (void);
55 /* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
56 describing changes which happened while combine_after_change_calls
57 was nonzero. We use this to decide how to call them
58 once the deferral ends.
60 In each element.
61 BEG-UNCHANGED is the number of chars before the changed range.
62 END-UNCHANGED is the number of chars after the changed range,
63 and CHANGE-AMOUNT is the number of characters inserted by the change
64 (negative for a deletion). */
65 Lisp_Object combine_after_change_list;
67 /* Buffer which combine_after_change_list is about. */
68 Lisp_Object combine_after_change_buffer;
70 Lisp_Object Qinhibit_modification_hooks;
72 #define CHECK_MARKERS() \
73 if (check_markers_debug_flag) \
74 check_markers (); \
75 else
77 void
78 check_markers (void)
80 register struct Lisp_Marker *tail;
81 int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
83 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
85 if (tail->buffer->text != current_buffer->text)
86 abort ();
87 if (tail->charpos > Z)
88 abort ();
89 if (tail->bytepos > Z_BYTE)
90 abort ();
91 if (multibyte && ! CHAR_HEAD_P (FETCH_BYTE (tail->bytepos)))
92 abort ();
96 /* Move gap to position CHARPOS.
97 Note that this can quit! */
99 void
100 move_gap (EMACS_INT charpos)
102 move_gap_both (charpos, charpos_to_bytepos (charpos));
105 /* Move gap to byte position BYTEPOS, which is also char position CHARPOS.
106 Note that this can quit! */
108 void
109 move_gap_both (EMACS_INT charpos, EMACS_INT bytepos)
111 if (bytepos < GPT_BYTE)
112 gap_left (charpos, bytepos, 0);
113 else if (bytepos > GPT_BYTE)
114 gap_right (charpos, bytepos);
117 /* Move the gap to a position less than the current GPT.
118 BYTEPOS describes the new position as a byte position,
119 and CHARPOS is the corresponding char position.
120 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
122 static void
123 gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap)
125 register unsigned char *to, *from;
126 register EMACS_INT i;
127 EMACS_INT new_s1;
129 if (!newgap)
130 BUF_COMPUTE_UNCHANGED (current_buffer, charpos, GPT);
132 i = GPT_BYTE;
133 to = GAP_END_ADDR;
134 from = GPT_ADDR;
135 new_s1 = GPT_BYTE;
137 /* Now copy the characters. To move the gap down,
138 copy characters up. */
140 while (1)
142 /* I gets number of characters left to copy. */
143 i = new_s1 - bytepos;
144 if (i == 0)
145 break;
146 /* If a quit is requested, stop copying now.
147 Change BYTEPOS to be where we have actually moved the gap to. */
148 if (QUITP)
150 bytepos = new_s1;
151 charpos = BYTE_TO_CHAR (bytepos);
152 break;
154 /* Move at most 32000 chars before checking again for a quit. */
155 if (i > 32000)
156 i = 32000;
157 new_s1 -= i;
158 from -= i, to -= i;
159 memmove (to, from, i);
162 /* Adjust markers, and buffer data structure, to put the gap at BYTEPOS.
163 BYTEPOS is where the loop above stopped, which may be what was specified
164 or may be where a quit was detected. */
165 adjust_markers_gap_motion (bytepos, GPT_BYTE, GAP_SIZE);
166 GPT_BYTE = bytepos;
167 GPT = charpos;
168 if (bytepos < charpos)
169 abort ();
170 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
171 QUIT;
174 /* Move the gap to a position greater than the current GPT.
175 BYTEPOS describes the new position as a byte position,
176 and CHARPOS is the corresponding char position. */
178 static void
179 gap_right (EMACS_INT charpos, EMACS_INT bytepos)
181 register unsigned char *to, *from;
182 register EMACS_INT i;
183 EMACS_INT new_s1;
185 BUF_COMPUTE_UNCHANGED (current_buffer, charpos, GPT);
187 i = GPT_BYTE;
188 from = GAP_END_ADDR;
189 to = GPT_ADDR;
190 new_s1 = GPT_BYTE;
192 /* Now copy the characters. To move the gap up,
193 copy characters down. */
195 while (1)
197 /* I gets number of characters left to copy. */
198 i = bytepos - new_s1;
199 if (i == 0)
200 break;
201 /* If a quit is requested, stop copying now.
202 Change BYTEPOS to be where we have actually moved the gap to. */
203 if (QUITP)
205 bytepos = new_s1;
206 charpos = BYTE_TO_CHAR (bytepos);
207 break;
209 /* Move at most 32000 chars before checking again for a quit. */
210 if (i > 32000)
211 i = 32000;
212 new_s1 += i;
213 memmove (to, from, i);
214 from += i, to += i;
217 adjust_markers_gap_motion (GPT_BYTE + GAP_SIZE, bytepos + GAP_SIZE,
218 - GAP_SIZE);
219 GPT = charpos;
220 GPT_BYTE = bytepos;
221 if (bytepos < charpos)
222 abort ();
223 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
224 QUIT;
227 /* Add AMOUNT to the byte position of every marker in the current buffer
228 whose current byte position is between FROM (exclusive) and TO (inclusive).
230 Also, any markers past the outside of that interval, in the direction
231 of adjustment, are first moved back to the near end of the interval
232 and then adjusted by AMOUNT.
234 When the latter adjustment is done, if AMOUNT is negative,
235 we record the adjustment for undo. (This case happens only for
236 deletion.)
238 The markers' character positions are not altered,
239 because gap motion does not affect character positions. */
241 int adjust_markers_test;
243 static void
244 adjust_markers_gap_motion (EMACS_INT from, EMACS_INT to, EMACS_INT amount)
246 /* Now that a marker has a bytepos, not counting the gap,
247 nothing needs to be done here. */
248 #if 0
249 Lisp_Object marker;
250 register struct Lisp_Marker *m;
251 register EMACS_INT mpos;
253 marker = BUF_MARKERS (current_buffer);
255 while (!NILP (marker))
257 m = XMARKER (marker);
258 mpos = m->bytepos;
259 if (amount > 0)
261 if (mpos > to && mpos < to + amount)
263 if (adjust_markers_test)
264 abort ();
265 mpos = to + amount;
268 else
270 /* Here's the case where a marker is inside text being deleted.
271 AMOUNT can be negative for gap motion, too,
272 but then this range contains no markers. */
273 if (mpos > from + amount && mpos <= from)
275 if (adjust_markers_test)
276 abort ();
277 mpos = from + amount;
280 if (mpos > from && mpos <= to)
281 mpos += amount;
282 m->bufpos = mpos;
283 marker = m->chain;
285 #endif
288 /* Adjust all markers for a deletion
289 whose range in bytes is FROM_BYTE to TO_BYTE.
290 The range in charpos is FROM to TO.
292 This function assumes that the gap is adjacent to
293 or inside of the range being deleted. */
295 void
296 adjust_markers_for_delete (EMACS_INT from, EMACS_INT from_byte,
297 EMACS_INT to, EMACS_INT to_byte)
299 Lisp_Object marker;
300 register struct Lisp_Marker *m;
301 register EMACS_INT charpos;
303 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
305 charpos = m->charpos;
307 if (charpos > Z)
308 abort ();
310 /* If the marker is after the deletion,
311 relocate by number of chars / bytes deleted. */
312 if (charpos > to)
314 m->charpos -= to - from;
315 m->bytepos -= to_byte - from_byte;
317 /* Here's the case where a marker is inside text being deleted. */
318 else if (charpos > from)
320 if (! m->insertion_type)
321 { /* Normal markers will end up at the beginning of the
322 re-inserted text after undoing a deletion, and must be
323 adjusted to move them to the correct place. */
324 XSETMISC (marker, m);
325 record_marker_adjustment (marker, from - charpos);
327 else if (charpos < to)
328 { /* Before-insertion markers will automatically move forward
329 upon re-inserting the deleted text, so we have to arrange
330 for them to move backward to the correct position. */
331 XSETMISC (marker, m);
332 record_marker_adjustment (marker, to - charpos);
334 m->charpos = from;
335 m->bytepos = from_byte;
337 /* Here's the case where a before-insertion marker is immediately
338 before the deleted region. */
339 else if (charpos == from && m->insertion_type)
341 /* Undoing the change uses normal insertion, which will
342 incorrectly make MARKER move forward, so we arrange for it
343 to then move backward to the correct place at the beginning
344 of the deleted region. */
345 XSETMISC (marker, m);
346 record_marker_adjustment (marker, to - from);
352 /* Adjust markers for an insertion that stretches from FROM / FROM_BYTE
353 to TO / TO_BYTE. We have to relocate the charpos of every marker
354 that points after the insertion (but not their bytepos).
356 When a marker points at the insertion point,
357 we advance it if either its insertion-type is t
358 or BEFORE_MARKERS is true. */
360 static void
361 adjust_markers_for_insert (EMACS_INT from, EMACS_INT from_byte,
362 EMACS_INT to, EMACS_INT to_byte, int before_markers)
364 struct Lisp_Marker *m;
365 int adjusted = 0;
366 EMACS_INT nchars = to - from;
367 EMACS_INT nbytes = to_byte - from_byte;
369 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
371 eassert (m->bytepos >= m->charpos
372 && m->bytepos - m->charpos <= Z_BYTE - Z);
374 if (m->bytepos == from_byte)
376 if (m->insertion_type || before_markers)
378 m->bytepos = to_byte;
379 m->charpos = to;
380 if (m->insertion_type)
381 adjusted = 1;
384 else if (m->bytepos > from_byte)
386 m->bytepos += nbytes;
387 m->charpos += nchars;
391 /* Adjusting only markers whose insertion-type is t may result in
392 - disordered start and end in overlays, and
393 - disordered overlays in the slot `overlays_before' of current_buffer. */
394 if (adjusted)
396 fix_start_end_in_overlays(from, to);
397 fix_overlays_before (current_buffer, from, to);
401 /* Adjust point for an insertion of NBYTES bytes, which are NCHARS characters.
403 This is used only when the value of point changes due to an insert
404 or delete; it does not represent a conceptual change in point as a
405 marker. In particular, point is not crossing any interval
406 boundaries, so there's no need to use the usual SET_PT macro. In
407 fact it would be incorrect to do so, because either the old or the
408 new value of point is out of sync with the current set of
409 intervals. */
411 static void
412 adjust_point (EMACS_INT nchars, EMACS_INT nbytes)
414 BUF_PT (current_buffer) += nchars;
415 BUF_PT_BYTE (current_buffer) += nbytes;
417 /* In a single-byte buffer, the two positions must be equal. */
418 eassert (PT_BYTE >= PT && PT_BYTE - PT <= ZV_BYTE - ZV);
421 /* Adjust markers for a replacement of a text at FROM (FROM_BYTE) of
422 length OLD_CHARS (OLD_BYTES) to a new text of length NEW_CHARS
423 (NEW_BYTES). It is assumed that OLD_CHARS > 0, i.e., this is not
424 an insertion. */
426 static void
427 adjust_markers_for_replace (EMACS_INT from, EMACS_INT from_byte,
428 EMACS_INT old_chars, EMACS_INT old_bytes,
429 EMACS_INT new_chars, EMACS_INT new_bytes)
431 register struct Lisp_Marker *m;
432 EMACS_INT prev_to_byte = from_byte + old_bytes;
433 EMACS_INT diff_chars = new_chars - old_chars;
434 EMACS_INT diff_bytes = new_bytes - old_bytes;
436 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
438 if (m->bytepos >= prev_to_byte)
440 m->charpos += diff_chars;
441 m->bytepos += diff_bytes;
443 else if (m->bytepos > from_byte)
445 m->charpos = from;
446 m->bytepos = from_byte;
450 CHECK_MARKERS ();
454 /* Make the gap NBYTES_ADDED bytes longer. */
456 void
457 make_gap_larger (EMACS_INT nbytes_added)
459 Lisp_Object tem;
460 EMACS_INT real_gap_loc;
461 EMACS_INT real_gap_loc_byte;
462 EMACS_INT old_gap_size;
464 /* If we have to get more space, get enough to last a while. */
465 nbytes_added += 2000;
467 { EMACS_INT total_size = Z_BYTE - BEG_BYTE + GAP_SIZE + nbytes_added;
468 if (total_size < 0
469 /* Don't allow a buffer size that won't fit in a Lisp integer. */
470 || total_size != XINT (make_number (total_size))
471 /* Don't allow a buffer size that won't fit in an int
472 even if it will fit in a Lisp integer.
473 That won't work because so many places still use `int'. */
474 || total_size != (EMACS_INT) (int) total_size)
475 error ("Buffer exceeds maximum size");
478 enlarge_buffer_text (current_buffer, nbytes_added);
480 /* Prevent quitting in move_gap. */
481 tem = Vinhibit_quit;
482 Vinhibit_quit = Qt;
484 real_gap_loc = GPT;
485 real_gap_loc_byte = GPT_BYTE;
486 old_gap_size = GAP_SIZE;
488 /* Call the newly allocated space a gap at the end of the whole space. */
489 GPT = Z + GAP_SIZE;
490 GPT_BYTE = Z_BYTE + GAP_SIZE;
491 GAP_SIZE = nbytes_added;
493 /* Move the new gap down to be consecutive with the end of the old one.
494 This adjusts the markers properly too. */
495 gap_left (real_gap_loc + old_gap_size, real_gap_loc_byte + old_gap_size, 1);
497 /* Now combine the two into one large gap. */
498 GAP_SIZE += old_gap_size;
499 GPT = real_gap_loc;
500 GPT_BYTE = real_gap_loc_byte;
502 /* Put an anchor. */
503 *(Z_ADDR) = 0;
505 Vinhibit_quit = tem;
509 /* Make the gap NBYTES_REMOVED bytes shorter. */
511 void
512 make_gap_smaller (EMACS_INT nbytes_removed)
514 Lisp_Object tem;
515 EMACS_INT real_gap_loc;
516 EMACS_INT real_gap_loc_byte;
517 EMACS_INT real_Z;
518 EMACS_INT real_Z_byte;
519 EMACS_INT real_beg_unchanged;
520 EMACS_INT new_gap_size;
522 /* Make sure the gap is at least 20 bytes. */
523 if (GAP_SIZE - nbytes_removed < 20)
524 nbytes_removed = GAP_SIZE - 20;
526 /* Prevent quitting in move_gap. */
527 tem = Vinhibit_quit;
528 Vinhibit_quit = Qt;
530 real_gap_loc = GPT;
531 real_gap_loc_byte = GPT_BYTE;
532 new_gap_size = GAP_SIZE - nbytes_removed;
533 real_Z = Z;
534 real_Z_byte = Z_BYTE;
535 real_beg_unchanged = BEG_UNCHANGED;
537 /* Pretend that the last unwanted part of the gap is the entire gap,
538 and that the first desired part of the gap is part of the buffer
539 text. */
540 memset (GPT_ADDR, 0, new_gap_size);
541 GPT += new_gap_size;
542 GPT_BYTE += new_gap_size;
543 Z += new_gap_size;
544 Z_BYTE += new_gap_size;
545 GAP_SIZE = nbytes_removed;
547 /* Move the unwanted pretend gap to the end of the buffer. This
548 adjusts the markers properly too. */
549 gap_right (Z, Z_BYTE);
551 enlarge_buffer_text (current_buffer, -nbytes_removed);
553 /* Now restore the desired gap. */
554 GAP_SIZE = new_gap_size;
555 GPT = real_gap_loc;
556 GPT_BYTE = real_gap_loc_byte;
557 Z = real_Z;
558 Z_BYTE = real_Z_byte;
559 BEG_UNCHANGED = real_beg_unchanged;
561 /* Put an anchor. */
562 *(Z_ADDR) = 0;
564 Vinhibit_quit = tem;
567 void
568 make_gap (EMACS_INT nbytes_added)
570 if (nbytes_added >= 0)
571 make_gap_larger (nbytes_added);
572 #if defined USE_MMAP_FOR_BUFFERS || defined REL_ALLOC || defined DOUG_LEA_MALLOC
573 else
574 make_gap_smaller (-nbytes_added);
575 #endif
578 /* Copy NBYTES bytes of text from FROM_ADDR to TO_ADDR.
579 FROM_MULTIBYTE says whether the incoming text is multibyte.
580 TO_MULTIBYTE says whether to store the text as multibyte.
581 If FROM_MULTIBYTE != TO_MULTIBYTE, we convert.
583 Return the number of bytes stored at TO_ADDR. */
585 EMACS_INT
586 copy_text (const unsigned char *from_addr, unsigned char *to_addr,
587 EMACS_INT nbytes, int from_multibyte, int to_multibyte)
589 if (from_multibyte == to_multibyte)
591 memcpy (to_addr, from_addr, nbytes);
592 return nbytes;
594 else if (from_multibyte)
596 EMACS_INT nchars = 0;
597 EMACS_INT bytes_left = nbytes;
598 Lisp_Object tbl = Qnil;
600 while (bytes_left > 0)
602 int thislen, c;
603 c = STRING_CHAR_AND_LENGTH (from_addr, thislen);
604 if (! ASCII_CHAR_P (c))
605 c &= 0xFF;
606 *to_addr++ = c;
607 from_addr += thislen;
608 bytes_left -= thislen;
609 nchars++;
611 return nchars;
613 else
615 unsigned char *initial_to_addr = to_addr;
617 /* Convert single-byte to multibyte. */
618 while (nbytes > 0)
620 int c = *from_addr++;
622 if (!ASCII_CHAR_P (c))
624 c = BYTE8_TO_CHAR (c);
625 to_addr += CHAR_STRING (c, to_addr);
626 nbytes--;
628 else
629 /* Special case for speed. */
630 *to_addr++ = c, nbytes--;
632 return to_addr - initial_to_addr;
636 /* Return the number of bytes it would take
637 to convert some single-byte text to multibyte.
638 The single-byte text consists of NBYTES bytes at PTR. */
640 EMACS_INT
641 count_size_as_multibyte (const unsigned char *ptr, EMACS_INT nbytes)
643 EMACS_INT i;
644 EMACS_INT outgoing_nbytes = 0;
646 for (i = 0; i < nbytes; i++)
648 unsigned int c = *ptr++;
650 if (ASCII_CHAR_P (c))
651 outgoing_nbytes++;
652 else
654 c = BYTE8_TO_CHAR (c);
655 outgoing_nbytes += CHAR_BYTES (c);
659 return outgoing_nbytes;
662 /* Insert a string of specified length before point.
663 This function judges multibyteness based on
664 enable_multibyte_characters in the current buffer;
665 it never converts between single-byte and multibyte.
667 DO NOT use this for the contents of a Lisp string or a Lisp buffer!
668 prepare_to_modify_buffer could relocate the text. */
670 void
671 insert (const char *string, EMACS_INT nbytes)
673 if (nbytes > 0)
675 EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
676 insert_1_both (string, len, nbytes, 0, 1, 0);
677 opoint = PT - len;
678 signal_after_change (opoint, 0, len);
679 update_compositions (opoint, PT, CHECK_BORDER);
683 /* Likewise, but inherit text properties from neighboring characters. */
685 void
686 insert_and_inherit (const char *string, EMACS_INT nbytes)
688 if (nbytes > 0)
690 EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
691 insert_1_both (string, len, nbytes, 1, 1, 0);
692 opoint = PT - len;
693 signal_after_change (opoint, 0, len);
694 update_compositions (opoint, PT, CHECK_BORDER);
698 /* Insert the character C before point. Do not inherit text properties. */
700 void
701 insert_char (int c)
703 unsigned char str[MAX_MULTIBYTE_LENGTH];
704 int len;
706 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
707 len = CHAR_STRING (c, str);
708 else
710 len = 1;
711 str[0] = c;
714 insert ((char *) str, len);
717 /* Insert the null-terminated string S before point. */
719 void
720 insert_string (const char *s)
722 insert (s, strlen (s));
725 /* Like `insert' except that all markers pointing at the place where
726 the insertion happens are adjusted to point after it.
727 Don't use this function to insert part of a Lisp string,
728 since gc could happen and relocate it. */
730 void
731 insert_before_markers (const char *string, EMACS_INT nbytes)
733 if (nbytes > 0)
735 EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
736 insert_1_both (string, len, nbytes, 0, 1, 1);
737 opoint = PT - len;
738 signal_after_change (opoint, 0, len);
739 update_compositions (opoint, PT, CHECK_BORDER);
743 /* Likewise, but inherit text properties from neighboring characters. */
745 void
746 insert_before_markers_and_inherit (const char *string,
747 EMACS_INT nbytes)
749 if (nbytes > 0)
751 EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
752 insert_1_both (string, len, nbytes, 1, 1, 1);
753 opoint = PT - len;
754 signal_after_change (opoint, 0, len);
755 update_compositions (opoint, PT, CHECK_BORDER);
759 /* Subroutine used by the insert functions above. */
761 void
762 insert_1 (const char *string, EMACS_INT nbytes,
763 int inherit, int prepare, int before_markers)
765 insert_1_both (string, chars_in_text ((unsigned char *) string, nbytes),
766 nbytes, inherit, prepare, before_markers);
770 #ifdef BYTE_COMBINING_DEBUG
772 /* See if the bytes before POS/POS_BYTE combine with bytes
773 at the start of STRING to form a single character.
774 If so, return the number of bytes at the start of STRING
775 which combine in this way. Otherwise, return 0. */
778 count_combining_before (const unsigned char *string, EMACS_INT length,
779 EMACS_INT pos, EMACS_INT pos_byte)
781 int len, combining_bytes;
782 const unsigned char *p;
784 if (NILP (current_buffer->enable_multibyte_characters))
785 return 0;
787 /* At first, we can exclude the following cases:
788 (1) STRING[0] can't be a following byte of multibyte sequence.
789 (2) POS is the start of the current buffer.
790 (3) A character before POS is not a multibyte character. */
791 if (length == 0 || CHAR_HEAD_P (*string)) /* case (1) */
792 return 0;
793 if (pos_byte == BEG_BYTE) /* case (2) */
794 return 0;
795 len = 1;
796 p = BYTE_POS_ADDR (pos_byte - 1);
797 while (! CHAR_HEAD_P (*p)) p--, len++;
798 if (! LEADING_CODE_P (*p)) /* case (3) */
799 return 0;
801 combining_bytes = BYTES_BY_CHAR_HEAD (*p) - len;
802 if (combining_bytes <= 0)
803 /* The character preceding POS is, complete and no room for
804 combining bytes (combining_bytes == 0), or an independent 8-bit
805 character (combining_bytes < 0). */
806 return 0;
808 /* We have a combination situation. Count the bytes at STRING that
809 may combine. */
810 p = string + 1;
811 while (!CHAR_HEAD_P (*p) && p < string + length)
812 p++;
814 return (combining_bytes < p - string ? combining_bytes : p - string);
817 /* See if the bytes after POS/POS_BYTE combine with bytes
818 at the end of STRING to form a single character.
819 If so, return the number of bytes after POS/POS_BYTE
820 which combine in this way. Otherwise, return 0. */
823 count_combining_after (const unsigned char *string,
824 EMACS_INT length, EMACS_INT pos, EMACS_INT pos_byte)
826 EMACS_INT opos_byte = pos_byte;
827 EMACS_INT i;
828 EMACS_INT bytes;
829 unsigned char *bufp;
831 if (NILP (current_buffer->enable_multibyte_characters))
832 return 0;
834 /* At first, we can exclude the following cases:
835 (1) The last byte of STRING is an ASCII.
836 (2) POS is the last of the current buffer.
837 (3) A character at POS can't be a following byte of multibyte
838 character. */
839 if (length > 0 && ASCII_BYTE_P (string[length - 1])) /* case (1) */
840 return 0;
841 if (pos_byte == Z_BYTE) /* case (2) */
842 return 0;
843 bufp = BYTE_POS_ADDR (pos_byte);
844 if (CHAR_HEAD_P (*bufp)) /* case (3) */
845 return 0;
847 i = length - 1;
848 while (i >= 0 && ! CHAR_HEAD_P (string[i]))
850 i--;
852 if (i < 0)
854 /* All characters in STRING are not character head. We must
855 check also preceding bytes at POS. We are sure that the gap
856 is at POS. */
857 unsigned char *p = BEG_ADDR;
858 i = pos_byte - 2;
859 while (i >= 0 && ! CHAR_HEAD_P (p[i]))
860 i--;
861 if (i < 0 || !LEADING_CODE_P (p[i]))
862 return 0;
864 bytes = BYTES_BY_CHAR_HEAD (p[i]);
865 return (bytes <= pos_byte - 1 - i + length
867 : bytes - (pos_byte - 1 - i + length));
869 if (!LEADING_CODE_P (string[i]))
870 return 0;
872 bytes = BYTES_BY_CHAR_HEAD (string[i]) - (length - i);
873 bufp++, pos_byte++;
874 while (!CHAR_HEAD_P (*bufp)) bufp++, pos_byte++;
876 return (bytes <= pos_byte - opos_byte ? bytes : pos_byte - opos_byte);
879 #endif
882 /* Insert a sequence of NCHARS chars which occupy NBYTES bytes
883 starting at STRING. INHERIT, PREPARE and BEFORE_MARKERS
884 are the same as in insert_1. */
886 void
887 insert_1_both (const char *string,
888 EMACS_INT nchars, EMACS_INT nbytes,
889 int inherit, int prepare, int before_markers)
891 if (nchars == 0)
892 return;
894 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
895 nchars = nbytes;
897 if (prepare)
898 /* Do this before moving and increasing the gap,
899 because the before-change hooks might move the gap
900 or make it smaller. */
901 prepare_to_modify_buffer (PT, PT, NULL);
903 if (PT != GPT)
904 move_gap_both (PT, PT_BYTE);
905 if (GAP_SIZE < nbytes)
906 make_gap (nbytes - GAP_SIZE);
908 #ifdef BYTE_COMBINING_DEBUG
909 if (count_combining_before (string, nbytes, PT, PT_BYTE)
910 || count_combining_after (string, nbytes, PT, PT_BYTE))
911 abort ();
912 #endif
914 /* Record deletion of the surrounding text that combines with
915 the insertion. This, together with recording the insertion,
916 will add up to the right stuff in the undo list. */
917 record_insert (PT, nchars);
918 MODIFF++;
919 CHARS_MODIFF = MODIFF;
921 memcpy (GPT_ADDR, string, nbytes);
923 GAP_SIZE -= nbytes;
924 GPT += nchars;
925 ZV += nchars;
926 Z += nchars;
927 GPT_BYTE += nbytes;
928 ZV_BYTE += nbytes;
929 Z_BYTE += nbytes;
930 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
932 if (GPT_BYTE < GPT)
933 abort ();
935 /* The insert may have been in the unchanged region, so check again. */
936 if (Z - GPT < END_UNCHANGED)
937 END_UNCHANGED = Z - GPT;
939 adjust_overlays_for_insert (PT, nchars);
940 adjust_markers_for_insert (PT, PT_BYTE,
941 PT + nchars, PT_BYTE + nbytes,
942 before_markers);
944 if (BUF_INTERVALS (current_buffer) != 0)
945 offset_intervals (current_buffer, PT, nchars);
947 if (!inherit && BUF_INTERVALS (current_buffer) != 0)
948 set_text_properties (make_number (PT), make_number (PT + nchars),
949 Qnil, Qnil, Qnil);
951 adjust_point (nchars, nbytes);
953 CHECK_MARKERS ();
956 /* Insert the part of the text of STRING, a Lisp object assumed to be
957 of type string, consisting of the LENGTH characters (LENGTH_BYTE bytes)
958 starting at position POS / POS_BYTE. If the text of STRING has properties,
959 copy them into the buffer.
961 It does not work to use `insert' for this, because a GC could happen
962 before we copy the stuff into the buffer, and relocate the string
963 without insert noticing. */
965 void
966 insert_from_string (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
967 EMACS_INT length, EMACS_INT length_byte, int inherit)
969 EMACS_INT opoint = PT;
971 if (SCHARS (string) == 0)
972 return;
974 insert_from_string_1 (string, pos, pos_byte, length, length_byte,
975 inherit, 0);
976 signal_after_change (opoint, 0, PT - opoint);
977 update_compositions (opoint, PT, CHECK_BORDER);
980 /* Like `insert_from_string' except that all markers pointing
981 at the place where the insertion happens are adjusted to point after it. */
983 void
984 insert_from_string_before_markers (Lisp_Object string,
985 EMACS_INT pos, EMACS_INT pos_byte,
986 EMACS_INT length, EMACS_INT length_byte,
987 int inherit)
989 EMACS_INT opoint = PT;
991 if (SCHARS (string) == 0)
992 return;
994 insert_from_string_1 (string, pos, pos_byte, length, length_byte,
995 inherit, 1);
996 signal_after_change (opoint, 0, PT - opoint);
997 update_compositions (opoint, PT, CHECK_BORDER);
1000 /* Subroutine of the insertion functions above. */
1002 static void
1003 insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
1004 EMACS_INT nchars, EMACS_INT nbytes,
1005 int inherit, int before_markers)
1007 struct gcpro gcpro1;
1008 EMACS_INT outgoing_nbytes = nbytes;
1009 INTERVAL intervals;
1011 /* Make OUTGOING_NBYTES describe the text
1012 as it will be inserted in this buffer. */
1014 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1015 outgoing_nbytes = nchars;
1016 else if (! STRING_MULTIBYTE (string))
1017 outgoing_nbytes
1018 = count_size_as_multibyte (SDATA (string) + pos_byte,
1019 nbytes);
1021 GCPRO1 (string);
1022 /* Do this before moving and increasing the gap,
1023 because the before-change hooks might move the gap
1024 or make it smaller. */
1025 prepare_to_modify_buffer (PT, PT, NULL);
1027 if (PT != GPT)
1028 move_gap_both (PT, PT_BYTE);
1029 if (GAP_SIZE < outgoing_nbytes)
1030 make_gap (outgoing_nbytes - GAP_SIZE);
1031 UNGCPRO;
1033 /* Copy the string text into the buffer, perhaps converting
1034 between single-byte and multibyte. */
1035 copy_text (SDATA (string) + pos_byte, GPT_ADDR, nbytes,
1036 STRING_MULTIBYTE (string),
1037 ! NILP (BVAR (current_buffer, enable_multibyte_characters)));
1039 #ifdef BYTE_COMBINING_DEBUG
1040 /* We have copied text into the gap, but we have not altered
1041 PT or PT_BYTE yet. So we can pass PT and PT_BYTE
1042 to these functions and get the same results as we would
1043 have got earlier on. Meanwhile, PT_ADDR does point to
1044 the text that has been stored by copy_text. */
1045 if (count_combining_before (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE)
1046 || count_combining_after (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE))
1047 abort ();
1048 #endif
1050 record_insert (PT, nchars);
1051 MODIFF++;
1052 CHARS_MODIFF = MODIFF;
1054 GAP_SIZE -= outgoing_nbytes;
1055 GPT += nchars;
1056 ZV += nchars;
1057 Z += nchars;
1058 GPT_BYTE += outgoing_nbytes;
1059 ZV_BYTE += outgoing_nbytes;
1060 Z_BYTE += outgoing_nbytes;
1061 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1063 if (GPT_BYTE < GPT)
1064 abort ();
1066 /* The insert may have been in the unchanged region, so check again. */
1067 if (Z - GPT < END_UNCHANGED)
1068 END_UNCHANGED = Z - GPT;
1070 adjust_overlays_for_insert (PT, nchars);
1071 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
1072 PT_BYTE + outgoing_nbytes,
1073 before_markers);
1075 offset_intervals (current_buffer, PT, nchars);
1077 intervals = STRING_INTERVALS (string);
1078 /* Get the intervals for the part of the string we are inserting. */
1079 if (nbytes < SBYTES (string))
1080 intervals = copy_intervals (intervals, pos, nchars);
1082 /* Insert those intervals. */
1083 graft_intervals_into_buffer (intervals, PT, nchars,
1084 current_buffer, inherit);
1086 adjust_point (nchars, outgoing_nbytes);
1088 CHECK_MARKERS ();
1091 /* Insert a sequence of NCHARS chars which occupy NBYTES bytes
1092 starting at GPT_ADDR. */
1094 void
1095 insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes)
1097 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1098 nchars = nbytes;
1100 record_insert (GPT, nchars);
1101 MODIFF++;
1103 GAP_SIZE -= nbytes;
1104 GPT += nchars;
1105 ZV += nchars;
1106 Z += nchars;
1107 GPT_BYTE += nbytes;
1108 ZV_BYTE += nbytes;
1109 Z_BYTE += nbytes;
1110 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1112 if (GPT_BYTE < GPT)
1113 abort ();
1115 adjust_overlays_for_insert (GPT - nchars, nchars);
1116 adjust_markers_for_insert (GPT - nchars, GPT_BYTE - nbytes,
1117 GPT, GPT_BYTE, 0);
1119 if (BUF_INTERVALS (current_buffer) != 0)
1121 offset_intervals (current_buffer, GPT - nchars, nchars);
1122 graft_intervals_into_buffer (NULL_INTERVAL, GPT - nchars, nchars,
1123 current_buffer, 0);
1126 if (GPT - nchars < PT)
1127 adjust_point (nchars, nbytes);
1129 CHECK_MARKERS ();
1132 /* Insert text from BUF, NCHARS characters starting at CHARPOS, into the
1133 current buffer. If the text in BUF has properties, they are absorbed
1134 into the current buffer.
1136 It does not work to use `insert' for this, because a malloc could happen
1137 and relocate BUF's text before the copy happens. */
1139 void
1140 insert_from_buffer (struct buffer *buf,
1141 EMACS_INT charpos, EMACS_INT nchars, int inherit)
1143 EMACS_INT opoint = PT;
1145 insert_from_buffer_1 (buf, charpos, nchars, inherit);
1146 signal_after_change (opoint, 0, PT - opoint);
1147 update_compositions (opoint, PT, CHECK_BORDER);
1150 static void
1151 insert_from_buffer_1 (struct buffer *buf,
1152 EMACS_INT from, EMACS_INT nchars, int inherit)
1154 register Lisp_Object temp;
1155 EMACS_INT chunk, chunk_expanded;
1156 EMACS_INT from_byte = buf_charpos_to_bytepos (buf, from);
1157 EMACS_INT to_byte = buf_charpos_to_bytepos (buf, from + nchars);
1158 EMACS_INT incoming_nbytes = to_byte - from_byte;
1159 EMACS_INT outgoing_nbytes = incoming_nbytes;
1160 INTERVAL intervals;
1162 /* Make OUTGOING_NBYTES describe the text
1163 as it will be inserted in this buffer. */
1165 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1166 outgoing_nbytes = nchars;
1167 else if (NILP (BVAR (buf, enable_multibyte_characters)))
1169 EMACS_INT outgoing_before_gap = 0;
1170 EMACS_INT outgoing_after_gap = 0;
1172 if (from < BUF_GPT (buf))
1174 chunk = BUF_GPT_BYTE (buf) - from_byte;
1175 if (chunk > incoming_nbytes)
1176 chunk = incoming_nbytes;
1177 outgoing_before_gap
1178 = count_size_as_multibyte (BUF_BYTE_ADDRESS (buf, from_byte),
1179 chunk);
1181 else
1182 chunk = 0;
1184 if (chunk < incoming_nbytes)
1185 outgoing_after_gap
1186 = count_size_as_multibyte (BUF_BYTE_ADDRESS (buf,
1187 from_byte + chunk),
1188 incoming_nbytes - chunk);
1190 outgoing_nbytes = outgoing_before_gap + outgoing_after_gap;
1193 /* Make sure point-max won't overflow after this insertion. */
1194 XSETINT (temp, outgoing_nbytes + Z);
1195 if (outgoing_nbytes + Z != XINT (temp))
1196 error ("Maximum buffer size exceeded");
1198 /* Do this before moving and increasing the gap,
1199 because the before-change hooks might move the gap
1200 or make it smaller. */
1201 prepare_to_modify_buffer (PT, PT, NULL);
1203 if (PT != GPT)
1204 move_gap_both (PT, PT_BYTE);
1205 if (GAP_SIZE < outgoing_nbytes)
1206 make_gap (outgoing_nbytes - GAP_SIZE);
1208 if (from < BUF_GPT (buf))
1210 chunk = BUF_GPT_BYTE (buf) - from_byte;
1211 if (chunk > incoming_nbytes)
1212 chunk = incoming_nbytes;
1213 /* Record number of output bytes, so we know where
1214 to put the output from the second copy_text. */
1215 chunk_expanded
1216 = copy_text (BUF_BYTE_ADDRESS (buf, from_byte),
1217 GPT_ADDR, chunk,
1218 ! NILP (BVAR (buf, enable_multibyte_characters)),
1219 ! NILP (BVAR (current_buffer, enable_multibyte_characters)));
1221 else
1222 chunk_expanded = chunk = 0;
1224 if (chunk < incoming_nbytes)
1225 copy_text (BUF_BYTE_ADDRESS (buf, from_byte + chunk),
1226 GPT_ADDR + chunk_expanded, incoming_nbytes - chunk,
1227 ! NILP (BVAR (buf, enable_multibyte_characters)),
1228 ! NILP (BVAR (current_buffer, enable_multibyte_characters)));
1230 #ifdef BYTE_COMBINING_DEBUG
1231 /* We have copied text into the gap, but we have not altered
1232 PT or PT_BYTE yet. So we can pass PT and PT_BYTE
1233 to these functions and get the same results as we would
1234 have got earlier on. Meanwhile, GPT_ADDR does point to
1235 the text that has been stored by copy_text. */
1236 if (count_combining_before (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE)
1237 || count_combining_after (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE))
1238 abort ();
1239 #endif
1241 record_insert (PT, nchars);
1242 MODIFF++;
1243 CHARS_MODIFF = MODIFF;
1245 GAP_SIZE -= outgoing_nbytes;
1246 GPT += nchars;
1247 ZV += nchars;
1248 Z += nchars;
1249 GPT_BYTE += outgoing_nbytes;
1250 ZV_BYTE += outgoing_nbytes;
1251 Z_BYTE += outgoing_nbytes;
1252 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1254 if (GPT_BYTE < GPT)
1255 abort ();
1257 /* The insert may have been in the unchanged region, so check again. */
1258 if (Z - GPT < END_UNCHANGED)
1259 END_UNCHANGED = Z - GPT;
1261 adjust_overlays_for_insert (PT, nchars);
1262 adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
1263 PT_BYTE + outgoing_nbytes,
1266 if (BUF_INTERVALS (current_buffer) != 0)
1267 offset_intervals (current_buffer, PT, nchars);
1269 /* Get the intervals for the part of the string we are inserting. */
1270 intervals = BUF_INTERVALS (buf);
1271 if (nchars < BUF_Z (buf) - BUF_BEG (buf))
1273 if (buf == current_buffer && PT <= from)
1274 from += nchars;
1275 intervals = copy_intervals (intervals, from, nchars);
1278 /* Insert those intervals. */
1279 graft_intervals_into_buffer (intervals, PT, nchars, current_buffer, inherit);
1281 adjust_point (nchars, outgoing_nbytes);
1284 /* Record undo information and adjust markers and position keepers for
1285 a replacement of a text PREV_TEXT at FROM to a new text of LEN
1286 chars (LEN_BYTE bytes) which resides in the gap just after
1287 GPT_ADDR.
1289 PREV_TEXT nil means the new text was just inserted. */
1291 void
1292 adjust_after_replace (EMACS_INT from, EMACS_INT from_byte,
1293 Lisp_Object prev_text, EMACS_INT len, EMACS_INT len_byte)
1295 EMACS_INT nchars_del = 0, nbytes_del = 0;
1297 #ifdef BYTE_COMBINING_DEBUG
1298 if (count_combining_before (GPT_ADDR, len_byte, from, from_byte)
1299 || count_combining_after (GPT_ADDR, len_byte, from, from_byte))
1300 abort ();
1301 #endif
1303 if (STRINGP (prev_text))
1305 nchars_del = SCHARS (prev_text);
1306 nbytes_del = SBYTES (prev_text);
1309 /* Update various buffer positions for the new text. */
1310 GAP_SIZE -= len_byte;
1311 ZV += len; Z+= len;
1312 ZV_BYTE += len_byte; Z_BYTE += len_byte;
1313 GPT += len; GPT_BYTE += len_byte;
1314 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1316 if (nchars_del > 0)
1317 adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
1318 len, len_byte);
1319 else
1320 adjust_markers_for_insert (from, from_byte,
1321 from + len, from_byte + len_byte, 0);
1323 if (! EQ (BVAR (current_buffer, undo_list), Qt))
1325 if (nchars_del > 0)
1326 record_delete (from, prev_text);
1327 record_insert (from, len);
1330 if (len > nchars_del)
1331 adjust_overlays_for_insert (from, len - nchars_del);
1332 else if (len < nchars_del)
1333 adjust_overlays_for_delete (from, nchars_del - len);
1334 if (BUF_INTERVALS (current_buffer) != 0)
1336 offset_intervals (current_buffer, from, len - nchars_del);
1339 if (from < PT)
1340 adjust_point (len - nchars_del, len_byte - nbytes_del);
1342 /* As byte combining will decrease Z, we must check this again. */
1343 if (Z - GPT < END_UNCHANGED)
1344 END_UNCHANGED = Z - GPT;
1346 CHECK_MARKERS ();
1348 if (len == 0)
1349 evaporate_overlays (from);
1350 MODIFF++;
1351 CHARS_MODIFF = MODIFF;
1354 /* Like adjust_after_replace, but doesn't require PREV_TEXT.
1355 This is for use when undo is not enabled in the current buffer. */
1357 void
1358 adjust_after_replace_noundo (EMACS_INT from, EMACS_INT from_byte,
1359 EMACS_INT nchars_del, EMACS_INT nbytes_del,
1360 EMACS_INT len, EMACS_INT len_byte)
1362 #ifdef BYTE_COMBINING_DEBUG
1363 if (count_combining_before (GPT_ADDR, len_byte, from, from_byte)
1364 || count_combining_after (GPT_ADDR, len_byte, from, from_byte))
1365 abort ();
1366 #endif
1368 /* Update various buffer positions for the new text. */
1369 GAP_SIZE -= len_byte;
1370 ZV += len; Z+= len;
1371 ZV_BYTE += len_byte; Z_BYTE += len_byte;
1372 GPT += len; GPT_BYTE += len_byte;
1373 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1375 if (nchars_del > 0)
1376 adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
1377 len, len_byte);
1378 else
1379 adjust_markers_for_insert (from, from_byte,
1380 from + len, from_byte + len_byte, 0);
1382 if (len > nchars_del)
1383 adjust_overlays_for_insert (from, len - nchars_del);
1384 else if (len < nchars_del)
1385 adjust_overlays_for_delete (from, nchars_del - len);
1386 if (BUF_INTERVALS (current_buffer) != 0)
1388 offset_intervals (current_buffer, from, len - nchars_del);
1391 if (from < PT)
1392 adjust_point (len - nchars_del, len_byte - nbytes_del);
1394 /* As byte combining will decrease Z, we must check this again. */
1395 if (Z - GPT < END_UNCHANGED)
1396 END_UNCHANGED = Z - GPT;
1398 CHECK_MARKERS ();
1400 if (len == 0)
1401 evaporate_overlays (from);
1402 MODIFF++;
1403 CHARS_MODIFF = MODIFF;
1406 /* Record undo information, adjust markers and position keepers for an
1407 insertion of a text from FROM (FROM_BYTE) to TO (TO_BYTE). The
1408 text already exists in the current buffer but character length (TO
1409 - FROM) may be incorrect, the correct length is NEWLEN. */
1411 void
1412 adjust_after_insert (EMACS_INT from, EMACS_INT from_byte,
1413 EMACS_INT to, EMACS_INT to_byte, EMACS_INT newlen)
1415 EMACS_INT len = to - from, len_byte = to_byte - from_byte;
1417 if (GPT != to)
1418 move_gap_both (to, to_byte);
1419 GAP_SIZE += len_byte;
1420 GPT -= len; GPT_BYTE -= len_byte;
1421 ZV -= len; ZV_BYTE -= len_byte;
1422 Z -= len; Z_BYTE -= len_byte;
1423 adjust_after_replace (from, from_byte, Qnil, newlen, len_byte);
1426 /* Replace the text from character positions FROM to TO with NEW,
1427 If PREPARE is nonzero, call prepare_to_modify_buffer.
1428 If INHERIT, the newly inserted text should inherit text properties
1429 from the surrounding non-deleted text. */
1431 /* Note that this does not yet handle markers quite right.
1432 Also it needs to record a single undo-entry that does a replacement
1433 rather than a separate delete and insert.
1434 That way, undo will also handle markers properly.
1436 But if MARKERS is 0, don't relocate markers. */
1438 void
1439 replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
1440 int prepare, int inherit, int markers)
1442 EMACS_INT inschars = SCHARS (new);
1443 EMACS_INT insbytes = SBYTES (new);
1444 EMACS_INT from_byte, to_byte;
1445 EMACS_INT nbytes_del, nchars_del;
1446 register Lisp_Object temp;
1447 struct gcpro gcpro1;
1448 INTERVAL intervals;
1449 EMACS_INT outgoing_insbytes = insbytes;
1450 Lisp_Object deletion;
1452 CHECK_MARKERS ();
1454 GCPRO1 (new);
1455 deletion = Qnil;
1457 if (prepare)
1459 EMACS_INT range_length = to - from;
1460 prepare_to_modify_buffer (from, to, &from);
1461 to = from + range_length;
1464 UNGCPRO;
1466 /* Make args be valid */
1467 if (from < BEGV)
1468 from = BEGV;
1469 if (to > ZV)
1470 to = ZV;
1472 from_byte = CHAR_TO_BYTE (from);
1473 to_byte = CHAR_TO_BYTE (to);
1475 nchars_del = to - from;
1476 nbytes_del = to_byte - from_byte;
1478 if (nbytes_del <= 0 && insbytes == 0)
1479 return;
1481 /* Make OUTGOING_INSBYTES describe the text
1482 as it will be inserted in this buffer. */
1484 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1485 outgoing_insbytes = inschars;
1486 else if (! STRING_MULTIBYTE (new))
1487 outgoing_insbytes
1488 = count_size_as_multibyte (SDATA (new), insbytes);
1490 /* Make sure point-max won't overflow after this insertion. */
1491 XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
1492 if (Z_BYTE - nbytes_del + insbytes != XINT (temp))
1493 error ("Maximum buffer size exceeded");
1495 GCPRO1 (new);
1497 /* Make sure the gap is somewhere in or next to what we are deleting. */
1498 if (from > GPT)
1499 gap_right (from, from_byte);
1500 if (to < GPT)
1501 gap_left (to, to_byte, 0);
1503 /* Even if we don't record for undo, we must keep the original text
1504 because we may have to recover it because of inappropriate byte
1505 combining. */
1506 if (! EQ (BVAR (current_buffer, undo_list), Qt))
1507 deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1);
1509 GAP_SIZE += nbytes_del;
1510 ZV -= nchars_del;
1511 Z -= nchars_del;
1512 ZV_BYTE -= nbytes_del;
1513 Z_BYTE -= nbytes_del;
1514 GPT = from;
1515 GPT_BYTE = from_byte;
1516 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1518 if (GPT_BYTE < GPT)
1519 abort ();
1521 if (GPT - BEG < BEG_UNCHANGED)
1522 BEG_UNCHANGED = GPT - BEG;
1523 if (Z - GPT < END_UNCHANGED)
1524 END_UNCHANGED = Z - GPT;
1526 if (GAP_SIZE < insbytes)
1527 make_gap (insbytes - GAP_SIZE);
1529 /* Copy the string text into the buffer, perhaps converting
1530 between single-byte and multibyte. */
1531 copy_text (SDATA (new), GPT_ADDR, insbytes,
1532 STRING_MULTIBYTE (new),
1533 ! NILP (BVAR (current_buffer, enable_multibyte_characters)));
1535 #ifdef BYTE_COMBINING_DEBUG
1536 /* We have copied text into the gap, but we have not marked
1537 it as part of the buffer. So we can use the old FROM and FROM_BYTE
1538 here, for both the previous text and the following text.
1539 Meanwhile, GPT_ADDR does point to
1540 the text that has been stored by copy_text. */
1541 if (count_combining_before (GPT_ADDR, outgoing_insbytes, from, from_byte)
1542 || count_combining_after (GPT_ADDR, outgoing_insbytes, from, from_byte))
1543 abort ();
1544 #endif
1546 if (! EQ (BVAR (current_buffer, undo_list), Qt))
1548 /* Record the insertion first, so that when we undo,
1549 the deletion will be undone first. Thus, undo
1550 will insert before deleting, and thus will keep
1551 the markers before and after this text separate. */
1552 record_insert (from + SCHARS (deletion), inschars);
1553 record_delete (from, deletion);
1556 GAP_SIZE -= outgoing_insbytes;
1557 GPT += inschars;
1558 ZV += inschars;
1559 Z += inschars;
1560 GPT_BYTE += outgoing_insbytes;
1561 ZV_BYTE += outgoing_insbytes;
1562 Z_BYTE += outgoing_insbytes;
1563 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1565 if (GPT_BYTE < GPT)
1566 abort ();
1568 /* Adjust the overlay center as needed. This must be done after
1569 adjusting the markers that bound the overlays. */
1570 adjust_overlays_for_delete (from, nchars_del);
1571 adjust_overlays_for_insert (from, inschars);
1573 /* Adjust markers for the deletion and the insertion. */
1574 if (markers)
1575 adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
1576 inschars, outgoing_insbytes);
1578 offset_intervals (current_buffer, from, inschars - nchars_del);
1580 /* Get the intervals for the part of the string we are inserting--
1581 not including the combined-before bytes. */
1582 intervals = STRING_INTERVALS (new);
1583 /* Insert those intervals. */
1584 graft_intervals_into_buffer (intervals, from, inschars,
1585 current_buffer, inherit);
1587 /* Relocate point as if it were a marker. */
1588 if (from < PT)
1589 adjust_point ((from + inschars - (PT < to ? PT : to)),
1590 (from_byte + outgoing_insbytes
1591 - (PT_BYTE < to_byte ? PT_BYTE : to_byte)));
1593 if (outgoing_insbytes == 0)
1594 evaporate_overlays (from);
1596 CHECK_MARKERS ();
1598 MODIFF++;
1599 CHARS_MODIFF = MODIFF;
1600 UNGCPRO;
1602 signal_after_change (from, nchars_del, GPT - from);
1603 update_compositions (from, GPT, CHECK_BORDER);
1606 /* Replace the text from character positions FROM to TO with
1607 the text in INS of length INSCHARS.
1608 Keep the text properties that applied to the old characters
1609 (extending them to all the new chars if there are more new chars).
1611 Note that this does not yet handle markers quite right.
1613 If MARKERS is nonzero, relocate markers.
1615 Unlike most functions at this level, never call
1616 prepare_to_modify_buffer and never call signal_after_change. */
1618 void
1619 replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
1620 EMACS_INT to, EMACS_INT to_byte,
1621 const char *ins, EMACS_INT inschars, EMACS_INT insbytes,
1622 int markers)
1624 EMACS_INT nbytes_del, nchars_del;
1625 Lisp_Object temp;
1627 CHECK_MARKERS ();
1629 nchars_del = to - from;
1630 nbytes_del = to_byte - from_byte;
1632 if (nbytes_del <= 0 && insbytes == 0)
1633 return;
1635 /* Make sure point-max won't overflow after this insertion. */
1636 XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
1637 if (Z_BYTE - nbytes_del + insbytes != XINT (temp))
1638 error ("Maximum buffer size exceeded");
1640 /* Make sure the gap is somewhere in or next to what we are deleting. */
1641 if (from > GPT)
1642 gap_right (from, from_byte);
1643 if (to < GPT)
1644 gap_left (to, to_byte, 0);
1646 GAP_SIZE += nbytes_del;
1647 ZV -= nchars_del;
1648 Z -= nchars_del;
1649 ZV_BYTE -= nbytes_del;
1650 Z_BYTE -= nbytes_del;
1651 GPT = from;
1652 GPT_BYTE = from_byte;
1653 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1655 if (GPT_BYTE < GPT)
1656 abort ();
1658 if (GPT - BEG < BEG_UNCHANGED)
1659 BEG_UNCHANGED = GPT - BEG;
1660 if (Z - GPT < END_UNCHANGED)
1661 END_UNCHANGED = Z - GPT;
1663 if (GAP_SIZE < insbytes)
1664 make_gap (insbytes - GAP_SIZE);
1666 /* Copy the replacement text into the buffer. */
1667 memcpy (GPT_ADDR, ins, insbytes);
1669 #ifdef BYTE_COMBINING_DEBUG
1670 /* We have copied text into the gap, but we have not marked
1671 it as part of the buffer. So we can use the old FROM and FROM_BYTE
1672 here, for both the previous text and the following text.
1673 Meanwhile, GPT_ADDR does point to
1674 the text that has been stored by copy_text. */
1675 if (count_combining_before (GPT_ADDR, insbytes, from, from_byte)
1676 || count_combining_after (GPT_ADDR, insbytes, from, from_byte))
1677 abort ();
1678 #endif
1680 GAP_SIZE -= insbytes;
1681 GPT += inschars;
1682 ZV += inschars;
1683 Z += inschars;
1684 GPT_BYTE += insbytes;
1685 ZV_BYTE += insbytes;
1686 Z_BYTE += insbytes;
1687 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
1689 if (GPT_BYTE < GPT)
1690 abort ();
1692 /* Adjust the overlay center as needed. This must be done after
1693 adjusting the markers that bound the overlays. */
1694 if (nchars_del != inschars)
1696 adjust_overlays_for_insert (from, inschars);
1697 adjust_overlays_for_delete (from + inschars, nchars_del);
1700 /* Adjust markers for the deletion and the insertion. */
1701 if (markers
1702 && ! (nchars_del == 1 && inschars == 1 && nbytes_del == insbytes))
1703 adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
1704 inschars, insbytes);
1706 offset_intervals (current_buffer, from, inschars - nchars_del);
1708 /* Relocate point as if it were a marker. */
1709 if (from < PT && (nchars_del != inschars || nbytes_del != insbytes))
1711 if (PT < to)
1712 /* PT was within the deleted text. Move it to FROM. */
1713 adjust_point (from - PT, from_byte - PT_BYTE);
1714 else
1715 adjust_point (inschars - nchars_del, insbytes - nbytes_del);
1718 if (insbytes == 0)
1719 evaporate_overlays (from);
1721 CHECK_MARKERS ();
1723 MODIFF++;
1724 CHARS_MODIFF = MODIFF;
1727 /* Delete characters in current buffer
1728 from FROM up to (but not including) TO.
1729 If TO comes before FROM, we delete nothing. */
1731 void
1732 del_range (EMACS_INT from, EMACS_INT to)
1734 del_range_1 (from, to, 1, 0);
1737 /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer.
1738 RET_STRING says to return the deleted text. */
1740 Lisp_Object
1741 del_range_1 (EMACS_INT from, EMACS_INT to, int prepare, int ret_string)
1743 EMACS_INT from_byte, to_byte;
1744 Lisp_Object deletion;
1745 struct gcpro gcpro1;
1747 /* Make args be valid */
1748 if (from < BEGV)
1749 from = BEGV;
1750 if (to > ZV)
1751 to = ZV;
1753 if (to <= from)
1754 return Qnil;
1756 if (prepare)
1758 EMACS_INT range_length = to - from;
1759 prepare_to_modify_buffer (from, to, &from);
1760 to = min (ZV, from + range_length);
1763 from_byte = CHAR_TO_BYTE (from);
1764 to_byte = CHAR_TO_BYTE (to);
1766 deletion = del_range_2 (from, from_byte, to, to_byte, ret_string);
1767 GCPRO1(deletion);
1768 signal_after_change (from, to - from, 0);
1769 update_compositions (from, from, CHECK_HEAD);
1770 UNGCPRO;
1771 return deletion;
1774 /* Like del_range_1 but args are byte positions, not char positions. */
1776 void
1777 del_range_byte (EMACS_INT from_byte, EMACS_INT to_byte, int prepare)
1779 EMACS_INT from, to;
1781 /* Make args be valid */
1782 if (from_byte < BEGV_BYTE)
1783 from_byte = BEGV_BYTE;
1784 if (to_byte > ZV_BYTE)
1785 to_byte = ZV_BYTE;
1787 if (to_byte <= from_byte)
1788 return;
1790 from = BYTE_TO_CHAR (from_byte);
1791 to = BYTE_TO_CHAR (to_byte);
1793 if (prepare)
1795 EMACS_INT old_from = from, old_to = Z - to;
1796 EMACS_INT range_length = to - from;
1797 prepare_to_modify_buffer (from, to, &from);
1798 to = from + range_length;
1800 if (old_from != from)
1801 from_byte = CHAR_TO_BYTE (from);
1802 if (to > ZV)
1804 to = ZV;
1805 to_byte = ZV_BYTE;
1807 else if (old_to == Z - to)
1808 to_byte = CHAR_TO_BYTE (to);
1811 del_range_2 (from, from_byte, to, to_byte, 0);
1812 signal_after_change (from, to - from, 0);
1813 update_compositions (from, from, CHECK_HEAD);
1816 /* Like del_range_1, but positions are specified both as charpos
1817 and bytepos. */
1819 void
1820 del_range_both (EMACS_INT from, EMACS_INT from_byte,
1821 EMACS_INT to, EMACS_INT to_byte, int prepare)
1823 /* Make args be valid */
1824 if (from_byte < BEGV_BYTE)
1825 from_byte = BEGV_BYTE;
1826 if (to_byte > ZV_BYTE)
1827 to_byte = ZV_BYTE;
1829 if (to_byte <= from_byte)
1830 return;
1832 if (from < BEGV)
1833 from = BEGV;
1834 if (to > ZV)
1835 to = ZV;
1837 if (prepare)
1839 EMACS_INT old_from = from, old_to = Z - to;
1840 EMACS_INT range_length = to - from;
1841 prepare_to_modify_buffer (from, to, &from);
1842 to = from + range_length;
1844 if (old_from != from)
1845 from_byte = CHAR_TO_BYTE (from);
1846 if (to > ZV)
1848 to = ZV;
1849 to_byte = ZV_BYTE;
1851 else if (old_to == Z - to)
1852 to_byte = CHAR_TO_BYTE (to);
1855 del_range_2 (from, from_byte, to, to_byte, 0);
1856 signal_after_change (from, to - from, 0);
1857 update_compositions (from, from, CHECK_HEAD);
1860 /* Delete a range of text, specified both as character positions
1861 and byte positions. FROM and TO are character positions,
1862 while FROM_BYTE and TO_BYTE are byte positions.
1863 If RET_STRING is true, the deleted area is returned as a string. */
1865 Lisp_Object
1866 del_range_2 (EMACS_INT from, EMACS_INT from_byte,
1867 EMACS_INT to, EMACS_INT to_byte, int ret_string)
1869 register EMACS_INT nbytes_del, nchars_del;
1870 Lisp_Object deletion;
1872 CHECK_MARKERS ();
1874 nchars_del = to - from;
1875 nbytes_del = to_byte - from_byte;
1877 /* Make sure the gap is somewhere in or next to what we are deleting. */
1878 if (from > GPT)
1879 gap_right (from, from_byte);
1880 if (to < GPT)
1881 gap_left (to, to_byte, 0);
1883 #ifdef BYTE_COMBINING_DEBUG
1884 if (count_combining_before (BUF_BYTE_ADDRESS (current_buffer, to_byte),
1885 Z_BYTE - to_byte, from, from_byte))
1886 abort ();
1887 #endif
1889 if (ret_string || ! EQ (BVAR (current_buffer, undo_list), Qt))
1890 deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1);
1891 else
1892 deletion = Qnil;
1894 /* Relocate all markers pointing into the new, larger gap
1895 to point at the end of the text before the gap.
1896 Do this before recording the deletion,
1897 so that undo handles this after reinserting the text. */
1898 adjust_markers_for_delete (from, from_byte, to, to_byte);
1900 if (! EQ (BVAR (current_buffer, undo_list), Qt))
1901 record_delete (from, deletion);
1902 MODIFF++;
1903 CHARS_MODIFF = MODIFF;
1905 /* Relocate point as if it were a marker. */
1906 if (from < PT)
1907 adjust_point (from - (PT < to ? PT : to),
1908 from_byte - (PT_BYTE < to_byte ? PT_BYTE : to_byte));
1910 offset_intervals (current_buffer, from, - nchars_del);
1912 /* Adjust the overlay center as needed. This must be done after
1913 adjusting the markers that bound the overlays. */
1914 adjust_overlays_for_delete (from, nchars_del);
1916 GAP_SIZE += nbytes_del;
1917 ZV_BYTE -= nbytes_del;
1918 Z_BYTE -= nbytes_del;
1919 ZV -= nchars_del;
1920 Z -= nchars_del;
1921 GPT = from;
1922 GPT_BYTE = from_byte;
1923 if (GAP_SIZE > 0 && !current_buffer->text->inhibit_shrinking)
1924 /* Put an anchor, unless called from decode_coding_object which
1925 needs to access the previous gap contents. */
1926 *(GPT_ADDR) = 0;
1928 if (GPT_BYTE < GPT)
1929 abort ();
1931 if (GPT - BEG < BEG_UNCHANGED)
1932 BEG_UNCHANGED = GPT - BEG;
1933 if (Z - GPT < END_UNCHANGED)
1934 END_UNCHANGED = Z - GPT;
1936 CHECK_MARKERS ();
1938 evaporate_overlays (from);
1940 return deletion;
1943 /* Call this if you're about to change the region of BUFFER from
1944 character positions START to END. This checks the read-only
1945 properties of the region, calls the necessary modification hooks,
1946 and warns the next redisplay that it should pay attention to that
1947 area.
1949 If PRESERVE_CHARS_MODIFF is non-zero, do not update CHARS_MODIFF.
1950 Otherwise set CHARS_MODIFF to the new value of MODIFF. */
1952 void
1953 modify_region (struct buffer *buffer, EMACS_INT start, EMACS_INT end,
1954 int preserve_chars_modiff)
1956 struct buffer *old_buffer = current_buffer;
1958 if (buffer != old_buffer)
1959 set_buffer_internal (buffer);
1961 prepare_to_modify_buffer (start, end, NULL);
1963 BUF_COMPUTE_UNCHANGED (buffer, start - 1, end);
1965 if (MODIFF <= SAVE_MODIFF)
1966 record_first_change ();
1967 MODIFF++;
1968 if (! preserve_chars_modiff)
1969 CHARS_MODIFF = MODIFF;
1971 BVAR (buffer, point_before_scroll) = Qnil;
1973 if (buffer != old_buffer)
1974 set_buffer_internal (old_buffer);
1977 /* Check that it is okay to modify the buffer between START and END,
1978 which are char positions.
1980 Run the before-change-function, if any. If intervals are in use,
1981 verify that the text to be modified is not read-only, and call
1982 any modification properties the text may have.
1984 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1985 by holding its value temporarily in a marker. */
1987 void
1988 prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end,
1989 EMACS_INT *preserve_ptr)
1991 struct buffer *base_buffer;
1993 if (!NILP (BVAR (current_buffer, read_only)))
1994 Fbarf_if_buffer_read_only ();
1996 /* Let redisplay consider other windows than selected_window
1997 if modifying another buffer. */
1998 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1999 ++windows_or_buffers_changed;
2001 if (BUF_INTERVALS (current_buffer) != 0)
2003 if (preserve_ptr)
2005 Lisp_Object preserve_marker;
2006 struct gcpro gcpro1;
2007 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil);
2008 GCPRO1 (preserve_marker);
2009 verify_interval_modification (current_buffer, start, end);
2010 *preserve_ptr = marker_position (preserve_marker);
2011 unchain_marker (XMARKER (preserve_marker));
2012 UNGCPRO;
2014 else
2015 verify_interval_modification (current_buffer, start, end);
2018 /* For indirect buffers, use the base buffer to check clashes. */
2019 if (current_buffer->base_buffer != 0)
2020 base_buffer = current_buffer->base_buffer;
2021 else
2022 base_buffer = current_buffer;
2024 #ifdef CLASH_DETECTION
2025 if (!NILP (BVAR (base_buffer, file_truename))
2026 /* Make binding buffer-file-name to nil effective. */
2027 && !NILP (BVAR (base_buffer, filename))
2028 && SAVE_MODIFF >= MODIFF)
2029 lock_file (BVAR (base_buffer, file_truename));
2030 #else
2031 /* At least warn if this file has changed on disk since it was visited. */
2032 if (!NILP (BVAR (base_buffer, filename))
2033 && SAVE_MODIFF >= MODIFF
2034 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
2035 && !NILP (Ffile_exists_p (BVAR (base_buffer, filename))))
2036 call1 (intern ("ask-user-about-supersession-threat"),
2037 BVAR (base_buffer,filename));
2038 #endif /* not CLASH_DETECTION */
2040 /* If `select-active-regions' is non-nil, save the region text. */
2041 if (!NILP (BVAR (current_buffer, mark_active))
2042 && !inhibit_modification_hooks
2043 && XMARKER (BVAR (current_buffer, mark))->buffer
2044 && NILP (Vsaved_region_selection)
2045 && (EQ (Vselect_active_regions, Qonly)
2046 ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
2047 : (!NILP (Vselect_active_regions)
2048 && !NILP (Vtransient_mark_mode))))
2050 EMACS_INT b = XMARKER (BVAR (current_buffer, mark))->charpos;
2051 EMACS_INT e = PT;
2052 if (b < e)
2053 Vsaved_region_selection = make_buffer_string (b, e, 0);
2054 else if (b > e)
2055 Vsaved_region_selection = make_buffer_string (e, b, 0);
2058 signal_before_change (start, end, preserve_ptr);
2060 if (current_buffer->newline_cache)
2061 invalidate_region_cache (current_buffer,
2062 current_buffer->newline_cache,
2063 start - BEG, Z - end);
2064 if (current_buffer->width_run_cache)
2065 invalidate_region_cache (current_buffer,
2066 current_buffer->width_run_cache,
2067 start - BEG, Z - end);
2069 Vdeactivate_mark = Qt;
2072 /* These macros work with an argument named `preserve_ptr'
2073 and a local variable named `preserve_marker'. */
2075 #define PRESERVE_VALUE \
2076 if (preserve_ptr && NILP (preserve_marker)) \
2077 preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil)
2079 #define RESTORE_VALUE \
2080 if (! NILP (preserve_marker)) \
2082 *preserve_ptr = marker_position (preserve_marker); \
2083 unchain_marker (XMARKER (preserve_marker)); \
2086 #define PRESERVE_START_END \
2087 if (NILP (start_marker)) \
2088 start_marker = Fcopy_marker (start, Qnil); \
2089 if (NILP (end_marker)) \
2090 end_marker = Fcopy_marker (end, Qnil);
2092 #define FETCH_START \
2093 (! NILP (start_marker) ? Fmarker_position (start_marker) : start)
2095 #define FETCH_END \
2096 (! NILP (end_marker) ? Fmarker_position (end_marker) : end)
2098 /* Set a variable to nil if an error occurred.
2099 Don't change the variable if there was no error.
2100 VAL is a cons-cell (VARIABLE . NO-ERROR-FLAG).
2101 VARIABLE is the variable to maybe set to nil.
2102 NO-ERROR-FLAG is nil if there was an error,
2103 anything else meaning no error (so this function does nothing). */
2104 Lisp_Object
2105 reset_var_on_error (Lisp_Object val)
2107 if (NILP (XCDR (val)))
2108 Fset (XCAR (val), Qnil);
2109 return Qnil;
2112 /* Signal a change to the buffer immediately before it happens.
2113 START_INT and END_INT are the bounds of the text to be changed.
2115 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
2116 by holding its value temporarily in a marker. */
2118 void
2119 signal_before_change (EMACS_INT start_int, EMACS_INT end_int,
2120 EMACS_INT *preserve_ptr)
2122 Lisp_Object start, end;
2123 Lisp_Object start_marker, end_marker;
2124 Lisp_Object preserve_marker;
2125 struct gcpro gcpro1, gcpro2, gcpro3;
2126 int count = SPECPDL_INDEX ();
2128 if (inhibit_modification_hooks)
2129 return;
2131 start = make_number (start_int);
2132 end = make_number (end_int);
2133 preserve_marker = Qnil;
2134 start_marker = Qnil;
2135 end_marker = Qnil;
2136 GCPRO3 (preserve_marker, start_marker, end_marker);
2138 specbind (Qinhibit_modification_hooks, Qt);
2140 /* If buffer is unmodified, run a special hook for that case. */
2141 if (SAVE_MODIFF >= MODIFF
2142 && !NILP (Vfirst_change_hook)
2143 && !NILP (Vrun_hooks))
2145 PRESERVE_VALUE;
2146 PRESERVE_START_END;
2147 call1 (Vrun_hooks, Qfirst_change_hook);
2150 /* Now run the before-change-functions if any. */
2151 if (!NILP (Vbefore_change_functions))
2153 Lisp_Object args[3];
2154 Lisp_Object rvoe_arg = Fcons (Qbefore_change_functions, Qnil);
2156 PRESERVE_VALUE;
2157 PRESERVE_START_END;
2159 /* Mark before-change-functions to be reset to nil in case of error. */
2160 record_unwind_protect (reset_var_on_error, rvoe_arg);
2162 /* Actually run the hook functions. */
2163 args[0] = Qbefore_change_functions;
2164 args[1] = FETCH_START;
2165 args[2] = FETCH_END;
2166 Frun_hook_with_args (3, args);
2168 /* There was no error: unarm the reset_on_error. */
2169 XSETCDR (rvoe_arg, Qt);
2172 if (current_buffer->overlays_before || current_buffer->overlays_after)
2174 PRESERVE_VALUE;
2175 report_overlay_modification (FETCH_START, FETCH_END, 0,
2176 FETCH_START, FETCH_END, Qnil);
2179 if (! NILP (start_marker))
2180 free_marker (start_marker);
2181 if (! NILP (end_marker))
2182 free_marker (end_marker);
2183 RESTORE_VALUE;
2184 UNGCPRO;
2186 unbind_to (count, Qnil);
2189 /* Signal a change immediately after it happens.
2190 CHARPOS is the character position of the start of the changed text.
2191 LENDEL is the number of characters of the text before the change.
2192 (Not the whole buffer; just the part that was changed.)
2193 LENINS is the number of characters in that part of the text
2194 after the change. */
2196 void
2197 signal_after_change (EMACS_INT charpos, EMACS_INT lendel, EMACS_INT lenins)
2199 int count = SPECPDL_INDEX ();
2200 if (inhibit_modification_hooks)
2201 return;
2203 /* If we are deferring calls to the after-change functions
2204 and there are no before-change functions,
2205 just record the args that we were going to use. */
2206 if (! NILP (Vcombine_after_change_calls)
2207 && NILP (Vbefore_change_functions)
2208 && !current_buffer->overlays_before
2209 && !current_buffer->overlays_after)
2211 Lisp_Object elt;
2213 if (!NILP (combine_after_change_list)
2214 && current_buffer != XBUFFER (combine_after_change_buffer))
2215 Fcombine_after_change_execute ();
2217 elt = Fcons (make_number (charpos - BEG),
2218 Fcons (make_number (Z - (charpos - lendel + lenins)),
2219 Fcons (make_number (lenins - lendel), Qnil)));
2220 combine_after_change_list
2221 = Fcons (elt, combine_after_change_list);
2222 combine_after_change_buffer = Fcurrent_buffer ();
2224 return;
2227 if (!NILP (combine_after_change_list))
2228 Fcombine_after_change_execute ();
2230 specbind (Qinhibit_modification_hooks, Qt);
2232 if (!NILP (Vafter_change_functions))
2234 Lisp_Object args[4];
2235 Lisp_Object rvoe_arg = Fcons (Qafter_change_functions, Qnil);
2237 /* Mark after-change-functions to be reset to nil in case of error. */
2238 record_unwind_protect (reset_var_on_error, rvoe_arg);
2240 /* Actually run the hook functions. */
2241 args[0] = Qafter_change_functions;
2242 XSETFASTINT (args[1], charpos);
2243 XSETFASTINT (args[2], charpos + lenins);
2244 XSETFASTINT (args[3], lendel);
2245 Frun_hook_with_args (4, args);
2247 /* There was no error: unarm the reset_on_error. */
2248 XSETCDR (rvoe_arg, Qt);
2251 if (current_buffer->overlays_before || current_buffer->overlays_after)
2252 report_overlay_modification (make_number (charpos),
2253 make_number (charpos + lenins),
2255 make_number (charpos),
2256 make_number (charpos + lenins),
2257 make_number (lendel));
2259 /* After an insertion, call the text properties
2260 insert-behind-hooks or insert-in-front-hooks. */
2261 if (lendel == 0)
2262 report_interval_modification (make_number (charpos),
2263 make_number (charpos + lenins));
2265 unbind_to (count, Qnil);
2268 Lisp_Object
2269 Fcombine_after_change_execute_1 (Lisp_Object val)
2271 Vcombine_after_change_calls = val;
2272 return val;
2275 DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,
2276 Scombine_after_change_execute, 0, 0, 0,
2277 doc: /* This function is for use internally in `combine-after-change-calls'. */)
2278 (void)
2280 int count = SPECPDL_INDEX ();
2281 EMACS_INT beg, end, change;
2282 EMACS_INT begpos, endpos;
2283 Lisp_Object tail;
2285 if (NILP (combine_after_change_list))
2286 return Qnil;
2288 /* It is rare for combine_after_change_buffer to be invalid, but
2289 possible. It can happen when combine-after-change-calls is
2290 non-nil, and insertion calls a file handler (e.g. through
2291 lock_file) which scribbles into a temp file -- cyd */
2292 if (!BUFFERP (combine_after_change_buffer)
2293 || NILP (BVAR (XBUFFER (combine_after_change_buffer), name)))
2295 combine_after_change_list = Qnil;
2296 return Qnil;
2299 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
2301 Fset_buffer (combine_after_change_buffer);
2303 /* # chars unchanged at beginning of buffer. */
2304 beg = Z - BEG;
2305 /* # chars unchanged at end of buffer. */
2306 end = beg;
2307 /* Total amount of insertion (negative for deletion). */
2308 change = 0;
2310 /* Scan the various individual changes,
2311 accumulating the range info in BEG, END and CHANGE. */
2312 for (tail = combine_after_change_list; CONSP (tail);
2313 tail = XCDR (tail))
2315 Lisp_Object elt;
2316 EMACS_INT thisbeg, thisend, thischange;
2318 /* Extract the info from the next element. */
2319 elt = XCAR (tail);
2320 if (! CONSP (elt))
2321 continue;
2322 thisbeg = XINT (XCAR (elt));
2324 elt = XCDR (elt);
2325 if (! CONSP (elt))
2326 continue;
2327 thisend = XINT (XCAR (elt));
2329 elt = XCDR (elt);
2330 if (! CONSP (elt))
2331 continue;
2332 thischange = XINT (XCAR (elt));
2334 /* Merge this range into the accumulated range. */
2335 change += thischange;
2336 if (thisbeg < beg)
2337 beg = thisbeg;
2338 if (thisend < end)
2339 end = thisend;
2342 /* Get the current start and end positions of the range
2343 that was changed. */
2344 begpos = BEG + beg;
2345 endpos = Z - end;
2347 /* We are about to handle these, so discard them. */
2348 combine_after_change_list = Qnil;
2350 /* Now run the after-change functions for real.
2351 Turn off the flag that defers them. */
2352 record_unwind_protect (Fcombine_after_change_execute_1,
2353 Vcombine_after_change_calls);
2354 signal_after_change (begpos, endpos - begpos - change, endpos - begpos);
2355 update_compositions (begpos, endpos, CHECK_ALL);
2357 return unbind_to (count, Qnil);
2360 void
2361 syms_of_insdel (void)
2363 staticpro (&combine_after_change_list);
2364 staticpro (&combine_after_change_buffer);
2365 combine_after_change_list = Qnil;
2366 combine_after_change_buffer = Qnil;
2368 DEFVAR_BOOL ("check-markers-debug-flag", check_markers_debug_flag,
2369 doc: /* Non-nil means enable debugging checks for invalid marker positions. */);
2370 check_markers_debug_flag = 0;
2371 DEFVAR_LISP ("combine-after-change-calls", Vcombine_after_change_calls,
2372 doc: /* Used internally by the `combine-after-change-calls' macro. */);
2373 Vcombine_after_change_calls = Qnil;
2375 DEFVAR_BOOL ("inhibit-modification-hooks", inhibit_modification_hooks,
2376 doc: /* Non-nil means don't run any of the hooks that respond to buffer changes.
2377 This affects `before-change-functions' and `after-change-functions',
2378 as well as hooks attached to text properties and overlays. */);
2379 inhibit_modification_hooks = 0;
2380 Qinhibit_modification_hooks = intern_c_string ("inhibit-modification-hooks");
2381 staticpro (&Qinhibit_modification_hooks);
2383 defsubr (&Scombine_after_change_execute);