(prepare_to_modify_buffer): Set Vdeactivate_mark.
[bpt/emacs.git] / src / insdel.c
1 /* Buffer insertion/deletion and gap motion for GNU Emacs.
2 Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21 #include "config.h"
22 #include "lisp.h"
23 #include "intervals.h"
24 #include "buffer.h"
25 #include "window.h"
26
27 /* Move gap to position `pos'.
28 Note that this can quit! */
29
30 move_gap (pos)
31 int pos;
32 {
33 if (pos < GPT)
34 gap_left (pos, 0);
35 else if (pos > GPT)
36 gap_right (pos);
37 }
38
39 /* Move the gap to POS, which is less than the current GPT.
40 If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
41
42 gap_left (pos, newgap)
43 register int pos;
44 int newgap;
45 {
46 register unsigned char *to, *from;
47 register int i;
48 int new_s1;
49
50 pos--;
51
52 if (!newgap)
53 {
54 if (unchanged_modified == MODIFF)
55 {
56 beg_unchanged = pos;
57 end_unchanged = Z - pos - 1;
58 }
59 else
60 {
61 if (Z - GPT < end_unchanged)
62 end_unchanged = Z - GPT;
63 if (pos < beg_unchanged)
64 beg_unchanged = pos;
65 }
66 }
67
68 i = GPT;
69 to = GAP_END_ADDR;
70 from = GPT_ADDR;
71 new_s1 = GPT - BEG;
72
73 /* Now copy the characters. To move the gap down,
74 copy characters up. */
75
76 while (1)
77 {
78 /* I gets number of characters left to copy. */
79 i = new_s1 - pos;
80 if (i == 0)
81 break;
82 /* If a quit is requested, stop copying now.
83 Change POS to be where we have actually moved the gap to. */
84 if (QUITP)
85 {
86 pos = new_s1;
87 break;
88 }
89 /* Move at most 32000 chars before checking again for a quit. */
90 if (i > 32000)
91 i = 32000;
92 #ifdef GAP_USE_BCOPY
93 if (i >= 128
94 /* bcopy is safe if the two areas of memory do not overlap
95 or on systems where bcopy is always safe for moving upward. */
96 && (BCOPY_UPWARD_SAFE
97 || to - from >= 128))
98 {
99 /* If overlap is not safe, avoid it by not moving too many
100 characters at once. */
101 if (!BCOPY_UPWARD_SAFE && i > to - from)
102 i = to - from;
103 new_s1 -= i;
104 from -= i, to -= i;
105 bcopy (from, to, i);
106 }
107 else
108 #endif
109 {
110 new_s1 -= i;
111 while (--i >= 0)
112 *--to = *--from;
113 }
114 }
115
116 /* Adjust markers, and buffer data structure, to put the gap at POS.
117 POS is where the loop above stopped, which may be what was specified
118 or may be where a quit was detected. */
119 adjust_markers (pos + 1, GPT, GAP_SIZE);
120 GPT = pos + 1;
121 QUIT;
122 }
123
124 gap_right (pos)
125 register int pos;
126 {
127 register unsigned char *to, *from;
128 register int i;
129 int new_s1;
130
131 pos--;
132
133 if (unchanged_modified == MODIFF)
134 {
135 beg_unchanged = pos;
136 end_unchanged = Z - pos - 1;
137 }
138 else
139 {
140 if (Z - pos - 1 < end_unchanged)
141 end_unchanged = Z - pos - 1;
142 if (GPT - BEG < beg_unchanged)
143 beg_unchanged = GPT - BEG;
144 }
145
146 i = GPT;
147 from = GAP_END_ADDR;
148 to = GPT_ADDR;
149 new_s1 = GPT - 1;
150
151 /* Now copy the characters. To move the gap up,
152 copy characters down. */
153
154 while (1)
155 {
156 /* I gets number of characters left to copy. */
157 i = pos - new_s1;
158 if (i == 0)
159 break;
160 /* If a quit is requested, stop copying now.
161 Change POS to be where we have actually moved the gap to. */
162 if (QUITP)
163 {
164 pos = new_s1;
165 break;
166 }
167 /* Move at most 32000 chars before checking again for a quit. */
168 if (i > 32000)
169 i = 32000;
170 #ifdef GAP_USE_BCOPY
171 if (i >= 128
172 /* bcopy is safe if the two areas of memory do not overlap
173 or on systems where bcopy is always safe for moving downward. */
174 && (BCOPY_DOWNWARD_SAFE
175 || from - to >= 128))
176 {
177 /* If overlap is not safe, avoid it by not moving too many
178 characters at once. */
179 if (!BCOPY_DOWNWARD_SAFE && i > from - to)
180 i = from - to;
181 new_s1 += i;
182 bcopy (from, to, i);
183 from += i, to += i;
184 }
185 else
186 #endif
187 {
188 new_s1 += i;
189 while (--i >= 0)
190 *to++ = *from++;
191 }
192 }
193
194 adjust_markers (GPT + GAP_SIZE, pos + 1 + GAP_SIZE, - GAP_SIZE);
195 GPT = pos + 1;
196 QUIT;
197 }
198
199 /* Add `amount' to the position of every marker in the current buffer
200 whose current position is between `from' (exclusive) and `to' (inclusive).
201 Also, any markers past the outside of that interval, in the direction
202 of adjustment, are first moved back to the near end of the interval
203 and then adjusted by `amount'. */
204
205 adjust_markers (from, to, amount)
206 register int from, to, amount;
207 {
208 Lisp_Object marker;
209 register struct Lisp_Marker *m;
210 register int mpos;
211
212 marker = current_buffer->markers;
213
214 while (!NILP (marker))
215 {
216 m = XMARKER (marker);
217 mpos = m->bufpos;
218 if (amount > 0)
219 {
220 if (mpos > to && mpos < to + amount)
221 mpos = to + amount;
222 }
223 else
224 {
225 if (mpos > from + amount && mpos <= from)
226 mpos = from + amount;
227 }
228 if (mpos > from && mpos <= to)
229 mpos += amount;
230 m->bufpos = mpos;
231 marker = m->chain;
232 }
233 }
234 \f
235 /* Make the gap INCREMENT characters longer. */
236
237 make_gap (increment)
238 int increment;
239 {
240 unsigned char *result;
241 Lisp_Object tem;
242 int real_gap_loc;
243 int old_gap_size;
244
245 /* If we have to get more space, get enough to last a while. */
246 increment += 2000;
247
248 result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment));
249 if (result == 0)
250 memory_full ();
251 BEG_ADDR = result;
252
253 /* Prevent quitting in move_gap. */
254 tem = Vinhibit_quit;
255 Vinhibit_quit = Qt;
256
257 real_gap_loc = GPT;
258 old_gap_size = GAP_SIZE;
259
260 /* Call the newly allocated space a gap at the end of the whole space. */
261 GPT = Z + GAP_SIZE;
262 GAP_SIZE = increment;
263
264 /* Move the new gap down to be consecutive with the end of the old one.
265 This adjusts the markers properly too. */
266 gap_left (real_gap_loc + old_gap_size, 1);
267
268 /* Now combine the two into one large gap. */
269 GAP_SIZE += old_gap_size;
270 GPT = real_gap_loc;
271
272 Vinhibit_quit = tem;
273 }
274 \f
275 /* Insert a string of specified length before point.
276 DO NOT use this for the contents of a Lisp string!
277 prepare_to_modify_buffer could relocate the string. */
278
279 insert (string, length)
280 register unsigned char *string;
281 register length;
282 {
283 register Lisp_Object temp;
284
285 if (length < 1)
286 return;
287
288 /* Make sure point-max won't overflow after this insertion. */
289 XSET (temp, Lisp_Int, length + Z);
290 if (length + Z != XINT (temp))
291 error ("maximum buffer size exceeded");
292
293 prepare_to_modify_buffer (point, point);
294
295 if (point != GPT)
296 move_gap (point);
297 if (GAP_SIZE < length)
298 make_gap (length - GAP_SIZE);
299
300 record_insert (point, length);
301 MODIFF++;
302
303 bcopy (string, GPT_ADDR, length);
304
305 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
306 offset_intervals (current_buffer, point, length);
307
308 GAP_SIZE -= length;
309 GPT += length;
310 ZV += length;
311 Z += length;
312 SET_PT (point + length);
313
314 signal_after_change (point-length, 0, length);
315 }
316
317 /* Insert the part of the text of STRING, a Lisp object assumed to be
318 of type string, consisting of the LENGTH characters starting at
319 position POS. If the text of STRING has properties, they are absorbed
320 into the buffer.
321
322 It does not work to use `insert' for this, because a GC could happen
323 before we bcopy the stuff into the buffer, and relocate the string
324 without insert noticing. */
325
326 insert_from_string (string, pos, length)
327 Lisp_Object string;
328 register int pos, length;
329 {
330 register Lisp_Object temp;
331 struct gcpro gcpro1;
332
333 if (length < 1)
334 return;
335
336 /* Make sure point-max won't overflow after this insertion. */
337 XSET (temp, Lisp_Int, length + Z);
338 if (length + Z != XINT (temp))
339 error ("maximum buffer size exceeded");
340
341 GCPRO1 (string);
342 prepare_to_modify_buffer (point, point);
343
344 if (point != GPT)
345 move_gap (point);
346 if (GAP_SIZE < length)
347 make_gap (length - GAP_SIZE);
348
349 record_insert (point, length);
350 MODIFF++;
351 UNGCPRO;
352
353 bcopy (XSTRING (string)->data, GPT_ADDR, length);
354
355 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
356 offset_intervals (current_buffer, point, length);
357
358 GAP_SIZE -= length;
359 GPT += length;
360 ZV += length;
361 Z += length;
362
363 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
364 graft_intervals_into_buffer (XSTRING (string)->intervals, point,
365 current_buffer);
366
367 SET_PT (point + length);
368
369 signal_after_change (point-length, 0, length);
370 }
371
372 /* Insert the character C before point */
373
374 void
375 insert_char (c)
376 unsigned char c;
377 {
378 insert (&c, 1);
379 }
380
381 /* Insert the null-terminated string S before point */
382
383 void
384 insert_string (s)
385 char *s;
386 {
387 insert (s, strlen (s));
388 }
389
390 /* Like `insert' except that all markers pointing at the place where
391 the insertion happens are adjusted to point after it.
392 Don't use this function to insert part of a Lisp string,
393 since gc could happen and relocate it. */
394
395 insert_before_markers (string, length)
396 unsigned char *string;
397 register int length;
398 {
399 register int opoint = point;
400 insert (string, length);
401 adjust_markers (opoint - 1, opoint, length);
402 }
403
404 /* Insert part of a Lisp string, relocating markers after. */
405
406 insert_from_string_before_markers (string, pos, length)
407 Lisp_Object string;
408 register int pos, length;
409 {
410 register int opoint = point;
411 insert_from_string (string, pos, length);
412 adjust_markers (opoint - 1, opoint, length);
413 }
414 \f
415 /* Delete characters in current buffer
416 from FROM up to (but not including) TO. */
417
418 del_range (from, to)
419 register int from, to;
420 {
421 register int numdel;
422
423 /* Make args be valid */
424 if (from < BEGV)
425 from = BEGV;
426 if (to > ZV)
427 to = ZV;
428
429 if ((numdel = to - from) <= 0)
430 return;
431
432 /* Make sure the gap is somewhere in or next to what we are deleting. */
433 if (from > GPT)
434 gap_right (from);
435 if (to < GPT)
436 gap_left (to, 0);
437
438 prepare_to_modify_buffer (from, to);
439
440 record_delete (from, numdel);
441 MODIFF++;
442
443 /* Relocate point as if it were a marker. */
444 if (from < point)
445 {
446 if (point < to)
447 SET_PT (from);
448 else
449 SET_PT (point - numdel);
450 }
451
452 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
453 offset_intervals (current_buffer, point, - numdel);
454
455 /* Relocate all markers pointing into the new, larger gap
456 to point at the end of the text before the gap. */
457 adjust_markers (to + GAP_SIZE, to + GAP_SIZE, - numdel - GAP_SIZE);
458
459 GAP_SIZE += numdel;
460 ZV -= numdel;
461 Z -= numdel;
462 GPT = from;
463
464 if (GPT - BEG < beg_unchanged)
465 beg_unchanged = GPT - BEG;
466 if (Z - GPT < end_unchanged)
467 end_unchanged = Z - GPT;
468
469 signal_after_change (from, numdel, 0);
470 }
471 \f
472 modify_region (start, end)
473 int start, end;
474 {
475 prepare_to_modify_buffer (start, end);
476
477 if (start - 1 < beg_unchanged || unchanged_modified == MODIFF)
478 beg_unchanged = start - 1;
479 if (Z - end < end_unchanged
480 || unchanged_modified == MODIFF)
481 end_unchanged = Z - end;
482 MODIFF++;
483 }
484
485 /* Check that it is okay to modify the buffer between START and END.
486 Run the before-change-function, if any. If intervals are in use,
487 verify that the text to be modified is not read-only, and call
488 any modification properties the text may have. */
489
490 prepare_to_modify_buffer (start, end)
491 Lisp_Object start, end;
492 {
493 if (!NILP (current_buffer->read_only))
494 Fbarf_if_buffer_read_only ();
495
496 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
497 verify_interval_modification (current_buffer, start, end);
498
499 #ifdef CLASH_DETECTION
500 if (!NILP (current_buffer->filename)
501 && current_buffer->save_modified >= MODIFF)
502 lock_file (current_buffer->filename);
503 #else
504 /* At least warn if this file has changed on disk since it was visited. */
505 if (!NILP (current_buffer->filename)
506 && current_buffer->save_modified >= MODIFF
507 && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ()))
508 && !NILP (Ffile_exists_p (current_buffer->filename)))
509 call1 (intern ("ask-user-about-supersession-threat"),
510 current_buffer->filename);
511 #endif /* not CLASH_DETECTION */
512
513 signal_before_change (start, end);
514
515 Vdeactivate_mark = Qt;
516 }
517 \f
518 static Lisp_Object
519 before_change_function_restore (value)
520 Lisp_Object value;
521 {
522 Vbefore_change_function = value;
523 }
524
525 static Lisp_Object
526 after_change_function_restore (value)
527 Lisp_Object value;
528 {
529 Vafter_change_function = value;
530 }
531
532 /* Signal a change to the buffer immediatly before it happens.
533 START and END are the bounds of the text to be changed,
534 as Lisp objects. */
535
536 signal_before_change (start, end)
537 Lisp_Object start, end;
538 {
539 /* If buffer is unmodified, run a special hook for that case. */
540 if (current_buffer->save_modified >= MODIFF
541 && !NILP (Vfirst_change_hook)
542 && !NILP (Vrun_hooks))
543 call1 (Vrun_hooks, Qfirst_change_hook);
544
545 /* Now in any case run the before-change-function if any. */
546 if (!NILP (Vbefore_change_function))
547 {
548 int count = specpdl_ptr - specpdl;
549 Lisp_Object function;
550
551 function = Vbefore_change_function;
552 record_unwind_protect (after_change_function_restore,
553 Vafter_change_function);
554 record_unwind_protect (before_change_function_restore,
555 Vbefore_change_function);
556 Vafter_change_function = Qnil;
557 Vbefore_change_function = Qnil;
558
559 call2 (function, start, end);
560 unbind_to (count, Qnil);
561 }
562 }
563
564 /* Signal a change immediatly after it happens.
565 POS is the address of the start of the changed text.
566 LENDEL is the number of characters of the text before the change.
567 (Not the whole buffer; just the part that was changed.)
568 LENINS is the number of characters in the changed text. */
569
570 signal_after_change (pos, lendel, lenins)
571 int pos, lendel, lenins;
572 {
573 if (!NILP (Vafter_change_function))
574 {
575 int count = specpdl_ptr - specpdl;
576 Lisp_Object function;
577 function = Vafter_change_function;
578
579 record_unwind_protect (after_change_function_restore,
580 Vafter_change_function);
581 record_unwind_protect (before_change_function_restore,
582 Vbefore_change_function);
583 Vafter_change_function = Qnil;
584 Vbefore_change_function = Qnil;
585
586 call3 (function, make_number (pos), make_number (pos + lenins),
587 make_number (lendel));
588 unbind_to (count, Qnil);
589 }
590 }