*** empty log message ***
[emacs.git] / src / undo.c
blob31d7c39db14ba9ab1497cc47926a781d55665fc0
1 /* undo handling for GNU Emacs.
2 Copyright (C) 1990, 1993, 1994, 2000 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
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.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 #include <config.h>
23 #include "lisp.h"
24 #include "buffer.h"
25 #include "commands.h"
27 /* Last buffer for which undo information was recorded. */
28 Lisp_Object last_undo_buffer;
30 Lisp_Object Qinhibit_read_only;
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. */
37 Lisp_Object pending_boundary;
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.) */
44 void
45 record_insert (beg, length)
46 int beg, length;
48 Lisp_Object lbeg, lend;
50 if (EQ (current_buffer->undo_list, Qt))
51 return;
53 /* Allocate a cons cell to be the undo boundary after this command. */
54 if (NILP (pending_boundary))
55 pending_boundary = Fcons (Qnil, Qnil);
57 if (!BUFFERP (last_undo_buffer)
58 || current_buffer != XBUFFER (last_undo_buffer))
59 Fundo_boundary ();
60 XSETBUFFER (last_undo_buffer, current_buffer);
62 if (MODIFF <= SAVE_MODIFF)
63 record_first_change ();
65 /* If this is following another insertion and consecutive with it
66 in the buffer, combine the two. */
67 if (CONSP (current_buffer->undo_list))
69 Lisp_Object elt;
70 elt = XCAR (current_buffer->undo_list);
71 if (CONSP (elt)
72 && INTEGERP (XCAR (elt))
73 && INTEGERP (XCDR (elt))
74 && XINT (XCDR (elt)) == beg)
76 XSETINT (XCDR (elt), beg + length);
77 return;
81 XSETFASTINT (lbeg, beg);
82 XSETINT (lend, beg + length);
83 current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
84 current_buffer->undo_list);
87 /* Record that a deletion is about to take place,
88 of the characters in STRING, at location BEG. */
90 void
91 record_delete (beg, string)
92 int beg;
93 Lisp_Object string;
95 Lisp_Object sbeg;
96 int at_boundary;
98 if (EQ (current_buffer->undo_list, Qt))
99 return;
101 /* Allocate a cons cell to be the undo boundary after this command. */
102 if (NILP (pending_boundary))
103 pending_boundary = Fcons (Qnil, Qnil);
105 if (BUFFERP (last_undo_buffer)
106 && current_buffer != XBUFFER (last_undo_buffer))
107 Fundo_boundary ();
108 XSETBUFFER (last_undo_buffer, current_buffer);
110 if (CONSP (current_buffer->undo_list))
112 /* Set AT_BOUNDARY to 1 only when we have nothing other than
113 marker adjustment before undo boundary. */
115 Lisp_Object tail = current_buffer->undo_list, elt;
117 while (1)
119 if (NILP (tail))
120 elt = Qnil;
121 else
122 elt = XCAR (tail);
123 if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
124 break;
125 tail = XCDR (tail);
127 at_boundary = NILP (elt);
129 else
130 at_boundary = 0;
132 if (MODIFF <= SAVE_MODIFF)
133 record_first_change ();
135 if (PT == beg + XSTRING (string)->size)
136 XSETINT (sbeg, -beg);
137 else
138 XSETFASTINT (sbeg, beg);
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)
144 /* If we're called from batch mode, this could be nil. */
145 && BUFFERP (last_point_position_buffer)
146 && current_buffer == XBUFFER (last_point_position_buffer))
147 current_buffer->undo_list
148 = Fcons (make_number (last_point_position), current_buffer->undo_list);
150 current_buffer->undo_list
151 = Fcons (Fcons (string, sbeg), current_buffer->undo_list);
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. */
159 void
160 record_marker_adjustment (marker, adjustment)
161 Lisp_Object marker;
162 int adjustment;
164 if (EQ (current_buffer->undo_list, Qt))
165 return;
167 /* Allocate a cons cell to be the undo boundary after this command. */
168 if (NILP (pending_boundary))
169 pending_boundary = Fcons (Qnil, Qnil);
171 if (!BUFFERP (last_undo_buffer)
172 || current_buffer != XBUFFER (last_undo_buffer))
173 Fundo_boundary ();
174 XSETBUFFER (last_undo_buffer, current_buffer);
176 current_buffer->undo_list
177 = Fcons (Fcons (marker, make_number (adjustment)),
178 current_buffer->undo_list);
181 /* Record that a replacement is about to take place,
182 for LENGTH characters at location BEG.
183 The replacement must not change the number of characters. */
185 void
186 record_change (beg, length)
187 int beg, length;
189 record_delete (beg, make_buffer_string (beg, beg + length, 1));
190 record_insert (beg, length);
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. */
197 void
198 record_first_change ()
200 Lisp_Object high, low;
201 struct buffer *base_buffer = current_buffer;
203 if (EQ (current_buffer->undo_list, Qt))
204 return;
206 if (!BUFFERP (last_undo_buffer)
207 || current_buffer != XBUFFER (last_undo_buffer))
208 Fundo_boundary ();
209 XSETBUFFER (last_undo_buffer, current_buffer);
211 if (base_buffer->base_buffer)
212 base_buffer = base_buffer->base_buffer;
214 XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
215 XSETFASTINT (low, base_buffer->modtime & 0xffff);
216 current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
219 /* Record a change in property PROP (whose old value was VAL)
220 for LENGTH characters starting at position BEG in BUFFER. */
222 void
223 record_property_change (beg, length, prop, value, buffer)
224 int beg, length;
225 Lisp_Object prop, value, buffer;
227 Lisp_Object lbeg, lend, entry;
228 struct buffer *obuf = current_buffer;
229 int boundary = 0;
231 if (EQ (XBUFFER (buffer)->undo_list, Qt))
232 return;
234 /* Allocate a cons cell to be the undo boundary after this command. */
235 if (NILP (pending_boundary))
236 pending_boundary = Fcons (Qnil, Qnil);
238 if (!EQ (buffer, last_undo_buffer))
239 boundary = 1;
240 last_undo_buffer = buffer;
242 /* Switch temporarily to the buffer that was changed. */
243 current_buffer = XBUFFER (buffer);
245 if (boundary)
246 Fundo_boundary ();
248 if (MODIFF <= SAVE_MODIFF)
249 record_first_change ();
251 XSETINT (lbeg, beg);
252 XSETINT (lend, beg + length);
253 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
254 current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
256 current_buffer = obuf;
259 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
260 "Mark a boundary between units of undo.\n\
261 An undo command will stop at this point,\n\
262 but another undo command will undo to the previous boundary.")
265 Lisp_Object tem;
266 if (EQ (current_buffer->undo_list, Qt))
267 return Qnil;
268 tem = Fcar (current_buffer->undo_list);
269 if (!NILP (tem))
271 /* One way or another, cons nil onto the front of the undo list. */
272 if (!NILP (pending_boundary))
274 /* If we have preallocated the cons cell to use here,
275 use that one. */
276 XCDR (pending_boundary) = current_buffer->undo_list;
277 current_buffer->undo_list = pending_boundary;
278 pending_boundary = Qnil;
280 else
281 current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
283 return Qnil;
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.
289 In practice, these are the values of undo-limit and
290 undo-strong-limit. */
292 Lisp_Object
293 truncate_undo_list (list, minsize, maxsize)
294 Lisp_Object list;
295 int minsize, maxsize;
297 Lisp_Object prev, next, last_boundary;
298 int size_so_far = 0;
300 prev = Qnil;
301 next = list;
302 last_boundary = Qnil;
304 /* Always preserve at least the most recent undo record.
305 If the first element is an undo boundary, skip past it.
307 Skip, skip, skip the undo, skip, skip, skip the undo,
308 Skip, skip, skip the undo, skip to the undo bound'ry.
309 (Get it? "Skip to my Loo?") */
310 if (CONSP (next) && NILP (XCAR (next)))
312 /* Add in the space occupied by this element and its chain link. */
313 size_so_far += sizeof (struct Lisp_Cons);
315 /* Advance to next element. */
316 prev = next;
317 next = XCDR (next);
319 while (CONSP (next) && ! NILP (XCAR (next)))
321 Lisp_Object elt;
322 elt = XCAR (next);
324 /* Add in the space occupied by this element and its chain link. */
325 size_so_far += sizeof (struct Lisp_Cons);
326 if (CONSP (elt))
328 size_so_far += sizeof (struct Lisp_Cons);
329 if (STRINGP (XCAR (elt)))
330 size_so_far += (sizeof (struct Lisp_String) - 1
331 + XSTRING (XCAR (elt))->size);
334 /* Advance to next element. */
335 prev = next;
336 next = XCDR (next);
338 if (CONSP (next))
339 last_boundary = prev;
341 while (CONSP (next))
343 Lisp_Object elt;
344 elt = XCAR (next);
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. */
350 if (NILP (elt))
352 if (size_so_far > maxsize)
353 break;
354 last_boundary = prev;
355 if (size_so_far > minsize)
356 break;
359 /* Add in the space occupied by this element and its chain link. */
360 size_so_far += sizeof (struct Lisp_Cons);
361 if (CONSP (elt))
363 size_so_far += sizeof (struct Lisp_Cons);
364 if (STRINGP (XCAR (elt)))
365 size_so_far += (sizeof (struct Lisp_String) - 1
366 + XSTRING (XCAR (elt))->size);
369 /* Advance to next element. */
370 prev = next;
371 next = XCDR (next);
374 /* If we scanned the whole list, it is short enough; don't change it. */
375 if (NILP (next))
376 return list;
378 /* Truncate at the boundary where we decided to truncate. */
379 if (!NILP (last_boundary))
381 XCDR (last_boundary) = Qnil;
382 return list;
384 else
385 return Qnil;
388 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
389 "Undo N records from the front of the list LIST.\n\
390 Return what remains of the list.")
391 (n, list)
392 Lisp_Object n, list;
394 struct gcpro gcpro1, gcpro2;
395 Lisp_Object next;
396 int count = specpdl_ptr - specpdl;
397 register int arg;
398 #if 0 /* This is a good feature, but would make undo-start
399 unable to do what is expected. */
400 Lisp_Object tem;
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);
405 if (NILP (tem))
406 list = Fcdr (list);
407 #endif
409 CHECK_NUMBER (n, 0);
410 arg = XINT (n);
411 next = Qnil;
412 GCPRO2 (next, list);
414 /* Don't let read-only properties interfere with undo. */
415 if (!NILP (current_buffer->read_only))
416 specbind (Qinhibit_read_only, Qt);
418 while (arg > 0)
420 while (1)
422 next = Fcar (list);
423 list = Fcdr (list);
424 /* Exit inner loop at undo boundary. */
425 if (NILP (next))
426 break;
427 /* Handle an integer by setting point to that value. */
428 if (INTEGERP (next))
429 SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
430 else if (CONSP (next))
432 Lisp_Object car, cdr;
434 car = Fcar (next);
435 cdr = Fcdr (next);
436 if (EQ (car, Qt))
438 /* Element (t high . low) records previous modtime. */
439 Lisp_Object high, low;
440 int mod_time;
441 struct buffer *base_buffer = current_buffer;
443 high = Fcar (cdr);
444 low = Fcdr (cdr);
445 mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
447 if (current_buffer->base_buffer)
448 base_buffer = current_buffer->base_buffer;
450 /* If this records an obsolete save
451 (not matching the actual disk file)
452 then don't mark unmodified. */
453 if (mod_time != base_buffer->modtime)
454 continue;
455 #ifdef CLASH_DETECTION
456 Funlock_buffer ();
457 #endif /* CLASH_DETECTION */
458 Fset_buffer_modified_p (Qnil);
460 else if (EQ (car, Qnil))
462 /* Element (nil prop val beg . end) is property change. */
463 Lisp_Object beg, end, prop, val;
465 prop = Fcar (cdr);
466 cdr = Fcdr (cdr);
467 val = Fcar (cdr);
468 cdr = Fcdr (cdr);
469 beg = Fcar (cdr);
470 end = Fcdr (cdr);
472 Fput_text_property (beg, end, prop, val, Qnil);
474 else if (INTEGERP (car) && INTEGERP (cdr))
476 /* Element (BEG . END) means range was inserted. */
477 Lisp_Object end;
479 if (XINT (car) < BEGV
480 || XINT (cdr) > ZV)
481 error ("Changes to be undone are outside visible portion of buffer");
482 /* Set point first thing, so that undoing this undo
483 does not send point back to where it is now. */
484 Fgoto_char (car);
485 Fdelete_region (car, cdr);
487 else if (STRINGP (car) && INTEGERP (cdr))
489 /* Element (STRING . POS) means STRING was deleted. */
490 Lisp_Object membuf;
491 int pos = XINT (cdr);
493 membuf = car;
494 if (pos < 0)
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);
501 else
503 if (pos < BEGV || pos > ZV)
504 error ("Changes to be undone are outside visible portion of buffer");
505 SET_PT (pos);
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);
513 SET_PT (pos);
516 else if (MARKERP (car) && INTEGERP (cdr))
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));
527 arg--;
530 UNGCPRO;
531 return unbind_to (count, list);
534 void
535 syms_of_undo ()
537 Qinhibit_read_only = intern ("inhibit-read-only");
538 staticpro (&Qinhibit_read_only);
540 pending_boundary = Qnil;
541 staticpro (&pending_boundary);
543 defsubr (&Sprimitive_undo);
544 defsubr (&Sundo_boundary);