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 (!BUFFERP (last_undo_buffer
)
58 || current_buffer
!= XBUFFER (last_undo_buffer
))
60 XSETBUFFER (last_undo_buffer
, current_buffer
);
62 if (MODIFF
<= SAVE_MODIFF
)
63 record_first_change ();
65 /* If this is following another insertion and consecutive with it
66 in the buffer, combine the two. */
67 if (CONSP (current_buffer
->undo_list
))
70 elt
= XCAR (current_buffer
->undo_list
);
72 && INTEGERP (XCAR (elt
))
73 && INTEGERP (XCDR (elt
))
74 && XINT (XCDR (elt
)) == beg
)
76 XSETINT (XCDR (elt
), beg
+ length
);
81 XSETFASTINT (lbeg
, beg
);
82 XSETINT (lend
, beg
+ length
);
83 current_buffer
->undo_list
= Fcons (Fcons (lbeg
, lend
),
84 current_buffer
->undo_list
);
87 /* Record that a deletion is about to take place,
88 of the characters in STRING, at location BEG. */
91 record_delete (beg
, string
)
98 if (EQ (current_buffer
->undo_list
, Qt
))
101 /* Allocate a cons cell to be the undo boundary after this command. */
102 if (NILP (pending_boundary
))
103 pending_boundary
= Fcons (Qnil
, Qnil
);
105 if (current_buffer
!= XBUFFER (last_undo_buffer
))
107 XSETBUFFER (last_undo_buffer
, current_buffer
);
109 if (CONSP (current_buffer
->undo_list
))
111 /* Set AT_BOUNDARY to 1 only when we have nothing other than
112 marker adjustment before undo boundary. */
114 Lisp_Object tail
= current_buffer
->undo_list
, elt
;
122 if (NILP (elt
) || ! (CONSP (elt
) && MARKERP (XCAR (elt
))))
126 at_boundary
= NILP (elt
);
131 if (MODIFF
<= SAVE_MODIFF
)
132 record_first_change ();
134 if (PT
== beg
+ XSTRING (string
)->size
)
135 XSETINT (sbeg
, -beg
);
137 XSETFASTINT (sbeg
, beg
);
139 /* If we are just after an undo boundary, and
140 point wasn't at start of deleted range, record where it was. */
142 && last_point_position
!= XFASTINT (sbeg
)
143 /* If we're called from batch mode, this could be nil. */
144 && BUFFERP (last_point_position_buffer
)
145 && current_buffer
== XBUFFER (last_point_position_buffer
))
146 current_buffer
->undo_list
147 = Fcons (make_number (last_point_position
), current_buffer
->undo_list
);
149 current_buffer
->undo_list
150 = Fcons (Fcons (string
, sbeg
), current_buffer
->undo_list
);
153 /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
154 This is done only when a marker points within text being deleted,
155 because that's the only case where an automatic marker adjustment
156 won't be inverted automatically by undoing the buffer modification. */
159 record_marker_adjustment (marker
, adjustment
)
163 if (EQ (current_buffer
->undo_list
, Qt
))
166 /* Allocate a cons cell to be the undo boundary after this command. */
167 if (NILP (pending_boundary
))
168 pending_boundary
= Fcons (Qnil
, Qnil
);
170 if (current_buffer
!= XBUFFER (last_undo_buffer
))
172 XSETBUFFER (last_undo_buffer
, current_buffer
);
174 current_buffer
->undo_list
175 = Fcons (Fcons (marker
, make_number (adjustment
)),
176 current_buffer
->undo_list
);
179 /* Record that a replacement is about to take place,
180 for LENGTH characters at location BEG.
181 The replacement must not change the number of characters. */
184 record_change (beg
, length
)
187 record_delete (beg
, make_buffer_string (beg
, beg
+ length
, 1));
188 record_insert (beg
, length
);
191 /* Record that an unmodified buffer is about to be changed.
192 Record the file modification date so that when undoing this entry
193 we can tell whether it is obsolete because the file was saved again. */
196 record_first_change ()
198 Lisp_Object high
, low
;
199 struct buffer
*base_buffer
= current_buffer
;
201 if (EQ (current_buffer
->undo_list
, Qt
))
204 if (current_buffer
!= XBUFFER (last_undo_buffer
))
206 XSETBUFFER (last_undo_buffer
, current_buffer
);
208 if (base_buffer
->base_buffer
)
209 base_buffer
= base_buffer
->base_buffer
;
211 XSETFASTINT (high
, (base_buffer
->modtime
>> 16) & 0xffff);
212 XSETFASTINT (low
, base_buffer
->modtime
& 0xffff);
213 current_buffer
->undo_list
= Fcons (Fcons (Qt
, Fcons (high
, low
)), current_buffer
->undo_list
);
216 /* Record a change in property PROP (whose old value was VAL)
217 for LENGTH characters starting at position BEG in BUFFER. */
220 record_property_change (beg
, length
, prop
, value
, buffer
)
222 Lisp_Object prop
, value
, buffer
;
224 Lisp_Object lbeg
, lend
, entry
;
225 struct buffer
*obuf
= current_buffer
;
228 if (EQ (XBUFFER (buffer
)->undo_list
, Qt
))
231 /* Allocate a cons cell to be the undo boundary after this command. */
232 if (NILP (pending_boundary
))
233 pending_boundary
= Fcons (Qnil
, Qnil
);
235 if (!EQ (buffer
, last_undo_buffer
))
237 last_undo_buffer
= buffer
;
239 /* Switch temporarily to the buffer that was changed. */
240 current_buffer
= XBUFFER (buffer
);
245 if (MODIFF
<= SAVE_MODIFF
)
246 record_first_change ();
249 XSETINT (lend
, beg
+ length
);
250 entry
= Fcons (Qnil
, Fcons (prop
, Fcons (value
, Fcons (lbeg
, lend
))));
251 current_buffer
->undo_list
= Fcons (entry
, current_buffer
->undo_list
);
253 current_buffer
= obuf
;
256 DEFUN ("undo-boundary", Fundo_boundary
, Sundo_boundary
, 0, 0, 0,
257 "Mark a boundary between units of undo.\n\
258 An undo command will stop at this point,\n\
259 but another undo command will undo to the previous boundary.")
263 if (EQ (current_buffer
->undo_list
, Qt
))
265 tem
= Fcar (current_buffer
->undo_list
);
268 /* One way or another, cons nil onto the front of the undo list. */
269 if (!NILP (pending_boundary
))
271 /* If we have preallocated the cons cell to use here,
273 XCDR (pending_boundary
) = current_buffer
->undo_list
;
274 current_buffer
->undo_list
= pending_boundary
;
275 pending_boundary
= Qnil
;
278 current_buffer
->undo_list
= Fcons (Qnil
, current_buffer
->undo_list
);
283 /* At garbage collection time, make an undo list shorter at the end,
284 returning the truncated list.
285 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
286 In practice, these are the values of undo-limit and
287 undo-strong-limit. */
290 truncate_undo_list (list
, minsize
, maxsize
)
292 int minsize
, maxsize
;
294 Lisp_Object prev
, next
, last_boundary
;
299 last_boundary
= Qnil
;
301 /* Always preserve at least the most recent undo record.
302 If the first element is an undo boundary, skip past it.
304 Skip, skip, skip the undo, skip, skip, skip the undo,
305 Skip, skip, skip the undo, skip to the undo bound'ry.
306 (Get it? "Skip to my Loo?") */
307 if (CONSP (next
) && NILP (XCAR (next
)))
309 /* Add in the space occupied by this element and its chain link. */
310 size_so_far
+= sizeof (struct Lisp_Cons
);
312 /* Advance to next element. */
316 while (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
);
325 size_so_far
+= sizeof (struct Lisp_Cons
);
326 if (STRINGP (XCAR (elt
)))
327 size_so_far
+= (sizeof (struct Lisp_String
) - 1
328 + XSTRING (XCAR (elt
))->size
);
331 /* Advance to next element. */
336 last_boundary
= prev
;
343 /* When we get to a boundary, decide whether to truncate
344 either before or after it. The lower threshold, MINSIZE,
345 tells us to truncate after it. If its size pushes past
346 the higher threshold MAXSIZE as well, we truncate before it. */
349 if (size_so_far
> maxsize
)
351 last_boundary
= prev
;
352 if (size_so_far
> minsize
)
356 /* Add in the space occupied by this element and its chain link. */
357 size_so_far
+= sizeof (struct Lisp_Cons
);
360 size_so_far
+= sizeof (struct Lisp_Cons
);
361 if (STRINGP (XCAR (elt
)))
362 size_so_far
+= (sizeof (struct Lisp_String
) - 1
363 + XSTRING (XCAR (elt
))->size
);
366 /* Advance to next element. */
371 /* If we scanned the whole list, it is short enough; don't change it. */
375 /* Truncate at the boundary where we decided to truncate. */
376 if (!NILP (last_boundary
))
378 XCDR (last_boundary
) = Qnil
;
385 DEFUN ("primitive-undo", Fprimitive_undo
, Sprimitive_undo
, 2, 2, 0,
386 "Undo N records from the front of the list LIST.\n\
387 Return what remains of the list.")
391 struct gcpro gcpro1
, gcpro2
;
393 int count
= specpdl_ptr
- specpdl
;
395 #if 0 /* This is a good feature, but would make undo-start
396 unable to do what is expected. */
399 /* If the head of the list is a boundary, it is the boundary
400 preceding this command. Get rid of it and don't count it. */
411 /* Don't let read-only properties interfere with undo. */
412 if (NILP (current_buffer
->read_only
))
413 specbind (Qinhibit_read_only
, Qt
);
421 /* Exit inner loop at undo boundary. */
424 /* Handle an integer by setting point to that value. */
426 SET_PT (clip_to_bounds (BEGV
, XINT (next
), ZV
));
427 else if (CONSP (next
))
429 Lisp_Object car
, cdr
;
435 /* Element (t high . low) records previous modtime. */
436 Lisp_Object high
, low
;
438 struct buffer
*base_buffer
= current_buffer
;
442 mod_time
= (XFASTINT (high
) << 16) + XFASTINT (low
);
444 if (current_buffer
->base_buffer
)
445 base_buffer
= current_buffer
->base_buffer
;
447 /* If this records an obsolete save
448 (not matching the actual disk file)
449 then don't mark unmodified. */
450 if (mod_time
!= base_buffer
->modtime
)
452 #ifdef CLASH_DETECTION
454 #endif /* CLASH_DETECTION */
455 Fset_buffer_modified_p (Qnil
);
457 else if (EQ (car
, Qnil
))
459 /* Element (nil prop val beg . end) is property change. */
460 Lisp_Object beg
, end
, prop
, val
;
469 Fput_text_property (beg
, end
, prop
, val
, Qnil
);
471 else if (INTEGERP (car
) && INTEGERP (cdr
))
473 /* Element (BEG . END) means range was inserted. */
476 if (XINT (car
) < BEGV
478 error ("Changes to be undone are outside visible portion of buffer");
479 /* Set point first thing, so that undoing this undo
480 does not send point back to where it is now. */
482 Fdelete_region (car
, cdr
);
484 else if (STRINGP (car
) && INTEGERP (cdr
))
486 /* Element (STRING . POS) means STRING was deleted. */
488 int pos
= XINT (cdr
);
493 if (-pos
< BEGV
|| -pos
> ZV
)
494 error ("Changes to be undone are outside visible portion of buffer");
496 Finsert (1, &membuf
);
500 if (pos
< BEGV
|| pos
> ZV
)
501 error ("Changes to be undone are outside visible portion of buffer");
504 /* Now that we record marker adjustments
505 (caused by deletion) for undo,
506 we should always insert after markers,
507 so that undoing the marker adjustments
508 put the markers back in the right place. */
509 Finsert (1, &membuf
);
513 else if (MARKERP (car
) && INTEGERP (cdr
))
515 /* (MARKER . INTEGER) means a marker MARKER
516 was adjusted by INTEGER. */
517 if (XMARKER (car
)->buffer
)
519 make_number (marker_position (car
) - XINT (cdr
)),
520 Fmarker_buffer (car
));
528 return unbind_to (count
, list
);
534 Qinhibit_read_only
= intern ("inhibit-read-only");
535 staticpro (&Qinhibit_read_only
);
537 pending_boundary
= Qnil
;
538 staticpro (&pending_boundary
);
540 defsubr (&Sprimitive_undo
);
541 defsubr (&Sundo_boundary
);