(Fprimitive_undo): Bind inhibit-read-only to t if
[bpt/emacs.git] / src / undo.c
CommitLineData
c6953be1 1/* undo handling for GNU Emacs.
3a22ee35 2 Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
c6953be1
JB
3
4This file is part of GNU Emacs.
5
3b7ad313
EN
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
c6953be1 11GNU Emacs is distributed in the hope that it will be useful,
3b7ad313
EN
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
c6953be1
JB
20
21
18160b98 22#include <config.h>
c6953be1
JB
23#include "lisp.h"
24#include "buffer.h"
4e665715 25#include "commands.h"
c6953be1
JB
26
27/* Last buffer for which undo information was recorded. */
28Lisp_Object last_undo_buffer;
29
f87a68b3
RS
30Lisp_Object Qinhibit_read_only;
31
c58632fc
RS
32/* The first time a command records something for undo.
33 it also allocates the undo-boundary object
34 which will be added to the list at the end of the command.
35 This ensures we can't run out of space while trying to make
36 an undo-boundary. */
37Lisp_Object pending_boundary;
38
c6953be1
JB
39/* Record an insertion that just happened or is about to happen,
40 for LENGTH characters at position BEG.
41 (It is possible to record an insertion before or after the fact
42 because we don't need to record the contents.) */
43
90dd3e4f 44void
c6953be1 45record_insert (beg, length)
53480e99 46 int beg, length;
c6953be1
JB
47{
48 Lisp_Object lbeg, lend;
49
bdbe6f28
RS
50 if (EQ (current_buffer->undo_list, Qt))
51 return;
52
c58632fc
RS
53 /* Allocate a cons cell to be the undo boundary after this command. */
54 if (NILP (pending_boundary))
55 pending_boundary = Fcons (Qnil, Qnil);
56
8801a864
KR
57 if (!BUFFERP (last_undo_buffer)
58 || current_buffer != XBUFFER (last_undo_buffer))
c6953be1 59 Fundo_boundary ();
552bdbcf 60 XSETBUFFER (last_undo_buffer, current_buffer);
c6953be1 61
ad9cdce4 62 if (MODIFF <= SAVE_MODIFF)
c6953be1
JB
63 record_first_change ();
64
65 /* If this is following another insertion and consecutive with it
66 in the buffer, combine the two. */
38c0d37c 67 if (CONSP (current_buffer->undo_list))
c6953be1
JB
68 {
69 Lisp_Object elt;
c1d497be 70 elt = XCAR (current_buffer->undo_list);
38c0d37c 71 if (CONSP (elt)
c1d497be
KR
72 && INTEGERP (XCAR (elt))
73 && INTEGERP (XCDR (elt))
74 && XINT (XCDR (elt)) == beg)
c6953be1 75 {
c1d497be 76 XSETINT (XCDR (elt), beg + length);
c6953be1
JB
77 return;
78 }
79 }
80
53480e99
KH
81 XSETFASTINT (lbeg, beg);
82 XSETINT (lend, beg + length);
213861c7
JB
83 current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
84 current_buffer->undo_list);
c6953be1
JB
85}
86
87/* Record that a deletion is about to take place,
e928d437 88 of the characters in STRING, at location BEG. */
c6953be1 89
ff1aa840 90void
e928d437
RS
91record_delete (beg, string)
92 int beg;
93 Lisp_Object string;
c6953be1 94{
e928d437 95 Lisp_Object sbeg;
e7a8b791 96 int at_boundary;
c6953be1 97
bdbe6f28
RS
98 if (EQ (current_buffer->undo_list, Qt))
99 return;
100
c58632fc
RS
101 /* Allocate a cons cell to be the undo boundary after this command. */
102 if (NILP (pending_boundary))
103 pending_boundary = Fcons (Qnil, Qnil);
104
ae0b9b46
KR
105 if (BUFFERP (last_undo_buffer)
106 && current_buffer != XBUFFER (last_undo_buffer))
c6953be1 107 Fundo_boundary ();
552bdbcf 108 XSETBUFFER (last_undo_buffer, current_buffer);
c6953be1 109
cbc1b668
KH
110 if (CONSP (current_buffer->undo_list))
111 {
112 /* Set AT_BOUNDARY to 1 only when we have nothing other than
113 marker adjustment before undo boundary. */
114
115 Lisp_Object tail = current_buffer->undo_list, elt;
116
117 while (1)
118 {
86a375f8
KR
119 if (NILP (tail))
120 elt = Qnil;
121 else
122 elt = XCAR (tail);
c1d497be 123 if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
cbc1b668 124 break;
c1d497be 125 tail = XCDR (tail);
cbc1b668
KH
126 }
127 at_boundary = NILP (elt);
128 }
129 else
130 at_boundary = 0;
e7a8b791 131
ad9cdce4 132 if (MODIFF <= SAVE_MODIFF)
c6953be1
JB
133 record_first_change ();
134
e928d437 135 if (PT == beg + XSTRING (string)->size)
552bdbcf 136 XSETINT (sbeg, -beg);
c6953be1 137 else
28b2b116 138 XSETFASTINT (sbeg, beg);
350bce56 139
e7a8b791
RS
140 /* If we are just after an undo boundary, and
141 point wasn't at start of deleted range, record where it was. */
142 if (at_boundary
143 && last_point_position != XFASTINT (sbeg)
b347b3fd
KR
144 /* If we're called from batch mode, this could be nil. */
145 && BUFFERP (last_point_position_buffer)
e7a8b791 146 && current_buffer == XBUFFER (last_point_position_buffer))
350bce56 147 current_buffer->undo_list
4e665715 148 = Fcons (make_number (last_point_position), current_buffer->undo_list);
350bce56 149
c6953be1 150 current_buffer->undo_list
e928d437 151 = Fcons (Fcons (string, sbeg), current_buffer->undo_list);
c6953be1
JB
152}
153
714bced9
RS
154/* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
155 This is done only when a marker points within text being deleted,
156 because that's the only case where an automatic marker adjustment
157 won't be inverted automatically by undoing the buffer modification. */
158
ff1aa840 159void
714bced9
RS
160record_marker_adjustment (marker, adjustment)
161 Lisp_Object marker;
162 int adjustment;
163{
164 if (EQ (current_buffer->undo_list, Qt))
165 return;
166
167 /* Allocate a cons cell to be the undo boundary after this command. */
168 if (NILP (pending_boundary))
169 pending_boundary = Fcons (Qnil, Qnil);
170
2f33f38a
GM
171 if (!BUFFERP (last_undo_buffer)
172 || current_buffer != XBUFFER (last_undo_buffer))
714bced9
RS
173 Fundo_boundary ();
174 XSETBUFFER (last_undo_buffer, current_buffer);
175
176 current_buffer->undo_list
177 = Fcons (Fcons (marker, make_number (adjustment)),
178 current_buffer->undo_list);
179}
180
c6953be1
JB
181/* Record that a replacement is about to take place,
182 for LENGTH characters at location BEG.
e928d437 183 The replacement must not change the number of characters. */
c6953be1 184
ff1aa840 185void
c6953be1
JB
186record_change (beg, length)
187 int beg, length;
188{
e928d437 189 record_delete (beg, make_buffer_string (beg, beg + length, 1));
c6953be1
JB
190 record_insert (beg, length);
191}
192\f
193/* Record that an unmodified buffer is about to be changed.
194 Record the file modification date so that when undoing this entry
195 we can tell whether it is obsolete because the file was saved again. */
196
90dd3e4f 197void
c6953be1
JB
198record_first_change ()
199{
200 Lisp_Object high, low;
ad9cdce4 201 struct buffer *base_buffer = current_buffer;
0736cafe
RS
202
203 if (EQ (current_buffer->undo_list, Qt))
204 return;
205
2f33f38a
GM
206 if (!BUFFERP (last_undo_buffer)
207 || current_buffer != XBUFFER (last_undo_buffer))
0736cafe 208 Fundo_boundary ();
552bdbcf 209 XSETBUFFER (last_undo_buffer, current_buffer);
0736cafe 210
ad9cdce4
RS
211 if (base_buffer->base_buffer)
212 base_buffer = base_buffer->base_buffer;
213
214 XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
215 XSETFASTINT (low, base_buffer->modtime & 0xffff);
c6953be1
JB
216 current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
217}
218
da9319d5
RS
219/* Record a change in property PROP (whose old value was VAL)
220 for LENGTH characters starting at position BEG in BUFFER. */
221
90dd3e4f 222void
da9319d5
RS
223record_property_change (beg, length, prop, value, buffer)
224 int beg, length;
225 Lisp_Object prop, value, buffer;
226{
227 Lisp_Object lbeg, lend, entry;
228 struct buffer *obuf = current_buffer;
229 int boundary = 0;
230
0736cafe 231 if (EQ (XBUFFER (buffer)->undo_list, Qt))
bdbe6f28
RS
232 return;
233
c58632fc
RS
234 /* Allocate a cons cell to be the undo boundary after this command. */
235 if (NILP (pending_boundary))
236 pending_boundary = Fcons (Qnil, Qnil);
237
da9319d5
RS
238 if (!EQ (buffer, last_undo_buffer))
239 boundary = 1;
240 last_undo_buffer = buffer;
241
da9319d5
RS
242 /* Switch temporarily to the buffer that was changed. */
243 current_buffer = XBUFFER (buffer);
244
245 if (boundary)
246 Fundo_boundary ();
247
ad9cdce4 248 if (MODIFF <= SAVE_MODIFF)
da9319d5
RS
249 record_first_change ();
250
552bdbcf
KH
251 XSETINT (lbeg, beg);
252 XSETINT (lend, beg + length);
da9319d5
RS
253 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
254 current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
255
256 current_buffer = obuf;
257}
258
c6953be1
JB
259DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
260 "Mark a boundary between units of undo.\n\
261An undo command will stop at this point,\n\
262but another undo command will undo to the previous boundary.")
263 ()
264{
265 Lisp_Object tem;
266 if (EQ (current_buffer->undo_list, Qt))
267 return Qnil;
268 tem = Fcar (current_buffer->undo_list);
265a9e55 269 if (!NILP (tem))
c58632fc
RS
270 {
271 /* One way or another, cons nil onto the front of the undo list. */
272 if (!NILP (pending_boundary))
273 {
274 /* If we have preallocated the cons cell to use here,
275 use that one. */
c1d497be 276 XCDR (pending_boundary) = current_buffer->undo_list;
c58632fc
RS
277 current_buffer->undo_list = pending_boundary;
278 pending_boundary = Qnil;
279 }
280 else
281 current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
282 }
c6953be1
JB
283 return Qnil;
284}
285
286/* At garbage collection time, make an undo list shorter at the end,
287 returning the truncated list.
288 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
f06cd136
JB
289 In practice, these are the values of undo-limit and
290 undo-strong-limit. */
c6953be1
JB
291
292Lisp_Object
293truncate_undo_list (list, minsize, maxsize)
294 Lisp_Object list;
295 int minsize, maxsize;
296{
297 Lisp_Object prev, next, last_boundary;
298 int size_so_far = 0;
299
300 prev = Qnil;
301 next = list;
302 last_boundary = Qnil;
303
304 /* Always preserve at least the most recent undo record.
181a18b1
JB
305 If the first element is an undo boundary, skip past it.
306
307 Skip, skip, skip the undo, skip, skip, skip the undo,
07627b5d
JB
308 Skip, skip, skip the undo, skip to the undo bound'ry.
309 (Get it? "Skip to my Loo?") */
c1d497be 310 if (CONSP (next) && NILP (XCAR (next)))
c6953be1
JB
311 {
312 /* Add in the space occupied by this element and its chain link. */
313 size_so_far += sizeof (struct Lisp_Cons);
314
315 /* Advance to next element. */
316 prev = next;
c1d497be 317 next = XCDR (next);
c6953be1 318 }
c1d497be 319 while (CONSP (next) && ! NILP (XCAR (next)))
c6953be1
JB
320 {
321 Lisp_Object elt;
c1d497be 322 elt = XCAR (next);
c6953be1
JB
323
324 /* Add in the space occupied by this element and its chain link. */
325 size_so_far += sizeof (struct Lisp_Cons);
38c0d37c 326 if (CONSP (elt))
c6953be1
JB
327 {
328 size_so_far += sizeof (struct Lisp_Cons);
c1d497be 329 if (STRINGP (XCAR (elt)))
c6953be1 330 size_so_far += (sizeof (struct Lisp_String) - 1
c1d497be 331 + XSTRING (XCAR (elt))->size);
c6953be1
JB
332 }
333
334 /* Advance to next element. */
335 prev = next;
c1d497be 336 next = XCDR (next);
c6953be1 337 }
38c0d37c 338 if (CONSP (next))
c6953be1
JB
339 last_boundary = prev;
340
38c0d37c 341 while (CONSP (next))
c6953be1
JB
342 {
343 Lisp_Object elt;
c1d497be 344 elt = XCAR (next);
c6953be1
JB
345
346 /* When we get to a boundary, decide whether to truncate
347 either before or after it. The lower threshold, MINSIZE,
348 tells us to truncate after it. If its size pushes past
349 the higher threshold MAXSIZE as well, we truncate before it. */
265a9e55 350 if (NILP (elt))
c6953be1
JB
351 {
352 if (size_so_far > maxsize)
353 break;
354 last_boundary = prev;
355 if (size_so_far > minsize)
356 break;
357 }
358
359 /* Add in the space occupied by this element and its chain link. */
360 size_so_far += sizeof (struct Lisp_Cons);
38c0d37c 361 if (CONSP (elt))
c6953be1
JB
362 {
363 size_so_far += sizeof (struct Lisp_Cons);
c1d497be 364 if (STRINGP (XCAR (elt)))
c6953be1 365 size_so_far += (sizeof (struct Lisp_String) - 1
c1d497be 366 + XSTRING (XCAR (elt))->size);
c6953be1
JB
367 }
368
369 /* Advance to next element. */
370 prev = next;
c1d497be 371 next = XCDR (next);
c6953be1
JB
372 }
373
374 /* If we scanned the whole list, it is short enough; don't change it. */
265a9e55 375 if (NILP (next))
c6953be1
JB
376 return list;
377
378 /* Truncate at the boundary where we decided to truncate. */
265a9e55 379 if (!NILP (last_boundary))
c6953be1 380 {
c1d497be 381 XCDR (last_boundary) = Qnil;
c6953be1
JB
382 return list;
383 }
384 else
385 return Qnil;
386}
387\f
388DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
389 "Undo N records from the front of the list LIST.\n\
390Return what remains of the list.")
063fb61f
RS
391 (n, list)
392 Lisp_Object n, list;
c6953be1 393{
de65837b
KH
394 struct gcpro gcpro1, gcpro2;
395 Lisp_Object next;
f87a68b3 396 int count = specpdl_ptr - specpdl;
de65837b 397 register int arg;
c6953be1
JB
398#if 0 /* This is a good feature, but would make undo-start
399 unable to do what is expected. */
400 Lisp_Object tem;
401
402 /* If the head of the list is a boundary, it is the boundary
403 preceding this command. Get rid of it and don't count it. */
404 tem = Fcar (list);
265a9e55 405 if (NILP (tem))
c6953be1
JB
406 list = Fcdr (list);
407#endif
408
de65837b
KH
409 CHECK_NUMBER (n, 0);
410 arg = XINT (n);
411 next = Qnil;
412 GCPRO2 (next, list);
413
f87a68b3 414 /* Don't let read-only properties interfere with undo. */
4c587cd3 415 if (!NILP (current_buffer->read_only))
f87a68b3
RS
416 specbind (Qinhibit_read_only, Qt);
417
c6953be1
JB
418 while (arg > 0)
419 {
420 while (1)
421 {
c6953be1
JB
422 next = Fcar (list);
423 list = Fcdr (list);
350bce56 424 /* Exit inner loop at undo boundary. */
265a9e55 425 if (NILP (next))
c6953be1 426 break;
350bce56 427 /* Handle an integer by setting point to that value. */
38c0d37c 428 if (INTEGERP (next))
350bce56 429 SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
38c0d37c 430 else if (CONSP (next))
c6953be1 431 {
350bce56
RS
432 Lisp_Object car, cdr;
433
434 car = Fcar (next);
435 cdr = Fcdr (next);
436 if (EQ (car, Qt))
c6953be1 437 {
350bce56
RS
438 /* Element (t high . low) records previous modtime. */
439 Lisp_Object high, low;
440 int mod_time;
ad9cdce4 441 struct buffer *base_buffer = current_buffer;
350bce56
RS
442
443 high = Fcar (cdr);
444 low = Fcdr (cdr);
d8552b2f 445 mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
ad9cdce4
RS
446
447 if (current_buffer->base_buffer)
448 base_buffer = current_buffer->base_buffer;
449
350bce56
RS
450 /* If this records an obsolete save
451 (not matching the actual disk file)
452 then don't mark unmodified. */
ad9cdce4 453 if (mod_time != base_buffer->modtime)
103dcb38 454 continue;
e6dd6080 455#ifdef CLASH_DETECTION
350bce56 456 Funlock_buffer ();
e6dd6080 457#endif /* CLASH_DETECTION */
350bce56 458 Fset_buffer_modified_p (Qnil);
c6953be1 459 }
d8552b2f 460 else if (EQ (car, Qnil))
da9319d5 461 {
d8552b2f 462 /* Element (nil prop val beg . end) is property change. */
da9319d5
RS
463 Lisp_Object beg, end, prop, val;
464
465 prop = Fcar (cdr);
466 cdr = Fcdr (cdr);
467 val = Fcar (cdr);
468 cdr = Fcdr (cdr);
469 beg = Fcar (cdr);
470 end = Fcdr (cdr);
471
472 Fput_text_property (beg, end, prop, val, Qnil);
473 }
38c0d37c 474 else if (INTEGERP (car) && INTEGERP (cdr))
c6953be1 475 {
350bce56
RS
476 /* Element (BEG . END) means range was inserted. */
477 Lisp_Object end;
478
479 if (XINT (car) < BEGV
480 || XINT (cdr) > ZV)
c6953be1 481 error ("Changes to be undone are outside visible portion of buffer");
f28f04cc
RS
482 /* Set point first thing, so that undoing this undo
483 does not send point back to where it is now. */
350bce56 484 Fgoto_char (car);
f28f04cc 485 Fdelete_region (car, cdr);
350bce56 486 }
38c0d37c 487 else if (STRINGP (car) && INTEGERP (cdr))
350bce56
RS
488 {
489 /* Element (STRING . POS) means STRING was deleted. */
490 Lisp_Object membuf;
491 int pos = XINT (cdr);
492
493 membuf = car;
494 if (pos < 0)
495 {
496 if (-pos < BEGV || -pos > ZV)
497 error ("Changes to be undone are outside visible portion of buffer");
498 SET_PT (-pos);
499 Finsert (1, &membuf);
500 }
501 else
502 {
503 if (pos < BEGV || pos > ZV)
504 error ("Changes to be undone are outside visible portion of buffer");
505 SET_PT (pos);
506
b2adc409
RS
507 /* Now that we record marker adjustments
508 (caused by deletion) for undo,
509 we should always insert after markers,
510 so that undoing the marker adjustments
511 put the markers back in the right place. */
512 Finsert (1, &membuf);
350bce56
RS
513 SET_PT (pos);
514 }
c6953be1 515 }
714bced9
RS
516 else if (MARKERP (car) && INTEGERP (cdr))
517 {
518 /* (MARKER . INTEGER) means a marker MARKER
519 was adjusted by INTEGER. */
520 if (XMARKER (car)->buffer)
521 Fset_marker (car,
522 make_number (marker_position (car) - XINT (cdr)),
523 Fmarker_buffer (car));
524 }
c6953be1
JB
525 }
526 }
527 arg--;
528 }
529
de65837b 530 UNGCPRO;
f87a68b3 531 return unbind_to (count, list);
c6953be1
JB
532}
533
dfcf069d 534void
c6953be1
JB
535syms_of_undo ()
536{
f87a68b3
RS
537 Qinhibit_read_only = intern ("inhibit-read-only");
538 staticpro (&Qinhibit_read_only);
539
c58632fc
RS
540 pending_boundary = Qnil;
541 staticpro (&pending_boundary);
542
c6953be1
JB
543 defsubr (&Sprimitive_undo);
544 defsubr (&Sundo_boundary);
545}