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 distributed in the hope that it will be useful,
7 but WITHOUT ANY WARRANTY. No author or distributor
8 accepts responsibility to anyone for the consequences of using it
9 or for whether it serves any particular purpose or works at all,
10 unless he says so in writing. Refer to the GNU Emacs General Public
11 License for full details.
13 Everyone is granted permission to copy, modify and redistribute
14 GNU Emacs, but only under the conditions described in the
15 GNU Emacs General Public License. A copy of this license is
16 supposed to have been given to you along with GNU Emacs so you
17 can know your rights and responsibilities. It should be in a
18 file named COPYING. Among other things, the copyright notice
19 and this notice must be preserved on all copies. */
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.) */
44 record_insert (beg
, length
)
45 Lisp_Object beg
, length
;
47 Lisp_Object lbeg
, lend
;
49 if (EQ (current_buffer
->undo_list
, Qt
))
52 /* Allocate a cons cell to be the undo boundary after this command. */
53 if (NILP (pending_boundary
))
54 pending_boundary
= Fcons (Qnil
, Qnil
);
56 if (current_buffer
!= XBUFFER (last_undo_buffer
))
58 XSET (last_undo_buffer
, Lisp_Buffer
, current_buffer
);
60 if (MODIFF
<= current_buffer
->save_modified
)
61 record_first_change ();
63 /* If this is following another insertion and consecutive with it
64 in the buffer, combine the two. */
65 if (XTYPE (current_buffer
->undo_list
) == Lisp_Cons
)
68 elt
= XCONS (current_buffer
->undo_list
)->car
;
69 if (XTYPE (elt
) == Lisp_Cons
70 && XTYPE (XCONS (elt
)->car
) == Lisp_Int
71 && XTYPE (XCONS (elt
)->cdr
) == Lisp_Int
72 && XINT (XCONS (elt
)->cdr
) == XINT (beg
))
74 XSETINT (XCONS (elt
)->cdr
, XINT (beg
) + XINT (length
));
80 XSET (lend
, Lisp_Int
, XINT (beg
) + XINT (length
));
81 current_buffer
->undo_list
= Fcons (Fcons (lbeg
, lend
),
82 current_buffer
->undo_list
);
85 /* Record that a deletion is about to take place,
86 for LENGTH characters at location BEG. */
88 record_delete (beg
, length
)
91 Lisp_Object lbeg
, lend
, sbeg
;
94 if (EQ (current_buffer
->undo_list
, Qt
))
97 /* Allocate a cons cell to be the undo boundary after this command. */
98 if (NILP (pending_boundary
))
99 pending_boundary
= Fcons (Qnil
, Qnil
);
101 if (current_buffer
!= XBUFFER (last_undo_buffer
))
103 XSET (last_undo_buffer
, Lisp_Buffer
, current_buffer
);
105 at_boundary
= (CONSP (current_buffer
->undo_list
)
106 && NILP (XCONS (current_buffer
->undo_list
)->car
));
108 if (MODIFF
<= current_buffer
->save_modified
)
109 record_first_change ();
111 if (point
== beg
+ length
)
112 XSET (sbeg
, Lisp_Int
, -beg
);
114 XFASTINT (sbeg
) = beg
;
115 XFASTINT (lbeg
) = beg
;
116 XFASTINT (lend
) = beg
+ length
;
118 /* If we are just after an undo boundary, and
119 point wasn't at start of deleted range, record where it was. */
121 && last_point_position
!= XFASTINT (sbeg
)
122 && current_buffer
== XBUFFER (last_point_position_buffer
))
123 current_buffer
->undo_list
124 = Fcons (make_number (last_point_position
), current_buffer
->undo_list
);
126 current_buffer
->undo_list
127 = Fcons (Fcons (Fbuffer_substring (lbeg
, lend
), sbeg
),
128 current_buffer
->undo_list
);
131 /* Record that a replacement is about to take place,
132 for LENGTH characters at location BEG.
133 The replacement does not change the number of characters. */
135 record_change (beg
, length
)
138 record_delete (beg
, length
);
139 record_insert (beg
, length
);
142 /* Record that an unmodified buffer is about to be changed.
143 Record the file modification date so that when undoing this entry
144 we can tell whether it is obsolete because the file was saved again. */
146 record_first_change ()
148 Lisp_Object high
, low
;
150 if (EQ (current_buffer
->undo_list
, Qt
))
153 if (current_buffer
!= XBUFFER (last_undo_buffer
))
155 XSET (last_undo_buffer
, Lisp_Buffer
, current_buffer
);
157 XFASTINT (high
) = (current_buffer
->modtime
>> 16) & 0xffff;
158 XFASTINT (low
) = current_buffer
->modtime
& 0xffff;
159 current_buffer
->undo_list
= Fcons (Fcons (Qt
, Fcons (high
, low
)), current_buffer
->undo_list
);
162 /* Record a change in property PROP (whose old value was VAL)
163 for LENGTH characters starting at position BEG in BUFFER. */
165 record_property_change (beg
, length
, prop
, value
, buffer
)
167 Lisp_Object prop
, value
, buffer
;
169 Lisp_Object lbeg
, lend
, entry
;
170 struct buffer
*obuf
= current_buffer
;
173 if (EQ (XBUFFER (buffer
)->undo_list
, Qt
))
176 /* Allocate a cons cell to be the undo boundary after this command. */
177 if (NILP (pending_boundary
))
178 pending_boundary
= Fcons (Qnil
, Qnil
);
180 if (!EQ (buffer
, last_undo_buffer
))
182 last_undo_buffer
= buffer
;
184 /* Switch temporarily to the buffer that was changed. */
185 current_buffer
= XBUFFER (buffer
);
190 if (MODIFF
<= current_buffer
->save_modified
)
191 record_first_change ();
193 XSET (lbeg
, Lisp_Int
, beg
);
194 XSET (lend
, Lisp_Int
, beg
+ length
);
195 entry
= Fcons (Qnil
, Fcons (prop
, Fcons (value
, Fcons (lbeg
, lend
))));
196 current_buffer
->undo_list
= Fcons (entry
, current_buffer
->undo_list
);
198 current_buffer
= obuf
;
201 DEFUN ("undo-boundary", Fundo_boundary
, Sundo_boundary
, 0, 0, 0,
202 "Mark a boundary between units of undo.\n\
203 An undo command will stop at this point,\n\
204 but another undo command will undo to the previous boundary.")
208 if (EQ (current_buffer
->undo_list
, Qt
))
210 tem
= Fcar (current_buffer
->undo_list
);
213 /* One way or another, cons nil onto the front of the undo list. */
214 if (!NILP (pending_boundary
))
216 /* If we have preallocated the cons cell to use here,
218 XCONS (pending_boundary
)->cdr
= current_buffer
->undo_list
;
219 current_buffer
->undo_list
= pending_boundary
;
220 pending_boundary
= Qnil
;
223 current_buffer
->undo_list
= Fcons (Qnil
, current_buffer
->undo_list
);
228 /* At garbage collection time, make an undo list shorter at the end,
229 returning the truncated list.
230 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
231 In practice, these are the values of undo-limit and
232 undo-strong-limit. */
235 truncate_undo_list (list
, minsize
, maxsize
)
237 int minsize
, maxsize
;
239 Lisp_Object prev
, next
, last_boundary
;
244 last_boundary
= Qnil
;
246 /* Always preserve at least the most recent undo record.
247 If the first element is an undo boundary, skip past it.
249 Skip, skip, skip the undo, skip, skip, skip the undo,
250 Skip, skip, skip the undo, skip to the undo bound'ry.
251 (Get it? "Skip to my Loo?") */
252 if (XTYPE (next
) == Lisp_Cons
253 && NILP (XCONS (next
)->car
))
255 /* Add in the space occupied by this element and its chain link. */
256 size_so_far
+= sizeof (struct Lisp_Cons
);
258 /* Advance to next element. */
260 next
= XCONS (next
)->cdr
;
262 while (XTYPE (next
) == Lisp_Cons
263 && ! NILP (XCONS (next
)->car
))
266 elt
= XCONS (next
)->car
;
268 /* Add in the space occupied by this element and its chain link. */
269 size_so_far
+= sizeof (struct Lisp_Cons
);
270 if (XTYPE (elt
) == Lisp_Cons
)
272 size_so_far
+= sizeof (struct Lisp_Cons
);
273 if (XTYPE (XCONS (elt
)->car
) == Lisp_String
)
274 size_so_far
+= (sizeof (struct Lisp_String
) - 1
275 + XSTRING (XCONS (elt
)->car
)->size
);
278 /* Advance to next element. */
280 next
= XCONS (next
)->cdr
;
282 if (XTYPE (next
) == Lisp_Cons
)
283 last_boundary
= prev
;
285 while (XTYPE (next
) == Lisp_Cons
)
288 elt
= XCONS (next
)->car
;
290 /* When we get to a boundary, decide whether to truncate
291 either before or after it. The lower threshold, MINSIZE,
292 tells us to truncate after it. If its size pushes past
293 the higher threshold MAXSIZE as well, we truncate before it. */
296 if (size_so_far
> maxsize
)
298 last_boundary
= prev
;
299 if (size_so_far
> minsize
)
303 /* Add in the space occupied by this element and its chain link. */
304 size_so_far
+= sizeof (struct Lisp_Cons
);
305 if (XTYPE (elt
) == Lisp_Cons
)
307 size_so_far
+= sizeof (struct Lisp_Cons
);
308 if (XTYPE (XCONS (elt
)->car
) == Lisp_String
)
309 size_so_far
+= (sizeof (struct Lisp_String
) - 1
310 + XSTRING (XCONS (elt
)->car
)->size
);
313 /* Advance to next element. */
315 next
= XCONS (next
)->cdr
;
318 /* If we scanned the whole list, it is short enough; don't change it. */
322 /* Truncate at the boundary where we decided to truncate. */
323 if (!NILP (last_boundary
))
325 XCONS (last_boundary
)->cdr
= Qnil
;
332 DEFUN ("primitive-undo", Fprimitive_undo
, Sprimitive_undo
, 2, 2, 0,
333 "Undo N records from the front of the list LIST.\n\
334 Return what remains of the list.")
338 int count
= specpdl_ptr
- specpdl
;
339 register int arg
= XINT (n
);
340 #if 0 /* This is a good feature, but would make undo-start
341 unable to do what is expected. */
344 /* If the head of the list is a boundary, it is the boundary
345 preceding this command. Get rid of it and don't count it. */
351 /* Don't let read-only properties interfere with undo. */
352 if (NILP (current_buffer
->read_only
))
353 specbind (Qinhibit_read_only
, Qt
);
362 /* Exit inner loop at undo boundary. */
365 /* Handle an integer by setting point to that value. */
366 if (XTYPE (next
) == Lisp_Int
)
367 SET_PT (clip_to_bounds (BEGV
, XINT (next
), ZV
));
368 else if (XTYPE (next
) == Lisp_Cons
)
370 Lisp_Object car
, cdr
;
376 /* Element (t high . low) records previous modtime. */
377 Lisp_Object high
, low
;
382 mod_time
= (XFASTINT (high
) << 16) + XFASTINT (low
);
383 /* If this records an obsolete save
384 (not matching the actual disk file)
385 then don't mark unmodified. */
386 if (mod_time
!= current_buffer
->modtime
)
388 #ifdef CLASH_DETECTION
390 #endif /* CLASH_DETECTION */
391 Fset_buffer_modified_p (Qnil
);
393 #ifdef USE_TEXT_PROPERTIES
394 else if (EQ (car
, Qnil
))
396 /* Element (nil prop val beg . end) is property change. */
397 Lisp_Object beg
, end
, prop
, val
;
406 Fput_text_property (beg
, end
, prop
, val
, Qnil
);
408 #endif /* USE_TEXT_PROPERTIES */
409 else if (XTYPE (car
) == Lisp_Int
&& XTYPE (cdr
) == Lisp_Int
)
411 /* Element (BEG . END) means range was inserted. */
414 if (XINT (car
) < BEGV
416 error ("Changes to be undone are outside visible portion of buffer");
417 /* Set point first thing, so that undoing this undo
418 does not send point back to where it is now. */
420 Fdelete_region (car
, cdr
);
422 else if (XTYPE (car
) == Lisp_String
&& XTYPE (cdr
) == Lisp_Int
)
424 /* Element (STRING . POS) means STRING was deleted. */
426 int pos
= XINT (cdr
);
431 if (-pos
< BEGV
|| -pos
> ZV
)
432 error ("Changes to be undone are outside visible portion of buffer");
434 Finsert (1, &membuf
);
438 if (pos
< BEGV
|| pos
> ZV
)
439 error ("Changes to be undone are outside visible portion of buffer");
442 /* Insert before markers so that if the mark is
443 currently on the boundary of this deletion, it
444 ends up on the other side of the now-undeleted
445 text from point. Since undo doesn't even keep
446 track of the mark, this isn't really necessary,
447 but it may lead to better behavior in certain
449 Finsert_before_markers (1, &membuf
);
458 return unbind_to (count
, list
);
463 Qinhibit_read_only
= intern ("inhibit-read-only");
464 staticpro (&Qinhibit_read_only
);
466 pending_boundary
= Qnil
;
467 staticpro (&pending_boundary
);
469 defsubr (&Sprimitive_undo
);
470 defsubr (&Sundo_boundary
);