1 /* undo handling for GNU Emacs.
2 Copyright (C) 1990, 1993, 1994 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)
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. */
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
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.) */
45 record_insert (beg
, length
)
48 Lisp_Object lbeg
, lend
;
50 if (EQ (current_buffer
->undo_list
, Qt
))
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 (current_buffer
!= XBUFFER (last_undo_buffer
))
59 XSETBUFFER (last_undo_buffer
, current_buffer
);
61 if (MODIFF
<= SAVE_MODIFF
)
62 record_first_change ();
64 /* If this is following another insertion and consecutive with it
65 in the buffer, combine the two. */
66 if (CONSP (current_buffer
->undo_list
))
69 elt
= XCONS (current_buffer
->undo_list
)->car
;
71 && INTEGERP (XCONS (elt
)->car
)
72 && INTEGERP (XCONS (elt
)->cdr
)
73 && XINT (XCONS (elt
)->cdr
) == beg
)
75 XSETINT (XCONS (elt
)->cdr
, beg
+ length
);
80 XSETFASTINT (lbeg
, beg
);
81 XSETINT (lend
, beg
+ length
);
82 current_buffer
->undo_list
= Fcons (Fcons (lbeg
, lend
),
83 current_buffer
->undo_list
);
86 /* Record that a deletion is about to take place,
87 for LENGTH characters at location BEG. */
90 record_delete (beg
, length
)
93 Lisp_Object lbeg
, lend
, sbeg
;
96 if (EQ (current_buffer
->undo_list
, Qt
))
99 /* Allocate a cons cell to be the undo boundary after this command. */
100 if (NILP (pending_boundary
))
101 pending_boundary
= Fcons (Qnil
, Qnil
);
103 if (current_buffer
!= XBUFFER (last_undo_buffer
))
105 XSETBUFFER (last_undo_buffer
, current_buffer
);
107 at_boundary
= (CONSP (current_buffer
->undo_list
)
108 && NILP (XCONS (current_buffer
->undo_list
)->car
));
110 if (MODIFF
<= SAVE_MODIFF
)
111 record_first_change ();
113 if (PT
== beg
+ length
)
114 XSETINT (sbeg
, -beg
);
116 XSETFASTINT (sbeg
, beg
);
117 XSETFASTINT (lbeg
, beg
);
118 XSETFASTINT (lend
, beg
+ length
);
120 /* If we are just after an undo boundary, and
121 point wasn't at start of deleted range, record where it was. */
123 && last_point_position
!= XFASTINT (sbeg
)
124 && current_buffer
== XBUFFER (last_point_position_buffer
))
125 current_buffer
->undo_list
126 = Fcons (make_number (last_point_position
), current_buffer
->undo_list
);
128 current_buffer
->undo_list
129 = Fcons (Fcons (Fbuffer_substring (lbeg
, lend
), sbeg
),
130 current_buffer
->undo_list
);
133 /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
134 This is done only when a marker points within text being deleted,
135 because that's the only case where an automatic marker adjustment
136 won't be inverted automatically by undoing the buffer modification. */
139 record_marker_adjustment (marker
, adjustment
)
143 if (EQ (current_buffer
->undo_list
, Qt
))
146 /* Allocate a cons cell to be the undo boundary after this command. */
147 if (NILP (pending_boundary
))
148 pending_boundary
= Fcons (Qnil
, Qnil
);
150 if (current_buffer
!= XBUFFER (last_undo_buffer
))
152 XSETBUFFER (last_undo_buffer
, current_buffer
);
154 current_buffer
->undo_list
155 = Fcons (Fcons (marker
, make_number (adjustment
)),
156 current_buffer
->undo_list
);
159 /* Record that a replacement is about to take place,
160 for LENGTH characters at location BEG.
161 The replacement does not change the number of characters. */
164 record_change (beg
, length
)
167 record_delete (beg
, length
);
168 record_insert (beg
, length
);
171 /* Record that an unmodified buffer is about to be changed.
172 Record the file modification date so that when undoing this entry
173 we can tell whether it is obsolete because the file was saved again. */
176 record_first_change ()
178 Lisp_Object high
, low
;
179 struct buffer
*base_buffer
= current_buffer
;
181 if (EQ (current_buffer
->undo_list
, Qt
))
184 if (current_buffer
!= XBUFFER (last_undo_buffer
))
186 XSETBUFFER (last_undo_buffer
, current_buffer
);
188 if (base_buffer
->base_buffer
)
189 base_buffer
= base_buffer
->base_buffer
;
191 XSETFASTINT (high
, (base_buffer
->modtime
>> 16) & 0xffff);
192 XSETFASTINT (low
, base_buffer
->modtime
& 0xffff);
193 current_buffer
->undo_list
= Fcons (Fcons (Qt
, Fcons (high
, low
)), current_buffer
->undo_list
);
196 /* Record a change in property PROP (whose old value was VAL)
197 for LENGTH characters starting at position BEG in BUFFER. */
200 record_property_change (beg
, length
, prop
, value
, buffer
)
202 Lisp_Object prop
, value
, buffer
;
204 Lisp_Object lbeg
, lend
, entry
;
205 struct buffer
*obuf
= current_buffer
;
208 if (EQ (XBUFFER (buffer
)->undo_list
, Qt
))
211 /* Allocate a cons cell to be the undo boundary after this command. */
212 if (NILP (pending_boundary
))
213 pending_boundary
= Fcons (Qnil
, Qnil
);
215 if (!EQ (buffer
, last_undo_buffer
))
217 last_undo_buffer
= buffer
;
219 /* Switch temporarily to the buffer that was changed. */
220 current_buffer
= XBUFFER (buffer
);
225 if (MODIFF
<= SAVE_MODIFF
)
226 record_first_change ();
229 XSETINT (lend
, beg
+ length
);
230 entry
= Fcons (Qnil
, Fcons (prop
, Fcons (value
, Fcons (lbeg
, lend
))));
231 current_buffer
->undo_list
= Fcons (entry
, current_buffer
->undo_list
);
233 current_buffer
= obuf
;
236 DEFUN ("undo-boundary", Fundo_boundary
, Sundo_boundary
, 0, 0, 0,
237 "Mark a boundary between units of undo.\n\
238 An undo command will stop at this point,\n\
239 but another undo command will undo to the previous boundary.")
243 if (EQ (current_buffer
->undo_list
, Qt
))
245 tem
= Fcar (current_buffer
->undo_list
);
248 /* One way or another, cons nil onto the front of the undo list. */
249 if (!NILP (pending_boundary
))
251 /* If we have preallocated the cons cell to use here,
253 XCONS (pending_boundary
)->cdr
= current_buffer
->undo_list
;
254 current_buffer
->undo_list
= pending_boundary
;
255 pending_boundary
= Qnil
;
258 current_buffer
->undo_list
= Fcons (Qnil
, current_buffer
->undo_list
);
263 /* At garbage collection time, make an undo list shorter at the end,
264 returning the truncated list.
265 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
266 In practice, these are the values of undo-limit and
267 undo-strong-limit. */
270 truncate_undo_list (list
, minsize
, maxsize
)
272 int minsize
, maxsize
;
274 Lisp_Object prev
, next
, last_boundary
;
279 last_boundary
= Qnil
;
281 /* Always preserve at least the most recent undo record.
282 If the first element is an undo boundary, skip past it.
284 Skip, skip, skip the undo, skip, skip, skip the undo,
285 Skip, skip, skip the undo, skip to the undo bound'ry.
286 (Get it? "Skip to my Loo?") */
287 if (CONSP (next
) && NILP (XCONS (next
)->car
))
289 /* Add in the space occupied by this element and its chain link. */
290 size_so_far
+= sizeof (struct Lisp_Cons
);
292 /* Advance to next element. */
294 next
= XCONS (next
)->cdr
;
296 while (CONSP (next
) && ! NILP (XCONS (next
)->car
))
299 elt
= XCONS (next
)->car
;
301 /* Add in the space occupied by this element and its chain link. */
302 size_so_far
+= sizeof (struct Lisp_Cons
);
305 size_so_far
+= sizeof (struct Lisp_Cons
);
306 if (STRINGP (XCONS (elt
)->car
))
307 size_so_far
+= (sizeof (struct Lisp_String
) - 1
308 + XSTRING (XCONS (elt
)->car
)->size
);
311 /* Advance to next element. */
313 next
= XCONS (next
)->cdr
;
316 last_boundary
= prev
;
321 elt
= XCONS (next
)->car
;
323 /* When we get to a boundary, decide whether to truncate
324 either before or after it. The lower threshold, MINSIZE,
325 tells us to truncate after it. If its size pushes past
326 the higher threshold MAXSIZE as well, we truncate before it. */
329 if (size_so_far
> maxsize
)
331 last_boundary
= prev
;
332 if (size_so_far
> minsize
)
336 /* Add in the space occupied by this element and its chain link. */
337 size_so_far
+= sizeof (struct Lisp_Cons
);
340 size_so_far
+= sizeof (struct Lisp_Cons
);
341 if (STRINGP (XCONS (elt
)->car
))
342 size_so_far
+= (sizeof (struct Lisp_String
) - 1
343 + XSTRING (XCONS (elt
)->car
)->size
);
346 /* Advance to next element. */
348 next
= XCONS (next
)->cdr
;
351 /* If we scanned the whole list, it is short enough; don't change it. */
355 /* Truncate at the boundary where we decided to truncate. */
356 if (!NILP (last_boundary
))
358 XCONS (last_boundary
)->cdr
= Qnil
;
365 DEFUN ("primitive-undo", Fprimitive_undo
, Sprimitive_undo
, 2, 2, 0,
366 "Undo N records from the front of the list LIST.\n\
367 Return what remains of the list.")
371 struct gcpro gcpro1
, gcpro2
;
373 int count
= specpdl_ptr
- specpdl
;
375 #if 0 /* This is a good feature, but would make undo-start
376 unable to do what is expected. */
379 /* If the head of the list is a boundary, it is the boundary
380 preceding this command. Get rid of it and don't count it. */
391 /* Don't let read-only properties interfere with undo. */
392 if (NILP (current_buffer
->read_only
))
393 specbind (Qinhibit_read_only
, Qt
);
401 /* Exit inner loop at undo boundary. */
404 /* Handle an integer by setting point to that value. */
406 SET_PT (clip_to_bounds (BEGV
, XINT (next
), ZV
));
407 else if (CONSP (next
))
409 Lisp_Object car
, cdr
;
415 /* Element (t high . low) records previous modtime. */
416 Lisp_Object high
, low
;
418 struct buffer
*base_buffer
= current_buffer
;
422 mod_time
= (XFASTINT (high
) << 16) + XFASTINT (low
);
424 if (current_buffer
->base_buffer
)
425 base_buffer
= current_buffer
->base_buffer
;
427 /* If this records an obsolete save
428 (not matching the actual disk file)
429 then don't mark unmodified. */
430 if (mod_time
!= base_buffer
->modtime
)
432 #ifdef CLASH_DETECTION
434 #endif /* CLASH_DETECTION */
435 Fset_buffer_modified_p (Qnil
);
437 #ifdef USE_TEXT_PROPERTIES
438 else if (EQ (car
, Qnil
))
440 /* Element (nil prop val beg . end) is property change. */
441 Lisp_Object beg
, end
, prop
, val
;
450 Fput_text_property (beg
, end
, prop
, val
, Qnil
);
452 #endif /* USE_TEXT_PROPERTIES */
453 else if (INTEGERP (car
) && INTEGERP (cdr
))
455 /* Element (BEG . END) means range was inserted. */
458 if (XINT (car
) < BEGV
460 error ("Changes to be undone are outside visible portion of buffer");
461 /* Set point first thing, so that undoing this undo
462 does not send point back to where it is now. */
464 Fdelete_region (car
, cdr
);
466 else if (STRINGP (car
) && INTEGERP (cdr
))
468 /* Element (STRING . POS) means STRING was deleted. */
470 int pos
= XINT (cdr
);
475 if (-pos
< BEGV
|| -pos
> ZV
)
476 error ("Changes to be undone are outside visible portion of buffer");
478 Finsert (1, &membuf
);
482 if (pos
< BEGV
|| pos
> ZV
)
483 error ("Changes to be undone are outside visible portion of buffer");
486 /* Now that we record marker adjustments
487 (caused by deletion) for undo,
488 we should always insert after markers,
489 so that undoing the marker adjustments
490 put the markers back in the right place. */
491 Finsert (1, &membuf
);
495 else if (MARKERP (car
) && INTEGERP (cdr
))
497 /* (MARKER . INTEGER) means a marker MARKER
498 was adjusted by INTEGER. */
499 if (XMARKER (car
)->buffer
)
501 make_number (marker_position (car
) - XINT (cdr
)),
502 Fmarker_buffer (car
));
510 return unbind_to (count
, list
);
515 Qinhibit_read_only
= intern ("inhibit-read-only");
516 staticpro (&Qinhibit_read_only
);
518 pending_boundary
= Qnil
;
519 staticpro (&pending_boundary
);
521 defsubr (&Sprimitive_undo
);
522 defsubr (&Sundo_boundary
);