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 XSETBUFFER (last_undo_buffer
, current_buffer
);
60 if (MODIFF
<= SAVE_MODIFF
)
61 record_first_change ();
63 /* If this is following another insertion and consecutive with it
64 in the buffer, combine the two. */
65 if (CONSP (current_buffer
->undo_list
))
68 elt
= XCONS (current_buffer
->undo_list
)->car
;
70 && INTEGERP (XCONS (elt
)->car
)
71 && INTEGERP (XCONS (elt
)->cdr
)
72 && XINT (XCONS (elt
)->cdr
) == XINT (beg
))
74 XSETINT (XCONS (elt
)->cdr
, XINT (beg
) + XINT (length
));
80 XSETINT (lend
, 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 XSETBUFFER (last_undo_buffer
, current_buffer
);
105 at_boundary
= (CONSP (current_buffer
->undo_list
)
106 && NILP (XCONS (current_buffer
->undo_list
)->car
));
108 if (MODIFF
<= SAVE_MODIFF
)
109 record_first_change ();
111 if (point
== beg
+ length
)
112 XSETINT (sbeg
, -beg
);
114 XSETFASTINT (sbeg
, beg
);
115 XSETFASTINT (lbeg
, beg
);
116 XSETFASTINT (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
;
149 struct buffer
*base_buffer
= current_buffer
;
151 if (EQ (current_buffer
->undo_list
, Qt
))
154 if (current_buffer
!= XBUFFER (last_undo_buffer
))
156 XSETBUFFER (last_undo_buffer
, current_buffer
);
158 if (base_buffer
->base_buffer
)
159 base_buffer
= base_buffer
->base_buffer
;
161 XSETFASTINT (high
, (base_buffer
->modtime
>> 16) & 0xffff);
162 XSETFASTINT (low
, base_buffer
->modtime
& 0xffff);
163 current_buffer
->undo_list
= Fcons (Fcons (Qt
, Fcons (high
, low
)), current_buffer
->undo_list
);
166 /* Record a change in property PROP (whose old value was VAL)
167 for LENGTH characters starting at position BEG in BUFFER. */
169 record_property_change (beg
, length
, prop
, value
, buffer
)
171 Lisp_Object prop
, value
, buffer
;
173 Lisp_Object lbeg
, lend
, entry
;
174 struct buffer
*obuf
= current_buffer
;
177 if (EQ (XBUFFER (buffer
)->undo_list
, Qt
))
180 /* Allocate a cons cell to be the undo boundary after this command. */
181 if (NILP (pending_boundary
))
182 pending_boundary
= Fcons (Qnil
, Qnil
);
184 if (!EQ (buffer
, last_undo_buffer
))
186 last_undo_buffer
= buffer
;
188 /* Switch temporarily to the buffer that was changed. */
189 current_buffer
= XBUFFER (buffer
);
194 if (MODIFF
<= SAVE_MODIFF
)
195 record_first_change ();
198 XSETINT (lend
, beg
+ length
);
199 entry
= Fcons (Qnil
, Fcons (prop
, Fcons (value
, Fcons (lbeg
, lend
))));
200 current_buffer
->undo_list
= Fcons (entry
, current_buffer
->undo_list
);
202 current_buffer
= obuf
;
205 DEFUN ("undo-boundary", Fundo_boundary
, Sundo_boundary
, 0, 0, 0,
206 "Mark a boundary between units of undo.\n\
207 An undo command will stop at this point,\n\
208 but another undo command will undo to the previous boundary.")
212 if (EQ (current_buffer
->undo_list
, Qt
))
214 tem
= Fcar (current_buffer
->undo_list
);
217 /* One way or another, cons nil onto the front of the undo list. */
218 if (!NILP (pending_boundary
))
220 /* If we have preallocated the cons cell to use here,
222 XCONS (pending_boundary
)->cdr
= current_buffer
->undo_list
;
223 current_buffer
->undo_list
= pending_boundary
;
224 pending_boundary
= Qnil
;
227 current_buffer
->undo_list
= Fcons (Qnil
, current_buffer
->undo_list
);
232 /* At garbage collection time, make an undo list shorter at the end,
233 returning the truncated list.
234 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
235 In practice, these are the values of undo-limit and
236 undo-strong-limit. */
239 truncate_undo_list (list
, minsize
, maxsize
)
241 int minsize
, maxsize
;
243 Lisp_Object prev
, next
, last_boundary
;
248 last_boundary
= Qnil
;
250 /* Always preserve at least the most recent undo record.
251 If the first element is an undo boundary, skip past it.
253 Skip, skip, skip the undo, skip, skip, skip the undo,
254 Skip, skip, skip the undo, skip to the undo bound'ry.
255 (Get it? "Skip to my Loo?") */
256 if (CONSP (next
) && NILP (XCONS (next
)->car
))
258 /* Add in the space occupied by this element and its chain link. */
259 size_so_far
+= sizeof (struct Lisp_Cons
);
261 /* Advance to next element. */
263 next
= XCONS (next
)->cdr
;
265 while (CONSP (next
) && ! NILP (XCONS (next
)->car
))
268 elt
= XCONS (next
)->car
;
270 /* Add in the space occupied by this element and its chain link. */
271 size_so_far
+= sizeof (struct Lisp_Cons
);
274 size_so_far
+= sizeof (struct Lisp_Cons
);
275 if (STRINGP (XCONS (elt
)->car
))
276 size_so_far
+= (sizeof (struct Lisp_String
) - 1
277 + XSTRING (XCONS (elt
)->car
)->size
);
280 /* Advance to next element. */
282 next
= XCONS (next
)->cdr
;
285 last_boundary
= prev
;
290 elt
= XCONS (next
)->car
;
292 /* When we get to a boundary, decide whether to truncate
293 either before or after it. The lower threshold, MINSIZE,
294 tells us to truncate after it. If its size pushes past
295 the higher threshold MAXSIZE as well, we truncate before it. */
298 if (size_so_far
> maxsize
)
300 last_boundary
= prev
;
301 if (size_so_far
> minsize
)
305 /* Add in the space occupied by this element and its chain link. */
306 size_so_far
+= sizeof (struct Lisp_Cons
);
309 size_so_far
+= sizeof (struct Lisp_Cons
);
310 if (STRINGP (XCONS (elt
)->car
))
311 size_so_far
+= (sizeof (struct Lisp_String
) - 1
312 + XSTRING (XCONS (elt
)->car
)->size
);
315 /* Advance to next element. */
317 next
= XCONS (next
)->cdr
;
320 /* If we scanned the whole list, it is short enough; don't change it. */
324 /* Truncate at the boundary where we decided to truncate. */
325 if (!NILP (last_boundary
))
327 XCONS (last_boundary
)->cdr
= Qnil
;
334 DEFUN ("primitive-undo", Fprimitive_undo
, Sprimitive_undo
, 2, 2, 0,
335 "Undo N records from the front of the list LIST.\n\
336 Return what remains of the list.")
340 struct gcpro gcpro1
, gcpro2
;
342 int count
= specpdl_ptr
- specpdl
;
344 #if 0 /* This is a good feature, but would make undo-start
345 unable to do what is expected. */
348 /* If the head of the list is a boundary, it is the boundary
349 preceding this command. Get rid of it and don't count it. */
360 /* Don't let read-only properties interfere with undo. */
361 if (NILP (current_buffer
->read_only
))
362 specbind (Qinhibit_read_only
, Qt
);
370 /* Exit inner loop at undo boundary. */
373 /* Handle an integer by setting point to that value. */
375 SET_PT (clip_to_bounds (BEGV
, XINT (next
), ZV
));
376 else if (CONSP (next
))
378 Lisp_Object car
, cdr
;
384 /* Element (t high . low) records previous modtime. */
385 Lisp_Object high
, low
;
387 struct buffer
*base_buffer
= current_buffer
;
391 mod_time
= (XFASTINT (high
) << 16) + XFASTINT (low
);
393 if (current_buffer
->base_buffer
)
394 base_buffer
= current_buffer
->base_buffer
;
396 /* If this records an obsolete save
397 (not matching the actual disk file)
398 then don't mark unmodified. */
399 if (mod_time
!= base_buffer
->modtime
)
401 #ifdef CLASH_DETECTION
403 #endif /* CLASH_DETECTION */
404 Fset_buffer_modified_p (Qnil
);
406 #ifdef USE_TEXT_PROPERTIES
407 else if (EQ (car
, Qnil
))
409 /* Element (nil prop val beg . end) is property change. */
410 Lisp_Object beg
, end
, prop
, val
;
419 Fput_text_property (beg
, end
, prop
, val
, Qnil
);
421 #endif /* USE_TEXT_PROPERTIES */
422 else if (INTEGERP (car
) && INTEGERP (cdr
))
424 /* Element (BEG . END) means range was inserted. */
427 if (XINT (car
) < BEGV
429 error ("Changes to be undone are outside visible portion of buffer");
430 /* Set point first thing, so that undoing this undo
431 does not send point back to where it is now. */
433 Fdelete_region (car
, cdr
);
435 else if (STRINGP (car
) && INTEGERP (cdr
))
437 /* Element (STRING . POS) means STRING was deleted. */
439 int pos
= XINT (cdr
);
444 if (-pos
< BEGV
|| -pos
> ZV
)
445 error ("Changes to be undone are outside visible portion of buffer");
447 Finsert (1, &membuf
);
451 if (pos
< BEGV
|| pos
> ZV
)
452 error ("Changes to be undone are outside visible portion of buffer");
455 /* Insert before markers so that if the mark is
456 currently on the boundary of this deletion, it
457 ends up on the other side of the now-undeleted
458 text from point. Since undo doesn't even keep
459 track of the mark, this isn't really necessary,
460 but it may lead to better behavior in certain
462 Finsert_before_markers (1, &membuf
);
472 return unbind_to (count
, list
);
477 Qinhibit_read_only
= intern ("inhibit-read-only");
478 staticpro (&Qinhibit_read_only
);
480 pending_boundary
= Qnil
;
481 staticpro (&pending_boundary
);
483 defsubr (&Sprimitive_undo
);
484 defsubr (&Sundo_boundary
);