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
<= 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 (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
<= current_buffer
->save_modified
)
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
;
150 if (EQ (current_buffer
->undo_list
, Qt
))
153 if (current_buffer
!= XBUFFER (last_undo_buffer
))
155 XSETBUFFER (last_undo_buffer
, current_buffer
);
157 XSETFASTINT (high
, (current_buffer
->modtime
>> 16) & 0xffff);
158 XSETFASTINT (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 ();
194 XSETINT (lend
, 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 (CONSP (next
) && NILP (XCONS (next
)->car
))
254 /* Add in the space occupied by this element and its chain link. */
255 size_so_far
+= sizeof (struct Lisp_Cons
);
257 /* Advance to next element. */
259 next
= XCONS (next
)->cdr
;
261 while (CONSP (next
) && ! NILP (XCONS (next
)->car
))
264 elt
= XCONS (next
)->car
;
266 /* Add in the space occupied by this element and its chain link. */
267 size_so_far
+= sizeof (struct Lisp_Cons
);
270 size_so_far
+= sizeof (struct Lisp_Cons
);
271 if (STRINGP (XCONS (elt
)->car
))
272 size_so_far
+= (sizeof (struct Lisp_String
) - 1
273 + XSTRING (XCONS (elt
)->car
)->size
);
276 /* Advance to next element. */
278 next
= XCONS (next
)->cdr
;
281 last_boundary
= prev
;
286 elt
= XCONS (next
)->car
;
288 /* When we get to a boundary, decide whether to truncate
289 either before or after it. The lower threshold, MINSIZE,
290 tells us to truncate after it. If its size pushes past
291 the higher threshold MAXSIZE as well, we truncate before it. */
294 if (size_so_far
> maxsize
)
296 last_boundary
= prev
;
297 if (size_so_far
> minsize
)
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 /* If we scanned the whole list, it is short enough; don't change it. */
320 /* Truncate at the boundary where we decided to truncate. */
321 if (!NILP (last_boundary
))
323 XCONS (last_boundary
)->cdr
= Qnil
;
330 DEFUN ("primitive-undo", Fprimitive_undo
, Sprimitive_undo
, 2, 2, 0,
331 "Undo N records from the front of the list LIST.\n\
332 Return what remains of the list.")
336 struct gcpro gcpro1
, gcpro2
;
338 int count
= specpdl_ptr
- specpdl
;
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. */
356 /* Don't let read-only properties interfere with undo. */
357 if (NILP (current_buffer
->read_only
))
358 specbind (Qinhibit_read_only
, Qt
);
366 /* Exit inner loop at undo boundary. */
369 /* Handle an integer by setting point to that value. */
371 SET_PT (clip_to_bounds (BEGV
, XINT (next
), ZV
));
372 else if (CONSP (next
))
374 Lisp_Object car
, cdr
;
380 /* Element (t high . low) records previous modtime. */
381 Lisp_Object high
, low
;
386 mod_time
= (XFASTINT (high
) << 16) + XFASTINT (low
);
387 /* If this records an obsolete save
388 (not matching the actual disk file)
389 then don't mark unmodified. */
390 if (mod_time
!= current_buffer
->modtime
)
392 #ifdef CLASH_DETECTION
394 #endif /* CLASH_DETECTION */
395 Fset_buffer_modified_p (Qnil
);
397 #ifdef USE_TEXT_PROPERTIES
398 else if (EQ (car
, Qnil
))
400 /* Element (nil prop val beg . end) is property change. */
401 Lisp_Object beg
, end
, prop
, val
;
410 Fput_text_property (beg
, end
, prop
, val
, Qnil
);
412 #endif /* USE_TEXT_PROPERTIES */
413 else if (INTEGERP (car
) && INTEGERP (cdr
))
415 /* Element (BEG . END) means range was inserted. */
418 if (XINT (car
) < BEGV
420 error ("Changes to be undone are outside visible portion of buffer");
421 /* Set point first thing, so that undoing this undo
422 does not send point back to where it is now. */
424 Fdelete_region (car
, cdr
);
426 else if (STRINGP (car
) && INTEGERP (cdr
))
428 /* Element (STRING . POS) means STRING was deleted. */
430 int pos
= XINT (cdr
);
435 if (-pos
< BEGV
|| -pos
> ZV
)
436 error ("Changes to be undone are outside visible portion of buffer");
438 Finsert (1, &membuf
);
442 if (pos
< BEGV
|| pos
> ZV
)
443 error ("Changes to be undone are outside visible portion of buffer");
446 /* Insert before markers so that if the mark is
447 currently on the boundary of this deletion, it
448 ends up on the other side of the now-undeleted
449 text from point. Since undo doesn't even keep
450 track of the mark, this isn't really necessary,
451 but it may lead to better behavior in certain
453 Finsert_before_markers (1, &membuf
);
463 return unbind_to (count
, list
);
468 Qinhibit_read_only
= intern ("inhibit-read-only");
469 staticpro (&Qinhibit_read_only
);
471 pending_boundary
= Qnil
;
472 staticpro (&pending_boundary
);
474 defsubr (&Sprimitive_undo
);
475 defsubr (&Sundo_boundary
);