(flyspell-external-point-words): Use goto-char instead of beginning-of-buffer.
[emacs.git] / src / undo.c
blob9fdc46a3b13112684fb926f48098dfd8e56fef93
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 point as it was at beginning of this command (if necessary)
40 And prepare the undo info for recording a change.
41 PT is the position of point that will naturally occur as a result of the
42 undo record that will be added just after this command terminates. */
44 static void
45 record_point (pt)
46 int pt;
48 int at_boundary;
50 /* Allocate a cons cell to be the undo boundary after this command. */
51 if (NILP (pending_boundary))
52 pending_boundary = Fcons (Qnil, Qnil);
54 if (!BUFFERP (last_undo_buffer)
55 || current_buffer != XBUFFER (last_undo_buffer))
56 Fundo_boundary ();
57 XSETBUFFER (last_undo_buffer, current_buffer);
59 if (CONSP (current_buffer->undo_list))
61 /* Set AT_BOUNDARY to 1 only when we have nothing other than
62 marker adjustment before undo boundary. */
64 Lisp_Object tail = current_buffer->undo_list, elt;
66 while (1)
68 if (NILP (tail))
69 elt = Qnil;
70 else
71 elt = XCAR (tail);
72 if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
73 break;
74 tail = XCDR (tail);
76 at_boundary = NILP (elt);
78 else
79 at_boundary = 1;
81 if (MODIFF <= SAVE_MODIFF)
82 record_first_change ();
84 /* If we are just after an undo boundary, and
85 point wasn't at start of deleted range, record where it was. */
86 if (at_boundary
87 && last_point_position != pt
88 /* If we're called from batch mode, this could be nil. */
89 && BUFFERP (last_point_position_buffer)
90 && current_buffer == XBUFFER (last_point_position_buffer))
91 current_buffer->undo_list
92 = Fcons (make_number (last_point_position), current_buffer->undo_list);
95 /* Record an insertion that just happened or is about to happen,
96 for LENGTH characters at position BEG.
97 (It is possible to record an insertion before or after the fact
98 because we don't need to record the contents.) */
100 void
101 record_insert (beg, length)
102 int beg, length;
104 Lisp_Object lbeg, lend;
106 if (EQ (current_buffer->undo_list, Qt))
107 return;
109 record_point (beg);
111 /* If this is following another insertion and consecutive with it
112 in the buffer, combine the two. */
113 if (CONSP (current_buffer->undo_list))
115 Lisp_Object elt;
116 elt = XCAR (current_buffer->undo_list);
117 if (CONSP (elt)
118 && INTEGERP (XCAR (elt))
119 && INTEGERP (XCDR (elt))
120 && XINT (XCDR (elt)) == beg)
122 XSETCDR (elt, make_number (beg + length));
123 return;
127 XSETFASTINT (lbeg, beg);
128 XSETINT (lend, beg + length);
129 current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
130 current_buffer->undo_list);
133 /* Record that a deletion is about to take place,
134 of the characters in STRING, at location BEG. */
136 void
137 record_delete (beg, string)
138 int beg;
139 Lisp_Object string;
141 Lisp_Object sbeg;
143 if (EQ (current_buffer->undo_list, Qt))
144 return;
146 if (PT == beg + SCHARS (string))
148 XSETINT (sbeg, -beg);
149 record_point (PT);
151 else
153 XSETFASTINT (sbeg, beg);
154 record_point (beg);
157 current_buffer->undo_list
158 = Fcons (Fcons (string, sbeg), current_buffer->undo_list);
161 /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
162 This is done only when a marker points within text being deleted,
163 because that's the only case where an automatic marker adjustment
164 won't be inverted automatically by undoing the buffer modification. */
166 void
167 record_marker_adjustment (marker, adjustment)
168 Lisp_Object marker;
169 int adjustment;
171 if (EQ (current_buffer->undo_list, Qt))
172 return;
174 /* Allocate a cons cell to be the undo boundary after this command. */
175 if (NILP (pending_boundary))
176 pending_boundary = Fcons (Qnil, Qnil);
178 if (!BUFFERP (last_undo_buffer)
179 || current_buffer != XBUFFER (last_undo_buffer))
180 Fundo_boundary ();
181 XSETBUFFER (last_undo_buffer, current_buffer);
183 current_buffer->undo_list
184 = Fcons (Fcons (marker, make_number (adjustment)),
185 current_buffer->undo_list);
188 /* Record that a replacement is about to take place,
189 for LENGTH characters at location BEG.
190 The replacement must not change the number of characters. */
192 void
193 record_change (beg, length)
194 int beg, length;
196 record_delete (beg, make_buffer_string (beg, beg + length, 1));
197 record_insert (beg, length);
200 /* Record that an unmodified buffer is about to be changed.
201 Record the file modification date so that when undoing this entry
202 we can tell whether it is obsolete because the file was saved again. */
204 void
205 record_first_change ()
207 Lisp_Object high, low;
208 struct buffer *base_buffer = current_buffer;
210 if (EQ (current_buffer->undo_list, Qt))
211 return;
213 if (!BUFFERP (last_undo_buffer)
214 || current_buffer != XBUFFER (last_undo_buffer))
215 Fundo_boundary ();
216 XSETBUFFER (last_undo_buffer, current_buffer);
218 if (base_buffer->base_buffer)
219 base_buffer = base_buffer->base_buffer;
221 XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
222 XSETFASTINT (low, base_buffer->modtime & 0xffff);
223 current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
226 /* Record a change in property PROP (whose old value was VAL)
227 for LENGTH characters starting at position BEG in BUFFER. */
229 void
230 record_property_change (beg, length, prop, value, buffer)
231 int beg, length;
232 Lisp_Object prop, value, buffer;
234 Lisp_Object lbeg, lend, entry;
235 struct buffer *obuf = current_buffer;
236 int boundary = 0;
238 if (EQ (XBUFFER (buffer)->undo_list, Qt))
239 return;
241 /* Allocate a cons cell to be the undo boundary after this command. */
242 if (NILP (pending_boundary))
243 pending_boundary = Fcons (Qnil, Qnil);
245 if (!EQ (buffer, last_undo_buffer))
246 boundary = 1;
247 last_undo_buffer = buffer;
249 /* Switch temporarily to the buffer that was changed. */
250 current_buffer = XBUFFER (buffer);
252 if (boundary)
253 Fundo_boundary ();
255 if (MODIFF <= SAVE_MODIFF)
256 record_first_change ();
258 XSETINT (lbeg, beg);
259 XSETINT (lend, beg + length);
260 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
261 current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
263 current_buffer = obuf;
266 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
267 doc: /* Mark a boundary between units of undo.
268 An undo command will stop at this point,
269 but another undo command will undo to the previous boundary. */)
272 Lisp_Object tem;
273 if (EQ (current_buffer->undo_list, Qt))
274 return Qnil;
275 tem = Fcar (current_buffer->undo_list);
276 if (!NILP (tem))
278 /* One way or another, cons nil onto the front of the undo list. */
279 if (!NILP (pending_boundary))
281 /* If we have preallocated the cons cell to use here,
282 use that one. */
283 XSETCDR (pending_boundary, current_buffer->undo_list);
284 current_buffer->undo_list = pending_boundary;
285 pending_boundary = Qnil;
287 else
288 current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
290 return Qnil;
293 /* At garbage collection time, make an undo list shorter at the end,
294 returning the truncated list.
295 MINSIZE, MAXSIZE and LIMITSIZE are the limits on size allowed,
296 as described below.
297 In practice, these are the values of undo-limit,
298 undo-strong-limit, and undo-outer-limit. */
300 Lisp_Object
301 truncate_undo_list (list, minsize, maxsize, limitsize)
302 Lisp_Object list;
303 int minsize, maxsize, limitsize;
305 Lisp_Object prev, next, last_boundary;
306 int size_so_far = 0;
308 prev = Qnil;
309 next = list;
310 last_boundary = Qnil;
312 /* Always preserve at least the most recent undo record
313 unless it is really horribly big.
314 If the first element is an undo boundary, skip past it.
316 Skip, skip, skip the undo, skip, skip, skip the undo,
317 Skip, skip, skip the undo, skip to the undo bound'ry.
318 (Get it? "Skip to my Loo?") */
319 if (CONSP (next) && NILP (XCAR (next)))
321 /* Add in the space occupied by this element and its chain link. */
322 size_so_far += sizeof (struct Lisp_Cons);
324 /* Advance to next element. */
325 prev = next;
326 next = XCDR (next);
329 while (CONSP (next) && ! NILP (XCAR (next)))
331 Lisp_Object elt;
332 elt = XCAR (next);
334 /* Add in the space occupied by this element and its chain link. */
335 size_so_far += sizeof (struct Lisp_Cons);
336 if (CONSP (elt))
338 size_so_far += sizeof (struct Lisp_Cons);
339 if (STRINGP (XCAR (elt)))
340 size_so_far += (sizeof (struct Lisp_String) - 1
341 + SCHARS (XCAR (elt)));
344 /* If we reach LIMITSIZE before the first boundary,
345 we're heading for memory full, so truncate the list to nothing. */
346 if (size_so_far > limitsize)
347 return Qnil;
349 /* Advance to next element. */
350 prev = next;
351 next = XCDR (next);
354 if (CONSP (next))
355 last_boundary = prev;
357 /* Keep more if it fits. */
358 while (CONSP (next))
360 Lisp_Object elt;
361 elt = XCAR (next);
363 /* When we get to a boundary, decide whether to truncate
364 either before or after it. The lower threshold, MINSIZE,
365 tells us to truncate after it. If its size pushes past
366 the higher threshold MAXSIZE as well, we truncate before it. */
367 if (NILP (elt))
369 if (size_so_far > maxsize)
370 break;
371 last_boundary = prev;
372 if (size_so_far > minsize)
373 break;
376 /* Add in the space occupied by this element and its chain link. */
377 size_so_far += sizeof (struct Lisp_Cons);
378 if (CONSP (elt))
380 size_so_far += sizeof (struct Lisp_Cons);
381 if (STRINGP (XCAR (elt)))
382 size_so_far += (sizeof (struct Lisp_String) - 1
383 + SCHARS (XCAR (elt)));
386 /* Advance to next element. */
387 prev = next;
388 next = XCDR (next);
391 /* If we scanned the whole list, it is short enough; don't change it. */
392 if (NILP (next))
393 return list;
395 /* Truncate at the boundary where we decided to truncate. */
396 if (!NILP (last_boundary))
398 XSETCDR (last_boundary, Qnil);
399 return list;
401 else
402 return Qnil;
405 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
406 doc: /* Undo N records from the front of the list LIST.
407 Return what remains of the list. */)
408 (n, list)
409 Lisp_Object n, list;
411 struct gcpro gcpro1, gcpro2;
412 Lisp_Object next;
413 int count = SPECPDL_INDEX ();
414 register int arg;
416 #if 0 /* This is a good feature, but would make undo-start
417 unable to do what is expected. */
418 Lisp_Object tem;
420 /* If the head of the list is a boundary, it is the boundary
421 preceding this command. Get rid of it and don't count it. */
422 tem = Fcar (list);
423 if (NILP (tem))
424 list = Fcdr (list);
425 #endif
427 CHECK_NUMBER (n);
428 arg = XINT (n);
429 next = Qnil;
430 GCPRO2 (next, list);
432 /* In a writable buffer, enable undoing read-only text that is so
433 because of text properties. */
434 if (NILP (current_buffer->read_only))
435 specbind (Qinhibit_read_only, Qt);
437 /* Don't let `intangible' properties interfere with undo. */
438 specbind (Qinhibit_point_motion_hooks, Qt);
440 while (arg > 0)
442 while (CONSP (list))
444 next = XCAR (list);
445 list = XCDR (list);
446 /* Exit inner loop at undo boundary. */
447 if (NILP (next))
448 break;
449 /* Handle an integer by setting point to that value. */
450 if (INTEGERP (next))
451 SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
452 else if (CONSP (next))
454 Lisp_Object car, cdr;
456 car = XCAR (next);
457 cdr = XCDR (next);
458 if (EQ (car, Qt))
460 /* Element (t high . low) records previous modtime. */
461 Lisp_Object high, low;
462 int mod_time;
463 struct buffer *base_buffer = current_buffer;
465 high = Fcar (cdr);
466 low = Fcdr (cdr);
467 mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
469 if (current_buffer->base_buffer)
470 base_buffer = current_buffer->base_buffer;
472 /* If this records an obsolete save
473 (not matching the actual disk file)
474 then don't mark unmodified. */
475 if (mod_time != base_buffer->modtime)
476 continue;
477 #ifdef CLASH_DETECTION
478 Funlock_buffer ();
479 #endif /* CLASH_DETECTION */
480 Fset_buffer_modified_p (Qnil);
482 else if (EQ (car, Qnil))
484 /* Element (nil prop val beg . end) is property change. */
485 Lisp_Object beg, end, prop, val;
487 prop = Fcar (cdr);
488 cdr = Fcdr (cdr);
489 val = Fcar (cdr);
490 cdr = Fcdr (cdr);
491 beg = Fcar (cdr);
492 end = Fcdr (cdr);
494 Fput_text_property (beg, end, prop, val, Qnil);
496 else if (INTEGERP (car) && INTEGERP (cdr))
498 /* Element (BEG . END) means range was inserted. */
500 if (XINT (car) < BEGV
501 || XINT (cdr) > ZV)
502 error ("Changes to be undone are outside visible portion of buffer");
503 /* Set point first thing, so that undoing this undo
504 does not send point back to where it is now. */
505 Fgoto_char (car);
506 Fdelete_region (car, cdr);
508 else if (STRINGP (car) && INTEGERP (cdr))
510 /* Element (STRING . POS) means STRING was deleted. */
511 Lisp_Object membuf;
512 int pos = XINT (cdr);
514 membuf = car;
515 if (pos < 0)
517 if (-pos < BEGV || -pos > ZV)
518 error ("Changes to be undone are outside visible portion of buffer");
519 SET_PT (-pos);
520 Finsert (1, &membuf);
522 else
524 if (pos < BEGV || pos > ZV)
525 error ("Changes to be undone are outside visible portion of buffer");
526 SET_PT (pos);
528 /* Now that we record marker adjustments
529 (caused by deletion) for undo,
530 we should always insert after markers,
531 so that undoing the marker adjustments
532 put the markers back in the right place. */
533 Finsert (1, &membuf);
534 SET_PT (pos);
537 else if (MARKERP (car) && INTEGERP (cdr))
539 /* (MARKER . INTEGER) means a marker MARKER
540 was adjusted by INTEGER. */
541 if (XMARKER (car)->buffer)
542 Fset_marker (car,
543 make_number (marker_position (car) - XINT (cdr)),
544 Fmarker_buffer (car));
548 arg--;
551 UNGCPRO;
552 return unbind_to (count, list);
555 void
556 syms_of_undo ()
558 Qinhibit_read_only = intern ("inhibit-read-only");
559 staticpro (&Qinhibit_read_only);
561 pending_boundary = Qnil;
562 staticpro (&pending_boundary);
564 defsubr (&Sprimitive_undo);
565 defsubr (&Sundo_boundary);
568 /* arch-tag: d546ee01-4aed-4ffb-bb8b-eefaae50d38a
569 (do not change this comment) */